| package Spreadsheet::WriteExcel::Properties; |
| |
| ############################################################################### |
| # |
| # Properties - A module for creating Excel property sets. |
| # |
| # |
| # Used in conjunction with Spreadsheet::WriteExcel |
| # |
| # Copyright 2000-2010, John McNamara. |
| # |
| # Documentation after __END__ |
| # |
| |
| use Exporter; |
| use strict; |
| use Carp; |
| use POSIX 'fmod'; |
| use Time::Local 'timelocal'; |
| |
| |
| |
| |
| use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); |
| @ISA = qw(Exporter); |
| |
| $VERSION = '2.37'; |
| |
| # Set up the exports. |
| my @all_functions = qw( |
| create_summary_property_set |
| create_doc_summary_property_set |
| _pack_property_data |
| _pack_VT_I2 |
| _pack_VT_LPSTR |
| _pack_VT_FILETIME |
| ); |
| |
| my @pps_summaries = qw( |
| create_summary_property_set |
| create_doc_summary_property_set |
| ); |
| |
| @EXPORT = (); |
| @EXPORT_OK = (@all_functions); |
| %EXPORT_TAGS = (testing => \@all_functions, |
| property_sets => \@pps_summaries, |
| ); |
| |
| |
| ############################################################################### |
| # |
| # create_summary_property_set(). |
| # |
| # Create the SummaryInformation property set. This is mainly used for the |
| # Title, Subject, Author, Keywords, Comments, Last author keywords and the |
| # creation date. |
| # |
| sub create_summary_property_set { |
| |
| my @properties = @{$_[0]}; |
| |
| my $byte_order = pack 'v', 0xFFFE; |
| my $version = pack 'v', 0x0000; |
| my $system_id = pack 'V', 0x00020105; |
| my $class_id = pack 'H*', '00000000000000000000000000000000'; |
| my $num_property_sets = pack 'V', 0x0001; |
| my $format_id = pack 'H*', 'E0859FF2F94F6810AB9108002B27B3D9'; |
| my $offset = pack 'V', 0x0030; |
| my $num_property = pack 'V', scalar @properties; |
| my $property_offsets = ''; |
| |
| # Create the property set data block and calculate the offsets into it. |
| my ($property_data, $offsets) = _pack_property_data(\@properties); |
| |
| # Create the property type and offsets based on the previous calculation. |
| for my $i (0 .. @properties -1) { |
| $property_offsets .= pack('VV', $properties[$i]->[0], $offsets->[$i]); |
| } |
| |
| # Size of $size (4 bytes) + $num_property (4 bytes) + the data structures. |
| my $size = 8 + length($property_offsets) + length($property_data); |
| $size = pack 'V', $size; |
| |
| |
| return $byte_order . |
| $version . |
| $system_id . |
| $class_id . |
| $num_property_sets . |
| $format_id . |
| $offset . |
| $size . |
| $num_property . |
| $property_offsets . |
| $property_data; |
| } |
| |
| |
| ############################################################################### |
| # |
| # Create the DocSummaryInformation property set. This is mainly used for the |
| # Manager, Company and Category keywords. |
| # |
| # The DocSummary also contains a stream for user defined properties. However |
| # this is a little arcane and probably not worth the implementation effort. |
| # |
| sub create_doc_summary_property_set { |
| |
| my @properties = @{$_[0]}; |
| |
| my $byte_order = pack 'v', 0xFFFE; |
| my $version = pack 'v', 0x0000; |
| my $system_id = pack 'V', 0x00020105; |
| my $class_id = pack 'H*', '00000000000000000000000000000000'; |
| my $num_property_sets = pack 'V', 0x0002; |
| |
| my $format_id_0 = pack 'H*', '02D5CDD59C2E1B10939708002B2CF9AE'; |
| my $format_id_1 = pack 'H*', '05D5CDD59C2E1B10939708002B2CF9AE'; |
| my $offset_0 = pack 'V', 0x0044; |
| my $num_property_0 = pack 'V', scalar @properties; |
| my $property_offsets_0 = ''; |
| |
| # Create the property set data block and calculate the offsets into it. |
| my ($property_data_0, $offsets) = _pack_property_data(\@properties); |
| |
| # Create the property type and offsets based on the previous calculation. |
| for my $i (0 .. @properties -1) { |
| $property_offsets_0 .= pack('VV', $properties[$i]->[0], $offsets->[$i]); |
| } |
| |
| # Size of $size (4 bytes) + $num_property (4 bytes) + the data structures. |
| my $data_len = 8 + length($property_offsets_0) + length($property_data_0); |
| my $size_0 = pack 'V', $data_len; |
| |
| |
| # The second property set offset is at the end of the first property set. |
| my $offset_1 = pack 'V', 0x0044 + $data_len; |
| |
| # We will use a static property set stream rather than try to generate it. |
| my $property_data_1 = pack 'H*', join '', qw ( |
| 98 00 00 00 03 00 00 00 00 00 00 00 20 00 00 00 |
| 01 00 00 00 36 00 00 00 02 00 00 00 3E 00 00 00 |
| 01 00 00 00 02 00 00 00 0A 00 00 00 5F 50 49 44 |
| 5F 47 55 49 44 00 02 00 00 00 E4 04 00 00 41 00 |
| 00 00 4E 00 00 00 7B 00 31 00 36 00 43 00 34 00 |
| 42 00 38 00 33 00 42 00 2D 00 39 00 36 00 35 00 |
| 46 00 2D 00 34 00 42 00 32 00 31 00 2D 00 39 00 |
| 30 00 33 00 44 00 2D 00 39 00 31 00 30 00 46 00 |
| 41 00 44 00 46 00 41 00 37 00 30 00 31 00 42 00 |
| 7D 00 00 00 00 00 00 00 2D 00 39 00 30 00 33 00 |
| ); |
| |
| |
| return $byte_order . |
| $version . |
| $system_id . |
| $class_id . |
| $num_property_sets . |
| $format_id_0 . |
| $offset_0 . |
| $format_id_1 . |
| $offset_1 . |
| |
| $size_0 . |
| $num_property_0 . |
| $property_offsets_0 . |
| $property_data_0 . |
| |
| $property_data_1; |
| } |
| |
| |
| ############################################################################### |
| # |
| # _pack_property_data(). |
| # |
| # Create a packed property set structure. Strings are null terminated and |
| # padded to a 4 byte boundary. We also use this function to keep track of the |
| # property offsets within the data structure. These offsets are used by the |
| # calling functions. Currently we only need to handle 4 property types: |
| # VT_I2, VT_LPSTR, VT_FILETIME. |
| # |
| sub _pack_property_data { |
| |
| my @properties = @{$_[0]}; |
| my $offset = $_[1] || 0; |
| my $packed_property = ''; |
| my $data = ''; |
| my @offsets; |
| |
| # Get the strings codepage from the first property. |
| my $codepage = $properties[0]->[2]; |
| |
| # The properties start after 8 bytes for size + num_properties + 8 bytes |
| # for each propety type/offset pair. |
| $offset += 8 * (@properties + 1); |
| |
| for my $property (@properties) { |
| push @offsets, $offset; |
| |
| my $property_type = $property->[1]; |
| |
| if ($property_type eq 'VT_I2') { |
| $packed_property = _pack_VT_I2($property->[2]); |
| } |
| elsif ($property_type eq 'VT_LPSTR') { |
| $packed_property = _pack_VT_LPSTR($property->[2], $codepage); |
| } |
| elsif ($property_type eq 'VT_FILETIME') { |
| $packed_property = _pack_VT_FILETIME($property->[2]); |
| } |
| else { |
| croak "Unknown property type: $property_type\n"; |
| } |
| |
| $offset += length $packed_property; |
| $data .= $packed_property; |
| } |
| |
| return $data, \@offsets; |
| } |
| |
| |
| ############################################################################### |
| # |
| # _pack_VT_I2(). |
| # |
| # Pack an OLE property type: VT_I2, 16-bit signed integer. |
| # |
| sub _pack_VT_I2 { |
| |
| my $type = 0x0002; |
| my $value = $_[0]; |
| |
| my $data = pack 'VV', $type, $value; |
| |
| return $data; |
| } |
| |
| |
| ############################################################################### |
| # |
| # _pack_VT_LPSTR(). |
| # |
| # Pack an OLE property type: VT_LPSTR, String in the Codepage encoding. |
| # The strings are null terminated and padded to a 4 byte boundary. |
| # |
| sub _pack_VT_LPSTR { |
| |
| my $type = 0x001E; |
| my $string = $_[0] . "\0"; |
| my $codepage = $_[1]; |
| my $length; |
| my $byte_string; |
| |
| if ($codepage == 0x04E4) { |
| # Latin1 |
| $byte_string = $string; |
| $length = length $byte_string; |
| } |
| elsif ($codepage == 0xFDE9) { |
| # UTF-8 |
| if ( $] > 5.008 ) { |
| require Encode; |
| if (Encode::is_utf8($string)) { |
| $byte_string = Encode::encode_utf8($string); |
| } |
| else { |
| $byte_string = $string; |
| } |
| } |
| else { |
| $byte_string = $string; |
| } |
| |
| $length = length $byte_string; |
| } |
| else { |
| croak "Unknown codepage: $codepage\n"; |
| } |
| |
| # Pack the data. |
| my $data = pack 'VV', $type, $length; |
| $data .= $byte_string; |
| |
| # The packed data has to null padded to a 4 byte boundary. |
| if (my $extra = $length % 4) { |
| $data .= "\0" x (4 - $extra); |
| } |
| |
| return $data; |
| } |
| |
| |
| ############################################################################### |
| # |
| # _pack_VT_FILETIME(). |
| # |
| # Pack an OLE property type: VT_FILETIME. |
| # |
| sub _pack_VT_FILETIME { |
| |
| my $type = 0x0040; |
| my $localtime = $_[0]; |
| |
| # Convert from localtime to seconds. |
| my $seconds = Time::Local::timelocal(@{$localtime}); |
| |
| # Add the number of seconds between the 1601 and 1970 epochs. |
| $seconds += 11644473600; |
| |
| # The FILETIME seconds are in units of 100 nanoseconds. |
| my $nanoseconds = $seconds * 1E7; |
| |
| # Pack the total nanoseconds into 64 bits. |
| my $time_hi = int($nanoseconds / 2**32); |
| my $time_lo = POSIX::fmod($nanoseconds, 2**32); |
| |
| my $data = pack 'VVV', $type, $time_lo, $time_hi; |
| |
| return $data; |
| } |
| |
| |
| 1; |
| |
| |
| __END__ |
| |
| |
| =head1 NAME |
| |
| Properties - A module for creating Excel property sets. |
| |
| =head1 SYNOPSIS |
| |
| See the C<set_properties()> method in the Spreadsheet::WriteExcel documentation. |
| |
| =head1 DESCRIPTION |
| |
| This module is used in conjunction with Spreadsheet::WriteExcel. |
| |
| =head1 AUTHOR |
| |
| John McNamara jmcnamara@cpan.org |
| |
| =head1 COPYRIGHT |
| |
| © MM-MMX, John McNamara. |
| |
| All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself. |