[Feature]add MT2731_MP2_MR2_SVN388 baseline version
Change-Id: Ief04314834b31e27effab435d3ca8ba33b499059
diff --git a/src/bach/build.bach/tools/perl/Crypt/RC4.pm b/src/bach/build.bach/tools/perl/Crypt/RC4.pm
new file mode 100644
index 0000000..acd27a0
--- /dev/null
+++ b/src/bach/build.bach/tools/perl/Crypt/RC4.pm
@@ -0,0 +1,165 @@
+#--------------------------------------------------------------------#
+# Crypt::RC4
+# Date Written: 07-Jun-2000 04:15:55 PM
+# Last Modified: 13-Dec-2001 03:33:49 PM
+# Author: Kurt Kincaid (sifukurt@yahoo.com)
+# Copyright (c) 2001, Kurt Kincaid
+# All Rights Reserved.
+#
+# This is free software and may be modified and/or
+# redistributed under the same terms as Perl itself.
+#--------------------------------------------------------------------#
+
+package Crypt::RC4;
+
+use strict;
+use vars qw( $VERSION @ISA @EXPORT $MAX_CHUNK_SIZE );
+
+$MAX_CHUNK_SIZE = 1024 unless $MAX_CHUNK_SIZE;
+
+require Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(RC4);
+$VERSION = '2.02';
+
+sub new {
+ my ( $class, $key ) = @_;
+ my $self = bless {}, $class;
+ $self->{state} = Setup( $key );
+ $self->{x} = 0;
+ $self->{y} = 0;
+ $self;
+}
+
+sub RC4 {
+ my $self;
+ my( @state, $x, $y );
+ if ( ref $_[0] ) {
+ $self = shift;
+ @state = @{ $self->{state} };
+ $x = $self->{x};
+ $y = $self->{y};
+ } else {
+ @state = Setup( shift );
+ $x = $y = 0;
+ }
+ my $message = shift;
+ my $num_pieces = do {
+ my $num = length($message) / $MAX_CHUNK_SIZE;
+ my $int = int $num;
+ $int == $num ? $int : $int+1;
+ };
+ for my $piece ( 0..$num_pieces - 1 ) {
+ my @message = unpack "C*", substr($message, $piece * $MAX_CHUNK_SIZE, $MAX_CHUNK_SIZE);
+ for ( @message ) {
+ $x = 0 if ++$x > 255;
+ $y -= 256 if ($y += $state[$x]) > 255;
+ @state[$x, $y] = @state[$y, $x];
+ $_ ^= $state[( $state[$x] + $state[$y] ) % 256];
+ }
+ substr($message, $piece * $MAX_CHUNK_SIZE, $MAX_CHUNK_SIZE) = pack "C*", @message;
+ }
+ if ($self) {
+ $self->{state} = \@state;
+ $self->{x} = $x;
+ $self->{y} = $y;
+ }
+ $message;
+}
+
+sub Setup {
+ my @k = unpack( 'C*', shift );
+ my @state = 0..255;
+ my $y = 0;
+ for my $x (0..255) {
+ $y = ( $k[$x % @k] + $state[$x] + $y ) % 256;
+ @state[$x, $y] = @state[$y, $x];
+ }
+ wantarray ? @state : \@state;
+}
+
+
+1;
+__END__
+
+=head1 NAME
+
+Crypt::RC4 - Perl implementation of the RC4 encryption algorithm
+
+=head1 SYNOPSIS
+
+# Functional Style
+ use Crypt::RC4;
+ $encrypted = RC4( $passphrase, $plaintext );
+ $decrypt = RC4( $passphrase, $encrypted );
+
+# OO Style
+ use Crypt::RC4;
+ $ref = Crypt::RC4->new( $passphrase );
+ $encrypted = $ref->RC4( $plaintext );
+
+ $ref2 = Crypt::RC4->new( $passphrase );
+ $decrypted = $ref2->RC4( $encrypted );
+
+# process an entire file, one line at a time
+# (Warning: Encrypted file leaks line lengths.)
+ $ref3 = Crypt::RC4->new( $passphrase );
+ while (<FILE>) {
+ chomp;
+ print $ref3->RC4($_), "\n";
+ }
+
+=head1 DESCRIPTION
+
+A simple implementation of the RC4 algorithm, developed by RSA Security, Inc. Here is the description
+from RSA's website:
+
+RC4 is a stream cipher designed by Rivest for RSA Data Security (now RSA Security). It is a variable
+key-size stream cipher with byte-oriented operations. The algorithm is based on the use of a random
+permutation. Analysis shows that the period of the cipher is overwhelmingly likely to be greater than
+10100. Eight to sixteen machine operations are required per output byte, and the cipher can be
+expected to run very quickly in software. Independent analysts have scrutinized the algorithm and it
+is considered secure.
+
+Based substantially on the "RC4 in 3 lines of perl" found at http://www.cypherspace.org
+
+A major bug in v1.0 was fixed by David Hook (dgh@wumpus.com.au). Thanks, David.
+
+=head1 AUTHOR
+
+Kurt Kincaid (sifukurt@yahoo.com)
+Ronald Rivest for RSA Security, Inc.
+
+=head1 BUGS
+
+Disclaimer: Strictly speaking, this module uses the "alleged" RC4
+algorithm. The Algorithm known as "RC4" is a trademark of RSA Security
+Inc., and this document makes no claims one way or another that this
+is the correct algorithm, and further, make no claims about the
+quality of the source code nor any licensing requirements for
+commercial use.
+
+There's nothing preventing you from using this module in an insecure
+way which leaks information. For example, encrypting multilple
+messages with the same passphrase may allow an attacker to decode all of
+them with little effort, even though they'll appear to be secured. If
+serious crypto is your goal, be careful. Be very careful.
+
+It's a pure-Perl implementation, so that rating of "Eight
+to sixteen machine operations" is good for nothing but a good laugh.
+If encryption and decryption are a bottleneck for you, please re-write
+this module to use native code wherever practical.
+
+=head1 LICENSE
+
+This is free software and may be modified and/or
+redistributed under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+L<perl>, L<http://www.cypherspace.org>, L<http://www.rsasecurity.com>,
+L<http://www.achtung.com/crypto/rc4.html>,
+L<http://www.columbia.edu/~ariel/ssleay/rrc4.html>
+
+=cut
diff --git a/src/bach/build.bach/tools/perl/Digest/Perl/MD5.pm b/src/bach/build.bach/tools/perl/Digest/Perl/MD5.pm
new file mode 100644
index 0000000..e81877c
--- /dev/null
+++ b/src/bach/build.bach/tools/perl/Digest/Perl/MD5.pm
@@ -0,0 +1,481 @@
+#! /usr/bin/false
+#
+# $Id: MD5.pm,v 1.23 2004/08/27 20:28:25 lackas Exp $
+#
+
+package Digest::Perl::MD5;
+use strict;
+use integer;
+use Exporter;
+use vars qw($VERSION @ISA @EXPORTER @EXPORT_OK);
+
+@EXPORT_OK = qw(md5 md5_hex md5_base64);
+
+@ISA = 'Exporter';
+$VERSION = '1.8';
+
+# I-Vektor
+sub A() { 0x67_45_23_01 }
+sub B() { 0xef_cd_ab_89 }
+sub C() { 0x98_ba_dc_fe }
+sub D() { 0x10_32_54_76 }
+
+# for internal use
+sub MAX() { 0xFFFFFFFF }
+
+# padd a message to a multiple of 64
+sub padding {
+ my $l = length (my $msg = shift() . chr(128));
+ $msg .= "\0" x (($l%64<=56?56:120)-$l%64);
+ $l = ($l-1)*8;
+ $msg .= pack 'VV', $l & MAX , ($l >> 16 >> 16);
+}
+
+
+sub rotate_left($$) {
+ #$_[0] << $_[1] | $_[0] >> (32 - $_[1]);
+ #my $right = $_[0] >> (32 - $_[1]);
+ #my $rmask = (1 << $_[1]) - 1;
+ ($_[0] << $_[1]) | (( $_[0] >> (32 - $_[1]) ) & ((1 << $_[1]) - 1));
+ #$_[0] << $_[1] | (($_[0]>> (32 - $_[1])) & (1 << (32 - $_[1])) - 1);
+}
+
+sub gen_code {
+ # Discard upper 32 bits on 64 bit archs.
+ my $MSK = ((1 << 16) << 16) ? ' & ' . MAX : '';
+# FF => "X0=rotate_left(((X1&X2)|(~X1&X3))+X0+X4+X6$MSK,X5)+X1$MSK;",
+# GG => "X0=rotate_left(((X1&X3)|(X2&(~X3)))+X0+X4+X6$MSK,X5)+X1$MSK;",
+ my %f = (
+ FF => "X0=rotate_left((X3^(X1&(X2^X3)))+X0+X4+X6$MSK,X5)+X1$MSK;",
+ GG => "X0=rotate_left((X2^(X3&(X1^X2)))+X0+X4+X6$MSK,X5)+X1$MSK;",
+ HH => "X0=rotate_left((X1^X2^X3)+X0+X4+X6$MSK,X5)+X1$MSK;",
+ II => "X0=rotate_left((X2^(X1|(~X3)))+X0+X4+X6$MSK,X5)+X1$MSK;",
+ );
+ #unless ( (1 << 16) << 16) { %f = %{$CODES{'32bit'}} }
+ #else { %f = %{$CODES{'64bit'}} }
+
+ my %s = ( # shift lengths
+ S11 => 7, S12 => 12, S13 => 17, S14 => 22, S21 => 5, S22 => 9, S23 => 14,
+ S24 => 20, S31 => 4, S32 => 11, S33 => 16, S34 => 23, S41 => 6, S42 => 10,
+ S43 => 15, S44 => 21
+ );
+
+ my $insert = "\n";
+ while(<DATA>) {
+ chomp;
+ next unless /^[FGHI]/;
+ my ($func,@x) = split /,/;
+ my $c = $f{$func};
+ $c =~ s/X(\d)/$x[$1]/g;
+ $c =~ s/(S\d{2})/$s{$1}/;
+ $c =~ s/^(.*)=rotate_left\((.*),(.*)\)\+(.*)$//;
+
+ my $su = 32 - $3;
+ my $sh = (1 << $3) - 1;
+
+ $c = "$1=(((\$r=$2)<<$3)|((\$r>>$su)&$sh))+$4";
+
+ #my $rotate = "(($2 << $3) || (($2 >> (32 - $3)) & (1 << $2) - 1)))";
+ # $c = "\$r = $2;
+ # $1 = ((\$r << $3) | ((\$r >> (32 - $3)) & ((1 << $3) - 1))) + $4";
+ $insert .= "\t$c\n";
+ }
+ close DATA;
+
+ my $dump = '
+ sub round {
+ my ($a,$b,$c,$d) = @_[0 .. 3];
+ my $r;' . $insert . '
+ $_[0]+$a' . $MSK . ', $_[1]+$b ' . $MSK .
+ ', $_[2]+$c' . $MSK . ', $_[3]+$d' . $MSK . ';
+ }';
+ eval $dump;
+ # print "$dump\n";
+ # exit 0;
+}
+
+gen_code();
+
+#########################################
+# Private output converter functions:
+sub _encode_hex { unpack 'H*', $_[0] }
+sub _encode_base64 {
+ my $res;
+ while ($_[0] =~ /(.{1,45})/gs) {
+ $res .= substr pack('u', $1), 1;
+ chop $res;
+ }
+ $res =~ tr|` -_|AA-Za-z0-9+/|;#`
+ chop $res; chop $res;
+ $res
+}
+
+#########################################
+# OOP interface:
+sub new {
+ my $proto = shift;
+ my $class = ref $proto || $proto;
+ my $self = {};
+ bless $self, $class;
+ $self->reset();
+ $self
+}
+
+sub reset {
+ my $self = shift;
+ delete $self->{_data};
+ $self->{_state} = [A,B,C,D];
+ $self->{_length} = 0;
+ $self
+}
+
+sub add {
+ my $self = shift;
+ $self->{_data} .= join '', @_ if @_;
+ my ($i,$c);
+ for $i (0 .. (length $self->{_data})/64-1) {
+ my @X = unpack 'V16', substr $self->{_data}, $i*64, 64;
+ @{$self->{_state}} = round(@{$self->{_state}},@X);
+ ++$c;
+ }
+ if ($c) {
+ substr ($self->{_data}, 0, $c*64) = '';
+ $self->{_length} += $c*64;
+ }
+ $self
+}
+
+sub finalize {
+ my $self = shift;
+ $self->{_data} .= chr(128);
+ my $l = $self->{_length} + length $self->{_data};
+ $self->{_data} .= "\0" x (($l%64<=56?56:120)-$l%64);
+ $l = ($l-1)*8;
+ $self->{_data} .= pack 'VV', $l & MAX , ($l >> 16 >> 16);
+ $self->add();
+ $self
+}
+
+sub addfile {
+ my ($self,$fh) = @_;
+ if (!ref($fh) && ref(\$fh) ne "GLOB") {
+ require Symbol;
+ $fh = Symbol::qualify($fh, scalar caller);
+ }
+ # $self->{_data} .= do{local$/;<$fh>};
+ my $read = 0;
+ my $buffer = '';
+ $self->add($buffer) while $read = read $fh, $buffer, 8192;
+ die __PACKAGE__, " read failed: $!" unless defined $read;
+ $self
+}
+
+sub add_bits {
+ my $self = shift;
+ return $self->add( pack 'B*', shift ) if @_ == 1;
+ my ($b,$n) = @_;
+ die __PACKAGE__, " Invalid number of bits\n" if $n%8;
+ $self->add( substr $b, 0, $n/8 )
+}
+
+sub digest {
+ my $self = shift;
+ $self->finalize();
+ my $res = pack 'V4', @{$self->{_state}};
+ $self->reset();
+ $res
+}
+
+sub hexdigest {
+ _encode_hex($_[0]->digest)
+}
+
+sub b64digest {
+ _encode_base64($_[0]->digest)
+}
+
+sub clone {
+ my $self = shift;
+ my $clone = {
+ _state => [@{$self->{_state}}],
+ _length => $self->{_length},
+ _data => $self->{_data}
+ };
+ bless $clone, ref $self || $self;
+}
+
+#########################################
+# Procedural interface:
+sub md5 {
+ my $message = padding(join'',@_);
+ my ($a,$b,$c,$d) = (A,B,C,D);
+ my $i;
+ for $i (0 .. (length $message)/64-1) {
+ my @X = unpack 'V16', substr $message,$i*64,64;
+ ($a,$b,$c,$d) = round($a,$b,$c,$d,@X);
+ }
+ pack 'V4',$a,$b,$c,$d;
+}
+sub md5_hex { _encode_hex &md5 }
+sub md5_base64 { _encode_base64 &md5 }
+
+
+1;
+
+=head1 NAME
+
+Digest::MD5::Perl - Perl implementation of Ron Rivests MD5 Algorithm
+
+=head1 DISCLAIMER
+
+This is B<not> an interface (like C<Digest::MD5>) but a Perl implementation of MD5.
+It is written in perl only and because of this it is slow but it works without C-Code.
+You should use C<Digest::MD5> instead of this module if it is available.
+This module is only usefull for
+
+=over 4
+
+=item
+
+computers where you cannot install C<Digest::MD5> (e.g. lack of a C-Compiler)
+
+=item
+
+encrypting only small amounts of data (less than one million bytes). I use it to
+hash passwords.
+
+=item
+
+educational purposes
+
+=back
+
+=head1 SYNOPSIS
+
+ # Functional style
+ use Digest::MD5 qw(md5 md5_hex md5_base64);
+
+ $hash = md5 $data;
+ $hash = md5_hex $data;
+ $hash = md5_base64 $data;
+
+
+ # OO style
+ use Digest::MD5;
+
+ $ctx = Digest::MD5->new;
+
+ $ctx->add($data);
+ $ctx->addfile(*FILE);
+
+ $digest = $ctx->digest;
+ $digest = $ctx->hexdigest;
+ $digest = $ctx->b64digest;
+
+=head1 DESCRIPTION
+
+This modules has the same interface as the much faster C<Digest::MD5>. So you can
+easily exchange them, e.g.
+
+ BEGIN {
+ eval {
+ require Digest::MD5;
+ import Digest::MD5 'md5_hex'
+ };
+ if ($@) { # ups, no Digest::MD5
+ require Digest::Perl::MD5;
+ import Digest::Perl::MD5 'md5_hex'
+ }
+ }
+
+If the C<Digest::MD5> module is available it is used and if not you take
+C<Digest::Perl::MD5>.
+
+You can also install the Perl part of Digest::MD5 together with Digest::Perl::MD5
+and use Digest::MD5 as normal, it falls back to Digest::Perl::MD5 if it
+cannot load its object files.
+
+For a detailed Documentation see the C<Digest::MD5> module.
+
+=head1 EXAMPLES
+
+The simplest way to use this library is to import the md5_hex()
+function (or one of its cousins):
+
+ use Digest::Perl::MD5 'md5_hex';
+ print 'Digest is ', md5_hex('foobarbaz'), "\n";
+
+The above example would print out the message
+
+ Digest is 6df23dc03f9b54cc38a0fc1483df6e21
+
+provided that the implementation is working correctly. The same
+checksum can also be calculated in OO style:
+
+ use Digest::MD5;
+
+ $md5 = Digest::MD5->new;
+ $md5->add('foo', 'bar');
+ $md5->add('baz');
+ $digest = $md5->hexdigest;
+
+ print "Digest is $digest\n";
+
+The digest methods are destructive. That means you can only call them
+once and the $md5 objects is reset after use. You can make a copy with clone:
+
+ $md5->clone->hexdigest
+
+=head1 LIMITATIONS
+
+This implementation of the MD5 algorithm has some limitations:
+
+=over 4
+
+=item
+
+It's slow, very slow. I've done my very best but Digest::MD5 is still about 100 times faster.
+You can only encrypt Data up to one million bytes in an acceptable time. But it's very usefull
+for encrypting small amounts of data like passwords.
+
+=item
+
+You can only encrypt up to 2^32 bits = 512 MB on 32bit archs. But You should
+use C<Digest::MD5> for those amounts of data anyway.
+
+=back
+
+=head1 SEE ALSO
+
+L<Digest::MD5>
+
+L<md5(1)>
+
+RFC 1321
+
+tools/md5: a small BSD compatible md5 tool written in pure perl.
+
+=head1 COPYRIGHT
+
+This library is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+ Copyright 2000 Christian Lackas, Imperia Software Solutions
+ Copyright 1998-1999 Gisle Aas.
+ Copyright 1995-1996 Neil Winton.
+ Copyright 1991-1992 RSA Data Security, Inc.
+
+The MD5 algorithm is defined in RFC 1321. The basic C code
+implementing the algorithm is derived from that in the RFC and is
+covered by the following copyright:
+
+=over 4
+
+=item
+
+Copyright (C) 1991-1992, RSA Data Security, Inc. Created 1991. All
+rights reserved.
+
+License to copy and use this software is granted provided that it
+is identified as the "RSA Data Security, Inc. MD5 Message-Digest
+Algorithm" in all material mentioning or referencing this software
+or this function.
+
+License is also granted to make and use derivative works provided
+that such works are identified as "derived from the RSA Data
+Security, Inc. MD5 Message-Digest Algorithm" in all material
+mentioning or referencing the derived work.
+
+RSA Data Security, Inc. makes no representations concerning either
+the merchantability of this software or the suitability of this
+software for any particular purpose. It is provided "as is"
+without express or implied warranty of any kind.
+
+These notices must be retained in any copies of any part of this
+documentation and/or software.
+
+=back
+
+This copyright does not prohibit distribution of any version of Perl
+containing this extension under the terms of the GNU or Artistic
+licenses.
+
+=head1 AUTHORS
+
+The original MD5 interface was written by Neil Winton
+(<N.Winton (at) axion.bt.co.uk>).
+
+C<Digest::MD5> was made by Gisle Aas <gisle (at) aas.no> (I took his Interface
+and part of the documentation).
+
+Thanks to Guido Flohr for his 'use integer'-hint.
+
+This release was made by Christian Lackas <delta (at) lackas.net>.
+
+=cut
+
+__DATA__
+FF,$a,$b,$c,$d,$_[4],7,0xd76aa478,/* 1 */
+FF,$d,$a,$b,$c,$_[5],12,0xe8c7b756,/* 2 */
+FF,$c,$d,$a,$b,$_[6],17,0x242070db,/* 3 */
+FF,$b,$c,$d,$a,$_[7],22,0xc1bdceee,/* 4 */
+FF,$a,$b,$c,$d,$_[8],7,0xf57c0faf,/* 5 */
+FF,$d,$a,$b,$c,$_[9],12,0x4787c62a,/* 6 */
+FF,$c,$d,$a,$b,$_[10],17,0xa8304613,/* 7 */
+FF,$b,$c,$d,$a,$_[11],22,0xfd469501,/* 8 */
+FF,$a,$b,$c,$d,$_[12],7,0x698098d8,/* 9 */
+FF,$d,$a,$b,$c,$_[13],12,0x8b44f7af,/* 10 */
+FF,$c,$d,$a,$b,$_[14],17,0xffff5bb1,/* 11 */
+FF,$b,$c,$d,$a,$_[15],22,0x895cd7be,/* 12 */
+FF,$a,$b,$c,$d,$_[16],7,0x6b901122,/* 13 */
+FF,$d,$a,$b,$c,$_[17],12,0xfd987193,/* 14 */
+FF,$c,$d,$a,$b,$_[18],17,0xa679438e,/* 15 */
+FF,$b,$c,$d,$a,$_[19],22,0x49b40821,/* 16 */
+GG,$a,$b,$c,$d,$_[5],5,0xf61e2562,/* 17 */
+GG,$d,$a,$b,$c,$_[10],9,0xc040b340,/* 18 */
+GG,$c,$d,$a,$b,$_[15],14,0x265e5a51,/* 19 */
+GG,$b,$c,$d,$a,$_[4],20,0xe9b6c7aa,/* 20 */
+GG,$a,$b,$c,$d,$_[9],5,0xd62f105d,/* 21 */
+GG,$d,$a,$b,$c,$_[14],9,0x2441453,/* 22 */
+GG,$c,$d,$a,$b,$_[19],14,0xd8a1e681,/* 23 */
+GG,$b,$c,$d,$a,$_[8],20,0xe7d3fbc8,/* 24 */
+GG,$a,$b,$c,$d,$_[13],5,0x21e1cde6,/* 25 */
+GG,$d,$a,$b,$c,$_[18],9,0xc33707d6,/* 26 */
+GG,$c,$d,$a,$b,$_[7],14,0xf4d50d87,/* 27 */
+GG,$b,$c,$d,$a,$_[12],20,0x455a14ed,/* 28 */
+GG,$a,$b,$c,$d,$_[17],5,0xa9e3e905,/* 29 */
+GG,$d,$a,$b,$c,$_[6],9,0xfcefa3f8,/* 30 */
+GG,$c,$d,$a,$b,$_[11],14,0x676f02d9,/* 31 */
+GG,$b,$c,$d,$a,$_[16],20,0x8d2a4c8a,/* 32 */
+HH,$a,$b,$c,$d,$_[9],4,0xfffa3942,/* 33 */
+HH,$d,$a,$b,$c,$_[12],11,0x8771f681,/* 34 */
+HH,$c,$d,$a,$b,$_[15],16,0x6d9d6122,/* 35 */
+HH,$b,$c,$d,$a,$_[18],23,0xfde5380c,/* 36 */
+HH,$a,$b,$c,$d,$_[5],4,0xa4beea44,/* 37 */
+HH,$d,$a,$b,$c,$_[8],11,0x4bdecfa9,/* 38 */
+HH,$c,$d,$a,$b,$_[11],16,0xf6bb4b60,/* 39 */
+HH,$b,$c,$d,$a,$_[14],23,0xbebfbc70,/* 40 */
+HH,$a,$b,$c,$d,$_[17],4,0x289b7ec6,/* 41 */
+HH,$d,$a,$b,$c,$_[4],11,0xeaa127fa,/* 42 */
+HH,$c,$d,$a,$b,$_[7],16,0xd4ef3085,/* 43 */
+HH,$b,$c,$d,$a,$_[10],23,0x4881d05,/* 44 */
+HH,$a,$b,$c,$d,$_[13],4,0xd9d4d039,/* 45 */
+HH,$d,$a,$b,$c,$_[16],11,0xe6db99e5,/* 46 */
+HH,$c,$d,$a,$b,$_[19],16,0x1fa27cf8,/* 47 */
+HH,$b,$c,$d,$a,$_[6],23,0xc4ac5665,/* 48 */
+II,$a,$b,$c,$d,$_[4],6,0xf4292244,/* 49 */
+II,$d,$a,$b,$c,$_[11],10,0x432aff97,/* 50 */
+II,$c,$d,$a,$b,$_[18],15,0xab9423a7,/* 51 */
+II,$b,$c,$d,$a,$_[9],21,0xfc93a039,/* 52 */
+II,$a,$b,$c,$d,$_[16],6,0x655b59c3,/* 53 */
+II,$d,$a,$b,$c,$_[7],10,0x8f0ccc92,/* 54 */
+II,$c,$d,$a,$b,$_[14],15,0xffeff47d,/* 55 */
+II,$b,$c,$d,$a,$_[5],21,0x85845dd1,/* 56 */
+II,$a,$b,$c,$d,$_[12],6,0x6fa87e4f,/* 57 */
+II,$d,$a,$b,$c,$_[19],10,0xfe2ce6e0,/* 58 */
+II,$c,$d,$a,$b,$_[10],15,0xa3014314,/* 59 */
+II,$b,$c,$d,$a,$_[17],21,0x4e0811a1,/* 60 */
+II,$a,$b,$c,$d,$_[8],6,0xf7537e82,/* 61 */
+II,$d,$a,$b,$c,$_[15],10,0xbd3af235,/* 62 */
+II,$c,$d,$a,$b,$_[6],15,0x2ad7d2bb,/* 63 */
+II,$b,$c,$d,$a,$_[13],21,0xeb86d391,/* 64 */
diff --git a/src/bach/build.bach/tools/perl/OLE/Storage_Lite.pm b/src/bach/build.bach/tools/perl/OLE/Storage_Lite.pm
new file mode 100644
index 0000000..3ea2a57
--- /dev/null
+++ b/src/bach/build.bach/tools/perl/OLE/Storage_Lite.pm
@@ -0,0 +1,1686 @@
+# 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("<iofile.xls");
+ binmode($oIo);
+ my $oOl = OLE::Storage_Lite->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<new()> constructor also accepts a valid filehandle. Remember to C<binmode()> 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<OLE::Storage_Lite::PPS> 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<new()> constructor also accepts a valid filehandle. Remember to C<binmode()> 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<append> 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<OLE::Storage_Lite> autovivified a scalar ref in the C<new()> 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<Open Specification Promise>. 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
diff --git a/src/bach/build.bach/tools/perl/Spreadsheet/ParseExcel.pm b/src/bach/build.bach/tools/perl/Spreadsheet/ParseExcel.pm
new file mode 100644
index 0000000..57554aa
--- /dev/null
+++ b/src/bach/build.bach/tools/perl/Spreadsheet/ParseExcel.pm
@@ -0,0 +1,3323 @@
+package Spreadsheet::ParseExcel;
+
+##############################################################################
+#
+# Spreadsheet::ParseExcel - Extract information from an Excel file.
+#
+# Copyright 2000-2008, Takanori Kawai
+#
+# perltidy with standard settings.
+#
+# Documentation after __END__
+#
+
+use strict;
+use warnings;
+use 5.008;
+
+use OLE::Storage_Lite;
+use IO::File;
+use Config;
+
+use Crypt::RC4;
+use Digest::Perl::MD5;
+
+our $VERSION = '0.59';
+
+use Spreadsheet::ParseExcel::Workbook;
+use Spreadsheet::ParseExcel::Worksheet;
+use Spreadsheet::ParseExcel::Font;
+use Spreadsheet::ParseExcel::Format;
+use Spreadsheet::ParseExcel::Cell;
+use Spreadsheet::ParseExcel::FmtDefault;
+
+my @aColor = (
+ '000000', # 0x00
+ 'FFFFFF', 'FFFFFF', 'FFFFFF', 'FFFFFF',
+ 'FFFFFF', 'FFFFFF', 'FFFFFF', 'FFFFFF', # 0x08
+ 'FFFFFF', 'FF0000', '00FF00', '0000FF',
+ 'FFFF00', 'FF00FF', '00FFFF', '800000', # 0x10
+ '008000', '000080', '808000', '800080',
+ '008080', 'C0C0C0', '808080', '9999FF', # 0x18
+ '993366', 'FFFFCC', 'CCFFFF', '660066',
+ 'FF8080', '0066CC', 'CCCCFF', '000080', # 0x20
+ 'FF00FF', 'FFFF00', '00FFFF', '800080',
+ '800000', '008080', '0000FF', '00CCFF', # 0x28
+ 'CCFFFF', 'CCFFCC', 'FFFF99', '99CCFF',
+ 'FF99CC', 'CC99FF', 'FFCC99', '3366FF', # 0x30
+ '33CCCC', '99CC00', 'FFCC00', 'FF9900',
+ 'FF6600', '666699', '969696', '003366', # 0x38
+ '339966', '003300', '333300', '993300',
+ '993366', '333399', '333333', 'FFFFFF' # 0x40
+);
+use constant verExcel95 => 0x500;
+use constant verExcel97 => 0x600;
+use constant verBIFF2 => 0x00;
+use constant verBIFF3 => 0x02;
+use constant verBIFF4 => 0x04;
+use constant verBIFF5 => 0x08;
+use constant verBIFF8 => 0x18;
+
+use constant MS_BIFF_CRYPTO_NONE => 0;
+use constant MS_BIFF_CRYPTO_XOR => 1;
+use constant MS_BIFF_CRYPTO_RC4 => 2;
+
+use constant sizeof_BIFF_8_FILEPASS => ( 6 + 3 * 16 );
+
+use constant REKEY_BLOCK => 0x400;
+
+# Error code for some of the common parsing errors.
+use constant ErrorNone => 0;
+use constant ErrorNoFile => 1;
+use constant ErrorNoExcelData => 2;
+use constant ErrorFileEncrypted => 3;
+
+our %error_strings = (
+ ErrorNone, '', # 0
+ ErrorNoFile, 'File not found', # 1
+ ErrorNoExcelData, 'No Excel data found in file', # 2
+ ErrorFileEncrypted, 'File is encrypted', # 3
+
+);
+
+
+our %ProcTbl = (
+
+ #Develpers' Kit P291
+ 0x14 => \&_subHeader, # Header
+ 0x15 => \&_subFooter, # Footer
+ 0x18 => \&_subName, # NAME(?)
+ 0x1A => \&_subVPageBreak, # Vertical Page Break
+ 0x1B => \&_subHPageBreak, # Horizontal Page Break
+ 0x22 => \&_subFlg1904, # 1904 Flag
+ 0x26 => \&_subMargin, # Left Margin
+ 0x27 => \&_subMargin, # Right Margin
+ 0x28 => \&_subMargin, # Top Margin
+ 0x29 => \&_subMargin, # Bottom Margin
+ 0x2A => \&_subPrintHeaders, # Print Headers
+ 0x2B => \&_subPrintGridlines, # Print Gridlines
+ 0x3C => \&_subContinue, # Continue
+ 0x43 => \&_subXF, # XF for Excel < 4.
+ 0x0443 => \&_subXF, # XF for Excel = 4.
+
+ #Develpers' Kit P292
+ 0x55 => \&_subDefColWidth, # Consider
+ 0x5C => \&_subWriteAccess, # WRITEACCESS
+ 0x7D => \&_subColInfo, # Colinfo
+ 0x7E => \&_subRK, # RK
+ 0x81 => \&_subWSBOOL, # WSBOOL
+ 0x83 => \&_subHcenter, # HCENTER
+ 0x84 => \&_subVcenter, # VCENTER
+ 0x85 => \&_subBoundSheet, # BoundSheet
+
+ 0x92 => \&_subPalette, # Palette, fgp
+
+ 0x99 => \&_subStandardWidth, # Standard Col
+
+ #Develpers' Kit P293
+ 0xA1 => \&_subSETUP, # SETUP
+ 0xBD => \&_subMulRK, # MULRK
+ 0xBE => \&_subMulBlank, # MULBLANK
+ 0xD6 => \&_subRString, # RString
+
+ #Develpers' Kit P294
+ 0xE0 => \&_subXF, # ExTended Format
+ 0xE5 => \&_subMergeArea, # MergeArea (Not Documented)
+ 0xFC => \&_subSST, # Shared String Table
+ 0xFD => \&_subLabelSST, # Label SST
+
+ #Develpers' Kit P295
+ 0x201 => \&_subBlank, # Blank
+
+ 0x202 => \&_subInteger, # Integer(Not Documented)
+ 0x203 => \&_subNumber, # Number
+ 0x204 => \&_subLabel, # Label
+ 0x205 => \&_subBoolErr, # BoolErr
+ 0x207 => \&_subString, # STRING
+ 0x208 => \&_subRow, # RowData
+ 0x221 => \&_subArray, # Array (Consider)
+ 0x225 => \&_subDefaultRowHeight, # Consider
+
+ 0x31 => \&_subFont, # Font
+ 0x231 => \&_subFont, # Font
+
+ 0x27E => \&_subRK, # RK
+ 0x41E => \&_subFormat, # Format
+
+ 0x06 => \&_subFormula, # Formula
+ 0x406 => \&_subFormula, # Formula
+
+ 0x009 => \&_subBOF, # BOF(BIFF2)
+ 0x209 => \&_subBOF, # BOF(BIFF3)
+ 0x409 => \&_subBOF, # BOF(BIFF4)
+ 0x809 => \&_subBOF, # BOF(BIFF5-8)
+);
+
+our $BIGENDIAN;
+our $PREFUNC;
+our $_CellHandler;
+our $_NotSetCell;
+our $_Object;
+our $_use_perlio;
+
+#------------------------------------------------------------------------------
+# Spreadsheet::ParseExcel->new
+#------------------------------------------------------------------------------
+sub new {
+ my ( $class, %hParam ) = @_;
+
+ if ( not defined $_use_perlio ) {
+ if ( exists $Config{useperlio}
+ && defined $Config{useperlio}
+ && $Config{useperlio} eq "define" )
+ {
+ $_use_perlio = 1;
+ }
+ else {
+ $_use_perlio = 0;
+ require IO::Scalar;
+ import IO::Scalar;
+ }
+ }
+
+ # Check ENDIAN(Little: Intel etc. BIG: Sparc etc)
+ $BIGENDIAN =
+ ( defined $hParam{Endian} ) ? $hParam{Endian}
+ : ( unpack( "H08", pack( "L", 2 ) ) eq '02000000' ) ? 0
+ : 1;
+ my $self = {};
+ bless $self, $class;
+
+ $self->{GetContent} = \&_subGetContent;
+
+ if ( $hParam{EventHandlers} ) {
+ $self->SetEventHandlers( $hParam{EventHandlers} );
+ }
+ else {
+ $self->SetEventHandlers( \%ProcTbl );
+ }
+ if ( $hParam{AddHandlers} ) {
+ foreach my $sKey ( keys( %{ $hParam{AddHandlers} } ) ) {
+ $self->SetEventHandler( $sKey, $hParam{AddHandlers}->{$sKey} );
+ }
+ }
+ $_CellHandler = $hParam{CellHandler} if ( $hParam{CellHandler} );
+ $_NotSetCell = $hParam{NotSetCell};
+ $_Object = $hParam{Object};
+
+
+ if ( defined $hParam{Password} ) {
+ $self->{Password} = $hParam{Password};
+ }
+ else {
+ $self->{Password} = 'VelvetSweatshop';
+ }
+
+ $self->{_error_status} = ErrorNone;
+ return $self;
+}
+
+#------------------------------------------------------------------------------
+# Spreadsheet::ParseExcel->SetEventHandler
+#------------------------------------------------------------------------------
+sub SetEventHandler {
+ my ( $self, $key, $sub_ref ) = @_;
+ $self->{FuncTbl}->{$key} = $sub_ref;
+}
+
+#------------------------------------------------------------------------------
+# Spreadsheet::ParseExcel->SetEventHandlers
+#------------------------------------------------------------------------------
+sub SetEventHandlers {
+ my ( $self, $rhTbl ) = @_;
+ $self->{FuncTbl} = undef;
+ foreach my $sKey ( keys %$rhTbl ) {
+ $self->{FuncTbl}->{$sKey} = $rhTbl->{$sKey};
+ }
+}
+
+#------------------------------------------------------------------------------
+# Decryption routines
+# based on sources of gnumeric (ms-biff.c ms-excel-read.c)
+#------------------------------------------------------------------------------
+sub md5state {
+ my ( $md5 ) = @_;
+ my $s = '';
+ for ( my $i = 0 ; $i < 4 ; $i++ ) {
+ my $v = $md5->{_state}[$i];
+ $s .= chr( $v & 0xff );
+ $s .= chr( ( $v >> 8 ) & 0xff );
+ $s .= chr( ( $v >> 16 ) & 0xff );
+ $s .= chr( ( $v >> 24 ) & 0xff );
+ }
+
+ return $s;
+}
+
+sub MakeKey {
+ my ( $block, $key, $valContext ) = @_;
+
+ my $pwarray = "\0" x 64;
+
+ substr( $pwarray, 0, 5 ) = substr( $valContext, 0, 5 );
+
+ substr( $pwarray, 5, 1 ) = chr( $block & 0xff );
+ substr( $pwarray, 6, 1 ) = chr( ( $block >> 8 ) & 0xff );
+ substr( $pwarray, 7, 1 ) = chr( ( $block >> 16 ) & 0xff );
+ substr( $pwarray, 8, 1 ) = chr( ( $block >> 24 ) & 0xff );
+
+ substr( $pwarray, 9, 1 ) = "\x80";
+ substr( $pwarray, 56, 1 ) = "\x48";
+
+ my $md5 = Digest::Perl::MD5->new();
+ $md5->add( $pwarray );
+
+ my $s = md5state( $md5 );
+
+ ${$key} = Crypt::RC4->new( $s );
+}
+
+sub VerifyPassword {
+ my ( $password, $docid, $salt_data, $hashedsalt_data, $valContext ) = @_;
+
+ my $pwarray = "\0" x 64;
+ my $i;
+ my $md5 = Digest::Perl::MD5->new();
+
+ for ( $i = 0 ; $i < length( $password ) ; $i++ ) {
+ my $o = ord( substr( $password, $i, 1 ) );
+ substr( $pwarray, 2 * $i, 1 ) = chr( $o & 0xff );
+ substr( $pwarray, 2 * $i + 1, 1 ) = chr( ( $o >> 8 ) & 0xff );
+ }
+ substr( $pwarray, 2 * $i, 1 ) = chr( 0x80 );
+ substr( $pwarray, 56, 1 ) = chr( ( $i << 4 ) & 0xff );
+
+ $md5->add( $pwarray );
+
+ my $mdContext1 = md5state( $md5 );
+
+ my $offset = 0;
+ my $keyoffset = 0;
+ my $tocopy = 5;
+
+ $md5->reset;
+
+ while ( $offset != 16 ) {
+ if ( ( 64 - $offset ) < 5 ) {
+ $tocopy = 64 - $offset;
+ }
+
+ substr( $pwarray, $offset, $tocopy ) =
+ substr( $mdContext1, $keyoffset, $tocopy );
+
+ $offset += $tocopy;
+
+ if ( $offset == 64 ) {
+ $md5->add( $pwarray );
+ $keyoffset = $tocopy;
+ $tocopy = 5 - $tocopy;
+ $offset = 0;
+ next;
+ }
+
+ $keyoffset = 0;
+ $tocopy = 5;
+ substr( $pwarray, $offset, 16 ) = $docid;
+ $offset += 16;
+ }
+
+ substr( $pwarray, 16, 1 ) = "\x80";
+ substr( $pwarray, 17, 47 ) = "\0" x 47;
+ substr( $pwarray, 56, 1 ) = "\x80";
+ substr( $pwarray, 57, 1 ) = "\x0a";
+
+ $md5->add( $pwarray );
+ ${$valContext} = md5state( $md5 );
+
+ my $key;
+
+ MakeKey( 0, \$key, ${$valContext} );
+
+ my $salt = $key->RC4( $salt_data );
+ my $hashedsalt = $key->RC4( $hashedsalt_data );
+
+ $salt .= "\x80" . "\0" x 47;
+
+ substr( $salt, 56, 1 ) = "\x80";
+
+ $md5->reset;
+ $md5->add( $salt );
+ my $mdContext2 = md5state( $md5 );
+
+ return ( $mdContext2 eq $hashedsalt );
+}
+
+sub SkipBytes {
+ my ( $q, $start, $count ) = @_;
+
+ my $scratch = "\0" x REKEY_BLOCK;
+ my $block;
+
+ $block = int( ( $start + $count ) / REKEY_BLOCK );
+
+ if ( $block != $q->{block} ) {
+ MakeKey( $q->{block} = $block, \$q->{rc4_key}, $q->{md5_ctxt} );
+ $count = ( $start + $count ) % REKEY_BLOCK;
+ }
+
+ $q->{rc4_key}->RC4( substr( $scratch, 0, $count ) );
+
+ return 1;
+}
+
+sub SetDecrypt {
+ my ( $q, $version, $password ) = @_;
+
+ if ( $q->{opcode} != 0x2f ) {
+ return 0;
+ }
+
+ if ( $password eq '' ) {
+ return 0;
+ }
+
+ # TODO old versions decryption
+ #if (version < MS_BIFF_V8 || q->data[0] == 0)
+ # return ms_biff_pre_biff8_query_set_decrypt (q, password);
+
+ if ( $q->{length} != sizeof_BIFF_8_FILEPASS ) {
+ return 0;
+ }
+
+ unless (
+ VerifyPassword(
+ $password,
+ substr( $q->{data}, 6, 16 ),
+ substr( $q->{data}, 22, 16 ),
+ substr( $q->{data}, 38, 16 ),
+ \$q->{md5_ctxt}
+ )
+ )
+ {
+ return 0;
+ }
+
+ $q->{encryption} = MS_BIFF_CRYPTO_RC4;
+ $q->{block} = -1;
+
+ # The first record after FILEPASS seems to be unencrypted
+ $q->{dont_decrypt_next_record} = 1;
+
+ # Pretend to decrypt the entire stream up till this point, it was
+ # encrypted, but do it anyway to keep the rc4 state in sync
+
+ SkipBytes( $q, 0, $q->{streamPos} );
+
+ return 1;
+}
+
+sub InitStream {
+ my ( $stream_data ) = @_;
+ my %q;
+
+ $q{opcode} = 0;
+ $q{length} = 0;
+ $q{data} = '';
+
+ $q{stream} = $stream_data; # data stream
+ $q{streamLen} = length( $stream_data ); # stream length
+ $q{streamPos} = 0; # stream position
+
+ $q{encryption} = 0;
+ $q{xor_key} = '';
+ $q{rc4_key} = '';
+ $q{md5_ctxt} = '';
+ $q{block} = 0;
+ $q{dont_decrypt_next_record} = 0;
+
+ return \%q;
+}
+
+sub QueryNext {
+ my ( $q ) = @_;
+
+ if ( $q->{streamPos} + 4 >= $q->{streamLen} ) {
+ return 0;
+ }
+
+ my $data = substr( $q->{stream}, $q->{streamPos}, 4 );
+
+ ( $q->{opcode}, $q->{length} ) = unpack( 'v2', $data );
+
+ # No biff record should be larger than around 20,000.
+ if ( $q->{length} >= 20000 ) {
+ return 0;
+ }
+
+ if ( $q->{length} > 0 ) {
+ $q->{data} = substr( $q->{stream}, $q->{streamPos} + 4, $q->{length} );
+ }
+ else {
+ $q->{data} = undef;
+ $q->{dont_decrypt_next_record} = 1;
+ }
+
+ if ( $q->{encryption} == MS_BIFF_CRYPTO_RC4 ) {
+ if ( $q->{dont_decrypt_next_record} ) {
+ SkipBytes( $q, $q->{streamPos}, 4 + $q->{length} );
+ $q->{dont_decrypt_next_record} = 0;
+ }
+ else {
+ my $pos = $q->{streamPos};
+ my $data = $q->{data};
+ my $len = $q->{length};
+ my $res = '';
+
+ # Pretend to decrypt header.
+ SkipBytes( $q, $pos, 4 );
+ $pos += 4;
+
+ while ( $q->{block} != int( ( $pos + $len ) / REKEY_BLOCK ) ) {
+ my $step = REKEY_BLOCK - ( $pos % REKEY_BLOCK );
+ $res .= $q->{rc4_key}->RC4( substr( $data, 0, $step ) );
+ $data = substr( $data, $step );
+ $pos += $step;
+ $len -= $step;
+ MakeKey( ++$q->{block}, \$q->{rc4_key}, $q->{md5_ctxt} );
+ }
+
+ $res .= $q->{rc4_key}->RC4( substr( $data, 0, $len ) );
+ $q->{data} = $res;
+ }
+ }
+ elsif ( $q->{encryption} == MS_BIFF_CRYPTO_XOR ) {
+
+ # not implemented
+ return 0;
+ }
+ elsif ( $q->{encryption} == MS_BIFF_CRYPTO_NONE ) {
+
+ }
+
+ $q->{streamPos} += 4 + $q->{length};
+
+ return 1;
+}
+
+###############################################################################
+#
+# Parse()
+#
+# Parse the Excel file and convert it into a tree of objects..
+#
+sub parse {
+
+ my ( $self, $source, $formatter ) = @_;
+
+ my $workbook = Spreadsheet::ParseExcel::Workbook->new();
+ $workbook->{SheetCount} = 0;
+
+ my ( $biff_data, $data_length ) = $self->_get_content( $source, $workbook );
+ return undef if not $biff_data;
+
+ if ( $formatter ) {
+ $workbook->{FmtClass} = $formatter;
+ }
+ else {
+ $workbook->{FmtClass} = Spreadsheet::ParseExcel::FmtDefault->new();
+ }
+
+ # Parse the BIFF data.
+ my $stream = InitStream( $biff_data );
+
+ while ( QueryNext( $stream ) ) {
+
+ my $record = $stream->{opcode};
+ my $record_length = $stream->{length};
+
+ my $record_header = $stream->{data};
+
+ # If the file contains a FILEPASS record we assume that it is encrypted
+ # and cannot be parsed.
+ if ( $record == 0x002F ) {
+ unless ( SetDecrypt( $stream, '', $self->{Password} ) ) {
+ $self->{_error_status} = ErrorFileEncrypted;
+ return undef;
+ }
+ }
+
+ # Special case of a formula String with no string.
+ if ( $workbook->{_PrevPos}
+ && ( defined $self->{FuncTbl}->{$record} )
+ && ( $record != 0x207 ) )
+ {
+ my $iPos = $workbook->{_PrevPos};
+ $workbook->{_PrevPos} = undef;
+
+ my ( $row, $col, $format_index ) = @$iPos;
+ _NewCell(
+ $workbook, $row, $col,
+ Kind => 'Formula String',
+ Val => '',
+ FormatNo => $format_index,
+ Format => $workbook->{Format}[$format_index],
+ Numeric => 0,
+ Code => undef,
+ Book => $workbook,
+ );
+ }
+
+ # If the BIFF record matches 0x0*09 then it is a BOF record.
+ # We reset the _skip_chart flag to ensure we check the sheet type.
+ if ( ( $record & 0xF0FF ) == 0x09 ) {
+ $workbook->{_skip_chart} = 0;
+ }
+
+ if ( defined $self->{FuncTbl}->{$record} && !$workbook->{_skip_chart} )
+ {
+ $self->{FuncTbl}->{$record}
+ ->( $workbook, $record, $record_length, $record_header );
+ }
+
+ $PREFUNC = $record if ( $record != 0x3C ); #Not Continue
+
+ return $workbook if defined $workbook->{_ParseAbort};
+ }
+
+ return $workbook;
+}
+
+###############################################################################
+#
+# _get_content()
+#
+# Get the Excel BIFF content from the file or filehandle.
+#
+sub _get_content {
+
+ my ( $self, $source, $workbook ) = @_;
+ my ( $biff_data, $data_length );
+
+ # Reset the error status in case method is called more than once.
+ $self->{_error_status} = ErrorNone;
+
+ if ( ref( $source ) eq "SCALAR" ) {
+
+ # Specified by a scalar buffer.
+ ( $biff_data, $data_length ) = $self->{GetContent}->( $source );
+
+ }
+ elsif ( ( ref( $source ) =~ /GLOB/ ) || ( ref( $source ) eq 'Fh' ) ) {
+
+ # For CGI.pm (Light FileHandle)
+ binmode( $source );
+ my $sWk;
+ my $sBuff = '';
+
+ while ( read( $source, $sWk, 4096 ) ) {
+ $sBuff .= $sWk;
+ }
+
+ ( $biff_data, $data_length ) = $self->{GetContent}->( \$sBuff );
+
+ }
+ elsif ( ref( $source ) eq 'ARRAY' ) {
+
+ # Specified by file content
+ $workbook->{File} = undef;
+ my $sData = join( '', @$source );
+ ( $biff_data, $data_length ) = $self->{GetContent}->( \$sData );
+ }
+ else {
+
+ # Specified by filename .
+ $workbook->{File} = $source;
+
+ if ( !-e $source ) {
+ $self->{_error_status} = ErrorNoFile;
+ return undef;
+ }
+
+ ( $biff_data, $data_length ) = $self->{GetContent}->( $source );
+ }
+
+ # If the read was successful return the data.
+ if ( $data_length ) {
+ return ( $biff_data, $data_length );
+ }
+ else {
+ $self->{_error_status} = ErrorNoExcelData;
+ return undef;
+ }
+
+}
+
+#------------------------------------------------------------------------------
+# _subGetContent (for Spreadsheet::ParseExcel)
+#------------------------------------------------------------------------------
+sub _subGetContent {
+ my ( $sFile ) = @_;
+
+ my $oOl = OLE::Storage_Lite->new( $sFile );
+ return ( undef, undef ) unless ( $oOl );
+ my @aRes = $oOl->getPpsSearch(
+ [
+ OLE::Storage_Lite::Asc2Ucs( 'Book' ),
+ OLE::Storage_Lite::Asc2Ucs( 'Workbook' )
+ ],
+ 1, 1
+ );
+ return ( undef, undef ) if ( $#aRes < 0 );
+
+ #Hack from Herbert
+ if ( $aRes[0]->{Data} ) {
+ return ( $aRes[0]->{Data}, length( $aRes[0]->{Data} ) );
+ }
+
+ #Same as OLE::Storage_Lite
+ my $oIo;
+
+ #1. $sFile is Ref of scalar
+ if ( ref( $sFile ) eq 'SCALAR' ) {
+ if ( $_use_perlio ) {
+ open $oIo, "<", \$sFile;
+ }
+ else {
+ $oIo = IO::Scalar->new;
+ $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 = IO::File->new;
+ $oIo->open( "<$sFile" ) || return undef;
+ binmode( $oIo );
+ }
+ my $sWk;
+ my $sBuff = '';
+
+ while ( $oIo->read( $sWk, 4096 ) ) { #4_096 has no special meanings
+ $sBuff .= $sWk;
+ }
+ $oIo->close();
+
+ #Not Excel file (simple method)
+ return ( undef, undef ) if ( substr( $sBuff, 0, 1 ) ne "\x09" );
+ return ( $sBuff, length( $sBuff ) );
+}
+
+#------------------------------------------------------------------------------
+# _subBOF (for Spreadsheet::ParseExcel) Developers' Kit : P303
+#------------------------------------------------------------------------------
+sub _subBOF {
+ my ( $oBook, $bOp, $bLen, $sWk ) = @_;
+ my ( $iVer, $iDt ) = unpack( "v2", $sWk );
+
+ #Workbook Global
+ if ( $iDt == 0x0005 ) {
+ $oBook->{Version} = unpack( "v", $sWk );
+ $oBook->{BIFFVersion} =
+ ( $oBook->{Version} == verExcel95 ) ? verBIFF5 : verBIFF8;
+ $oBook->{_CurSheet} = undef;
+ $oBook->{_CurSheet_} = -1;
+ }
+
+ #Worksheet or Dialogsheet
+ elsif ( $iDt != 0x0020 ) { #if($iDt == 0x0010)
+ if ( defined $oBook->{_CurSheet_} ) {
+ $oBook->{_CurSheet} = $oBook->{_CurSheet_} + 1;
+ $oBook->{_CurSheet_}++;
+
+ (
+ $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{SheetVersion},
+ $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{SheetType},
+ )
+ = unpack( "v2", $sWk )
+ if ( length( $sWk ) > 4 );
+ }
+ else {
+ $oBook->{BIFFVersion} = int( $bOp / 0x100 );
+ if ( ( $oBook->{BIFFVersion} == verBIFF2 )
+ || ( $oBook->{BIFFVersion} == verBIFF3 )
+ || ( $oBook->{BIFFVersion} == verBIFF4 ) )
+ {
+ $oBook->{Version} = $oBook->{BIFFVersion};
+ $oBook->{_CurSheet} = 0;
+ $oBook->{Worksheet}[ $oBook->{SheetCount} ] =
+ Spreadsheet::ParseExcel::Worksheet->new(
+ _Name => '',
+ Name => '',
+ _Book => $oBook,
+ _SheetNo => $oBook->{SheetCount},
+ );
+ $oBook->{SheetCount}++;
+ }
+ }
+ }
+ else {
+
+ # Set flag to ignore all chart records until we reach another BOF.
+ $oBook->{_skip_chart} = 1;
+ }
+}
+
+#------------------------------------------------------------------------------
+# _subBlank (for Spreadsheet::ParseExcel) DK:P303
+#------------------------------------------------------------------------------
+sub _subBlank {
+ my ( $oBook, $bOp, $bLen, $sWk ) = @_;
+ my ( $iR, $iC, $iF ) = unpack( "v3", $sWk );
+ _NewCell(
+ $oBook, $iR, $iC,
+ Kind => 'BLANK',
+ Val => '',
+ FormatNo => $iF,
+ Format => $oBook->{Format}[$iF],
+ Numeric => 0,
+ Code => undef,
+ Book => $oBook,
+ );
+
+ #2.MaxRow, MaxCol, MinRow, MinCol
+ _SetDimension( $oBook, $iR, $iC, $iC );
+}
+
+#------------------------------------------------------------------------------
+# _subInteger (for Spreadsheet::ParseExcel) Not in DK
+#------------------------------------------------------------------------------
+sub _subInteger {
+ my ( $oBook, $bOp, $bLen, $sWk ) = @_;
+ my ( $iR, $iC, $iF, $sTxt, $sDum );
+
+ ( $iR, $iC, $iF, $sDum, $sTxt ) = unpack( "v3cv", $sWk );
+ _NewCell(
+ $oBook, $iR, $iC,
+ Kind => 'INTEGER',
+ Val => $sTxt,
+ FormatNo => $iF,
+ Format => $oBook->{Format}[$iF],
+ Numeric => 0,
+ Code => undef,
+ Book => $oBook,
+ );
+
+ #2.MaxRow, MaxCol, MinRow, MinCol
+ _SetDimension( $oBook, $iR, $iC, $iC );
+}
+
+#------------------------------------------------------------------------------
+# _subNumber (for Spreadsheet::ParseExcel) : DK: P354
+#------------------------------------------------------------------------------
+sub _subNumber {
+ my ( $oBook, $bOp, $bLen, $sWk ) = @_;
+
+ my ( $iR, $iC, $iF ) = unpack( "v3", $sWk );
+ my $dVal = _convDval( substr( $sWk, 6, 8 ) );
+ _NewCell(
+ $oBook, $iR, $iC,
+ Kind => 'Number',
+ Val => $dVal,
+ FormatNo => $iF,
+ Format => $oBook->{Format}[$iF],
+ Numeric => 1,
+ Code => undef,
+ Book => $oBook,
+ );
+
+ #2.MaxRow, MaxCol, MinRow, MinCol
+ _SetDimension( $oBook, $iR, $iC, $iC );
+}
+
+#------------------------------------------------------------------------------
+# _convDval (for Spreadsheet::ParseExcel)
+#------------------------------------------------------------------------------
+sub _convDval {
+ my ( $sWk ) = @_;
+ return
+ unpack( "d",
+ ( $BIGENDIAN ) ? pack( "c8", reverse( unpack( "c8", $sWk ) ) ) : $sWk );
+}
+
+#------------------------------------------------------------------------------
+# _subRString (for Spreadsheet::ParseExcel) DK:P405
+#------------------------------------------------------------------------------
+sub _subRString {
+ my ( $oBook, $bOp, $bLen, $sWk ) = @_;
+ my ( $iR, $iC, $iF, $iL, $sTxt );
+ ( $iR, $iC, $iF, $iL ) = unpack( "v4", $sWk );
+ $sTxt = substr( $sWk, 8, $iL );
+
+ #Has STRUN
+ if ( length( $sWk ) > ( 8 + $iL ) ) {
+ _NewCell(
+ $oBook, $iR, $iC,
+ Kind => 'RString',
+ Val => $sTxt,
+ FormatNo => $iF,
+ Format => $oBook->{Format}[$iF],
+ Numeric => 0,
+ Code => '_native_', #undef,
+ Book => $oBook,
+ Rich => substr( $sWk, ( 8 + $iL ) + 1 ),
+ );
+ }
+ else {
+ _NewCell(
+ $oBook, $iR, $iC,
+ Kind => 'RString',
+ Val => $sTxt,
+ FormatNo => $iF,
+ Format => $oBook->{Format}[$iF],
+ Numeric => 0,
+ Code => '_native_',
+ Book => $oBook,
+ );
+ }
+
+ #2.MaxRow, MaxCol, MinRow, MinCol
+ _SetDimension( $oBook, $iR, $iC, $iC );
+}
+
+#------------------------------------------------------------------------------
+# _subBoolErr (for Spreadsheet::ParseExcel) DK:P306
+#------------------------------------------------------------------------------
+sub _subBoolErr {
+ my ( $oBook, $bOp, $bLen, $sWk ) = @_;
+ my ( $iR, $iC, $iF ) = unpack( "v3", $sWk );
+ my ( $iVal, $iFlg ) = unpack( "cc", substr( $sWk, 6, 2 ) );
+ my $sTxt = DecodeBoolErr( $iVal, $iFlg );
+
+ _NewCell(
+ $oBook, $iR, $iC,
+ Kind => 'BoolError',
+ Val => $sTxt,
+ FormatNo => $iF,
+ Format => $oBook->{Format}[$iF],
+ Numeric => 0,
+ Code => undef,
+ Book => $oBook,
+ );
+
+ #2.MaxRow, MaxCol, MinRow, MinCol
+ _SetDimension( $oBook, $iR, $iC, $iC );
+}
+
+###############################################################################
+#
+# _subRK()
+#
+# Decode the RK BIFF record.
+#
+sub _subRK {
+
+ my ( $workbook, $biff_number, $length, $data ) = @_;
+
+ my ( $row, $col, $format_index, $rk_number ) = unpack( 'vvvV', $data );
+
+ my $number = _decode_rk_number( $rk_number );
+
+ _NewCell(
+ $workbook, $row, $col,
+ Kind => 'RK',
+ Val => $number,
+ FormatNo => $format_index,
+ Format => $workbook->{Format}->[$format_index],
+ Numeric => 1,
+ Code => undef,
+ Book => $workbook,
+ );
+
+ # Store the max and min row/col values.
+ _SetDimension( $workbook, $row, $col, $col );
+}
+
+#------------------------------------------------------------------------------
+# _subArray (for Spreadsheet::ParseExcel) DK:P297
+#------------------------------------------------------------------------------
+sub _subArray {
+ my ( $oBook, $bOp, $bLen, $sWk ) = @_;
+ my ( $iBR, $iER, $iBC, $iEC ) = unpack( "v2c2", $sWk );
+
+}
+
+#------------------------------------------------------------------------------
+# _subFormula (for Spreadsheet::ParseExcel) DK:P336
+#------------------------------------------------------------------------------
+sub _subFormula {
+ my ( $oBook, $bOp, $bLen, $sWk ) = @_;
+ my ( $iR, $iC, $iF ) = unpack( "v3", $sWk );
+
+ my ( $iFlg ) = unpack( "v", substr( $sWk, 12, 2 ) );
+ if ( $iFlg == 0xFFFF ) {
+ my ( $iKind ) = unpack( "c", substr( $sWk, 6, 1 ) );
+ my ( $iVal ) = unpack( "c", substr( $sWk, 8, 1 ) );
+
+ if ( ( $iKind == 1 ) or ( $iKind == 2 ) ) {
+ my $sTxt =
+ ( $iKind == 1 )
+ ? DecodeBoolErr( $iVal, 0 )
+ : DecodeBoolErr( $iVal, 1 );
+ _NewCell(
+ $oBook, $iR, $iC,
+ Kind => 'Formula Bool',
+ Val => $sTxt,
+ FormatNo => $iF,
+ Format => $oBook->{Format}[$iF],
+ Numeric => 0,
+ Code => undef,
+ Book => $oBook,
+ );
+ }
+ else { # Result (Reserve Only)
+ $oBook->{_PrevPos} = [ $iR, $iC, $iF ];
+ }
+ }
+ else {
+ my $dVal = _convDval( substr( $sWk, 6, 8 ) );
+ _NewCell(
+ $oBook, $iR, $iC,
+ Kind => 'Formula Number',
+ Val => $dVal,
+ FormatNo => $iF,
+ Format => $oBook->{Format}[$iF],
+ Numeric => 1,
+ Code => undef,
+ Book => $oBook,
+ );
+ }
+
+ #2.MaxRow, MaxCol, MinRow, MinCol
+ _SetDimension( $oBook, $iR, $iC, $iC );
+}
+
+#------------------------------------------------------------------------------
+# _subString (for Spreadsheet::ParseExcel) DK:P414
+#------------------------------------------------------------------------------
+sub _subString {
+ my ( $oBook, $bOp, $bLen, $sWk ) = @_;
+
+ #Position (not enough for ARRAY)
+
+ my $iPos = $oBook->{_PrevPos};
+ return undef unless ( $iPos );
+ $oBook->{_PrevPos} = undef;
+ my ( $iR, $iC, $iF ) = @$iPos;
+
+ my ( $iLen, $sTxt, $sCode );
+ if ( $oBook->{BIFFVersion} == verBIFF8 ) {
+ my ( $raBuff, $iLen ) = _convBIFF8String( $oBook, $sWk, 1 );
+ $sTxt = $raBuff->[0];
+ $sCode = ( $raBuff->[1] ) ? 'ucs2' : undef;
+ }
+ elsif ( $oBook->{BIFFVersion} == verBIFF5 ) {
+ $sCode = '_native_';
+ $iLen = unpack( "v", $sWk );
+ $sTxt = substr( $sWk, 2, $iLen );
+ }
+ else {
+ $sCode = '_native_';
+ $iLen = unpack( "c", $sWk );
+ $sTxt = substr( $sWk, 1, $iLen );
+ }
+ _NewCell(
+ $oBook, $iR, $iC,
+ Kind => 'String',
+ Val => $sTxt,
+ FormatNo => $iF,
+ Format => $oBook->{Format}[$iF],
+ Numeric => 0,
+ Code => $sCode,
+ Book => $oBook,
+ );
+
+ #2.MaxRow, MaxCol, MinRow, MinCol
+ _SetDimension( $oBook, $iR, $iC, $iC );
+}
+
+#------------------------------------------------------------------------------
+# _subLabel (for Spreadsheet::ParseExcel) DK:P344
+#------------------------------------------------------------------------------
+sub _subLabel {
+ my ( $oBook, $bOp, $bLen, $sWk ) = @_;
+ my ( $iR, $iC, $iF ) = unpack( "v3", $sWk );
+ my ( $sLbl, $sCode );
+
+ #BIFF8
+ if ( $oBook->{BIFFVersion} >= verBIFF8 ) {
+ my ( $raBuff, $iLen, $iStPos, $iLenS ) =
+ _convBIFF8String( $oBook, substr( $sWk, 6 ), 1 );
+ $sLbl = $raBuff->[0];
+ $sCode = ( $raBuff->[1] ) ? 'ucs2' : undef;
+ }
+
+ #Before BIFF8
+ else {
+ $sLbl = substr( $sWk, 8 );
+ $sCode = '_native_';
+ }
+ _NewCell(
+ $oBook, $iR, $iC,
+ Kind => 'Label',
+ Val => $sLbl,
+ FormatNo => $iF,
+ Format => $oBook->{Format}[$iF],
+ Numeric => 0,
+ Code => $sCode,
+ Book => $oBook,
+ );
+
+ #2.MaxRow, MaxCol, MinRow, MinCol
+ _SetDimension( $oBook, $iR, $iC, $iC );
+}
+
+###############################################################################
+#
+# _subMulRK()
+#
+# Decode the Multiple RK BIFF record.
+#
+sub _subMulRK {
+
+ my ( $workbook, $biff_number, $length, $data ) = @_;
+
+ # JMN: I don't know why this is here.
+ return if $workbook->{SheetCount} <= 0;
+
+ my ( $row, $first_col ) = unpack( "v2", $data );
+ my $last_col = unpack( "v", substr( $data, length( $data ) - 2, 2 ) );
+
+ # Iterate over the RK array and decode the data.
+ my $pos = 4;
+ for my $col ( $first_col .. $last_col ) {
+
+ my $data = substr( $data, $pos, 6 );
+ my ( $format_index, $rk_number ) = unpack 'vV', $data;
+ my $number = _decode_rk_number( $rk_number );
+
+ _NewCell(
+ $workbook, $row, $col,
+ Kind => 'MulRK',
+ Val => $number,
+ FormatNo => $format_index,
+ Format => $workbook->{Format}->[$format_index],
+ Numeric => 1,
+ Code => undef,
+ Book => $workbook,
+ );
+ $pos += 6;
+ }
+
+ # Store the max and min row/col values.
+ _SetDimension( $workbook, $row, $first_col, $last_col );
+}
+
+#------------------------------------------------------------------------------
+# _subMulBlank (for Spreadsheet::ParseExcel) DK:P349
+#------------------------------------------------------------------------------
+sub _subMulBlank {
+ my ( $oBook, $bOp, $bLen, $sWk ) = @_;
+ my ( $iR, $iSc ) = unpack( "v2", $sWk );
+ my $iEc = unpack( "v", substr( $sWk, length( $sWk ) - 2, 2 ) );
+ my $iPos = 4;
+ for ( my $iC = $iSc ; $iC <= $iEc ; $iC++ ) {
+ my $iF = unpack( 'v', substr( $sWk, $iPos, 2 ) );
+ _NewCell(
+ $oBook, $iR, $iC,
+ Kind => 'MulBlank',
+ Val => '',
+ FormatNo => $iF,
+ Format => $oBook->{Format}[$iF],
+ Numeric => 0,
+ Code => undef,
+ Book => $oBook,
+ );
+ $iPos += 2;
+ }
+
+ #2.MaxRow, MaxCol, MinRow, MinCol
+ _SetDimension( $oBook, $iR, $iSc, $iEc );
+}
+
+#------------------------------------------------------------------------------
+# _subLabelSST (for Spreadsheet::ParseExcel) DK: P345
+#------------------------------------------------------------------------------
+sub _subLabelSST {
+ my ( $oBook, $bOp, $bLen, $sWk ) = @_;
+ my ( $iR, $iC, $iF, $iIdx ) = unpack( 'v3V', $sWk );
+
+ _NewCell(
+ $oBook, $iR, $iC,
+ Kind => 'PackedIdx',
+ Val => $oBook->{PkgStr}[$iIdx]->{Text},
+ FormatNo => $iF,
+ Format => $oBook->{Format}[$iF],
+ Numeric => 0,
+ Code => ( $oBook->{PkgStr}[$iIdx]->{Unicode} ) ? 'ucs2' : undef,
+ Book => $oBook,
+ Rich => $oBook->{PkgStr}[$iIdx]->{Rich},
+ );
+
+ #2.MaxRow, MaxCol, MinRow, MinCol
+ _SetDimension( $oBook, $iR, $iC, $iC );
+}
+
+#------------------------------------------------------------------------------
+# _subFlg1904 (for Spreadsheet::ParseExcel) DK:P296
+#------------------------------------------------------------------------------
+sub _subFlg1904 {
+ my ( $oBook, $bOp, $bLen, $sWk ) = @_;
+ $oBook->{Flg1904} = unpack( "v", $sWk );
+}
+
+#------------------------------------------------------------------------------
+# _subRow (for Spreadsheet::ParseExcel) DK:P403
+#------------------------------------------------------------------------------
+sub _subRow {
+ my ( $oBook, $bOp, $bLen, $sWk ) = @_;
+ return undef unless ( defined $oBook->{_CurSheet} );
+
+ #0. Get Worksheet info (MaxRow, MaxCol, MinRow, MinCol)
+ my ( $iR, $iSc, $iEc, $iHght, $undef1, $undef2, $iGr, $iXf ) =
+ unpack( "v8", $sWk );
+ $iEc--;
+
+ # TODO. we need to handle hidden rows:
+ # $iGr & 0x20
+ $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{RowHeight}[$iR] = $iHght / 20;
+
+ #2.MaxRow, MaxCol, MinRow, MinCol
+ _SetDimension( $oBook, $iR, $iSc, $iEc );
+}
+
+#------------------------------------------------------------------------------
+# _SetDimension (for Spreadsheet::ParseExcel)
+#------------------------------------------------------------------------------
+sub _SetDimension {
+ my ( $oBook, $iR, $iSc, $iEc ) = @_;
+ return undef unless ( defined $oBook->{_CurSheet} );
+
+ #2.MaxRow, MaxCol, MinRow, MinCol
+ #2.1 MinRow
+ $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{MinRow} = $iR
+ unless ( defined $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{MinRow} )
+ and ( $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{MinRow} <= $iR );
+
+ #2.2 MaxRow
+ $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{MaxRow} = $iR
+ unless ( defined $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{MaxRow} )
+ and ( $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{MaxRow} > $iR );
+
+ #2.3 MinCol
+ $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{MinCol} = $iSc
+ unless ( defined $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{MinCol} )
+ and ( $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{MinCol} <= $iSc );
+
+ #2.4 MaxCol
+ $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{MaxCol} = $iEc
+ unless ( defined $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{MaxCol} )
+ and ( $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{MaxCol} > $iEc );
+
+}
+
+#------------------------------------------------------------------------------
+# _subDefaultRowHeight (for Spreadsheet::ParseExcel) DK: P318
+#------------------------------------------------------------------------------
+sub _subDefaultRowHeight {
+ my ( $oBook, $bOp, $bLen, $sWk ) = @_;
+ return undef unless ( defined $oBook->{_CurSheet} );
+
+ #1. RowHeight
+ my ( $iDum, $iHght ) = unpack( "v2", $sWk );
+ $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{DefRowHeight} = $iHght / 20;
+
+}
+
+#------------------------------------------------------------------------------
+# _subStandardWidth(for Spreadsheet::ParseExcel) DK:P413
+#------------------------------------------------------------------------------
+sub _subStandardWidth {
+ my ( $oBook, $bOp, $bLen, $sWk ) = @_;
+ my $iW = unpack( "v", $sWk );
+ $oBook->{StandardWidth} = _convert_col_width( $oBook, $iW );
+}
+
+###############################################################################
+#
+# _subDefColWidth()
+#
+# Read the DEFCOLWIDTH Biff record. This gives the width in terms of chars
+# and is different from the width in the COLINFO record.
+#
+sub _subDefColWidth {
+
+ my ( $self, $record, $length, $data ) = @_;
+
+ my $width = unpack 'v', $data;
+
+ # Adjustment for default Arial 10 width.
+ $width = 8.43 if $width == 8;
+
+ $self->{Worksheet}->[ $self->{_CurSheet} ]->{DefColWidth} = $width;
+}
+
+###############################################################################
+#
+# _convert_col_width()
+#
+# Converts from the internal Excel column width units to user units seen in the
+# interface. It is first necessary to convert the internal width to pixels and
+# then to user units. The conversion is specific to a default font of Arial 10.
+# TODO, the conversion should be extended to other fonts and sizes.
+#
+sub _convert_col_width {
+
+ my $self = shift;
+ my $excel_width = shift;
+
+ # Convert from Excel units to pixels (rounded up).
+ my $pixels = int( 0.5 + $excel_width * 7 / 256 );
+
+ # Convert from pixels to user units.
+ # The conversion is different for columns <= 1 user unit (12 pixels).
+ my $user_width;
+ if ( $pixels <= 12 ) {
+ $user_width = $pixels / 12;
+ }
+ else {
+ $user_width = ( $pixels - 5 ) / 7;
+ }
+
+ # Round up to 2 decimal places.
+ $user_width = int( $user_width * 100 + 0.5 ) / 100;
+
+ return $user_width;
+}
+
+#------------------------------------------------------------------------------
+# _subColInfo (for Spreadsheet::ParseExcel) DK:P309
+#------------------------------------------------------------------------------
+sub _subColInfo {
+
+ my ( $oBook, $bOp, $bLen, $sWk ) = @_;
+
+ return undef unless defined $oBook->{_CurSheet};
+
+ my ( $iSc, $iEc, $iW, $iXF, $iGr ) = unpack( "v5", $sWk );
+
+ for ( my $i = $iSc ; $i <= $iEc ; $i++ ) {
+
+ $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{ColWidth}[$i] =
+ _convert_col_width( $oBook, $iW );
+
+ $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{ColFmtNo}[$i] = $iXF;
+
+ # TODO. we need to handle hidden cols: $iGr & 0x01.
+ }
+}
+
+#------------------------------------------------------------------------------
+# _subSST (for Spreadsheet::ParseExcel) DK:P413
+#------------------------------------------------------------------------------
+sub _subSST {
+ my ( $oBook, $bOp, $bLen, $sWk ) = @_;
+ _subStrWk( $oBook, substr( $sWk, 8 ) );
+}
+
+#------------------------------------------------------------------------------
+# _subContinue (for Spreadsheet::ParseExcel) DK:P311
+#------------------------------------------------------------------------------
+sub _subContinue {
+ my ( $oBook, $bOp, $bLen, $sWk ) = @_;
+
+ #if(defined $self->{FuncTbl}->{$bOp}) {
+ # $self->{FuncTbl}->{$PREFUNC}->($oBook, $bOp, $bLen, $sWk);
+ #}
+
+ _subStrWk( $oBook, $sWk, 1 ) if ( $PREFUNC == 0xFC );
+}
+
+#------------------------------------------------------------------------------
+# _subWriteAccess (for Spreadsheet::ParseExcel) DK:P451
+#------------------------------------------------------------------------------
+sub _subWriteAccess {
+ my ( $oBook, $bOp, $bLen, $sWk ) = @_;
+ return if ( defined $oBook->{_Author} );
+
+ #BIFF8
+ if ( $oBook->{BIFFVersion} >= verBIFF8 ) {
+ $oBook->{Author} = _convBIFF8String( $oBook, $sWk );
+ }
+
+ #Before BIFF8
+ else {
+ my ( $iLen ) = unpack( "c", $sWk );
+ $oBook->{Author} =
+ $oBook->{FmtClass}->TextFmt( substr( $sWk, 1, $iLen ), '_native_' );
+ }
+}
+
+#------------------------------------------------------------------------------
+# _convBIFF8String (for Spreadsheet::ParseExcel)
+#------------------------------------------------------------------------------
+sub _convBIFF8String {
+ my ( $oBook, $sWk, $iCnvFlg ) = @_;
+ my ( $iLen, $iFlg ) = unpack( "vc", $sWk );
+ my ( $iHigh, $iExt, $iRich ) = ( $iFlg & 0x01, $iFlg & 0x04, $iFlg & 0x08 );
+ my ( $iStPos, $iExtCnt, $iRichCnt, $sStr );
+
+ #2. Rich and Ext
+ if ( $iRich && $iExt ) {
+ $iStPos = 9;
+ ( $iRichCnt, $iExtCnt ) = unpack( 'vV', substr( $sWk, 3, 6 ) );
+ }
+ elsif ( $iRich ) { #Only Rich
+ $iStPos = 5;
+ $iRichCnt = unpack( 'v', substr( $sWk, 3, 2 ) );
+ $iExtCnt = 0;
+ }
+ elsif ( $iExt ) { #Only Ext
+ $iStPos = 7;
+ $iRichCnt = 0;
+ $iExtCnt = unpack( 'V', substr( $sWk, 3, 4 ) );
+ }
+ else { #Nothing Special
+ $iStPos = 3;
+ $iExtCnt = 0;
+ $iRichCnt = 0;
+ }
+
+ #3.Get String
+ if ( $iHigh ) { #Compressed
+ $iLen *= 2;
+ $sStr = substr( $sWk, $iStPos, $iLen );
+ _SwapForUnicode( \$sStr );
+ $sStr = $oBook->{FmtClass}->TextFmt( $sStr, 'ucs2' )
+ unless ( $iCnvFlg );
+ }
+ else { #Not Compressed
+ $sStr = substr( $sWk, $iStPos, $iLen );
+ $sStr = $oBook->{FmtClass}->TextFmt( $sStr, undef ) unless ( $iCnvFlg );
+ }
+
+ #4. return
+ if ( wantarray ) {
+
+ #4.1 Get Rich and Ext
+ if ( length( $sWk ) < $iStPos + $iLen + $iRichCnt * 4 + $iExtCnt ) {
+ return (
+ [ undef, $iHigh, undef, undef ],
+ $iStPos + $iLen + $iRichCnt * 4 + $iExtCnt,
+ $iStPos, $iLen
+ );
+ }
+ else {
+ return (
+ [
+ $sStr,
+ $iHigh,
+ substr( $sWk, $iStPos + $iLen, $iRichCnt * 4 ),
+ substr( $sWk, $iStPos + $iLen + $iRichCnt * 4, $iExtCnt )
+ ],
+ $iStPos + $iLen + $iRichCnt * 4 + $iExtCnt,
+ $iStPos, $iLen
+ );
+ }
+ }
+ else {
+ return $sStr;
+ }
+}
+
+#------------------------------------------------------------------------------
+# _subXF (for Spreadsheet::ParseExcel) DK:P453
+#------------------------------------------------------------------------------
+sub _subXF {
+ my ( $oBook, $bOp, $bLen, $sWk ) = @_;
+
+ my ( $iFnt, $iIdx );
+ my (
+ $iLock, $iHidden, $iStyle, $i123, $iAlH, $iWrap,
+ $iAlV, $iJustL, $iRotate, $iInd, $iShrink, $iMerge,
+ $iReadDir, $iBdrD, $iBdrSL, $iBdrSR, $iBdrST, $iBdrSB,
+ $iBdrSD, $iBdrCL, $iBdrCR, $iBdrCT, $iBdrCB, $iBdrCD,
+ $iFillP, $iFillCF, $iFillCB
+ );
+
+
+ if ( $oBook->{BIFFVersion} == verBIFF4 ) {
+
+ # Minimal support for Excel 4. We just get the font and format indices
+ # so that the cell data value can be formatted.
+ ( $iFnt, $iIdx, ) = unpack( "CC", $sWk );
+ }
+ elsif ( $oBook->{BIFFVersion} == verBIFF8 ) {
+ my ( $iGen, $iAlign, $iGen2, $iBdr1, $iBdr2, $iBdr3, $iPtn );
+
+ ( $iFnt, $iIdx, $iGen, $iAlign, $iGen2, $iBdr1, $iBdr2, $iBdr3, $iPtn )
+ = unpack( "v7Vv", $sWk );
+ $iLock = ( $iGen & 0x01 ) ? 1 : 0;
+ $iHidden = ( $iGen & 0x02 ) ? 1 : 0;
+ $iStyle = ( $iGen & 0x04 ) ? 1 : 0;
+ $i123 = ( $iGen & 0x08 ) ? 1 : 0;
+ $iAlH = ( $iAlign & 0x07 );
+ $iWrap = ( $iAlign & 0x08 ) ? 1 : 0;
+ $iAlV = ( $iAlign & 0x70 ) / 0x10;
+ $iJustL = ( $iAlign & 0x80 ) ? 1 : 0;
+
+ $iRotate = ( ( $iAlign & 0xFF00 ) / 0x100 ) & 0x00FF;
+ $iRotate = 90 if ( $iRotate == 255 );
+ $iRotate = 90 - $iRotate if ( $iRotate > 90 );
+
+ $iInd = ( $iGen2 & 0x0F );
+ $iShrink = ( $iGen2 & 0x10 ) ? 1 : 0;
+ $iMerge = ( $iGen2 & 0x20 ) ? 1 : 0;
+ $iReadDir = ( ( $iGen2 & 0xC0 ) / 0x40 ) & 0x03;
+ $iBdrSL = $iBdr1 & 0x0F;
+ $iBdrSR = ( ( $iBdr1 & 0xF0 ) / 0x10 ) & 0x0F;
+ $iBdrST = ( ( $iBdr1 & 0xF00 ) / 0x100 ) & 0x0F;
+ $iBdrSB = ( ( $iBdr1 & 0xF000 ) / 0x1000 ) & 0x0F;
+
+ $iBdrCL = ( ( $iBdr2 & 0x7F ) ) & 0x7F;
+ $iBdrCR = ( ( $iBdr2 & 0x3F80 ) / 0x80 ) & 0x7F;
+ $iBdrD = ( ( $iBdr2 & 0xC000 ) / 0x4000 ) & 0x3;
+
+ $iBdrCT = ( ( $iBdr3 & 0x7F ) ) & 0x7F;
+ $iBdrCB = ( ( $iBdr3 & 0x3F80 ) / 0x80 ) & 0x7F;
+ $iBdrCD = ( ( $iBdr3 & 0x1FC000 ) / 0x4000 ) & 0x7F;
+ $iBdrSD = ( ( $iBdr3 & 0x1E00000 ) / 0x200000 ) & 0xF;
+ $iFillP = ( ( $iBdr3 & 0xFC000000 ) / 0x4000000 ) & 0x3F;
+
+ $iFillCF = ( $iPtn & 0x7F );
+ $iFillCB = ( ( $iPtn & 0x3F80 ) / 0x80 ) & 0x7F;
+ }
+ else {
+ my ( $iGen, $iAlign, $iPtn, $iPtn2, $iBdr1, $iBdr2 );
+
+ ( $iFnt, $iIdx, $iGen, $iAlign, $iPtn, $iPtn2, $iBdr1, $iBdr2 ) =
+ unpack( "v8", $sWk );
+ $iLock = ( $iGen & 0x01 ) ? 1 : 0;
+ $iHidden = ( $iGen & 0x02 ) ? 1 : 0;
+ $iStyle = ( $iGen & 0x04 ) ? 1 : 0;
+ $i123 = ( $iGen & 0x08 ) ? 1 : 0;
+
+ $iAlH = ( $iAlign & 0x07 );
+ $iWrap = ( $iAlign & 0x08 ) ? 1 : 0;
+ $iAlV = ( $iAlign & 0x70 ) / 0x10;
+ $iJustL = ( $iAlign & 0x80 ) ? 1 : 0;
+
+ $iRotate = ( ( $iAlign & 0x300 ) / 0x100 ) & 0x3;
+
+ $iFillCF = ( $iPtn & 0x7F );
+ $iFillCB = ( ( $iPtn & 0x1F80 ) / 0x80 ) & 0x7F;
+
+ $iFillP = ( $iPtn2 & 0x3F );
+ $iBdrSB = ( ( $iPtn2 & 0x1C0 ) / 0x40 ) & 0x7;
+ $iBdrCB = ( ( $iPtn2 & 0xFE00 ) / 0x200 ) & 0x7F;
+
+ $iBdrST = ( $iBdr1 & 0x07 );
+ $iBdrSL = ( ( $iBdr1 & 0x38 ) / 0x8 ) & 0x07;
+ $iBdrSR = ( ( $iBdr1 & 0x1C0 ) / 0x40 ) & 0x07;
+ $iBdrCT = ( ( $iBdr1 & 0xFE00 ) / 0x200 ) & 0x7F;
+
+ $iBdrCL = ( $iBdr2 & 0x7F ) & 0x7F;
+ $iBdrCR = ( ( $iBdr2 & 0x3F80 ) / 0x80 ) & 0x7F;
+ }
+
+ push @{ $oBook->{Format} }, Spreadsheet::ParseExcel::Format->new(
+ FontNo => $iFnt,
+ Font => $oBook->{Font}[$iFnt],
+ FmtIdx => $iIdx,
+
+ Lock => $iLock,
+ Hidden => $iHidden,
+ Style => $iStyle,
+ Key123 => $i123,
+ AlignH => $iAlH,
+ Wrap => $iWrap,
+ AlignV => $iAlV,
+ JustLast => $iJustL,
+ Rotate => $iRotate,
+
+ Indent => $iInd,
+ Shrink => $iShrink,
+ Merge => $iMerge,
+ ReadDir => $iReadDir,
+
+ BdrStyle => [ $iBdrSL, $iBdrSR, $iBdrST, $iBdrSB ],
+ BdrColor => [ $iBdrCL, $iBdrCR, $iBdrCT, $iBdrCB ],
+ BdrDiag => [ $iBdrD, $iBdrSD, $iBdrCD ],
+ Fill => [ $iFillP, $iFillCF, $iFillCB ],
+ );
+}
+
+#------------------------------------------------------------------------------
+# _subFormat (for Spreadsheet::ParseExcel) DK: P336
+#------------------------------------------------------------------------------
+sub _subFormat {
+
+ my ( $oBook, $bOp, $bLen, $sWk ) = @_;
+ my $sFmt;
+
+ if ( $oBook->{BIFFVersion} <= verBIFF5 ) {
+ $sFmt = substr( $sWk, 3, unpack( 'c', substr( $sWk, 2, 1 ) ) );
+ $sFmt = $oBook->{FmtClass}->TextFmt( $sFmt, '_native_' );
+ }
+ else {
+ $sFmt = _convBIFF8String( $oBook, substr( $sWk, 2 ) );
+ }
+
+ my $format_index = unpack( 'v', substr( $sWk, 0, 2 ) );
+
+ # Excel 4 and earlier used an index of 0 to indicate that a built-in format
+ # that was stored implicitly.
+ if ( $oBook->{BIFFVersion} <= verBIFF4 && $format_index == 0 ) {
+ $format_index = keys %{ $oBook->{FormatStr} };
+ }
+
+ $oBook->{FormatStr}->{$format_index} = $sFmt;
+}
+
+#------------------------------------------------------------------------------
+# _subPalette (for Spreadsheet::ParseExcel) DK: P393
+#------------------------------------------------------------------------------
+sub _subPalette {
+ my ( $oBook, $bOp, $bLen, $sWk ) = @_;
+ for ( my $i = 0 ; $i < unpack( 'v', $sWk ) ; $i++ ) {
+
+ # push @aColor, unpack('H6', substr($sWk, $i*4+2));
+ $aColor[ $i + 8 ] = unpack( 'H6', substr( $sWk, $i * 4 + 2 ) );
+ }
+}
+
+#------------------------------------------------------------------------------
+# _subFont (for Spreadsheet::ParseExcel) DK:P333
+#------------------------------------------------------------------------------
+sub _subFont {
+ my ( $oBook, $bOp, $bLen, $sWk ) = @_;
+ my ( $iHeight, $iAttr, $iCIdx, $iBold, $iSuper, $iUnderline, $sFntName );
+ my ( $bBold, $bItalic, $bUnderline, $bStrikeout );
+
+ if ( $oBook->{BIFFVersion} == verBIFF8 ) {
+ ( $iHeight, $iAttr, $iCIdx, $iBold, $iSuper, $iUnderline ) =
+ unpack( "v5c", $sWk );
+ my ( $iSize, $iHigh ) = unpack( 'cc', substr( $sWk, 14, 2 ) );
+ if ( $iHigh ) {
+ $sFntName = substr( $sWk, 16, $iSize * 2 );
+ _SwapForUnicode( \$sFntName );
+ $sFntName = $oBook->{FmtClass}->TextFmt( $sFntName, 'ucs2' );
+ }
+ else {
+ $sFntName = substr( $sWk, 16, $iSize );
+ $sFntName = $oBook->{FmtClass}->TextFmt( $sFntName, '_native_' );
+ }
+ $bBold = ( $iBold >= 0x2BC ) ? 1 : 0;
+ $bItalic = ( $iAttr & 0x02 ) ? 1 : 0;
+ $bStrikeout = ( $iAttr & 0x08 ) ? 1 : 0;
+ $bUnderline = ( $iUnderline ) ? 1 : 0;
+ }
+ elsif ( $oBook->{BIFFVersion} == verBIFF5 ) {
+ ( $iHeight, $iAttr, $iCIdx, $iBold, $iSuper, $iUnderline ) =
+ unpack( "v5c", $sWk );
+ $sFntName =
+ $oBook->{FmtClass}
+ ->TextFmt( substr( $sWk, 15, unpack( "c", substr( $sWk, 14, 1 ) ) ),
+ '_native_' );
+ $bBold = ( $iBold >= 0x2BC ) ? 1 : 0;
+ $bItalic = ( $iAttr & 0x02 ) ? 1 : 0;
+ $bStrikeout = ( $iAttr & 0x08 ) ? 1 : 0;
+ $bUnderline = ( $iUnderline ) ? 1 : 0;
+ }
+ else {
+ ( $iHeight, $iAttr ) = unpack( "v2", $sWk );
+ $iCIdx = undef;
+ $iSuper = 0;
+
+ $bBold = ( $iAttr & 0x01 ) ? 1 : 0;
+ $bItalic = ( $iAttr & 0x02 ) ? 1 : 0;
+ $bUnderline = ( $iAttr & 0x04 ) ? 1 : 0;
+ $bStrikeout = ( $iAttr & 0x08 ) ? 1 : 0;
+
+ $sFntName = substr( $sWk, 5, unpack( "c", substr( $sWk, 4, 1 ) ) );
+ }
+ push @{ $oBook->{Font} }, Spreadsheet::ParseExcel::Font->new(
+ Height => $iHeight / 20.0,
+ Attr => $iAttr,
+ Color => $iCIdx,
+ Super => $iSuper,
+ UnderlineStyle => $iUnderline,
+ Name => $sFntName,
+
+ Bold => $bBold,
+ Italic => $bItalic,
+ Underline => $bUnderline,
+ Strikeout => $bStrikeout,
+ );
+
+ #Skip Font[4]
+ push @{ $oBook->{Font} }, {} if ( scalar( @{ $oBook->{Font} } ) == 4 );
+
+}
+
+#------------------------------------------------------------------------------
+# _subBoundSheet (for Spreadsheet::ParseExcel): DK: P307
+#------------------------------------------------------------------------------
+sub _subBoundSheet {
+ my ( $oBook, $bOp, $bLen, $sWk ) = @_;
+ my ( $iPos, $iGr, $iKind ) = unpack( "Lc2", $sWk );
+ $iKind &= 0x0F;
+ return if ( ( $iKind != 0x00 ) && ( $iKind != 0x01 ) );
+
+ if ( $oBook->{BIFFVersion} >= verBIFF8 ) {
+ my ( $iSize, $iUni ) = unpack( "cc", substr( $sWk, 6, 2 ) );
+ my $sWsName = substr( $sWk, 8 );
+ if ( $iUni & 0x01 ) {
+ _SwapForUnicode( \$sWsName );
+ $sWsName = $oBook->{FmtClass}->TextFmt( $sWsName, 'ucs2' );
+ }
+ $oBook->{Worksheet}[ $oBook->{SheetCount} ] =
+ Spreadsheet::ParseExcel::Worksheet->new(
+ Name => $sWsName,
+ Kind => $iKind,
+ _Pos => $iPos,
+ _Book => $oBook,
+ _SheetNo => $oBook->{SheetCount},
+ );
+ }
+ else {
+ $oBook->{Worksheet}[ $oBook->{SheetCount} ] =
+ Spreadsheet::ParseExcel::Worksheet->new(
+ Name =>
+ $oBook->{FmtClass}->TextFmt( substr( $sWk, 7 ), '_native_' ),
+ Kind => $iKind,
+ _Pos => $iPos,
+ _Book => $oBook,
+ _SheetNo => $oBook->{SheetCount},
+ );
+ }
+ $oBook->{SheetCount}++;
+}
+
+#------------------------------------------------------------------------------
+# _subHeader (for Spreadsheet::ParseExcel) DK: P340
+#------------------------------------------------------------------------------
+sub _subHeader {
+ my ( $oBook, $bOp, $bLen, $sWk ) = @_;
+ return undef unless ( defined $oBook->{_CurSheet} );
+ my $sW;
+
+ if ( !defined $sWk ) {
+ $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{Header} = undef;
+ return;
+ }
+
+ #BIFF8
+ if ( $oBook->{BIFFVersion} >= verBIFF8 ) {
+ $sW = _convBIFF8String( $oBook, $sWk );
+ $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{Header} =
+ ( $sW eq "\x00" ) ? undef : $sW;
+ }
+
+ #Before BIFF8
+ else {
+ my ( $iLen ) = unpack( "c", $sWk );
+ $sW =
+ $oBook->{FmtClass}->TextFmt( substr( $sWk, 1, $iLen ), '_native_' );
+ $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{Header} =
+ ( $sW eq "\x00\x00\x00" ) ? undef : $sW;
+ }
+}
+
+#------------------------------------------------------------------------------
+# _subFooter (for Spreadsheet::ParseExcel) DK: P335
+#------------------------------------------------------------------------------
+sub _subFooter {
+ my ( $oBook, $bOp, $bLen, $sWk ) = @_;
+ return undef unless ( defined $oBook->{_CurSheet} );
+ my $sW;
+
+ if ( !defined $sWk ) {
+ $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{Footer} = undef;
+ return;
+ }
+
+ #BIFF8
+ if ( $oBook->{BIFFVersion} >= verBIFF8 ) {
+ $sW = _convBIFF8String( $oBook, $sWk );
+ $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{Footer} =
+ ( $sW eq "\x00" ) ? undef : $sW;
+ }
+
+ #Before BIFF8
+ else {
+ my ( $iLen ) = unpack( "c", $sWk );
+ $sW =
+ $oBook->{FmtClass}->TextFmt( substr( $sWk, 1, $iLen ), '_native_' );
+ $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{Footer} =
+ ( $sW eq "\x00\x00\x00" ) ? undef : $sW;
+ }
+}
+
+#------------------------------------------------------------------------------
+# _subHPageBreak (for Spreadsheet::ParseExcel) DK: P341
+#------------------------------------------------------------------------------
+sub _subHPageBreak {
+ my ( $oBook, $bOp, $bLen, $sWk ) = @_;
+ my @aBreak;
+ my $iCnt = unpack( "v", $sWk );
+
+ return undef unless ( defined $oBook->{_CurSheet} );
+
+ #BIFF8
+ if ( $oBook->{BIFFVersion} >= verBIFF8 ) {
+ for ( my $i = 0 ; $i < $iCnt ; $i++ ) {
+ my ( $iRow, $iColB, $iColE ) =
+ unpack( 'v3', substr( $sWk, 2 + $i * 6, 6 ) );
+
+ # push @aBreak, [$iRow, $iColB, $iColE];
+ push @aBreak, $iRow;
+ }
+ }
+
+ #Before BIFF8
+ else {
+ for ( my $i = 0 ; $i < $iCnt ; $i++ ) {
+ my ( $iRow ) = unpack( 'v', substr( $sWk, 2 + $i * 2, 2 ) );
+ push @aBreak, $iRow;
+
+ # push @aBreak, [$iRow, 0, 255];
+ }
+ }
+ @aBreak = sort { $a <=> $b } @aBreak;
+ $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{HPageBreak} = \@aBreak;
+}
+
+#------------------------------------------------------------------------------
+# _subVPageBreak (for Spreadsheet::ParseExcel) DK: P447
+#------------------------------------------------------------------------------
+sub _subVPageBreak {
+ my ( $oBook, $bOp, $bLen, $sWk ) = @_;
+ return undef unless ( defined $oBook->{_CurSheet} );
+
+ my @aBreak;
+ my $iCnt = unpack( "v", $sWk );
+
+ #BIFF8
+ if ( $oBook->{BIFFVersion} >= verBIFF8 ) {
+ for ( my $i = 0 ; $i < $iCnt ; $i++ ) {
+ my ( $iCol, $iRowB, $iRowE ) =
+ unpack( 'v3', substr( $sWk, 2 + $i * 6, 6 ) );
+ push @aBreak, $iCol;
+
+ # push @aBreak, [$iCol, $iRowB, $iRowE];
+ }
+ }
+
+ #Before BIFF8
+ else {
+ for ( my $i = 0 ; $i < $iCnt ; $i++ ) {
+ my ( $iCol ) = unpack( 'v', substr( $sWk, 2 + $i * 2, 2 ) );
+ push @aBreak, $iCol;
+
+ # push @aBreak, [$iCol, 0, 65535];
+ }
+ }
+ @aBreak = sort { $a <=> $b } @aBreak;
+ $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{VPageBreak} = \@aBreak;
+}
+
+#------------------------------------------------------------------------------
+# _subMargin (for Spreadsheet::ParseExcel) DK: P306, 345, 400, 440
+#------------------------------------------------------------------------------
+sub _subMargin {
+ my ( $oBook, $bOp, $bLen, $sWk ) = @_;
+ return undef unless ( defined $oBook->{_CurSheet} );
+
+ # The "Mergin" options are a workaround for a backward compatible typo.
+
+ my $dWk = _convDval( substr( $sWk, 0, 8 ) );
+ if ( $bOp == 0x26 ) {
+ $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{LeftMergin} = $dWk;
+ $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{LeftMargin} = $dWk;
+ }
+ elsif ( $bOp == 0x27 ) {
+ $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{RightMergin} = $dWk;
+ $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{RightMargin} = $dWk;
+ }
+ elsif ( $bOp == 0x28 ) {
+ $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{TopMergin} = $dWk;
+ $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{TopMargin} = $dWk;
+ }
+ elsif ( $bOp == 0x29 ) {
+ $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{BottomMergin} = $dWk;
+ $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{BottomMargin} = $dWk;
+ }
+}
+
+#------------------------------------------------------------------------------
+# _subHcenter (for Spreadsheet::ParseExcel) DK: P340
+#------------------------------------------------------------------------------
+sub _subHcenter {
+ my ( $oBook, $bOp, $bLen, $sWk ) = @_;
+ return undef unless ( defined $oBook->{_CurSheet} );
+
+ my $iWk = unpack( "v", $sWk );
+ $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{HCenter} = $iWk;
+
+}
+
+#------------------------------------------------------------------------------
+# _subVcenter (for Spreadsheet::ParseExcel) DK: P447
+#------------------------------------------------------------------------------
+sub _subVcenter {
+ my ( $oBook, $bOp, $bLen, $sWk ) = @_;
+ return undef unless ( defined $oBook->{_CurSheet} );
+
+ my $iWk = unpack( "v", $sWk );
+ $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{VCenter} = $iWk;
+}
+
+#------------------------------------------------------------------------------
+# _subPrintGridlines (for Spreadsheet::ParseExcel) DK: P397
+#------------------------------------------------------------------------------
+sub _subPrintGridlines {
+ my ( $oBook, $bOp, $bLen, $sWk ) = @_;
+ return undef unless ( defined $oBook->{_CurSheet} );
+
+ my $iWk = unpack( "v", $sWk );
+ $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{PrintGrid} = $iWk;
+
+}
+
+#------------------------------------------------------------------------------
+# _subPrintHeaders (for Spreadsheet::ParseExcel) DK: P397
+#------------------------------------------------------------------------------
+sub _subPrintHeaders {
+ my ( $oBook, $bOp, $bLen, $sWk ) = @_;
+ return undef unless ( defined $oBook->{_CurSheet} );
+
+ my $iWk = unpack( "v", $sWk );
+ $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{PrintHeaders} = $iWk;
+}
+
+#------------------------------------------------------------------------------
+# _subSETUP (for Spreadsheet::ParseExcel) DK: P409
+#------------------------------------------------------------------------------
+sub _subSETUP {
+ my ( $oBook, $bOp, $bLen, $sWk ) = @_;
+ return undef unless ( defined $oBook->{_CurSheet} );
+
+ # Workaround for some apps and older Excels that don't write a
+ # complete SETUP record.
+ return undef if $bLen != 34;
+
+ my $oWkS = $oBook->{Worksheet}[ $oBook->{_CurSheet} ];
+ my $iGrBit;
+
+ (
+ $oWkS->{PaperSize}, $oWkS->{Scale}, $oWkS->{PageStart},
+ $oWkS->{FitWidth}, $oWkS->{FitHeight}, $iGrBit,
+ $oWkS->{Res}, $oWkS->{VRes},
+ ) = unpack( 'v8', $sWk );
+
+ $oWkS->{HeaderMargin} = _convDval( substr( $sWk, 16, 8 ) );
+ $oWkS->{FooterMargin} = _convDval( substr( $sWk, 24, 8 ) );
+ $oWkS->{Copis} = unpack( 'v2', substr( $sWk, 32, 2 ) );
+ $oWkS->{LeftToRight} = ( ( $iGrBit & 0x01 ) ? 1 : 0 );
+ $oWkS->{Landscape} = ( ( $iGrBit & 0x02 ) ? 1 : 0 );
+ $oWkS->{NoPls} = ( ( $iGrBit & 0x04 ) ? 1 : 0 );
+ $oWkS->{NoColor} = ( ( $iGrBit & 0x08 ) ? 1 : 0 );
+ $oWkS->{Draft} = ( ( $iGrBit & 0x10 ) ? 1 : 0 );
+ $oWkS->{Notes} = ( ( $iGrBit & 0x20 ) ? 1 : 0 );
+ $oWkS->{NoOrient} = ( ( $iGrBit & 0x40 ) ? 1 : 0 );
+ $oWkS->{UsePage} = ( ( $iGrBit & 0x80 ) ? 1 : 0 );
+
+ # The NoPls flag indicates that the values have not been taken from an
+ # actual printer and thus may not be accurate.
+
+ # Set default scale if NoPls otherwise it may be an invalid value of 0XFF.
+ $oWkS->{Scale} = 100 if $oWkS->{NoPls};
+
+ # Workaround for a backward compatible typo.
+ $oWkS->{HeaderMergin} = $oWkS->{HeaderMargin};
+ $oWkS->{FooterMergin} = $oWkS->{FooterMargin};
+
+}
+
+#------------------------------------------------------------------------------
+# _subName (for Spreadsheet::ParseExcel) DK: P350
+#------------------------------------------------------------------------------
+sub _subName {
+ my ( $oBook, $bOp, $bLen, $sWk ) = @_;
+ my (
+ $iGrBit, $cKey, $cCh, $iCce, $ixAls,
+ $iTab, $cchCust, $cchDsc, $cchHep, $cchStatus
+ ) = unpack( 'vc2v3c4', $sWk );
+
+ #Builtin Name + Length == 1
+ if ( ( $iGrBit & 0x20 ) && ( $cCh == 1 ) ) {
+
+ #BIFF8
+ if ( $oBook->{BIFFVersion} >= verBIFF8 ) {
+ my $iName = unpack( 'n', substr( $sWk, 14 ) );
+ my $iSheet = unpack( 'v', substr( $sWk, 8 ) ) - 1;
+
+ # Workaround for mal-formed Excel workbooks where Print_Title is
+ # set as Global (i.e. itab = 0). Note, this will have to be
+ # treated differently when we get around to handling global names.
+ return undef if $iSheet == -1;
+
+ if ( $iName == 6 ) { #PrintArea
+ my ( $iSheetW, $raArea ) = _ParseNameArea( substr( $sWk, 16 ) );
+ $oBook->{PrintArea}[$iSheet] = $raArea;
+ }
+ elsif ( $iName == 7 ) { #Title
+ my ( $iSheetW, $raArea ) = _ParseNameArea( substr( $sWk, 16 ) );
+ my @aTtlR = ();
+ my @aTtlC = ();
+ foreach my $raI ( @$raArea ) {
+ if ( $raI->[3] == 0xFF ) { #Row Title
+ push @aTtlR, [ $raI->[0], $raI->[2] ];
+ }
+ else { #Col Title
+ push @aTtlC, [ $raI->[1], $raI->[3] ];
+ }
+ }
+ $oBook->{PrintTitle}[$iSheet] =
+ { Row => \@aTtlR, Column => \@aTtlC };
+ }
+ }
+ else {
+ my $iName = unpack( 'c', substr( $sWk, 14 ) );
+ if ( $iName == 6 ) { #PrintArea
+ my ( $iSheet, $raArea ) =
+ _ParseNameArea95( substr( $sWk, 15 ) );
+ $oBook->{PrintArea}[$iSheet] = $raArea;
+ }
+ elsif ( $iName == 7 ) { #Title
+ my ( $iSheet, $raArea ) =
+ _ParseNameArea95( substr( $sWk, 15 ) );
+ my @aTtlR = ();
+ my @aTtlC = ();
+ foreach my $raI ( @$raArea ) {
+ if ( $raI->[3] == 0xFF ) { #Row Title
+ push @aTtlR, [ $raI->[0], $raI->[2] ];
+ }
+ else { #Col Title
+ push @aTtlC, [ $raI->[1], $raI->[3] ];
+ }
+ }
+ $oBook->{PrintTitle}[$iSheet] =
+ { Row => \@aTtlR, Column => \@aTtlC };
+ }
+ }
+ }
+}
+
+#------------------------------------------------------------------------------
+# ParseNameArea (for Spreadsheet::ParseExcel) DK: 494 (ptgAread3d)
+#------------------------------------------------------------------------------
+sub _ParseNameArea {
+ my ( $sObj ) = @_;
+ my ( $iOp );
+ my @aRes = ();
+ $iOp = unpack( 'C', $sObj );
+ my $iSheet;
+ if ( $iOp == 0x3b ) {
+ my ( $iWkS, $iRs, $iRe, $iCs, $iCe ) =
+ unpack( 'v5', substr( $sObj, 1 ) );
+ $iSheet = $iWkS;
+ push @aRes, [ $iRs, $iCs, $iRe, $iCe ];
+ }
+ elsif ( $iOp == 0x29 ) {
+ my $iLen = unpack( 'v', substr( $sObj, 1, 2 ) );
+ my $iSt = 0;
+ while ( $iSt < $iLen ) {
+ my ( $iOpW, $iWkS, $iRs, $iRe, $iCs, $iCe ) =
+ unpack( 'cv5', substr( $sObj, $iSt + 3, 11 ) );
+
+ if ( $iOpW == 0x3b ) {
+ $iSheet = $iWkS;
+ push @aRes, [ $iRs, $iCs, $iRe, $iCe ];
+ }
+
+ if ( $iSt == 0 ) {
+ $iSt += 11;
+ }
+ else {
+ $iSt += 12; #Skip 1 byte;
+ }
+ }
+ }
+ return ( $iSheet, \@aRes );
+}
+
+#------------------------------------------------------------------------------
+# ParseNameArea95 (for Spreadsheet::ParseExcel) DK: 494 (ptgAread3d)
+#------------------------------------------------------------------------------
+sub _ParseNameArea95 {
+ my ( $sObj ) = @_;
+ my ( $iOp );
+ my @aRes = ();
+ $iOp = unpack( 'C', $sObj );
+ my $iSheet;
+ if ( $iOp == 0x3b ) {
+ $iSheet = unpack( 'v', substr( $sObj, 11, 2 ) );
+ my ( $iRs, $iRe, $iCs, $iCe ) =
+ unpack( 'v2C2', substr( $sObj, 15, 6 ) );
+ push @aRes, [ $iRs, $iCs, $iRe, $iCe ];
+ }
+ elsif ( $iOp == 0x29 ) {
+ my $iLen = unpack( 'v', substr( $sObj, 1, 2 ) );
+ my $iSt = 0;
+ while ( $iSt < $iLen ) {
+ my $iOpW = unpack( 'c', substr( $sObj, $iSt + 3, 6 ) );
+ $iSheet = unpack( 'v', substr( $sObj, $iSt + 14, 2 ) );
+ my ( $iRs, $iRe, $iCs, $iCe ) =
+ unpack( 'v2C2', substr( $sObj, $iSt + 18, 6 ) );
+ push @aRes, [ $iRs, $iCs, $iRe, $iCe ] if ( $iOpW == 0x3b );
+
+ if ( $iSt == 0 ) {
+ $iSt += 21;
+ }
+ else {
+ $iSt += 22; #Skip 1 byte;
+ }
+ }
+ }
+ return ( $iSheet, \@aRes );
+}
+
+#------------------------------------------------------------------------------
+# _subBOOL (for Spreadsheet::ParseExcel) DK: P452
+#------------------------------------------------------------------------------
+sub _subWSBOOL {
+ my ( $oBook, $bOp, $bLen, $sWk ) = @_;
+ return undef unless ( defined $oBook->{_CurSheet} );
+
+ $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{PageFit} =
+ ( ( unpack( 'v', $sWk ) & 0x100 ) ? 1 : 0 );
+}
+
+#------------------------------------------------------------------------------
+# _subMergeArea (for Spreadsheet::ParseExcel) DK: (Not)
+#------------------------------------------------------------------------------
+sub _subMergeArea {
+ my ( $oBook, $bOp, $bLen, $sWk ) = @_;
+ return undef unless ( defined $oBook->{_CurSheet} );
+
+ my $iCnt = unpack( "v", $sWk );
+ my $oWkS = $oBook->{Worksheet}[ $oBook->{_CurSheet} ];
+ $oWkS->{MergedArea} = [] unless ( defined $oWkS->{MergedArea} );
+ for ( my $i = 0 ; $i < $iCnt ; $i++ ) {
+ my ( $iRs, $iRe, $iCs, $iCe ) =
+ unpack( 'v4', substr( $sWk, $i * 8 + 2, 8 ) );
+ for ( my $iR = $iRs ; $iR <= $iRe ; $iR++ ) {
+ for ( my $iC = $iCs ; $iC <= $iCe ; $iC++ ) {
+ $oWkS->{Cells}[$iR][$iC]->{Merged} = 1
+ if ( defined $oWkS->{Cells}[$iR][$iC] );
+ }
+ }
+ push @{ $oWkS->{MergedArea} }, [ $iRs, $iCs, $iRe, $iCe ];
+ }
+}
+
+#------------------------------------------------------------------------------
+# DecodeBoolErr (for Spreadsheet::ParseExcel) DK: P306
+#------------------------------------------------------------------------------
+sub DecodeBoolErr {
+ my ( $iVal, $iFlg ) = @_;
+ if ( $iFlg ) { # ERROR
+ if ( $iVal == 0x00 ) {
+ return "#NULL!";
+ }
+ elsif ( $iVal == 0x07 ) {
+ return "#DIV/0!";
+ }
+ elsif ( $iVal == 0x0F ) {
+ return "#VALUE!";
+ }
+ elsif ( $iVal == 0x17 ) {
+ return "#REF!";
+ }
+ elsif ( $iVal == 0x1D ) {
+ return "#NAME?";
+ }
+ elsif ( $iVal == 0x24 ) {
+ return "#NUM!";
+ }
+ elsif ( $iVal == 0x2A ) {
+ return "#N/A!";
+ }
+ else {
+ return "#ERR";
+ }
+ }
+ else {
+ return ( $iVal ) ? "TRUE" : "FALSE";
+ }
+}
+
+###############################################################################
+#
+# _decode_rk_number()
+#
+# Convert an encoded RK number into a real number. The RK encoding is
+# explained in some detail in the MS docs. It is a way of storing applicable
+# ints and doubles in 32bits (30 data + 2 info bits) in order to save space.
+#
+sub _decode_rk_number {
+
+ my $rk_number = shift;
+ my $number;
+
+ # Check the main RK type.
+ if ( $rk_number & 0x02 ) {
+
+ # RK Type 2 and 4, a packed integer.
+
+ # Shift off the info bits.
+ $number = $rk_number >> 2;
+
+ # Convert from unsigned to signed if required.
+ $number -= 0x40000000 if $number & 0x20000000;
+ }
+ else {
+
+ # RK Type 1 and 3, a truncated IEEE Double.
+
+ # Pack the RK number into the high 30 bits of an IEEE double.
+ $number = pack "VV", 0x0000, $rk_number & 0xFFFFFFFC;
+
+ # Reverse the packed IEEE double on big-endian machines.
+ $number = reverse $number if $BIGENDIAN;
+
+ # Unpack the number.
+ $number = unpack "d", $number;
+ }
+
+ # RK Types 3 and 4 were multiplied by 100 prior to encoding.
+ $number /= 100 if $rk_number & 0x01;
+
+ return $number;
+}
+
+###############################################################################
+#
+# _subStrWk()
+#
+# Extract the workbook strings from the SST (Shared String Table) record and
+# any following CONTINUE records.
+#
+# The workbook strings are initially contained in the SST block but may also
+# occupy one or more CONTINUE blocks. Reading the CONTINUE blocks is made a
+# little tricky by the fact that they can contain an additional initial byte
+# if a string is continued from a previous block.
+#
+# Parsing is further complicated by the fact that the continued section of the
+# string may have a different encoding (ASCII or UTF-8) from the previous
+# section. Excel does this to save space.
+#
+sub _subStrWk {
+
+ my ( $self, $biff_data, $is_continue ) = @_;
+
+ if ( $is_continue ) {
+
+ # We are reading a CONTINUE record.
+
+ if ( $self->{_buffer} eq '' ) {
+
+ # A CONTINUE block with no previous SST.
+ $self->{_buffer} .= $biff_data;
+ }
+ elsif ( !defined $self->{_string_continued} ) {
+
+ # The CONTINUE block starts with a new (non-continued) string.
+
+ # Strip the Grbit byte and store the string data.
+ $self->{_buffer} .= substr $biff_data, 1;
+ }
+ else {
+
+ # A CONTINUE block that starts with a continued string.
+
+ # The first byte (Grbit) of the CONTINUE record indicates if (0)
+ # the continued string section is single bytes or (1) double bytes.
+ my $grbit = ord $biff_data;
+
+ my ( $str_position, $str_length ) = @{ $self->{_previous_info} };
+ my $buff_length = length $self->{_buffer};
+
+ if ( $buff_length >= ( $str_position + $str_length ) ) {
+
+ # Not in a string.
+ $self->{_buffer} .= $biff_data;
+ }
+ elsif ( ( $self->{_string_continued} & 0x01 ) == ( $grbit & 0x01 ) )
+ {
+
+ # Same encoding as the previous block of the string.
+ $self->{_buffer} .= substr( $biff_data, 1 );
+ }
+ else {
+
+ # Different encoding to the previous block of the string.
+ if ( $grbit & 0x01 ) {
+
+ # Current block is UTF-16, previous was ASCII.
+ my ( undef, $cch ) = unpack 'vc', $self->{_buffer};
+ substr( $self->{_buffer}, 2, 1 ) = pack( 'C', $cch | 0x01 );
+
+ # Convert the previous ASCII, single character, portion of
+ # the string into a double character UTF-16 string by
+ # inserting zero bytes.
+ for (
+ my $i = ( $buff_length - $str_position ) ;
+ $i >= 1 ;
+ $i--
+ )
+ {
+ substr( $self->{_buffer}, $str_position + $i, 0 ) =
+ "\x00";
+ }
+
+ }
+ else {
+
+ # Current block is ASCII, previous was UTF-16.
+
+ # Convert the current ASCII, single character, portion of
+ # the string into a double character UTF-16 string by
+ # inserting null bytes.
+ my $change_length =
+ ( $str_position + $str_length ) - $buff_length;
+
+ # Length of the current CONTINUE record data.
+ my $biff_length = length $biff_data;
+
+ # Restrict the portion to be changed to the current block
+ # if the string extends over more than one block.
+ if ( $change_length > ( $biff_length - 1 ) * 2 ) {
+ $change_length = ( $biff_length - 1 ) * 2;
+ }
+
+ # Insert the null bytes.
+ for ( my $i = ( $change_length / 2 ) ; $i >= 1 ; $i-- ) {
+ substr( $biff_data, $i + 1, 0 ) = "\x00";
+ }
+
+ }
+
+ # Strip the Grbit byte and store the string data.
+ $self->{_buffer} .= substr $biff_data, 1;
+ }
+ }
+ }
+ else {
+
+ # Not a CONTINUE block therefore an SST block.
+ $self->{_buffer} .= $biff_data;
+ }
+
+ # Reset the state variables.
+ $self->{_string_continued} = undef;
+ $self->{_previous_info} = undef;
+
+ # Extract out any full strings from the current buffer leaving behind a
+ # partial string that is continued into the next block, or an empty
+ # buffer is no string is continued.
+ while ( length $self->{_buffer} >= 4 ) {
+ my ( $str_info, $length, $str_position, $str_length ) =
+ _convBIFF8String( $self, $self->{_buffer}, 1 );
+
+ if ( defined $str_info->[0] ) {
+ push @{ $self->{PkgStr} },
+ {
+ Text => $str_info->[0],
+ Unicode => $str_info->[1],
+ Rich => $str_info->[2],
+ Ext => $str_info->[3],
+ };
+ $self->{_buffer} = substr( $self->{_buffer}, $length );
+ }
+ else {
+ $self->{_string_continued} = $str_info->[1];
+ $self->{_previous_info} = [ $str_position, $str_length ];
+ last;
+ }
+ }
+}
+
+#------------------------------------------------------------------------------
+# _SwapForUnicode (for Spreadsheet::ParseExcel)
+#------------------------------------------------------------------------------
+sub _SwapForUnicode {
+ my ( $sObj ) = @_;
+
+ # for(my $i = 0; $i<length($$sObj); $i+=2){
+ for ( my $i = 0 ; $i < ( int( length( $$sObj ) / 2 ) * 2 ) ; $i += 2 ) {
+ my $sIt = substr( $$sObj, $i, 1 );
+ substr( $$sObj, $i, 1 ) = substr( $$sObj, $i + 1, 1 );
+ substr( $$sObj, $i + 1, 1 ) = $sIt;
+ }
+}
+
+#------------------------------------------------------------------------------
+# _NewCell (for Spreadsheet::ParseExcel)
+#------------------------------------------------------------------------------
+sub _NewCell {
+ my ( $oBook, $iR, $iC, %rhKey ) = @_;
+ my ( $sWk, $iLen );
+ return undef unless ( defined $oBook->{_CurSheet} );
+
+ my $FmtClass = $oBook->{FmtClass};
+ $rhKey{Type} =
+ $FmtClass->ChkType( $rhKey{Numeric}, $rhKey{Format}{FmtIdx} );
+ my $FmtStr = $oBook->{FormatStr}{ $rhKey{Format}{FmtIdx} };
+
+ # Set "Date" type if required for numbers in a MulRK BIFF block.
+ if ( defined $FmtStr && $rhKey{Type} eq "Numeric" ) {
+
+ # Match a range of possible date formats. Note: this isn't important
+ # except for reporting. The number will still be converted to a date
+ # by ExcelFmt() even if 'Type' isn't set to 'Date'.
+ if ( $FmtStr =~ m{^[dmy][-\\/dmy]*$}i ) {
+ $rhKey{Type} = "Date";
+ }
+ }
+
+ my $oCell = Spreadsheet::ParseExcel::Cell->new(
+ Val => $rhKey{Val},
+ FormatNo => $rhKey{FormatNo},
+ Format => $rhKey{Format},
+ Code => $rhKey{Code},
+ Type => $rhKey{Type},
+ );
+ $oCell->{_Kind} = $rhKey{Kind};
+ $oCell->{_Value} = $FmtClass->ValFmt( $oCell, $oBook );
+ if ( $rhKey{Rich} ) {
+ my @aRich = ();
+ my $sRich = $rhKey{Rich};
+ for ( my $iWk = 0 ; $iWk < length( $sRich ) ; $iWk += 4 ) {
+ my ( $iPos, $iFnt ) = unpack( 'v2', substr( $sRich, $iWk ) );
+ push @aRich, [ $iPos, $oBook->{Font}[$iFnt] ];
+ }
+ $oCell->{Rich} = \@aRich;
+ }
+
+ if ( defined $_CellHandler ) {
+ if ( defined $_Object ) {
+ no strict;
+ ref( $_CellHandler ) eq "CODE"
+ ? $_CellHandler->(
+ $_Object, $oBook, $oBook->{_CurSheet}, $iR, $iC, $oCell
+ )
+ : $_CellHandler->callback( $_Object, $oBook, $oBook->{_CurSheet},
+ $iR, $iC, $oCell );
+ }
+ else {
+ $_CellHandler->( $oBook, $oBook->{_CurSheet}, $iR, $iC, $oCell );
+ }
+ }
+ unless ( $_NotSetCell ) {
+ $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{Cells}[$iR][$iC] = $oCell;
+ }
+ return $oCell;
+}
+
+#------------------------------------------------------------------------------
+# ColorIdxToRGB (for Spreadsheet::ParseExcel)
+#
+# TODO JMN Make this a Workbook method and re-document.
+#
+#------------------------------------------------------------------------------
+sub ColorIdxToRGB {
+ my ( $sPkg, $iIdx ) = @_;
+ return ( ( defined $aColor[$iIdx] ) ? $aColor[$iIdx] : $aColor[0] );
+}
+
+
+###############################################################################
+#
+# error().
+#
+# Return an error string for a failed parse().
+#
+sub error {
+
+ my $self = shift;
+
+ my $parse_error = $self->{_error_status};
+
+ if ( exists $error_strings{$parse_error} ) {
+ return $error_strings{$parse_error};
+ }
+ else {
+ return 'Unknown parse error';
+ }
+}
+
+
+###############################################################################
+#
+# error_code().
+#
+# Return an error code for a failed parse().
+#
+sub error_code {
+
+ my $self = shift;
+
+ return $self->{_error_status};
+}
+
+
+###############################################################################
+#
+# Mapping between legacy method names and new names.
+#
+{
+ no warnings; # Ignore warnings about variables used only once.
+ *Parse = *parse;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Spreadsheet::ParseExcel - Read information from an Excel file.
+
+=head1 SYNOPSIS
+
+ #!/usr/bin/perl -w
+
+ use strict;
+ use Spreadsheet::ParseExcel;
+
+ my $parser = Spreadsheet::ParseExcel->new();
+ my $workbook = $parser->parse('Book1.xls');
+
+ if ( !defined $workbook ) {
+ die $parser->error(), ".\n";
+ }
+
+ for my $worksheet ( $workbook->worksheets() ) {
+
+ my ( $row_min, $row_max ) = $worksheet->row_range();
+ my ( $col_min, $col_max ) = $worksheet->col_range();
+
+ for my $row ( $row_min .. $row_max ) {
+ for my $col ( $col_min .. $col_max ) {
+
+ my $cell = $worksheet->get_cell( $row, $col );
+ next unless $cell;
+
+ print "Row, Col = ($row, $col)\n";
+ print "Value = ", $cell->value(), "\n";
+ print "Unformatted = ", $cell->unformatted(), "\n";
+ print "\n";
+ }
+ }
+ }
+
+
+=head1 DESCRIPTION
+
+The Spreadsheet::ParseExcel module can be used to read information from Excel 95-2003 binary files.
+
+The module cannot read files in the Excel 2007 Open XML XLSX format. See the L<Spreadsheet::XLSX> module instead.
+
+=head1 Parser
+
+=head2 new()
+
+The C<new()> method is used to create a new C<Spreadsheet::ParseExcel> parser object.
+
+ my $parser = Spreadsheet::ParseExcel->new();
+
+It it possible to pass a password to decrypt an encrypted file:
+
+ $parser = Spreadsheet::ParseExcel->new( Password => 'secret' );
+
+Only the default Excel encryption scheme is currently supported. See L</Decryption>.
+
+As an advanced feature it is also possible to pass a call-back handler to the parser to control the parsing of the spreadsheet.
+
+ $parser = Spreadsheet::ParseExcel->new(
+ CellHandler => \&cell_handler,
+ NotSetCell => 1,
+ );
+
+The call-back can be used to ignore certain cells or to reduce memory usage. See the section L<Reducing the memory usage of Spreadsheet::ParseExcel> for more information.
+
+
+=head2 parse($filename, $formatter)
+
+The Parser C<parse()> method returns a L</Workbook> object.
+
+ my $parser = Spreadsheet::ParseExcel->new();
+ my $workbook = $parser->parse('Book1.xls');
+
+If an error occurs C<parse()> returns C<undef>. In general, programs should contain a test for failed parsing as follows:
+
+ my $parser = Spreadsheet::ParseExcel->new();
+ my $workbook = $parser->parse('Book1.xls');
+
+ if ( !defined $workbook ) {
+ die $parser->error(), ".\n";
+ }
+
+The C<$filename> parameter is generally the file to be parsed. However, it can also be a filehandle or a scalar reference.
+
+The optional C<$formatter> parameter can be an reference to a L</Formatter Class> to format the value of cells. This is useful for parsing workbooks with Unicode or Asian characters:
+
+ my $parser = Spreadsheet::ParseExcel->new();
+ my $formatter = Spreadsheet::ParseExcel::FmtJapan->new();
+ my $workbook = $parser->parse( 'Book1.xls', $formatter );
+
+The L<Spreadsheet::ParseExcel::FmtJapan> formatter also supports Unicode. If you encounter any encoding problems with the default formatter try that instead.
+
+
+=head2 error()
+
+The Parser C<error()> method returns an error string if a C<parse()> fails:
+
+ my $parser = Spreadsheet::ParseExcel->new();
+ my $workbook = $parser->parse('Book1.xls');
+
+ if ( !defined $workbook ) {
+ die $parser->error(), ".\n";
+ }
+
+If you wish to generate you own error string you can use the C<error_code()> method instead (see below). The C<error()> and C<error_code()> values are as follows:
+
+ error() error_code()
+ ======= ============
+ '' 0
+ 'File not found' 1
+ 'No Excel data found in file' 2
+ 'File is encrypted' 3
+
+
+The C<error_code()> method is explained below.
+
+Spreadsheet::ParseExcel will try to decrypt an encrypted Excel file using the default password or a user supplied password passed to C<new()>, see above. If these fail the module will return the C<'File is encrypted'> error. Only the default Excel encryption scheme is currently supported, see L</Decryption>.
+
+
+=head2 error_code()
+
+The Parser C<error_code()> method returns an error code if a C<parse()> fails:
+
+ my $parser = Spreadsheet::ParseExcel->new();
+ my $workbook = $parser->parse('Book1.xls');
+
+ if ( !defined $workbook ) {
+ die "Got error code ", $parser->error_code, ".\n";
+ }
+
+This can be useful if you wish to employ you own error strings or error handling methods.
+
+
+=head1 Workbook
+
+A C<Spreadsheet::ParseExcel::Workbook> is created via the C<Spreadsheet::ParseExcel> C<parse()> method:
+
+ my $parser = Spreadsheet::ParseExcel->new();
+ my $workbook = $parser->parse('Book1.xls');
+
+The main methods of the Workbook class are:
+
+ $workbook->worksheets()
+ $workbook->worksheet()
+ $workbook->worksheet_count()
+ $workbook->get_filename()
+
+These more commonly used methods of the Workbook class are outlined below. The other, less commonly used, methods are documented in L<Spreadsheet::ParseExcel::Worksheet>.
+
+
+=head2 worksheets()
+
+Returns an array of L</Worksheet> objects. This was most commonly used to iterate over the worksheets in a workbook:
+
+ for my $worksheet ( $workbook->worksheets() ) {
+ ...
+ }
+
+
+=head2 worksheet()
+
+The C<worksheet()> method returns a single C<Worksheet> object using either its name or index:
+
+ $worksheet = $workbook->worksheet('Sheet1');
+ $worksheet = $workbook->worksheet(0);
+
+Returns C<undef> if the sheet name or index doesn't exist.
+
+
+=head2 worksheet_count()
+
+The C<worksheet_count()> method returns the number of Worksheet objects in the Workbook.
+
+ my $worksheet_count = $workbook->worksheet_count();
+
+
+=head2 get_filename()
+
+The C<get_filename()> method returns the name of the Excel file of C<undef> if the data was read from a filehandle rather than a file.
+
+ my $filename = $workbook->get_filename();
+
+
+=head2 Other Workbook Methods
+
+For full documentation of the methods available via a Workbook object see L<Spreadsheet::ParseExcel::Workbook>.
+
+=head1 Worksheet
+
+The C<Spreadsheet::ParseExcel::Worksheet> class encapsulates the properties of an Excel worksheet.
+
+A Worksheet object is obtained via the L</worksheets()> or L</worksheet()> methods.
+
+ for my $worksheet ( $workbook->worksheets() ) {
+ ...
+ }
+
+ # Or:
+
+ $worksheet = $workbook->worksheet('Sheet1');
+ $worksheet = $workbook->worksheet(0);
+
+The most commonly used methods of the Worksheet class are:
+
+ $worksheet->get_cell()
+ $worksheet->row_range()
+ $worksheet->col_range()
+ $worksheet->get_name()
+
+The Spreadsheet::ParseExcel::Worksheet class exposes a lot of methods but in general very few are required unless you are writing an advanced filter.
+
+The most commonly used methods are detailed below. The others are documented in L<Spreadsheet::ParseExcel::Worksheet>.
+
+=head2 get_cell($row, $col)
+
+Return the L</Cell> object at row C<$row> and column C<$col> if it is defined. Otherwise returns undef.
+
+ my $cell = $worksheet->get_cell($row, $col);
+
+
+=head2 row_range()
+
+Returns a two-element list C<($min, $max)> containing the minimum and maximum defined rows in the worksheet. If there is no row defined C<$max> is smaller than C<$min>.
+
+ my ( $row_min, $row_max ) = $worksheet->row_range();
+
+
+=head2 col_range()
+
+Returns a two-element list C<($min, $max)> containing the minimum and maximum of defined columns in the worksheet. If there is no column defined C<$max> is smaller than C<$min>.
+
+ my ( $col_min, $col_max ) = $worksheet->col_range();
+
+
+=head2 get_name()
+
+The C<get_name()> method returns the name of the worksheet, such as 'Sheet1'.
+
+ my $name = $worksheet->get_name();
+
+=head2 Other Worksheet Methods
+
+For other, less commonly used, Worksheet methods see L<Spreadsheet::ParseExcel::Worksheet>.
+
+=head1 Cell
+
+The C<Spreadsheet::ParseExcel::Cell> class has the following main methods.
+
+ $cell->value()
+ $cell->unformatted()
+
+=head2 value()
+
+The C<value()> method returns the formatted value of the cell.
+
+ my $value = $cell->value();
+
+Formatted in this sense refers to the numeric format of the cell value. For example a number such as 40177 might be formatted as 40,117, 40117.000 or even as the date 2009/12/30.
+
+If the cell doesn't contain a numeric format then the formatted and unformatted cell values are the same, see the C<unformatted()> method below.
+
+For a defined C<$cell> the C<value()> method will always return a value.
+
+In the case of a cell with formatting but no numeric or string contents the method will return the empty string C<''>.
+
+
+=head2 unformatted()
+
+The C<unformatted()> method returns the unformatted value of the cell.
+
+ my $unformatted = $cell->unformatted();
+
+Returns the cell value without a numeric format. See the C<value()> method above.
+
+=head2 Other Cell Methods
+
+For other, less commonly used, Worksheet methods see L<Spreadsheet::ParseExcel::Cell>.
+
+
+=head1 Format
+
+The C<Spreadsheet::ParseExcel::Format> class has the following properties:
+
+=head2 Format properties
+
+ $format->{Font}
+ $format->{AlignH}
+ $format->{AlignV}
+ $format->{Indent}
+ $format->{Wrap}
+ $format->{Shrink}
+ $format->{Rotate}
+ $format->{JustLast}
+ $format->{ReadDir}
+ $format->{BdrStyle}
+ $format->{BdrColor}
+ $format->{BdrDiag}
+ $format->{Fill}
+ $format->{Lock}
+ $format->{Hidden}
+ $format->{Style}
+
+These properties are generally only of interest to advanced users. Casual users can skip this section.
+
+=head2 $format->{Font}
+
+Returns the L</Font> object for the Format.
+
+=head2 $format->{AlignH}
+
+Returns the horizontal alignment of the format where the value has the following meaning:
+
+ 0 => No alignment
+ 1 => Left
+ 2 => Center
+ 3 => Right
+ 4 => Fill
+ 5 => Justify
+ 6 => Center across
+ 7 => Distributed/Equal spaced
+
+=head2 $format->{AlignV}
+
+Returns the vertical alignment of the format where the value has the following meaning:
+
+ 0 => Top
+ 1 => Center
+ 2 => Bottom
+ 3 => Justify
+ 4 => Distributed/Equal spaced
+
+=head2 $format->{Indent}
+
+Returns the indent level of the C<Left> horizontal alignment.
+
+=head2 $format->{Wrap}
+
+Returns true if textwrap is on.
+
+=head2 $format->{Shrink}
+
+Returns true if "Shrink to fit" is set for the format.
+
+=head2 $format->{Rotate}
+
+Returns the text rotation. In Excel97+, it returns the angle in degrees of the text rotation.
+
+In Excel95 or earlier it returns a value as follows:
+
+ 0 => No rotation
+ 1 => Top down
+ 2 => 90 degrees anti-clockwise,
+ 3 => 90 clockwise
+
+=head2 $format->{JustLast}
+
+Return true if the "justify last" property is set for the format.
+
+=head2 $format->{ReadDir}
+
+Returns the direction that the text is read from.
+
+=head2 $format->{BdrStyle}
+
+Returns an array ref of border styles as follows:
+
+ [ $left, $right, $top, $bottom ]
+
+=head2 $format->{BdrColor}
+
+Returns an array ref of border color indexes as follows:
+
+ [ $left, $right, $top, $bottom ]
+
+=head2 $format->{BdrDiag}
+
+Returns an array ref of diagonal border kind, style and color index as follows:
+
+ [$kind, $style, $color ]
+
+Where kind is:
+
+ 0 => None
+ 1 => Right-Down
+ 2 => Right-Up
+ 3 => Both
+
+=head2 $format->{Fill}
+
+Returns an array ref of fill pattern and color indexes as follows:
+
+ [ $pattern, $front_color, $back_color ]
+
+=head2 $format->{Lock}
+
+Returns true if the cell is locked.
+
+=head2 $format->{Hidden}
+
+Returns true if the cell is Hidden.
+
+=head2 $format->{Style}
+
+Returns true if the format is a Style format.
+
+
+
+
+=head1 Font
+
+I<Spreadsheet::ParseExcel::Font>
+
+Format class has these properties:
+
+=head1 Font Properties
+
+ $font->{Name}
+ $font->{Bold}
+ $font->{Italic}
+ $font->{Height}
+ $font->{Underline}
+ $font->{UnderlineStyle}
+ $font->{Color}
+ $font->{Strikeout}
+ $font->{Super}
+
+=head2 $font->{Name}
+
+Returns the name of the font, for example 'Arial'.
+
+=head2 $font->{Bold}
+
+Returns true if the font is bold.
+
+=head2 $font->{Italic}
+
+Returns true if the font is italic.
+
+=head2 $font->{Height}
+
+Returns the size (height) of the font.
+
+=head2 $font->{Underline}
+
+Returns true if the font in underlined.
+
+=head2 $font->{UnderlineStyle}
+
+Returns the style of an underlined font where the value has the following meaning:
+
+ 0 => None
+ 1 => Single
+ 2 => Double
+ 33 => Single accounting
+ 34 => Double accounting
+
+=head2 $font->{Color}
+
+Returns the color index for the font. The index can be converted to a RGB string using the C<ColorIdxToRGB()> Parser method.
+
+=head2 $font->{Strikeout}
+
+Returns true if the font has the strikeout property set.
+
+=head2 $font->{Super}
+
+Returns one of the following values if the superscript or subscript property of the font is set:
+
+ 0 => None
+ 1 => Superscript
+ 2 => Subscript
+
+=head1 Formatter Class
+
+Formatters can be passed to the C<parse()> method to deal with Unicode or Asian formatting.
+
+Spreadsheet::ParseExcel includes 2 formatter classes. C<FmtDefault> and C<FmtJapanese>. It is also possible to create a user defined formatting class.
+
+The formatter class C<Spreadsheet::ParseExcel::Fmt*> should provide the following functions:
+
+
+=head2 ChkType($self, $is_numeric, $format_index)
+
+Method to check the type of data in the cell. Should return C<Date>, C<Numeric> or C<Text>. It is passed the following parameters:
+
+=over
+
+=item $self
+
+A scalar reference to the Formatter object.
+
+=item $is_numeric
+
+If true, the value seems to be number.
+
+=item $format_index
+
+The index number for the cell Format object.
+
+=back
+
+=head2 TextFmt($self, $string_data, $string_encoding)
+
+Converts the string data in the cell into the correct encoding. It is passed the following parameters:
+
+=over
+
+=item $self
+
+A scalar reference to the Formatter object.
+
+=item $string_data
+
+The original string/text data.
+
+=item $string_encoding
+
+The character encoding of original string/text.
+
+=back
+
+=head2 ValFmt($self, $cell, $workbook)
+
+Convert the original unformatted cell value into the appropriate formatted value. For instance turn a number into a formatted date. It is passed the following parameters:
+
+=over
+
+=item $self
+
+A scalar reference to the Formatter object.
+
+=item $cell
+
+A scalar reference to the Cell object.
+
+=item $workbook
+
+A scalar reference to the Workbook object.
+
+=back
+
+
+=head2 FmtString($self, $cell, $workbook)
+
+Get the format string for the Cell. It is passed the following parameters:
+
+=over
+
+=item $self
+
+A scalar reference to the Formatter object.
+
+=item $cell
+
+A scalar reference to the Cell object.
+
+=item $workbook
+
+A scalar reference to the Workbook object.
+
+=back
+
+
+=head1 Reducing the memory usage of Spreadsheet::ParseExcel
+
+In some cases a C<Spreadsheet::ParseExcel> application may consume a lot of memory when processing a large Excel file and, as a result, may fail to complete. The following explains why this can occur and how to resolve it.
+
+C<Spreadsheet::ParseExcel> processes an Excel file in two stages. In the first stage it extracts the Excel binary stream from the OLE container file using C<OLE::Storage_Lite>. In the second stage it parses the binary stream to read workbook, worksheet and cell data which it then stores in memory. The majority of the memory usage is required for storing cell data.
+
+The reason for this is that as the Excel file is parsed and each cell is encountered a cell handling function creates a relatively large nested cell object that contains the cell value and all of the data that relates to the cell formatting. For large files (a 10MB Excel file on a 256MB system) this overhead can cause the system to grind to a halt.
+
+However, in a lot of cases when an Excel file is being processed the only information that is required are the cell values. In these cases it is possible to avoid most of the memory overhead by specifying your own cell handling function and by telling Spreadsheet::ParseExcel not to store the parsed cell data. This is achieved by passing a cell handler function to C<new()> when creating the parse object. Here is an example.
+
+ #!/usr/bin/perl -w
+
+ use strict;
+ use Spreadsheet::ParseExcel;
+
+ my $parser = Spreadsheet::ParseExcel->new(
+ CellHandler => \&cell_handler,
+ NotSetCell => 1
+ );
+
+ my $workbook = $parser->parse('file.xls');
+
+ sub cell_handler {
+
+ my $workbook = $_[0];
+ my $sheet_index = $_[1];
+ my $row = $_[2];
+ my $col = $_[3];
+ my $cell = $_[4];
+
+ # Do something useful with the formatted cell value
+ print $cell->value(), "\n";
+
+ }
+
+
+The user specified cell handler is passed as a code reference to C<new()> along with the parameter C<NotSetCell> which tells Spreadsheet::ParseExcel not to store the parsed cell. Note, you don't have to iterate over the rows and columns, this happens automatically as part of the parsing.
+
+The cell handler is passed 5 arguments. The first, C<$workbook>, is a reference to the C<Spreadsheet::ParseExcel::Workbook> object that represent the parsed workbook. This can be used to access any of the C<Spreadsheet::ParseExcel::Workbook> methods, see L</Workbook>. The second C<$sheet_index> is the zero-based index of the worksheet being parsed. The third and fourth, C<$row> and C<$col>, are the zero-based row and column number of the cell. The fifth, C<$cell>, is a reference to the C<Spreadsheet::ParseExcel::Cell> object. This is used to extract the data from the cell. See L</Cell> for more information.
+
+This technique can be useful if you are writing an Excel to database filter since you can put your DB calls in the cell handler.
+
+If you don't want all of the data in the spreadsheet you can add some control logic to the cell handler. For example we can extend the previous example so that it only prints the first 10 rows of the first two worksheets in the parsed workbook by adding some C<if()> statements to the cell handler:
+
+ #!/usr/bin/perl -w
+
+ use strict;
+ use Spreadsheet::ParseExcel;
+
+ my $parser = Spreadsheet::ParseExcel->new(
+ CellHandler => \&cell_handler,
+ NotSetCell => 1
+ );
+
+ my $workbook = $parser->parse('file.xls');
+
+ sub cell_handler {
+
+ my $workbook = $_[0];
+ my $sheet_index = $_[1];
+ my $row = $_[2];
+ my $col = $_[3];
+ my $cell = $_[4];
+
+ # Skip some worksheets and rows (inefficiently).
+ return if $sheet_index >= 3;
+ return if $row >= 10;
+
+ # Do something with the formatted cell value
+ print $cell->value(), "\n";
+
+ }
+
+
+However, this still processes the entire workbook. If you wish to save some additional processing time you can abort the parsing after you have read the data that you want, using the workbook C<ParseAbort> method:
+
+ #!/usr/bin/perl -w
+
+ use strict;
+ use Spreadsheet::ParseExcel;
+
+ my $parser = Spreadsheet::ParseExcel->new(
+ CellHandler => \&cell_handler,
+ NotSetCell => 1
+ );
+
+ my $workbook = $parser->parse('file.xls');
+
+ sub cell_handler {
+
+ my $workbook = $_[0];
+ my $sheet_index = $_[1];
+ my $row = $_[2];
+ my $col = $_[3];
+ my $cell = $_[4];
+
+ # Skip some worksheets and rows (more efficiently).
+ if ( $sheet_index >= 1 and $row >= 10 ) {
+ $workbook->ParseAbort(1);
+ return;
+ }
+
+ # Do something with the formatted cell value
+ print $cell->value(), "\n";
+
+ }
+
+=head1 Decryption
+
+If a workbook is "protected" then Excel will encrypt the file whether a password is supplied or not. As of version 0.59 Spreadsheet::ParseExcel supports decrypting Excel workbooks using a default or user supplied password. However, only the following encryption scheme is supported:
+
+ Office 97/2000 Compatible encryption
+
+The following encryption methods are not supported:
+
+ Weak Encryption (XOR)
+ RC4, Microsoft Base Cryptographic Provider v1.0
+ RC4, Microsoft Base DSS and Diffie-Hellman Cryptographic Provider
+ RC4, Microsoft DH SChannel Cryptographic Provider
+ RC4, Microsoft Enhanced Cryptographic Provider v1.0
+ RC4, Microsoft Enhanced DSS and Diffie-Hellman Cryptographic Provider
+ RC4, Microsoft Enhanced RSA and AES Cryptographic Provider
+ RC4, Microsoft RSA SChannel Cryptographic Provider
+ RC4, Microsoft Strong Cryptographic Provider
+
+See the following for more information on Excel encryption: L<http://office.microsoft.com/en-us/office-2003-resource-kit/important-aspects-of-password-and-encryption-protection-HA001140311.aspx>.
+
+
+
+=head1 KNOWN PROBLEMS
+
+=over
+
+=item * Issues reported by users: L<http://rt.cpan.org/Public/Dist/Display.html?Name=Spreadsheet-ParseExcel>
+
+=item * This module cannot read the values of formulas from files created with Spreadsheet::WriteExcel unless the user specified the values when creating the file (which is generally not the case). The reason for this is that Spreadsheet::WriteExcel writes the formula but not the formula result since it isn't in a position to calculate arbitrary Excel formulas without access to Excel's formula engine.
+
+=item * If Excel has date fields where the specified format is equal to the system-default for the short-date locale, Excel does not store the format, but defaults to an internal format which is system dependent. In these cases ParseExcel uses the date format 'yyyy-mm-dd'.
+
+=back
+
+
+
+
+=head1 REPORTING A BUG
+
+Bugs can be reported via rt.cpan.org. See the following for instructions on bug reporting for Spreadsheet::ParseExcel
+
+L<http://rt.cpan.org/Public/Dist/Display.html?Name=Spreadsheet-ParseExcel>
+
+
+
+
+=head1 SEE ALSO
+
+=over
+
+=item * xls2csv by Ken Prows L<http://search.cpan.org/~ken/xls2csv-1.06/script/xls2csv>.
+
+=item * xls2csv and xlscat by H.Merijn Brand (these utilities are part of Spreadsheet::Read, see below).
+
+=item * excel2txt by Ken Youens-Clark, L<http://search.cpan.org/~kclark/excel2txt/excel2txt>. This is an excellent example of an Excel filter using Spreadsheet::ParseExcel. It can produce CSV, Tab delimited, Html, XML and Yaml.
+
+=item * XLSperl by Jon Allen L<http://search.cpan.org/~jonallen/XLSperl/bin/XLSperl>. This application allows you to use Perl "one-liners" with Microsoft Excel files.
+
+=item * Spreadsheet::XLSX L<http://search.cpan.org/~dmow/Spreadsheet-XLSX/lib/Spreadsheet/XLSX.pm> by Dmitry Ovsyanko. A module with a similar interface to Spreadsheet::ParseExcel for parsing Excel 2007 XLSX OpenXML files.
+
+=item * Spreadsheet::Read L<http://search.cpan.org/~hmbrand/Spreadsheet-Read/Read.pm> by H.Merijn Brand. A single interface for reading several different spreadsheet formats.
+
+=item * Spreadsheet::WriteExcel L<http://search.cpan.org/~jmcnamara/Spreadsheet-WriteExcel/lib/Spreadsheet/WriteExcel.pm>. A perl module for creating new Excel files.
+
+=item * Spreadsheet::ParseExcel::SaveParser L<http://search.cpan.org/~jmcnamara/Spreadsheet-ParseExcel/lib/Spreadsheet/ParseExcel/SaveParser.pm>. This is a combination of Spreadsheet::ParseExcel and Spreadsheet::WriteExcel and it allows you to "rewrite" an Excel file. See the following example L<http://search.cpan.org/~jmcnamara/Spreadsheet-WriteExcel/lib/Spreadsheet/WriteExcel.pm#MODIFYING_AND_REWRITING_EXCEL_FILES>. It is part of the Spreadsheet::ParseExcel distro.
+
+=item * Text::CSV_XS L<http://search.cpan.org/~hmbrand/Text-CSV_XS/CSV_XS.pm> by H.Merijn Brand. A fast and rigorous module for reading and writing CSV data. Don't consider rolling your own CSV handling, use this module instead.
+
+=back
+
+
+
+
+=head1 MAILING LIST
+
+There is a Google group for discussing and asking questions about Spreadsheet::ParseExcel. This is a good place to search to see if your question has been asked before: L<http://groups-beta.google.com/group/spreadsheet-parseexcel/>
+
+
+
+
+=head1 DONATIONS
+
+If you'd care to donate to the Spreadsheet::ParseExcel project, you can do so via PayPal: L<http://tinyurl.com/7ayes>
+
+
+
+
+=head1 TODO
+
+=over
+
+=item * The current maintenance work is directed towards making the documentation more useful, improving and simplifying the API, and improving the maintainability of the code base. After that new features will be added.
+
+=item * Fix open bugs and documentation for SaveParser.
+
+=item * Add Formula support, Hyperlink support, Named Range support.
+
+=item * Improve Spreadsheet::ParseExcel::SaveParser compatibility with Spreadsheet::WriteExcel.
+
+=item * Improve Unicode and other encoding support. This will probably require dropping support for perls prior to 5.8+.
+
+=back
+
+
+
+=head1 ACKNOWLEDGEMENTS
+
+From Kawai Takanori:
+
+First of all, I would like to acknowledge the following valuable programs and modules:
+XHTML, OLE::Storage and Spreadsheet::WriteExcel.
+
+In no particular order: Yamaji Haruna, Simamoto Takesi, Noguchi Harumi, Ikezawa Kazuhiro, Suwazono Shugo, Hirofumi Morisada, Michael Edwards, Kim Namusk, Slaven Rezic, Grant Stevens, H.Merijn Brand and many many people + Kawai Mikako.
+
+Alexey Mazurin added the decryption facility.
+
+
+
+=head1 DISCLAIMER OF WARRANTY
+
+Because this software is licensed free of charge, there is no warranty for the software, to the extent permitted by applicable law. Except when otherwise stated in writing the copyright holders and/or other parties provide the software "as is" without warranty of any kind, either expressed or implied, including, but not limited to, the implied warranties of merchantability and fitness for a particular purpose. The entire risk as to the quality and performance of the software is with you. Should the software prove defective, you assume the cost of all necessary servicing, repair, or correction.
+
+In no event unless required by applicable law or agreed to in writing will any copyright holder, or any other party who may modify and/or redistribute the software as permitted by the above licence, be liable to you for damages, including any general, special, incidental, or consequential damages arising out of the use or inability to use the software (including but not limited to loss of data or data being rendered inaccurate or losses sustained by you or third parties or a failure of the software to operate with any other software), even if such holder or other party has been advised of the possibility of such damages.
+
+
+
+
+=head1 LICENSE
+
+Either the Perl Artistic Licence L<http://dev.perl.org/licenses/artistic.html> or the GPL L<http://www.opensource.org/licenses/gpl-license.php>
+
+
+
+
+=head1 AUTHOR
+
+Current maintainer 0.40+: John McNamara jmcnamara@cpan.org
+
+Maintainer 0.27-0.33: Gabor Szabo szabgab@cpan.org
+
+Original author: Kawai Takanori (Hippo2000) kwitknr@cpan.org
+
+
+
+
+=head1 COPYRIGHT
+
+Copyright (c) 2009-2011 John McNamara
+
+Copyright (c) 2006-2008 Gabor Szabo
+
+Copyright (c) 2000-2006 Kawai Takanori
+
+All rights reserved. This is free software. You may distribute under the terms of either the GNU General Public License or the Artistic License.
+
+
+=cut
diff --git a/src/bach/build.bach/tools/perl/Spreadsheet/ParseExcel/Cell.pm b/src/bach/build.bach/tools/perl/Spreadsheet/ParseExcel/Cell.pm
new file mode 100644
index 0000000..2527075
--- /dev/null
+++ b/src/bach/build.bach/tools/perl/Spreadsheet/ParseExcel/Cell.pm
@@ -0,0 +1,314 @@
+package Spreadsheet::ParseExcel::Cell;
+
+###############################################################################
+#
+# Spreadsheet::ParseExcel::Cell - A class for Cell data and formatting.
+#
+# Used in conjunction with Spreadsheet::ParseExcel.
+#
+# Copyright (c) 2009 John McNamara
+# Copyright (c) 2006-2008 Gabor Szabo
+# Copyright (c) 2000-2006 Kawai Takanori
+#
+# perltidy with standard settings.
+#
+# Documentation after __END__
+#
+
+use strict;
+use warnings;
+
+our $VERSION = '0.59';
+
+###############################################################################
+#
+# new()
+#
+# Constructor.
+#
+sub new {
+ my ( $package, %properties ) = @_;
+ my $self = \%properties;
+
+ bless $self, $package;
+}
+
+###############################################################################
+#
+# value()
+#
+# Returns the formatted value of the cell.
+#
+sub value {
+
+ my $self = shift;
+
+ return $self->{_Value};
+}
+
+###############################################################################
+#
+# unformatted()
+#
+# Returns the unformatted value of the cell.
+#
+sub unformatted {
+
+ my $self = shift;
+
+ return $self->{Val};
+}
+
+###############################################################################
+#
+# get_format()
+#
+# Returns the Format object for the cell.
+#
+sub get_format {
+
+ my $self = shift;
+
+ return $self->{Format};
+}
+
+###############################################################################
+#
+# type()
+#
+# Returns the type of cell such as Text, Numeric or Date.
+#
+sub type {
+
+ my $self = shift;
+
+ return $self->{Type};
+}
+
+###############################################################################
+#
+# encoding()
+#
+# Returns the character encoding of the cell.
+#
+sub encoding {
+
+ my $self = shift;
+
+ if ( !defined $self->{Code} ) {
+ return 1;
+ }
+ elsif ( $self->{Code} eq 'ucs2' ) {
+ return 2;
+ }
+ elsif ( $self->{Code} eq '_native_' ) {
+ return 3;
+ }
+ else {
+ return 0;
+ }
+
+ return $self->{Code};
+}
+
+###############################################################################
+#
+# is_merged()
+#
+# Returns true if the cell is merged.
+#
+sub is_merged {
+
+ my $self = shift;
+
+ return $self->{Merged};
+}
+
+###############################################################################
+#
+# get_rich_text()
+#
+# Returns an array ref of font information about each string block in a "rich",
+# i.e. multi-format, string.
+#
+sub get_rich_text {
+
+ my $self = shift;
+
+ return $self->{Rich};
+}
+
+###############################################################################
+#
+# Mapping between legacy method names and new names.
+#
+{
+ no warnings; # Ignore warnings about variables used only once.
+ *Value = *value;
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Spreadsheet::ParseExcel::Cell - A class for Cell data and formatting.
+
+=head1 SYNOPSIS
+
+See the documentation for Spreadsheet::ParseExcel.
+
+=head1 DESCRIPTION
+
+This module is used in conjunction with Spreadsheet::ParseExcel. See the documentation for Spreadsheet::ParseExcel.
+
+=head1 Methods
+
+The following Cell methods are available:
+
+ $cell->value()
+ $cell->unformatted()
+ $cell->get_format()
+ $cell->type()
+ $cell->encoding()
+ $cell->is_merged()
+ $cell->get_rich_text()
+
+
+=head2 value()
+
+The C<value()> method returns the formatted value of the cell.
+
+ my $value = $cell->value();
+
+Formatted in this sense refers to the numeric format of the cell value. For example a number such as 40177 might be formatted as 40,117, 40117.000 or even as the date 2009/12/30.
+
+If the cell doesn't contain a numeric format then the formatted and unformatted cell values are the same, see the C<unformatted()> method below.
+
+For a defined C<$cell> the C<value()> method will always return a value.
+
+In the case of a cell with formatting but no numeric or string contents the method will return the empty string C<''>.
+
+
+=head2 unformatted()
+
+The C<unformatted()> method returns the unformatted value of the cell.
+
+ my $unformatted = $cell->unformatted();
+
+Returns the cell value without a numeric format. See the C<value()> method above.
+
+
+=head2 get_format()
+
+The C<get_format()> method returns the L<Spreadsheet::ParseExcel::Format> object for the cell.
+
+ my $format = $cell->get_format();
+
+If a user defined format hasn't been applied to the cell then the default cell format is returned.
+
+
+=head2 type()
+
+The C<type()> method returns the type of cell such as Text, Numeric or Date. If the type was detected as Numeric, and the Cell Format matches C<m{^[dmy][-\\/dmy]*$}i>, it will be treated as a Date type.
+
+ my $type = $cell->type();
+
+See also L<Dates and Time in Excel>.
+
+
+=head2 encoding()
+
+The C<encoding()> method returns the character encoding of the cell.
+
+ my $encoding = $cell->encoding();
+
+This method is only of interest to developers. In general Spreadsheet::ParseExcel will return all character strings in UTF-8 regardless of the encoding used by Excel.
+
+The C<encoding()> method returns one of the following values:
+
+=over
+
+=item * 0: Unknown format. This shouldn't happen. In the default case the format should be 1.
+
+=item * 1: 8bit ASCII or single byte UTF-16. This indicates that the characters are encoded in a single byte. In Excel 95 and earlier This usually meant ASCII or an international variant. In Excel 97 it refers to a compressed UTF-16 character string where all of the high order bytes are 0 and are omitted to save space.
+
+=item * 2: UTF-16BE.
+
+=item * 3: Native encoding. In Excel 95 and earlier this encoding was used to represent multi-byte character encodings such as SJIS.
+
+=back
+
+
+=head2 is_merged()
+
+The C<is_merged()> method returns true if the cell is merged.
+
+ my $is_merged = $cell->is_merged();
+
+Returns C<undef> if the property isn't set.
+
+
+=head2 get_rich_text()
+
+The C<get_rich_text()> method returns an array ref of font information about each string block in a "rich", i.e. multi-format, string.
+
+ my $rich_text = $cell->get_rich_text();
+
+The return value is an arrayref of arrayrefs in the form:
+
+ [
+ [ $start_position, $font_object ],
+ ...,
+ ]
+
+Returns undef if the property isn't set.
+
+
+=head1 Dates and Time in Excel
+
+Dates and times in Excel are represented by real numbers, for example "Jan 1 2001 12:30 PM" is represented by the number 36892.521.
+
+The integer part of the number stores the number of days since the epoch and the fractional part stores the percentage of the day.
+
+A date or time in Excel is just like any other number. The way in which it is displayed is controlled by the number format:
+
+ Number format $cell->value() $cell->unformatted()
+ ============= ============== ==============
+ 'dd/mm/yy' '28/02/08' 39506.5
+ 'mm/dd/yy' '02/28/08' 39506.5
+ 'd-m-yyyy' '28-2-2008' 39506.5
+ 'dd/mm/yy hh:mm' '28/02/08 12:00' 39506.5
+ 'd mmm yyyy' '28 Feb 2008' 39506.5
+ 'mmm d yyyy hh:mm AM/PM' 'Feb 28 2008 12:00 PM' 39506.5
+
+
+The L<Spreadsheet::ParseExcel::Utility> module contains a function called C<ExcelLocaltime> which will convert between an unformatted Excel date/time number and a C<localtime()> like array.
+
+For date conversions using the CPAN C<DateTime> framework see L<DateTime::Format::Excel> http://search.cpan.org/search?dist=DateTime-Format-Excel
+
+
+=head1 AUTHOR
+
+Maintainer 0.40+: John McNamara jmcnamara@cpan.org
+
+Maintainer 0.27-0.33: Gabor Szabo szabgab@cpan.org
+
+Original author: Kawai Takanori kwitknr@cpan.org
+
+=head1 COPYRIGHT
+
+Copyright (c) 2009-2010 John McNamara
+
+Copyright (c) 2006-2008 Gabor Szabo
+
+Copyright (c) 2000-2006 Kawai Takanori
+
+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.
+
+=cut
diff --git a/src/bach/build.bach/tools/perl/Spreadsheet/ParseExcel/Dump.pm b/src/bach/build.bach/tools/perl/Spreadsheet/ParseExcel/Dump.pm
new file mode 100644
index 0000000..5586db2
--- /dev/null
+++ b/src/bach/build.bach/tools/perl/Spreadsheet/ParseExcel/Dump.pm
@@ -0,0 +1,355 @@
+package Spreadsheet::ParseExcel::Dump;
+
+###############################################################################
+#
+# Spreadsheet::ParseExcel::Dump - A class for dumping Excel records.
+#
+# Used in conjunction with Spreadsheet::ParseExcel.
+#
+# Copyright (c) 2009 John McNamara
+# Copyright (c) 2006-2008 Gabor Szabo
+# Copyright (c) 2000-2006 Kawai Takanori
+#
+# perltidy with standard settings.
+#
+# Documentation after __END__
+#
+
+use strict;
+use warnings;
+
+our $VERSION = '0.59';
+
+my %NameTbl = (
+
+ #P291
+ 0x0A => 'EOF',
+ 0x0C => 'CALCCOUNT',
+ 0x0D => 'CALCMODE',
+ 0x0E => 'PRECISION',
+ 0x0F => 'REFMODE',
+ 0x10 => 'DELTA',
+ 0x11 => 'ITERATION',
+ 0x12 => 'PROTECT',
+ 0x13 => 'PASSWORD',
+ 0x14 => 'HEADER',
+
+ 0x15 => 'FOOTER',
+ 0x16 => 'EXTERNCOUNT',
+ 0x17 => 'EXTERNSHEET',
+ 0x19 => 'WINDOWPROTECT',
+ 0x1A => 'VERTICALPAGEBREAKS',
+ 0x1B => 'HORIZONTALPAGEBREAKS',
+ 0x1C => 'NOTE',
+ 0x1D => 'SELECTION',
+ 0x22 => '1904',
+ 0x26 => 'LEFTMARGIN',
+
+ 0x27 => 'RIGHTMARGIN',
+ 0x28 => 'TOPMARGIN',
+ 0x29 => 'BOTTOMMARGIN',
+ 0x2A => 'PRINTHEADERS',
+ 0x2B => 'PRINTGRIDLINES',
+ 0x2F => 'FILEPASS',
+ 0x3C => 'COUNTINUE',
+ 0x3D => 'WINDOW1',
+ 0x40 => 'BACKUP',
+ 0x41 => 'PANE',
+
+ 0x42 => 'CODEPAGE',
+ 0x4D => 'PLS',
+ 0x50 => 'DCON',
+ 0x51 => 'DCONREF',
+
+ #P292
+ 0x52 => 'DCONNAME',
+ 0x55 => 'DEFCOLWIDTH',
+ 0x59 => 'XCT',
+ 0x5A => 'CRN',
+ 0x5B => 'FILESHARING',
+ 0x5C => 'WRITEACCES',
+ 0x5D => 'OBJ',
+ 0x5E => 'UNCALCED',
+ 0x5F => 'SAVERECALC',
+ 0x60 => 'TEMPLATE',
+
+ 0x63 => 'OBJPROTECT',
+ 0x7D => 'COLINFO',
+ 0x7E => 'RK',
+ 0x7F => 'IMDATA',
+ 0x80 => 'GUTS',
+ 0x81 => 'WSBOOL',
+ 0x82 => 'GRIDSET',
+ 0x83 => 'HCENTER',
+ 0x84 => 'VCENTER',
+ 0x85 => 'BOUNDSHEET',
+
+ 0x86 => 'WRITEPROT',
+ 0x87 => 'ADDIN',
+ 0x88 => 'EDG',
+ 0x89 => 'PUB',
+ 0x8C => 'COUNTRY',
+ 0x8D => 'HIDEOBJ',
+ 0x90 => 'SORT',
+ 0x91 => 'SUB',
+ 0x92 => 'PALETTE',
+ 0x94 => 'LHRECORD',
+
+ 0x95 => 'LHNGRAPH',
+ 0x96 => 'SOUND',
+ 0x98 => 'LPR',
+ 0x99 => 'STANDARDWIDTH',
+ 0x9A => 'FNGROUPNAME',
+ 0x9B => 'FILTERMODE',
+ 0x9C => 'FNGROUPCOUNT',
+
+ #P293
+ 0x9D => 'AUTOFILTERINFO',
+ 0x9E => 'AUTOFILTER',
+ 0xA0 => 'SCL',
+ 0xA1 => 'SETUP',
+ 0xA9 => 'COORDLIST',
+ 0xAB => 'GCW',
+ 0xAE => 'SCENMAN',
+ 0xAF => 'SCENARIO',
+ 0xB0 => 'SXVIEW',
+ 0xB1 => 'SXVD',
+
+ 0xB2 => 'SXV',
+ 0xB4 => 'SXIVD',
+ 0xB5 => 'SXLI',
+ 0xB6 => 'SXPI',
+ 0xB8 => 'DOCROUTE',
+ 0xB9 => 'RECIPNAME',
+ 0xBC => 'SHRFMLA',
+ 0xBD => 'MULRK',
+ 0xBE => 'MULBLANK',
+ 0xBF => 'TOOLBARHDR',
+ 0xC0 => 'TOOLBAREND',
+ 0xC1 => 'MMS',
+
+ 0xC2 => 'ADDMENU',
+ 0xC3 => 'DELMENU',
+ 0xC5 => 'SXDI',
+ 0xC6 => 'SXDB',
+ 0xCD => 'SXSTRING',
+ 0xD0 => 'SXTBL',
+ 0xD1 => 'SXTBRGIITM',
+ 0xD2 => 'SXTBPG',
+ 0xD3 => 'OBPROJ',
+ 0xD5 => 'SXISDTM',
+
+ 0xD6 => 'RSTRING',
+ 0xD7 => 'DBCELL',
+ 0xDA => 'BOOKBOOL',
+ 0xDC => 'PARAMQRY',
+ 0xDC => 'SXEXT',
+ 0xDD => 'SCENPROTECT',
+ 0xDE => 'OLESIZE',
+
+ #P294
+ 0xDF => 'UDDESC',
+ 0xE0 => 'XF',
+ 0xE1 => 'INTERFACEHDR',
+ 0xE2 => 'INTERFACEEND',
+ 0xE3 => 'SXVS',
+ 0xEA => 'TABIDCONF',
+ 0xEB => 'MSODRAWINGGROUP',
+ 0xEC => 'MSODRAWING',
+ 0xED => 'MSODRAWINGSELECTION',
+ 0xEF => 'PHONETICINFO',
+ 0xF0 => 'SXRULE',
+
+ 0xF1 => 'SXEXT',
+ 0xF2 => 'SXFILT',
+ 0xF6 => 'SXNAME',
+ 0xF7 => 'SXSELECT',
+ 0xF8 => 'SXPAIR',
+ 0xF9 => 'SXFMLA',
+ 0xFB => 'SXFORMAT',
+ 0xFC => 'SST',
+ 0xFD => 'LABELSST',
+ 0xFF => 'EXTSST',
+
+ 0x100 => 'SXVDEX',
+ 0x103 => 'SXFORMULA',
+ 0x122 => 'SXDBEX',
+ 0x13D => 'TABID',
+ 0x160 => 'USESELFS',
+ 0x161 => 'DSF',
+ 0x162 => 'XL5MODIFY',
+ 0x1A5 => 'FILESHARING2',
+ 0x1A9 => 'USERBVIEW',
+ 0x1AA => 'USERVIEWBEGIN',
+
+ 0x1AB => 'USERSVIEWEND',
+ 0x1AD => 'QSI',
+ 0x1AE => 'SUPBOOK',
+ 0x1AF => 'PROT4REV',
+ 0x1B0 => 'CONDFMT',
+ 0x1B1 => 'CF',
+ 0x1B2 => 'DVAL',
+
+ #P295
+ 0x1B5 => 'DCONBIN',
+ 0x1B6 => 'TXO',
+ 0x1B7 => 'REFRESHALL',
+ 0x1B8 => 'HLINK',
+ 0x1BA => 'CODENAME',
+ 0x1BB => 'SXFDBTYPE',
+ 0x1BC => 'PROT4REVPASS',
+ 0x1BE => 'DV',
+ 0x200 => 'DIMENSIONS',
+ 0x201 => 'BLANK',
+
+ 0x202 => 'Integer', #Not Documented
+ 0x203 => 'NUMBER',
+ 0x204 => 'LABEL',
+ 0x205 => 'BOOLERR',
+ 0x207 => 'STRING',
+ 0x208 => 'ROW',
+ 0x20B => 'INDEX',
+ 0x218 => 'NAME',
+ 0x221 => 'ARRAY',
+ 0x223 => 'EXTERNNAME',
+ 0x225 => 'DEFAULTROWHEIGHT',
+
+ 0x231 => 'FONT',
+ 0x236 => 'TABLE',
+ 0x23E => 'WINDOW2',
+ 0x293 => 'STYLE',
+ 0x406 => 'FORMULA',
+ 0x41E => 'FORMAT',
+
+ 0x18 => 'NAME',
+
+ 0x06 => 'FORMULA',
+
+ 0x09 => 'BOF(BIFF2)',
+ 0x209 => 'BOF(BIFF3)',
+ 0x409 => 'BOF(BIFF4)',
+ 0x809 => 'BOF(BIFF5-7)',
+
+ 0x31 => 'FONT', 0x27E => 'RK',
+
+ #Chart/Graph
+ 0x1001 => 'UNITS',
+ 0x1002 => 'CHART',
+ 0x1003 => 'SERISES',
+ 0x1006 => 'DATAFORMAT',
+ 0x1007 => 'LINEFORMAT',
+ 0x1009 => 'MAKERFORMAT',
+ 0x100A => 'AREAFORMAT',
+ 0x100B => 'PIEFORMAT',
+ 0x100C => 'ATTACHEDLABEL',
+ 0x100D => 'SERIESTEXT',
+ 0x1014 => 'CHARTFORMAT',
+ 0x1015 => 'LEGEND',
+ 0x1016 => 'SERIESLIST',
+ 0x1017 => 'BAR',
+ 0x1018 => 'LINE',
+ 0x1019 => 'PIE',
+ 0x101A => 'AREA',
+ 0x101B => 'SCATTER',
+ 0x101C => 'CHARTLINE',
+ 0x101D => 'AXIS',
+ 0x101E => 'TICK',
+ 0x101F => 'VALUERANGE',
+ 0x1020 => 'CATSERRANGE',
+ 0x1021 => 'AXISLINEFORMAT',
+ 0x1022 => 'CHARTFORMATLINK',
+ 0x1024 => 'DEFAULTTEXT',
+ 0x1025 => 'TEXT',
+ 0x1026 => 'FONTX',
+ 0x1027 => 'OBJECTLINK',
+ 0x1032 => 'FRAME',
+ 0x1033 => 'BEGIN',
+ 0x1034 => 'END',
+ 0x1035 => 'PLOTAREA',
+ 0x103A => '3D',
+ 0x103C => 'PICF',
+ 0x103D => 'DROPBAR',
+ 0x103E => 'RADAR',
+ 0x103F => 'SURFACE',
+ 0x1040 => 'RADARAREA',
+ 0x1041 => 'AXISPARENT',
+ 0x1043 => 'LEGENDXN',
+ 0x1044 => 'SHTPROPS',
+ 0x1045 => 'SERTOCRT',
+ 0x1046 => 'AXESUSED',
+ 0x1048 => 'SBASEREF',
+ 0x104A => 'SERPARENT',
+ 0x104B => 'SERAUXTREND',
+ 0x104E => 'IFMT',
+ 0x104F => 'POS',
+ 0x1050 => 'ALRUNS',
+ 0x1051 => 'AI',
+ 0x105B => 'SERAUXERRBAR',
+ 0x105D => 'SERFMT',
+ 0x1060 => 'FBI',
+ 0x1061 => 'BOPPOP',
+ 0x1062 => 'AXCEXT',
+ 0x1063 => 'DAT',
+ 0x1064 => 'PLOTGROWTH',
+ 0x1065 => 'SINDEX',
+ 0x1066 => 'GELFRAME',
+ 0x1067 => 'BPOPPOPCUSTOM',
+);
+
+#------------------------------------------------------------------------------
+# subDUMP (for Spreadsheet::ParseExcel)
+#------------------------------------------------------------------------------
+sub subDUMP {
+ my ( $oBook, $bOp, $bLen, $sWk ) = @_;
+ printf "%04X:%-23s (Len:%3d) : %s\n",
+ $bOp, OpName($bOp), $bLen, unpack( "H40", $sWk );
+}
+
+#------------------------------------------------------------------------------
+# Spreadsheet::ParseExcel->OpName
+#------------------------------------------------------------------------------
+sub OpName {
+ my ($bOp) = @_;
+ return ( defined $NameTbl{$bOp} ) ? $NameTbl{$bOp} : 'undef';
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Spreadsheet::ParseExcel::Dump - A class for dumping Excel records.
+
+=head1 SYNOPSIS
+
+See the documentation for Spreadsheet::ParseExcel.
+
+=head1 DESCRIPTION
+
+This module is used in conjunction with Spreadsheet::ParseExcel. See the documentation for Spreadsheet::ParseExcel.
+
+=head1 AUTHOR
+
+Maintainer 0.40+: John McNamara jmcnamara@cpan.org
+
+Maintainer 0.27-0.33: Gabor Szabo szabgab@cpan.org
+
+Original author: Kawai Takanori kwitknr@cpan.org
+
+=head1 COPYRIGHT
+
+Copyright (c) 2009-2010 John McNamara
+
+Copyright (c) 2006-2008 Gabor Szabo
+
+Copyright (c) 2000-2006 Kawai Takanori
+
+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.
+
+=cut
+
diff --git a/src/bach/build.bach/tools/perl/Spreadsheet/ParseExcel/FmtDefault.pm b/src/bach/build.bach/tools/perl/Spreadsheet/ParseExcel/FmtDefault.pm
new file mode 100644
index 0000000..416866f
--- /dev/null
+++ b/src/bach/build.bach/tools/perl/Spreadsheet/ParseExcel/FmtDefault.pm
@@ -0,0 +1,221 @@
+package Spreadsheet::ParseExcel::FmtDefault;
+
+###############################################################################
+#
+# Spreadsheet::ParseExcel::FmtDefault - A class for Cell formats.
+#
+# Used in conjunction with Spreadsheet::ParseExcel.
+#
+# Copyright (c) 2009 John McNamara
+# Copyright (c) 2006-2008 Gabor Szabo
+# Copyright (c) 2000-2006 Kawai Takanori
+#
+# perltidy with standard settings.
+#
+# Documentation after __END__
+#
+
+use strict;
+use warnings;
+
+use Spreadsheet::ParseExcel::Utility qw(ExcelFmt);
+our $VERSION = '0.59';
+
+my %hFmtDefault = (
+ 0x00 => '@',
+ 0x01 => '0',
+ 0x02 => '0.00',
+ 0x03 => '#,##0',
+ 0x04 => '#,##0.00',
+ 0x05 => '($#,##0_);($#,##0)',
+ 0x06 => '($#,##0_);[RED]($#,##0)',
+ 0x07 => '($#,##0.00_);($#,##0.00_)',
+ 0x08 => '($#,##0.00_);[RED]($#,##0.00_)',
+ 0x09 => '0%',
+ 0x0A => '0.00%',
+ 0x0B => '0.00E+00',
+ 0x0C => '# ?/?',
+ 0x0D => '# ??/??',
+ 0x0E => 'yyyy-mm-dd', # Was 'm-d-yy', which is bad as system default
+ 0x0F => 'd-mmm-yy',
+ 0x10 => 'd-mmm',
+ 0x11 => 'mmm-yy',
+ 0x12 => 'h:mm AM/PM',
+ 0x13 => 'h:mm:ss AM/PM',
+ 0x14 => 'h:mm',
+ 0x15 => 'h:mm:ss',
+ 0x16 => 'm-d-yy h:mm',
+
+ #0x17-0x24 -- Differs in Natinal
+ 0x25 => '(#,##0_);(#,##0)',
+ 0x26 => '(#,##0_);[RED](#,##0)',
+ 0x27 => '(#,##0.00);(#,##0.00)',
+ 0x28 => '(#,##0.00);[RED](#,##0.00)',
+ 0x29 => '_(*#,##0_);_(*(#,##0);_(*"-"_);_(@_)',
+ 0x2A => '_($*#,##0_);_($*(#,##0);_(*"-"_);_(@_)',
+ 0x2B => '_(*#,##0.00_);_(*(#,##0.00);_(*"-"??_);_(@_)',
+ 0x2C => '_($*#,##0.00_);_($*(#,##0.00);_(*"-"??_);_(@_)',
+ 0x2D => 'mm:ss',
+ 0x2E => '[h]:mm:ss',
+ 0x2F => 'mm:ss.0',
+ 0x30 => '##0.0E+0',
+ 0x31 => '@',
+);
+
+#------------------------------------------------------------------------------
+# new (for Spreadsheet::ParseExcel::FmtDefault)
+#------------------------------------------------------------------------------
+sub new {
+ my ( $sPkg, %hKey ) = @_;
+ my $oThis = {};
+ bless $oThis;
+ return $oThis;
+}
+
+#------------------------------------------------------------------------------
+# TextFmt (for Spreadsheet::ParseExcel::FmtDefault)
+#------------------------------------------------------------------------------
+sub TextFmt {
+ my ( $oThis, $sTxt, $sCode ) = @_;
+ return $sTxt if ( ( !defined($sCode) ) || ( $sCode eq '_native_' ) );
+ return pack( 'U*', unpack( 'n*', $sTxt ) );
+}
+
+#------------------------------------------------------------------------------
+# FmtStringDef (for Spreadsheet::ParseExcel::FmtDefault)
+#------------------------------------------------------------------------------
+sub FmtStringDef {
+ my ( $oThis, $iFmtIdx, $oBook, $rhFmt ) = @_;
+ my $sFmtStr = $oBook->{FormatStr}->{$iFmtIdx};
+
+ if ( !( defined($sFmtStr) ) && defined($rhFmt) ) {
+ $sFmtStr = $rhFmt->{$iFmtIdx};
+ }
+ $sFmtStr = $hFmtDefault{$iFmtIdx} unless ($sFmtStr);
+ return $sFmtStr;
+}
+
+#------------------------------------------------------------------------------
+# FmtString (for Spreadsheet::ParseExcel::FmtDefault)
+#------------------------------------------------------------------------------
+sub FmtString {
+ my ( $oThis, $oCell, $oBook ) = @_;
+
+ my $sFmtStr =
+ $oThis->FmtStringDef( $oBook->{Format}[ $oCell->{FormatNo} ]->{FmtIdx},
+ $oBook );
+
+ # Special case for cells that use Lotus123 style leading
+ # apostrophe to designate text formatting.
+ if ( $oBook->{Format}[ $oCell->{FormatNo} ]->{Key123} ) {
+ $sFmtStr = '@';
+ }
+
+ unless ( defined($sFmtStr) ) {
+ if ( $oCell->{Type} eq 'Numeric' ) {
+ if ( int( $oCell->{Val} ) != $oCell->{Val} ) {
+ $sFmtStr = '0.00';
+ }
+ else {
+ $sFmtStr = '0';
+ }
+ }
+ elsif ( $oCell->{Type} eq 'Date' ) {
+ if ( int( $oCell->{Val} ) <= 0 ) {
+ $sFmtStr = 'h:mm:ss';
+ }
+ else {
+ $sFmtStr = 'yyyy-mm-dd';
+ }
+ }
+ else {
+ $sFmtStr = '@';
+ }
+ }
+ return $sFmtStr;
+}
+
+#------------------------------------------------------------------------------
+# ValFmt (for Spreadsheet::ParseExcel::FmtDefault)
+#------------------------------------------------------------------------------
+sub ValFmt {
+ my ( $oThis, $oCell, $oBook ) = @_;
+
+ my ( $Dt, $iFmtIdx, $iNumeric, $Flg1904 );
+
+ if ( $oCell->{Type} eq 'Text' ) {
+ $Dt =
+ ( ( defined $oCell->{Val} ) && ( $oCell->{Val} ne '' ) )
+ ? $oThis->TextFmt( $oCell->{Val}, $oCell->{Code} )
+ : '';
+
+ return $Dt;
+ }
+ else {
+ $Dt = $oCell->{Val};
+ $Flg1904 = $oBook->{Flg1904};
+ my $sFmtStr = $oThis->FmtString( $oCell, $oBook );
+
+ return ExcelFmt( $sFmtStr, $Dt, $Flg1904, $oCell->{Type} );
+ }
+}
+
+#------------------------------------------------------------------------------
+# ChkType (for Spreadsheet::ParseExcel::FmtDefault)
+#------------------------------------------------------------------------------
+sub ChkType {
+ my ( $oPkg, $iNumeric, $iFmtIdx ) = @_;
+ if ($iNumeric) {
+ if ( ( ( $iFmtIdx >= 0x0E ) && ( $iFmtIdx <= 0x16 ) )
+ || ( ( $iFmtIdx >= 0x2D ) && ( $iFmtIdx <= 0x2F ) ) )
+ {
+ return "Date";
+ }
+ else {
+ return "Numeric";
+ }
+ }
+ else {
+ return "Text";
+ }
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Spreadsheet::ParseExcel::FmtDefault - A class for Cell formats.
+
+=head1 SYNOPSIS
+
+See the documentation for Spreadsheet::ParseExcel.
+
+=head1 DESCRIPTION
+
+This module is used in conjunction with Spreadsheet::ParseExcel. See the documentation for Spreadsheet::ParseExcel.
+
+=head1 AUTHOR
+
+Maintainer 0.40+: John McNamara jmcnamara@cpan.org
+
+Maintainer 0.27-0.33: Gabor Szabo szabgab@cpan.org
+
+Original author: Kawai Takanori kwitknr@cpan.org
+
+=head1 COPYRIGHT
+
+Copyright (c) 2009-2010 John McNamara
+
+Copyright (c) 2006-2008 Gabor Szabo
+
+Copyright (c) 2000-2006 Kawai Takanori
+
+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.
+
+=cut
diff --git a/src/bach/build.bach/tools/perl/Spreadsheet/ParseExcel/FmtJapan.pm b/src/bach/build.bach/tools/perl/Spreadsheet/ParseExcel/FmtJapan.pm
new file mode 100644
index 0000000..71f2b16
--- /dev/null
+++ b/src/bach/build.bach/tools/perl/Spreadsheet/ParseExcel/FmtJapan.pm
@@ -0,0 +1,210 @@
+package Spreadsheet::ParseExcel::FmtJapan;
+use utf8;
+
+###############################################################################
+#
+# Spreadsheet::ParseExcel::FmtJapan - A class for Cell formats.
+#
+# Used in conjunction with Spreadsheet::ParseExcel.
+#
+# Copyright (c) 2009 John McNamara
+# Copyright (c) 2006-2008 Gabor Szabo
+# Copyright (c) 2000-2006 Kawai Takanori
+#
+# perltidy with standard settings.
+#
+# Documentation after __END__
+#
+
+use strict;
+use warnings;
+
+use Encode qw(find_encoding decode);
+use base 'Spreadsheet::ParseExcel::FmtDefault';
+our $VERSION = '0.59';
+
+my %FormatTable = (
+ 0x00 => '@',
+ 0x01 => '0',
+ 0x02 => '0.00',
+ 0x03 => '#,##0',
+ 0x04 => '#,##0.00',
+ 0x05 => '(\\#,##0_);(\\#,##0)',
+ 0x06 => '(\\#,##0_);[RED](\\#,##0)',
+ 0x07 => '(\\#,##0.00_);(\\#,##0.00_)',
+ 0x08 => '(\\#,##0.00_);[RED](\\#,##0.00_)',
+ 0x09 => '0%',
+ 0x0A => '0.00%',
+ 0x0B => '0.00E+00',
+ 0x0C => '# ?/?',
+ 0x0D => '# ??/??',
+
+ # 0x0E => 'm/d/yy',
+ 0x0E => 'yyyy/m/d',
+ 0x0F => 'd-mmm-yy',
+ 0x10 => 'd-mmm',
+ 0x11 => 'mmm-yy',
+ 0x12 => 'h:mm AM/PM',
+ 0x13 => 'h:mm:ss AM/PM',
+ 0x14 => 'h:mm',
+ 0x15 => 'h:mm:ss',
+
+ # 0x16 => 'm/d/yy h:mm',
+ 0x16 => 'yyyy/m/d h:mm',
+
+ #0x17-0x24 -- Differs in Natinal
+ 0x1E => 'm/d/yy',
+ 0x1F => 'yyyy"年"m"月"d"日"',
+ 0x20 => 'h"時"mm"分"',
+ 0x21 => 'h"時"mm"分"ss"秒"',
+
+ #0x17-0x24 -- Differs in Natinal
+ 0x25 => '(#,##0_);(#,##0)',
+ 0x26 => '(#,##0_);[RED](#,##0)',
+ 0x27 => '(#,##0.00);(#,##0.00)',
+ 0x28 => '(#,##0.00);[RED](#,##0.00)',
+ 0x29 => '_(*#,##0_);_(*(#,##0);_(*"-"_);_(@_)',
+ 0x2A => '_(\\*#,##0_);_(\\*(#,##0);_(*"-"_);_(@_)',
+ 0x2B => '_(*#,##0.00_);_(*(#,##0.00);_(*"-"??_);_(@_)',
+ 0x2C => '_(\\*#,##0.00_);_(\\*(#,##0.00);_(*"-"??_);_(@_)',
+ 0x2D => 'mm:ss',
+ 0x2E => '[h]:mm:ss',
+ 0x2F => 'mm:ss.0',
+ 0x30 => '##0.0E+0',
+ 0x31 => '@',
+
+ 0x37 => 'yyyy"年"m"月"',
+ 0x38 => 'm"月"d"日"',
+ 0x39 => 'ge.m.d',
+ 0x3A => 'ggge"年"m"月"d"日"',
+);
+
+#------------------------------------------------------------------------------
+# new (for Spreadsheet::ParseExcel::FmtJapan)
+#------------------------------------------------------------------------------
+sub new {
+ my ( $class, %args ) = @_;
+ my $encoding = $args{Code} || $args{encoding};
+ my $self = { Code => $encoding };
+ if($encoding){
+ $self->{encoding} = find_encoding($encoding eq 'sjis' ? 'cp932' : $encoding)
+ or do{
+ require Carp;
+ Carp::croak(qq{Unknown encoding '$encoding'});
+ };
+ }
+ return bless $self, $class;
+}
+
+#------------------------------------------------------------------------------
+# TextFmt (for Spreadsheet::ParseExcel::FmtJapan)
+#------------------------------------------------------------------------------
+sub TextFmt {
+ my ( $self, $text, $input_encoding ) = @_;
+ if(!defined $input_encoding){
+ $input_encoding = 'utf8';
+ }
+ elsif($input_encoding eq '_native_'){
+ $input_encoding = 'cp932'; # Shift_JIS in Microsoft products
+ }
+ $text = decode($input_encoding, $text);
+ return $self->{Code} ? $self->{encoding}->encode($text) : $text;
+}
+#------------------------------------------------------------------------------
+# FmtStringDef (for Spreadsheet::ParseExcel::FmtJapan)
+#------------------------------------------------------------------------------
+sub FmtStringDef {
+ my ( $self, $format_index, $book ) = @_;
+ return $self->SUPER::FmtStringDef( $format_index, $book, \%FormatTable );
+}
+
+#------------------------------------------------------------------------------
+# CnvNengo (for Spreadsheet::ParseExcel::FmtJapan)
+#------------------------------------------------------------------------------
+
+# Convert A.D. into Japanese Nengo (aka Gengo)
+
+my @Nengo = (
+ {
+ name => '平成', # Heisei
+ abbr_name => 'H',
+
+ base => 1988,
+ start => 19890108,
+ },
+ {
+ name => '昭和', # Showa
+ abbr_name => 'S',
+
+ base => 1925,
+ start => 19261225,
+ },
+ {
+ name => '大正', # Taisho
+ abbr_name => 'T',
+
+ base => 1911,
+ start => 19120730,
+ },
+ {
+ name => '明治', # Meiji
+ abbr_name => 'M',
+
+ base => 1867,
+ start => 18680908,
+ },
+);
+
+# Usage: CnvNengo(name => @tm) or CnvNeng(abbr_name => @tm)
+sub CnvNengo {
+ my ( $kind, @tm ) = @_;
+ my $year = $tm[5] + 1900;
+ my $wk = ($year * 10000) + ($tm[4] * 100) + ($tm[3] * 1);
+ #my $wk = sprintf( '%04d%02d%02d', $year, $tm[4], $tm[3] );
+ foreach my $nengo(@Nengo){
+ if( $wk >= $nengo->{start} ){
+ return $nengo->{$kind} . ($year - $nengo->{base});
+ }
+ }
+ return $year;
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Spreadsheet::ParseExcel::FmtJapan - A class for Cell formats.
+
+=head1 SYNOPSIS
+
+See the documentation for Spreadsheet::ParseExcel.
+
+=head1 DESCRIPTION
+
+This module is used in conjunction with Spreadsheet::ParseExcel. See the documentation for Spreadsheet::ParseExcel.
+
+=head1 AUTHOR
+
+Maintainer 0.40+: John McNamara jmcnamara@cpan.org
+
+Maintainer 0.27-0.33: Gabor Szabo szabgab@cpan.org
+
+Original author: Kawai Takanori kwitknr@cpan.org
+
+=head1 COPYRIGHT
+
+Copyright (c) 2009-2010 John McNamara
+
+Copyright (c) 2006-2008 Gabor Szabo
+
+Copyright (c) 2000-2006 Kawai Takanori
+
+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.
+
+=cut
diff --git a/src/bach/build.bach/tools/perl/Spreadsheet/ParseExcel/FmtJapan2.pm b/src/bach/build.bach/tools/perl/Spreadsheet/ParseExcel/FmtJapan2.pm
new file mode 100644
index 0000000..318cb01
--- /dev/null
+++ b/src/bach/build.bach/tools/perl/Spreadsheet/ParseExcel/FmtJapan2.pm
@@ -0,0 +1,103 @@
+package Spreadsheet::ParseExcel::FmtJapan2;
+
+###############################################################################
+#
+# Spreadsheet::ParseExcel::FmtJapan2 - A class for Cell formats.
+#
+# Used in conjunction with Spreadsheet::ParseExcel.
+#
+# Copyright (c) 2009 John McNamara
+# Copyright (c) 2006-2008 Gabor Szabo
+# Copyright (c) 2000-2006 Kawai Takanori
+#
+# perltidy with standard settings.
+#
+# Documentation after __END__
+#
+
+use strict;
+use warnings;
+
+use Jcode;
+use Unicode::Map;
+use base 'Spreadsheet::ParseExcel::FmtJapan';
+our $VERSION = '0.59';
+
+#------------------------------------------------------------------------------
+# new (for Spreadsheet::ParseExcel::FmtJapan2)
+#------------------------------------------------------------------------------
+sub new {
+ my ( $sPkg, %hKey ) = @_;
+ my $oMap = Unicode::Map->new('CP932Excel');
+ die "NO MAP FILE CP932Excel!!"
+ unless ( -r Unicode::Map->mapping("CP932Excel") );
+
+ my $oThis = {
+ Code => $hKey{Code},
+ _UniMap => $oMap,
+ };
+ bless $oThis;
+ $oThis->SUPER::new(%hKey);
+ return $oThis;
+}
+
+#------------------------------------------------------------------------------
+# TextFmt (for Spreadsheet::ParseExcel::FmtJapan2)
+#------------------------------------------------------------------------------
+sub TextFmt {
+ my ( $oThis, $sTxt, $sCode ) = @_;
+
+ # $sCode = 'sjis' if((! defined($sCode)) || ($sCode eq '_native_'));
+ if ( $oThis->{Code} ) {
+ if ( !defined($sCode) ) {
+ $sTxt =~ s/(.)/\x00$1/sg;
+ $sTxt = $oThis->{_UniMap}->from_unicode($sTxt);
+ }
+ elsif ( $sCode eq 'ucs2' ) {
+ $sTxt = $oThis->{_UniMap}->from_unicode($sTxt);
+ }
+ return Jcode::convert( $sTxt, $oThis->{Code}, 'sjis' );
+ }
+ else {
+ return $sTxt;
+ }
+}
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Spreadsheet::ParseExcel::FmtJapan2 - A class for Cell formats.
+
+=head1 SYNOPSIS
+
+See the documentation for Spreadsheet::ParseExcel.
+
+=head1 DESCRIPTION
+
+This module is used in conjunction with Spreadsheet::ParseExcel. See the documentation for Spreadsheet::ParseExcel.
+
+=head1 AUTHOR
+
+Maintainer 0.40+: John McNamara jmcnamara@cpan.org
+
+Maintainer 0.27-0.33: Gabor Szabo szabgab@cpan.org
+
+Original author: Kawai Takanori kwitknr@cpan.org
+
+=head1 COPYRIGHT
+
+Copyright (c) 2009-2010 John McNamara
+
+Copyright (c) 2006-2008 Gabor Szabo
+
+Copyright (c) 2000-2006 Kawai Takanori
+
+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.
+
+=cut
diff --git a/src/bach/build.bach/tools/perl/Spreadsheet/ParseExcel/FmtUnicode.pm b/src/bach/build.bach/tools/perl/Spreadsheet/ParseExcel/FmtUnicode.pm
new file mode 100644
index 0000000..f0368bc
--- /dev/null
+++ b/src/bach/build.bach/tools/perl/Spreadsheet/ParseExcel/FmtUnicode.pm
@@ -0,0 +1,104 @@
+package Spreadsheet::ParseExcel::FmtUnicode;
+
+###############################################################################
+#
+# Spreadsheet::ParseExcel::FmtUnicode - A class for Cell formats.
+#
+# Used in conjunction with Spreadsheet::ParseExcel.
+#
+# Copyright (c) 2009 John McNamara
+# Copyright (c) 2006-2008 Gabor Szabo
+# Copyright (c) 2000-2006 Kawai Takanori
+#
+# perltidy with standard settings.
+#
+# Documentation after __END__
+#
+
+use strict;
+use warnings;
+
+use Unicode::Map;
+use base 'Spreadsheet::ParseExcel::FmtDefault';
+
+our $VERSION = '0.59';
+
+#------------------------------------------------------------------------------
+# new (for Spreadsheet::ParseExcel::FmtUnicode)
+#------------------------------------------------------------------------------
+sub new {
+ my ( $sPkg, %hKey ) = @_;
+ my $sMap = $hKey{Unicode_Map};
+ my $oMap;
+ $oMap = Unicode::Map->new($sMap) if $sMap;
+ my $oThis = {
+ Unicode_Map => $sMap,
+ _UniMap => $oMap,
+ };
+ bless $oThis;
+ return $oThis;
+}
+
+#------------------------------------------------------------------------------
+# TextFmt (for Spreadsheet::ParseExcel::FmtUnicode)
+#------------------------------------------------------------------------------
+sub TextFmt {
+ my ( $oThis, $sTxt, $sCode ) = @_;
+ if ( $oThis->{_UniMap} ) {
+ if ( !defined($sCode) ) {
+ my $sSv = $sTxt;
+ $sTxt =~ s/(.)/\x00$1/sg;
+ $sTxt = $oThis->{_UniMap}->from_unicode($sTxt);
+ $sTxt = $sSv unless ($sTxt);
+ }
+ elsif ( $sCode eq 'ucs2' ) {
+ $sTxt = $oThis->{_UniMap}->from_unicode($sTxt);
+ }
+
+ # $sTxt = $oThis->{_UniMap}->from_unicode($sTxt)
+ # if(defined($sCode) && $sCode eq 'ucs2');
+ return $sTxt;
+ }
+ else {
+ return $sTxt;
+ }
+}
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Spreadsheet::ParseExcel::FmtUnicode - A class for Cell formats.
+
+=head1 SYNOPSIS
+
+See the documentation for Spreadsheet::ParseExcel.
+
+=head1 DESCRIPTION
+
+This module is used in conjunction with Spreadsheet::ParseExcel. See the documentation for Spreadsheet::ParseExcel.
+
+=head1 AUTHOR
+
+Maintainer 0.40+: John McNamara jmcnamara@cpan.org
+
+Maintainer 0.27-0.33: Gabor Szabo szabgab@cpan.org
+
+Original author: Kawai Takanori kwitknr@cpan.org
+
+=head1 COPYRIGHT
+
+Copyright (c) 2009-2010 John McNamara
+
+Copyright (c) 2006-2008 Gabor Szabo
+
+Copyright (c) 2000-2006 Kawai Takanori
+
+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.
+
+=cut
diff --git a/src/bach/build.bach/tools/perl/Spreadsheet/ParseExcel/Font.pm b/src/bach/build.bach/tools/perl/Spreadsheet/ParseExcel/Font.pm
new file mode 100644
index 0000000..eb3b1fd
--- /dev/null
+++ b/src/bach/build.bach/tools/perl/Spreadsheet/ParseExcel/Font.pm
@@ -0,0 +1,69 @@
+package Spreadsheet::ParseExcel::Font;
+
+###############################################################################
+#
+# Spreadsheet::ParseExcel::Font - A class for Cell fonts.
+#
+# Used in conjunction with Spreadsheet::ParseExcel.
+#
+# Copyright (c) 2009 John McNamara
+# Copyright (c) 2006-2008 Gabor Szabo
+# Copyright (c) 2000-2006 Kawai Takanori
+#
+# perltidy with standard settings.
+#
+# Documentation after __END__
+#
+
+use strict;
+use warnings;
+
+our $VERSION = '0.59';
+
+sub new {
+ my ( $class, %rhIni ) = @_;
+ my $self = \%rhIni;
+
+ bless $self, $class;
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Spreadsheet::ParseExcel::Font - A class for Cell fonts.
+
+=head1 SYNOPSIS
+
+See the documentation for Spreadsheet::ParseExcel.
+
+=head1 DESCRIPTION
+
+This module is used in conjunction with Spreadsheet::ParseExcel. See the documentation for Spreadsheet::ParseExcel.
+
+=head1 AUTHOR
+
+Maintainer 0.40+: John McNamara jmcnamara@cpan.org
+
+Maintainer 0.27-0.33: Gabor Szabo szabgab@cpan.org
+
+Original author: Kawai Takanori kwitknr@cpan.org
+
+=head1 COPYRIGHT
+
+Copyright (c) 2009-2010 John McNamara
+
+Copyright (c) 2006-2008 Gabor Szabo
+
+Copyright (c) 2000-2006 Kawai Takanori
+
+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.
+
+=cut
+
diff --git a/src/bach/build.bach/tools/perl/Spreadsheet/ParseExcel/Format.pm b/src/bach/build.bach/tools/perl/Spreadsheet/ParseExcel/Format.pm
new file mode 100644
index 0000000..18b762f
--- /dev/null
+++ b/src/bach/build.bach/tools/perl/Spreadsheet/ParseExcel/Format.pm
@@ -0,0 +1,68 @@
+package Spreadsheet::ParseExcel::Format;
+
+###############################################################################
+#
+# Spreadsheet::ParseExcel::Format - A class for Cell formats.
+#
+# Used in conjunction with Spreadsheet::ParseExcel.
+#
+# Copyright (c) 2009 John McNamara
+# Copyright (c) 2006-2008 Gabor Szabo
+# Copyright (c) 2000-2006 Kawai Takanori
+#
+# perltidy with standard settings.
+#
+# Documentation after __END__
+#
+
+use strict;
+use warnings;
+
+our $VERSION = '0.59';
+
+sub new {
+ my ( $class, %rhIni ) = @_;
+ my $self = \%rhIni;
+
+ bless $self, $class;
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Spreadsheet::ParseExcel::Format - A class for Cell formats.
+
+=head1 SYNOPSIS
+
+See the documentation for Spreadsheet::ParseExcel.
+
+=head1 DESCRIPTION
+
+This module is used in conjunction with Spreadsheet::ParseExcel. See the documentation for Spreadsheet::ParseExcel.
+
+=head1 AUTHOR
+
+Maintainer 0.40+: John McNamara jmcnamara@cpan.org
+
+Maintainer 0.27-0.33: Gabor Szabo szabgab@cpan.org
+
+Original author: Kawai Takanori kwitknr@cpan.org
+
+=head1 COPYRIGHT
+
+Copyright (c) 2009-2010 John McNamara
+
+Copyright (c) 2006-2008 Gabor Szabo
+
+Copyright (c) 2000-2006 Kawai Takanori
+
+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.
+
+=cut
diff --git a/src/bach/build.bach/tools/perl/Spreadsheet/ParseExcel/SaveParser.pm b/src/bach/build.bach/tools/perl/Spreadsheet/ParseExcel/SaveParser.pm
new file mode 100644
index 0000000..3d2cf9c
--- /dev/null
+++ b/src/bach/build.bach/tools/perl/Spreadsheet/ParseExcel/SaveParser.pm
@@ -0,0 +1,310 @@
+package Spreadsheet::ParseExcel::SaveParser;
+
+###############################################################################
+#
+# Spreadsheet::ParseExcel::SaveParser - Rewrite an existing Excel file.
+#
+# Used in conjunction with Spreadsheet::ParseExcel.
+#
+# Copyright (c) 2009 John McNamara
+# Copyright (c) 2006-2008 Gabor Szabo
+# Copyright (c) 2000-2006 Kawai Takanori
+#
+# perltidy with standard settings.
+#
+# Documentation after __END__
+#
+
+use strict;
+use warnings;
+
+use Spreadsheet::ParseExcel;
+use Spreadsheet::ParseExcel::SaveParser::Workbook;
+use Spreadsheet::ParseExcel::SaveParser::Worksheet;
+use Spreadsheet::WriteExcel;
+use base 'Spreadsheet::ParseExcel';
+
+our $VERSION = '0.59';
+
+###############################################################################
+#
+# new()
+#
+sub new {
+
+ my ( $package, %params ) = @_;
+ $package->SUPER::new(%params);
+}
+
+###############################################################################
+#
+# Create()
+#
+sub Create {
+
+ my ( $self, $formatter ) = @_;
+
+ #0. New $workbook
+ my $workbook = Spreadsheet::ParseExcel::Workbook->new();
+ $workbook->{SheetCount} = 0;
+
+ # User specified formater class.
+ if ($formatter) {
+ $workbook->{FmtClass} = $formatter;
+ }
+ else {
+ $workbook->{FmtClass} = Spreadsheet::ParseExcel::FmtDefault->new();
+ }
+
+ return Spreadsheet::ParseExcel::SaveParser::Workbook->new($workbook);
+}
+
+###############################################################################
+#
+# Parse()
+#
+sub Parse {
+
+ my ( $self, $sFile, $formatter ) = @_;
+
+ my $workbook = $self->SUPER::Parse( $sFile, $formatter );
+
+ return undef unless defined $workbook;
+ return Spreadsheet::ParseExcel::SaveParser::Workbook->new($workbook);
+}
+
+###############################################################################
+#
+# SaveAs()
+#
+sub SaveAs {
+
+ my ( $self, $workbook, $filename ) = @_;
+
+ $workbook->SaveAs($filename);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Spreadsheet::ParseExcel::SaveParser - Rewrite an existing Excel file.
+
+=head1 SYNOPSIS
+
+
+
+Say we start with an Excel file that looks like this:
+
+ -----------------------------------------------------
+ | | A | B | C |
+ -----------------------------------------------------
+ | 1 | Hello | ... | ... | ...
+ | 2 | World | ... | ... | ...
+ | 3 | *Bold text* | ... | ... | ...
+ | 4 | ... | ... | ... | ...
+ | 5 | ... | ... | ... | ...
+
+
+Then we process it with the following program:
+
+ #!/usr/bin/perl
+
+ use strict;
+ use warnings;
+
+ use Spreadsheet::ParseExcel;
+ use Spreadsheet::ParseExcel::SaveParser;
+
+
+ # Open an existing file with SaveParser
+ my $parser = Spreadsheet::ParseExcel::SaveParser->new();
+ my $template = $parser->Parse('template.xls');
+
+
+ # Get the first worksheet.
+ my $worksheet = $template->worksheet(0);
+ my $row = 0;
+ my $col = 0;
+
+
+ # Overwrite the string in cell A1
+ $worksheet->AddCell( $row, $col, 'New string' );
+
+
+ # Add a new string in cell B1
+ $worksheet->AddCell( $row, $col + 1, 'Newer' );
+
+
+ # Add a new string in cell C1 with the format from cell A3.
+ my $cell = $worksheet->get_cell( $row + 2, $col );
+ my $format_number = $cell->{FormatNo};
+
+ $worksheet->AddCell( $row, $col + 2, 'Newest', $format_number );
+
+
+ # Write over the existing file or write a new file.
+ $template->SaveAs('newfile.xls');
+
+
+We should now have an Excel file that looks like this:
+
+ -----------------------------------------------------
+ | | A | B | C |
+ -----------------------------------------------------
+ | 1 | New string | Newer | *Newest* | ...
+ | 2 | World | ... | ... | ...
+ | 3 | *Bold text* | ... | ... | ...
+ | 4 | ... | ... | ... | ...
+ | 5 | ... | ... | ... | ...
+
+
+
+=head1 DESCRIPTION
+
+The C<Spreadsheet::ParseExcel::SaveParser> module rewrite an existing Excel file by reading it with C<Spreadsheet::ParseExcel> and rewriting it with C<Spreadsheet::WriteExcel>.
+
+=head1 METHODS
+
+=head1 Parser
+
+=head2 new()
+
+ $parse = new Spreadsheet::ParseExcel::SaveParser();
+
+Constructor.
+
+=head2 Parse()
+
+ $workbook = $parse->Parse($sFileName);
+
+ $workbook = $parse->Parse($sFileName , $formatter);
+
+Returns a L</Workbook> object. If an error occurs, returns undef.
+
+The optional C<$formatter> is a Formatter Class to format the value of cells.
+
+
+=head1 Workbook
+
+The C<Parse()> method returns a C<Spreadsheet::ParseExcel::SaveParser::Workbook> object.
+
+This is a subclass of the L<Spreadsheet::ParseExcel::Workbook> and has the following methods:
+
+=head2 worksheets()
+
+Returns an array of L</Worksheet> objects. This was most commonly used to iterate over the worksheets in a workbook:
+
+ for my $worksheet ( $workbook->worksheets() ) {
+ ...
+ }
+
+=head2 worksheet()
+
+The C<worksheet()> method returns a single C<Worksheet> object using either its name or index:
+
+ $worksheet = $workbook->worksheet('Sheet1');
+ $worksheet = $workbook->worksheet(0);
+
+Returns C<undef> if the sheet name or index doesn't exist.
+
+
+=head2 AddWorksheet()
+
+ $workbook = $workbook->AddWorksheet($name, %properties);
+
+Create a new Worksheet object of type C<Spreadsheet::ParseExcel::Worksheet>.
+
+The C<%properties> hash contains the properties of new Worksheet.
+
+
+=head2 AddFont
+
+ $workbook = $workbook->AddFont(%properties);
+
+Create new Font object of type C<Spreadsheet::ParseExcel::Font>.
+
+The C<%properties> hash contains the properties of new Font.
+
+
+=head2 AddFormat
+
+ $workbook = $workbook->AddFormat(%properties);
+
+The C<%properties> hash contains the properties of new Font.
+
+
+=head1 Worksheet
+
+Spreadsheet::ParseExcel::SaveParser::Worksheet
+
+Worksheet is a subclass of Spreadsheet::ParseExcel::Worksheet.
+And has these methods :
+
+
+The C<Worksbook::worksheet()> method returns a C<Spreadsheet::ParseExcel::SaveParser::Worksheet> object.
+
+This is a subclass of the L<Spreadsheet::ParseExcel::Worksheet> and has the following methods:
+
+
+=head1 AddCell
+
+ $workbook = $worksheet->AddCell($row, $col, $value, $format [$encoding]);
+
+Create new Cell object of type C<Spreadsheet::ParseExcel::Cell>.
+
+The C<$format> parameter is the format number rather than a full format object.
+
+To specify just same as another cell,
+you can set it like below:
+
+ $row = 0;
+ $col = 0;
+ $worksheet = $template->worksheet(0);
+ $cell = $worksheet->get_cell( $row, $col );
+ $format_number = $cell->{FormatNo};
+
+ $worksheet->AddCell($row +1, $coll, 'New data', $format_number);
+
+
+
+
+=head1 TODO
+
+Please note that this module is currently (versions 0.50-0.60) undergoing a major
+restructuring and rewriting.
+
+=head1 Known Problems
+
+
+You can only rewrite the features that Spreadsheet::WriteExcel supports so
+macros, graphs and some other features in the original Excel file will be lost.
+Also, formulas aren't rewritten, only the result of a formula is written.
+
+Only last print area will remain. (Others will be removed)
+
+
+=head1 AUTHOR
+
+Maintainer 0.40+: John McNamara jmcnamara@cpan.org
+
+Maintainer 0.27-0.33: Gabor Szabo szabgab@cpan.org
+
+Original author: Kawai Takanori kwitknr@cpan.org
+
+=head1 COPYRIGHT
+
+Copyright (c) 2009-2010 John McNamara
+
+Copyright (c) 2006-2008 Gabor Szabo
+
+Copyright (c) 2000-2002 Kawai Takanori and Nippon-RAD Co. OP Division
+
+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.
+
+
+=cut
diff --git a/src/bach/build.bach/tools/perl/Spreadsheet/ParseExcel/Utility.pm b/src/bach/build.bach/tools/perl/Spreadsheet/ParseExcel/Utility.pm
new file mode 100644
index 0000000..2eb09e7
--- /dev/null
+++ b/src/bach/build.bach/tools/perl/Spreadsheet/ParseExcel/Utility.pm
@@ -0,0 +1,1615 @@
+package Spreadsheet::ParseExcel::Utility;
+
+###############################################################################
+#
+# Spreadsheet::ParseExcel::Utility - Utility functions for ParseExcel.
+#
+# Used in conjunction with Spreadsheet::ParseExcel.
+#
+# Copyright (c) 2009 John McNamara
+# Copyright (c) 2006-2008 Gabor Szabo
+# Copyright (c) 2000-2006 Kawai Takanori
+#
+# perltidy with standard settings.
+#
+# Documentation after __END__
+#
+
+use strict;
+use warnings;
+
+require Exporter;
+use vars qw(@ISA @EXPORT_OK);
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(ExcelFmt LocaltimeExcel ExcelLocaltime
+ col2int int2col sheetRef xls2csv);
+
+our $VERSION = '0.59';
+
+my $qrNUMBER = qr/(^[+-]?\d+(\.\d+)?$)|(^[+-]?\d+\.?(\d*)[eE][+-](\d+))$/;
+
+###############################################################################
+#
+# ExcelFmt()
+#
+# This function takes an Excel style number format and converts a number into
+# that format. for example: 'hh:mm:ss AM/PM' + 0.01023148 = '12:14:44 AM'.
+#
+# It does this with a type of templating mechanism. The format string is parsed
+# to identify tokens that need to be replaced and their position within the
+# string is recorded. These can be thought of as placeholders. The number is
+# then converted to the required formats and substituted into the placeholders.
+#
+# Interested parties should refer to the Excel documentation on cell formats for
+# more information: http://office.microsoft.com/en-us/excel/HP051995001033.aspx
+# The Microsoft documentation for the Excel Binary File Format, [MS-XLS].pdf,
+# also contains a ABNF grammar for number format strings.
+#
+# Maintainers notes:
+# ==================
+#
+# Note on format subsections:
+# A format string can contain 4 possible sub-sections separated by semi-colons:
+# Positive numbers, negative numbers, zero values, and text.
+# For example: _(* #,##0_);_(* (#,##0);_(* "-"_);_(@_)
+#
+# Note on conditional formats.
+# A number format in Excel can have a conditional expression such as:
+# [>9999999](000)000-0000;000-0000
+# This is equivalent to the following in Perl:
+# $format = $number > 9999999 ? '(000)000-0000' : '000-0000';
+# Nested conditionals are also possible but we don't support them.
+#
+# Efficiency: The excessive use of substr() isn't very efficient. However,
+# it probably doesn't merit rewriting this function with a parser or regular
+# expressions and \G.
+#
+# TODO: I think the single quote handling may not be required. Check.
+#
+sub ExcelFmt {
+
+ my ( $format_str, $number, $is_1904, $number_type, $want_subformats ) = @_;
+
+ # Return text strings without further formatting.
+ return $number unless $number =~ $qrNUMBER;
+
+ # Handle OpenOffice.org GENERAL format.
+ $format_str = '@' if uc($format_str) eq "GENERAL";
+
+ # Check for a conditional at the start of the format. See notes above.
+ my $conditional;
+ if ( $format_str =~ /^\[([<>=][^\]]+)\](.*)$/ ) {
+ $conditional = $1;
+ $format_str = $2;
+ }
+
+ # Ignore the underscore token which is used to indicate a padding space.
+ $format_str =~ s/_/ /g;
+
+ # Split the format string into 4 possible sub-sections: positive numbers,
+ # negative numbers, zero values, and text. See notes above.
+ my @formats;
+ my $section = 0;
+ my $double_quote = 0;
+ my $single_quote = 0;
+
+ # Initial parsing of the format string to remove escape characters. This
+ # also handles quoted strings. See note about single quotes above.
+ CHARACTER:
+ for my $char ( split //, $format_str ) {
+
+ if ( $double_quote or $single_quote ) {
+ $formats[$section] .= $char;
+ $double_quote = 0 if $char eq '"';
+ $single_quote = 0;
+ next CHARACTER;
+ }
+
+ if ( $char eq ';' ) {
+ $section++;
+ next CHARACTER;
+ }
+ elsif ( $char eq '"' ) {
+ $double_quote = 1;
+ }
+ elsif ( $char eq '!' ) {
+ $single_quote = 1;
+ }
+ elsif ( $char eq '\\' ) {
+ $single_quote = 1;
+ }
+ elsif ( $char eq '(' ) {
+ next CHARACTER; # Ignore.
+ }
+ elsif ( $char eq ')' ) {
+ next CHARACTER; # Ignore.
+ }
+
+ # Convert upper case OpenOffice.org date/time formats to lowercase..
+ $char = lc($char) if $char =~ /[DMYHS]/;
+
+ $formats[$section] .= $char;
+ }
+
+ # Select the appropriate format from the 4 possible sub-sections:
+ # positive numbers, negative numbers, zero values, and text.
+ # We ignore the Text section since non-numeric values are returned
+ # unformatted at the start of the function.
+ my $format;
+ $section = 0;
+
+ if ( @formats == 1 ) {
+ $section = 0;
+ }
+ elsif ( @formats == 2 ) {
+ if ( $number < 0 ) {
+ $section = 1;
+ }
+ else {
+ $section = 0;
+ }
+ }
+ elsif ( @formats == 3 ) {
+ if ( $number == 0 ) {
+ $section = 2;
+ }
+ elsif ( $number < 0 ) {
+ $section = 1;
+ }
+ else {
+ $section = 0;
+ }
+ }
+ else {
+ $section = 0;
+ }
+
+ # Override the previous choice if the format is conditional.
+ if ($conditional) {
+
+ # TODO. Replace string eval with a function.
+ $section = eval "$number $conditional" ? 0 : 1;
+ }
+
+ # We now have the required format.
+ $format = $formats[$section];
+
+ # The format string can contain one of the following colours:
+ # [Black] [Blue] [Cyan] [Green] [Magenta] [Red] [White] [Yellow]
+ # or the string [ColorX] where x is a colour index from 1 to 56.
+ # We don't use the colour but we return it to the caller.
+ #
+ my $color = '';
+ if ( $format =~ s/^(\[[A-Z][a-z]{2,}(\d{1,2})?\])// ) {
+ $color = $1;
+ }
+
+ # Remove the locale, such as [$-409], from the format string.
+ my $locale = '';
+ if ( $format =~ s/^(\[\$?-\d+\])// ) {
+ $locale = $1;
+ }
+
+ # Replace currency locale, such as [$$-409], with $ in the format string.
+ # See the RT#60547 test cases in 21_number_format_user.t.
+ if ( $format =~ s/(\[\$([^-]+)(-\d+)?\])/$2/s ) {
+ $locale = $1;
+ }
+
+
+ # Remove leading # from '# ?/?', '# ??/??' fraction formats.
+ $format =~ s{# \?}{?}g;
+
+ # Parse the format string and create an AoA of placeholders that contain
+ # the parts of the string to be replaced. The format of the information
+ # stored is: [ $token, $start_pos, $end_pos, $option_info ].
+ #
+ my $format_mode = ''; # Either: '', 'number', 'date'
+ my $pos = 0; # Character position within format string.
+ my @placeholders = (); # Arefs with parts of the format to be replaced.
+ my $token = ''; # The actual format extracted from the total str.
+ my $start_pos; # A position variable. Initial parser position.
+ my $token_start = -1; # A position variable.
+ my $decimal_pos = -1; # Position of the punctuation char "." or ",".
+ my $comma_count = 0; # Count of the commas in the format.
+ my $is_fraction = 0; # Number format is a fraction.
+ my $is_currency = 0; # Number format is a currency.
+ my $is_percent = 0; # Number format is a percentage.
+ my $is_12_hour = 0; # Time format is using 12 hour clock.
+ my $seen_dot = 0; # Treat only the first "." as the decimal point.
+
+ # Parse the format.
+ PARSER:
+ while ( $pos < length $format ) {
+ $start_pos = $pos;
+ my $char = substr( $format, $pos, 1 );
+
+ # Ignore control format characters such as '#0+-.?eE,%'. However,
+ # only ignore '.' if it is the first one encountered. RT 45502.
+ if ( ( !$seen_dot && $char !~ /[#0\+\-\.\?eE\,\%]/ )
+ || $char !~ /[#0\+\-\?eE\,\%]/ )
+ {
+
+ if ( $token_start != -1 ) {
+ push @placeholders,
+ [
+ substr( $format, $token_start, $pos - $token_start ),
+ $decimal_pos, $pos - $token_start
+ ];
+ $token_start = -1;
+ }
+ }
+
+ # Processing for quoted strings within the format. See notes above.
+ if ( $char eq '"' ) {
+ $double_quote = $double_quote ? 0 : 1;
+ $pos++;
+ next PARSER;
+ }
+ elsif ( $char eq '!' ) {
+ $single_quote = 1;
+ $pos++;
+ next PARSER;
+ }
+ elsif ( $char eq '\\' ) {
+ if ( $single_quote != 1 ) {
+ $single_quote = 1;
+ $pos++;
+ next PARSER;
+ }
+ }
+
+ if ( ( defined($double_quote) and ($double_quote) )
+ or ( defined($single_quote) and ($single_quote) )
+ or ( $seen_dot && $char eq '.' ) )
+ {
+ $single_quote = 0;
+ if (
+ ( $format_mode ne 'date' )
+ and ( ( substr( $format, $pos, 2 ) eq "\x81\xA2" )
+ || ( substr( $format, $pos, 2 ) eq "\x81\xA3" )
+ || ( substr( $format, $pos, 2 ) eq "\xA2\xA4" )
+ || ( substr( $format, $pos, 2 ) eq "\xA2\xA5" ) )
+ )
+ {
+
+ # The above matches are currency symbols.
+ push @placeholders,
+ [ substr( $format, $pos, 2 ), length($token), 2 ];
+ $is_currency = 1;
+ $pos += 2;
+ }
+ else {
+ $pos++;
+ }
+ }
+ elsif (
+ ( $char =~ /[#0\+\.\?eE\,\%]/ )
+ || ( ( $format_mode ne 'date' )
+ and ( ( $char eq '-' ) || ( $char eq '(' ) || ( $char eq ')' ) )
+ )
+ )
+ {
+ $format_mode = 'number' unless $format_mode;
+ if ( substr( $format, $pos, 1 ) =~ /[#0]/ ) {
+ if (
+ substr( $format, $pos ) =~
+ /^([#0]+[\.]?[0#]*[eE][\+\-][0#]+)/ )
+ {
+ push @placeholders, [ $1, $pos, length($1) ];
+ $pos += length($1);
+ }
+ else {
+ if ( $token_start == -1 ) {
+ $token_start = $pos;
+ $decimal_pos = length($token);
+ }
+ }
+ }
+ elsif ( substr( $format, $pos, 1 ) eq '?' ) {
+
+ # Look for a fraction format like ?/? or ??/??
+ if ( $token_start != -1 ) {
+ push @placeholders,
+ [
+ substr(
+ $format, $token_start, $pos - $token_start + 1
+ ),
+ $decimal_pos,
+ $pos - $token_start + 1
+ ];
+ }
+ $token_start = $pos;
+
+ # Find the end of the fraction format.
+ FRACTION:
+ while ( $pos < length($format) ) {
+ if ( substr( $format, $pos, 1 ) eq '/' ) {
+ $is_fraction = 1;
+ }
+ elsif ( substr( $format, $pos, 1 ) eq '?' ) {
+ $pos++;
+ next FRACTION;
+ }
+ else {
+ if ( $is_fraction
+ && ( substr( $format, $pos, 1 ) =~ /[0-9]/ ) )
+ {
+
+ # TODO: Could invert if() logic and remove this.
+ $pos++;
+ next FRACTION;
+ }
+ else {
+ last FRACTION;
+ }
+ }
+ $pos++;
+ }
+ $pos--;
+
+ push @placeholders,
+ [
+ substr( $format, $token_start, $pos - $token_start + 1 ),
+ length($token), $pos - $token_start + 1
+ ];
+ $token_start = -1;
+ }
+ elsif ( substr( $format, $pos, 3 ) =~ /^[eE][\+\-][0#]$/ ) {
+ if ( substr( $format, $pos ) =~ /([eE][\+\-][0#]+)/ ) {
+ push @placeholders, [ $1, $pos, length($1) ];
+ $pos += length($1);
+ }
+ $token_start = -1;
+ }
+ else {
+ if ( $token_start != -1 ) {
+ push @placeholders,
+ [
+ substr( $format, $token_start, $pos - $token_start ),
+ $decimal_pos, $pos - $token_start
+ ];
+ $token_start = -1;
+ }
+ if ( substr( $format, $pos, 1 ) =~ /[\+\-]/ ) {
+ push @placeholders,
+ [ substr( $format, $pos, 1 ), length($token), 1 ];
+ $is_currency = 1;
+ }
+ elsif ( substr( $format, $pos, 1 ) eq '.' ) {
+ push @placeholders,
+ [ substr( $format, $pos, 1 ), length($token), 1 ];
+ $seen_dot = 1;
+ }
+ elsif ( substr( $format, $pos, 1 ) eq ',' ) {
+ $comma_count++;
+ push @placeholders,
+ [ substr( $format, $pos, 1 ), length($token), 1 ];
+ }
+ elsif ( substr( $format, $pos, 1 ) eq '%' ) {
+ $is_percent = 1;
+ }
+ elsif (( substr( $format, $pos, 1 ) eq '(' )
+ || ( substr( $format, $pos, 1 ) eq ')' ) )
+ {
+ push @placeholders,
+ [ substr( $format, $pos, 1 ), length($token), 1 ];
+ $is_currency = 1;
+ }
+ }
+ $pos++;
+ }
+ elsif ( $char =~ /[ymdhsapg]/i ) {
+ $format_mode = 'date' unless $format_mode;
+ if ( substr( $format, $pos, 5 ) =~ /am\/pm/i ) {
+ push @placeholders, [ 'am/pm', length($token), 5 ];
+ $is_12_hour = 1;
+ $pos += 5;
+ }
+ elsif ( substr( $format, $pos, 3 ) =~ /a\/p/i ) {
+ push @placeholders, [ 'a/p', length($token), 3 ];
+ $is_12_hour = 1;
+ $pos += 3;
+ }
+ elsif ( substr( $format, $pos, 5 ) eq 'mmmmm' ) {
+ push @placeholders, [ 'mmmmm', length($token), 5 ];
+ $pos += 5;
+ }
+ elsif (( substr( $format, $pos, 4 ) eq 'mmmm' )
+ || ( substr( $format, $pos, 4 ) eq 'dddd' )
+ || ( substr( $format, $pos, 4 ) eq 'yyyy' )
+ || ( substr( $format, $pos, 4 ) eq 'ggge' ) )
+ {
+ push @placeholders,
+ [ substr( $format, $pos, 4 ), length($token), 4 ];
+ $pos += 4;
+ }
+ elsif (( substr( $format, $pos, 3 ) eq 'ddd' )
+ || ( substr( $format, $pos, 3 ) eq 'mmm' )
+ || ( substr( $format, $pos, 3 ) eq 'yyy' ) )
+ {
+ push @placeholders,
+ [ substr( $format, $pos, 3 ), length($token), 3 ];
+ $pos += 3;
+ }
+ elsif (( substr( $format, $pos, 2 ) eq 'yy' )
+ || ( substr( $format, $pos, 2 ) eq 'mm' )
+ || ( substr( $format, $pos, 2 ) eq 'dd' )
+ || ( substr( $format, $pos, 2 ) eq 'hh' )
+ || ( substr( $format, $pos, 2 ) eq 'ss' )
+ || ( substr( $format, $pos, 2 ) eq 'ge' ) )
+ {
+ if (
+ ( substr( $format, $pos, 2 ) eq 'mm' )
+ && (@placeholders)
+ && ( ( $placeholders[-1]->[0] eq 'h' )
+ or ( $placeholders[-1]->[0] eq 'hh' ) )
+ )
+ {
+
+ # For this case 'm' is minutes not months.
+ push @placeholders, [ 'mm', length($token), 2, 'minutes' ];
+ }
+ else {
+ push @placeholders,
+ [ substr( $format, $pos, 2 ), length($token), 2 ];
+ }
+ if ( ( substr( $format, $pos, 2 ) eq 'ss' )
+ && ( @placeholders > 1 ) )
+ {
+ if ( ( $placeholders[-2]->[0] eq 'm' )
+ || ( $placeholders[-2]->[0] eq 'mm' ) )
+ {
+
+ # For this case 'm' is minutes not months.
+ push( @{ $placeholders[-2] }, 'minutes' );
+ }
+ }
+ $pos += 2;
+ }
+ elsif (( substr( $format, $pos, 1 ) eq 'm' )
+ || ( substr( $format, $pos, 1 ) eq 'd' )
+ || ( substr( $format, $pos, 1 ) eq 'h' )
+ || ( substr( $format, $pos, 1 ) eq 's' ) )
+ {
+ if (
+ ( substr( $format, $pos, 1 ) eq 'm' )
+ && (@placeholders)
+ && ( ( $placeholders[-1]->[0] eq 'h' )
+ or ( $placeholders[-1]->[0] eq 'hh' ) )
+ )
+ {
+
+ # For this case 'm' is minutes not months.
+ push @placeholders, [ 'm', length($token), 1, 'minutes' ];
+ }
+ else {
+ push @placeholders,
+ [ substr( $format, $pos, 1 ), length($token), 1 ];
+ }
+ if ( ( substr( $format, $pos, 1 ) eq 's' )
+ && ( @placeholders > 1 ) )
+ {
+ if ( ( $placeholders[-2]->[0] eq 'm' )
+ || ( $placeholders[-2]->[0] eq 'mm' ) )
+ {
+
+ # For this case 'm' is minutes not months.
+ push( @{ $placeholders[-2] }, 'minutes' );
+ }
+ }
+ $pos += 1;
+ }
+ }
+ elsif ( ( substr( $format, $pos, 3 ) eq '[h]' ) ) {
+ $format_mode = 'date' unless $format_mode;
+ push @placeholders, [ '[h]', length($token), 3 ];
+ $pos += 3;
+ }
+ elsif ( ( substr( $format, $pos, 4 ) eq '[mm]' ) ) {
+ $format_mode = 'date' unless $format_mode;
+ push @placeholders, [ '[mm]', length($token), 4 ];
+ $pos += 4;
+ }
+ elsif ( $char eq '@' ) {
+ push @placeholders, [ '@', length($token), 1 ];
+ $pos++;
+ }
+ elsif ( $char eq '*' ) {
+ push @placeholders,
+ [ substr( $format, $pos, 1 ), length($token), 1 ];
+ }
+ else {
+ $pos++;
+ }
+ $pos++ if ( $pos == $start_pos ); #No Format match
+ $token .= substr( $format, $start_pos, $pos - $start_pos );
+
+ } # End of parsing.
+
+ # Copy the located format string to a result string that we will perform
+ # the substitutions on and return to the user.
+ my $result = $token;
+
+ # Add a placeholder between the decimal/comma and end of the token, if any.
+ if ( $token_start != -1 ) {
+ push @placeholders,
+ [
+ substr( $format, $token_start, $pos - $token_start + 1 ),
+ $decimal_pos, $pos - $token_start + 1
+ ];
+ }
+
+ #
+ # In the next sections we process date, number and text formats. We take a
+ # format such as yyyy/mm/dd and replace it with something like 2008/12/25.
+ #
+ if ( ( $format_mode eq 'date' ) && ( $number =~ $qrNUMBER ) ) {
+
+ # The maximum allowable date in Excel is 9999-12-31T23:59:59.000 which
+ # equates to 2958465.999+ in the 1900 epoch and 2957003.999+ in the
+ # 1904 epoch. We use 0 as the minimum in both epochs. The 1904 system
+ # actually supports negative numbers but that isn't worth the effort.
+ my $min_date = 0;
+ my $max_date = 2958466;
+ $max_date = 2957004 if $is_1904;
+
+ if ( $number < $min_date || $number >= $max_date ) {
+ return $number; # Return unformatted number.
+ }
+
+ # Process date formats.
+ my @time = ExcelLocaltime( $number, $is_1904 );
+
+ # 0 1 2 3 4 5 6 7
+ my ( $sec, $min, $hour, $day, $month, $year, $wday, $msec ) = @time;
+
+ $month++; # localtime() zero indexed month.
+ $year += 1900; # localtime() year.
+
+ my @full_month_name = qw(
+ None January February March April May June July
+ August September October November December
+ );
+ my @short_month_name = qw(
+ None Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
+ );
+ my @full_day_name = qw(
+ Sunday Monday Tuesday Wednesday Thursday Friday Saturday
+ );
+ my @short_day_name = qw(
+ Sun Mon Tue Wed Thu Fri Sat
+ );
+
+ # Replace the placeholders in the template such as yyyy mm dd with
+ # actual numbers or strings.
+ my $replacement;
+ for ( my $i = @placeholders - 1 ; $i >= 0 ; $i-- ) {
+ my $placeholder = $placeholders[$i];
+
+ if ( $placeholder->[-1] eq 'minutes' ) {
+
+ # For this case 'm/mm' is minutes not months.
+ if ( $placeholder->[0] eq 'mm' ) {
+ $replacement = sprintf( "%02d", $min );
+ }
+ else {
+ $replacement = sprintf( "%d", $min );
+ }
+ }
+ elsif ( $placeholder->[0] eq 'yyyy' ) {
+
+ # 4 digit Year. 2000 -> 2000.
+ $replacement = sprintf( '%04d', $year );
+ }
+ elsif ( $placeholder->[0] eq 'yy' ) {
+
+ # 2 digit Year. 2000 -> 00.
+ $replacement = sprintf( '%02d', $year % 100 );
+ }
+ elsif ( $placeholder->[0] eq 'mmmmm' ) {
+
+ # First character of the month name. 1 -> J.
+ $replacement = substr( $short_month_name[$month], 0, 1 );
+ }
+ elsif ( $placeholder->[0] eq 'mmmm' ) {
+
+ # Full month name. 1 -> January.
+ $replacement = $full_month_name[$month];
+ }
+ elsif ( $placeholder->[0] eq 'mmm' ) {
+
+ # Short month name. 1 -> Jan.
+ $replacement = $short_month_name[$month];
+ }
+ elsif ( $placeholder->[0] eq 'mm' ) {
+
+ # 2 digit month. 1 -> 01.
+ $replacement = sprintf( '%02d', $month );
+ }
+ elsif ( $placeholder->[0] eq 'm' ) {
+
+ # 1 digit month. 1 -> 1.
+ $replacement = sprintf( '%d', $month );
+ }
+ elsif ( $placeholder->[0] eq 'dddd' ) {
+
+ # Full day name. Wednesday (for example.)
+ $replacement = $full_day_name[$wday];
+ }
+ elsif ( $placeholder->[0] eq 'ddd' ) {
+
+ # Short day name. Wed (for example.)
+ $replacement = $short_day_name[$wday];
+ }
+ elsif ( $placeholder->[0] eq 'dd' ) {
+
+ # 2 digit day. 1 -> 01.
+ $replacement = sprintf( '%02d', $day );
+ }
+ elsif ( $placeholder->[0] eq 'd' ) {
+
+ # 1 digit day. 1 -> 1.
+ $replacement = sprintf( '%d', $day );
+ }
+ elsif ( $placeholder->[0] eq 'hh' ) {
+
+ # 2 digit hour.
+ if ($is_12_hour) {
+ my $hour_tmp = $hour % 12;
+ $hour_tmp = 12 if $hour % 12 == 0;
+ $replacement = sprintf( '%d', $hour_tmp );
+ }
+ else {
+ $replacement = sprintf( '%02d', $hour );
+ }
+ }
+ elsif ( $placeholder->[0] eq 'h' ) {
+
+ # 1 digit hour.
+ if ($is_12_hour) {
+ my $hour_tmp = $hour % 12;
+ $hour_tmp = 12 if $hour % 12 == 0;
+ $replacement = sprintf( '%2d', $hour_tmp );
+ }
+ else {
+ $replacement = sprintf( '%d', $hour );
+ }
+ }
+ elsif ( $placeholder->[0] eq 'ss' ) {
+
+ # 2 digit seconds.
+ $replacement = sprintf( '%02d', $sec );
+ }
+ elsif ( $placeholder->[0] eq 's' ) {
+
+ # 1 digit seconds.
+ $replacement = sprintf( '%d', $sec );
+ }
+ elsif ( $placeholder->[0] eq 'am/pm' ) {
+
+ # AM/PM.
+ $replacement = ( $hour >= 12 ) ? 'PM' : 'AM';
+ }
+ elsif ( $placeholder->[0] eq 'a/p' ) {
+
+ # AM/PM.
+ $replacement = ( $hour >= 12 ) ? 'P' : 'A';
+ }
+ elsif ( $placeholder->[0] eq '.' ) {
+
+ # Decimal point for seconds.
+ $replacement = '.';
+ }
+ elsif ( $placeholder->[0] =~ /(^0+$)/ ) {
+
+ # Milliseconds. For example h:ss.000.
+ my $length = length($1);
+ $replacement =
+ substr( sprintf( "%.${length}f", $msec / 1000 ), 2, $length );
+ }
+ elsif ( $placeholder->[0] eq '[h]' ) {
+
+ # Hours modulus 24. 25 displays as 25 not as 1.
+ $replacement = sprintf( '%d', int($number) * 24 + $hour );
+ }
+ elsif ( $placeholder->[0] eq '[mm]' ) {
+
+ # Mins modulus 60. 72 displays as 72 not as 12.
+ $replacement =
+ sprintf( '%d', ( int($number) * 24 + $hour ) * 60 + $min );
+ }
+ elsif ( $placeholder->[0] eq 'ge' ) {
+ require Spreadsheet::ParseExcel::FmtJapan;
+ # Japanese Nengo (aka Gengo) in initialism (abbr. name)
+ $replacement =
+ Spreadsheet::ParseExcel::FmtJapan::CnvNengo( abbr_name => @time );
+ }
+ elsif ( $placeholder->[0] eq 'ggge' ) {
+ require Spreadsheet::ParseExcel::FmtJapan;
+ # Japanese Nengo (aka Gengo) in Kanji (full name)
+ $replacement =
+ Spreadsheet::ParseExcel::FmtJapan::CnvNengo( name => @time );
+ }
+ elsif ( $placeholder->[0] eq '@' ) {
+
+ # Text format.
+ $replacement = $number;
+ }
+
+ # Substitute the replacement string back into the template.
+ substr( $result, $placeholder->[1], $placeholder->[2],
+ $replacement );
+ }
+ }
+ elsif ( ( $format_mode eq 'number' ) && ( $number =~ $qrNUMBER ) ) {
+
+ # Process non date formats.
+ if (@placeholders) {
+ while ( $placeholders[-1]->[0] eq ',' ) {
+ $comma_count--;
+ substr(
+ $result,
+ $placeholders[-1]->[1],
+ $placeholders[-1]->[2], ''
+ );
+ $number /= 1000;
+ pop @placeholders;
+ }
+
+ my $number_format = join( '', map { $_->[0] } @placeholders );
+ my $number_result;
+ my $str_length = 0;
+ my $engineering = 0;
+ my $is_decimal = 0;
+ my $is_integer = 0;
+ my $after_decimal = undef;
+
+ for my $token ( split //, $number_format ) {
+ if ( $token eq '.' ) {
+ $str_length++;
+ $is_decimal = 1;
+ }
+ elsif ( ( $token eq 'E' ) || ( $token eq 'e' ) ) {
+ $engineering = 1;
+ }
+ elsif ( $token eq '0' ) {
+ $str_length++;
+ $after_decimal++ if $is_decimal;
+ $is_integer = 1;
+ }
+ elsif ( $token eq '#' ) {
+ $after_decimal++ if $is_decimal;
+ $is_integer = 1;
+ }
+ elsif ( $token eq '?' ) {
+ $after_decimal++ if $is_decimal;
+ }
+ }
+
+ $number *= 100.0 if $is_percent;
+
+ my $data = ($is_currency) ? abs($number) : $number + 0;
+
+ if ($is_fraction) {
+ $number_result = sprintf( "%0${str_length}d", int($data) );
+ }
+ else {
+ if ($is_decimal) {
+
+ if ( defined $after_decimal ) {
+ $number_result =
+ sprintf "%0${str_length}.${after_decimal}f", $data;
+ }
+ else {
+ $number_result = sprintf "%0${str_length}f", $data;
+ }
+
+ # Fix for Perl and sprintf not rounding up like Excel.
+ # http://rt.cpan.org/Public/Bug/Display.html?id=45626
+ if ( $data =~ /^${number_result}5/ ) {
+ $number_result =
+ sprintf "%0${str_length}.${after_decimal}f",
+ $data . '1';
+ }
+ }
+ else {
+ $number_result = sprintf( "%0${str_length}.0f", $data );
+ }
+ }
+
+ $number_result = AddComma($number_result) if $comma_count > 0;
+
+ my $number_length = length($number_result);
+ my $decimal_pos = -1;
+ my $replacement;
+
+ for ( my $i = @placeholders - 1 ; $i >= 0 ; $i-- ) {
+ my $placeholder = $placeholders[$i];
+
+ if ( $placeholder->[0] =~
+ /([#0]*)([\.]?)([0#]*)([eE])([\+\-])([0#]+)/ )
+ {
+ substr( $result, $placeholder->[1], $placeholder->[2],
+ MakeE( $placeholder->[0], $number ) );
+ }
+ elsif ( $placeholder->[0] =~ /\// ) {
+ substr( $result, $placeholder->[1], $placeholder->[2],
+ MakeFraction( $placeholder->[0], $number, $is_integer )
+ );
+ }
+ elsif ( $placeholder->[0] eq '.' ) {
+ $number_length--;
+ $decimal_pos = $number_length;
+ }
+ elsif ( $placeholder->[0] eq '+' ) {
+ substr( $result, $placeholder->[1], $placeholder->[2],
+ ( $number > 0 )
+ ? '+'
+ : ( ( $number == 0 ) ? '+' : '-' ) );
+ }
+ elsif ( $placeholder->[0] eq '-' ) {
+ substr( $result, $placeholder->[1], $placeholder->[2],
+ ( $number > 0 )
+ ? ''
+ : ( ( $number == 0 ) ? '' : '-' ) );
+ }
+ elsif ( $placeholder->[0] eq '@' ) {
+ substr( $result, $placeholder->[1], $placeholder->[2],
+ $number );
+ }
+ elsif ( $placeholder->[0] eq '*' ) {
+ substr( $result, $placeholder->[1], $placeholder->[2], '' );
+ }
+ elsif (( $placeholder->[0] eq "\xA2\xA4" )
+ or ( $placeholder->[0] eq "\xA2\xA5" )
+ or ( $placeholder->[0] eq "\x81\xA2" )
+ or ( $placeholder->[0] eq "\x81\xA3" ) )
+ {
+ substr(
+ $result, $placeholder->[1],
+ $placeholder->[2], $placeholder->[0]
+ );
+ }
+ elsif (( $placeholder->[0] eq '(' )
+ or ( $placeholder->[0] eq ')' ) )
+ {
+ substr(
+ $result, $placeholder->[1],
+ $placeholder->[2], $placeholder->[0]
+ );
+ }
+ else {
+ if ( $number_length > 0 ) {
+ if ( $i <= 0 ) {
+ $replacement =
+ substr( $number_result, 0, $number_length );
+ $number_length = 0;
+ }
+ else {
+ my $real_part_length = length( $placeholder->[0] );
+ if ( $decimal_pos >= 0 ) {
+ my $format = $placeholder->[0];
+ $format =~ s/^#+//;
+ $real_part_length = length $format;
+ $real_part_length =
+ ( $number_length <= $real_part_length )
+ ? $number_length
+ : $real_part_length;
+ }
+ else {
+ $real_part_length =
+ ( $number_length <= $real_part_length )
+ ? $number_length
+ : $real_part_length;
+ }
+ $replacement =
+ substr( $number_result,
+ $number_length - $real_part_length,
+ $real_part_length );
+ $number_length -= $real_part_length;
+ }
+ }
+ else {
+ $replacement = '';
+ }
+ substr( $result, $placeholder->[1], $placeholder->[2],
+ "\x00" . $replacement );
+ }
+ }
+ $replacement =
+ ( $number_length > 0 )
+ ? substr( $number_result, 0, $number_length )
+ : '';
+ $result =~ s/\x00/$replacement/;
+ $result =~ s/\x00//g;
+ }
+ }
+ else {
+
+ # Process text formats
+ my $is_text = 0;
+ for ( my $i = @placeholders - 1 ; $i >= 0 ; $i-- ) {
+ my $placeholder = $placeholders[$i];
+ if ( $placeholder->[0] eq '@' ) {
+ substr( $result, $placeholder->[1], $placeholder->[2],
+ $number );
+ $is_text++;
+ }
+ else {
+ substr( $result, $placeholder->[1], $placeholder->[2], '' );
+ }
+ }
+
+ $result = $number unless $is_text;
+
+ } # End of placeholder substitutions.
+
+ # Trim the leading and trailing whitespace from the results.
+ $result =~ s/^\s+//;
+ $result =~ s/\s+$//;
+
+ # Fix for negative currency.
+ $result =~ s/^\$\-/\-\$/;
+ $result =~ s/^\$ \-/\-\$ /;
+
+ # Return color and locale strings if required.
+ if ($want_subformats) {
+ return ( $result, $color, $locale );
+ }
+ else {
+ return $result;
+ }
+}
+
+#------------------------------------------------------------------------------
+# AddComma (for Spreadsheet::ParseExcel::Utility)
+#------------------------------------------------------------------------------
+sub AddComma {
+ my ($sNum) = @_;
+
+ if ( $sNum =~ /^([^\d]*)(\d\d\d\d+)(\.*.*)$/ ) {
+ my ( $sPre, $sObj, $sAft ) = ( $1, $2, $3 );
+ for ( my $i = length($sObj) - 3 ; $i > 0 ; $i -= 3 ) {
+ substr( $sObj, $i, 0, ',' );
+ }
+ return $sPre . $sObj . $sAft;
+ }
+ else {
+ return $sNum;
+ }
+}
+
+#------------------------------------------------------------------------------
+# MakeFraction (for Spreadsheet::ParseExcel::Utility)
+#------------------------------------------------------------------------------
+sub MakeFraction {
+ my ( $sFmt, $iData, $iFlg ) = @_;
+ my $iBunbo;
+ my $iShou;
+
+ #1. Init
+ # print "FLG: $iFlg\n";
+ if ($iFlg) {
+ $iShou = $iData - int($iData);
+ return '' if ( $iShou == 0 );
+ }
+ else {
+ $iShou = $iData;
+ }
+ $iShou = abs($iShou);
+ my $sSWk;
+
+ #2.Calc BUNBO
+ #2.1 BUNBO defined
+ if ( $sFmt =~ /\/(\d+)$/ ) {
+ $iBunbo = $1;
+ return sprintf( "%d/%d", $iShou * $iBunbo, $iBunbo );
+ }
+ else {
+
+ #2.2 Calc BUNBO
+ $sFmt =~ /\/(\?+)$/;
+ my $iKeta = length($1);
+ my $iSWk = 1;
+ my $sSWk = '';
+ my $iBunsi;
+ for ( my $iBunbo = 2 ; $iBunbo < 10**$iKeta ; $iBunbo++ ) {
+ $iBunsi = int( $iShou * $iBunbo + 0.5 );
+ my $iCmp = abs( $iShou - ( $iBunsi / $iBunbo ) );
+ if ( $iCmp < $iSWk ) {
+ $iSWk = $iCmp;
+ $sSWk = sprintf( "%d/%d", $iBunsi, $iBunbo );
+ last if ( $iSWk == 0 );
+ }
+ }
+ return $sSWk;
+ }
+}
+
+#------------------------------------------------------------------------------
+# MakeE (for Spreadsheet::ParseExcel::Utility)
+#------------------------------------------------------------------------------
+sub MakeE {
+ my ( $sFmt, $iData ) = @_;
+
+ $sFmt =~ /(([#0]*)[\.]?[#0]*)([eE])([\+\-][0#]+)/;
+ my ( $sKari, $iKeta, $sE, $sSisu ) = ( $1, length($2), $3, $4 );
+ $iKeta = 1 if ( $iKeta <= 0 );
+
+ my $iLog10 = 0;
+ $iLog10 = ( $iData == 0 ) ? 0 : ( log( abs($iData) ) / log(10) );
+ $iLog10 = (
+ int( $iLog10 / $iKeta ) +
+ ( ( ( $iLog10 - int( $iLog10 / $iKeta ) ) < 0 ) ? -1 : 0 ) ) * $iKeta;
+
+ my $sUe = ExcelFmt( $sKari, $iData * ( 10**( $iLog10 * -1 ) ), 0 );
+ my $sShita = ExcelFmt( $sSisu, $iLog10, 0 );
+ return $sUe . $sE . $sShita;
+}
+
+#------------------------------------------------------------------------------
+# LeapYear (for Spreadsheet::ParseExcel::Utility)
+#------------------------------------------------------------------------------
+sub LeapYear {
+ my ($iYear) = @_;
+ return 1 if ( $iYear == 1900 ); #Special for Excel
+ return ( ( ( $iYear % 4 ) == 0 )
+ && ( ( $iYear % 100 ) || ( $iYear % 400 ) == 0 ) )
+ ? 1
+ : 0;
+}
+
+#------------------------------------------------------------------------------
+# LocaltimeExcel (for Spreadsheet::ParseExcel::Utility)
+#------------------------------------------------------------------------------
+sub LocaltimeExcel {
+ my ( $iSec, $iMin, $iHour, $iDay, $iMon, $iYear, $iwDay, $iMSec, $flg1904 )
+ = @_;
+
+ #0. Init
+ $iMon++;
+ $iYear += 1900;
+
+ #1. Calc Time
+ my $iTime;
+ $iTime = $iHour;
+ $iTime *= 60;
+ $iTime += $iMin;
+ $iTime *= 60;
+ $iTime += $iSec;
+ $iTime += $iMSec / 1000.0 if ( defined($iMSec) );
+ $iTime /= 86400.0; #3600*24(1day in seconds)
+ my $iY;
+ my $iYDays;
+
+ #2. Calc Days
+ if ($flg1904) {
+ $iY = 1904;
+ $iTime--; #Start from Jan 1st
+ $iYDays = 366;
+ }
+ else {
+ $iY = 1900;
+ $iYDays = 366; #In Excel 1900 is leap year (That's not TRUE!)
+ }
+ while ( $iY < $iYear ) {
+ $iTime += $iYDays;
+ $iY++;
+ $iYDays = ( LeapYear($iY) ) ? 366 : 365;
+ }
+ for ( my $iM = 1 ; $iM < $iMon ; $iM++ ) {
+ if ( $iM == 1
+ || $iM == 3
+ || $iM == 5
+ || $iM == 7
+ || $iM == 8
+ || $iM == 10
+ || $iM == 12 )
+ {
+ $iTime += 31;
+ }
+ elsif ( $iM == 4 || $iM == 6 || $iM == 9 || $iM == 11 ) {
+ $iTime += 30;
+ }
+ elsif ( $iM == 2 ) {
+ $iTime += ( LeapYear($iYear) ) ? 29 : 28;
+ }
+ }
+ $iTime += $iDay;
+ return $iTime;
+}
+
+#------------------------------------------------------------------------------
+# ExcelLocaltime (for Spreadsheet::ParseExcel::Utility)
+#------------------------------------------------------------------------------
+sub ExcelLocaltime {
+
+ my ( $dObj, $flg1904 ) = @_;
+ my ( $iSec, $iMin, $iHour, $iDay, $iMon, $iYear, $iwDay, $iMSec );
+ my ( $iDt, $iTime, $iYDays );
+
+ $iDt = int($dObj);
+ $iTime = $dObj - $iDt;
+
+ #1. Calc Days
+ if ($flg1904) {
+ $iYear = 1904;
+ $iDt++; #Start from Jan 1st
+ $iYDays = 366;
+ $iwDay = ( ( $iDt + 4 ) % 7 );
+ }
+ else {
+ $iYear = 1900;
+ $iYDays = 366; #In Excel 1900 is leap year (That's not TRUE!)
+ $iwDay = ( ( $iDt + 6 ) % 7 );
+ }
+ while ( $iDt > $iYDays ) {
+ $iDt -= $iYDays;
+ $iYear++;
+ $iYDays =
+ ( ( ( $iYear % 4 ) == 0 )
+ && ( ( $iYear % 100 ) || ( $iYear % 400 ) == 0 ) ) ? 366 : 365;
+ }
+ $iYear -= 1900; # Localtime year is relative to 1900.
+
+ for ( $iMon = 1 ; $iMon < 12 ; $iMon++ ) {
+ my $iMD;
+ if ( $iMon == 1
+ || $iMon == 3
+ || $iMon == 5
+ || $iMon == 7
+ || $iMon == 8
+ || $iMon == 10
+ || $iMon == 12 )
+ {
+ $iMD = 31;
+ }
+ elsif ( $iMon == 4 || $iMon == 6 || $iMon == 9 || $iMon == 11 ) {
+ $iMD = 30;
+ }
+ elsif ( $iMon == 2 ) {
+ $iMD = ( ( $iYear % 4 ) == 0 ) ? 29 : 28;
+ }
+ last if ( $iDt <= $iMD );
+ $iDt -= $iMD;
+ }
+
+ $iMon -= 1; # Localtime month is 0 based.
+
+ #2. Calc Time
+ $iDay = $iDt;
+ $iTime += ( 0.0005 / 86400.0 );
+ $iTime *= 24.0;
+ $iHour = int($iTime);
+ $iTime -= $iHour;
+ $iTime *= 60.0;
+ $iMin = int($iTime);
+ $iTime -= $iMin;
+ $iTime *= 60.0;
+ $iSec = int($iTime);
+ $iTime -= $iSec;
+ $iTime *= 1000.0;
+ $iMSec = int($iTime);
+
+ return ( $iSec, $iMin, $iHour, $iDay, $iMon, $iYear, $iwDay, $iMSec );
+}
+
+# -----------------------------------------------------------------------------
+# col2int (for Spreadsheet::ParseExcel::Utility)
+#------------------------------------------------------------------------------
+# converts a excel row letter into an int for use in an array
+sub col2int {
+ my $result = 0;
+ my $str = shift;
+ my $incr = 0;
+
+ for ( my $i = length($str) ; $i > 0 ; $i-- ) {
+ my $char = substr( $str, $i - 1 );
+ my $curr += ord( lc($char) ) - ord('a') + 1;
+ $curr *= $incr if ($incr);
+ $result += $curr;
+ $incr += 26;
+ }
+
+ # this is one out as we range 0..x-1 not 1..x
+ $result--;
+
+ return $result;
+}
+
+# -----------------------------------------------------------------------------
+# int2col (for Spreadsheet::ParseExcel::Utility)
+#------------------------------------------------------------------------------
+### int2col
+# convert a column number into column letters
+# @note this is quite a brute force coarse method
+# does not manage values over 701 (ZZ)
+# @arg number, to convert
+# @returns string, column name
+#
+sub int2col {
+ my $out = "";
+ my $val = shift;
+
+ do {
+ $out .= chr( ( $val % 26 ) + ord('A') );
+ $val = int( $val / 26 ) - 1;
+ } while ( $val >= 0 );
+
+ return scalar reverse $out;
+}
+
+# -----------------------------------------------------------------------------
+# sheetRef (for Spreadsheet::ParseExcel::Utility)
+#------------------------------------------------------------------------------
+# -----------------------------------------------------------------------------
+### sheetRef
+# convert an excel letter-number address into a useful array address
+# @note that also Excel uses X-Y notation, we normally use Y-X in arrays
+# @args $str, excel coord eg. A2
+# @returns an array - 2 elements - column, row, or undefined
+#
+sub sheetRef {
+ my $str = shift;
+ my @ret;
+
+ $str =~ m/^(\D+)(\d+)$/;
+
+ if ( $1 && $2 ) {
+ push( @ret, $2 - 1, col2int($1) );
+ }
+ if ( $ret[0] < 0 ) {
+ undef @ret;
+ }
+
+ return @ret;
+}
+
+# -----------------------------------------------------------------------------
+# xls2csv (for Spreadsheet::ParseExcel::Utility)
+#------------------------------------------------------------------------------
+### xls2csv
+# convert a chunk of an excel file into csv text chunk
+# @args $param, sheet-colrow:colrow (1-A1:B2 or A1:B2 for sheet 1
+# @args $rotate, 0 or 1 decides if output should be rotated or not
+# @returns string containing a chunk of csv
+#
+sub xls2csv {
+ my ( $filename, $regions, $rotate ) = @_;
+ my $sheet = 0;
+
+ # We need Text::CSV_XS for proper CSV handling.
+ require Text::CSV_XS;
+
+ # extract any sheet number from the region string
+ $regions =~ m/^(\d+)-(.*)/;
+
+ if ($2) {
+ $sheet = $1 - 1;
+ $regions = $2;
+ }
+
+ # now extract the start and end regions
+ $regions =~ m/(.*):(.*)/;
+
+ if ( !$1 || !$2 ) {
+ print STDERR "Bad Params";
+ return "";
+ }
+
+ my @start = sheetRef($1);
+ my @end = sheetRef($2);
+ if ( !@start ) {
+ print STDERR "Bad coorinates - $1";
+ return "";
+ }
+ if ( !@end ) {
+ print STDERR "Bad coorinates - $2";
+ return "";
+ }
+
+ if ( $start[1] > $end[1] ) {
+ print STDERR "Bad COLUMN ordering\n";
+ print STDERR "Start column " . int2col( $start[1] );
+ print STDERR " after end column " . int2col( $end[1] ) . "\n";
+ return "";
+ }
+ if ( $start[0] > $end[0] ) {
+ print STDERR "Bad ROW ordering\n";
+ print STDERR "Start row " . ( $start[0] + 1 );
+ print STDERR " after end row " . ( $end[0] + 1 ) . "\n";
+ exit;
+ }
+
+ # start the excel object now
+ my $oExcel = new Spreadsheet::ParseExcel;
+ my $oBook = $oExcel->Parse($filename);
+
+ # open the sheet
+ my $oWkS = $oBook->{Worksheet}[$sheet];
+
+ # now check that the region exists in the file
+ # if not truncate to the possible region
+ # output a warning msg
+ if ( $start[1] < $oWkS->{MinCol} ) {
+ print STDERR int2col( $start[1] )
+ . " < min col "
+ . int2col( $oWkS->{MinCol} )
+ . " Resetting\n";
+ $start[1] = $oWkS->{MinCol};
+ }
+ if ( $end[1] > $oWkS->{MaxCol} ) {
+ print STDERR int2col( $end[1] )
+ . " > max col "
+ . int2col( $oWkS->{MaxCol} )
+ . " Resetting\n";
+ $end[1] = $oWkS->{MaxCol};
+ }
+ if ( $start[0] < $oWkS->{MinRow} ) {
+ print STDERR ""
+ . ( $start[0] + 1 )
+ . " < min row "
+ . ( $oWkS->{MinRow} + 1 )
+ . " Resetting\n";
+ $start[0] = $oWkS->{MinCol};
+ }
+ if ( $end[0] > $oWkS->{MaxRow} ) {
+ print STDERR ""
+ . ( $end[0] + 1 )
+ . " > max row "
+ . ( $oWkS->{MaxRow} + 1 )
+ . " Resetting\n";
+ $end[0] = $oWkS->{MaxRow};
+
+ }
+
+ my $x1 = $start[1];
+ my $y1 = $start[0];
+ my $x2 = $end[1];
+ my $y2 = $end[0];
+
+ my @cell_data;
+ my $row = 0;
+
+ if ( !$rotate ) {
+ for ( my $y = $y1 ; $y <= $y2 ; $y++ ) {
+ for ( my $x = $x1 ; $x <= $x2 ; $x++ ) {
+ my $cell = $oWkS->{Cells}[$y][$x];
+
+ my $value;
+ if ( defined $cell ) {
+ $value .= $cell->value();
+ }
+ else {
+ $value = '';
+ }
+
+ push @{ $cell_data[$row] }, $value;
+ }
+ $row++;
+ }
+ }
+ else {
+ for ( my $x = $x1 ; $x <= $x2 ; $x++ ) {
+ for ( my $y = $y1 ; $y <= $y2 ; $y++ ) {
+ my $cell = $oWkS->{Cells}[$y][$x];
+
+ my $value;
+ if ( defined $cell ) {
+ $value .= $cell->value();
+ }
+ else {
+ $value = '';
+ }
+
+ push @{ $cell_data[$row] }, $value;
+ }
+ $row++;
+ }
+ }
+
+ # Create the CSV output string.
+ my $csv = Text::CSV_XS->new( { binary => 1, eol => $/ } );
+ my $output = "";
+
+ for my $row (@cell_data) {
+ $csv->combine(@$row);
+ $output .= $csv->string();
+ }
+
+ return $output;
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Spreadsheet::ParseExcel::Utility - Utility functions for Spreadsheet::ParseExcel.
+
+=head1 SYNOPSIS
+
+ use Spreadsheet::ParseExcel::Utility qw(ExcelFmt ExcelLocaltime LocaltimeExcel);
+
+ # Convert localtime to Excel time
+ my $datetime = LocaltimeExcel(11, 10, 12, 23, 2, 64); # 1964-3-23 12:10:11
+
+ print $datetime, "\n"; # 23459.5070717593 (Excel date/time format)
+
+ # Convert Excel Time to localtime
+ my @time = ExcelLocaltime($datetime);
+ print join(":", @time), "\n"; # 11:10:12:23:2:64:1:0
+
+ # Formatting
+ print ExcelFmt('yyyy-mm-dd', $datetime), "\n"; # 1964-3-23
+ print ExcelFmt('m-d-yy', $datetime), "\n"; # 3-23-64
+ print ExcelFmt('#,##0', $datetime), "\n"; # 23,460
+ print ExcelFmt('#,##0.00', $datetime), "\n"; # 23,459.51
+
+=head1 DESCRIPTION
+
+The C<Spreadsheet::ParseExcel::Utility> module provides utility functions for working with ParseExcel and Excel data.
+
+=head1 Functions
+
+C<Spreadsheet::ParseExcel::Utility> can export the following functions:
+
+ ExcelFmt
+ ExcelLocaltime
+ LocaltimeExcel
+ col2int
+ int2col
+ sheetRef
+ xls2csv
+
+These functions must be imported implicitly:
+
+ # Just one function.
+ use Spreadsheet::ParseExcel::Utility 'col2int';
+
+ # More than one.
+ use Spreadsheet::ParseExcel::Utility qw(ExcelFmt ExcelLocaltime LocaltimeExcel);
+
+
+=head2 ExcelFmt($format_string, $number, $is_1904)
+
+Excel stores data such as dates and currency values as numbers. The way these numbers are displayed is controlled by the number format string for the cell. For example a cell with a number format of C<'$#,##0.00'> for currency and a value of 1234.567 would be displayed as follows:
+
+ '$#,##0.00' + 1234.567 = '$1,234.57'.
+
+The C<ExcelFmt()> function tries to emulate this formatting so that the user can convert raw numbers returned by C<Spreadsheet::ParseExel> to a desired format. For example:
+
+ print ExcelFmt('$#,##0.00', 1234.567); # $1,234.57.
+
+The syntax of the function is:
+
+ my $text = ExcelFmt($format_string, $number, $is_1904);
+
+Where C<$format_string> is an Excel number format string, C<$number> is a real or integer number and C<is_1904> is an optional flag to indicate that dates should use Excel's 1904 epoch instead of the default 1900 epoch.
+
+C<ExcelFmt()> is also used internally to convert numbers returned by the C<Cell::unformatted()> method to the formatted value returned by the C<Cell::value()> method:
+
+
+ my $cell = $worksheet->get_cell( 0, 0 );
+
+ print $cell->unformatted(), "\n"; # 1234.567
+ print $cell->value(), "\n"; # $1,234.57
+
+The most common usage for C<ExcelFmt> is to convert numbers to dates. Dates and times in Excel are represented by real numbers, for example "1 Jan 2001 12:30 PM" is represented by the number 36892.521. The integer part of the number stores the number of days since the epoch and the fractional part stores the percentage of the day. By applying an Excel number format the number is converted to the desired string representation:
+
+ print ExcelFmt('d mmm yyyy h:mm AM/PM', 36892.521); # 1 Jan 2001 12:30 PM
+
+C<$is_1904> is an optional flag to indicate that dates should use Excel's 1904 epoch instead of the default 1900 epoch. Excel for Windows generally uses 1900 and Excel for Mac OS uses 1904. The C<$is1904> flag isn't required very often by a casual user and can usually be ignored.
+
+
+=head2 ExcelLocaltime($excel_datetime, $is_1904)
+
+The C<ExcelLocaltime()> function converts from an Excel date/time number to a C<localtime()>-like array of values:
+
+ my @time = ExcelLocaltime($excel_datetime);
+
+ # 0 1 2 3 4 5 6 7
+ my ( $sec, $min, $hour, $day, $month, $year, $wday, $msec ) = @time;
+
+The array elements from C<(0 .. 6)> are the same as Perl's C<localtime()>. The last element C<$msec> is milliseconds. In particular it should be noted that, in common with C<localtime()>, the month is zero indexed and the year is the number of years since 1900. This means that you will usually need to do the following:
+
+ $month++;
+ $year += 1900;
+
+See also Perl's documentation for L<localtime()|perlfunc>:
+
+The C<$is_1904> flag is an optional. It is used to indicate that dates should use Excel's 1904 epoch instead of the default 1900 epoch.
+
+=head2 LocaltimeExcel($sec, $min, $hour, $day, $month, $year, $wday, $msec, $is_1904)
+
+The C<LocaltimeExcel()> function converts from a C<localtime()>-like array of values to an Excel date/time number:
+
+ $excel_datetime = LocaltimeExcel($sec, $min, $hour, $day, $month, $year, $wday, $msec);
+
+The array elements from C<(0 .. 6)> are the same as Perl's C<localtime()>. The last element C<$msec> is milliseconds. In particular it should be noted that, in common with C<localtime()>, the month is zero indexed and the year is the number of years since 1900. See also Perl's documentation for L<localtime()|perlfunc>:
+
+The C<$wday> and C<$msec> elements are usually optional. This time elements can also be zeroed if they aren't of interest:
+
+ # sec, min, hour, day, month, year
+ $excel_datetime = LocaltimeExcel( 0, 0, 0, 1, 0, 101 );
+
+ print ExcelFmt('d mmm yyyy', $excel_datetime); # 1 Jan 2001
+
+The C<$is_1904> flag is also optional. It is used to indicate that dates should use Excel's 1904 epoch instead of the default 1900 epoch.
+
+
+=head2 col2int($column)
+
+The C<col2int()> function converts an Excel column letter to an zero-indexed column number:
+
+ print col2int('A'); # 0
+ print col2int('AA'); # 26
+
+This function was contributed by Kevin Mulholland.
+
+
+=head2 int2col($column_number)
+
+The C<int2col()> function converts an zero-indexed Excel column number to a column letter:
+
+ print int2col(0); # 'A'
+ print int2col(26); # 'AA'
+
+This function was contributed by Kevin Mulholland.
+
+
+=head2 sheetRef($cell_string)
+
+The C<sheetRef()> function converts an Excel cell reference in 'A1' notation to a zero-indexed C<(row, col)> pair.
+
+ my ($row, $col) = sheetRef('A1'); # ( 0, 0 )
+ my ($row, $col) = sheetRef('C2'); # ( 1, 2 )
+
+This function was contributed by Kevin Mulholland.
+
+
+=head2 xls2csv($filename, $region, $rotate)
+
+The C<xls2csv()> function converts a section of an Excel file into a CSV text string.
+
+ $csv_text = xls2csv($filename, $region, $rotate);
+
+Where:
+
+ $region = "sheet-colrow:colrow"
+ For example '1-A1:B2' means 'A1:B2' for sheet 1.
+
+ and
+
+ $rotate = 0 or 1 (output is rotated/transposed or not)
+
+This function requires C<Text::CSV_XS> to be installed. It was contributed by Kevin Mulholland along with the C<xls2csv> script in the C<sample> directory of the distro.
+
+See also the following xls2csv utilities: Ken Prows' C<xls2csv>: http://search.cpan.org/~ken/xls2csv/script/xls2csv and H.Merijn Brand's C<xls2csv> (which is part of Spreadsheet::Read): http://search.cpan.org/~hmbrand/Spreadsheet-Read/
+
+
+=head1 AUTHOR
+
+Maintainer 0.40+: John McNamara jmcnamara@cpan.org
+
+Maintainer 0.27-0.33: Gabor Szabo szabgab@cpan.org
+
+Original author: Kawai Takanori kwitknr@cpan.org
+
+=head1 COPYRIGHT
+
+Copyright (c) 2009-2010 John McNamara
+
+Copyright (c) 2006-2008 Gabor Szabo
+
+Copyright (c) 2000-2006 Kawai Takanori
+
+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.
+
+=cut
diff --git a/src/bach/build.bach/tools/perl/Spreadsheet/ParseExcel/Workbook.pm b/src/bach/build.bach/tools/perl/Spreadsheet/ParseExcel/Workbook.pm
new file mode 100644
index 0000000..d8a03c0
--- /dev/null
+++ b/src/bach/build.bach/tools/perl/Spreadsheet/ParseExcel/Workbook.pm
@@ -0,0 +1,297 @@
+package Spreadsheet::ParseExcel::Workbook;
+
+###############################################################################
+#
+# Spreadsheet::ParseExcel::Workbook - A class for Workbooks.
+#
+# Used in conjunction with Spreadsheet::ParseExcel.
+#
+# Copyright (c) 2009 John McNamara
+# Copyright (c) 2006-2008 Gabor Szabo
+# Copyright (c) 2000-2006 Kawai Takanori
+#
+# perltidy with standard settings.
+#
+# Documentation after __END__
+#
+
+use strict;
+use warnings;
+
+our $VERSION = '0.59';
+
+###############################################################################
+#
+# new()
+#
+# Constructor.
+#
+sub new {
+ my ($class) = @_;
+ my $self = {};
+ bless $self, $class;
+}
+
+###############################################################################
+#
+# worksheet()
+#
+# This method returns a single Worksheet object using either its name or index.
+#
+sub worksheet {
+ my ( $oBook, $sName ) = @_;
+ my $oWkS;
+ foreach $oWkS ( @{ $oBook->{Worksheet} } ) {
+ return $oWkS if ( $oWkS->{Name} eq $sName );
+ }
+ if ( $sName =~ /^\d+$/ ) {
+ return $oBook->{Worksheet}->[$sName];
+ }
+ return undef;
+}
+
+###############################################################################
+#
+# worksheets()
+#
+# Returns an array ofWorksheet objects.
+#
+sub worksheets {
+ my $self = shift;
+
+ return @{ $self->{Worksheet} };
+}
+
+###############################################################################
+#
+# worksheet_count()
+#
+# Returns the number Woksheet objects in the Workbook.
+#
+sub worksheet_count {
+
+ my $self = shift;
+
+ return $self->{SheetCount};
+}
+
+###############################################################################
+#
+# get_filename()
+#
+# Returns the name of the Excel file of C<undef> if the data was read from a filehandle rather than a file.
+#
+sub get_filename {
+
+ my $self = shift;
+
+ return $self->{File};
+}
+
+###############################################################################
+#
+# get_print_areas()
+#
+# Returns an array ref of print areas.
+#
+# TODO. This should really be a Worksheet method.
+#
+sub get_print_areas {
+
+ my $self = shift;
+
+ return $self->{PrintArea};
+}
+
+###############################################################################
+#
+# get_print_titles()
+#
+# Returns an array ref of print title hash refs.
+#
+# TODO. This should really be a Worksheet method.
+#
+sub get_print_titles {
+
+ my $self = shift;
+
+ return $self->{PrintTitle};
+}
+
+###############################################################################
+#
+# using_1904_date()
+#
+# Returns true if the Excel file is using the 1904 date epoch.
+#
+sub using_1904_date {
+
+ my $self = shift;
+
+ return $self->{Flg1904};
+}
+
+###############################################################################
+#
+# ParseAbort()
+#
+# Todo
+#
+sub ParseAbort {
+ my ( $self, $val ) = @_;
+ $self->{_ParseAbort} = $val;
+}
+
+###############################################################################
+#
+# Parse(). Deprecated.
+#
+# Syntactic wrapper around Spreadsheet::ParseExcel::Parse().
+# This method is *deprecated* since it doesn't conform to the the current
+# error handling in the S::PE Parse() method.
+#
+sub Parse {
+
+ my ( $class, $source, $formatter ) = @_;
+ my $excel = Spreadsheet::ParseExcel->new();
+ my $workbook = $excel->Parse( $source, $formatter );
+ $workbook->{_Excel} = $excel;
+ return $workbook;
+}
+
+###############################################################################
+#
+# Mapping between legacy method names and new names.
+#
+{
+ no warnings; # Ignore warnings about variables used only once.
+ *Worksheet = *worksheet;
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Spreadsheet::ParseExcel::Workbook - A class for Workbooks.
+
+=head1 SYNOPSIS
+
+See the documentation for Spreadsheet::ParseExcel.
+
+=head1 DESCRIPTION
+
+This module is used in conjunction with Spreadsheet::ParseExcel. See the documentation for L<Spreadsheet::ParseExcel>.
+
+
+=head1 Methods
+
+The following Workbook methods are available:
+
+ $workbook->worksheets()
+ $workbook->worksheet()
+ $workbook->worksheet_count()
+ $workbook->get_filename()
+ $workbook->get_print_areas()
+ $workbook->get_print_titles()
+ $workbook->using_1904_date()
+
+
+=head2 worksheets()
+
+The C<worksheets()> method returns an array of Worksheet objects. This was most commonly used to iterate over the worksheets in a workbook:
+
+ for my $worksheet ( $workbook->worksheets() ) {
+ ...
+ }
+
+
+=head2 worksheet()
+
+The C<worksheet()> method returns a single C<Worksheet> object using either its name or index:
+
+ $worksheet = $workbook->worksheet('Sheet1');
+ $worksheet = $workbook->worksheet(0);
+
+Returns C<undef> if the sheet name or index doesn't exist.
+
+
+=head2 worksheet_count()
+
+The C<worksheet_count()> method returns the number of Woksheet objects in the Workbook.
+
+ my $worksheet_count = $workbook->worksheet_count();
+
+
+=head2 get_filename()
+
+The C<get_filename()> method returns the name of the Excel file of C<undef> if the data was read from a filehandle rather than a file.
+
+ my $filename = $workbook->get_filename();
+
+
+=head2 get_print_areas()
+
+The C<get_print_areas()> method returns an array ref of print areas.
+
+ my $print_areas = $workbook->get_print_areas();
+
+Each print area is as follows:
+
+ [ $start_row, $start_col, $end_row, $end_col ]
+
+Returns undef if there are no print areas.
+
+
+=head2 get_print_titles()
+
+The C<get_print_titles()> method returns an array ref of print title hash refs.
+
+ my $print_titles = $workbook->get_print_titles();
+
+Each print title array ref is as follows:
+
+ {
+ Row => [ $start_row, $end_row ],
+ Column => [ $start_col, $end_col ],
+ }
+
+
+Returns undef if there are no print titles.
+
+
+=head2 using_1904_date()
+
+The C<using_1904_date()> method returns true if the Excel file is using the 1904 date epoch instead of the 1900 epoch.
+
+ my $using_1904_date = $workbook->using_1904_date();
+
+ The Windows version of Excel generally uses the 1900 epoch while the Mac version of Excel generally uses the 1904 epoch.
+
+Returns 0 if the 1900 epoch is in use.
+
+
+=head1 AUTHOR
+
+Maintainer 0.40+: John McNamara jmcnamara@cpan.org
+
+Maintainer 0.27-0.33: Gabor Szabo szabgab@cpan.org
+
+Original author: Kawai Takanori kwitknr@cpan.org
+
+=head1 COPYRIGHT
+
+Copyright (c) 2009-2010 John McNamara
+
+Copyright (c) 2006-2008 Gabor Szabo
+
+Copyright (c) 2000-2006 Kawai Takanori
+
+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.
+
+=cut
diff --git a/src/bach/build.bach/tools/perl/Spreadsheet/ParseExcel/Worksheet.pm b/src/bach/build.bach/tools/perl/Spreadsheet/ParseExcel/Worksheet.pm
new file mode 100644
index 0000000..b9d32d7
--- /dev/null
+++ b/src/bach/build.bach/tools/perl/Spreadsheet/ParseExcel/Worksheet.pm
@@ -0,0 +1,955 @@
+package Spreadsheet::ParseExcel::Worksheet;
+
+###############################################################################
+#
+# Spreadsheet::ParseExcel::Worksheet - A class for Worksheets.
+#
+# Used in conjunction with Spreadsheet::ParseExcel.
+#
+# Copyright (c) 2009 John McNamara
+# Copyright (c) 2006-2008 Gabor Szabo
+# Copyright (c) 2000-2006 Kawai Takanori
+#
+# perltidy with standard settings.
+#
+# Documentation after __END__
+#
+
+use strict;
+use warnings;
+use Scalar::Util qw(weaken);
+
+our $VERSION = '0.59';
+
+###############################################################################
+#
+# new()
+#
+sub new {
+
+ my ( $class, %properties ) = @_;
+
+ my $self = \%properties;
+
+ weaken $self->{_Book};
+
+ $self->{Cells} = undef;
+ $self->{DefColWidth} = 8.43;
+
+ return bless $self, $class;
+}
+
+###############################################################################
+#
+# get_cell( $row, $col )
+#
+# Returns the Cell object at row $row and column $col, if defined.
+#
+sub get_cell {
+
+ my ( $self, $row, $col ) = @_;
+
+ if ( !defined $row
+ || !defined $col
+ || !defined $self->{MaxRow}
+ || !defined $self->{MaxCol} )
+ {
+
+ # Return undef if no arguments are given or if no cells are defined.
+ return undef;
+ }
+ elsif ($row < $self->{MinRow}
+ || $row > $self->{MaxRow}
+ || $col < $self->{MinCol}
+ || $col > $self->{MaxCol} )
+ {
+
+ # Return undef if outside allowable row/col range.
+ return undef;
+ }
+ else {
+
+ # Return the Cell object.
+ return $self->{Cells}->[$row]->[$col];
+ }
+}
+
+###############################################################################
+#
+# row_range()
+#
+# Returns a two-element list ($min, $max) containing the minimum and maximum
+# defined rows in the worksheet.
+#
+# If there is no row defined $max is smaller than $min.
+#
+sub row_range {
+
+ my $self = shift;
+
+ my $min = $self->{MinRow} || 0;
+ my $max = defined( $self->{MaxRow} ) ? $self->{MaxRow} : ( $min - 1 );
+
+ return ( $min, $max );
+}
+
+###############################################################################
+#
+# col_range()
+#
+# Returns a two-element list ($min, $max) containing the minimum and maximum
+# defined cols in the worksheet.
+#
+# If there is no column defined $max is smaller than $min.
+#
+sub col_range {
+
+ my $self = shift;
+
+ my $min = $self->{MinCol} || 0;
+ my $max = defined( $self->{MaxCol} ) ? $self->{MaxCol} : ( $min - 1 );
+
+ return ( $min, $max );
+}
+
+###############################################################################
+#
+# get_name()
+#
+# Returns the name of the worksheet.
+#
+sub get_name {
+
+ my $self = shift;
+
+ return $self->{Name};
+}
+
+###############################################################################
+#
+# sheet_num()
+#
+sub sheet_num {
+
+ my $self = shift;
+
+ return $self->{_SheetNo};
+}
+
+###############################################################################
+#
+# get_h_pagebreaks()
+#
+# Returns an array ref of row numbers where a horizontal page break occurs.
+#
+sub get_h_pagebreaks {
+
+ my $self = shift;
+
+ return $self->{HPageBreak};
+}
+
+###############################################################################
+#
+# get_v_pagebreaks()
+#
+# Returns an array ref of column numbers where a vertical page break occurs.
+#
+sub get_v_pagebreaks {
+
+ my $self = shift;
+
+ return $self->{VPageBreak};
+}
+
+###############################################################################
+#
+# get_merged_areas()
+#
+# Returns an array ref of cells that are merged.
+#
+sub get_merged_areas {
+
+ my $self = shift;
+
+ return $self->{MergedArea};
+}
+
+###############################################################################
+#
+# get_row_heights()
+#
+# Returns an array_ref of row heights.
+#
+sub get_row_heights {
+
+ my $self = shift;
+
+ return @{ $self->{RowHeight} };
+}
+
+###############################################################################
+#
+# get_col_widths()
+#
+# Returns an array_ref of column widths.
+#
+sub get_col_widths {
+
+ my $self = shift;
+
+ return @{ $self->{ColWidth} };
+}
+
+###############################################################################
+#
+# get_default_row_height()
+#
+# Returns the default row height for the worksheet. Generally 12.75.
+#
+sub get_default_row_height {
+
+ my $self = shift;
+
+ return $self->{DefRowHeight};
+}
+
+###############################################################################
+#
+# get_default_col_width()
+#
+# Returns the default column width for the worksheet. Generally 8.43.
+#
+sub get_default_col_width {
+
+ my $self = shift;
+
+ return $self->{DefColWidth};
+}
+
+###############################################################################
+#
+# _get_row_properties()
+#
+# Returns an array_ref of row properties.
+# TODO. This is a placeholder for a future method.
+#
+sub _get_row_properties {
+
+ my $self = shift;
+
+ return $self->{RowProperties};
+}
+
+###############################################################################
+#
+# _get_col_properties()
+#
+# Returns an array_ref of column properties.
+# TODO. This is a placeholder for a future method.
+#
+sub _get_col_properties {
+
+ my $self = shift;
+
+ return $self->{ColProperties};
+}
+
+###############################################################################
+#
+# get_header()
+#
+# Returns the worksheet header string.
+#
+sub get_header {
+
+ my $self = shift;
+
+ return $self->{Header};
+}
+
+###############################################################################
+#
+# get_footer()
+#
+# Returns the worksheet footer string.
+#
+sub get_footer {
+
+ my $self = shift;
+
+ return $self->{Footer};
+}
+
+###############################################################################
+#
+# get_margin_left()
+#
+# Returns the left margin of the worksheet in inches.
+#
+sub get_margin_left {
+
+ my $self = shift;
+
+ return $self->{LeftMargin};
+}
+
+###############################################################################
+#
+# get_margin_right()
+#
+# Returns the right margin of the worksheet in inches.
+#
+sub get_margin_right {
+
+ my $self = shift;
+
+ return $self->{RightMargin};
+}
+
+###############################################################################
+#
+# get_margin_top()
+#
+# Returns the top margin of the worksheet in inches.
+#
+sub get_margin_top {
+
+ my $self = shift;
+
+ return $self->{TopMargin};
+}
+
+###############################################################################
+#
+# get_margin_bottom()
+#
+# Returns the bottom margin of the worksheet in inches.
+#
+sub get_margin_bottom {
+
+ my $self = shift;
+
+ return $self->{BottomMargin};
+}
+
+###############################################################################
+#
+# get_margin_header()
+#
+# Returns the header margin of the worksheet in inches.
+#
+sub get_margin_header {
+
+ my $self = shift;
+
+ return $self->{HeaderMargin};
+}
+
+###############################################################################
+#
+# get_margin_footer()
+#
+# Returns the footer margin of the worksheet in inches.
+#
+sub get_margin_footer {
+
+ my $self = shift;
+
+ return $self->{FooterMargin};
+}
+
+###############################################################################
+#
+# get_paper()
+#
+# Returns the printer paper size.
+#
+sub get_paper {
+
+ my $self = shift;
+
+ return $self->{PaperSize};
+}
+
+###############################################################################
+#
+# get_start_page()
+#
+# Returns the page number that printing will start from.
+#
+sub get_start_page {
+
+ my $self = shift;
+
+ # Only return the page number if the "First page number" option is set.
+ if ( $self->{UsePage} ) {
+ return $self->{PageStart};
+ }
+ else {
+ return 0;
+ }
+}
+
+###############################################################################
+#
+# get_print_order()
+#
+# Returns the Worksheet page printing order.
+#
+sub get_print_order {
+
+ my $self = shift;
+
+ return $self->{LeftToRight};
+}
+
+###############################################################################
+#
+# get_print_scale()
+#
+# Returns the workbook scale for printing.
+#
+sub get_print_scale {
+
+ my $self = shift;
+
+ return $self->{Scale};
+}
+
+###############################################################################
+#
+# get_fit_to_pages()
+#
+# Returns the number of pages wide and high that the printed worksheet page
+# will fit to.
+#
+sub get_fit_to_pages {
+
+ my $self = shift;
+
+ if ( !$self->{PageFit} ) {
+ return ( 0, 0 );
+ }
+ else {
+ return ( $self->{FitWidth}, $self->{FitHeight} );
+ }
+}
+
+###############################################################################
+#
+# is_portrait()
+#
+# Returns true if the worksheet has been set for printing in portrait mode.
+#
+sub is_portrait {
+
+ my $self = shift;
+
+ return $self->{Landscape};
+}
+
+###############################################################################
+#
+# is_centered_horizontally()
+#
+# Returns true if the worksheet has been centered horizontally for printing.
+#
+sub is_centered_horizontally {
+
+ my $self = shift;
+
+ return $self->{HCenter};
+}
+
+###############################################################################
+#
+# is_centered_vertically()
+#
+# Returns true if the worksheet has been centered vertically for printing.
+#
+sub is_centered_vertically {
+
+ my $self = shift;
+
+ return $self->{HCenter};
+}
+
+###############################################################################
+#
+# is_print_gridlines()
+#
+# Returns true if the worksheet print "gridlines" option is turned on.
+#
+sub is_print_gridlines {
+
+ my $self = shift;
+
+ return $self->{PrintGrid};
+}
+
+###############################################################################
+#
+# is_print_row_col_headers()
+#
+# Returns true if the worksheet print "row and column headings" option is on.
+#
+sub is_print_row_col_headers {
+
+ my $self = shift;
+
+ return $self->{PrintHeaders};
+}
+
+###############################################################################
+#
+# is_print_black_and_white()
+#
+# Returns true if the worksheet print "black and white" option is turned on.
+#
+sub is_print_black_and_white {
+
+ my $self = shift;
+
+ return $self->{NoColor};
+}
+
+###############################################################################
+#
+# is_print_draft()
+#
+# Returns true if the worksheet print "draft" option is turned on.
+#
+sub is_print_draft {
+
+ my $self = shift;
+
+ return $self->{Draft};
+}
+
+###############################################################################
+#
+# is_print_comments()
+#
+# Returns true if the worksheet print "comments" option is turned on.
+#
+sub is_print_comments {
+
+ my $self = shift;
+
+ return $self->{Notes};
+}
+
+###############################################################################
+#
+# Mapping between legacy method names and new names.
+#
+{
+ no warnings; # Ignore warnings about variables used only once.
+ *sheetNo = *sheet_num;
+ *Cell = *get_cell;
+ *RowRange = *row_range;
+ *ColRange = *col_range;
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Spreadsheet::ParseExcel::Worksheet - A class for Worksheets.
+
+=head1 SYNOPSIS
+
+See the documentation for L<Spreadsheet::ParseExcel>.
+
+=head1 DESCRIPTION
+
+This module is used in conjunction with Spreadsheet::ParseExcel. See the documentation for Spreadsheet::ParseExcel.
+
+=head1 Methods
+
+The C<Spreadsheet::ParseExcel::Worksheet> class encapsulates the properties of an Excel worksheet. It has the following methods:
+
+ $worksheet->get_cell()
+ $worksheet->row_range()
+ $worksheet->col_range()
+ $worksheet->get_name()
+ $worksheet->get_h_pagebreaks()
+ $worksheet->get_v_pagebreaks()
+ $worksheet->get_merged_areas()
+ $worksheet->get_row_heights()
+ $worksheet->get_col_widths()
+ $worksheet->get_default_row_height()
+ $worksheet->get_default_col_width()
+ $worksheet->get_header()
+ $worksheet->get_footer()
+ $worksheet->get_margin_left()
+ $worksheet->get_margin_right()
+ $worksheet->get_margin_top()
+ $worksheet->get_margin_bottom()
+ $worksheet->get_margin_header()
+ $worksheet->get_margin_footer()
+ $worksheet->get_paper()
+ $worksheet->get_start_page()
+ $worksheet->get_print_order()
+ $worksheet->get_print_scale()
+ $worksheet->get_fit_to_pages()
+ $worksheet->is_portrait()
+ $worksheet->is_centered_horizontally()
+ $worksheet->is_centered_vertically()
+ $worksheet->is_print_gridlines()
+ $worksheet->is_print_row_col_headers()
+ $worksheet->is_print_black_and_white()
+ $worksheet->is_print_draft()
+ $worksheet->is_print_comments()
+
+
+=head2 get_cell($row, $col)
+
+Return the L</Cell> object at row C<$row> and column C<$col> if it is defined. Otherwise returns undef.
+
+ my $cell = $worksheet->get_cell($row, $col);
+
+=head2 row_range()
+
+Returns a two-element list C<($min, $max)> containing the minimum and maximum defined rows in the worksheet. If there is no row defined C<$max> is smaller than C<$min>.
+
+ my ( $row_min, $row_max ) = $worksheet->row_range();
+
+=head2 col_range()
+
+Returns a two-element list C<($min, $max)> containing the minimum and maximum of defined columns in the worksheet. If there is no column defined C<$max> is smaller than C<$min>.
+
+ my ( $col_min, $col_max ) = $worksheet->col_range();
+
+
+=head2 get_name()
+
+The C<get_name()> method returns the name of the worksheet.
+
+ my $name = $worksheet->get_name();
+
+
+=head2 get_h_pagebreaks()
+
+The C<get_h_pagebreaks()> method returns an array ref of row numbers where a horizontal page break occurs.
+
+ my $h_pagebreaks = $worksheet->get_h_pagebreaks();
+
+Returns C<undef> if there are no pagebreaks.
+
+
+=head2 get_v_pagebreaks()
+
+The C<get_v_pagebreaks()> method returns an array ref of column numbers where a vertical page break occurs.
+
+ my $v_pagebreaks = $worksheet->get_v_pagebreaks();
+
+Returns C<undef> if there are no pagebreaks.
+
+
+=head2 get_merged_areas()
+
+The C<get_merged_areas()> method returns an array ref of cells that are merged.
+
+ my $merged_areas = $worksheet->get_merged_areas();
+
+Each merged area is represented as follows:
+
+ [ $start_row, $start_col, $end_row, $end_col]
+
+Returns C<undef> if there are no merged areas.
+
+
+=head2 get_row_heights()
+
+The C<get_row_heights()> method returns an array_ref of row heights.
+
+ my $row_heights = $worksheet->get_row_heights();
+
+Returns C<undef> if the property isn't set.
+
+
+=head2 get_col_widths()
+
+The C<get_col_widths()> method returns an array_ref of column widths.
+
+ my $col_widths = $worksheet->get_col_widths();
+
+Returns C<undef> if the property isn't set.
+
+
+=head2 get_default_row_height()
+
+The C<get_default_row_height()> method returns the default row height for the worksheet. Generally 12.75.
+
+ my $default_row_height = $worksheet->get_default_row_height();
+
+
+=head2 get_default_col_width()
+
+The C<get_default_col_width()> method returns the default column width for the worksheet. Generally 8.43.
+
+ my $default_col_width = $worksheet->get_default_col_width();
+
+
+=head2 get_header()
+
+The C<get_header()> method returns the worksheet header string. This string can contain control codes for alignment and font properties. Refer to the Excel on-line help on headers and footers or to the Spreadsheet::WriteExcel documentation for set_header().
+
+ my $header = $worksheet->get_header();
+
+Returns C<undef> if the property isn't set.
+
+
+=head2 get_footer()
+
+The C<get_footer()> method returns the worksheet footer string. This string can contain control codes for alignment and font properties. Refer to the Excel on-line help on headers and footers or to the Spreadsheet::WriteExcel documentation for set_header().
+
+ my $footer = $worksheet->get_footer();
+
+Returns C<undef> if the property isn't set.
+
+
+=head2 get_margin_left()
+
+The C<get_margin_left()> method returns the left margin of the worksheet in inches.
+
+ my $margin_left = $worksheet->get_margin_left();
+
+Returns C<undef> if the property isn't set.
+
+
+=head2 get_margin_right()
+
+The C<get_margin_right()> method returns the right margin of the worksheet in inches.
+
+ my $margin_right = $worksheet->get_margin_right();
+
+Returns C<undef> if the property isn't set.
+
+
+=head2 get_margin_top()
+
+The C<get_margin_top()> method returns the top margin of the worksheet in inches.
+
+ my $margin_top = $worksheet->get_margin_top();
+
+Returns C<undef> if the property isn't set.
+
+
+=head2 get_margin_bottom()
+
+The C<get_margin_bottom()> method returns the bottom margin of the worksheet in inches.
+
+ my $margin_bottom = $worksheet->get_margin_bottom();
+
+Returns C<undef> if the property isn't set.
+
+
+=head2 get_margin_header()
+
+The C<get_margin_header()> method returns the header margin of the worksheet in inches.
+
+ my $margin_header = $worksheet->get_margin_header();
+
+Returns a default value of 0.5 if not set.
+
+
+=head2 get_margin_footer()
+
+The C<get_margin_footer()> method returns the footer margin of the worksheet in inches.
+
+ my $margin_footer = $worksheet->get_margin_footer();
+
+Returns a default value of 0.5 if not set.
+
+
+=head2 get_paper()
+
+The C<get_paper()> method returns the printer paper size.
+
+ my $paper = $worksheet->get_paper();
+
+The value corresponds to the formats shown below:
+
+ Index Paper format Paper size
+ ===== ============ ==========
+ 0 Printer default -
+ 1 Letter 8 1/2 x 11 in
+ 2 Letter Small 8 1/2 x 11 in
+ 3 Tabloid 11 x 17 in
+ 4 Ledger 17 x 11 in
+ 5 Legal 8 1/2 x 14 in
+ 6 Statement 5 1/2 x 8 1/2 in
+ 7 Executive 7 1/4 x 10 1/2 in
+ 8 A3 297 x 420 mm
+ 9 A4 210 x 297 mm
+ 10 A4 Small 210 x 297 mm
+ 11 A5 148 x 210 mm
+ 12 B4 250 x 354 mm
+ 13 B5 182 x 257 mm
+ 14 Folio 8 1/2 x 13 in
+ 15 Quarto 215 x 275 mm
+ 16 - 10x14 in
+ 17 - 11x17 in
+ 18 Note 8 1/2 x 11 in
+ 19 Envelope 9 3 7/8 x 8 7/8
+ 20 Envelope 10 4 1/8 x 9 1/2
+ 21 Envelope 11 4 1/2 x 10 3/8
+ 22 Envelope 12 4 3/4 x 11
+ 23 Envelope 14 5 x 11 1/2
+ 24 C size sheet -
+ 25 D size sheet -
+ 26 E size sheet -
+ 27 Envelope DL 110 x 220 mm
+ 28 Envelope C3 324 x 458 mm
+ 29 Envelope C4 229 x 324 mm
+ 30 Envelope C5 162 x 229 mm
+ 31 Envelope C6 114 x 162 mm
+ 32 Envelope C65 114 x 229 mm
+ 33 Envelope B4 250 x 353 mm
+ 34 Envelope B5 176 x 250 mm
+ 35 Envelope B6 176 x 125 mm
+ 36 Envelope 110 x 230 mm
+ 37 Monarch 3.875 x 7.5 in
+ 38 Envelope 3 5/8 x 6 1/2 in
+ 39 Fanfold 14 7/8 x 11 in
+ 40 German Std Fanfold 8 1/2 x 12 in
+ 41 German Legal Fanfold 8 1/2 x 13 in
+ 256 User defined
+
+The two most common paper sizes are C<1 = "US Letter"> and C<9 = A4>. Returns 9 by default.
+
+
+=head2 get_start_page()
+
+The C<get_start_page()> method returns the page number that printing will start from.
+
+ my $start_page = $worksheet->get_start_page();
+
+Returns 0 if the property isn't set.
+
+
+=head2 get_print_order()
+
+The C<get_print_order()> method returns 0 if the worksheet print "page order" is "Down then over" (the default) or 1 if it is "Over then down".
+
+ my $print_order = $worksheet->get_print_order();
+
+
+=head2 get_print_scale()
+
+The C<get_print_scale()> method returns the workbook scale for printing. The print scale fctor can be in the range 10 .. 400.
+
+ my $print_scale = $worksheet->get_print_scale();
+
+Returns 100 by default.
+
+
+=head2 get_fit_to_pages()
+
+The C<get_fit_to_pages()> method returns the number of pages wide and high that the printed worksheet page will fit to.
+
+ my ($pages_wide, $pages_high) = $worksheet->get_fit_to_pages();
+
+Returns (0, 0) if the property isn't set.
+
+
+=head2 is_portrait()
+
+The C<is_portrait()> method returns true if the worksheet has been set for printing in portrait mode.
+
+ my $is_portrait = $worksheet->is_portrait();
+
+Returns 0 if the worksheet has been set for printing in horizontal mode.
+
+
+=head2 is_centered_horizontally()
+
+The C<is_centered_horizontally()> method returns true if the worksheet has been centered horizontally for printing.
+
+ my $is_centered_horizontally = $worksheet->is_centered_horizontally();
+
+Returns 0 if the property isn't set.
+
+
+=head2 is_centered_vertically()
+
+The C<is_centered_vertically()> method returns true if the worksheet has been centered vertically for printing.
+
+ my $is_centered_vertically = $worksheet->is_centered_vertically();
+
+Returns 0 if the property isn't set.
+
+
+=head2 is_print_gridlines()
+
+The C<is_print_gridlines()> method returns true if the worksheet print "gridlines" option is turned on.
+
+ my $is_print_gridlines = $worksheet->is_print_gridlines();
+
+Returns 0 if the property isn't set.
+
+
+=head2 is_print_row_col_headers()
+
+The C<is_print_row_col_headers()> method returns true if the worksheet print "row and column headings" option is turned on.
+
+ my $is_print_row_col_headers = $worksheet->is_print_row_col_headers();
+
+Returns 0 if the property isn't set.
+
+
+=head2 is_print_black_and_white()
+
+The C<is_print_black_and_white()> method returns true if the worksheet print "black and white" option is turned on.
+
+ my $is_print_black_and_white = $worksheet->is_print_black_and_white();
+
+Returns 0 if the property isn't set.
+
+
+=head2 is_print_draft()
+
+The C<is_print_draft()> method returns true if the worksheet print "draft" option is turned on.
+
+ my $is_print_draft = $worksheet->is_print_draft();
+
+Returns 0 if the property isn't set.
+
+
+=head2 is_print_comments()
+
+The C<is_print_comments()> method returns true if the worksheet print "comments" option is turned on.
+
+ my $is_print_comments = $worksheet->is_print_comments();
+
+Returns 0 if the property isn't set.
+
+
+=head1 AUTHOR
+
+Maintainer 0.40+: John McNamara jmcnamara@cpan.org
+
+Maintainer 0.27-0.33: Gabor Szabo szabgab@cpan.org
+
+Original author: Kawai Takanori kwitknr@cpan.org
+
+=head1 COPYRIGHT
+
+Copyright (c) 2009-2010 John McNamara
+
+Copyright (c) 2006-2008 Gabor Szabo
+
+Copyright (c) 2000-2006 Kawai Takanori
+
+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.
+
+=cut