#!/usr/bin/perl -w ############################################################################### # # Testcases for Spreadsheet::WriteExcel. # # Tests for Workbook property_sets() interface. # # reverse('©'), Auguest 2008, John McNamara, jmcnamara@cpan.org # use strict; use Carp; use Spreadsheet::WriteExcel; use Spreadsheet::WriteExcel::Properties ':testing'; use Time::Local 'timegm'; use Test::More tests => 17; ############################################################################### # # Tests setup # my $test_file = "temp_test_file.xls"; my $workbook = Spreadsheet::WriteExcel->new($test_file); my $worksheet = $workbook->add_worksheet(); my $target; my $result; my $caption; my $string; my $codepage; my $smiley = chr 0x263A; my $filetime; my @properties; my %params; my @strings; ############################################################################### # # Test 1. _get_property_set_codepage() for default latin1 strings. # %params = ( title => 'Title', subject => 'Subject', author => 'Author', keywords => 'Keywords', comments => 'Comments', last_author => 'Username', ); @strings = qw(title subject author keywords comments last_author); $caption = " \t_get_property_set_codepage('latin1')"; $target = 0x04E4; $result = $workbook->_get_property_set_codepage(\%params, \@strings); is($result, $target, $caption); ############################################################################### # # Test 2. _get_property_set_codepage() for manual utf8 strings. # %params = ( title => 'Title', subject => 'Subject', author => 'Author', keywords => 'Keywords', comments => 'Comments', last_author => 'Username', utf8 => 1, ); @strings = qw(title subject author keywords comments last_author); $caption = " \t_get_property_set_codepage('utf8')"; $target = 0xFDE9; $result = $workbook->_get_property_set_codepage(\%params, \@strings); is($result, $target, $caption); ############################################################################### # # Test 3. _get_property_set_codepage() for perl 5.8 utf8 strings. # SKIP: { skip " \t_get_property_set_codepage('utf8'). Requires Perl 5.8 Unicode.", 1 if $] < 5.008; %params = ( title => 'Title' . $smiley, subject => 'Subject', author => 'Author', keywords => 'Keywords', comments => 'Comments', last_author => 'Username', ); @strings = qw(title subject author keywords comments last_author); $caption = " \t_get_property_set_codepage('utf8')"; $target = 0xFDE9; $result = $workbook->_get_property_set_codepage(\%params, \@strings); is($result, $target, $caption); } ############################################################################### # # Note, the "created => undef" parameters in some of the following tests is # used to avoid adding the default date to the property sets. ############################################################################### # # Test 4. Codepage only. # $workbook->set_properties( created => undef, ); $caption = " \tset_properties(codepage)"; $target = join " ", qw( FE FF 00 00 05 01 02 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 E0 85 9F F2 F9 4F 68 10 AB 91 08 00 2B 27 B3 D9 30 00 00 00 18 00 00 00 01 00 00 00 01 00 00 00 10 00 00 00 02 00 00 00 E4 04 00 00 ); $result = unpack_record( $workbook->{summary} ); is($result, $target, $caption); ############################################################################### # # Test 5. Same as previous + Title. # $workbook->set_properties( title => 'Title', created => undef, ); $caption = " \tset_properties('Title')"; $target = join " ", qw( FE FF 00 00 05 01 02 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 E0 85 9F F2 F9 4F 68 10 AB 91 08 00 2B 27 B3 D9 30 00 00 00 30 00 00 00 02 00 00 00 01 00 00 00 18 00 00 00 02 00 00 00 20 00 00 00 02 00 00 00 E4 04 00 00 1E 00 00 00 06 00 00 00 54 69 74 6C 65 00 00 00 ); $result = unpack_record( $workbook->{summary} ); is($result, $target, $caption); ############################################################################### # # Test 6. Same as previous + Subject. # $workbook->set_properties( title => 'Title', subject => 'Subject', created => undef, ); $caption = " \tset_properties('+ Subject')"; $target = join " ", qw( FE FF 00 00 05 01 02 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 E0 85 9F F2 F9 4F 68 10 AB 91 08 00 2B 27 B3 D9 30 00 00 00 48 00 00 00 03 00 00 00 01 00 00 00 20 00 00 00 02 00 00 00 28 00 00 00 03 00 00 00 38 00 00 00 02 00 00 00 E4 04 00 00 1E 00 00 00 06 00 00 00 54 69 74 6C 65 00 00 00 1E 00 00 00 08 00 00 00 53 75 62 6A 65 63 74 00 ); $result = unpack_record( $workbook->{summary} ); is($result, $target, $caption); ############################################################################### # # Test 7. Same as previous + Author. # $workbook->set_properties( title => 'Title', subject => 'Subject', author => 'Author', created => undef, ); $caption = " \tset_properties('+ Author')"; $target = join " ", qw( FE FF 00 00 05 01 02 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 E0 85 9F F2 F9 4F 68 10 AB 91 08 00 2B 27 B3 D9 30 00 00 00 60 00 00 00 04 00 00 00 01 00 00 00 28 00 00 00 02 00 00 00 30 00 00 00 03 00 00 00 40 00 00 00 04 00 00 00 50 00 00 00 02 00 00 00 E4 04 00 00 1E 00 00 00 06 00 00 00 54 69 74 6C 65 00 00 00 1E 00 00 00 08 00 00 00 53 75 62 6A 65 63 74 00 1E 00 00 00 07 00 00 00 41 75 74 68 6F 72 00 00 ); $result = unpack_record( $workbook->{summary} ); is($result, $target, $caption); ############################################################################### # # Test 8. Same as previous + Keywords. # $workbook->set_properties( title => 'Title', subject => 'Subject', author => 'Author', keywords => 'Keywords', created => undef, ); $caption = " \tset_properties('+ Keywords')"; $target = join " ", qw( FE FF 00 00 05 01 02 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 E0 85 9F F2 F9 4F 68 10 AB 91 08 00 2B 27 B3 D9 30 00 00 00 7C 00 00 00 05 00 00 00 01 00 00 00 30 00 00 00 02 00 00 00 38 00 00 00 03 00 00 00 48 00 00 00 04 00 00 00 58 00 00 00 05 00 00 00 68 00 00 00 02 00 00 00 E4 04 00 00 1E 00 00 00 06 00 00 00 54 69 74 6C 65 00 00 00 1E 00 00 00 08 00 00 00 53 75 62 6A 65 63 74 00 1E 00 00 00 07 00 00 00 41 75 74 68 6F 72 00 00 1E 00 00 00 09 00 00 00 4B 65 79 77 6F 72 64 73 00 00 00 00 ); $result = unpack_record( $workbook->{summary} ); is($result, $target, $caption); ############################################################################### # # Test 9. Same as previous + Comments. # $workbook->set_properties( title => 'Title', subject => 'Subject', author => 'Author', keywords => 'Keywords', comments => 'Comments', created => undef, ); $caption = " \tset_properties('+ Comments')"; $target = join " ", qw( FE FF 00 00 05 01 02 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 E0 85 9F F2 F9 4F 68 10 AB 91 08 00 2B 27 B3 D9 30 00 00 00 98 00 00 00 06 00 00 00 01 00 00 00 38 00 00 00 02 00 00 00 40 00 00 00 03 00 00 00 50 00 00 00 04 00 00 00 60 00 00 00 05 00 00 00 70 00 00 00 06 00 00 00 84 00 00 00 02 00 00 00 E4 04 00 00 1E 00 00 00 06 00 00 00 54 69 74 6C 65 00 00 00 1E 00 00 00 08 00 00 00 53 75 62 6A 65 63 74 00 1E 00 00 00 07 00 00 00 41 75 74 68 6F 72 00 00 1E 00 00 00 09 00 00 00 4B 65 79 77 6F 72 64 73 00 00 00 00 1E 00 00 00 09 00 00 00 43 6F 6D 6D 65 6E 74 73 00 00 00 00 ); $result = unpack_record( $workbook->{summary} ); is($result, $target, $caption); ############################################################################### # # Test 10. Same as previous + Last author. # $workbook->set_properties( title => 'Title', subject => 'Subject', author => 'Author', keywords => 'Keywords', comments => 'Comments', last_author => 'Username', created => undef, ); $caption = " \tset_properties('+ Last author')"; $target = join " ", qw( FE FF 00 00 05 01 02 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 E0 85 9F F2 F9 4F 68 10 AB 91 08 00 2B 27 B3 D9 30 00 00 00 B4 00 00 00 07 00 00 00 01 00 00 00 40 00 00 00 02 00 00 00 48 00 00 00 03 00 00 00 58 00 00 00 04 00 00 00 68 00 00 00 05 00 00 00 78 00 00 00 06 00 00 00 8C 00 00 00 08 00 00 00 A0 00 00 00 02 00 00 00 E4 04 00 00 1E 00 00 00 06 00 00 00 54 69 74 6C 65 00 00 00 1E 00 00 00 08 00 00 00 53 75 62 6A 65 63 74 00 1E 00 00 00 07 00 00 00 41 75 74 68 6F 72 00 00 1E 00 00 00 09 00 00 00 4B 65 79 77 6F 72 64 73 00 00 00 00 1E 00 00 00 09 00 00 00 43 6F 6D 6D 65 6E 74 73 00 00 00 00 1E 00 00 00 09 00 00 00 55 73 65 72 6E 61 6D 65 00 00 00 00 ); $result = unpack_record( $workbook->{summary} ); is($result, $target, $caption); ############################################################################### # # Test 11. Same as previous + Creation date. # # Wed Aug 20 00:20:13 2008 # $sec,$min,$hour,$mday,$mon,$year # We normalise the time using timegm() so that the tests don't fail due to # different timezones. $filetime = [localtime(timegm(13, 20, 23, 19, 7, 108))]; $workbook->set_properties( title => 'Title', subject => 'Subject', author => 'Author', keywords => 'Keywords', comments => 'Comments', last_author => 'Username', created => $filetime, ); $caption = " \tset_properties('+ Creation date')"; $target = join " ", qw( FE FF 00 00 05 01 02 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 E0 85 9F F2 F9 4F 68 10 AB 91 08 00 2B 27 B3 D9 30 00 00 00 C8 00 00 00 08 00 00 00 01 00 00 00 48 00 00 00 02 00 00 00 50 00 00 00 03 00 00 00 60 00 00 00 04 00 00 00 70 00 00 00 05 00 00 00 80 00 00 00 06 00 00 00 94 00 00 00 08 00 00 00 A8 00 00 00 0C 00 00 00 BC 00 00 00 02 00 00 00 E4 04 00 00 1E 00 00 00 06 00 00 00 54 69 74 6C 65 00 00 00 1E 00 00 00 08 00 00 00 53 75 62 6A 65 63 74 00 1E 00 00 00 07 00 00 00 41 75 74 68 6F 72 00 00 1E 00 00 00 09 00 00 00 4B 65 79 77 6F 72 64 73 00 00 00 00 1E 00 00 00 09 00 00 00 43 6F 6D 6D 65 6E 74 73 00 00 00 00 1E 00 00 00 09 00 00 00 55 73 65 72 6E 61 6D 65 00 00 00 00 40 00 00 00 80 74 89 21 52 02 C9 01 ); $result = unpack_record( $workbook->{summary} ); is($result, $target, $caption); ############################################################################### # # Test 12. Same as previous. Date set at the workbook level. # # Wed Aug 20 00:20:13 2008 # $sec,$min,$hour,$mday,$mon,$year # We normalise the time using timegm() so that the tests don't fail due to # different timezones. $workbook->{_localtime} = [localtime(timegm(13, 20, 23, 19, 7, 108))]; $workbook->set_properties( title => 'Title', subject => 'Subject', author => 'Author', keywords => 'Keywords', comments => 'Comments', last_author => 'Username', ); $caption = " \tset_properties('+ Creation date')"; $target = join " ", qw( FE FF 00 00 05 01 02 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 E0 85 9F F2 F9 4F 68 10 AB 91 08 00 2B 27 B3 D9 30 00 00 00 C8 00 00 00 08 00 00 00 01 00 00 00 48 00 00 00 02 00 00 00 50 00 00 00 03 00 00 00 60 00 00 00 04 00 00 00 70 00 00 00 05 00 00 00 80 00 00 00 06 00 00 00 94 00 00 00 08 00 00 00 A8 00 00 00 0C 00 00 00 BC 00 00 00 02 00 00 00 E4 04 00 00 1E 00 00 00 06 00 00 00 54 69 74 6C 65 00 00 00 1E 00 00 00 08 00 00 00 53 75 62 6A 65 63 74 00 1E 00 00 00 07 00 00 00 41 75 74 68 6F 72 00 00 1E 00 00 00 09 00 00 00 4B 65 79 77 6F 72 64 73 00 00 00 00 1E 00 00 00 09 00 00 00 43 6F 6D 6D 65 6E 74 73 00 00 00 00 1E 00 00 00 09 00 00 00 55 73 65 72 6E 61 6D 65 00 00 00 00 40 00 00 00 80 74 89 21 52 02 C9 01 ); $result = unpack_record( $workbook->{summary} ); is($result, $target, $caption); ############################################################################### # # Test 13. Same as 11 but params passed as a hashref. # # Wed Aug 20 00:20:13 2008 # $sec,$min,$hour,$mday,$mon,$year # We normalise the time using timegm() so that the tests don't fail due to # different timezones. $filetime = [localtime(timegm(13, 20, 23, 19, 7, 108))]; $workbook->set_properties({ title => 'Title', subject => 'Subject', author => 'Author', keywords => 'Keywords', comments => 'Comments', last_author => 'Username', created => $filetime, }); $caption = " \tset_properties({hash})"; $target = join " ", qw( FE FF 00 00 05 01 02 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 E0 85 9F F2 F9 4F 68 10 AB 91 08 00 2B 27 B3 D9 30 00 00 00 C8 00 00 00 08 00 00 00 01 00 00 00 48 00 00 00 02 00 00 00 50 00 00 00 03 00 00 00 60 00 00 00 04 00 00 00 70 00 00 00 05 00 00 00 80 00 00 00 06 00 00 00 94 00 00 00 08 00 00 00 A8 00 00 00 0C 00 00 00 BC 00 00 00 02 00 00 00 E4 04 00 00 1E 00 00 00 06 00 00 00 54 69 74 6C 65 00 00 00 1E 00 00 00 08 00 00 00 53 75 62 6A 65 63 74 00 1E 00 00 00 07 00 00 00 41 75 74 68 6F 72 00 00 1E 00 00 00 09 00 00 00 4B 65 79 77 6F 72 64 73 00 00 00 00 1E 00 00 00 09 00 00 00 43 6F 6D 6D 65 6E 74 73 00 00 00 00 1E 00 00 00 09 00 00 00 55 73 65 72 6E 61 6D 65 00 00 00 00 40 00 00 00 80 74 89 21 52 02 C9 01 ); $result = unpack_record( $workbook->{summary} ); is($result, $target, $caption); ############################################################################### # # Test 14. UTF-8 string used. # SKIP: { skip " \tset_properties(utf8). Test requires Perl 5.8 Unicode support.", 1 if $] < 5.008; $workbook->set_properties( title => 'Title' . $smiley, created => undef, ); $caption = " \tset_properties(utf8)"; $target = join " ", qw( FE FF 00 00 05 01 02 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 E0 85 9F F2 F9 4F 68 10 AB 91 08 00 2B 27 B3 D9 30 00 00 00 34 00 00 00 02 00 00 00 01 00 00 00 18 00 00 00 02 00 00 00 20 00 00 00 02 00 00 00 E9 FD 00 00 1E 00 00 00 09 00 00 00 54 69 74 6C 65 E2 98 BA 00 00 00 00 ); $result = unpack_record( $workbook->{summary} ); is($result, $target, $caption); } ############################################################################### # # Test 15. Manual UTF-8 string used.. # my $smiley_manual = pack 'H*', 'E298BA'; $workbook->set_properties( title => 'Title' . $smiley_manual, subject => 'Subject', created => undef, utf8 => 1, ); $caption = " \tset_properties(utf8)"; $target = join " ", qw( FE FF 00 00 05 01 02 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 E0 85 9F F2 F9 4F 68 10 AB 91 08 00 2B 27 B3 D9 30 00 00 00 4C 00 00 00 03 00 00 00 01 00 00 00 20 00 00 00 02 00 00 00 28 00 00 00 03 00 00 00 3C 00 00 00 02 00 00 00 E9 FD 00 00 1E 00 00 00 09 00 00 00 54 69 74 6C 65 E2 98 BA 00 00 00 00 1E 00 00 00 08 00 00 00 53 75 62 6A 65 63 74 00 ); $result = unpack_record( $workbook->{summary} ); is($result, $target, $caption); ############################################################################### # # Test 16. UTF-8 string used. # SKIP: { skip " \tset_properties(utf8). Test requires Perl 5.8 Unicode support.", 1 if $] < 5.008; $workbook->set_properties( title => 'Title' . $smiley, subject => 'Subject', created => undef, ); $caption = " \tset_properties(utf8)"; $target = join " ", qw( FE FF 00 00 05 01 02 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 E0 85 9F F2 F9 4F 68 10 AB 91 08 00 2B 27 B3 D9 30 00 00 00 4C 00 00 00 03 00 00 00 01 00 00 00 20 00 00 00 02 00 00 00 28 00 00 00 03 00 00 00 3C 00 00 00 02 00 00 00 E9 FD 00 00 1E 00 00 00 09 00 00 00 54 69 74 6C 65 E2 98 BA 00 00 00 00 1E 00 00 00 08 00 00 00 53 75 62 6A 65 63 74 00 ); $result = unpack_record( $workbook->{summary} ); is($result, $target, $caption); } ############################################################################### # # Test 17. UTF-8 string used. # SKIP: { skip " \tset_properties(utf8). Test requires Perl 5.8 Unicode support.", 1 if $] < 5.008; $workbook->set_properties( title => 'Title', subject => 'Subject' . $smiley, created => undef, ); $caption = " \tset_properties(utf8)"; $target = join " ", qw( FE FF 00 00 05 01 02 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 E0 85 9F F2 F9 4F 68 10 AB 91 08 00 2B 27 B3 D9 30 00 00 00 4C 00 00 00 03 00 00 00 01 00 00 00 20 00 00 00 02 00 00 00 28 00 00 00 03 00 00 00 38 00 00 00 02 00 00 00 E9 FD 00 00 1E 00 00 00 06 00 00 00 54 69 74 6C 65 00 00 00 1E 00 00 00 0B 00 00 00 53 75 62 6A 65 63 74 E2 98 BA 00 00 ); $result = unpack_record( $workbook->{summary} ); is($result, $target, $caption); } ############################################################################### # # Unpack the binary data into a format suitable for printing in tests. # sub unpack_record { return join ' ', map {sprintf "%02X", $_} unpack "C*", $_[0]; } # Cleanup $workbook->close(); unlink $test_file; __END__