1package Spreadsheet::WriteExcel::Properties; 2 3############################################################################### 4# 5# Properties - A module for creating Excel property sets. 6# 7# 8# Used in conjunction with Spreadsheet::WriteExcel 9# 10# Copyright 2000-2010, John McNamara. 11# 12# Documentation after __END__ 13# 14 15use Exporter; 16use strict; 17use Carp; 18use POSIX 'fmod'; 19use Time::Local 'timelocal'; 20 21 22 23 24use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); 25@ISA = qw(Exporter); 26 27$VERSION = '2.40'; 28 29# Set up the exports. 30my @all_functions = qw( 31 create_summary_property_set 32 create_doc_summary_property_set 33 _pack_property_data 34 _pack_VT_I2 35 _pack_VT_LPSTR 36 _pack_VT_FILETIME 37); 38 39my @pps_summaries = qw( 40 create_summary_property_set 41 create_doc_summary_property_set 42); 43 44@EXPORT = (); 45@EXPORT_OK = (@all_functions); 46%EXPORT_TAGS = (testing => \@all_functions, 47 property_sets => \@pps_summaries, 48 ); 49 50 51############################################################################### 52# 53# create_summary_property_set(). 54# 55# Create the SummaryInformation property set. This is mainly used for the 56# Title, Subject, Author, Keywords, Comments, Last author keywords and the 57# creation date. 58# 59sub create_summary_property_set { 60 61 my @properties = @{$_[0]}; 62 63 my $byte_order = pack 'v', 0xFFFE; 64 my $version = pack 'v', 0x0000; 65 my $system_id = pack 'V', 0x00020105; 66 my $class_id = pack 'H*', '00000000000000000000000000000000'; 67 my $num_property_sets = pack 'V', 0x0001; 68 my $format_id = pack 'H*', 'E0859FF2F94F6810AB9108002B27B3D9'; 69 my $offset = pack 'V', 0x0030; 70 my $num_property = pack 'V', scalar @properties; 71 my $property_offsets = ''; 72 73 # Create the property set data block and calculate the offsets into it. 74 my ($property_data, $offsets) = _pack_property_data(\@properties); 75 76 # Create the property type and offsets based on the previous calculation. 77 for my $i (0 .. @properties -1) { 78 $property_offsets .= pack('VV', $properties[$i]->[0], $offsets->[$i]); 79 } 80 81 # Size of $size (4 bytes) + $num_property (4 bytes) + the data structures. 82 my $size = 8 + length($property_offsets) + length($property_data); 83 $size = pack 'V', $size; 84 85 86 return $byte_order . 87 $version . 88 $system_id . 89 $class_id . 90 $num_property_sets . 91 $format_id . 92 $offset . 93 $size . 94 $num_property . 95 $property_offsets . 96 $property_data; 97} 98 99 100############################################################################### 101# 102# Create the DocSummaryInformation property set. This is mainly used for the 103# Manager, Company and Category keywords. 104# 105# The DocSummary also contains a stream for user defined properties. However 106# this is a little arcane and probably not worth the implementation effort. 107# 108sub create_doc_summary_property_set { 109 110 my @properties = @{$_[0]}; 111 112 my $byte_order = pack 'v', 0xFFFE; 113 my $version = pack 'v', 0x0000; 114 my $system_id = pack 'V', 0x00020105; 115 my $class_id = pack 'H*', '00000000000000000000000000000000'; 116 my $num_property_sets = pack 'V', 0x0002; 117 118 my $format_id_0 = pack 'H*', '02D5CDD59C2E1B10939708002B2CF9AE'; 119 my $format_id_1 = pack 'H*', '05D5CDD59C2E1B10939708002B2CF9AE'; 120 my $offset_0 = pack 'V', 0x0044; 121 my $num_property_0 = pack 'V', scalar @properties; 122 my $property_offsets_0 = ''; 123 124 # Create the property set data block and calculate the offsets into it. 125 my ($property_data_0, $offsets) = _pack_property_data(\@properties); 126 127 # Create the property type and offsets based on the previous calculation. 128 for my $i (0 .. @properties -1) { 129 $property_offsets_0 .= pack('VV', $properties[$i]->[0], $offsets->[$i]); 130 } 131 132 # Size of $size (4 bytes) + $num_property (4 bytes) + the data structures. 133 my $data_len = 8 + length($property_offsets_0) + length($property_data_0); 134 my $size_0 = pack 'V', $data_len; 135 136 137 # The second property set offset is at the end of the first property set. 138 my $offset_1 = pack 'V', 0x0044 + $data_len; 139 140 # We will use a static property set stream rather than try to generate it. 141 my $property_data_1 = pack 'H*', join '', qw ( 142 98 00 00 00 03 00 00 00 00 00 00 00 20 00 00 00 143 01 00 00 00 36 00 00 00 02 00 00 00 3E 00 00 00 144 01 00 00 00 02 00 00 00 0A 00 00 00 5F 50 49 44 145 5F 47 55 49 44 00 02 00 00 00 E4 04 00 00 41 00 146 00 00 4E 00 00 00 7B 00 31 00 36 00 43 00 34 00 147 42 00 38 00 33 00 42 00 2D 00 39 00 36 00 35 00 148 46 00 2D 00 34 00 42 00 32 00 31 00 2D 00 39 00 149 30 00 33 00 44 00 2D 00 39 00 31 00 30 00 46 00 150 41 00 44 00 46 00 41 00 37 00 30 00 31 00 42 00 151 7D 00 00 00 00 00 00 00 2D 00 39 00 30 00 33 00 152 ); 153 154 155 return $byte_order . 156 $version . 157 $system_id . 158 $class_id . 159 $num_property_sets . 160 $format_id_0 . 161 $offset_0 . 162 $format_id_1 . 163 $offset_1 . 164 165 $size_0 . 166 $num_property_0 . 167 $property_offsets_0 . 168 $property_data_0 . 169 170 $property_data_1; 171} 172 173 174############################################################################### 175# 176# _pack_property_data(). 177# 178# Create a packed property set structure. Strings are null terminated and 179# padded to a 4 byte boundary. We also use this function to keep track of the 180# property offsets within the data structure. These offsets are used by the 181# calling functions. Currently we only need to handle 4 property types: 182# VT_I2, VT_LPSTR, VT_FILETIME. 183# 184sub _pack_property_data { 185 186 my @properties = @{$_[0]}; 187 my $offset = $_[1] || 0; 188 my $packed_property = ''; 189 my $data = ''; 190 my @offsets; 191 192 # Get the strings codepage from the first property. 193 my $codepage = $properties[0]->[2]; 194 195 # The properties start after 8 bytes for size + num_properties + 8 bytes 196 # for each property type/offset pair. 197 $offset += 8 * (@properties + 1); 198 199 for my $property (@properties) { 200 push @offsets, $offset; 201 202 my $property_type = $property->[1]; 203 204 if ($property_type eq 'VT_I2') { 205 $packed_property = _pack_VT_I2($property->[2]); 206 } 207 elsif ($property_type eq 'VT_LPSTR') { 208 $packed_property = _pack_VT_LPSTR($property->[2], $codepage); 209 } 210 elsif ($property_type eq 'VT_FILETIME') { 211 $packed_property = _pack_VT_FILETIME($property->[2]); 212 } 213 else { 214 croak "Unknown property type: $property_type\n"; 215 } 216 217 $offset += length $packed_property; 218 $data .= $packed_property; 219 } 220 221 return $data, \@offsets; 222} 223 224 225############################################################################### 226# 227# _pack_VT_I2(). 228# 229# Pack an OLE property type: VT_I2, 16-bit signed integer. 230# 231sub _pack_VT_I2 { 232 233 my $type = 0x0002; 234 my $value = $_[0]; 235 236 my $data = pack 'VV', $type, $value; 237 238 return $data; 239} 240 241 242############################################################################### 243# 244# _pack_VT_LPSTR(). 245# 246# Pack an OLE property type: VT_LPSTR, String in the Codepage encoding. 247# The strings are null terminated and padded to a 4 byte boundary. 248# 249sub _pack_VT_LPSTR { 250 251 my $type = 0x001E; 252 my $string = $_[0] . "\0"; 253 my $codepage = $_[1]; 254 my $length; 255 my $byte_string; 256 257 if ($codepage == 0x04E4) { 258 # Latin1 259 $byte_string = $string; 260 $length = length $byte_string; 261 } 262 elsif ($codepage == 0xFDE9) { 263 # UTF-8 264 if ( $] > 5.008 ) { 265 require Encode; 266 if (Encode::is_utf8($string)) { 267 $byte_string = Encode::encode_utf8($string); 268 } 269 else { 270 $byte_string = $string; 271 } 272 } 273 else { 274 $byte_string = $string; 275 } 276 277 $length = length $byte_string; 278 } 279 else { 280 croak "Unknown codepage: $codepage\n"; 281 } 282 283 # Pack the data. 284 my $data = pack 'VV', $type, $length; 285 $data .= $byte_string; 286 287 # The packed data has to null padded to a 4 byte boundary. 288 if (my $extra = $length % 4) { 289 $data .= "\0" x (4 - $extra); 290 } 291 292 return $data; 293} 294 295 296############################################################################### 297# 298# _pack_VT_FILETIME(). 299# 300# Pack an OLE property type: VT_FILETIME. 301# 302sub _pack_VT_FILETIME { 303 304 my $type = 0x0040; 305 my $localtime = $_[0]; 306 307 # Convert from localtime to seconds. 308 my $seconds = Time::Local::timelocal(@{$localtime}); 309 310 # Add the number of seconds between the 1601 and 1970 epochs. 311 $seconds += 11644473600; 312 313 # The FILETIME seconds are in units of 100 nanoseconds. 314 my $nanoseconds = $seconds * 1E7; 315 316 # Pack the total nanoseconds into 64 bits. 317 my $time_hi = int($nanoseconds / 2**32); 318 my $time_lo = POSIX::fmod($nanoseconds, 2**32); 319 320 my $data = pack 'VVV', $type, $time_lo, $time_hi; 321 322 return $data; 323} 324 325 3261; 327 328 329__END__ 330 331=encoding latin1 332 333=head1 NAME 334 335Properties - A module for creating Excel property sets. 336 337=head1 SYNOPSIS 338 339See the C<set_properties()> method in the Spreadsheet::WriteExcel documentation. 340 341=head1 DESCRIPTION 342 343This module is used in conjunction with Spreadsheet::WriteExcel. 344 345=head1 AUTHOR 346 347John McNamara jmcnamara@cpan.org 348 349=head1 COPYRIGHT 350 351Copyright MM-MMX, John McNamara. 352 353All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself. 354