OLE-Storage_Lite-0.19/000755 000765 000024 00000000000 11303065342 014477 5ustar00Johnstaff000000 000000 OLE-Storage_Lite-0.19/Changes000644 000765 000024 00000007143 11303065203 015773 0ustar00Johnstaff000000 000000 Revision history for Perl extension OLE::Storage_Lite. 0.19 Tue Nov 24 2009 ! Fixed bug where the OLE header wasn't been written correctly for files < 7MB. This was causing Spreadsheet::WriteExcel problems in Windows 7. 0.18 Wed Dec 31 2008 ! Fixed internal version numbers. 0.17 Tue May 10 2008 - Rewrote internal date handling functions to avoid Math::BigInt due to further problems introduced by the patch in 0.15. http://rt.cpan.org/Public/Bug/Display.html?id=34567 Reported by Andrew Benham. 0.16 Tue Feb 19 2008 - Workaround for HP-UX Perl 5.6 integer bug. Thanks Bob Rose. - Fix for binmode() on IO::Scalar. Reported by Tobias Tacke: http://rt.cpan.org/Public/Bug/Display.html?id=32603 0.15 Sat Dec 1 2007 - Fix for OLE::Storage_Lite performance degradation caused by Math::BigInt degradation. http://rt.cpan.org/Public/Bug/Display.html?id=31006 Thanks Jonathan Kamens. 0.14 Mon Nov 8 2004 - Return filehandle close() value to caller. Spotted in Spreadsheet::WriteExcel::Big by Edward James and Reidar Johansen. - Changed IO::Scalar from a "use" to a "require" and removed the Makefile dependency to make H. Merijn Brand's life easier for some reason. :-) 0.13 Sun Aug 1 2004 - Allowed use of user defined filehandles. This should make the module work with mod_perl and some other applications. https://rt.cpan.org/NoAuth/Bug.html?id=7168 0.12 Thu May 28 2004 - Applied patch to fix problems when creating very large files. Thanks James Rouzier. - Applied patch to allow IO::Scalar as a data destination. Thanks Kyle Burton. - Fixed pack() warning in perl5.8 - jmcnamara 0.11 Tue Nov 12 7:40:00 2002 - Fix 10,683,904 bytes (20,700) Problem Thank you, John McNamara - Fix Makefile.PL (IO::Scalar), Thank you, Chris Dolan 0.10 Thu Jan 24 6:00:00 2001 - Fix Broken file problem + Fixed first release Thank you, Bruno Wolff III 0.09 Fri May 25 6:00:00 2001 - Fix small size problem Thank you, Thomas Schachner and John McNamara - Fix RootEntry -> Root Entry Thank you, Joergen von Bargen 0.08 Thu Mar 1 22:30:00 2001 - Fix case insensitive version for getPpsSearch Thank you, yusuf_najmuddin and sorry Punam Chordia. - Add IO::Scalar prerequire to Makefile.PL Thank you, J. David Blackstone. - Add newFile and append methond to Pps::File by Kawai Takanori 0.07 Thu Feb 22 9:00:00 2001 - Add case insensitive version for getPpsSearch by Kawai Takanori Thank you, Punam Chordia. - Modify save Big file by Kawai Takanori Thank you, Bill White. 0.06 Thu Feb 2 12:00:00 2001 - Add referrence of scalar and IO::File object support by Kawai Takanori Thank you, Jeff Haferman 0.05 Thu Jan 4 14:00:00 2001 - Modified Minor mistakes by Kawai Takanori Thank you, Hao Huang and Ian Penman 0.04 Wed Dec 6 11:00:00 2000 - Modified Minor mistakes by Kawai Takanori Thank you, Anthony Brock. 0.03 Wed Nov 14 10:00:00 2000 - Modified Minor mistakes by Kawai Takanori 0.02 Wed Nov 8 21:00:00 2000 - Added STDOUT; created by Kawai Takanori 0.01 Sat Nov 4 16:00:00 2000 - original version; created by Kawai Takanori OLE-Storage_Lite-0.19/lib/000755 000765 000024 00000000000 11303065342 015245 5ustar00Johnstaff000000 000000 OLE-Storage_Lite-0.19/Makefile.PL000644 000765 000024 00000000654 11302630320 016447 0ustar00Johnstaff000000 000000 use ExtUtils::MakeMaker; WriteMakefile( ($] >= 5.005 ? ( 'AUTHOR' => 'Kawai Takanori (kwitknr@cpan.org)', 'ABSTRACT' => 'Read and write OLE storage files.', ) : () ), 'NAME' => 'OLE::Storage_Lite', 'VERSION_FROM' => 'lib/OLE/Storage_Lite.pm', 'NEEDS_LINKING' => 0, 'PREREQ_PM' => {}, 'dist' => {COMPRESS => 'gzip --best', SUFFIX => 'gz'}, ); OLE-Storage_Lite-0.19/MANIFEST000644 000765 000024 00000000516 11302630320 015623 0ustar00Johnstaff000000 000000 Changes MANIFEST Makefile.PL README lib/OLE/Storage_Lite.pm sample/README sample/smpadd.pl sample/smpadd_a.pl sample/smpaddF.pl sample/smplls.pl sample/smplls_a.pl sample/smpsv.pl sample/test.xls t/00_load.t t/01_date_conversion.t META.yml Module meta-data (added by MakeMaker) OLE-Storage_Lite-0.19/META.yml000644 000765 000024 00000001036 11303065342 015750 0ustar00Johnstaff000000 000000 --- #YAML:1.0 name: OLE-Storage_Lite version: 0.19 abstract: Read and write OLE storage files. author: - Kawai Takanori (kwitknr@cpan.org) license: unknown distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: {} no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.54 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 OLE-Storage_Lite-0.19/README000644 000765 000024 00000001673 11302630320 015357 0ustar00Johnstaff000000 000000 NAME OLE::Storage_Lite - Simple Class for OLE document interface. DESCRIPTION This module allows you to read and write an OLE-Structured file. The module will work on the majority of Windows, UNIX and Macintosh platforms. REQUIREMENT Perl 5.005 or later. INSTALLATION The module can be installed using the standard Perl procedure: perl Makefile.PL make make test make install # You may need to be root make clean # or make realclean Windows users without a working "make" can get nmake from: ftp://ftp.microsoft.com/Softlib/MSLFILES/nmake15.exe SAMPLE Samples scripts are in sample directory. smplls.pl : displays PPS structure of specified file (subset of "lls" distributed with OLE::Storage) smpsv.pl : creates and save a sample OLE-file(tsv.dat). AUTHOR Kawai Takanori (kwitknr@cpan.org) OLE-Storage_Lite-0.19/sample/000755 000765 000024 00000000000 11303065342 015760 5ustar00Johnstaff000000 000000 OLE-Storage_Lite-0.19/t/000755 000765 000024 00000000000 11303065342 014742 5ustar00Johnstaff000000 000000 OLE-Storage_Lite-0.19/t/00_load.t000644 000765 000024 00000001252 11302630320 016336 0ustar00Johnstaff000000 000000 # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN { $| = 1; print "1..1\n"; } END {print "not ok 1\n" unless $loaded;} use OLE::Storage_Lite; $loaded = 1; print "ok 1\n"; ######################### End of black magic. # Insert your test code below (better if it prints "ok 13" # (correspondingly "not ok 13") depending on the success of chunk 13 # of the test code): OLE-Storage_Lite-0.19/t/01_date_conversion.t000644 000765 000024 00000021734 11302630320 020611 0ustar00Johnstaff000000 000000 #!/usr/bin/perl -w ############################################################################### # # Tests for OLE::Storage_Lites internal date handling functions. # # reverse('Љ'), May 2007, John McNamara, jmcnamara@cpan.org # use strict; use OLE::Storage_Lite; use Test::More tests => 198; my @testdata; # Read the test data from the end of the file... while () { next unless /\S/; chomp; s/# //; my @data = split /\s+/, $_, 4; push @testdata, \@data; } # Run the tests... for my $test (@testdata) { my $unix_seconds = $test->[0]; my $expected_localtime = $test->[1]; my $expected_oletime = $test->[2]; my $caption = $test->[3]; # Test LocalDate2OLE $expected_localtime = [split /-/, $expected_localtime]; my $got_oletime = OLE::Storage_Lite::LocalDate2OLE($expected_localtime); $got_oletime = uc unpack "H*", $got_oletime; is($got_oletime, $expected_oletime, " \tLocalDate2OLE: $caption"); # Test LocalDate2OLE $expected_oletime = pack 'H*', $expected_oletime; my @got_localtime = OLE::Storage_Lite::OLEDate2Local($expected_oletime); @got_localtime = @got_localtime[0..5]; my $got_localtime = join '-', @got_localtime[0..5]; $expected_localtime = join '-', @$expected_localtime; is($got_localtime, $expected_localtime, " \tOLEDate2Local: $caption"); } __DATA__ 0 0-0-0-1-0-70 00803ED5DEB19D01 # Thu Jan 1 00:00:00 1970 1 1-0-0-1-0-70 8016D7D5DEB19D01 # Thu Jan 1 00:00:01 1970 3997695 15-28-6-16-1-70 80E925B13AD69D01 # Mon Feb 16 06:28:15 1970 29753343 3-49-8-11-11-70 80E9A5BB79C09E01 # Fri Dec 11 08:49:03 1970 36634623 3-17-0-1-2-71 80E925760FFF9E01 # Mon Mar 1 00:17:03 1971 50593791 51-49-14-9-7-71 80516A100D7E9F01 # Mon Aug 9 14:49:51 1971 79101951 51-45-13-4-6-72 8051EACB5481A001 # Tue Jul 4 13:45:51 1972 124256255 35-37-3-9-11-73 80E9A578F91BA201 # Sun Dec 9 03:37:35 1973 171048959 59-35-18-3-5-75 80516A9B95C5A301 # Tue Jun 3 18:35:59 1975 183959551 31-52-3-31-9-75 80E9250AF93AA401 # Fri Oct 31 03:52:31 1975 201457663 43-27-17-20-4-76 80516A6326DAA401 # Thu May 20 17:27:43 1976 202637311 31-8-9-3-5-76 80516AF8E0E4A401 # Thu Jun 3 09:08:31 1976 203030527 7-22-22-7-5-76 80516A7F74E8A401 # Mon Jun 7 22:22:07 1976 236388351 51-25-0-29-5-77 8051EABBD717A601 # Wed Jun 29 00:25:51 1977 293470207 7-30-16-20-3-79 80516AC9FF1EA801 # Fri Apr 20 16:30:07 1979 324009983 23-46-3-8-3-80 80516ABEC134A901 # Tue Apr 8 03:46:23 1980 354877439 59-3-10-31-2-81 8051EAA37E4DAA01 # Tue Mar 31 10:03:59 1981 446300159 59-15-12-22-1-84 80E9A55DF28CAD01 # Wed Feb 22 12:15:59 1984 453312511 31-8-17-13-4-84 8051EAA6C1CCAD01 # Sun May 13 17:08:31 1984 482017279 19-41-22-10-3-85 8051EA25D3D1AE01 # Wed Apr 10 22:41:19 1985 508428287 47-4-14-10-1-86 80E9A5AFFFC1AF01 # Mon Feb 10 14:04:47 1986 510722047 7-14-3-9-2-86 80E92543DCD6AF01 # Sun Mar 9 03:14:07 1986 528285695 35-1-11-28-8-86 8051EA32A276B001 # Sun Sep 28 11:01:35 1986 571670527 7-22-13-12-1-88 80E925002F01B201 # Fri Feb 12 13:22:07 1988 599130111 51-1-9-26-11-88 80E9A553EDFAB201 # Mon Dec 26 09:01:51 1988 632619007 7-30-23-17-0-90 80E925BD812BB401 # Wed Jan 17 23:30:07 1990 633733119 39-58-20-30-0-90 80E9A5BBA335B401 # Tue Jan 30 20:58:39 1990 638189567 47-52-10-23-2-90 80E9A5B52B5EB401 # Fri Mar 23 10:52:47 1990 692518911 51-21-6-12-11-91 80E925124B4CB601 # Thu Dec 12 06:21:51 1991 737869823 23-50-4-20-4-93 8051EA45CAE8B701 # Thu May 20 04:50:23 1993 755892223 43-3-18-14-11-93 80E9A58FAB8CB801 # Tue Dec 14 18:03:43 1993 835387391 11-3-21-21-5-96 8051EA0DB55FBB01 # Fri Jun 21 21:03:11 1996 838729727 47-28-13-30-6-96 80516A091B7EBB01 # Tue Jul 30 13:28:47 1996 846135295 55-34-6-24-9-96 8051EA7775C1BB01 # Thu Oct 24 06:34:55 1996 856096767 27-39-12-16-1-97 80E92572061CBC01 # Sun Feb 16 12:39:27 1997 892076031 51-53-23-8-3-98 80516A944963BD01 # Wed Apr 8 23:53:51 1998 908460031 31-0-15-15-9-98 80516A8D4CF8BD01 # Thu Oct 15 15:00:31 1998 936312831 51-53-23-2-8-99 8051EA679EF5BE01 # Thu Sep 2 23:53:51 1999 944504831 11-27-18-6-11-99 80E9A5821740BF01 # Mon Dec 6 18:27:11 1999 951696000 0-0-0-28-1-100 00C062C17E81BF01 # Mon Feb 28 00:00:00 2000 951782399 59-59-23-28-1-100 80E933EB4782BF01 # Mon Feb 28 23:59:59 2000 951782400 0-0-0-29-1-100 0080CCEB4782BF01 # Tue Feb 29 00:00:00 2000 954138623 23-30-7-27-2-100 8051EA4FBE97BF01 # Mon Mar 27 07:30:23 2000 972226559 59-55-15-22-9-100 8051EA91403CC001 # Sun Oct 22 15:55:59 2000 983318400 0-0-0-28-1-101 0040936419A1C001 # Wed Feb 28 00:00:00 2001 983404799 59-59-23-28-1-101 8069648EE2A1C001 # Wed Feb 28 23:59:59 2001 983404800 0-0-0-1-2-101 0000FD8EE2A1C001 # Thu Mar 1 00:00:00 2001 1003552767 27-39-5-20-9-101 8051EA942959C101 # Sat Oct 20 05:39:27 2001 1031012351 11-19-1-3-8-102 80516AE8E752C201 # Tue Sep 3 01:19:11 2002 1037172735 15-32-7-13-10-102 80E9A5C9E68AC201 # Wed Nov 13 07:32:15 2002 1066926079 19-21-17-23-9-103 80516A128A99C301 # Thu Oct 23 17:21:19 2003 1076559871 31-24-4-12-1-104 80E9251C20F1C301 # Thu Feb 12 04:24:31 2004 1077926400 0-0-0-28-1-104 0080E7CE8DFDC301 # Sat Feb 28 00:00:00 2004 1078012799 59-59-23-28-1-104 80A9B8F856FEC301 # Sat Feb 28 23:59:59 2004 1078012800 0-0-0-29-1-104 004051F956FEC301 # Sun Feb 29 00:00:00 2004 1080557567 47-52-11-29-2-104 80516A5A8415C401 # Mon Mar 29 11:52:47 2004 1142554623 3-17-0-17-2-106 80E9A51D5849C601 # Fri Mar 17 00:17:03 2006 1144389631 31-0-7-7-3-106 80516AF5105AC601 # Fri Apr 7 07:00:31 2006 1146945535 55-58-20-6-4-106 8051EAE24F71C601 # Sat May 6 20:58:55 2006 1149829119 39-58-5-9-5-106 8051EAC0898BC601 # Fri Jun 9 05:58:39 2006 1183252479 39-14-2-1-6-107 8051EA9385BBC701 # Sun Jul 1 02:14:39 2007 1187643391 31-56-21-20-7-107 80516AF774E3C701 # Mon Aug 20 21:56:31 2007 1210121221 1-47-1-7-4-108 80D8233EE4AFC801 # Wed May 7 01:47:01 2008 1226899455 15-24-5-17-10-108 80E925BB7448C901 # Mon Nov 17 05:24:15 2008 1227227135 35-25-0-21-10-108 80E9A5AB6F4BC901 # Fri Nov 21 00:25:35 2008 1228210175 35-29-9-2-11-108 80E9257D6054C901 # Tue Dec 2 09:29:35 2008 1230767999 59-59-23-31-11-108 80A90EE3A36BC901 # Wed Dec 31 23:59:59 2008 1249116159 39-42-9-1-7-109 80516A688C12CA01 # Sat Aug 1 09:42:39 2009 1257111551 11-39-21-1-10-109 80E9A5BF3B5BCA01 # Sun Nov 1 21:39:11 2009 1271201791 31-36-0-14-3-110 8051EA866ADBCA01 # Wed Apr 14 00:36:31 2010 1288765439 59-23-6-3-10-110 80E925B31F7BCB01 # Wed Nov 3 06:23:59 2010 1294991359 19-49-7-14-0-111 80E9A58CBFB3CB01 # Fri Jan 14 07:49:19 2011 1297219583 23-46-2-9-1-111 80E9A58903C8CB01 # Wed Feb 9 02:46:23 2011 1339162623 3-37-14-8-5-112 80516A2B8445CD01 # Fri Jun 8 14:37:03 2012 1346502655 55-30-13-1-8-112 80516A034688CD01 # Sat Sep 1 13:30:55 2012 1349713919 59-31-17-8-9-112 8051EAD17AA5CD01 # Mon Oct 8 17:31:59 2012 1357119487 7-38-9-2-0-113 80E9A5DECCE8CD01 # Wed Jan 2 09:38:07 2013 1363673087 47-4-6-19-2-113 80E9A5A86724CE01 # Tue Mar 19 06:04:47 2013 1423769599 19-33-19-12-1-115 80E925C1FA46D001 # Thu Feb 12 19:33:19 2015 1502478335 35-5-20-11-7-117 80516A31DD12D301 # Fri Aug 11 20:05:35 2017 1538457599 59-19-6-2-9-118 8051EAF1175AD401 # Tue Oct 2 06:19:59 2018 1557790719 39-38-0-14-4-119 80516A5FED09D501 # Tue May 14 00:38:39 2019 1570963455 15-44-11-13-9-119 8051EA89BB81D501 # Sun Oct 13 11:44:15 2019 1576468479 39-54-3-16-11-119 80E9258AC4B3D501 # Mon Dec 16 03:54:39 2019 1604845567 7-26-14-8-10-120 80E9A518DBB5D601 # Sun Nov 8 14:26:07 2020 1612775423 23-10-9-8-1-121 80E9253BFAFDD601 # Mon Feb 8 09:10:23 2021 1654063103 23-58-6-1-5-122 8051EAFB8475D801 # Wed Jun 1 06:58:23 2022 1681260543 3-49-1-12-3-123 80516AF5E06CD901 # Wed Apr 12 01:49:03 2023 1766588415 15-0-15-24-11-125 80E9A502E674DC01 # Wed Dec 24 15:00:15 2025 1814822911 31-28-22-5-6-127 80516A149F2BDE01 # Mon Jul 5 22:28:31 2027 1820786687 47-4-23-12-8-127 8051EA93DC61DE01 # Sun Sep 12 23:04:47 2027 1824129023 23-30-15-21-9-127 80516A8F4280DE01 # Thu Oct 21 15:30:23 2027 1848377343 3-9-7-28-6-128 80516A14CC5CDF01 # Fri Jul 28 07:09:03 2028 1848770559 39-22-20-1-7-128 80516A9B5F60DF01 # Tue Aug 1 20:22:39 2028 1880883199 19-33-12-8-7-129 80516AAC6F84E001 # Wed Aug 8 12:33:19 2029 1986199551 51-5-10-9-11-132 80E925084042E401 # Thu Dec 9 10:05:51 2032 2029912063 43-27-9-29-3-134 80516A89D8CFE501 # Sat Apr 29 09:27:43 2034 2124873727 7-42-11-2-4-137 8051EA63842FE901 # Sat May 2 11:42:07 2037 2144993279 59-27-7-21-11-137 80E9A57D78E6E901 # Mon Dec 21 07:27:59 2037 OLE-Storage_Lite-0.19/sample/README000644 000765 000024 00000002517 11302630320 016636 0ustar00Johnstaff000000 000000 Files smplls.pl : displays PPS structure of specified file smpadd.pl : appends dummy PPS file to specified file smpsv.pl : saves new OLE file test.xls : Excel file for test addtest.xls: added PPS by smpadd.pl smpadd_a.pl: same as smpadd.pl (in 4 patterns) smplls_a.pl: same as smplls.pl (in 3 patterns) smpaddF.pl : same as smpadd.pl with file feature Example: > perl smplls.pl test.xls 00 1 'Root Entry' (pps 0) ROOT 15.11.1659 00:26:00 01 1 'Workbook' (pps 1) FILE 1000 bytes 02 2 ' SummaryInformation' (pps 2) FILE 1000 bytes 03 3 ' DocumentSummaryInformation' (pps 3) FILE 1000 bytes > perl smpadd.pl test.xls > perl smplls.pl add_test.xls 00 1 'Root Entry' (pps 0) ROOT 15.11.1659 00:26:00 01 1 'Workbook' (pps 3) FILE 1000 bytes 02 2 ' SummaryInformation' (pps 2) FILE 1000 bytes 03 3 ' DocumentSummaryInformation' (pps 1) FILE 1000 bytes 04 4 'Last Added' (pps 5) FILE 6 bytes 05 5 'Length 0' (pps 4) FILE 0 bytes > perl smpadd_a.pl test.xls > stdout.xls > perl smplls_a.pl test.xls ... OLE-Storage_Lite-0.19/sample/smpadd.pl000644 000765 000024 00000001205 11302630320 017554 0ustar00Johnstaff000000 000000 # OLE::Storage_Lite Sample # Name : smpadd.pl # by Kawai, Takanori (Hippo2000) 2000.12.21, 2001.1.4 #================================================================= use strict; use OLE::Storage_Lite; my $oOl = OLE::Storage_Lite->new('test.xls'); my $oPps = $oOl->getPpsTree(1); die( "test.xls must be a OLE file") unless($oPps); my $oF = OLE::Storage_Lite::PPS::File->new( OLE::Storage_Lite::Asc2Ucs('Last Added'), 'ABCDEF'); my $oF2 = OLE::Storage_Lite::PPS::File->new( OLE::Storage_Lite::Asc2Ucs('Length 0'), ''); push @{$oPps->{Child}}, $oF; push @{$oPps->{Child}}, $oF2; $oPps->save('add_test.xls'); OLE-Storage_Lite-0.19/sample/smpadd_a.pl000644 000765 000024 00000001670 11302630320 020062 0ustar00Johnstaff000000 000000 # OLE::Storage_Lite Sample # Name : smpadd.pl # by Kawai, Takanori (Hippo2000) 2000.12.21, 2001.1.4 #================================================================= use strict; use OLE::Storage_Lite; my $oOl = OLE::Storage_Lite->new('test.xls'); my $oPps = $oOl->getPpsTree(1); die( "test.xls must be a OLE file") unless($oPps); my $oF = OLE::Storage_Lite::PPS::File->new( OLE::Storage_Lite::Asc2Ucs('Last Added'), 'ABCDEF'); my $oF2 = OLE::Storage_Lite::PPS::File->new( OLE::Storage_Lite::Asc2Ucs('Length 0'), ''); push @{$oPps->{Child}}, $oF; push @{$oPps->{Child}}, $oF2; #STDOUT #$oPps->save('-'); #FILE $oPps->save('file.xls'); #Scalar my $sData; $sData=''; $oPps->save(\$sData); open OUT, ">scalar.xls"; binmode(OUT); print OUT $sData; close OUT; #IO::File use IO::File; my $oIo = new IO::File; $oIo->open(">iofile.xls"); binmode($oIo); $oPps->save($oIo); OLE-Storage_Lite-0.19/sample/smpaddF.pl000644 000765 000024 00000005570 11302630320 017673 0ustar00Johnstaff000000 000000 # OLE::Storage_Lite Sample # Name : smpadd.pl # by Kawai, Takanori (Hippo2000) 2000.12.21, 2001.1.4, 2001.3.1 #================================================================= use strict; use OLE::Storage_Lite; #0. prepare test file open OUT, ">test.tmp"; print OUT "1234567890"; close OUT; #1. Normal { my $oOl = OLE::Storage_Lite->new('test.xls'); my $oPps = $oOl->getPpsTree(1); die( "test.xls must be a OLE file") unless($oPps); my $oF = OLE::Storage_Lite::PPS::File->new( OLE::Storage_Lite::Asc2Ucs('Add Strting Len 5'), '12345'); my $oF2 = OLE::Storage_Lite::PPS::File->new( OLE::Storage_Lite::Asc2Ucs('Length 0'), ''); push @{$oPps->{Child}}, $oF; push @{$oPps->{Child}}, $oF2; $oPps->save('add_test.xls'); } #2. Tempfile { my $oOl = OLE::Storage_Lite->new('test.xls'); my $oPps = $oOl->getPpsTree(1); die( "test.xls must be a OLE file") unless($oPps); my $oF = OLE::Storage_Lite::PPS::File->newFile( OLE::Storage_Lite::Asc2Ucs('Add tempfile Len 6'), ); my $oF2 = OLE::Storage_Lite::PPS::File->newFile( OLE::Storage_Lite::Asc2Ucs('Length 0'), ''); $oF->append('123456'); push @{$oPps->{Child}}, $oF; push @{$oPps->{Child}}, $oF2; $oPps->save('add_tmp.xls'); } #3. Filename { my $oOl = OLE::Storage_Lite->new('test.xls'); my $oPps = $oOl->getPpsTree(1); die( "test.xls must be a OLE file") unless($oPps); my $oF = OLE::Storage_Lite::PPS::File->newFile( OLE::Storage_Lite::Asc2Ucs('Add filename Len b'), 'test.tmp'); my $oF2 = OLE::Storage_Lite::PPS::File->newFile( OLE::Storage_Lite::Asc2Ucs('Length 0'), ''); $oF->append('a'); push @{$oPps->{Child}}, $oF; push @{$oPps->{Child}}, $oF2; $oPps->save('add_name.xls'); } #4. IO::File { my $oOl = OLE::Storage_Lite->new('test.xls'); my $oPps = $oOl->getPpsTree(1); die( "test.xls must be a OLE file") unless($oPps); my $oFile = new IO::File; $oFile->open('test.tmp', 'r+'); my $oF = OLE::Storage_Lite::PPS::File->newFile( OLE::Storage_Lite::Asc2Ucs('Add IO::File Len c'), $oFile); my $oF2 = OLE::Storage_Lite::PPS::File->newFile( OLE::Storage_Lite::Asc2Ucs('Length 0'), ''); $oF->append('b'); push @{$oPps->{Child}}, $oF; push @{$oPps->{Child}}, $oF2; $oPps->save('add_io.xls'); } #4.1 IO::File(r) { my $oOl = OLE::Storage_Lite->new('test.xls'); my $oPps = $oOl->getPpsTree(1); die( "test.xls must be a OLE file") unless($oPps); my $oFile = new IO::File; $oFile->open('test.tmp', 'r'); my $oF = OLE::Storage_Lite::PPS::File->newFile( OLE::Storage_Lite::Asc2Ucs('Add IO2::File Len c'), $oFile); my $oF2 = OLE::Storage_Lite::PPS::File->newFile( OLE::Storage_Lite::Asc2Ucs('Length 0'), ''); $oF->append('b'); #No Work push @{$oPps->{Child}}, $oF; push @{$oPps->{Child}}, $oF2; $oPps->save('add_io2.xls'); } OLE-Storage_Lite-0.19/sample/smplls.pl000644 000765 000024 00000003237 11302630320 017625 0ustar00Johnstaff000000 000000 # OLE::Storage_Lite Sample # Name : smplls.pl # by Kawai, Takanori (Hippo2000) 2000.11.4 # Displays PPS structure of specified file # Just subset of lls that is distributed with OLE::Storage #================================================================= use strict; use OLE::Storage_Lite; die "No files is specified" if($#ARGV < 0); my $oOl = OLE::Storage_Lite->new($ARGV[0]); my $oPps = $oOl->getPpsTree(); die( $ARGV[0]. " must be a OLE file") unless($oPps); my $iTtl = 0; PrnItem($oPps, 0, \$iTtl, 1); #---------------------------------------------------------------- # PrnItem: Displays PPS infomations #---------------------------------------------------------------- sub PrnItem($$\$$) { my($oPps, $iLvl, $iTtl, $iDir) = @_; my $raDate; my %sPpsName = (1 => 'DIR', 2 => 'FILE', 5=>'ROOT'); # Make Name (including PPS-no and level) my $sName = OLE::Storage_Lite::Ucs2Asc($oPps->{Name}); $sName =~ s/\W/ /g; $sName = sprintf("%s %3d '%s' (pps %x)", ' ' x ($iLvl * 2), $iDir, $sName, $oPps->{No}); # Make Date my $sDate; if($oPps->{Type}==2) { $sDate = sprintf("%10x bytes", $oPps->{Size}); } else { $raDate = $oPps->{Time2nd}; $raDate = $oPps->{Time1st} unless($raDate); $sDate = ($raDate)? sprintf("%02d.%02d.%4d %02d:%02d:%02d", $raDate->[3], $raDate->[4]+1, $raDate->[5]+1900, $raDate->[2], $raDate->[1], $raDate->[0]) : ""; } # Display printf "%02d %-50s %-4s %s\n", ${$iTtl}++, $sName, $sPpsName{$oPps->{Type}}, $sDate; # For its Children my $iDirN=1; foreach my $iItem (@{$oPps->{Child}}) { PrnItem($iItem, $iLvl+1, $iTtl, $iDirN); $iDirN++; } } OLE-Storage_Lite-0.19/sample/smplls_a.pl000644 000765 000024 00000004612 11302630320 020123 0ustar00Johnstaff000000 000000 # OLE::Storage_Lite Sample # Name : smpllsv.pl # by Kawai, Takanori (Hippo2000) 2001.2.2 # Displays PPS structure of specified file (reading it into a variable) # Just subset of lls that is distributed with OLE::Storage #================================================================= use strict; use OLE::Storage_Lite; die "No files is specified" if($#ARGV < 0); #File print "--------------- File\n"; my $oOl = OLE::Storage_Lite->new($ARGV[0]); my $oPps = $oOl->getPpsTree(); die( $ARGV[0]. " must be a OLE file") unless($oPps); my $iTtl = 0; PrnItem($oPps, 0, \$iTtl, 1); #Variable print "--------------- File\n"; open IN, '<'. $ARGV[0]; binmode(IN); my $sBuff; read(IN, $sBuff, -s $ARGV[0]); close IN; $oOl = OLE::Storage_Lite->new(\$sBuff); $oPps = $oOl->getPpsTree(); die( "file.xls must be a OLE file") unless($oPps); $iTtl = 0; PrnItem($oPps, 0, \$iTtl, 1); #IO::File print "--------------- IO::File\n"; use IO::File; my $oIo = new IO::File; $oIo->open('<' . $ARGV[0]); binmode($oIo); $oOl = OLE::Storage_Lite->new($oIo); $oPps = $oOl->getPpsTree(); die( "iofile.xls must be a OLE file") unless($oPps); $iTtl = 0; PrnItem($oPps, 0, \$iTtl, 1); #---------------------------------------------------------------- # PrnItem: Displays PPS infomations #---------------------------------------------------------------- sub PrnItem($$\$$) { my($oPps, $iLvl, $iTtl, $iDir) = @_; my $raDate; my %sPpsName = (1 => 'DIR', 2 => 'FILE', 5=>'ROOT'); # Make Name (including PPS-no and level) my $sName = OLE::Storage_Lite::Ucs2Asc($oPps->{Name}); $sName =~ s/\W/ /g; $sName = sprintf("%s %3d '%s' (pps %x)", ' ' x ($iLvl * 2), $iDir, $sName, $oPps->{No}); # Make Date my $sDate; if($oPps->{Type}==2) { $sDate = sprintf("%10x bytes", $oPps->{Size}); } else { $raDate = $oPps->{Time2nd}; $raDate = $oPps->{Time1st} unless($raDate); $sDate = ($raDate)? sprintf("%02d.%02d.%4d %02d:%02d:%02d", $raDate->[3], $raDate->[4]+1, $raDate->[5]+1900, $raDate->[2], $raDate->[1], $raDate->[0]) : ""; } # Display printf "%02d %-50s %-4s %s\n", ${$iTtl}++, $sName, $sPpsName{$oPps->{Type}}, $sDate; # For its Children my $iDirN=1; foreach my $iItem (@{$oPps->{Child}}) { PrnItem($iItem, $iLvl+1, $iTtl, $iDirN); $iDirN++; } } OLE-Storage_Lite-0.19/sample/smpsv.pl000644 000765 000024 00000002752 11302630320 017464 0ustar00Johnstaff000000 000000 # OLE::Storage_Lite Sample # Name : smpsv.pl # by Kawai, Takanori (Hippo2000) 2000.11.8 # Just save sample OLE_File(tsv.dat) =execute sample # perl smplls.pl tsave.dat 00 1 'RootEntry' (pps 0) ROOT 04.11.2000 16:00:00 01 1 'Workbook' (pps 2) FILE 6 bytes 02 2 'Dir' (pps 1) DIR 04.11.2000 03:50:01 03 1 'File_2' (pps 4) FILE 1000 bytes 04 2 'File_3' (pps 3) FILE 100 bytes 05 3 'File_4' (pps 5) FILE 100 bytes =cut #================================================================= use strict; use OLE::Storage_Lite; my @aL = localtime(); splice(@aL, 6); my $oF = OLE::Storage_Lite::PPS::File->new( OLE::Storage_Lite::Asc2Ucs('Workbook'), 'ABCDEF'); my $oF2 = OLE::Storage_Lite::PPS::File->new( OLE::Storage_Lite::Asc2Ucs('File_2'), 'A'x 0x1000); my $oF3 = OLE::Storage_Lite::PPS::File->new( OLE::Storage_Lite::Asc2Ucs('File_3'), 'B'x 0x100); my $oF4 = OLE::Storage_Lite::PPS::File->new( OLE::Storage_Lite::Asc2Ucs('File_4'), 'C'x 0x100); my $oD = OLE::Storage_Lite::PPS::Dir->new( OLE::Storage_Lite::Asc2Ucs('Dir'), \@aL, \@aL, [$oF2, $oF3, $oF4]); my $oDt = OLE::Storage_Lite::PPS::Root->new( undef, [0, 0, 16, 4, 10, 100], #2000/11/4 16:00:00:0000 [$oF, $oD]); my $raW = $oDt->{Child}; $oDt->save("tsv.dat"); OLE-Storage_Lite-0.19/sample/test.xls000644 000765 000024 00000033000 11302630320 017454 0ustar00Johnstaff000000 000000 аЯрЁБс>ўџ ўџџџўџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџ шЬЩсАСт\pkawait BАa=œЏМ=№x”>0*8X@"Зк1 мџ€-џ3џ 0џД0З0У0Џ01 мџ€-џ3џ 0џД0З0У0Џ01 мџ€-џ3џ 0џД0З0У0Џ01 мџ€-џ3џ 0џД0З0У0Џ01 xџ€-џ3џ 0џД0З0У0Џ0"\"#,##0;"\"\-#,##0"\"#,##0;[Red]"\"\-#,##0"\"#,##0.00;"\"\-#,##0.00#"\"#,##0.00;[Red]"\"\-#,##0.007*2_ "\"* #,##0_ ;_ "\"* \-#,##0_ ;_ "\"* "-"_ ;_ @_ .))_ * #,##0_ ;_ * \-#,##0_ ;_ * "-"_ ;_ @_ ?,:_ "\"* #,##0.00_ ;_ "\"* \-#,##0.00_ ;_ "\"* "-"??_ ;_ @_ 6+1_ * #,##0.00_ ;_ * \-#,##0.00_ ;_ * "-"??_ ;_ @_ \$#,##0_);\(\$#,##0\)\$#,##0_);[Red]\(\$#,##0\) \$#,##0.00_);\(\$#,##0.00\)% \$#,##0.00_);[Red]\(\$#,##0.00\)рѕџ Р рѕџ єР рѕџ єР рѕџ єР рѕџ єР рѕџ єР рѕџ єР рѕџ єР рѕџ єР рѕџ єР рѕџ єР рѕџ єР рѕџ єР рѕџ єР рѕџ єР р Р р ѕџ јР р&ѕџ јР р(ѕџ јР рѕџ јР рѕџ јР “€џ“€џ“€џ“€џ“€џ“€џ`…< Sheet1ŒQQќ, ADD INFO Data 5џ CХpPХ((ХHP—i\Х,џ0Лџџџџ Ahy-p0: Ч Чˆ ƒьХƒiˆџџџч ƒˆ! 0’ ^Кw}ТwаВТwаВ’зџџџџ ƒy-p0ˆ+p06 ЧЧШЦXЦџџц!! 04 Ч№—V0ФЦ–nЩ0Х0Ћ$l0Іе0Щ0n0Щ0@л06 ЧЧ4 Ч–n6 ЧЩЂ0ЧЧџџџџ]г06 ЧЧџџџџРЧDЩj–n[0.00]]Тг0œЧЖW0pW0 П0бО0rW0#)% —F€аЧ'Щ0)pW0ќ—€ќ€% —0Ш…Ч0 меpШ`!W0`%W0t—`Ш`АџxПphкpџџџџ\ШиyВw`!W0€Ш`!W0ќХ0tШ€„0C`!W0€ШШ`%W0VЩ˜ШиФ0`!W0`!W0œФ0`!W0`%W0VЩœЧDЩрЩDЩŒЦ—,Щфв0ŒЦ шЬЩ ( b  dќЉёвMbP?_*+‚€%Сƒ„M,EPSON PM-800C`мN‹ š 4dhh4š Д***Ц  qhhDLLName32=e_du01jj.dll L dL 2џEPSON PM-800CЁ" dќЉёвMbр?ќЉёвMbр?Us§ з">Ж@я5 ўџр…ŸђљOhЋ‘+'Гй0Œ8@P` x„ЄkawaitkawaitMicrosoft Excel@€чщПqjРўџеЭеœ.“—+,љЎDеЭеœ.“—+,љЎа PXt |„Œ” œ ЏЄ“њ–{ƒ‰ƒbƒhŠ”ŽЎ‰яŽаш Sheet1 мАИМАФ˜ 6> _PID_GUIDЄAN{4A7C3150-D665-11D4-96CB-0090CC001ADF}ўџџџ ўџџџўџџџ§џџџўџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџRoot Entryc:\PrTEaXXles\Micrџџџџџџџџ РFo\VC‰О–бЁРўџџџ:\Workbookssl-0.9.4\out32dll;C:\Pџџџџџџџџџџџџiles\InstallShieldtaSummaryInformationional Editio(џџџџm; -l0  РРРР  DocumentSummaryInformation€p€p8џџџџџџџџџџџџААААААААААААААААААААOLE-Storage_Lite-0.19/lib/OLE/000755 000765 000024 00000000000 11303065342 015664 5ustar00Johnstaff000000 000000 OLE-Storage_Lite-0.19/lib/OLE/Storage_Lite.pm000644 000765 000024 00000155345 11303065150 020615 0ustar00Johnstaff000000 000000 # OLE::Storage_Lite # by Kawai, Takanori (Hippo2000) 2000.11.4, 8, 14 # This Program is Still ALPHA version. #////////////////////////////////////////////////////////////////////////////// # OLE::Storage_Lite::PPS Object #////////////////////////////////////////////////////////////////////////////// #============================================================================== # OLE::Storage_Lite::PPS #============================================================================== package OLE::Storage_Lite::PPS; require Exporter; use strict; use vars qw($VERSION @ISA); @ISA = qw(Exporter); $VERSION = '0.19'; #------------------------------------------------------------------------------ # new (OLE::Storage_Lite::PPS) #------------------------------------------------------------------------------ sub new ($$$$$$$$$$;$$) { #1. Constructor for General Usage my($sClass, $iNo, $sNm, $iType, $iPrev, $iNext, $iDir, $raTime1st, $raTime2nd, $iStart, $iSize, $sData, $raChild) = @_; if($iType == OLE::Storage_Lite::PpsType_File()) { #FILE return OLE::Storage_Lite::PPS::File->_new ($iNo, $sNm, $iType, $iPrev, $iNext, $iDir, $raTime1st, $raTime2nd, $iStart, $iSize, $sData, $raChild); } elsif($iType == OLE::Storage_Lite::PpsType_Dir()) { #DIRECTRY return OLE::Storage_Lite::PPS::Dir->_new ($iNo, $sNm, $iType, $iPrev, $iNext, $iDir, $raTime1st, $raTime2nd, $iStart, $iSize, $sData, $raChild); } elsif($iType == OLE::Storage_Lite::PpsType_Root()) { #ROOT return OLE::Storage_Lite::PPS::Root->_new ($iNo, $sNm, $iType, $iPrev, $iNext, $iDir, $raTime1st, $raTime2nd, $iStart, $iSize, $sData, $raChild); } else { die "Error PPS:$iType $sNm\n"; } } #------------------------------------------------------------------------------ # _new (OLE::Storage_Lite::PPS) # for OLE::Storage_Lite #------------------------------------------------------------------------------ sub _new ($$$$$$$$$$$;$$) { my($sClass, $iNo, $sNm, $iType, $iPrev, $iNext, $iDir, $raTime1st, $raTime2nd, $iStart, $iSize, $sData, $raChild) = @_; #1. Constructor for OLE::Storage_Lite my $oThis = { No => $iNo, Name => $sNm, Type => $iType, PrevPps => $iPrev, NextPps => $iNext, DirPps => $iDir, Time1st => $raTime1st, Time2nd => $raTime2nd, StartBlock => $iStart, Size => $iSize, Data => $sData, Child => $raChild, }; bless $oThis, $sClass; return $oThis; } #------------------------------------------------------------------------------ # _DataLen (OLE::Storage_Lite::PPS) # Check for update #------------------------------------------------------------------------------ sub _DataLen($) { my($oSelf) =@_; return 0 unless(defined($oSelf->{Data})); return ($oSelf->{_PPS_FILE})? ($oSelf->{_PPS_FILE}->stat())[7] : length($oSelf->{Data}); } #------------------------------------------------------------------------------ # _makeSmallData (OLE::Storage_Lite::PPS) #------------------------------------------------------------------------------ sub _makeSmallData($$$) { my($oThis, $aList, $rhInfo) = @_; my ($sRes); my $FILE = $rhInfo->{_FILEH_}; my $iSmBlk = 0; foreach my $oPps (@$aList) { #1. Make SBD, small data string if($oPps->{Type}==OLE::Storage_Lite::PpsType_File()) { next if($oPps->{Size}<=0); if($oPps->{Size} < $rhInfo->{_SMALL_SIZE}) { my $iSmbCnt = int($oPps->{Size} / $rhInfo->{_SMALL_BLOCK_SIZE}) + (($oPps->{Size} % $rhInfo->{_SMALL_BLOCK_SIZE})? 1: 0); #1.1 Add to SBD for (my $i = 0; $i<($iSmbCnt-1); $i++) { print {$FILE} (pack("V", $i+$iSmBlk+1)); } print {$FILE} (pack("V", -2)); #1.2 Add to Data String(this will be written for RootEntry) #Check for update if($oPps->{_PPS_FILE}) { my $sBuff; $oPps->{_PPS_FILE}->seek(0, 0); #To The Top while($oPps->{_PPS_FILE}->read($sBuff, 4096)) { $sRes .= $sBuff; } } else { $sRes .= $oPps->{Data}; } $sRes .= ("\x00" x ($rhInfo->{_SMALL_BLOCK_SIZE} - ($oPps->{Size}% $rhInfo->{_SMALL_BLOCK_SIZE}))) if($oPps->{Size}% $rhInfo->{_SMALL_BLOCK_SIZE}); #1.3 Set for PPS $oPps->{StartBlock} = $iSmBlk; $iSmBlk += $iSmbCnt; } } } my $iSbCnt = int($rhInfo->{_BIG_BLOCK_SIZE}/ OLE::Storage_Lite::LongIntSize()); print {$FILE} (pack("V", -1) x ($iSbCnt - ($iSmBlk % $iSbCnt))) if($iSmBlk % $iSbCnt); #2. Write SBD with adjusting length for block return $sRes; } #------------------------------------------------------------------------------ # _savePpsWk (OLE::Storage_Lite::PPS) #------------------------------------------------------------------------------ sub _savePpsWk($$) { my($oThis, $rhInfo) = @_; #1. Write PPS my $FILE = $rhInfo->{_FILEH_}; print {$FILE} ( $oThis->{Name} . ("\x00" x (64 - length($oThis->{Name}))) #64 , pack("v", length($oThis->{Name}) + 2) #66 , pack("c", $oThis->{Type}) #67 , pack("c", 0x00) #UK #68 , pack("V", $oThis->{PrevPps}) #Prev #72 , pack("V", $oThis->{NextPps}) #Next #76 , pack("V", $oThis->{DirPps}) #Dir #80 , "\x00\x09\x02\x00" #84 , "\x00\x00\x00\x00" #88 , "\xc0\x00\x00\x00" #92 , "\x00\x00\x00\x46" #96 , "\x00\x00\x00\x00" #100 , OLE::Storage_Lite::LocalDate2OLE($oThis->{Time1st}) #108 , OLE::Storage_Lite::LocalDate2OLE($oThis->{Time2nd}) #116 , pack("V", defined($oThis->{StartBlock})? $oThis->{StartBlock}:0) #116 , pack("V", defined($oThis->{Size})? $oThis->{Size} : 0) #124 , pack("V", 0), #128 ); } #////////////////////////////////////////////////////////////////////////////// # OLE::Storage_Lite::PPS::Root Object #////////////////////////////////////////////////////////////////////////////// #============================================================================== # OLE::Storage_Lite::PPS::Root #============================================================================== package OLE::Storage_Lite::PPS::Root; require Exporter; use strict; use IO::File; use IO::Handle; use Fcntl; use vars qw($VERSION @ISA); @ISA = qw(OLE::Storage_Lite::PPS Exporter); $VERSION = '0.19'; sub _savePpsSetPnt($$$); sub _savePpsSetPnt2($$$); #------------------------------------------------------------------------------ # new (OLE::Storage_Lite::PPS::Root) #------------------------------------------------------------------------------ sub new ($;$$$) { my($sClass, $raTime1st, $raTime2nd, $raChild) = @_; OLE::Storage_Lite::PPS::_new( $sClass, undef, OLE::Storage_Lite::Asc2Ucs('Root Entry'), 5, undef, undef, undef, $raTime1st, $raTime2nd, undef, undef, undef, $raChild); } #------------------------------------------------------------------------------ # save (OLE::Storage_Lite::PPS::Root) #------------------------------------------------------------------------------ sub save($$;$$) { my($oThis, $sFile, $bNoAs, $rhInfo) = @_; #0.Initial Setting for saving $rhInfo = {} unless($rhInfo); $rhInfo->{_BIG_BLOCK_SIZE} = 2** (($rhInfo->{_BIG_BLOCK_SIZE})? _adjust2($rhInfo->{_BIG_BLOCK_SIZE}) : 9); $rhInfo->{_SMALL_BLOCK_SIZE}= 2 ** (($rhInfo->{_SMALL_BLOCK_SIZE})? _adjust2($rhInfo->{_SMALL_BLOCK_SIZE}): 6); $rhInfo->{_SMALL_SIZE} = 0x1000; $rhInfo->{_PPS_SIZE} = 0x80; my $closeFile = 1; #1.Open File #1.1 $sFile is Ref of scalar if(ref($sFile) eq 'SCALAR') { require IO::Scalar; my $oIo = new IO::Scalar $sFile, O_WRONLY; $rhInfo->{_FILEH_} = $oIo; } #1.1.1 $sFile is a IO::Scalar object # Now handled as a filehandle ref below. #1.2 $sFile is a IO::Handle object elsif(UNIVERSAL::isa($sFile, 'IO::Handle')) { # Not all filehandles support binmode() so try it in an eval. eval{ binmode $sFile }; $rhInfo->{_FILEH_} = $sFile; } #1.3 $sFile is a simple filename string elsif(!ref($sFile)) { if($sFile ne '-') { my $oIo = new IO::File; $oIo->open(">$sFile") || return undef; binmode($oIo); $rhInfo->{_FILEH_} = $oIo; } else { my $oIo = new IO::Handle; $oIo->fdopen(fileno(STDOUT),"w") || return undef; binmode($oIo); $rhInfo->{_FILEH_} = $oIo; } } #1.4 Assume that if $sFile is a ref then it is a valid filehandle else { # Not all filehandles support binmode() so try it in an eval. eval{ binmode $sFile }; $rhInfo->{_FILEH_} = $sFile; # Caller controls filehandle closing $closeFile = 0; } my $iBlk = 0; #1. Make an array of PPS (for Save) my @aList=(); if($bNoAs) { _savePpsSetPnt2([$oThis], \@aList, $rhInfo); } else { _savePpsSetPnt([$oThis], \@aList, $rhInfo); } my ($iSBDcnt, $iBBcnt, $iPPScnt) = $oThis->_calcSize(\@aList, $rhInfo); #2.Save Header $oThis->_saveHeader($rhInfo, $iSBDcnt, $iBBcnt, $iPPScnt); #3.Make Small Data string (write SBD) my $sSmWk = $oThis->_makeSmallData(\@aList, $rhInfo); $oThis->{Data} = $sSmWk; #Small Datas become RootEntry Data #4. Write BB my $iBBlk = $iSBDcnt; $oThis->_saveBigData(\$iBBlk, \@aList, $rhInfo); #5. Write PPS $oThis->_savePps(\@aList, $rhInfo); #6. Write BD and BDList and Adding Header informations $oThis->_saveBbd($iSBDcnt, $iBBcnt, $iPPScnt, $rhInfo); #7.Close File return $rhInfo->{_FILEH_}->close if $closeFile; } #------------------------------------------------------------------------------ # _calcSize (OLE::Storage_Lite::PPS) #------------------------------------------------------------------------------ sub _calcSize($$) { my($oThis, $raList, $rhInfo) = @_; #0. Calculate Basic Setting my ($iSBDcnt, $iBBcnt, $iPPScnt) = (0,0,0); my $iSmallLen = 0; my $iSBcnt = 0; foreach my $oPps (@$raList) { if($oPps->{Type}==OLE::Storage_Lite::PpsType_File()) { $oPps->{Size} = $oPps->_DataLen(); #Mod if($oPps->{Size} < $rhInfo->{_SMALL_SIZE}) { $iSBcnt += int($oPps->{Size} / $rhInfo->{_SMALL_BLOCK_SIZE}) + (($oPps->{Size} % $rhInfo->{_SMALL_BLOCK_SIZE})? 1: 0); } else { $iBBcnt += (int($oPps->{Size}/ $rhInfo->{_BIG_BLOCK_SIZE}) + (($oPps->{Size}% $rhInfo->{_BIG_BLOCK_SIZE})? 1: 0)); } } } $iSmallLen = $iSBcnt * $rhInfo->{_SMALL_BLOCK_SIZE}; my $iSlCnt = int($rhInfo->{_BIG_BLOCK_SIZE}/ OLE::Storage_Lite::LongIntSize()); $iSBDcnt = int($iSBcnt / $iSlCnt)+ (($iSBcnt % $iSlCnt)? 1:0); $iBBcnt += (int($iSmallLen/ $rhInfo->{_BIG_BLOCK_SIZE}) + (( $iSmallLen% $rhInfo->{_BIG_BLOCK_SIZE})? 1: 0)); my $iCnt = scalar(@$raList); my $iBdCnt = $rhInfo->{_BIG_BLOCK_SIZE}/OLE::Storage_Lite::PpsSize(); $iPPScnt = (int($iCnt/$iBdCnt) + (($iCnt % $iBdCnt)? 1: 0)); return ($iSBDcnt, $iBBcnt, $iPPScnt); } #------------------------------------------------------------------------------ # _adjust2 (OLE::Storage_Lite::PPS::Root) #------------------------------------------------------------------------------ sub _adjust2($) { my($i2) = @_; my $iWk; $iWk = log($i2)/log(2); return ($iWk > int($iWk))? int($iWk)+1:$iWk; } #------------------------------------------------------------------------------ # _saveHeader (OLE::Storage_Lite::PPS::Root) #------------------------------------------------------------------------------ sub _saveHeader($$$$$) { my($oThis, $rhInfo, $iSBDcnt, $iBBcnt, $iPPScnt) = @_; my $FILE = $rhInfo->{_FILEH_}; #0. Calculate Basic Setting my $iBlCnt = $rhInfo->{_BIG_BLOCK_SIZE} / OLE::Storage_Lite::LongIntSize(); my $i1stBdL = int(($rhInfo->{_BIG_BLOCK_SIZE} - 0x4C) / OLE::Storage_Lite::LongIntSize()); my $i1stBdMax = $i1stBdL * $iBlCnt - $i1stBdL; my $iBdExL = 0; my $iAll = $iBBcnt + $iPPScnt + $iSBDcnt; my $iAllW = $iAll; my $iBdCntW = int($iAllW / $iBlCnt) + (($iAllW % $iBlCnt)? 1: 0); my $iBdCnt = int(($iAll + $iBdCntW) / $iBlCnt) + ((($iAllW+$iBdCntW) % $iBlCnt)? 1: 0); my $i; if ($iBdCnt > $i1stBdL) { #0.1 Calculate BD count $iBlCnt--; #the BlCnt is reduced in the count of the last sect is used for a pointer the next Bl my $iBBleftover = $iAll - $i1stBdMax; if ($iAll >$i1stBdMax) { while(1) { $iBdCnt = int(($iBBleftover) / $iBlCnt) + ((($iBBleftover) % $iBlCnt)? 1: 0); $iBdExL = int(($iBdCnt) / $iBlCnt) + ((($iBdCnt) % $iBlCnt)? 1: 0); $iBBleftover = $iBBleftover + $iBdExL; last if($iBdCnt == (int(($iBBleftover) / $iBlCnt) + ((($iBBleftover) % $iBlCnt)? 1: 0))); } } $iBdCnt += $i1stBdL; #print "iBdCnt = $iBdCnt \n"; } #1.Save Header print {$FILE} ( "\xD0\xCF\x11\xE0\xA1\xB1\x1A\xE1" , "\x00\x00\x00\x00" x 4 , pack("v", 0x3b) , pack("v", 0x03) , pack("v", -2) , pack("v", 9) , pack("v", 6) , pack("v", 0) , "\x00\x00\x00\x00" x 2 , pack("V", $iBdCnt), , pack("V", $iBBcnt+$iSBDcnt), #ROOT START , pack("V", 0) , pack("V", 0x1000) , pack("V", $iSBDcnt ? 0 : -2) #Small Block Depot , pack("V", $iSBDcnt) ); #2. Extra BDList Start, Count if($iAll <= $i1stBdMax) { print {$FILE} ( pack("V", -2), #Extra BDList Start pack("V", 0), #Extra BDList Count ); } else { print {$FILE} ( pack("V", $iAll+$iBdCnt), pack("V", $iBdExL), ); } #3. BDList for($i=0; $i<$i1stBdL and $i < $iBdCnt; $i++) { print {$FILE} (pack("V", $iAll+$i)); } print {$FILE} ((pack("V", -1)) x($i1stBdL-$i)) if($i<$i1stBdL); } #------------------------------------------------------------------------------ # _saveBigData (OLE::Storage_Lite::PPS) #------------------------------------------------------------------------------ sub _saveBigData($$$$) { my($oThis, $iStBlk, $raList, $rhInfo) = @_; my $iRes = 0; my $FILE = $rhInfo->{_FILEH_}; #1.Write Big (ge 0x1000) Data into Block foreach my $oPps (@$raList) { if($oPps->{Type}!=OLE::Storage_Lite::PpsType_Dir()) { #print "PPS: $oPps DEF:", defined($oPps->{Data}), "\n"; $oPps->{Size} = $oPps->_DataLen(); #Mod if(($oPps->{Size} >= $rhInfo->{_SMALL_SIZE}) || (($oPps->{Type} == OLE::Storage_Lite::PpsType_Root()) && defined($oPps->{Data}))) { #1.1 Write Data #Check for update if($oPps->{_PPS_FILE}) { my $sBuff; my $iLen = 0; $oPps->{_PPS_FILE}->seek(0, 0); #To The Top while($oPps->{_PPS_FILE}->read($sBuff, 4096)) { $iLen += length($sBuff); print {$FILE} ($sBuff); #Check for update } } else { print {$FILE} ($oPps->{Data}); } print {$FILE} ( "\x00" x ($rhInfo->{_BIG_BLOCK_SIZE} - ($oPps->{Size} % $rhInfo->{_BIG_BLOCK_SIZE})) ) if ($oPps->{Size} % $rhInfo->{_BIG_BLOCK_SIZE}); #1.2 Set For PPS $oPps->{StartBlock} = $$iStBlk; $$iStBlk += (int($oPps->{Size}/ $rhInfo->{_BIG_BLOCK_SIZE}) + (($oPps->{Size}% $rhInfo->{_BIG_BLOCK_SIZE})? 1: 0)); } } } } #------------------------------------------------------------------------------ # _savePps (OLE::Storage_Lite::PPS::Root) #------------------------------------------------------------------------------ sub _savePps($$$) { my($oThis, $raList, $rhInfo) = @_; #0. Initial my $FILE = $rhInfo->{_FILEH_}; #2. Save PPS foreach my $oItem (@$raList) { $oItem->_savePpsWk($rhInfo); } #3. Adjust for Block my $iCnt = scalar(@$raList); my $iBCnt = $rhInfo->{_BIG_BLOCK_SIZE} / $rhInfo->{_PPS_SIZE}; print {$FILE} ("\x00" x (($iBCnt - ($iCnt % $iBCnt)) * $rhInfo->{_PPS_SIZE})) if($iCnt % $iBCnt); return int($iCnt / $iBCnt) + (($iCnt % $iBCnt)? 1: 0); } #------------------------------------------------------------------------------ # _savePpsSetPnt2 (OLE::Storage_Lite::PPS::Root) # For Test #------------------------------------------------------------------------------ sub _savePpsSetPnt2($$$) { my($aThis, $raList, $rhInfo) = @_; #1. make Array as Children-Relations #1.1 if No Children if($#$aThis < 0) { return 0xFFFFFFFF; } elsif($#$aThis == 0) { #1.2 Just Only one push @$raList, $aThis->[0]; $aThis->[0]->{No} = $#$raList; $aThis->[0]->{PrevPps} = 0xFFFFFFFF; $aThis->[0]->{NextPps} = 0xFFFFFFFF; $aThis->[0]->{DirPps} = _savePpsSetPnt2($aThis->[0]->{Child}, $raList, $rhInfo); return $aThis->[0]->{No}; } else { #1.3 Array my $iCnt = $#$aThis + 1; #1.3.1 Define Center my $iPos = 0; #int($iCnt/ 2); #$iCnt my @aWk = @$aThis; my @aPrev = ($#$aThis > 1)? splice(@aWk, 1, 1) : (); #$iPos); my @aNext = splice(@aWk, 1); #, $iCnt - $iPos -1); $aThis->[$iPos]->{PrevPps} = _savePpsSetPnt2( \@aPrev, $raList, $rhInfo); push @$raList, $aThis->[$iPos]; $aThis->[$iPos]->{No} = $#$raList; #1.3.2 Devide a array into Previous,Next $aThis->[$iPos]->{NextPps} = _savePpsSetPnt2( \@aNext, $raList, $rhInfo); $aThis->[$iPos]->{DirPps} = _savePpsSetPnt2($aThis->[$iPos]->{Child}, $raList, $rhInfo); return $aThis->[$iPos]->{No}; } } #------------------------------------------------------------------------------ # _savePpsSetPnt2 (OLE::Storage_Lite::PPS::Root) # For Test #------------------------------------------------------------------------------ sub _savePpsSetPnt2s($$$) { my($aThis, $raList, $rhInfo) = @_; #1. make Array as Children-Relations #1.1 if No Children if($#$aThis < 0) { return 0xFFFFFFFF; } elsif($#$aThis == 0) { #1.2 Just Only one push @$raList, $aThis->[0]; $aThis->[0]->{No} = $#$raList; $aThis->[0]->{PrevPps} = 0xFFFFFFFF; $aThis->[0]->{NextPps} = 0xFFFFFFFF; $aThis->[0]->{DirPps} = _savePpsSetPnt2($aThis->[0]->{Child}, $raList, $rhInfo); return $aThis->[0]->{No}; } else { #1.3 Array my $iCnt = $#$aThis + 1; #1.3.1 Define Center my $iPos = 0; #int($iCnt/ 2); #$iCnt push @$raList, $aThis->[$iPos]; $aThis->[$iPos]->{No} = $#$raList; my @aWk = @$aThis; #1.3.2 Devide a array into Previous,Next my @aPrev = splice(@aWk, 0, $iPos); my @aNext = splice(@aWk, 1, $iCnt - $iPos -1); $aThis->[$iPos]->{PrevPps} = _savePpsSetPnt2( \@aPrev, $raList, $rhInfo); $aThis->[$iPos]->{NextPps} = _savePpsSetPnt2( \@aNext, $raList, $rhInfo); $aThis->[$iPos]->{DirPps} = _savePpsSetPnt2($aThis->[$iPos]->{Child}, $raList, $rhInfo); return $aThis->[$iPos]->{No}; } } #------------------------------------------------------------------------------ # _savePpsSetPnt (OLE::Storage_Lite::PPS::Root) #------------------------------------------------------------------------------ sub _savePpsSetPnt($$$) { my($aThis, $raList, $rhInfo) = @_; #1. make Array as Children-Relations #1.1 if No Children if($#$aThis < 0) { return 0xFFFFFFFF; } elsif($#$aThis == 0) { #1.2 Just Only one push @$raList, $aThis->[0]; $aThis->[0]->{No} = $#$raList; $aThis->[0]->{PrevPps} = 0xFFFFFFFF; $aThis->[0]->{NextPps} = 0xFFFFFFFF; $aThis->[0]->{DirPps} = _savePpsSetPnt($aThis->[0]->{Child}, $raList, $rhInfo); return $aThis->[0]->{No}; } else { #1.3 Array my $iCnt = $#$aThis + 1; #1.3.1 Define Center my $iPos = int($iCnt/ 2); #$iCnt push @$raList, $aThis->[$iPos]; $aThis->[$iPos]->{No} = $#$raList; my @aWk = @$aThis; #1.3.2 Devide a array into Previous,Next my @aPrev = splice(@aWk, 0, $iPos); my @aNext = splice(@aWk, 1, $iCnt - $iPos -1); $aThis->[$iPos]->{PrevPps} = _savePpsSetPnt( \@aPrev, $raList, $rhInfo); $aThis->[$iPos]->{NextPps} = _savePpsSetPnt( \@aNext, $raList, $rhInfo); $aThis->[$iPos]->{DirPps} = _savePpsSetPnt($aThis->[$iPos]->{Child}, $raList, $rhInfo); return $aThis->[$iPos]->{No}; } } #------------------------------------------------------------------------------ # _savePpsSetPnt (OLE::Storage_Lite::PPS::Root) #------------------------------------------------------------------------------ sub _savePpsSetPnt1($$$) { my($aThis, $raList, $rhInfo) = @_; #1. make Array as Children-Relations #1.1 if No Children if($#$aThis < 0) { return 0xFFFFFFFF; } elsif($#$aThis == 0) { #1.2 Just Only one push @$raList, $aThis->[0]; $aThis->[0]->{No} = $#$raList; $aThis->[0]->{PrevPps} = 0xFFFFFFFF; $aThis->[0]->{NextPps} = 0xFFFFFFFF; $aThis->[0]->{DirPps} = _savePpsSetPnt($aThis->[0]->{Child}, $raList, $rhInfo); return $aThis->[0]->{No}; } else { #1.3 Array my $iCnt = $#$aThis + 1; #1.3.1 Define Center my $iPos = int($iCnt/ 2); #$iCnt push @$raList, $aThis->[$iPos]; $aThis->[$iPos]->{No} = $#$raList; my @aWk = @$aThis; #1.3.2 Devide a array into Previous,Next my @aPrev = splice(@aWk, 0, $iPos); my @aNext = splice(@aWk, 1, $iCnt - $iPos -1); $aThis->[$iPos]->{PrevPps} = _savePpsSetPnt( \@aPrev, $raList, $rhInfo); $aThis->[$iPos]->{NextPps} = _savePpsSetPnt( \@aNext, $raList, $rhInfo); $aThis->[$iPos]->{DirPps} = _savePpsSetPnt($aThis->[$iPos]->{Child}, $raList, $rhInfo); return $aThis->[$iPos]->{No}; } } #------------------------------------------------------------------------------ # _saveBbd (OLE::Storage_Lite) #------------------------------------------------------------------------------ sub _saveBbd($$$$) { my($oThis, $iSbdSize, $iBsize, $iPpsCnt, $rhInfo) = @_; my $FILE = $rhInfo->{_FILEH_}; #0. Calculate Basic Setting my $iBbCnt = $rhInfo->{_BIG_BLOCK_SIZE} / OLE::Storage_Lite::LongIntSize(); my $iBlCnt = $iBbCnt - 1; my $i1stBdL = int(($rhInfo->{_BIG_BLOCK_SIZE} - 0x4C) / OLE::Storage_Lite::LongIntSize()); my $i1stBdMax = $i1stBdL * $iBbCnt - $i1stBdL; my $iBdExL = 0; my $iAll = $iBsize + $iPpsCnt + $iSbdSize; my $iAllW = $iAll; my $iBdCntW = int($iAllW / $iBbCnt) + (($iAllW % $iBbCnt)? 1: 0); my $iBdCnt = 0; my $i; #0.1 Calculate BD count my $iBBleftover = $iAll - $i1stBdMax; if ($iAll >$i1stBdMax) { while(1) { $iBdCnt = int(($iBBleftover) / $iBlCnt) + ((($iBBleftover) % $iBlCnt)? 1: 0); $iBdExL = int(($iBdCnt) / $iBlCnt) + ((($iBdCnt) % $iBlCnt)? 1: 0); $iBBleftover = $iBBleftover + $iBdExL; last if($iBdCnt == (int(($iBBleftover) / $iBlCnt) + ((($iBBleftover) % $iBlCnt)? 1: 0))); } } $iAllW += $iBdExL; $iBdCnt += $i1stBdL; #print "iBdCnt = $iBdCnt \n"; #1. Making BD #1.1 Set for SBD if($iSbdSize > 0) { for ($i = 0; $i<($iSbdSize-1); $i++) { print {$FILE} (pack("V", $i+1)); } print {$FILE} (pack("V", -2)); } #1.2 Set for B for ($i = 0; $i<($iBsize-1); $i++) { print {$FILE} (pack("V", $i+$iSbdSize+1)); } print {$FILE} (pack("V", -2)); #1.3 Set for PPS for ($i = 0; $i<($iPpsCnt-1); $i++) { print {$FILE} (pack("V", $i+$iSbdSize+$iBsize+1)); } print {$FILE} (pack("V", -2)); #1.4 Set for BBD itself ( 0xFFFFFFFD : BBD) for($i=0; $i<$iBdCnt;$i++) { print {$FILE} (pack("V", 0xFFFFFFFD)); } #1.5 Set for ExtraBDList for($i=0; $i<$iBdExL;$i++) { print {$FILE} (pack("V", 0xFFFFFFFC)); } #1.6 Adjust for Block print {$FILE} (pack("V", -1) x ($iBbCnt - (($iAllW + $iBdCnt) % $iBbCnt))) if(($iAllW + $iBdCnt) % $iBbCnt); #2.Extra BDList if($iBdCnt > $i1stBdL) { my $iN=0; my $iNb=0; for($i=$i1stBdL;$i<$iBdCnt; $i++, $iN++) { if($iN>=($iBbCnt-1)) { $iN = 0; $iNb++; print {$FILE} (pack("V", $iAll+$iBdCnt+$iNb)); } print {$FILE} (pack("V", $iBsize+$iSbdSize+$iPpsCnt+$i)); } print {$FILE} (pack("V", -1) x (($iBbCnt-1) - (($iBdCnt-$i1stBdL) % ($iBbCnt-1)))) if(($iBdCnt-$i1stBdL) % ($iBbCnt-1)); print {$FILE} (pack("V", -2)); } } #////////////////////////////////////////////////////////////////////////////// # OLE::Storage_Lite::PPS::File Object #////////////////////////////////////////////////////////////////////////////// #============================================================================== # OLE::Storage_Lite::PPS::File #============================================================================== package OLE::Storage_Lite::PPS::File; require Exporter; use strict; use vars qw($VERSION @ISA); @ISA = qw(OLE::Storage_Lite::PPS Exporter); $VERSION = '0.19'; #------------------------------------------------------------------------------ # new (OLE::Storage_Lite::PPS::File) #------------------------------------------------------------------------------ sub new ($$$) { my($sClass, $sNm, $sData) = @_; OLE::Storage_Lite::PPS::_new( $sClass, undef, $sNm, 2, undef, undef, undef, undef, undef, undef, undef, $sData, undef); } #------------------------------------------------------------------------------ # newFile (OLE::Storage_Lite::PPS::File) #------------------------------------------------------------------------------ sub newFile ($$;$) { my($sClass, $sNm, $sFile) = @_; my $oSelf = OLE::Storage_Lite::PPS::_new( $sClass, undef, $sNm, 2, undef, undef, undef, undef, undef, undef, undef, '', undef); # if((!defined($sFile)) or ($sFile eq '')) { $oSelf->{_PPS_FILE} = IO::File->new_tmpfile(); } elsif(UNIVERSAL::isa($sFile, 'IO::Handle')) { $oSelf->{_PPS_FILE} = $sFile; } elsif(!ref($sFile)) { #File Name $oSelf->{_PPS_FILE} = new IO::File; return undef unless($oSelf->{_PPS_FILE}); $oSelf->{_PPS_FILE}->open("$sFile", "r+") || return undef; } else { return undef; } if($oSelf->{_PPS_FILE}) { $oSelf->{_PPS_FILE}->seek(0, 2); binmode($oSelf->{_PPS_FILE}); $oSelf->{_PPS_FILE}->autoflush(1); } return $oSelf; } #------------------------------------------------------------------------------ # append (OLE::Storage_Lite::PPS::File) #------------------------------------------------------------------------------ sub append ($$) { my($oSelf, $sData) = @_; if($oSelf->{_PPS_FILE}) { print {$oSelf->{_PPS_FILE}} $sData; } else { $oSelf->{Data} .= $sData; } } #////////////////////////////////////////////////////////////////////////////// # OLE::Storage_Lite::PPS::Dir Object #////////////////////////////////////////////////////////////////////////////// #------------------------------------------------------------------------------ # new (OLE::Storage_Lite::PPS::Dir) #------------------------------------------------------------------------------ package OLE::Storage_Lite::PPS::Dir; require Exporter; use strict; use vars qw($VERSION @ISA); @ISA = qw(OLE::Storage_Lite::PPS Exporter); $VERSION = '0.19'; sub new ($$;$$$) { my($sClass, $sName, $raTime1st, $raTime2nd, $raChild) = @_; OLE::Storage_Lite::PPS::_new( $sClass, undef, $sName, 1, undef, undef, undef, $raTime1st, $raTime2nd, undef, undef, undef, $raChild); } #============================================================================== # OLE::Storage_Lite #============================================================================== package OLE::Storage_Lite; require Exporter; use strict; use IO::File; use Time::Local 'timegm'; use vars qw($VERSION @ISA @EXPORT); @ISA = qw(Exporter); $VERSION = '0.19'; sub _getPpsSearch($$$$$;$); sub _getPpsTree($$$;$); #------------------------------------------------------------------------------ # Const for OLE::Storage_Lite #------------------------------------------------------------------------------ #0. Constants sub PpsType_Root {5}; sub PpsType_Dir {1}; sub PpsType_File {2}; sub DataSizeSmall{0x1000}; sub LongIntSize {4}; sub PpsSize {0x80}; #------------------------------------------------------------------------------ # new OLE::Storage_Lite #------------------------------------------------------------------------------ sub new($$) { my($sClass, $sFile) = @_; my $oThis = { _FILE => $sFile, }; bless $oThis; return $oThis; } #------------------------------------------------------------------------------ # getPpsTree: OLE::Storage_Lite #------------------------------------------------------------------------------ sub getPpsTree($;$) { my($oThis, $bData) = @_; #0.Init my $rhInfo = _initParse($oThis->{_FILE}); return undef unless($rhInfo); #1. Get Data my ($oPps) = _getPpsTree(0, $rhInfo, $bData); close(IN); return $oPps; } #------------------------------------------------------------------------------ # getSearch: OLE::Storage_Lite #------------------------------------------------------------------------------ sub getPpsSearch($$;$$) { my($oThis, $raName, $bData, $iCase) = @_; #0.Init my $rhInfo = _initParse($oThis->{_FILE}); return undef unless($rhInfo); #1. Get Data my @aList = _getPpsSearch(0, $rhInfo, $raName, $bData, $iCase); close(IN); return @aList; } #------------------------------------------------------------------------------ # getNthPps: OLE::Storage_Lite #------------------------------------------------------------------------------ sub getNthPps($$;$) { my($oThis, $iNo, $bData) = @_; #0.Init my $rhInfo = _initParse($oThis->{_FILE}); return undef unless($rhInfo); #1. Get Data my $oPps = _getNthPps($iNo, $rhInfo, $bData); close IN; return $oPps; } #------------------------------------------------------------------------------ # _initParse: OLE::Storage_Lite #------------------------------------------------------------------------------ sub _initParse($) { my($sFile)=@_; my $oIo; #1. $sFile is Ref of scalar if(ref($sFile) eq 'SCALAR') { require IO::Scalar; $oIo = new IO::Scalar; $oIo->open($sFile); } #2. $sFile is a IO::Handle object elsif(UNIVERSAL::isa($sFile, 'IO::Handle')) { $oIo = $sFile; binmode($oIo); } #3. $sFile is a simple filename string elsif(!ref($sFile)) { $oIo = new IO::File; $oIo->open("<$sFile") || return undef; binmode($oIo); } #4 Assume that if $sFile is a ref then it is a valid filehandle else { $oIo = $sFile; # Not all filehandles support binmode() so try it in an eval. eval{ binmode $oIo }; } return _getHeaderInfo($oIo); } #------------------------------------------------------------------------------ # _getPpsTree: OLE::Storage_Lite #------------------------------------------------------------------------------ sub _getPpsTree($$$;$) { my($iNo, $rhInfo, $bData, $raDone) = @_; if(defined($raDone)) { return () if(grep {$_ ==$iNo} @$raDone); } else { $raDone=[]; } push @$raDone, $iNo; my $iRootBlock = $rhInfo->{_ROOT_START} ; #1. Get Information about itself my $oPps = _getNthPps($iNo, $rhInfo, $bData); #2. Child if($oPps->{DirPps} != 0xFFFFFFFF) { my @aChildL = _getPpsTree($oPps->{DirPps}, $rhInfo, $bData, $raDone); $oPps->{Child} = \@aChildL; } else { $oPps->{Child} = undef; } #3. Previous,Next PPSs my @aList = (); push @aList, _getPpsTree($oPps->{PrevPps}, $rhInfo, $bData, $raDone) if($oPps->{PrevPps} != 0xFFFFFFFF); push @aList, $oPps; push @aList, _getPpsTree($oPps->{NextPps}, $rhInfo, $bData, $raDone) if($oPps->{NextPps} != 0xFFFFFFFF); return @aList; } #------------------------------------------------------------------------------ # _getPpsSearch: OLE::Storage_Lite #------------------------------------------------------------------------------ sub _getPpsSearch($$$$$;$) { my($iNo, $rhInfo, $raName, $bData, $iCase, $raDone) = @_; my $iRootBlock = $rhInfo->{_ROOT_START} ; my @aRes; #1. Check it self if(defined($raDone)) { return () if(grep {$_==$iNo} @$raDone); } else { $raDone=[]; } push @$raDone, $iNo; my $oPps = _getNthPps($iNo, $rhInfo, undef); # if(grep($_ eq $oPps->{Name}, @$raName)) { if(($iCase && (grep(/^\Q$oPps->{Name}\E$/i, @$raName))) || (grep($_ eq $oPps->{Name}, @$raName))) { $oPps = _getNthPps($iNo, $rhInfo, $bData) if ($bData); @aRes = ($oPps); } else { @aRes = (); } #2. Check Child, Previous, Next PPSs push @aRes, _getPpsSearch($oPps->{DirPps}, $rhInfo, $raName, $bData, $iCase, $raDone) if($oPps->{DirPps} != 0xFFFFFFFF) ; push @aRes, _getPpsSearch($oPps->{PrevPps}, $rhInfo, $raName, $bData, $iCase, $raDone) if($oPps->{PrevPps} != 0xFFFFFFFF ); push @aRes, _getPpsSearch($oPps->{NextPps}, $rhInfo, $raName, $bData, $iCase, $raDone) if($oPps->{NextPps} != 0xFFFFFFFF); return @aRes; } #=================================================================== # Get Header Info (BASE Informain about that file) #=================================================================== sub _getHeaderInfo($){ my($FILE) = @_; my($iWk); my $rhInfo = {}; $rhInfo->{_FILEH_} = $FILE; my $sWk; #0. Check ID $rhInfo->{_FILEH_}->seek(0, 0); $rhInfo->{_FILEH_}->read($sWk, 8); return undef unless($sWk eq "\xD0\xCF\x11\xE0\xA1\xB1\x1A\xE1"); #BIG BLOCK SIZE $iWk = _getInfoFromFile($rhInfo->{_FILEH_}, 0x1E, 2, "v"); return undef unless(defined($iWk)); $rhInfo->{_BIG_BLOCK_SIZE} = 2 ** $iWk; #SMALL BLOCK SIZE $iWk = _getInfoFromFile($rhInfo->{_FILEH_}, 0x20, 2, "v"); return undef unless(defined($iWk)); $rhInfo->{_SMALL_BLOCK_SIZE} = 2 ** $iWk; #BDB Count $iWk = _getInfoFromFile($rhInfo->{_FILEH_}, 0x2C, 4, "V"); return undef unless(defined($iWk)); $rhInfo->{_BDB_COUNT} = $iWk; #START BLOCK $iWk = _getInfoFromFile($rhInfo->{_FILEH_}, 0x30, 4, "V"); return undef unless(defined($iWk)); $rhInfo->{_ROOT_START} = $iWk; #MIN SIZE OF BB # $iWk = _getInfoFromFile($rhInfo->{_FILEH_}, 0x38, 4, "V"); # return undef unless(defined($iWk)); # $rhInfo->{_MIN_SIZE_BB} = $iWk; #SMALL BD START $iWk = _getInfoFromFile($rhInfo->{_FILEH_}, 0x3C, 4, "V"); return undef unless(defined($iWk)); $rhInfo->{_SBD_START} = $iWk; #SMALL BD COUNT $iWk = _getInfoFromFile($rhInfo->{_FILEH_}, 0x40, 4, "V"); return undef unless(defined($iWk)); $rhInfo->{_SBD_COUNT} = $iWk; #EXTRA BBD START $iWk = _getInfoFromFile($rhInfo->{_FILEH_}, 0x44, 4, "V"); return undef unless(defined($iWk)); $rhInfo->{_EXTRA_BBD_START} = $iWk; #EXTRA BD COUNT $iWk = _getInfoFromFile($rhInfo->{_FILEH_}, 0x48, 4, "V"); return undef unless(defined($iWk)); $rhInfo->{_EXTRA_BBD_COUNT} = $iWk; #GET BBD INFO $rhInfo->{_BBD_INFO}= _getBbdInfo($rhInfo); #GET ROOT PPS my $oRoot = _getNthPps(0, $rhInfo, undef); $rhInfo->{_SB_START} = $oRoot->{StartBlock}; $rhInfo->{_SB_SIZE} = $oRoot->{Size}; return $rhInfo; } #------------------------------------------------------------------------------ # _getInfoFromFile #------------------------------------------------------------------------------ sub _getInfoFromFile($$$$) { my($FILE, $iPos, $iLen, $sFmt) =@_; my($sWk); return undef unless($FILE); return undef if($FILE->seek($iPos, 0)==0); return undef if($FILE->read($sWk, $iLen)!=$iLen); return unpack($sFmt, $sWk); } #------------------------------------------------------------------------------ # _getBbdInfo #------------------------------------------------------------------------------ sub _getBbdInfo($) { my($rhInfo) =@_; my @aBdList = (); my $iBdbCnt = $rhInfo->{_BDB_COUNT}; my $iGetCnt; my $sWk; my $i1stCnt = int(($rhInfo->{_BIG_BLOCK_SIZE} - 0x4C) / OLE::Storage_Lite::LongIntSize()); my $iBdlCnt = int($rhInfo->{_BIG_BLOCK_SIZE} / OLE::Storage_Lite::LongIntSize()) - 1; #1. 1st BDlist $rhInfo->{_FILEH_}->seek(0x4C, 0); $iGetCnt = ($iBdbCnt < $i1stCnt)? $iBdbCnt: $i1stCnt; $rhInfo->{_FILEH_}->read($sWk, OLE::Storage_Lite::LongIntSize()*$iGetCnt); push @aBdList, unpack("V$iGetCnt", $sWk); $iBdbCnt -= $iGetCnt; #2. Extra BDList my $iBlock = $rhInfo->{_EXTRA_BBD_START}; while(($iBdbCnt> 0) && _isNormalBlock($iBlock)){ _setFilePos($iBlock, 0, $rhInfo); $iGetCnt= ($iBdbCnt < $iBdlCnt)? $iBdbCnt: $iBdlCnt; $rhInfo->{_FILEH_}->read($sWk, OLE::Storage_Lite::LongIntSize()*$iGetCnt); push @aBdList, unpack("V$iGetCnt", $sWk); $iBdbCnt -= $iGetCnt; $rhInfo->{_FILEH_}->read($sWk, OLE::Storage_Lite::LongIntSize()); $iBlock = unpack("V", $sWk); } #3.Get BDs my @aWk; my %hBd; my $iBlkNo = 0; my $iBdL; my $i; my $iBdCnt = int($rhInfo->{_BIG_BLOCK_SIZE} / OLE::Storage_Lite::LongIntSize()); foreach $iBdL (@aBdList) { _setFilePos($iBdL, 0, $rhInfo); $rhInfo->{_FILEH_}->read($sWk, $rhInfo->{_BIG_BLOCK_SIZE}); @aWk = unpack("V$iBdCnt", $sWk); for($i=0;$i<$iBdCnt;$i++, $iBlkNo++) { if($aWk[$i] != ($iBlkNo+1)){ $hBd{$iBlkNo} = $aWk[$i]; } } } return \%hBd; } #------------------------------------------------------------------------------ # getNthPps (OLE::Storage_Lite) #------------------------------------------------------------------------------ sub _getNthPps($$$){ my($iPos, $rhInfo, $bData) = @_; my($iPpsStart) = ($rhInfo->{_ROOT_START}); my($iPpsBlock, $iPpsPos); my $sWk; my $iBlock; my $iBaseCnt = $rhInfo->{_BIG_BLOCK_SIZE} / OLE::Storage_Lite::PpsSize(); $iPpsBlock = int($iPos / $iBaseCnt); $iPpsPos = $iPos % $iBaseCnt; $iBlock = _getNthBlockNo($iPpsStart, $iPpsBlock, $rhInfo); return undef unless(defined($iBlock)); _setFilePos($iBlock, OLE::Storage_Lite::PpsSize()*$iPpsPos, $rhInfo); $rhInfo->{_FILEH_}->read($sWk, OLE::Storage_Lite::PpsSize()); return undef unless($sWk); my $iNmSize = unpack("v", substr($sWk, 0x40, 2)); $iNmSize = ($iNmSize > 2)? $iNmSize - 2 : $iNmSize; my $sNm= substr($sWk, 0, $iNmSize); my $iType = unpack("C", substr($sWk, 0x42, 2)); my $lPpsPrev = unpack("V", substr($sWk, 0x44, OLE::Storage_Lite::LongIntSize())); my $lPpsNext = unpack("V", substr($sWk, 0x48, OLE::Storage_Lite::LongIntSize())); my $lDirPps = unpack("V", substr($sWk, 0x4C, OLE::Storage_Lite::LongIntSize())); my @raTime1st = (($iType == OLE::Storage_Lite::PpsType_Root()) or ($iType == OLE::Storage_Lite::PpsType_Dir()))? OLEDate2Local(substr($sWk, 0x64, 8)) : undef , my @raTime2nd = (($iType == OLE::Storage_Lite::PpsType_Root()) or ($iType == OLE::Storage_Lite::PpsType_Dir()))? OLEDate2Local(substr($sWk, 0x6C, 8)) : undef, my($iStart, $iSize) = unpack("VV", substr($sWk, 0x74, 8)); if($bData) { my $sData = _getData($iType, $iStart, $iSize, $rhInfo); return OLE::Storage_Lite::PPS->new( $iPos, $sNm, $iType, $lPpsPrev, $lPpsNext, $lDirPps, \@raTime1st, \@raTime2nd, $iStart, $iSize, $sData, undef); } else { return OLE::Storage_Lite::PPS->new( $iPos, $sNm, $iType, $lPpsPrev, $lPpsNext, $lDirPps, \@raTime1st, \@raTime2nd, $iStart, $iSize, undef, undef); } } #------------------------------------------------------------------------------ # _setFilePos (OLE::Storage_Lite) #------------------------------------------------------------------------------ sub _setFilePos($$$){ my($iBlock, $iPos, $rhInfo) = @_; $rhInfo->{_FILEH_}->seek(($iBlock+1)*$rhInfo->{_BIG_BLOCK_SIZE}+$iPos, 0); } #------------------------------------------------------------------------------ # _getNthBlockNo (OLE::Storage_Lite) #------------------------------------------------------------------------------ sub _getNthBlockNo($$$){ my($iStBlock, $iNth, $rhInfo) = @_; my $iSv; my $iNext = $iStBlock; for(my $i =0; $i<$iNth; $i++) { $iSv = $iNext; $iNext = _getNextBlockNo($iSv, $rhInfo); return undef unless _isNormalBlock($iNext); } return $iNext; } #------------------------------------------------------------------------------ # _getData (OLE::Storage_Lite) #------------------------------------------------------------------------------ sub _getData($$$$) { my($iType, $iBlock, $iSize, $rhInfo) = @_; if ($iType == OLE::Storage_Lite::PpsType_File()) { if($iSize < OLE::Storage_Lite::DataSizeSmall()) { return _getSmallData($iBlock, $iSize, $rhInfo); } else { return _getBigData($iBlock, $iSize, $rhInfo); } } elsif($iType == OLE::Storage_Lite::PpsType_Root()) { #Root return _getBigData($iBlock, $iSize, $rhInfo); } elsif($iType == OLE::Storage_Lite::PpsType_Dir()) { # Directory return undef; } } #------------------------------------------------------------------------------ # _getBigData (OLE::Storage_Lite) #------------------------------------------------------------------------------ sub _getBigData($$$) { my($iBlock, $iSize, $rhInfo) = @_; my($iRest, $sWk, $sRes); return '' unless(_isNormalBlock($iBlock)); $iRest = $iSize; my($i, $iGetSize, $iNext); $sRes = ''; my @aKeys= sort({$a<=>$b} keys(%{$rhInfo->{_BBD_INFO}})); while ($iRest > 0) { my @aRes = grep($_ >= $iBlock, @aKeys); my $iNKey = $aRes[0]; $i = $iNKey - $iBlock; $iNext = $rhInfo->{_BBD_INFO}{$iNKey}; _setFilePos($iBlock, 0, $rhInfo); my $iGetSize = ($rhInfo->{_BIG_BLOCK_SIZE} * ($i+1)); $iGetSize = $iRest if($iRest < $iGetSize); $rhInfo->{_FILEH_}->read( $sWk, $iGetSize); $sRes .= $sWk; $iRest -= $iGetSize; $iBlock= $iNext; } return $sRes; } #------------------------------------------------------------------------------ # _getNextBlockNo (OLE::Storage_Lite) #------------------------------------------------------------------------------ sub _getNextBlockNo($$){ my($iBlockNo, $rhInfo) = @_; my $iRes = $rhInfo->{_BBD_INFO}->{$iBlockNo}; return defined($iRes)? $iRes: $iBlockNo+1; } #------------------------------------------------------------------------------ # _isNormalBlock (OLE::Storage_Lite) # 0xFFFFFFFC : BDList, 0xFFFFFFFD : BBD, # 0xFFFFFFFE: End of Chain 0xFFFFFFFF : unused #------------------------------------------------------------------------------ sub _isNormalBlock($){ my($iBlock) = @_; return ($iBlock < 0xFFFFFFFC)? 1: undef; } #------------------------------------------------------------------------------ # _getSmallData (OLE::Storage_Lite) #------------------------------------------------------------------------------ sub _getSmallData($$$) { my($iSmBlock, $iSize, $rhInfo) = @_; my($sRes, $sWk); my $iRest = $iSize; $sRes = ''; while ($iRest > 0) { _setFilePosSmall($iSmBlock, $rhInfo); $rhInfo->{_FILEH_}->read($sWk, ($iRest >= $rhInfo->{_SMALL_BLOCK_SIZE})? $rhInfo->{_SMALL_BLOCK_SIZE}: $iRest); $sRes .= $sWk; $iRest -= $rhInfo->{_SMALL_BLOCK_SIZE}; $iSmBlock= _getNextSmallBlockNo($iSmBlock, $rhInfo); } return $sRes; } #------------------------------------------------------------------------------ # _setFilePosSmall(OLE::Storage_Lite) #------------------------------------------------------------------------------ sub _setFilePosSmall($$) { my($iSmBlock, $rhInfo) = @_; my $iSmStart = $rhInfo->{_SB_START}; my $iBaseCnt = $rhInfo->{_BIG_BLOCK_SIZE} / $rhInfo->{_SMALL_BLOCK_SIZE}; my $iNth = int($iSmBlock/$iBaseCnt); my $iPos = $iSmBlock % $iBaseCnt; my $iBlk = _getNthBlockNo($iSmStart, $iNth, $rhInfo); _setFilePos($iBlk, $iPos * $rhInfo->{_SMALL_BLOCK_SIZE}, $rhInfo); } #------------------------------------------------------------------------------ # _getNextSmallBlockNo (OLE::Storage_Lite) #------------------------------------------------------------------------------ sub _getNextSmallBlockNo($$) { my($iSmBlock, $rhInfo) = @_; my($sWk); my $iBaseCnt = $rhInfo->{_BIG_BLOCK_SIZE} / OLE::Storage_Lite::LongIntSize(); my $iNth = int($iSmBlock/$iBaseCnt); my $iPos = $iSmBlock % $iBaseCnt; my $iBlk = _getNthBlockNo($rhInfo->{_SBD_START}, $iNth, $rhInfo); _setFilePos($iBlk, $iPos * OLE::Storage_Lite::LongIntSize(), $rhInfo); $rhInfo->{_FILEH_}->read($sWk, OLE::Storage_Lite::LongIntSize()); return unpack("V", $sWk); } #------------------------------------------------------------------------------ # Asc2Ucs: OLE::Storage_Lite #------------------------------------------------------------------------------ sub Asc2Ucs($) { my($sAsc) = @_; return join("\x00", split //, $sAsc) . "\x00"; } #------------------------------------------------------------------------------ # Ucs2Asc: OLE::Storage_Lite #------------------------------------------------------------------------------ sub Ucs2Asc($) { my($sUcs) = @_; return join('', map(pack('c', $_), unpack('v*', $sUcs))); } #------------------------------------------------------------------------------ # OLEDate2Local() # # Convert from a Window FILETIME structure to a localtime array. FILETIME is # a 64-bit value representing the number of 100-nanosecond intervals since # January 1 1601. # # We first convert the FILETIME to seconds and then subtract the difference # between the 1601 epoch and the 1970 Unix epoch. # sub OLEDate2Local { my $oletime = shift; # Unpack the FILETIME into high and low longs. my ( $lo, $hi ) = unpack 'V2', $oletime; # Convert the longs to a double. my $nanoseconds = $hi * 2**32 + $lo; # Convert the 100 nanosecond units into seconds. my $time = $nanoseconds / 1e7; # Subtract the number of seconds between the 1601 and 1970 epochs. $time -= 11644473600; # Convert to a localtime (actually gmtime) structure. my @localtime = gmtime($time); return @localtime; } #------------------------------------------------------------------------------ # LocalDate2OLE() # # Convert from a a localtime array to a Window FILETIME structure. FILETIME is # a 64-bit value representing the number of 100-nanosecond intervals since # January 1 1601. # # We first convert the localtime (actually gmtime) to seconds and then add the # difference between the 1601 epoch and the 1970 Unix epoch. We convert that to # 100 nanosecond units, divide it into high and low longs and return it as a # packed 64bit structure. # sub LocalDate2OLE { my $localtime = shift; return "\x00" x 8 unless $localtime; # Convert from localtime (actually gmtime) to seconds. my $time = timegm( @{$localtime} ); # Add the number of seconds between the 1601 and 1970 epochs. $time += 11644473600; # The FILETIME seconds are in units of 100 nanoseconds. my $nanoseconds = $time * 1E7; use POSIX 'fmod'; # Pack the total nanoseconds into 64 bits... my $hi = int( $nanoseconds / 2**32 ); my $lo = fmod($nanoseconds, 2**32); my $oletime = pack "VV", $lo, $hi; return $oletime; } 1; __END__ =head1 NAME OLE::Storage_Lite - Simple Class for OLE document interface. =head1 SYNOPSIS use OLE::Storage_Lite; # Initialize. # From a file my $oOl = OLE::Storage_Lite->new("some.xls"); # From a filehandle object use IO::File; my $oIo = new IO::File; $oIo->open("new($oFile); # Read data my $oPps = $oOl->getPpsTree(1); # Save Data # To a File $oPps->save("kaba.xls"); #kaba.xls $oPps->save('-'); #STDOUT # To a filehandle object my $oIo = new IO::File; $oIo->open(">iofile.xls"); bimode($oIo); $oPps->save($oIo); =head1 DESCRIPTION OLE::Storage_Lite allows you to read and write an OLE structured file. OLE::Storage_Lite::PPS is a class representing PPS. OLE::Storage_Lite::PPS::Root, OLE::Storage_Lite::PPS::File and OLE::Storage_Lite::PPS::Dir are subclasses of OLE::Storage_Lite::PPS. =head2 new() Constructor. $oOle = OLE::Storage_Lite->new($sFile); Creates a OLE::Storage_Lite object for C<$sFile>. C<$sFile> must be a correct file name. The C constructor also accepts a valid filehandle. Remember to C the filehandle first. =head2 getPpsTree() $oPpsRoot = $oOle->getPpsTree([$bData]); Returns PPS as an OLE::Storage_Lite::PPS::Root object. Other PPS objects will be included as its children. If C<$bData> is true, the objects will have data in the file. =head2 getPpsSearch() $oPpsRoot = $oOle->getPpsTree($raName [, $bData][, $iCase] ); Returns PPSs as OLE::Storage_Lite::PPS objects that has the name specified in C<$raName> array. If C<$bData> is true, the objects will have data in the file. If C<$iCase> is true, search is case insensitive. =head2 getNthPps() $oPpsRoot = $oOle->getNthPps($iNth [, $bData]); Returns PPS as C object specified number C<$iNth>. If C<$bData> is true, the objects will have data in the file. =head2 Asc2Ucs() $sUcs2 = OLE::Storage_Lite::Asc2Ucs($sAsc>); Utility function. Just adds 0x00 after every characters in C<$sAsc>. =head2 Ucs2Asc() $sAsc = OLE::Storage_Lite::Ucs2Asc($sUcs2); Utility function. Just deletes 0x00 after words in C<$sUcs>. =head1 OLE::Storage_Lite::PPS OLE::Storage_Lite::PPS has these properties: =over 4 =item No Order number in saving. =item Name Its name in UCS2 (a.k.a Unicode). =item Type Its type (1:Dir, 2:File (Data), 5: Root) =item PrevPps Previous pps (as No) =item NextPps Next pps (as No) =item DirPps Dir pps (as No). =item Time1st Timestamp 1st in array ref as similar fomat of localtime. =item Time2nd Timestamp 2nd in array ref as similar fomat of localtime. =item StartBlock Start block number =item Size Size of the pps =item Data Its data =item Child Its child PPSs in array ref =back =head1 OLE::Storage_Lite::PPS::Root OLE::Storage_Lite::PPS::Root has 2 methods. =head2 new() $oRoot = OLE::Storage_Lite::PPS::Root->new( $raTime1st, $raTime2nd, $raChild); Constructor. C<$raTime1st>, C<$raTime2nd> are array refs with ($iSec, $iMin, $iHour, $iDay, $iMon, $iYear). $iSec means seconds, $iMin means minutes. $iHour means hours. $iDay means day. $iMon is month -1. $iYear is year - 1900. C<$raChild> is a array ref of children PPSs. =head2 save() $oRoot = $oRoot>->save( $sFile, $bNoAs); Saves information into C<$sFile>. If C<$sFile> is '-', this will use STDOUT. The C constructor also accepts a valid filehandle. Remember to C the filehandle first. If C<$bNoAs> is defined, this function will use the No of PPSs for saving order. If C<$bNoAs> is undefined, this will calculate PPS saving order. =head1 OLE::Storage_Lite::PPS::Dir OLE::Storage_Lite::PPS::Dir has 1 method. =head2 new() $oRoot = OLE::Storage_Lite::PPS::Dir->new( $sName, [, $raTime1st] [, $raTime2nd] [, $raChild>]); Constructor. C<$sName> is a name of the PPS. C<$raTime1st>, C<$raTime2nd> is a array ref as ($iSec, $iMin, $iHour, $iDay, $iMon, $iYear). $iSec means seconds, $iMin means minutes. $iHour means hours. $iDay means day. $iMon is month -1. $iYear is year - 1900. C<$raChild> is a array ref of children PPSs. =head1 OLE::Storage_Lite::PPS::File OLE::Storage_Lite::PPS::File has 3 method. =head2 new $oRoot = OLE::Storage_Lite::PPS::File->new($sName, $sData); C<$sName> is name of the PPS. C<$sData> is data of the PPS. =head2 newFile() $oRoot = OLE::Storage_Lite::PPS::File->newFile($sName, $sFile); This function makes to use file handle for geting and storing data. C<$sName> is name of the PPS. If C<$sFile> is scalar, it assumes that is a filename. If C<$sFile> is an IO::Handle object, it uses that specified handle. If C<$sFile> is undef or '', it uses temporary file. CAUTION: Take care C<$sFile> will be updated by C method. So if you want to use IO::Handle and append a data to it, you should open the handle with "r+". =head2 append() $oRoot = $oPps->append($sData); appends specified data to that PPS. C<$sData> is appending data for that PPS. =head1 CAUTION A saved file with VBA (a.k.a Macros) by this module will not work correctly. However modules can get the same information from the file, the file occurs a error in application(Word, Excel ...). =head1 DEPRECATED FEATURES Older version of C autovivified a scalar ref in the C constructors into a scalar filehandle. This functionality is still there for backwards compatibility but it is highly recommended that you do not use it. Instead create a filehandle (scalar or otherwise) and pass that in. =head1 COPYRIGHT The OLE::Storage_Lite module is Copyright (c) 2000,2001 Kawai Takanori. Japan. All rights reserved. You may distribute under the terms of either the GNU General Public License or the Artistic License, as specified in the Perl README file. =head1 ACKNOWLEDGEMENTS First of all, I would like to acknowledge to Martin Schwartz and his module OLE::Storage. =head1 AUTHOR Kawai Takanori kwitknr@cpan.org This module is currently maintained by John McNamara jmcnamara@cpan.org =head1 SEE ALSO OLE::Storage Documentation for the OLE Compound document has been released by Microsoft under the I. See http://www.microsoft.com/interop/docs/supportingtechnologies.mspx The Digital Imaging Group have also detailed the OLE format in the JPEG2000 specification: see Appendix A of http://www.i3a.org/pdf/wg1n1017.pdf =cut