[Feature][Modem]Update MTK MODEM V1.6 baseline version: MOLY.NR15.R3.MD700.IVT.MP1MR3.MP.V1.6
MTK modem version: MT2735_IVT_MOLY.NR15.R3.MD700.IVT.MP1MR3.MP.V1.6.tar.gz
RF modem version: NA
Change-Id: I45a4c2752fa9d1a618beacd5d40737fb39ab64fb
diff --git a/mcu/tools/perl/Crypt/RC4.pm b/mcu/tools/perl/Crypt/RC4.pm
new file mode 100644
index 0000000..acd27a0
--- /dev/null
+++ b/mcu/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/mcu/tools/perl/Digest/Perl/MD5.pm b/mcu/tools/perl/Digest/Perl/MD5.pm
new file mode 100644
index 0000000..e81877c
--- /dev/null
+++ b/mcu/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/mcu/tools/perl/MIME/Lite.pm b/mcu/tools/perl/MIME/Lite.pm
new file mode 100644
index 0000000..bf67559
--- /dev/null
+++ b/mcu/tools/perl/MIME/Lite.pm
@@ -0,0 +1,3275 @@
+package MIME::Lite;
+
+
+=head1 NAME
+
+MIME::Lite - low-calorie MIME generator
+
+
+=head1 SYNOPSIS
+
+ use MIME::Lite;
+
+Create a single-part message:
+
+ ### Create a new single-part message, to send a GIF file:
+ $msg = MIME::Lite->new(
+ From =>'me@myhost.com',
+ To =>'you@yourhost.com',
+ Cc =>'some@other.com, some@more.com',
+ Subject =>'Helloooooo, nurse!',
+ Type =>'image/gif',
+ Encoding =>'base64',
+ Path =>'hellonurse.gif'
+ );
+
+Create a multipart message (i.e., one with attachments):
+
+ ### Create a new multipart message:
+ $msg = MIME::Lite->new(
+ From =>'me@myhost.com',
+ To =>'you@yourhost.com',
+ Cc =>'some@other.com, some@more.com',
+ Subject =>'A message with 2 parts...',
+ Type =>'multipart/mixed'
+ );
+
+ ### Add parts (each "attach" has same arguments as "new"):
+ $msg->attach(Type =>'TEXT',
+ Data =>"Here's the GIF file you wanted"
+ );
+ $msg->attach(Type =>'image/gif',
+ Path =>'aaa000123.gif',
+ Filename =>'logo.gif',
+ Disposition => 'attachment'
+ );
+
+Output a message:
+
+ ### Format as a string:
+ $str = $msg->as_string;
+
+ ### Print to a filehandle (say, a "sendmail" stream):
+ $msg->print(\*SENDMAIL);
+
+
+Send a message:
+
+ ### Send in the "best" way (the default is to use "sendmail"):
+ $msg->send;
+
+
+
+=head1 DESCRIPTION
+
+In the never-ending quest for great taste with fewer calories,
+we proudly present: I<MIME::Lite>.
+
+MIME::Lite is intended as a simple, standalone module for generating
+(not parsing!) MIME messages... specifically, it allows you to
+output a simple, decent single- or multi-part message with text or binary
+attachments. It does not require that you have the Mail:: or MIME::
+modules installed.
+
+You can specify each message part as either the literal data itself (in
+a scalar or array), or as a string which can be given to open() to get
+a readable filehandle (e.g., "<filename" or "somecommand|").
+
+You don't need to worry about encoding your message data:
+this module will do that for you. It handles the 5 standard MIME encodings.
+
+If you need more sophisticated behavior, please get the MIME-tools
+package instead. I will be more likely to add stuff to that toolkit
+over this one.
+
+
+=head1 EXAMPLES
+
+=head2 Create a simple message containing just text
+
+ $msg = MIME::Lite->new(
+ From =>'me@myhost.com',
+ To =>'you@yourhost.com',
+ Cc =>'some@other.com, some@more.com',
+ Subject =>'Helloooooo, nurse!',
+ Data =>"How's it goin', eh?"
+ );
+
+=head2 Create a simple message containing just an image
+
+ $msg = MIME::Lite->new(
+ From =>'me@myhost.com',
+ To =>'you@yourhost.com',
+ Cc =>'some@other.com, some@more.com',
+ Subject =>'Helloooooo, nurse!',
+ Type =>'image/gif',
+ Encoding =>'base64',
+ Path =>'hellonurse.gif'
+ );
+
+
+=head2 Create a multipart message
+
+ ### Create the multipart "container":
+ $msg = MIME::Lite->new(
+ From =>'me@myhost.com',
+ To =>'you@yourhost.com',
+ Cc =>'some@other.com, some@more.com',
+ Subject =>'A message with 2 parts...',
+ Type =>'multipart/mixed'
+ );
+
+ ### Add the text message part:
+ ### (Note that "attach" has same arguments as "new"):
+ $msg->attach(Type =>'TEXT',
+ Data =>"Here's the GIF file you wanted"
+ );
+
+ ### Add the image part:
+ $msg->attach(Type =>'image/gif',
+ Path =>'aaa000123.gif',
+ Filename =>'logo.gif',
+ Disposition => 'attachment'
+ );
+
+
+=head2 Attach a GIF to a text message
+
+This will create a multipart message exactly as above, but using the
+"attach to singlepart" hack:
+
+ ### Start with a simple text message:
+ $msg = MIME::Lite->new(
+ From =>'me@myhost.com',
+ To =>'you@yourhost.com',
+ Cc =>'some@other.com, some@more.com',
+ Subject =>'A message with 2 parts...',
+ Type =>'TEXT',
+ Data =>"Here's the GIF file you wanted"
+ );
+
+ ### Attach a part... the make the message a multipart automatically:
+ $msg->attach(Type =>'image/gif',
+ Path =>'aaa000123.gif',
+ Filename =>'logo.gif'
+ );
+
+
+=head2 Attach a pre-prepared part to a message
+
+ ### Create a standalone part:
+ $part = MIME::Lite->new(
+ Type =>'text/html',
+ Data =>'<H1>Hello</H1>',
+ );
+ $part->attr('content-type.charset' => 'UTF8');
+ $part->add('X-Comment' => 'A message for you');
+
+ ### Attach it to any message:
+ $msg->attach($part);
+
+
+=head2 Print a message to a filehandle
+
+ ### Write it to a filehandle:
+ $msg->print(\*STDOUT);
+
+ ### Write just the header:
+ $msg->print_header(\*STDOUT);
+
+ ### Write just the encoded body:
+ $msg->print_body(\*STDOUT);
+
+
+=head2 Print a message into a string
+
+ ### Get entire message as a string:
+ $str = $msg->as_string;
+
+ ### Get just the header:
+ $str = $msg->header_as_string;
+
+ ### Get just the encoded body:
+ $str = $msg->body_as_string;
+
+
+=head2 Send a message
+
+ ### Send in the "best" way (the default is to use "sendmail"):
+ $msg->send;
+
+
+=head2 Send an HTML document... with images included!
+
+ $msg = MIME::Lite->new(
+ To =>'you@yourhost.com',
+ Subject =>'HTML with in-line images!',
+ Type =>'multipart/related'
+ );
+ $msg->attach(Type => 'text/html',
+ Data => qq{ <body>
+ Here's <i>my</i> image:
+ <img src="cid:myimage.gif">
+ </body> }
+ );
+ $msg->attach(Type => 'image/gif',
+ Id => 'myimage.gif',
+ Path => '/path/to/somefile.gif',
+ );
+ $msg->send();
+
+
+=head2 Change how messages are sent
+
+ ### Do something like this in your 'main':
+ if ($I_DONT_HAVE_SENDMAIL) {
+ MIME::Lite->send('smtp', "smtp.myisp.net", Timeout=>60);
+ }
+
+ ### Now this will do the right thing:
+ $msg->send; ### will now use Net::SMTP as shown above
+
+
+
+
+
+
+=head1 PUBLIC INTERFACE
+
+=head2 Global configuration
+
+To alter the way the entire module behaves, you have the following
+methods/options:
+
+=over 4
+
+
+=item MIME::Lite->field_order()
+
+When used as a L<classmethod|/field_order>, this changes the default
+order in which headers are output for I<all> messages.
+However, please consider using the instance method variant instead,
+so you won't stomp on other message senders in the same application.
+
+
+=item MIME::Lite->quiet()
+
+This L<classmethod|/quiet> can be used to suppress/unsuppress
+all warnings coming from this module.
+
+
+=item MIME::Lite->send()
+
+When used as a L<classmethod|/send>, this can be used to specify
+a different default mechanism for sending message.
+The initial default is:
+
+ MIME::Lite->send("sendmail", "/usr/lib/sendmail -t -oi -oem");
+
+However, you should consider the similar but smarter and taint-safe variant:
+
+ MIME::Lite->send("sendmail");
+
+Or, for non-Unix users:
+
+ MIME::Lite->send("smtp");
+
+
+=item $MIME::Lite::AUTO_CC
+
+If true, automatically send to the Cc/Bcc addresses for send_by_smtp().
+Default is B<true>.
+
+
+=item $MIME::Lite::AUTO_CONTENT_TYPE
+
+If true, try to automatically choose the content type from the file name
+in C<new()>/C<build()>. In other words, setting this true changes the
+default C<Type> from C<"TEXT"> to C<"AUTO">.
+
+Default is B<false>, since we must maintain backwards-compatibility
+with prior behavior. B<Please> consider keeping it false,
+and just using Type 'AUTO' when you build() or attach().
+
+
+=item $MIME::Lite::AUTO_ENCODE
+
+If true, automatically choose the encoding from the content type.
+Default is B<true>.
+
+
+=item $MIME::Lite::AUTO_VERIFY
+
+If true, check paths to attachments right before printing, raising an exception
+if any path is unreadable.
+Default is B<true>.
+
+
+=item $MIME::Lite::PARANOID
+
+If true, we won't attempt to use MIME::Base64, MIME::QuotedPrint,
+or MIME::Types, even if they're available.
+Default is B<false>. Please consider keeping it false,
+and trusting these other packages to do the right thing.
+
+
+=back
+
+=cut
+
+require 5.004; ### for /c modifier in m/\G.../gc modifier
+
+use Carp ();
+use FileHandle;
+
+use strict;
+use vars qw(
+ $AUTO_CC
+ $AUTO_CONTENT_TYPE
+ $AUTO_ENCODE
+ $AUTO_VERIFY
+ $PARANOID
+ $QUIET
+ $VANILLA
+ $VERSION
+ );
+
+
+
+#==============================
+#==============================
+#
+# GLOBALS, EXTERNAL/CONFIGURATION...
+$VERSION = "3.01";
+
+### Automatically interpret CC/BCC for SMTP:
+$AUTO_CC = 1;
+
+### Automatically choose content type from file name:
+$AUTO_CONTENT_TYPE = 0;
+
+### Automatically choose encoding from content type:
+$AUTO_ENCODE = 1;
+
+### Check paths right before printing:
+$AUTO_VERIFY = 1;
+
+### Set this true if you don't want to use MIME::Base64/QuotedPrint/Types:
+$PARANOID = 0;
+
+### Don't warn me about dangerous activities:
+$QUIET = undef;
+
+### Unsupported (for tester use): don't qualify boundary with time/pid:
+$VANILLA = 0;
+
+
+#==============================
+#==============================
+#
+# GLOBALS, INTERNAL...
+
+### Find sendmail:
+my $SENDMAIL = "/usr/lib/sendmail";
+(-x $SENDMAIL) or ($SENDMAIL = "/usr/sbin/sendmail");
+(-x $SENDMAIL) or ($SENDMAIL = "sendmail");
+
+### Our sending facilities:
+my $Sender = "sendmail";
+my %SenderArgs = (
+ "sendmail" => ["$SENDMAIL -t -oi -oem"],
+ "smtp" => [],
+ "sub" => [],
+);
+
+### Boundary counter:
+my $BCount = 0;
+
+### Known Mail/MIME fields... these, plus some general forms like
+### "x-*", are recognized by build():
+my %KnownField = map {$_=>1}
+qw(
+ bcc cc comments date encrypted
+ from keywords message-id mime-version organization
+ received references reply-to return-path sender
+ subject to
+
+ approved
+ );
+
+### What external packages do we use for encoding?
+my @Uses;
+
+### Header order:
+my @FieldOrder;
+
+### See if we have File::Basename
+my $HaveFileBasename = 0;
+if (eval "require File::Basename") { # not affected by $PARANOID, core Perl
+ $HaveFileBasename = 1;
+ push @Uses, "F$File::Basename::VERSION";
+}
+
+### See if we have/want MIME::Types
+my $HaveMimeTypes=0;
+if (!$PARANOID and eval "require MIME::Types; MIME::Types->VERSION(1.004);") {
+ $HaveMimeTypes = 1;
+ push @Uses, "T$MIME::Types::VERSION";
+}
+#==============================
+#==============================
+#
+# PRIVATE UTILITY FUNCTIONS...
+
+#------------------------------
+#
+# fold STRING
+#
+# Make STRING safe as a field value. Remove leading/trailing whitespace,
+# and make sure newlines are represented as newline+space
+
+sub fold {
+ my $str = shift;
+ $str =~ s/^\s*|\s*$//g; ### trim
+ $str =~ s/\n/\n /g;
+ $str;
+}
+
+#------------------------------
+#
+# gen_boundary
+#
+# Generate a new boundary to use.
+# The unsupported $VANILLA is for test purposes only.
+
+sub gen_boundary {
+ return ("_----------=_".($VANILLA ? '' : int(time).$$).$BCount++);
+}
+
+#------------------------------
+#
+# known_field FIELDNAME
+#
+# Is this a recognized Mail/MIME field?
+
+sub known_field {
+ my $field = lc(shift);
+ $KnownField{$field} or ($field =~ m{^(content|resent|x)-.});
+}
+
+#------------------------------
+#
+# is_mime_field FIELDNAME
+#
+# Is this a field I manage?
+
+sub is_mime_field {
+ $_[0] =~ /^(mime\-|content\-)/i;
+}
+
+#------------------------------
+#
+# extract_addrs STRING
+#
+# Split STRING into an array of email addresses: somewhat of a KLUDGE.
+#
+# Unless paranoid, we try to load the real code before supplying our own.
+
+my $ATOM = '[^ \000-\037()<>@,;:\134"\056\133\135]+';
+my $QSTR = '".*?"';
+my $WORD = '(?:' . $QSTR . '|' . $ATOM . ')';
+my $DOMAIN = '(?:' . $ATOM . '(?:' . '\\.' . $ATOM . ')*' . ')';
+my $LOCALPART = '(?:' . $WORD . '(?:' . '\\.' . $WORD . ')*' . ')';
+my $ADDR = '(?:' . $LOCALPART . '@' . $DOMAIN . ')';
+my $PHRASE = '(?:' . $WORD . ')+';
+my $SEP = "(?:^\\s*|\\s*,\\s*)"; ### before elems in a list
+
+sub my_extract_addrs {
+ my $str = shift;
+ my @addrs;
+ $str =~ s/\s/ /g; ### collapse whitespace
+
+ pos($str) = 0;
+ while ($str !~ m{\G\s*\Z}gco) {
+ ### print STDERR "TACKLING: ".substr($str, pos($str))."\n";
+ if ($str =~ m{\G$SEP$PHRASE\s*<\s*($ADDR)\s*>}gco) {push @addrs,$1}
+ elsif ($str =~ m{\G$SEP($ADDR)}gco) {push @addrs,$1}
+ elsif ($str =~ m{\G$SEP($ATOM)}gco) {push @addrs,$1}
+ else {
+ my $problem = substr($str, pos($str));
+ die "can't extract address at <$problem> in <$str>\n";
+ }
+ }
+ return @addrs;
+}
+
+if (eval "require Mail::Address") {
+ push @Uses, "A$Mail::Address::VERSION";
+ eval q{
+ sub extract_addrs {
+ return map { $_->format } Mail::Address->parse($_[0]);
+ }
+ }; ### q
+}
+else {
+ eval q{
+ sub extract_addrs {
+ return my_extract_addrs(@_);
+ }
+ }; ### q
+} ### if
+
+
+
+#==============================
+#==============================
+#
+# PRIVATE ENCODING FUNCTIONS...
+
+#------------------------------
+#
+# encode_base64 STRING
+#
+# Encode the given string using BASE64.
+# Unless paranoid, we try to load the real code before supplying our own.
+
+if (!$PARANOID and eval "require MIME::Base64") {
+ import MIME::Base64 qw(encode_base64);
+ push @Uses, "B$MIME::Base64::VERSION";
+}
+else {
+ eval q{
+sub encode_base64 {
+ my $res = "";
+ my $eol = "\n";
+
+ pos($_[0]) = 0; ### thanks, Andreas!
+ while ($_[0] =~ /(.{1,45})/gs) {
+ $res .= substr(pack('u', $1), 1);
+ chop($res);
+ }
+ $res =~ tr|` -_|AA-Za-z0-9+/|;
+
+ ### Fix padding at the end:
+ my $padding = (3 - length($_[0]) % 3) % 3;
+ $res =~ s/.{$padding}$/'=' x $padding/e if $padding;
+
+ ### Break encoded string into lines of no more than 76 characters each:
+ $res =~ s/(.{1,76})/$1$eol/g if (length $eol);
+ return $res;
+} ### sub
+ } ### q
+} ### if
+
+#------------------------------
+#
+# encode_qp STRING
+#
+# Encode the given string, LINE BY LINE, using QUOTED-PRINTABLE.
+# Stolen from MIME::QuotedPrint by Gisle Aas, with a slight bug fix: we
+# break lines earlier. Notice that this seems not to work unless
+# encoding line by line.
+#
+# Unless paranoid, we try to load the real code before supplying our own.
+
+if (!$PARANOID and eval "require MIME::QuotedPrint") {
+ import MIME::QuotedPrint qw(encode_qp);
+ push @Uses, "Q$MIME::QuotedPrint::VERSION";
+}
+else {
+ eval q{
+sub encode_qp {
+ my $res = shift;
+ local($_);
+ $res =~ s/([^ \t\n!-<>-~])/sprintf("=%02X", ord($1))/eg; ### rule #2,#3
+ $res =~ s/([ \t]+)$/
+ join('', map { sprintf("=%02X", ord($_)) }
+ split('', $1)
+ )/egm; ### rule #3 (encode whitespace at eol)
+
+ ### rule #5 (lines shorter than 76 chars, but can't break =XX escapes:
+ my $brokenlines = "";
+ $brokenlines .= "$1=\n" while $res =~ s/^(.{70}([^=]{2})?)//; ### 70 was 74
+ $brokenlines =~ s/=\n$// unless length $res;
+ "$brokenlines$res";
+} ### sub
+ } ### q
+} ### if
+
+
+#------------------------------
+#
+# encode_8bit STRING
+#
+# Encode the given string using 8BIT.
+# This breaks long lines into shorter ones.
+
+sub encode_8bit {
+ my $str = shift;
+ $str =~ s/^(.{990})/$1\n/mg;
+ $str;
+}
+
+#------------------------------
+#
+# encode_7bit STRING
+#
+# Encode the given string using 7BIT.
+# This NO LONGER protects people through encoding.
+
+sub encode_7bit {
+ my $str = shift;
+ $str =~ s/[\x80-\xFF]//g;
+ $str =~ s/^(.{990})/$1\n/mg;
+ $str;
+}
+
+#==============================
+#==============================
+
+=head2 Construction
+
+=over 4
+
+=cut
+
+
+#------------------------------
+
+=item new [PARAMHASH]
+
+I<Class method, constructor.>
+Create a new message object.
+
+If any arguments are given, they are passed into C<build()>; otherwise,
+just the empty object is created.
+
+=cut
+
+sub new {
+ my $class = shift;
+
+ ### Create basic object:
+ my $self = {
+ Attrs => {}, ### MIME attributes
+ Header => [], ### explicit message headers
+ Parts => [], ### array of parts
+ };
+ bless $self, $class;
+
+ ### Build, if needed:
+ return (@_ ? $self->build(@_) : $self);
+}
+
+
+#------------------------------
+
+=item attach PART
+
+=item attach PARAMHASH...
+
+I<Instance method.>
+Add a new part to this message, and return the new part.
+
+If you supply a single PART argument, it will be regarded
+as a MIME::Lite object to be attached. Otherwise, this
+method assumes that you are giving in the pairs of a PARAMHASH
+which will be sent into C<new()> to create the new part.
+
+One of the possibly-quite-useful hacks thrown into this is the
+"attach-to-singlepart" hack: if you attempt to attach a part (let's
+call it "part 1") to a message that doesn't have a content-type
+of "multipart" or "message", the following happens:
+
+=over 4
+
+=item *
+
+A new part (call it "part 0") is made.
+
+=item *
+
+The MIME attributes and data (but I<not> the other headers)
+are cut from the "self" message, and pasted into "part 0".
+
+=item *
+
+The "self" is turned into a "multipart/mixed" message.
+
+=item *
+
+The new "part 0" is added to the "self", and I<then> "part 1" is added.
+
+=back
+
+One of the nice side-effects is that you can create a text message
+and then add zero or more attachments to it, much in the same way
+that a user agent like Netscape allows you to do.
+
+=cut
+
+sub attach {
+ my $self = shift;
+
+ ### Create new part, if necessary:
+ my $part1 = ((@_ == 1) ? shift : ref($self)->new(Top=>0, @_));
+
+ ### Do the "attach-to-singlepart" hack:
+ if ($self->attr('content-type') !~ m{^(multipart|message)/}i) {
+
+ ### Create part zero:
+ my $part0 = ref($self)->new;
+
+ ### Cut MIME stuff from self, and paste into part zero:
+ foreach (qw(Attrs Data Path FH)) {
+ $part0->{$_} = $self->{$_}; delete($self->{$_});
+ }
+ $part0->top_level(0); ### clear top-level attributes
+
+ ### Make self a top-level multipart:
+ $self->{Attrs} ||= {}; ### reset
+ $self->attr('content-type' => 'multipart/mixed');
+ $self->attr('content-type.boundary' => gen_boundary());
+ $self->attr('content-transfer-encoding' => '7bit');
+ $self->top_level(1); ### activate top-level attributes
+
+ ### Add part 0:
+ push @{$self->{Parts}}, $part0;
+ }
+
+ ### Add the new part:
+ push @{$self->{Parts}}, $part1;
+ $part1;
+}
+
+#------------------------------
+
+=item build [PARAMHASH]
+
+I<Class/instance method, initializer.>
+Create (or initialize) a MIME message object.
+Normally, you'll use the following keys in PARAMHASH:
+
+ * Data, FH, or Path (either one of these, or none if multipart)
+ * Type (e.g., "image/jpeg")
+ * From, To, and Subject (if this is the "top level" of a message)
+
+The PARAMHASH can contain the following keys:
+
+=over 4
+
+=item (fieldname)
+
+Any field you want placed in the message header, taken from the
+standard list of header fields (you don't need to worry about case):
+
+ Approved Encrypted Received Sender
+ Bcc From References Subject
+ Cc Keywords Reply-To To
+ Comments Message-ID Resent-* X-*
+ Content-* MIME-Version Return-Path
+ Date Organization
+
+To give experienced users some veto power, these fields will be set
+I<after> the ones I set... so be careful: I<don't set any MIME fields>
+(like C<Content-type>) unless you know what you're doing!
+
+To specify a fieldname that's I<not> in the above list, even one that's
+identical to an option below, just give it with a trailing C<":">,
+like C<"My-field:">. When in doubt, that I<always> signals a mail
+field (and it sort of looks like one too).
+
+=item Data
+
+I<Alternative to "Path" or "FH".>
+The actual message data. This may be a scalar or a ref to an array of
+strings; if the latter, the message consists of a simple concatenation
+of all the strings in the array.
+
+=item Datestamp
+
+I<Optional.>
+If given true (or omitted), we force the creation of a C<Date:> field
+stamped with the current date/time if this is a top-level message.
+You may want this if using L<send_by_smtp()|/send_by_smtp>.
+If you don't want this to be done, either provide your own Date
+or explicitly set this to false.
+
+=item Disposition
+
+I<Optional.>
+The content disposition, C<"inline"> or C<"attachment">.
+The default is C<"inline">.
+
+=item Encoding
+
+I<Optional.>
+The content transfer encoding that should be used to encode your data:
+
+ Use encoding: | If your message contains:
+ ------------------------------------------------------------
+ 7bit | Only 7-bit text, all lines <1000 characters
+ 8bit | 8-bit text, all lines <1000 characters
+ quoted-printable | 8-bit text or long lines (more reliable than "8bit")
+ base64 | Largely non-textual data: a GIF, a tar file, etc.
+
+The default is taken from the Type; generally it is "binary" (no
+encoding) for text/*, message/*, and multipart/*, and "base64" for
+everything else. A value of C<"binary"> is generally I<not> suitable
+for sending anything but ASCII text files with lines under 1000
+characters, so consider using one of the other values instead.
+
+In the case of "7bit"/"8bit", long lines are automatically chopped to
+legal length; in the case of "7bit", all 8-bit characters are
+automatically I<removed>. This may not be what you want, so pick your
+encoding well! For more info, see L<"A MIME PRIMER">.
+
+=item FH
+
+I<Alternative to "Data" or "Path".>
+Filehandle containing the data, opened for reading.
+See "ReadNow" also.
+
+=item Filename
+
+I<Optional.>
+The name of the attachment. You can use this to supply a
+recommended filename for the end-user who is saving the attachment
+to disk. You only need this if the filename at the end of the
+"Path" is inadequate, or if you're using "Data" instead of "Path".
+You should I<not> put path information in here (e.g., no "/"
+or "\" or ":" characters should be used).
+
+=item Id
+
+I<Optional.>
+Same as setting "content-id".
+
+=item Length
+
+I<Optional.>
+Set the content length explicitly. Normally, this header is automatically
+computed, but only under certain circumstances (see L<"Limitations">).
+
+=item Path
+
+I<Alternative to "Data" or "FH".>
+Path to a file containing the data... actually, it can be any open()able
+expression. If it looks like a path, the last element will automatically
+be treated as the filename.
+See "ReadNow" also.
+
+=item ReadNow
+
+I<Optional, for use with "Path".>
+If true, will open the path and slurp the contents into core now.
+This is useful if the Path points to a command and you don't want
+to run the command over and over if outputting the message several
+times. B<Fatal exception> raised if the open fails.
+
+=item Top
+
+I<Optional.>
+If defined, indicates whether or not this is a "top-level" MIME message.
+The parts of a multipart message are I<not> top-level.
+Default is true.
+
+=item Type
+
+I<Optional.>
+The MIME content type, or one of these special values (case-sensitive):
+
+ "TEXT" means "text/plain"
+ "BINARY" means "application/octet-stream"
+ "AUTO" means attempt to guess from the filename, falling back
+ to 'application/octet-stream'. This is good if you have
+ MIME::Types on your system and you have no idea what
+ file might be used for the attachment.
+
+The default is C<"TEXT">, but it will be C<"AUTO"> if you set
+$AUTO_CONTENT_TYPE to true (sorry, but you have to enable
+it explicitly, since we don't want to break code which depends
+on the old behavior).
+
+=back
+
+A picture being worth 1000 words (which
+is of course 2000 bytes, so it's probably more of an "icon" than a "picture",
+but I digress...), here are some examples:
+
+ $msg = MIME::Lite->build(
+ From => 'yelling@inter.com',
+ To => 'stocking@fish.net',
+ Subject => "Hi there!",
+ Type => 'TEXT',
+ Encoding => '7bit',
+ Data => "Just a quick note to say hi!");
+
+ $msg = MIME::Lite->build(
+ From => 'dorothy@emerald-city.oz',
+ To => 'gesundheit@edu.edu.edu',
+ Subject => "A gif for U"
+ Type => 'image/gif',
+ Path => "/home/httpd/logo.gif");
+
+ $msg = MIME::Lite->build(
+ From => 'laughing@all.of.us',
+ To => 'scarlett@fiddle.dee.de',
+ Subject => "A gzipp'ed tar file",
+ Type => 'x-gzip',
+ Path => "gzip < /usr/inc/somefile.tar |",
+ ReadNow => 1,
+ Filename => "somefile.tgz");
+
+To show you what's really going on, that last example could also
+have been written:
+
+ $msg = new MIME::Lite;
+ $msg->build(Type => 'x-gzip',
+ Path => "gzip < /usr/inc/somefile.tar |",
+ ReadNow => 1,
+ Filename => "somefile.tgz");
+ $msg->add(From => "laughing@all.of.us");
+ $msg->add(To => "scarlett@fiddle.dee.de");
+ $msg->add(Subject => "A gzipp'ed tar file");
+
+=cut
+
+sub build {
+ my $self = shift;
+ my %params = @_;
+ my @params = @_;
+ my $key;
+
+ ### Miko's note: reorganized to check for exactly one of Data, Path, or FH
+ (defined($params{Data})+defined($params{Path})+defined($params{FH}) <= 1)
+ or Carp::croak "supply exactly zero or one of (Data|Path|FH).\n";
+
+ ### Create new instance, if necessary:
+ ref($self) or $self = $self->new;
+
+
+ ### CONTENT-TYPE....
+ ###
+
+ ### Get content-type or content-type-macro:
+ my $type = ($params{Type} || ($AUTO_CONTENT_TYPE ? 'AUTO' : 'TEXT'));
+
+ ### Interpret content-type-macros:
+ if ($type eq 'TEXT') { $type = 'text/plain'; }
+ elsif ($type eq 'BINARY') { $type = 'application/octet-stream' }
+ elsif ($type eq 'AUTO') { $type = $self->suggest_type($params{Path}); }
+
+ ### We now have a content-type; set it:
+ $type = lc($type);
+ $self->attr('content-type' => $type);
+
+ ### Get some basic attributes from the content type:
+ my $is_multipart = ($type =~ m{^(multipart)/}i);
+
+ ### Add in the multipart boundary:
+ if ($is_multipart) {
+ my $boundary = gen_boundary();
+ $self->attr('content-type.boundary' => $boundary);
+ }
+
+
+ ### CONTENT-ID...
+ ###
+ $self->attr('content-id' => $params{Id}) if defined($params{Id});
+
+
+ ### DATA OR PATH...
+ ### Note that we must do this *after* we get the content type,
+ ### in case read_now() is invoked, since it needs the binmode().
+
+ ### Get data, as...
+ ### ...either literal data:
+ if (defined($params{Data})) {
+ $self->data($params{Data});
+ }
+ ### ...or a path to data:
+ elsif (defined($params{Path})) {
+ $self->path($params{Path}); ### also sets filename
+ $self->read_now if $params{ReadNow};
+ }
+ ### ...or a filehandle to data:
+ ### Miko's note: this part works much like the path routine just above,
+ elsif (defined($params{FH})) {
+ $self->fh($params{FH});
+ $self->read_now if $params{ReadNow}; ### implement later
+ }
+
+
+ ### FILENAME... (added by Ian Smith <ian@safeway.dircon.co.uk> on 8/4/97)
+ ### Need this to make sure the filename is added. The Filename
+ ### attribute is ignored, otherwise.
+ if (defined($params{Filename})) {
+ $self->filename($params{Filename});
+ }
+
+
+ ### CONTENT-TRANSFER-ENCODING...
+ ###
+
+ ### Get it:
+ my $enc = ($params{Encoding} ||
+ ($AUTO_ENCODE and $self->suggest_encoding($type)) ||
+ 'binary');
+ $self->attr('content-transfer-encoding' => lc($enc));
+
+ ### Sanity check:
+ if ($type =~ m{^(multipart|message)/}) {
+ ($enc =~ m{^(7bit|8bit|binary)\Z}) or
+ Carp::croak("illegal MIME: ".
+ "can't have encoding $enc with type $type\n");
+ }
+
+ ### CONTENT-DISPOSITION...
+ ### Default is inline for single, none for multis:
+ ###
+ my $disp = ($params{Disposition} or ($is_multipart ? undef : 'inline'));
+ $self->attr('content-disposition' => $disp);
+
+ ### CONTENT-LENGTH...
+ ###
+ my $length;
+ if (exists($params{Length})) { ### given by caller:
+ $self->attr('content-length' => $params{Length});
+ }
+ else { ### compute it ourselves
+ $self->get_length;
+ }
+
+ ### Init the top-level fields:
+ my $is_top = defined($params{Top}) ? $params{Top} : 1;
+ $self->top_level($is_top);
+
+ ### Datestamp if desired:
+ my $ds_wanted = $params{Datestamp};
+ my $ds_defaulted = ($is_top and !exists($params{Datestamp}));
+ if (($ds_wanted or $ds_defaulted) and !exists($params{Date})) {
+ my ($u_wdy, $u_mon, $u_mdy, $u_time, $u_y4) =
+ split /\s+/, gmtime().""; ### should be non-locale-dependent
+ my $date = "$u_wdy, $u_mdy $u_mon $u_y4 $u_time UT";
+ $self->add("date", $date);
+ }
+
+ ### Set message headers:
+ my @paramz = @params;
+ my $field;
+ while (@paramz) {
+ my ($tag, $value) = (shift(@paramz), shift(@paramz));
+
+ ### Get tag, if a tag:
+ if ($tag =~ /^-(.*)/) { ### old style, backwards-compatibility
+ $field = lc($1);
+ }
+ elsif ($tag =~ /^(.*):$/) { ### new style
+ $field = lc($1);
+ }
+ elsif (known_field($field = lc($tag))) { ### known field
+ ### no-op
+ }
+ else { ### not a field:
+ next;
+ }
+
+ ### Add it:
+ $self->add($field, $value);
+ }
+
+ ### Done!
+ $self;
+}
+
+=back
+
+=cut
+
+
+#==============================
+#==============================
+
+=head2 Setting/getting headers and attributes
+
+=over 4
+
+=cut
+
+#------------------------------
+#
+# top_level ONOFF
+#
+# Set/unset the top-level attributes and headers.
+# This affects "MIME-Version" and "X-Mailer".
+
+sub top_level {
+ my ($self, $onoff) = @_;
+ if ($onoff) {
+ $self->attr('MIME-Version' => '1.0');
+ my $uses = (@Uses ? ("(" . join("; ", @Uses) . ")") : '');
+ $self->replace('X-Mailer' => "MIME::Lite $VERSION $uses")
+ unless $VANILLA;
+ }
+ else {
+ $self->attr('MIME-Version' => undef);
+ $self->delete('X-Mailer');
+ }
+}
+
+#------------------------------
+
+=item add TAG,VALUE
+
+I<Instance method.>
+Add field TAG with the given VALUE to the end of the header.
+The TAG will be converted to all-lowercase, and the VALUE
+will be made "safe" (returns will be given a trailing space).
+
+B<Beware:> any MIME fields you "add" will override any MIME
+attributes I have when it comes time to output those fields.
+Normally, you will use this method to add I<non-MIME> fields:
+
+ $msg->add("Subject" => "Hi there!");
+
+Giving VALUE as an arrayref will cause all those values to be added.
+This is only useful for special multiple-valued fields like "Received":
+
+ $msg->add("Received" => ["here", "there", "everywhere"]
+
+Giving VALUE as the empty string adds an invisible placeholder
+to the header, which can be used to suppress the output of
+the "Content-*" fields or the special "MIME-Version" field.
+When suppressing fields, you should use replace() instead of add():
+
+ $msg->replace("Content-disposition" => "");
+
+I<Note:> add() is probably going to be more efficient than C<replace()>,
+so you're better off using it for most applications if you are
+certain that you don't need to delete() the field first.
+
+I<Note:> the name comes from Mail::Header.
+
+=cut
+
+sub add {
+ my $self = shift;
+ my $tag = lc(shift);
+ my $value = shift;
+
+ ### If a dangerous option, warn them:
+ Carp::carp "Explicitly setting a MIME header field ($tag) is dangerous:\n".
+ "use the attr() method instead.\n"
+ if (is_mime_field($tag) && !$QUIET);
+
+ ### Get array of clean values:
+ my @vals = ((ref($value) and (ref($value) eq 'ARRAY'))
+ ? @{$value}
+ : ($value.''));
+ map { s/\n/\n /g } @vals;
+
+ ### Add them:
+ foreach (@vals) {
+ push @{$self->{Header}}, [$tag, $_];
+ }
+}
+
+#------------------------------
+
+=item attr ATTR,[VALUE]
+
+I<Instance method.>
+Set MIME attribute ATTR to the string VALUE.
+ATTR is converted to all-lowercase.
+This method is normally used to set/get MIME attributes:
+
+ $msg->attr("content-type" => "text/html");
+ $msg->attr("content-type.charset" => "US-ASCII");
+ $msg->attr("content-type.name" => "homepage.html");
+
+This would cause the final output to look something like this:
+
+ Content-type: text/html; charset=US-ASCII; name="homepage.html"
+
+Note that the special empty sub-field tag indicates the anonymous
+first sub-field.
+
+Giving VALUE as undefined will cause the contents of the named
+subfield to be deleted.
+
+Supplying no VALUE argument just returns the attribute's value:
+
+ $type = $msg->attr("content-type"); ### returns "text/html"
+ $name = $msg->attr("content-type.name"); ### returns "homepage.html"
+
+=cut
+
+sub attr {
+ my ($self, $attr, $value) = @_;
+ $attr = lc($attr);
+
+ ### Break attribute name up:
+ my ($tag, $subtag) = split /\./, $attr;
+ defined($subtag) or $subtag = '';
+
+ ### Set or get?
+ if (@_ > 2) { ### set:
+ $self->{Attrs}{$tag} ||= {}; ### force hash
+ delete $self->{Attrs}{$tag}{$subtag}; ### delete first
+ if (defined($value)) { ### set...
+ $value =~ s/[\r\n]//g; ### make clean
+ $self->{Attrs}{$tag}{$subtag} = $value;
+ }
+ }
+
+ ### Return current value:
+ $self->{Attrs}{$tag}{$subtag};
+}
+
+sub _safe_attr {
+ my ($self, $attr) = @_;
+ my $v = $self->attr($attr);
+ defined($v) ? $v : '';
+}
+
+#------------------------------
+
+=item delete TAG
+
+I<Instance method.>
+Delete field TAG with the given VALUE to the end of the header.
+The TAG will be converted to all-lowercase.
+
+ $msg->delete("Subject");
+
+I<Note:> the name comes from Mail::Header.
+
+=cut
+
+sub delete {
+ my $self = shift;
+ my $tag = lc(shift);
+
+ ### Delete from the header:
+ my $hdr = [];
+ my $field;
+ foreach $field (@{$self->{Header}}) {
+ push @$hdr, $field if ($field->[0] ne $tag);
+ }
+ $self->{Header} = $hdr;
+ $self;
+}
+
+
+#------------------------------
+
+=item field_order FIELD,...FIELD
+
+I<Class/instance method.>
+Change the order in which header fields are output for this object:
+
+ $msg->field_order('from', 'to', 'content-type', 'subject');
+
+When used as a class method, changes the default settings for
+all objects:
+
+ MIME::Lite->field_order('from', 'to', 'content-type', 'subject');
+
+Case does not matter: all field names will be coerced to lowercase.
+In either case, supply the empty array to restore the default ordering.
+
+=cut
+
+sub field_order {
+ my $self = shift;
+ if (ref($self)) { $self->{FieldOrder} = [ map { lc($_) } @_ ] }
+ else { @FieldOrder = map { lc($_) } @_ }
+}
+
+#------------------------------
+
+=item fields
+
+I<Instance method.>
+Return the full header for the object, as a ref to an array
+of C<[TAG, VALUE]> pairs, where each TAG is all-lowercase.
+Note that any fields the user has explicitly set will override the
+corresponding MIME fields that we would otherwise generate.
+So, don't say...
+
+ $msg->set("Content-type" => "text/html; charset=US-ASCII");
+
+unless you want the above value to override the "Content-type"
+MIME field that we would normally generate.
+
+I<Note:> I called this "fields" because the header() method of
+Mail::Header returns something different, but similar enough to
+be confusing.
+
+You can change the order of the fields: see L</field_order>.
+You really shouldn't need to do this, but some people have to
+deal with broken mailers.
+
+=cut
+
+sub fields {
+ my $self = shift;
+ my @fields;
+
+ ### Get a lookup-hash of all *explicitly-given* fields:
+ my %explicit = map { $_->[0] => 1 } @{$self->{Header}};
+
+ ### Start with any MIME attributes not given explicitly:
+ my $tag;
+ foreach $tag (sort keys %{$self->{Attrs}}) {
+
+ ### Skip if explicit:
+ next if ($explicit{$tag});
+
+ ### Skip if no subtags:
+ my @subtags = keys %{$self->{Attrs}{$tag}};
+ @subtags or next;
+
+ ### Create string:
+ my $value;
+ defined($value = $self->{Attrs}{$tag}{''}) or next; ### need default
+ foreach (sort @subtags) {
+ next if ($_ eq '');
+ $value .= qq{; $_="$self->{Attrs}{$tag}{$_}"};
+ }
+
+ ### Add to running fields;
+ push @fields, [$tag, $value];
+ }
+
+ ### Add remaining fields (note that we duplicate the array for safety):
+ foreach (@{$self->{Header}}) {
+ push @fields, [@{$_}];
+ }
+
+ ### Final step:
+ ### If a suggested ordering was given, we "sort" by that ordering.
+ ### The idea is that we give each field a numeric rank, which is
+ ### (1000 * order(field)) + origposition.
+ my @order = @{$self->{FieldOrder} || []}; ### object-specific
+ @order or @order = @FieldOrder; ### no? maybe generic
+ if (@order) { ### either?
+
+ ### Create hash mapping field names to 1-based rank:
+ my %rank = map {$order[$_] => (1+$_)} (0..$#order);
+
+ ### Create parallel array to @fields, called @ranked.
+ ### It contains fields tagged with numbers like 2003, where the
+ ### 3 is the original 0-based position, and 2000 indicates that
+ ### we wanted ths type of field to go second.
+ my @ranked = map {
+ [
+ ($_ + 1000*($rank{lc($fields[$_][0])} || (2+$#order))),
+ $fields[$_]
+ ]
+ } (0..$#fields);
+ # foreach (@ranked) {
+ # print STDERR "RANKED: $_->[0] $_->[1][0] $_->[1][1]\n";
+ # }
+
+ ### That was half the Schwartzian transform. Here's the rest:
+ @fields = map { $_->[1] }
+ sort { $a->[0] <=> $b->[0] }
+ @ranked;
+ }
+
+ ### Done!
+ return \@fields;
+}
+
+
+#------------------------------
+
+=item filename [FILENAME]
+
+I<Instance method.>
+Set the filename which this data will be reported as.
+This actually sets both "standard" attributes.
+
+With no argument, returns the filename as dictated by the
+content-disposition.
+
+=cut
+
+sub filename {
+ my ($self, $filename) = @_;
+ if (@_ > 1) {
+ $self->attr('content-type.name' => $filename);
+ $self->attr('content-disposition.filename' => $filename);
+ }
+ $self->attr('content-disposition.filename');
+}
+
+#------------------------------
+
+=item get TAG,[INDEX]
+
+I<Instance method.>
+Get the contents of field TAG, which might have been set
+with set() or replace(). Returns the text of the field.
+
+ $ml->get('Subject', 0);
+
+If the optional 0-based INDEX is given, then we return the INDEX'th
+occurence of field TAG. Otherwise, we look at the context:
+In a scalar context, only the first (0th) occurence of the
+field is returned; in an array context, I<all> occurences are returned.
+
+I<Warning:> this should only be used with non-MIME fields.
+Behavior with MIME fields is TBD, and will raise an exception for now.
+
+=cut
+
+sub get {
+ my ($self, $tag, $index) = @_;
+ $tag = lc($tag);
+ Carp::croak "get: can't be used with MIME fields\n" if is_mime_field($tag);
+
+ my @all = map { ($_->[0] eq $tag) ? $_->[1] : ()} @{$self->{Header}};
+ (defined($index) ? $all[$index] : (wantarray ? @all : $all[0]));
+}
+
+#------------------------------
+
+=item get_length
+
+I<Instance method.>
+Recompute the content length for the message I<if the process is trivial>,
+setting the "content-length" attribute as a side-effect:
+
+ $msg->get_length;
+
+Returns the length, or undefined if not set.
+
+I<Note:> the content length can be difficult to compute, since it
+involves assembling the entire encoded body and taking the length
+of it (which, in the case of multipart messages, means freezing
+all the sub-parts, etc.).
+
+This method only sets the content length to a defined value if the
+message is a singlepart with C<"binary"> encoding, I<and> the body is
+available either in-core or as a simple file. Otherwise, the content
+length is set to the undefined value.
+
+Since content-length is not a standard MIME field anyway (that's right, kids:
+it's not in the MIME RFCs, it's an HTTP thing), this seems pretty fair.
+
+=cut
+
+#----
+# Miko's note: I wasn't quite sure how to handle this, so I waited to hear
+# what you think. Given that the content-length isn't always required,
+# and given the performance cost of calculating it from a file handle,
+# I thought it might make more sense to add some some sort of computelength
+# property. If computelength is false, then the length simply isn't
+# computed. What do you think?
+#
+# Eryq's reply: I agree; for now, we can silently leave out the content-type.
+
+sub get_length {
+ my $self = shift;
+
+ my $is_multipart = ($self->attr('content-type') =~ m{^multipart/}i);
+ my $enc = lc($self->attr('content-transfer-encoding') || 'binary');
+ my $length;
+ if (!$is_multipart && ($enc eq "binary")){ ### might figure it out cheap:
+ if (defined($self->{Data})) { ### it's in core
+ $length = length($self->{Data});
+ }
+ elsif (defined($self->{FH})) { ### it's in a filehandle
+ ### no-op: it's expensive, so don't bother
+ }
+ elsif (defined($self->{Path})) { ### it's a simple file!
+ $length = (-s $self->{Path}) if (-e $self->{Path});
+ }
+ }
+ $self->attr('content-length' => $length);
+ return $length;
+}
+
+#------------------------------
+
+=item parts
+
+I<Instance method.>
+Return the parts of this entity, and this entity only.
+Returns empty array if this entity has no parts.
+
+This is B<not> recursive! Parts can have sub-parts; use
+parts_DFS() to get everything.
+
+=cut
+
+sub parts {
+ my $self = shift;
+ @{$self->{Parts} || []};
+}
+
+#------------------------------
+
+=item parts_DFS
+
+I<Instance method.>
+Return the list of all MIME::Lite objects included in the entity,
+starting with the entity itself, in depth-first-search order.
+If this object has no parts, it alone will be returned.
+
+=cut
+
+sub parts_DFS {
+ my $self = shift;
+ return ($self, map { $_->parts_DFS } $self->parts);
+}
+
+#------------------------------
+
+=item preamble [TEXT]
+
+I<Instance method.>
+Get/set the preamble string, assuming that this object has subparts.
+Set it to undef for the default string.
+
+=cut
+
+sub preamble {
+ my $self = shift;
+ $self->{Preamble} = shift if @_;
+ $self->{Preamble};
+}
+
+#------------------------------
+
+=item replace TAG,VALUE
+
+I<Instance method.>
+Delete all occurences of fields named TAG, and add a new
+field with the given VALUE. TAG is converted to all-lowercase.
+
+B<Beware> the special MIME fields (MIME-version, Content-*):
+if you "replace" a MIME field, the replacement text will override
+the I<actual> MIME attributes when it comes time to output that field.
+So normally you use attr() to change MIME fields and add()/replace() to
+change I<non-MIME> fields:
+
+ $msg->replace("Subject" => "Hi there!");
+
+Giving VALUE as the I<empty string> will effectively I<prevent> that
+field from being output. This is the correct way to suppress
+the special MIME fields:
+
+ $msg->replace("Content-disposition" => "");
+
+Giving VALUE as I<undefined> will just cause all explicit values
+for TAG to be deleted, without having any new values added.
+
+I<Note:> the name of this method comes from Mail::Header.
+
+=cut
+
+sub replace {
+ my ($self, $tag, $value) = @_;
+ $self->delete($tag);
+ $self->add($tag, $value) if defined($value);
+}
+
+
+#------------------------------
+
+=item scrub
+
+I<Instance method.>
+B<This is Alpha code. If you use it, please let me know how it goes.>
+Recursively goes through the "parts" tree of this message and tries
+to find MIME attributes that can be removed.
+With an array argument, removes exactly those attributes; e.g.:
+
+ $msg->scrub(['content-disposition', 'content-length']);
+
+Is the same as recursively doing:
+
+ $msg->replace('Content-disposition' => '');
+ $msg->replace('Content-length' => '');
+
+=cut
+
+sub scrub {
+ my ($self, @a) = @_;
+ my ($expl) = @a;
+ local $QUIET = 1;
+
+ ### Scrub me:
+ if (!@a) { ### guess
+
+ ### Scrub length always:
+ $self->replace('content-length', '');
+
+ ### Scrub disposition if no filename, or if content-type has same info:
+ if (!$self->_safe_attr('content-disposition.filename') ||
+ $self->_safe_attr('content-type.name')) {
+ $self->replace('content-disposition', '');
+ }
+
+ ### Scrub encoding if effectively unencoded:
+ if ($self->_safe_attr('content-transfer-encoding') =~
+ /^(7bit|8bit|binary)$/i) {
+ $self->replace('content-transfer-encoding', '');
+ }
+
+ ### Scrub charset if US-ASCII:
+ if ($self->_safe_attr('content-type.charset') =~ /^(us-ascii)/i) {
+ $self->attr('content-type.charset' => undef);
+ }
+
+ ### TBD: this is not really right for message/digest:
+ if ((keys %{$self->{Attrs}{'content-type'}} == 1) and
+ ($self->_safe_attr('content-type') eq 'text/plain')) {
+ $self->replace('content-type', '');
+ }
+ }
+ elsif ($expl and (ref($expl) eq 'ARRAY')) {
+ foreach (@{$expl}) { $self->replace($_, ''); }
+ }
+
+ ### Scrub my kids:
+ foreach (@{$self->{Parts}}) { $_->scrub(@a); }
+}
+
+=back
+
+=cut
+
+
+#==============================
+#==============================
+
+=head2 Setting/getting message data
+
+=over 4
+
+=cut
+
+#------------------------------
+
+=item binmode [OVERRIDE]
+
+I<Instance method.>
+With no argument, returns whether or not it thinks that the data
+(as given by the "Path" argument of C<build()>) should be read using
+binmode() (for example, when C<read_now()> is invoked).
+
+The default behavior is that any content type other than
+C<text/*> or C<message/*> is binmode'd; this should in general work fine.
+
+With a defined argument, this method sets an explicit "override"
+value. An undefined argument unsets the override.
+The new current value is returned.
+
+=cut
+
+sub binmode {
+ my $self = shift;
+ $self->{Binmode} = shift if (@_); ### argument? set override
+ return (defined($self->{Binmode})
+ ? $self->{Binmode}
+ : ($self->attr("content-type") !~ m{^(text|message)/}i));
+}
+
+#------------------------------
+
+=item data [DATA]
+
+I<Instance method.>
+Get/set the literal DATA of the message. The DATA may be
+either a scalar, or a reference to an array of scalars (which
+will simply be joined).
+
+I<Warning:> setting the data causes the "content-length" attribute
+to be recomputed (possibly to nothing).
+
+=cut
+
+sub data {
+ my $self = shift;
+ if (@_) {
+ $self->{Data} = ((ref($_[0]) eq 'ARRAY') ? join('', @{$_[0]}) : $_[0]);
+ $self->get_length;
+ }
+ $self->{Data};
+}
+
+#------------------------------
+
+=item fh [FILEHANDLE]
+
+I<Instance method.>
+Get/set the FILEHANDLE which contains the message data.
+
+Takes a filehandle as an input and stores it in the object.
+This routine is similar to path(); one important difference is that
+no attempt is made to set the content length.
+
+=cut
+
+sub fh {
+ my $self = shift;
+ $self->{FH} = shift if @_;
+ $self->{FH};
+}
+
+#------------------------------
+
+=item path [PATH]
+
+I<Instance method.>
+Get/set the PATH to the message data.
+
+I<Warning:> setting the path recomputes any existing "content-length" field,
+and re-sets the "filename" (to the last element of the path if it
+looks like a simple path, and to nothing if not).
+
+=cut
+
+sub path {
+ my $self = shift;
+ if (@_) {
+
+ ### Set the path, and invalidate the content length:
+ $self->{Path} = shift;
+
+ ### Re-set filename, extracting it from path if possible:
+ my $filename;
+ if ($self->{Path} and ($self->{Path} !~ /\|$/)) { ### non-shell path:
+ ($filename = $self->{Path}) =~ s/^<//;
+
+ ### Consult File::Basename, maybe:
+ if ($HaveFileBasename) {
+ $filename = File::Basename::basename($filename);
+ }
+ else {
+ ($filename) = ($filename =~ m{([^\/]+)\Z});
+ }
+ }
+ $self->filename($filename);
+
+ ### Reset the length:
+ $self->get_length;
+ }
+ $self->{Path};
+}
+
+#------------------------------
+
+=item resetfh [FILEHANDLE]
+
+I<Instance method.>
+Set the current position of the filehandle back to the beginning.
+Only applies if you used "FH" in build() or attach() for this message.
+
+Returns false if unable to reset the filehandle (since not all filehandles
+are seekable).
+
+=cut
+
+#----
+# Miko's note: With the Data and Path, the same data could theoretically
+# be reused. However, file handles need to be reset to be reused,
+# so I added this routine.
+#
+# Eryq reply: beware... not all filehandles are seekable (think about STDIN)!
+
+sub resetfh {
+ my $self = shift;
+ seek($self->{FH},0,0);
+}
+
+#------------------------------
+
+=item read_now
+
+I<Instance method.>
+Forces data from the path/filehandle (as specified by C<build()>)
+to be read into core immediately, just as though you had given it
+literally with the C<Data> keyword.
+
+Note that the in-core data will always be used if available.
+
+Be aware that everything is slurped into a giant scalar: you may not want
+to use this if sending tar files! The benefit of I<not> reading in the data
+is that very large files can be handled by this module if left on disk
+until the message is output via C<print()> or C<print_body()>.
+
+=cut
+
+sub read_now {
+ my $self = shift;
+ local $/ = undef;
+
+ if ($self->{FH}) { ### data from a filehandle:
+ my $chunk;
+ my @chunks;
+ CORE::binmode($self->{FH}) if $self->binmode;
+ while (read($self->{FH}, $chunk, 1024)) {
+ push @chunks, $chunk;
+ }
+ $self->{Data} = join '', @chunks;
+ }
+ elsif ($self->{Path}) { ### data from a path:
+ open SLURP, $self->{Path} or Carp::croak "open $self->{Path}: $!\n";
+ CORE::binmode(SLURP) if $self->binmode;
+ $self->{Data} = <SLURP>; ### sssssssssssssslurp...
+ close SLURP; ### ...aaaaaaaaahhh!
+ }
+}
+
+#------------------------------
+
+=item sign PARAMHASH
+
+I<Instance method.>
+Sign the message. This forces the message to be read into core,
+after which the signature is appended to it.
+
+=over 4
+
+=item Data
+
+As in C<build()>: the literal signature data.
+Can be either a scalar or a ref to an array of scalars.
+
+=item Path
+
+As in C<build()>: the path to the file.
+
+=back
+
+If no arguments are given, the default is:
+
+ Path => "$ENV{HOME}/.signature"
+
+The content-length is recomputed.
+
+=cut
+
+sub sign {
+ my $self = shift;
+ my %params = @_;
+
+ ### Default:
+ @_ or $params{Path} = "$ENV{HOME}/.signature";
+
+ ### Force message in-core:
+ defined($self->{Data}) or $self->read_now;
+
+ ### Load signature:
+ my $sig;
+ if (!defined($sig = $params{Data})) { ### not given explicitly:
+ local $/ = undef;
+ open SIG, $params{Path} or Carp::croak "open sig $params{Path}: $!\n";
+ $sig = <SIG>; ### sssssssssssssslurp...
+ close SIG; ### ...aaaaaaaaahhh!
+ }
+ $sig = join('',@$sig) if (ref($sig) and (ref($sig) eq 'ARRAY'));
+
+ ### Append, following Internet conventions:
+ $self->{Data} .= "\n-- \n$sig";
+
+ ### Re-compute length:
+ $self->get_length;
+ 1;
+}
+
+#------------------------------
+#
+# =item suggest_encoding CONTENTTYPE
+#
+# I<Class/instance method.>
+# Based on the CONTENTTYPE, return a good suggested encoding.
+# C<text> and C<message> types have their bodies scanned line-by-line
+# for 8-bit characters and long lines; lack of either means that the
+# message is 7bit-ok. Other types are chosen independent of their body:
+#
+# Major type: 7bit ok? Suggested encoding:
+# ------------------------------------------------------------
+# text yes 7bit
+# no quoted-printable
+# unknown binary
+#
+# message yes 7bit
+# no binary
+# unknown binary
+#
+# multipart n/a binary (in case some parts are not ok)
+#
+# (other) n/a base64
+#
+#=cut
+
+sub suggest_encoding {
+ my ($self, $ctype) = @_;
+ $ctype = lc($ctype);
+
+ ### Consult MIME::Types, maybe:
+ if ($HaveMimeTypes) {
+
+ ### Mappings contain [suffix,mimetype,encoding]
+ my @mappings = MIME::Types::by_mediatype($ctype);
+ if (scalar(@mappings)) {
+ ### Just pick the first one:
+ my ($suffix, $mimetype, $encoding) = @{$mappings[0]};
+ if ($encoding &&
+ $encoding =~/^(base64|binary|[78]bit|quoted-printable)$/i) {
+ return lc($encoding); ### sanity check
+ }
+ }
+ }
+
+ ### If we got here, then MIME::Types was no help.
+ ### Extract major type:
+ my ($type) = split '/', $ctype;
+ if (($type eq 'text') || ($type eq 'message')) { ### scan message body?
+ return 'binary';
+ }
+ else {
+ return ($type eq 'multipart') ? 'binary' : 'base64';
+ }
+}
+
+#------------------------------
+#
+# =item suggest_type PATH
+#
+# I<Class/instance method.>
+# Suggest the content-type for this attached path.
+# We always fall back to "application/octet-stream" if no good guess
+# can be made, so don't use this if you don't mean it!
+#
+sub suggest_type {
+ my ($self, $path) = @_;
+
+ ### If there's no path, bail:
+ $path or return 'application/octet-stream';
+
+ ### Consult MIME::Types, maybe:
+ if ($HaveMimeTypes) {
+ # Mappings contain [mimetype,encoding]:
+ my ($mimetype, $encoding) = MIME::Types::by_suffix($path);
+ return $mimetype if ($mimetype && $mimetype =~ /^\S+\/\S+$/); ### sanity check
+ }
+ ### If we got here, then MIME::Types was no help.
+ ### The correct thing to fall back to is the most-generic content type:
+ return 'application/octet-stream';
+}
+
+#------------------------------
+
+=item verify_data
+
+I<Instance method.>
+Verify that all "paths" to attached data exist, recursively.
+It might be a good idea for you to do this before a print(), to
+prevent accidental partial output if a file might be missing.
+Raises exception if any path is not readable.
+
+=cut
+
+sub verify_data {
+ my $self = shift;
+
+ ### Verify self:
+ my $path = $self->{Path};
+ if ($path and ($path !~ /\|$/)) { ### non-shell path:
+ $path =~ s/^<//;
+ (-r $path) or die "$path: not readable\n";
+ }
+
+ ### Verify parts:
+ foreach my $part (@{$self->{Parts}}) { $part->verify_data }
+ 1;
+}
+
+=back
+
+=cut
+
+
+#==============================
+#==============================
+
+=head2 Output
+
+=over 4
+
+=cut
+
+#------------------------------
+
+=item print [OUTHANDLE]
+
+I<Instance method.>
+Print the message to the given output handle, or to the currently-selected
+filehandle if none was given.
+
+All OUTHANDLE has to be is a filehandle (possibly a glob ref), or
+any object that responds to a print() message.
+
+=cut
+
+sub print {
+ my ($self, $out) = @_;
+
+ ### Coerce into a printable output handle:
+ $out = wrap MIME::Lite::IO_Handle $out;
+
+ ### Output head, separator, and body:
+ $self->verify_data if $AUTO_VERIFY; ### prevents missing parts!
+ $out->print($self->header_as_string, "\n");
+ $self->print_body($out);
+}
+
+#------------------------------
+#
+# print_for_smtp
+#
+# Instance method, private.
+# Print, but filter out the topmost "Bcc" field.
+# This is because qmail apparently doesn't do this for us!
+#
+sub print_for_smtp {
+ my ($self, $out) = @_;
+
+ ### Coerce into a printable output handle:
+ $out = wrap MIME::Lite::IO_Handle $out;
+
+ ### Create a safe head:
+ my @fields = grep { $_->[0] ne 'bcc' } @{$self->fields};
+ my $header = $self->fields_as_string(\@fields);
+
+ ### Output head, separator, and body:
+ $out->print($header, "\n");
+ $self->print_body($out);
+}
+
+#------------------------------
+
+=item print_body [OUTHANDLE]
+
+I<Instance method.>
+Print the body of a message to the given output handle, or to
+the currently-selected filehandle if none was given.
+
+All OUTHANDLE has to be is a filehandle (possibly a glob ref), or
+any object that responds to a print() message.
+
+B<Fatal exception> raised if unable to open any of the input files,
+or if a part contains no data, or if an unsupported encoding is
+encountered.
+
+=cut
+
+sub print_body {
+ my ($self, $out) = @_;
+
+ ### Coerce into a printable output handle:
+ $out = wrap MIME::Lite::IO_Handle $out;
+
+ ### Output either the body or the parts.
+ ### Notice that we key off of the content-type! We expect fewer
+ ### accidents that way, since the syntax will always match the MIME type.
+ my $type = $self->attr('content-type');
+ if ($type =~ m{^multipart/}i) {
+ my $boundary = $self->attr('content-type.boundary');
+
+ ### Preamble:
+ $out->print(defined($self->{Preamble})
+ ? $self->{Preamble}
+ : "This is a multi-part message in MIME format.\n");
+
+ ### Parts:
+ my $part;
+ foreach $part (@{$self->{Parts}}) {
+ $out->print("\n--$boundary\n");
+ $part->print($out);
+ }
+
+ ### Epilogue:
+ $out->print("\n--$boundary--\n\n");
+ }
+ elsif ($type =~ m{^message/}) {
+ my @parts = @{$self->{Parts}};
+
+ ### It's a toss-up; try both data and parts:
+ if (@parts == 0) { $self->print_simple_body($out) }
+ elsif (@parts == 1) { $parts[0]->print($out) }
+ else { Carp::croak "can't handle message with >1 part\n"; }
+ }
+ else {
+ $self->print_simple_body($out);
+ }
+ 1;
+}
+
+#------------------------------
+#
+# print_simple_body [OUTHANDLE]
+#
+# I<Instance method, private.>
+# Print the body of a simple singlepart message to the given
+# output handle, or to the currently-selected filehandle if none
+# was given.
+#
+# Note that if you want to print "the portion after
+# the header", you don't want this method: you want
+# L<print_body()|/print_body>.
+#
+# All OUTHANDLE has to be is a filehandle (possibly a glob ref), or
+# any object that responds to a print() message.
+#
+# B<Fatal exception> raised if unable to open any of the input files,
+# or if a part contains no data, or if an unsupported encoding is
+# encountered.
+#
+sub print_simple_body {
+ my ($self, $out) = @_;
+
+ ### Coerce into a printable output handle:
+ $out = wrap MIME::Lite::IO_Handle $out;
+
+ ### Get content-transfer-encoding:
+ my $encoding = uc($self->attr('content-transfer-encoding'));
+
+ ### Notice that we don't just attempt to slurp the data in from a file:
+ ### by processing files piecemeal, we still enable ourselves to prepare
+ ### very large MIME messages...
+
+ ### Is the data in-core? If so, blit it out...
+ if (defined($self->{Data})) {
+ DATA:
+ { local $_ = $encoding;
+
+ /^BINARY$/ and do {
+ $out->print($self->{Data});
+ last DATA;
+ };
+ /^8BIT$/ and do {
+ $out->print(encode_8bit($self->{Data}));
+ last DATA;
+ };
+ /^7BIT$/ and do {
+ $out->print(encode_7bit($self->{Data}));
+ last DATA;
+ };
+ /^QUOTED-PRINTABLE$/ and do {
+ ### UNTAINT since m//mg on tainted data loops forever:
+ my ($untainted) = ($self->{Data} =~ m/\A(.*)\Z/s);
+
+ ### Encode it line by line:
+ while ($untainted =~ m{^(.*[\r\n]*)}mg) {
+ $out->print(encode_qp($1)); ### have to do it line by line...
+ }
+ last DATA;
+ };
+ /^BASE64/ and do {
+ $out->print(encode_base64($self->{Data}));
+ last DATA;
+ };
+ Carp::croak "unsupported encoding: `$_'\n";
+ }
+ }
+
+ ### Else, is the data in a file? If so, output piecemeal...
+ ### Miko's note: this routine pretty much works the same with a path
+ ### or a filehandle. the only difference in behaviour is that it does
+ ### not attempt to open anything if it already has a filehandle
+ elsif (defined($self->{Path}) || defined($self->{FH})) {
+ no strict 'refs'; ### in case FH is not an object
+ my $DATA;
+
+ ### Open file if necessary:
+ if (defined($self->{Path})) {
+ $DATA = new FileHandle || Carp::croak "can't get new filehandle\n";
+ $DATA->open("$self->{Path}") or
+ Carp::croak "open $self->{Path}: $!\n";
+ }
+ else {
+ $DATA=$self->{FH};
+ }
+ CORE::binmode($DATA) if $self->binmode;
+
+ ### Encode piece by piece:
+ PATH:
+ { local $_ = $encoding;
+
+ /^BINARY$/ and do {
+ $out->print($_) while read($DATA, $_, 2048);
+ last PATH;
+ };
+ /^8BIT$/ and do {
+ $out->print(encode_8bit($_)) while (<$DATA>);
+ last PATH;
+ };
+ /^7BIT$/ and do {
+ $out->print(encode_7bit($_)) while (<$DATA>);
+ last PATH;
+ };
+ /^QUOTED-PRINTABLE$/ and do {
+ $out->print(encode_qp($_)) while (<$DATA>);
+ last PATH;
+ };
+ /^BASE64$/ and do {
+ $out->print(encode_base64($_)) while (read($DATA, $_, 45));
+ last PATH;
+ };
+ Carp::croak "unsupported encoding: `$_'\n";
+ }
+
+ ### Close file:
+ close $DATA if defined($self->{Path});
+ }
+
+ else {
+ Carp::croak "no data in this part\n";
+ }
+ 1;
+}
+
+#------------------------------
+
+=item print_header [OUTHANDLE]
+
+I<Instance method.>
+Print the header of the message to the given output handle,
+or to the currently-selected filehandle if none was given.
+
+All OUTHANDLE has to be is a filehandle (possibly a glob ref), or
+any object that responds to a print() message.
+
+=cut
+
+sub print_header {
+ my ($self, $out) = @_;
+
+ ### Coerce into a printable output handle:
+ $out = wrap MIME::Lite::IO_Handle $out;
+
+ ### Output the header:
+ $out->print($self->header_as_string);
+ 1;
+}
+
+#------------------------------
+
+=item as_string
+
+I<Instance method.>
+Return the entire message as a string, with a header and an encoded body.
+
+=cut
+
+sub as_string {
+ my $self = shift;
+ my $buf = [];
+ my $io = (wrap MIME::Lite::IO_ScalarArray $buf);
+ $self->print($io);
+ join '', @$buf;
+}
+*stringify = \&as_string; ### backwards compatibility
+*stringify = \&as_string; ### ...twice to avoid warnings :)
+
+#------------------------------
+
+=item body_as_string
+
+I<Instance method.>
+Return the encoded body as a string.
+This is the portion after the header and the blank line.
+
+I<Note:> actually prepares the body by "printing" to a scalar.
+Proof that you can hand the C<print*()> methods any blessed object
+that responds to a C<print()> message.
+
+=cut
+
+sub body_as_string {
+ my $self = shift;
+ my $buf = [];
+ my $io = (wrap MIME::Lite::IO_ScalarArray $buf);
+ $self->print_body($io);
+ join '', @$buf;
+}
+*stringify_body = \&body_as_string; ### backwards compatibility
+*stringify_body = \&body_as_string; ### ...twice to avoid warnings :)
+
+#------------------------------
+#
+# fields_as_string FIELDS
+#
+# PRIVATE! Return a stringified version of the given header
+# fields, where FIELDS is an arrayref like that returned by fields().
+#
+sub fields_as_string {
+ my ($self, $fields) = @_;
+ my @lines;
+ foreach (@$fields) {
+ my ($tag, $value) = @$_;
+ next if ($value eq ''); ### skip empties
+ $tag =~ s/\b([a-z])/uc($1)/ge; ### make pretty
+ $tag =~ s/^mime-/MIME-/ig; ### even prettier
+ push @lines, "$tag: $value\n";
+ }
+ join '', @lines;
+}
+
+#------------------------------
+
+=item header_as_string
+
+I<Instance method.>
+Return the header as a string.
+
+=cut
+
+sub header_as_string {
+ my $self = shift;
+ $self->fields_as_string($self->fields);
+}
+*stringify_header = \&header_as_string; ### backwards compatibility
+*stringify_header = \&header_as_string; ### ...twice to avoid warnings :)
+
+=back
+
+=cut
+
+
+
+#==============================
+#==============================
+
+=head2 Sending
+
+=over 4
+
+=cut
+
+#------------------------------
+
+=item send
+
+=item send HOW, HOWARGS...
+
+I<Class/instance method.>
+This is the principal method for sending mail, and for configuring
+how mail will be sent.
+
+I<As a class method> with a HOW argument and optional HOWARGS, it sets
+the default sending mechanism that the no-argument instance method
+will use. The HOW is a facility name (B<see below>),
+and the HOWARGS is interpreted by the facilty.
+The class method returns the previous HOW and HOWARGS as an array.
+
+ MIME::Lite->send('sendmail', "d:\\programs\\sendmail.exe");
+ ...
+ $msg = MIME::Lite->new(...);
+ $msg->send;
+
+I<As an instance method with arguments>
+(a HOW argument and optional HOWARGS), sends the message in the
+requested manner; e.g.:
+
+ $msg->send('sendmail', "d:\\programs\\sendmail.exe");
+
+I<As an instance method with no arguments,> sends the message by
+the default mechanism set up by the class method.
+Returns whatever the mail-handling routine returns: this should be true
+on success, false/exception on error:
+
+ $msg = MIME::Lite->new(From=>...);
+ $msg->send || die "you DON'T have mail!";
+
+On Unix systems (at least), the default setting is equivalent to:
+
+ MIME::Lite->send("sendmail", "/usr/lib/sendmail -t -oi -oem");
+
+There are three facilities:
+
+=over 4
+
+=item "sendmail", ARGS...
+
+Send a message by piping it into the "sendmail" command.
+Uses the L<send_by_sendmail()|/send_by_sendmail> method, giving it the ARGS.
+This usage implements (and deprecates) the C<sendmail()> method.
+
+=item "smtp", [HOSTNAME]
+
+Send a message by SMTP, using optional HOSTNAME as SMTP-sending host.
+Uses the L<send_by_smtp()|/send_by_smtp> method.
+
+=item "sub", \&SUBREF, ARGS...
+
+Sends a message MSG by invoking the subroutine SUBREF of your choosing,
+with MSG as the first argument, and ARGS following.
+
+=back
+
+I<For example:> let's say you're on an OS which lacks the usual Unix
+"sendmail" facility, but you've installed something a lot like it, and
+you need to configure your Perl script to use this "sendmail.exe" program.
+Do this following in your script's setup:
+
+ MIME::Lite->send('sendmail', "d:\\programs\\sendmail.exe");
+
+Then, whenever you need to send a message $msg, just say:
+
+ $msg->send;
+
+That's it. Now, if you ever move your script to a Unix box, all you
+need to do is change that line in the setup and you're done.
+All of your $msg-E<gt>send invocations will work as expected.
+
+=cut
+
+sub send {
+ my $self = shift;
+
+ if (ref($self)) { ### instance method:
+ my ($method, @args);
+ if (@_) { ### args; use them just this once
+ $method = 'send_by_' . shift;
+ @args = @_;
+ }
+ else { ### no args; use defaults
+ $method = "send_by_$Sender";
+ @args = @{$SenderArgs{$Sender} || []};
+ }
+ $self->verify_data if $AUTO_VERIFY; ### prevents missing parts!
+ return $self->$method(@args);
+ }
+ else { ### class method:
+ if (@_) {
+ my @old = ($Sender, @{$SenderArgs{$Sender}});
+ $Sender = shift;
+ $SenderArgs{$Sender} = [@_]; ### remaining args
+ return @old;
+ }
+ else {
+ Carp::croak "class method send must have HOW... arguments\n";
+ }
+ }
+}
+
+#------------------------------
+
+=item send_by_sendmail SENDMAILCMD
+
+=item send_by_sendmail PARAM=>VALUE, ...
+
+I<Instance method.>
+Send message via an external "sendmail" program
+(this will probably only work out-of-the-box on Unix systems).
+
+Returns true on success, false or exception on error.
+
+You can specify the program and all its arguments by giving a single
+string, SENDMAILCMD. Nothing fancy is done; the message is simply
+piped in.
+
+However, if your needs are a little more advanced, you can specify
+zero or more of the following PARAM/VALUE pairs; a Unix-style,
+taint-safe "sendmail" command will be constructed for you:
+
+=over 4
+
+=item Sendmail
+
+Full path to the program to use.
+Default is "/usr/lib/sendmail".
+
+=item BaseArgs
+
+Ref to the basic array of arguments we start with.
+Default is C<["-t", "-oi", "-oem"]>.
+
+=item SetSender
+
+Unless this is I<explicitly> given as false, we attempt to automatically
+set the C<-f> argument to the first address that can be extracted from
+the "From:" field of the message (if there is one).
+
+I<What is the -f, and why do we use it?>
+Suppose we did I<not> use C<-f>, and you gave an explicit "From:"
+field in your message: in this case, the sendmail "envelope" would
+indicate the I<real> user your process was running under, as a way
+of preventing mail forgery. Using the C<-f> switch causes the sender
+to be set in the envelope as well.
+
+I<So when would I NOT want to use it?>
+If sendmail doesn't regard you as a "trusted" user, it will permit
+the C<-f> but also add an "X-Authentication-Warning" header to the message
+to indicate a forged envelope. To avoid this, you can either
+(1) have SetSender be false, or
+(2) make yourself a trusted user by adding a C<T> configuration
+ command to your I<sendmail.cf> file
+ (e.g.: C<Teryq> if the script is running as user "eryq").
+
+=item FromSender
+
+If defined, this is identical to setting SetSender to true,
+except that instead of looking at the "From:" field we use
+the address given by this option.
+Thus:
+
+ FromSender => 'me@myhost.com'
+
+=back
+
+=cut
+
+sub send_by_sendmail {
+ my $self = shift;
+
+ if (@_ == 1) { ### Use the given command...
+ my $sendmailcmd = shift @_;
+
+ ### Do it:
+ open SENDMAIL, "|$sendmailcmd" or Carp::croak "open |$sendmailcmd: $!\n";
+ $self->print(\*SENDMAIL);
+ close SENDMAIL;
+ return (($? >> 8) ? undef : 1);
+ }
+ else { ### Build the command...
+ my %p = @_;
+ $p{Sendmail} ||= "/usr/lib/sendmail";
+
+ ### Start with the command and basic args:
+ my @cmd = ($p{Sendmail}, @{$p{BaseArgs} || ['-t', '-oi', '-oem']});
+
+ ### See if we are forcibly setting the sender:
+ $p{SetSender} = 1 if defined($p{FromSender});
+
+ ### Add the -f argument, unless we're explicitly told NOT to:
+ unless (exists($p{SetSender}) and !$p{SetSender}) {
+ my $from = $p{FromSender} || ($self->get('From'))[0];
+ if ($from) {
+ my ($from_addr) = extract_addrs($from);
+ push @cmd, "-f$from_addr" if $from_addr;
+ }
+ }
+
+ ### Open the command in a taint-safe fashion:
+ my $pid = open SENDMAIL, "|-";
+ defined($pid) or die "open of pipe failed: $!\n";
+ if (!$pid) { ### child
+ exec(@cmd) or die "can't exec $p{Sendmail}: $!\n";
+ ### NOTREACHED
+ }
+ else { ### parent
+ $self->print(\*SENDMAIL);
+ close SENDMAIL || die "error closing $p{Sendmail}: $! (exit $?)\n";
+ return 1;
+ }
+ }
+}
+
+#------------------------------
+
+=item send_by_smtp ARGS...
+
+I<Instance method.>
+Send message via SMTP, using Net::SMTP.
+The optional ARGS are sent into Net::SMTP::new(): usually, these are
+
+ MAILHOST, OPTION=>VALUE, ...
+
+Note that the list of recipients is taken from the
+"To", "Cc" and "Bcc" fields.
+
+Returns true on success, false or exception on error.
+
+=cut
+
+### Provided by Andrew McRae. Version 0.2 anm 09Sep97
+### Copyright 1997 Optimation New Zealand Ltd.
+### May be modified/redistributed under the same terms as Perl.
+#
+sub send_by_smtp {
+ my ($self, @args) = @_;
+
+ ### We need the "From:" and "To:" headers to pass to the SMTP mailer:
+ my $hdr = $self->fields();
+ my $from = $self->get('From');
+ my $to = $self->get('To');
+
+ ### Sanity check:
+ defined($to) or Carp::croak "send_by_smtp: missing 'To:' address\n";
+
+ ### Get the destinations as a simple array of addresses:
+ my @to_all = extract_addrs($to);
+ if ($AUTO_CC) {
+ foreach my $field (qw(Cc Bcc)) {
+ my $value = $self->get($field);
+ push @to_all, extract_addrs($value) if defined($value);
+ }
+ }
+
+ ### Create SMTP client:
+ require Net::SMTP;
+ my $smtp = MIME::Lite::SMTP->new(@args)
+ or Carp::croak("Failed to connect to mail server: $!\n");
+ $smtp->mail($from)
+ or Carp::croak("SMTP MAIL command failed: $!\n".$smtp->message."\n");
+ $smtp->to(@to_all)
+ or Carp::croak("SMTP RCPT command failed: $!\n".$smtp->message."\n");
+ $smtp->data()
+ or Carp::croak("SMTP DATA command failed: $!\n".$smtp->message."\n");
+
+ ### MIME::Lite can print() to anything with a print() method:
+ $self->print_for_smtp($smtp);
+ $smtp->dataend();
+ $smtp->quit;
+ 1;
+}
+
+#------------------------------
+#
+# send_by_sub [\&SUBREF, [ARGS...]]
+#
+# I<Instance method, private.>
+# Send the message via an anonymous subroutine.
+#
+sub send_by_sub {
+ my ($self, $subref, @args) = @_;
+ &$subref($self, @args);
+}
+
+#------------------------------
+
+=item sendmail COMMAND...
+
+I<Class method, DEPRECATED.>
+Declare the sender to be "sendmail", and set up the "sendmail" command.
+I<You should use send() instead.>
+
+=cut
+
+sub sendmail {
+ my $self = shift;
+ $self->send('sendmail', join(' ', @_));
+}
+
+=back
+
+=cut
+
+
+
+#==============================
+#==============================
+
+=head2 Miscellaneous
+
+=over 4
+
+=cut
+
+#------------------------------
+
+=item quiet ONOFF
+
+I<Class method.>
+Suppress/unsuppress all warnings coming from this module.
+
+ MIME::Lite->quiet(1); ### I know what I'm doing
+
+I recommend that you include that comment as well. And while
+you type it, say it out loud: if it doesn't feel right, then maybe
+you should reconsider the whole line. C<;-)>
+
+=cut
+
+sub quiet {
+ my $class = shift;
+ $QUIET = shift if @_;
+ $QUIET;
+}
+
+=back
+
+=cut
+
+
+
+#============================================================
+
+package MIME::Lite::SMTP;
+
+#============================================================
+# This class just adds a print() method to Net::SMTP.
+# Notice that we don't use/require it until it's needed!
+
+use strict;
+use vars qw( @ISA );
+@ISA = qw(Net::SMTP);
+
+sub print { shift->datasend(@_) }
+
+
+
+#============================================================
+
+package MIME::Lite::IO_Handle;
+
+#============================================================
+
+### Wrap a non-object filehandle inside a blessed, printable interface:
+### Does nothing if the given $fh is already a blessed object.
+sub wrap {
+ my ($class, $fh) = @_;
+ no strict 'refs';
+
+ ### Get default, if necessary:
+ $fh or $fh = select; ### no filehandle means selected one
+ ref($fh) or $fh = \*$fh; ### scalar becomes a globref
+
+ ### Stop right away if already a printable object:
+ return $fh if (ref($fh) and (ref($fh) ne 'GLOB'));
+
+ ### Get and return a printable interface:
+ bless \$fh, $class; ### wrap it in a printable interface
+}
+
+### Print:
+sub print {
+ my $self = shift;
+ print {$$self} @_;
+}
+
+
+#============================================================
+
+package MIME::Lite::IO_Scalar;
+
+#============================================================
+
+### Wrap a scalar inside a blessed, printable interface:
+sub wrap {
+ my ($class, $scalarref) = @_;
+ defined($scalarref) or $scalarref = \"";
+ bless $scalarref, $class;
+}
+
+### Print:
+sub print {
+ my $self = shift;
+ $$self .= join('', @_);
+ 1;
+}
+
+
+#============================================================
+
+package MIME::Lite::IO_ScalarArray;
+
+#============================================================
+
+### Wrap an array inside a blessed, printable interface:
+sub wrap {
+ my ($class, $arrayref) = @_;
+ defined($arrayref) or $arrayref = [];
+ bless $arrayref, $class;
+}
+
+### Print:
+sub print {
+ my $self = shift;
+ push @$self, @_;
+ 1;
+}
+
+1;
+__END__
+
+
+#============================================================
+
+=head1 NOTES
+
+
+=head2 How do I prevent "Content" headers from showing up in my mail reader?
+
+Apparently, some people are using mail readers which display the MIME
+headers like "Content-disposition", and they want MIME::Lite not
+to generate them "because they look ugly".
+
+Sigh.
+
+Y'know, kids, those headers aren't just there for cosmetic purposes.
+They help ensure that the message is I<understood> correctly by mail
+readers. But okay, you asked for it, you got it...
+here's how you can suppress the standard MIME headers.
+Before you send the message, do this:
+
+ $msg->scrub;
+
+You can scrub() any part of a multipart message independently;
+just be aware that it works recursively. Before you scrub,
+note the rules that I follow:
+
+=over 4
+
+=item Content-type
+
+You can safely scrub the "content-type" attribute if, and only if,
+the part is of type "text/plain" with charset "us-ascii".
+
+=item Content-transfer-encoding
+
+You can safely scrub the "content-transfer-encoding" attribute
+if, and only if, the part uses "7bit", "8bit", or "binary" encoding.
+You are far better off doing this if your lines are under 1000
+characters. Generally, that means you I<can> scrub it for plain
+text, and you can I<not> scrub this for images, etc.
+
+=item Content-disposition
+
+You can safely scrub the "content-disposition" attribute
+if you trust the mail reader to do the right thing when it decides
+whether to show an attachment inline or as a link. Be aware
+that scrubbing both the content-disposition and the content-type
+means that there is no way to "recommend" a filename for the attachment!
+
+B<Note:> there are reports of brain-dead MUAs out there that
+do the wrong thing if you I<provide> the content-disposition.
+If your attachments keep showing up inline or vice-versa,
+try scrubbing this attribute.
+
+=item Content-length
+
+You can always scrub "content-length" safely.
+
+=back
+
+=head2 How do I give my attachment a [different] recommended filename?
+
+By using the Filename option (which is different from Path!):
+
+ $msg->attach(Type => "image/gif",
+ Path => "/here/is/the/real/file.GIF",
+ Filename => "logo.gif");
+
+You should I<not> put path information in the Filename.
+
+=head2 Benign limitations
+
+This is "lite", after all...
+
+=over 4
+
+=item *
+
+There's no parsing. Get MIME-tools if you need to parse MIME messages.
+
+=item *
+
+MIME::Lite messages are currently I<not> interchangeable with
+either Mail::Internet or MIME::Entity objects. This is a completely
+separate module.
+
+=item *
+
+A content-length field is only inserted if the encoding is binary,
+the message is a singlepart, and all the document data is available
+at C<build()> time by virtue of residing in a simple path, or in-core.
+Since content-length is not a standard MIME field anyway (that's right, kids:
+it's not in the MIME RFCs, it's an HTTP thing), this seems pretty fair.
+
+=item *
+
+MIME::Lite alone cannot help you lose weight. You must supplement
+your use of MIME::Lite with a healthy diet and exercise.
+
+=back
+
+
+=head2 Cheap and easy mailing
+
+I thought putting in a default "sendmail" invocation wasn't too bad an
+idea, since a lot of Perlers are on UNIX systems.
+The out-of-the-box configuration is:
+
+ MIME::Lite->send('sendmail', "/usr/lib/sendmail -t -oi -oem");
+
+By the way, these arguments to sendmail are:
+
+ -t Scan message for To:, Cc:, Bcc:, etc.
+
+ -oi Do NOT treat a single "." on a line as a message terminator.
+ As in, "-oi vey, it truncated my message... why?!"
+
+ -oem On error, mail back the message (I assume to the
+ appropriate address, given in the header).
+ When mail returns, circle is complete. Jai Guru Deva -oem.
+
+Note that these are the same arguments you get if you configure to use
+the smarter, taint-safe mailing:
+
+ MIME::Lite->send('sendmail');
+
+If you get "X-Authentication-Warning" headers from this, you can forgo
+diddling with the envelope by instead specifying:
+
+ MIME::Lite->send('sendmail', SetSender=>0);
+
+And, if you're not on a Unix system, or if you'd just rather send mail
+some other way, there's always:
+
+ MIME::Lite->send('smtp', "smtp.myisp.net");
+
+Or you can set up your own subroutine to call.
+In any case, check out the L<send()|/send> method.
+
+
+
+=head1 WARNINGS
+
+=head2 Good-vs-bad email addresses with send_by_smtp()
+
+If using L<send_by_smtp()|/send_by_smtp>, be aware that you are
+forcing MIME::Lite to extract email addresses out of a possible list
+provided in the C<To:>, C<Cc:>, and C<Bcc:> fields. This is tricky
+stuff, and as such only the following sorts of addresses will work
+reliably:
+
+ username
+ full.name@some.host.com
+ "Name, Full" <full.name@some.host.com>
+
+This last form is discouraged because SMTP must be able to get
+at the I<name> or I<name@domain> portion.
+
+B<Disclaimer:>
+MIME::Lite was never intended to be a Mail User Agent, so please
+don't expect a full implementation of RFC-822. Restrict yourself to
+the common forms of Internet addresses described herein, and you should
+be fine. If this is not feasible, then consider using MIME::Lite
+to I<prepare> your message only, and using Net::SMTP explicitly to
+I<send> your message.
+
+
+=head2 Formatting of headers delayed until print()
+
+This class treats a MIME header in the most abstract sense,
+as being a collection of high-level attributes. The actual
+RFC-822-style header fields are not constructed until it's time
+to actually print the darn thing.
+
+
+=head2 Encoding of data delayed until print()
+
+When you specify message bodies
+(in L<build()|/build> or L<attach()|/attach>) --
+whether by B<FH>, B<Data>, or B<Path> -- be warned that we don't
+attempt to open files, read filehandles, or encode the data until
+L<print()|/print> is invoked.
+
+In the past, this created some confusion for users of sendmail
+who gave the wrong path to an attachment body, since enough of
+the print() would succeed to get the initial part of the message out.
+Nowadays, $AUTO_VERIFY is used to spot-check the Paths given before
+the mail facility is employed. A whisker slower, but tons safer.
+
+Note that if you give a message body via FH, and try to print()
+a message twice, the second print() will not do the right thing
+unless you explicitly rewind the filehandle.
+
+You can get past these difficulties by using the B<ReadNow> option,
+provided that you have enough memory to handle your messages.
+
+
+=head2 MIME attributes are separate from header fields!
+
+B<Important:> the MIME attributes are stored and manipulated separately
+from the message header fields; when it comes time to print the
+header out, I<any explicitly-given header fields override the ones that
+would be created from the MIME attributes.> That means that this:
+
+ ### DANGER ### DANGER ### DANGER ### DANGER ### DANGER ###
+ $msg->add("Content-type", "text/html; charset=US-ASCII");
+
+will set the exact C<"Content-type"> field in the header I write,
+I<regardless of what the actual MIME attributes are.>
+
+I<This feature is for experienced users only,> as an escape hatch in case
+the code that normally formats MIME header fields isn't doing what
+you need. And, like any escape hatch, it's got an alarm on it:
+MIME::Lite will warn you if you attempt to C<set()> or C<replace()>
+any MIME header field. Use C<attr()> instead.
+
+
+=head2 Beware of lines consisting of a single dot
+
+Julian Haight noted that MIME::Lite allows you to compose messages
+with lines in the body consisting of a single ".".
+This is true: it should be completely harmless so long as "sendmail"
+is used with the -oi option (see L<"Cheap and easy mailing">).
+
+However, I don't know if using Net::SMTP to transfer such a message
+is equally safe. Feedback is welcomed.
+
+My perspective: I don't want to magically diddle with a user's
+message unless absolutely positively necessary.
+Some users may want to send files with "." alone on a line;
+my well-meaning tinkering could seriously harm them.
+
+
+=head2 Infinite loops may mean tainted data!
+
+Stefan Sautter noticed a bug in 2.106 where a m//gc match was
+failing due to tainted data, leading to an infinite loop inside
+MIME::Lite.
+
+I am attempting to correct for this, but be advised that my fix will
+silently untaint the data (given the context in which the problem
+occurs, this should be benign: I've labelled the source code with
+UNTAINT comments for the curious).
+
+So: don't depend on taint-checking to save you from outputting
+tainted data in a message.
+
+
+=head2 Don't tweak the global configuration
+
+Global configuration variables are bad, and should go away.
+Until they do, please follow the hints with each setting
+on how I<not> to change it.
+
+=head1 A MIME PRIMER
+
+=head2 Content types
+
+The "Type" parameter of C<build()> is a I<content type>.
+This is the actual type of data you are sending.
+Generally this is a string of the form C<"majortype/minortype">.
+
+Here are the major MIME types.
+A more-comprehensive listing may be found in RFC-2046.
+
+=over 4
+
+=item application
+
+Data which does not fit in any of the other categories, particularly
+data to be processed by some type of application program.
+C<application/octet-stream>, C<application/gzip>, C<application/postscript>...
+
+=item audio
+
+Audio data.
+C<audio/basic>...
+
+=item image
+
+Graphics data.
+C<image/gif>, C<image/jpeg>...
+
+=item message
+
+A message, usually another mail or MIME message.
+C<message/rfc822>...
+
+=item multipart
+
+A message containing other messages.
+C<multipart/mixed>, C<multipart/alternative>...
+
+=item text
+
+Textual data, meant for humans to read.
+C<text/plain>, C<text/html>...
+
+=item video
+
+Video or video+audio data.
+C<video/mpeg>...
+
+=back
+
+
+=head2 Content transfer encodings
+
+The "Encoding" parameter of C<build()>.
+This is how the message body is packaged up for safe transit.
+
+Here are the 5 major MIME encodings.
+A more-comprehensive listing may be found in RFC-2045.
+
+=over 4
+
+=item 7bit
+
+Basically, no I<real> encoding is done. However, this label guarantees that no
+8-bit characters are present, and that lines do not exceed 1000 characters
+in length.
+
+=item 8bit
+
+Basically, no I<real> encoding is done. The message might contain 8-bit
+characters, but this encoding guarantees that lines do not exceed 1000
+characters in length.
+
+=item binary
+
+No encoding is done at all. Message might contain 8-bit characters,
+and lines might be longer than 1000 characters long.
+
+The most liberal, and the least likely to get through mail gateways.
+Use sparingly, or (better yet) not at all.
+
+=item base64
+
+Like "uuencode", but very well-defined. This is how you should send
+essentially binary information (tar files, GIFs, JPEGs, etc.).
+
+=item quoted-printable
+
+Useful for encoding messages which are textual in nature, yet which contain
+non-ASCII characters (e.g., Latin-1, Latin-2, or any other 8-bit alphabet).
+
+=back
+
+=cut
+
+=begin FOR_README_ONLY
+
+=head1 INSTALLATION
+
+Install using
+
+ perl makefile.pl
+ make test
+ make install
+
+Adjust the make command as is appropriate for your OS.
+'nmake' is the usual name under Win32
+
+In order to read the docmentation please use
+
+ perldoc MIME::Lite
+
+from the command line or visit
+
+ http://search.cpan.org/search?query=MIME%3A%3ALite&mode=all
+
+for a list of all MIME::Lite related materials including the
+documentation in HTML of all of the released versions of
+MIME::Lite.
+
+=cut
+
+=end FOR_README_ONLY
+
+=cut
+
+=head1 HELPER MODULES
+
+MIME::Lite works nicely with other certain other modules if they are present.
+Good to have installed is the latest L<MIME::Types|MIME::Types>,
+L<Mail::Address|Mail::Address>, L<MIME::Base64|MIME::Base64>,
+L<MIME::QuotedPrint|MIME::QuotedPrint>.
+
+If they aren't present then some functionality won't work, and other features
+wont be as efficient or up to date as they could be. Nevertheless they are optional
+extras.
+
+=head1 BUNDLED GOODIES
+
+MIME::Lite comes with a number of extra files in the distribution bundle.
+This includes examples, and utility modules that you can use to get yourself
+started with the module.
+
+The ./examples directory contains a number of snippets in prepared
+form, generally they are documented, but they should be easy to understand.
+
+The ./contrib directory contains a companion/tool modules that come bundled
+with MIME::Lite, they dont get installed by default. Please review the POD they
+come with.
+
+=head1 BUGS
+
+The whole reason that version 3.0 was released was to ensure that MIME::Lite
+is up to date and patched. If you find an issue please report it.
+
+As far as I know MIME::Lite doesnt currently have any serious bugs, but my usage
+is hardly comprehensive.
+
+Having said that there are a number of open issues for me, mostly caused by the progress
+in the community as whole since Eryq last released. The tests are based around an
+interesting but non standard test framework. I'd like to change it over to using
+Test::More.
+
+Should tests fail please review the ./testout directory, and in any bug reports
+please include the output of the relevent file. This is the only redeeming feature
+of not using Test::More that I can see.
+
+Bug fixes / Patches / Contribution are welcome, however I probably won't apply them
+unless they also have an associated test. This means that if I dont have the time to
+write the test the patch wont get applied, so please, include tests for any patches
+you provide.
+
+=head1 VERSION
+
+Version: 3.01 (Maintenance release and a new caretaker!)
+
+=head1 CHANGE LOG
+
+Moved to ./changes.pod
+
+=head1 TERMS AND CONDITIONS
+
+ Copyright (c) 1997 by Eryq.
+ Copyright (c) 1998 by ZeeGee Software Inc.
+ Copyright (c) 2003 Yves Orton. demerphq (at) hotmail.com.
+
+All rights reserved. This program is free software; you can
+redistribute it and/or modify it under the same terms as Perl
+itself.
+
+This software comes with B<NO WARRANTY> of any kind.
+See the COPYING file in the distribution for details.
+
+=head1 NUTRITIONAL INFORMATION
+
+For some reason, the US FDA says that this is now required by law
+on any products that bear the name "Lite"...
+
+Version 3.0 is now new and improved! The distribution is now 30% smaller!
+
+ MIME::Lite |
+ ------------------------------------------------------------
+ Serving size: | 1 module
+ Servings per container: | 1
+ Calories: | 0
+ Fat: | 0g
+ Saturated Fat: | 0g
+
+Warning: for consumption by hardware only! May produce
+indigestion in humans if taken internally.
+
+=head1 AUTHOR
+
+Eryq (F<eryq@zeegee.com>).
+President, ZeeGee Software Inc. (F<http://www.zeegee.com>).
+
+Go to F<http://www.zeegee.com> for the latest downloads
+and on-line documentation for this module. Enjoy.
+
+Patches And Maintenance by Yves Orton demerphq@hotmail.com and many others. Consult
+./changes.pod
+
+=cut
+
diff --git a/mcu/tools/perl/OLE/Storage_Lite.pm b/mcu/tools/perl/OLE/Storage_Lite.pm
new file mode 100644
index 0000000..3ea2a57
--- /dev/null
+++ b/mcu/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/mcu/tools/perl/Parse/CSV.pm b/mcu/tools/perl/Parse/CSV.pm
new file mode 100644
index 0000000..184149b
--- /dev/null
+++ b/mcu/tools/perl/Parse/CSV.pm
@@ -0,0 +1,463 @@
+package Parse::CSV;
+
+=pod
+
+=head1 NAME
+
+Parse::CSV - Highly flexible CVS parser for large files
+
+=head1 SYNOPSIS
+
+ # Simple headerless comma-seperated column parser
+ my $simple = Parse::CSV->new(
+ file => 'file.csv',
+ );
+ while ( my $array_ref = $simple->fetch ) {
+ # Do something...
+ }
+
+... or a more complex example...
+
+ # Parse a colon-seperated variables file from a handle as a hash
+ # based on headers from the first line.
+ # Then filter, so we emit objects rather than the plain hash.
+ my $objects = Parse::CSV->new(
+ handle => $io_handle,
+ sep_char => ';',
+ fields => 'auto',
+ filter => sub { My::Object->new( $_ ) },
+ );
+ while ( my $object = $objects->fetch ) {
+ $object->do_something;
+ }
+
+=head1 DESCRIPTION
+
+Surely the CPAN doesn't need yet another CSV parsing module.
+
+L<Text::CSV_XS> is the standard parser for CSV files. It is fast as hell,
+but unfortunately it can be a bit verbose to use.
+
+A number of other modules have attempted to put usability wrappers around
+this venerable module, but they have all focussed on parsing the entire
+file into memory at once.
+
+This method is fine unless your CSV files start to get large. Once that
+happens, the only existing option is to fall back on the relatively slow
+and heavyweight L<XML::SAXDriver::CSV> module.
+
+L<Parse::CSV> fills this functionality gap. It provides a flexible
+and light-weight streaming parser for large, extremely large, or
+arbitrarily large CSV files.
+
+=head2 Main Features
+
+B<Stream-Based Parser> - All parsing a line at a time.
+
+B<Array Mode> - Parsing can be done in simple array mode, returning
+a reference to an array if the columns are not named.
+
+B<Hash Mode> - Parsing can be done in hash mode, putting the data into
+a hash and return a reference to it.
+
+B<Filter Capability> - All items returned can be passed through a
+custom filter. This filter can either modify the data on the fly,
+or drop records you don't need.
+
+=head2 Writing Filters
+
+A L<Parse::CSV> filter is a subroutine reference that is passed the raw
+record as C<$_>, and should C<return> the alternative or modified record
+to return to the user.
+
+The null filter (does not modify or drop any records) looks like the
+following.
+
+ sub { $_ };
+
+A filter which reversed the order of the columns (assuming they are
+passed as an array) might look like the following.
+
+ sub { return [ reverse @$_ ] };
+
+To drop the record, you should return C<undef> from the filter. The
+parser will then keep pulling and parsing new records until one
+passes the filter.
+
+ # Only keep records where foo is true
+ sub { $_->{foo} ? $_ : undef }
+
+To signal an error, throw an exception
+
+ sub {
+ $_->{foo} =~ /bar/ or die "Assumption failed";
+ return $_;
+ }
+
+=head1 METHODS
+
+=cut
+
+use 5.005;
+use strict;
+use Carp ();
+use IO::File ();
+use Text::CSV_XS ();
+use Params::Util qw{ _STRING _ARRAY _HASH0 _CODELIKE _HANDLE };
+
+use vars qw{$VERSION};
+BEGIN {
+ $VERSION = '1.00';
+}
+
+
+
+
+
+#####################################################################
+# Constructor
+
+=pod
+
+=head2 new
+
+The C<new> constructor creates and initialise a new CSV parser.
+
+It takes a number of params.
+
+To specify the CSV data source, you should provide either the C<file>
+param, which should be the name of the file to read, or the C<handle>
+param, which should be a file handle to read instead.
+
+The actual parsing is done using L<Text::CSV_XS>. Any of it's
+constructor/parsing params can also be provided to this C<new> method,
+and they will be passed on.
+
+Alternatively, they can be passed as a single C<HASH> reference as the
+C<csv_attr> param. For example:
+
+ $parser = Parse::CSV->new(
+ file => 'file.csv',
+ csv_attr => {
+ sep_char => ';',
+ quote_char => "'",
+ },
+ );
+
+An optional C<fields> param can be provided, which should be an array
+reference containing the names of the columns in the CSV file.
+
+ $parser = Parse::CSV->new(
+ file => 'file.csv',
+ fields => [ 'col1', 'col2', 'col3' ],
+ );
+
+If the C<fields> param is provided, the parser will map the columns to a
+hash where the keys are the field names provided, and the values are the
+values found in the CSV file.
+
+If the C<fields> param is B<not> provided, the parser will return simple
+array references of the columns.
+
+If the C<fields> param is the string 'auto', the fields will be
+automatically determined by reading the first line of the CSV file and
+using those values as the field names.
+
+The optional C<filter> param will be used to filter the records if
+provided. It should be a C<CODE> reference or any otherwise callable
+scalar, and each value parsed (either array reference or hash reference)
+will be passed to the filter to be changed or converted into an object,
+or whatever you wish.
+
+Returns a new L<Parse::CSV> object, or throws an exception (dies) on error.
+
+=cut
+
+sub new {
+ my $class = shift;
+ my $self = bless { @_,
+ row => 0,
+ errstr => '',
+ }, $class;
+
+ # Do we have a file name
+ if ( exists $self->{file} ) {
+ unless ( _STRING($self->{file}) ) {
+ Carp::croak("Parse::CSV file param is not a string");
+ }
+ unless ( -f $self->{file} and -r _ ) {
+ Carp::croak("Parse::CSV file '$self->{file}' does not exist");
+ }
+ $self->{handle} = IO::File->new();
+ unless ( $self->{handle}->open($self->{file}) ) {
+ Carp::croak("Parse::CSV file '$self->{file}' failed to load: $!");
+ }
+ }
+
+ # Do we have a file handle
+ if ( exists $self->{handle} ) {
+ unless ( _HANDLE($self->{handle}) ) {
+ Carp::croak("Parse::CSV handle param is not an IO handle");
+ }
+ } else {
+ Carp::croak("Parse::CSV not provided a file or handle param");
+ }
+
+ # Seperate the Text::CSV attributes
+ unless ( _HASH0($self->{csv_attr}) ) {
+ $self->{csv_attr} = {};
+ foreach ( qw{quote_char eol escape_char sep_char binary always_quote} ) {
+ next unless exists $self->{$_};
+ $self->{csv_attr}->{$_} = delete $self->{$_};
+ }
+ }
+
+ # Create the parser
+ $self->{csv_xs} = Text::CSV_XS->new( $self->{csv_attr} );
+ unless ( $self->{csv_xs} ) {
+ Carp::croak("Failed to create Text::CSV_XS parser");
+ }
+
+ # Handle automatic fields
+ if ( _STRING($self->{fields}) and lc($self->{fields}) eq 'auto' ) {
+ # Grab the first line
+ my $line = $self->_getline;
+ unless ( defined $line ) {
+ Carp::croak("Failed to get header line from CSV");
+ }
+
+ # Parse the line into columns
+ unless ( $self->{csv_xs}->parse($line) ) {
+ Carp::croak(
+ "Failed to parse header line from CSV: "
+ . $self->{csv_xs}->error_input
+ );
+ }
+
+ # Turn the array ref into a hash if needed
+ my @cols = $self->{csv_xs}->fields;
+ $self->{fields} = \@cols;
+ }
+
+ # Check fields
+ if ( exists $self->{fields} and ! _ARRAY($self->{fields}) ) {
+ Carp::croak("Parse::CSV fields param is not an array reference of strings");
+ }
+
+ # Check filter
+ if ( exists $self->{filter} and ! _CODELIKE($self->{filter}) ) {
+ Carp::croak("Parse::CSV filter param is not callable");
+ }
+
+ $self;
+}
+
+
+
+
+
+#####################################################################
+# Main Methods
+
+=pod
+
+=head2 fetch
+
+Once a L<Parse::CSV> object has been created, the C<fetch> method is
+used to parse and return the next value from the CSV file.
+
+Returns an C<ARRAY>, C<HASH> or the output of the filter, based on the
+configuration of the object, or C<undef> in a variety of situations.
+
+Returning C<undef> means either some part of the parsing and filtering
+process has resulted in an error, B<or> that the end of file has been
+reached.
+
+On receiving C<undef>, you should the C<errstr> method. If it is a null
+string you have reached the end of file. Otherwise the error message will
+be returned. Thus, the basic usage of L<Parse::CSV> will look like the
+following.
+
+ my $parser = Parse::CSV->new(
+ file => 'file.csv',
+ );
+ while ( my $value = $parser->fetch ) {
+ # Do something...
+ }
+ if ( $parser->errstr ) {
+ # Handle errors...
+ }
+
+=cut
+
+sub fetch {
+ my $self = shift;
+
+ # The filter can skip rows,
+ # iterate till we get something.
+ while ( defined(my $line = $self->_getline) ) {
+ # Parse the line into columns
+ unless ( $self->{csv_xs}->parse($line) ) {
+ $self->{errstr} = "Failed to parse row $self->{row}";
+ return undef;
+ }
+
+ # Turn the array ref into a hash if needed
+ my $rv = undef;
+ my $f = $self->{fields};
+ my @cols = $self->{csv_xs}->fields;
+ if ( $f ) {
+ $rv = {};
+ foreach ( 0 .. $#$f ) {
+ $rv->{ $f->[$_] } = $cols[$_];
+ }
+ } else {
+ $rv = \@cols;
+ }
+
+ # Just return for simple uses
+ return $rv unless $self->{filter};
+
+ # Filter if needed
+ local $_ = $rv;
+ $rv = eval { $self->{filter}->() };
+ if ( $@ ) {
+ # Handle filter errors
+ $self->{errstr} = "Filter error: $@";
+ $self->{errstr} =~ s/^(.+)at line.+$/$1/;
+ return undef;
+ }
+
+ # Filter returns undef to drop a record
+ next unless defined $rv;
+
+ # We have a good record, return it
+ return $rv;
+ }
+
+ return undef;
+}
+
+sub _getline {
+ my $self = shift;
+ $self->{errstr} = '';
+
+ # Fetch the next file line
+ my $handle = $self->{handle};
+ my $line = <$handle>;
+ unless ( defined $line ) {
+ $self->{errstr} = $handle->eof ? '' : $!;
+ return undef;
+ }
+
+ # Parse the line into columns
+ $self->{row}++;
+ return $line;
+}
+
+=pod
+
+=head2 row
+
+The C<row> method returns the current row of the CSV file.
+
+This is a one-based count, so when you first create the parser,
+the value of C<row> will be zero (unless you are using
+C<fields => 'auto'> in which case it will be 1).
+
+=cut
+
+sub row {
+ $_[0]->{row};
+}
+
+=pod
+
+=head2 combine
+
+ $status = $csv->combine(@columns);
+
+The C<combine> method is provided as a convenience, and is passed through
+to the underlying L<Text::CSV_XS> object.
+
+=cut
+
+sub combine {
+ shift->combine(@_);
+}
+
+=pod
+
+=head2 string
+
+ $line = $cvs->string;
+
+The C<string> method is provided as a convenience, and is passed through
+to the underlying L<Text::CSV_XS> object.
+
+=cut
+
+sub string {
+ shift->string(@_);
+}
+
+=pod
+
+=head2 print
+
+ $status = $cvs->print($io, $columns);
+
+The C<print> method is provided as a convenience, and is passed through
+to the underlying L<Text::CSV_XS> object.
+
+=cut
+
+sub print {
+ shift->print(@_);
+}
+
+=pod
+
+=head2 errstr
+
+On error, the C<errstr> method returns the error that occured.
+
+If the last action was NOT an error, returns the null string C<''>.
+
+=cut
+
+sub errstr {
+ $_[0]->{errstr};
+}
+
+1;
+
+=pod
+
+=head1 SUPPORT
+
+Bugs should be always be reported via the CPAN bug tracker at
+
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Parse-CSV>
+
+For other issues, or commercial enhancement or support, contact the author.
+
+=head1 AUTHORS
+
+Adam Kennedy E<lt>adamk@cpan.orgE<gt>
+
+=head1 SEE ALSO
+
+L<Text::CSV_XS>, L<http://ali.as/>
+
+=head1 COPYRIGHT
+
+Copyright 2006 Adam Kennedy.
+
+This program is free software; you can redistribute
+it and/or modify it under the same terms as Perl itself.
+
+The full text of the license can be found in the
+LICENSE file included with this module.
+
+=cut
diff --git a/mcu/tools/perl/Parse/RecDescent.pm b/mcu/tools/perl/Parse/RecDescent.pm
new file mode 100644
index 0000000..ec8aa40
--- /dev/null
+++ b/mcu/tools/perl/Parse/RecDescent.pm
@@ -0,0 +1,6417 @@
+# GENERATE RECURSIVE DESCENT PARSER OBJECTS FROM A GRAMMAR
+
+use 5.006;
+use strict;
+
+package Parse::RecDescent;
+
+use Text::Balanced qw ( extract_codeblock extract_bracketed extract_quotelike extract_delimited );
+
+use vars qw ( $skip );
+
+ *defskip = \ '\s*'; # DEFAULT SEPARATOR IS OPTIONAL WHITESPACE
+ $skip = '\s*'; # UNIVERSAL SEPARATOR IS OPTIONAL WHITESPACE
+my $MAXREP = 100_000_000; # REPETITIONS MATCH AT MOST 100,000,000 TIMES
+
+
+#ifndef RUNTIME
+sub import # IMPLEMENT PRECOMPILER BEHAVIOUR UNDER:
+ # perl -MParse::RecDescent - <grammarfile> <classname>
+{
+ local *_die = sub { print @_, "\n"; exit };
+
+ my ($package, $file, $line) = caller;
+
+ if ($file eq '-' && $line == 0)
+ {
+ _die("Usage: perl -MLocalTest - <grammarfile> <classname>")
+ unless @ARGV == 2;
+
+ my ($sourcefile, $class) = @ARGV;
+
+ local *IN;
+ open IN, $sourcefile
+ or _die(qq{Can't open grammar file "$sourcefile"});
+ local $/; #
+ my $grammar = <IN>;
+ close IN;
+
+ Parse::RecDescent->Precompile($grammar, $class, $sourcefile);
+ exit;
+ }
+}
+
+sub Save
+{
+ my $self = shift;
+ my %opt;
+ if ('HASH' eq ref $_[0]) {
+ %opt = (%opt, %{$_[0]});
+ shift;
+ }
+ my ($class) = @_;
+ $self->{saving} = 1;
+ $self->Precompile(undef,$class);
+ $self->{saving} = 0;
+}
+
+sub Precompile
+{
+ my $self = shift;
+ my %opt = ( -standalone => 0 );
+ if ('HASH' eq ref $_[0]) {
+ %opt = (%opt, %{$_[0]});
+ shift;
+ }
+ my ($grammar, $class, $sourcefile) = @_;
+
+ $class =~ /^(\w+::)*\w+$/ or croak("Bad class name: $class");
+
+ my $modulefile = $class;
+ $modulefile =~ s/.*:://;
+ $modulefile .= ".pm";
+
+ my $runtime_package = 'Parse::RecDescent::_Runtime';
+ my $code;
+
+ local *OUT;
+ open OUT, ">", $modulefile
+ or croak("Can't write to new module file '$modulefile'");
+
+ print STDERR "precompiling grammar from file '$sourcefile'\n",
+ "to class $class in module file '$modulefile'\n"
+ if $grammar && $sourcefile;
+
+ # Make the resulting pre-compiled parser stand-alone by
+ # including the contents of Parse::RecDescent as
+ # Parse::RecDescent::Runtime in the resulting precompiled
+ # parser.
+ if ($opt{-standalone}) {
+ local *IN;
+ open IN, '<', $Parse::RecDescent::_FILENAME
+ or croak("Can't open $Parse::RecDescent::_FILENAME for standalone pre-compilation: $!\n");
+ my $exclude = 0;
+ print OUT "{\n";
+ while (<IN>) {
+ if ($_ =~ /^\s*#\s*ifndef\s+RUNTIME\s*$/) {
+ ++$exclude;
+ }
+ if ($exclude) {
+ if ($_ =~ /^\s*#\s*endif\s$/) {
+ --$exclude;
+ }
+ } else {
+ if ($_ =~ m/^__END__/) {
+ last;
+ }
+ s/Parse::RecDescent/$runtime_package/gs;
+ print OUT $_;
+ }
+ }
+ close IN;
+ print OUT "}\n";
+ }
+
+ $self = Parse::RecDescent->new($grammar, # $grammar
+ 1, # $compiling
+ $class # $namespace
+ )
+ || croak("Can't compile bad grammar")
+ if $grammar;
+
+ $self->{_precompiled} = 1;
+
+ foreach ( keys %{$self->{rules}} ) {
+ $self->{rules}{$_}{changed} = 1;
+ }
+
+
+ print OUT "package $class;\n";
+ if (not $opt{-standalone}) {
+ print OUT "use Parse::RecDescent;\n";
+ }
+
+ print OUT "{ my \$ERRORS;\n\n";
+
+ $code = $self->_code();
+ if ($opt{-standalone}) {
+ $code =~ s/Parse::RecDescent/$runtime_package/gs;
+ }
+ print OUT $code;
+
+ print OUT "}\npackage $class; sub new { ";
+ print OUT "my ";
+
+ require Data::Dumper;
+ $code = Data::Dumper->Dump([$self], [qw(self)]);
+ if ($opt{-standalone}) {
+ $code =~ s/Parse::RecDescent/$runtime_package/gs;
+ }
+ print OUT $code;
+
+ print OUT "}";
+
+ close OUT
+ or croak("Can't write to new module file '$modulefile'");
+}
+#endif
+
+package Parse::RecDescent::LineCounter;
+
+
+sub TIESCALAR # ($classname, \$text, $thisparser, $prevflag)
+{
+ bless {
+ text => $_[1],
+ parser => $_[2],
+ prev => $_[3]?1:0,
+ }, $_[0];
+}
+
+sub FETCH
+{
+ my $parser = $_[0]->{parser};
+ my $cache = $parser->{linecounter_cache};
+ my $from = $parser->{fulltextlen}-length(${$_[0]->{text}})-$_[0]->{prev}
+;
+
+ unless (exists $cache->{$from})
+ {
+ $parser->{lastlinenum} = $parser->{offsetlinenum}
+ - Parse::RecDescent::_linecount(substr($parser->{fulltext},$from))
+ + 1;
+ $cache->{$from} = $parser->{lastlinenum};
+ }
+ return $cache->{$from};
+}
+
+sub STORE
+{
+ my $parser = $_[0]->{parser};
+ $parser->{offsetlinenum} -= $parser->{lastlinenum} - $_[1];
+ return undef;
+}
+
+sub resync # ($linecounter)
+{
+ my $self = tied($_[0]);
+ die "Tried to alter something other than a LineCounter\n"
+ unless $self =~ /Parse::RecDescent::LineCounter/;
+
+ my $parser = $self->{parser};
+ my $apparently = $parser->{offsetlinenum}
+ - Parse::RecDescent::_linecount(${$self->{text}})
+ + 1;
+
+ $parser->{offsetlinenum} += $parser->{lastlinenum} - $apparently;
+ return 1;
+}
+
+package Parse::RecDescent::ColCounter;
+
+sub TIESCALAR # ($classname, \$text, $thisparser, $prevflag)
+{
+ bless {
+ text => $_[1],
+ parser => $_[2],
+ prev => $_[3]?1:0,
+ }, $_[0];
+}
+
+sub FETCH
+{
+ my $parser = $_[0]->{parser};
+ my $missing = $parser->{fulltextlen}-length(${$_[0]->{text}})-$_[0]->{prev}+1;
+ substr($parser->{fulltext},0,$missing) =~ m/^(.*)\Z/m;
+ return length($1);
+}
+
+sub STORE
+{
+ die "Can't set column number via \$thiscolumn\n";
+}
+
+
+package Parse::RecDescent::OffsetCounter;
+
+sub TIESCALAR # ($classname, \$text, $thisparser, $prev)
+{
+ bless {
+ text => $_[1],
+ parser => $_[2],
+ prev => $_[3]?-1:0,
+ }, $_[0];
+}
+
+sub FETCH
+{
+ my $parser = $_[0]->{parser};
+ return $parser->{fulltextlen}-length(${$_[0]->{text}})+$_[0]->{prev};
+}
+
+sub STORE
+{
+ die "Can't set current offset via \$thisoffset or \$prevoffset\n";
+}
+
+
+
+package Parse::RecDescent::Rule;
+
+sub new ($$$$$)
+{
+ my $class = ref($_[0]) || $_[0];
+ my $name = $_[1];
+ my $owner = $_[2];
+ my $line = $_[3];
+ my $replace = $_[4];
+
+ if (defined $owner->{"rules"}{$name})
+ {
+ my $self = $owner->{"rules"}{$name};
+ if ($replace && !$self->{"changed"})
+ {
+ $self->reset;
+ }
+ return $self;
+ }
+ else
+ {
+ return $owner->{"rules"}{$name} =
+ bless
+ {
+ "name" => $name,
+ "prods" => [],
+ "calls" => [],
+ "changed" => 0,
+ "line" => $line,
+ "impcount" => 0,
+ "opcount" => 0,
+ "vars" => "",
+ }, $class;
+ }
+}
+
+sub reset($)
+{
+ @{$_[0]->{"prods"}} = ();
+ @{$_[0]->{"calls"}} = ();
+ $_[0]->{"changed"} = 0;
+ $_[0]->{"impcount"} = 0;
+ $_[0]->{"opcount"} = 0;
+ $_[0]->{"vars"} = "";
+}
+
+sub DESTROY {}
+
+sub hasleftmost($$)
+{
+ my ($self, $ref) = @_;
+
+ my $prod;
+ foreach $prod ( @{$self->{"prods"}} )
+ {
+ return 1 if $prod->hasleftmost($ref);
+ }
+
+ return 0;
+}
+
+sub leftmostsubrules($)
+{
+ my $self = shift;
+ my @subrules = ();
+
+ my $prod;
+ foreach $prod ( @{$self->{"prods"}} )
+ {
+ push @subrules, $prod->leftmostsubrule();
+ }
+
+ return @subrules;
+}
+
+sub expected($)
+{
+ my $self = shift;
+ my @expected = ();
+
+ my $prod;
+ foreach $prod ( @{$self->{"prods"}} )
+ {
+ my $next = $prod->expected();
+ unless (! $next or _contains($next,@expected) )
+ {
+ push @expected, $next;
+ }
+ }
+
+ return join ', or ', @expected;
+}
+
+sub _contains($@)
+{
+ my $target = shift;
+ my $item;
+ foreach $item ( @_ ) { return 1 if $target eq $item; }
+ return 0;
+}
+
+sub addcall($$)
+{
+ my ( $self, $subrule ) = @_;
+ unless ( _contains($subrule, @{$self->{"calls"}}) )
+ {
+ push @{$self->{"calls"}}, $subrule;
+ }
+}
+
+sub addprod($$)
+{
+ my ( $self, $prod ) = @_;
+ push @{$self->{"prods"}}, $prod;
+ $self->{"changed"} = 1;
+ $self->{"impcount"} = 0;
+ $self->{"opcount"} = 0;
+ $prod->{"number"} = $#{$self->{"prods"}};
+ return $prod;
+}
+
+sub addvar
+{
+ my ( $self, $var, $parser ) = @_;
+ if ($var =~ /\A\s*local\s+([%@\$]\w+)/)
+ {
+ $parser->{localvars} .= " $1";
+ $self->{"vars"} .= "$var;\n" }
+ else
+ { $self->{"vars"} .= "my $var;\n" }
+ $self->{"changed"} = 1;
+ return 1;
+}
+
+sub addautoscore
+{
+ my ( $self, $code ) = @_;
+ $self->{"autoscore"} = $code;
+ $self->{"changed"} = 1;
+ return 1;
+}
+
+sub nextoperator($)
+{
+ my $self = shift;
+ my $prodcount = scalar @{$self->{"prods"}};
+ my $opcount = ++$self->{"opcount"};
+ return "_operator_${opcount}_of_production_${prodcount}_of_rule_$self->{name}";
+}
+
+sub nextimplicit($)
+{
+ my $self = shift;
+ my $prodcount = scalar @{$self->{"prods"}};
+ my $impcount = ++$self->{"impcount"};
+ return "_alternation_${impcount}_of_production_${prodcount}_of_rule_$self->{name}";
+}
+
+
+sub code
+{
+ my ($self, $namespace, $parser, $check) = @_;
+
+eval 'undef &' . $namespace . '::' . $self->{"name"} unless $parser->{saving};
+
+ my $code =
+'
+# ARGS ARE: ($parser, $text; $repeating, $_noactions, $_itempos, \@args)
+sub ' . $namespace . '::' . $self->{"name"} . '
+{
+ my $thisparser = $_[0];
+ use vars q{$tracelevel};
+ local $tracelevel = ($tracelevel||0)+1;
+ $ERRORS = 0;
+ my $thisrule = $thisparser->{"rules"}{"' . $self->{"name"} . '"};
+
+ Parse::RecDescent::_trace(q{Trying rule: [' . $self->{"name"} . ']},
+ Parse::RecDescent::_tracefirst($_[1]),
+ q{' . $self->{"name"} . '},
+ $tracelevel)
+ if defined $::RD_TRACE;
+
+ ' . ($parser->{deferrable}
+ ? 'my $def_at = @{$thisparser->{deferred}};'
+ : '') .
+ '
+ my $err_at = @{$thisparser->{errors}};
+
+ my $score;
+ my $score_return;
+ my $_tok;
+ my $return = undef;
+ my $_matched=0;
+ my $commit=0;
+ my @item = ();
+ my %item = ();
+ my $repeating = $_[2];
+ my $_noactions = $_[3];
+ my $_itempos = $_[4];
+ my @arg = defined $_[5] ? @{ &{$_[5]} } : ();
+ my %arg = ($#arg & 01) ? @arg : (@arg, undef);
+ my $text;
+ my $lastsep;
+ my $current_match;
+ my $expectation = new Parse::RecDescent::Expectation(q{' . $self->expected() . '});
+ $expectation->at($_[1]);
+ '. ($parser->{_check}{thisoffset}?'
+ my $thisoffset;
+ tie $thisoffset, q{Parse::RecDescent::OffsetCounter}, \$text, $thisparser;
+ ':'') . ($parser->{_check}{prevoffset}?'
+ my $prevoffset;
+ tie $prevoffset, q{Parse::RecDescent::OffsetCounter}, \$text, $thisparser, 1;
+ ':'') . ($parser->{_check}{thiscolumn}?'
+ my $thiscolumn;
+ tie $thiscolumn, q{Parse::RecDescent::ColCounter}, \$text, $thisparser;
+ ':'') . ($parser->{_check}{prevcolumn}?'
+ my $prevcolumn;
+ tie $prevcolumn, q{Parse::RecDescent::ColCounter}, \$text, $thisparser, 1;
+ ':'') . ($parser->{_check}{prevline}?'
+ my $prevline;
+ tie $prevline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser, 1;
+ ':'') . '
+ my $thisline;
+ tie $thisline, q{Parse::RecDescent::LineCounter}, \$text, $thisparser;
+
+ '. $self->{vars} .'
+';
+
+ my $prod;
+ foreach $prod ( @{$self->{"prods"}} )
+ {
+ $prod->addscore($self->{autoscore},0,0) if $self->{autoscore};
+ next unless $prod->checkleftmost();
+ $code .= $prod->code($namespace,$self,$parser);
+
+ $code .= $parser->{deferrable}
+ ? ' splice
+ @{$thisparser->{deferred}}, $def_at unless $_matched;
+ '
+ : '';
+ }
+
+ $code .=
+'
+ unless ( $_matched || defined($score) )
+ {
+ ' .($parser->{deferrable}
+ ? ' splice @{$thisparser->{deferred}}, $def_at;
+ '
+ : '') . '
+
+ $_[1] = $text; # NOT SURE THIS IS NEEDED
+ Parse::RecDescent::_trace(q{<<'.Parse::RecDescent::_matchtracemessage($self,1).' rule>>},
+ Parse::RecDescent::_tracefirst($_[1]),
+ q{' . $self->{"name"} .'},
+ $tracelevel)
+ if defined $::RD_TRACE;
+ return undef;
+ }
+ if (!defined($return) && defined($score))
+ {
+ Parse::RecDescent::_trace(q{>>Accepted scored production<<}, "",
+ q{' . $self->{"name"} .'},
+ $tracelevel)
+ if defined $::RD_TRACE;
+ $return = $score_return;
+ }
+ splice @{$thisparser->{errors}}, $err_at;
+ $return = $item[$#item] unless defined $return;
+ if (defined $::RD_TRACE)
+ {
+ Parse::RecDescent::_trace(q{>>'.Parse::RecDescent::_matchtracemessage($self).' rule<< (return value: [} .
+ $return . q{])}, "",
+ q{' . $self->{"name"} .'},
+ $tracelevel);
+ Parse::RecDescent::_trace(q{(consumed: [} .
+ Parse::RecDescent::_tracemax(substr($_[1],0,-length($text))) . q{])},
+ Parse::RecDescent::_tracefirst($text),
+ , q{' . $self->{"name"} .'},
+ $tracelevel)
+ }
+ $_[1] = $text;
+ return $return;
+}
+';
+
+ return $code;
+}
+
+my @left;
+sub isleftrec($$)
+{
+ my ($self, $rules) = @_;
+ my $root = $self->{"name"};
+ @left = $self->leftmostsubrules();
+ my $next;
+ foreach $next ( @left )
+ {
+ next unless defined $rules->{$next}; # SKIP NON-EXISTENT RULES
+ return 1 if $next eq $root;
+ my $child;
+ foreach $child ( $rules->{$next}->leftmostsubrules() )
+ {
+ push(@left, $child)
+ if ! _contains($child, @left) ;
+ }
+ }
+ return 0;
+}
+
+package Parse::RecDescent::Production;
+
+sub describe ($;$)
+{
+ return join ' ', map { $_->describe($_[1]) or () } @{$_[0]->{items}};
+}
+
+sub new ($$;$$)
+{
+ my ($self, $line, $uncommit, $error) = @_;
+ my $class = ref($self) || $self;
+
+ bless
+ {
+ "items" => [],
+ "uncommit" => $uncommit,
+ "error" => $error,
+ "line" => $line,
+ strcount => 0,
+ patcount => 0,
+ dircount => 0,
+ actcount => 0,
+ }, $class;
+}
+
+sub expected ($)
+{
+ my $itemcount = scalar @{$_[0]->{"items"}};
+ return ($itemcount) ? $_[0]->{"items"}[0]->describe(1) : '';
+}
+
+sub hasleftmost ($$)
+{
+ my ($self, $ref) = @_;
+ return ${$self->{"items"}}[0] eq $ref if scalar @{$self->{"items"}};
+ return 0;
+}
+
+sub isempty($)
+{
+ my $self = shift;
+ return 0 == @{$self->{"items"}};
+}
+
+sub leftmostsubrule($)
+{
+ my $self = shift;
+
+ if ( $#{$self->{"items"}} >= 0 )
+ {
+ my $subrule = $self->{"items"}[0]->issubrule();
+ return $subrule if defined $subrule;
+ }
+
+ return ();
+}
+
+sub checkleftmost($)
+{
+ my @items = @{$_[0]->{"items"}};
+ if (@items==1 && ref($items[0]) =~ /\AParse::RecDescent::Error/
+ && $items[0]->{commitonly} )
+ {
+ Parse::RecDescent::_warn(2,"Lone <error?> in production treated
+ as <error?> <reject>");
+ Parse::RecDescent::_hint("A production consisting of a single
+ conditional <error?> directive would
+ normally succeed (with the value zero) if the
+ rule is not 'commited' when it is
+ tried. Since you almost certainly wanted
+ '<error?> <reject>' Parse::RecDescent
+ supplied it for you.");
+ push @{$_[0]->{items}},
+ Parse::RecDescent::UncondReject->new(0,0,'<reject>');
+ }
+ elsif (@items==1 && ($items[0]->describe||"") =~ /<rulevar|<autoscore/)
+ {
+ # Do nothing
+ }
+ elsif (@items &&
+ ( ref($items[0]) =~ /\AParse::RecDescent::UncondReject/
+ || ($items[0]->describe||"") =~ /<autoscore/
+ ))
+ {
+ Parse::RecDescent::_warn(1,"Optimizing away production: [". $_[0]->describe ."]");
+ my $what = $items[0]->describe =~ /<rulevar/
+ ? "a <rulevar> (which acts like an unconditional <reject> during parsing)"
+ : $items[0]->describe =~ /<autoscore/
+ ? "an <autoscore> (which acts like an unconditional <reject> during parsing)"
+ : "an unconditional <reject>";
+ my $caveat = $items[0]->describe =~ /<rulevar/
+ ? " after the specified variable was set up"
+ : "";
+ my $advice = @items > 1
+ ? "However, there were also other (useless) items after the leading "
+ . $items[0]->describe
+ . ", so you may have been expecting some other behaviour."
+ : "You can safely ignore this message.";
+ Parse::RecDescent::_hint("The production starts with $what. That means that the
+ production can never successfully match, so it was
+ optimized out of the final parser$caveat. $advice");
+ return 0;
+ }
+ return 1;
+}
+
+sub changesskip($)
+{
+ my $item;
+ foreach $item (@{$_[0]->{"items"}})
+ {
+ if (ref($item) =~ /Parse::RecDescent::(Action|Directive)/)
+ {
+ return 1 if $item->{code} =~ /\$skip\s*=/;
+ }
+ }
+ return 0;
+}
+
+sub adddirective
+{
+ my ( $self, $whichop, $line, $name ) = @_;
+ push @{$self->{op}},
+ { type=>$whichop, line=>$line, name=>$name,
+ offset=> scalar(@{$self->{items}}) };
+}
+
+sub addscore
+{
+ my ( $self, $code, $lookahead, $line ) = @_;
+ $self->additem(Parse::RecDescent::Directive->new(
+ "local \$^W;
+ my \$thisscore = do { $code } + 0;
+ if (!defined(\$score) || \$thisscore>\$score)
+ { \$score=\$thisscore; \$score_return=\$item[-1]; }
+ undef;", $lookahead, $line,"<score: $code>") )
+ unless $self->{items}[-1]->describe =~ /<score/;
+ return 1;
+}
+
+sub check_pending
+{
+ my ( $self, $line ) = @_;
+ if ($self->{op})
+ {
+ while (my $next = pop @{$self->{op}})
+ {
+ Parse::RecDescent::_error("Incomplete <$next->{type}op:...>.", $line);
+ Parse::RecDescent::_hint(
+ "The current production ended without completing the
+ <$next->{type}op:...> directive that started near line
+ $next->{line}. Did you forget the closing '>'?");
+ }
+ }
+ return 1;
+}
+
+sub enddirective
+{
+ my ( $self, $line, $minrep, $maxrep ) = @_;
+ unless ($self->{op})
+ {
+ Parse::RecDescent::_error("Unmatched > found.", $line);
+ Parse::RecDescent::_hint(
+ "A '>' angle bracket was encountered, which typically
+ indicates the end of a directive. However no suitable
+ preceding directive was encountered. Typically this
+ indicates either a extra '>' in the grammar, or a
+ problem inside the previous directive.");
+ return;
+ }
+ my $op = pop @{$self->{op}};
+ my $span = @{$self->{items}} - $op->{offset};
+ if ($op->{type} =~ /left|right/)
+ {
+ if ($span != 3)
+ {
+ Parse::RecDescent::_error(
+ "Incorrect <$op->{type}op:...> specification:
+ expected 3 args, but found $span instead", $line);
+ Parse::RecDescent::_hint(
+ "The <$op->{type}op:...> directive requires a
+ sequence of exactly three elements. For example:
+ <$op->{type}op:leftarg /op/ rightarg>");
+ }
+ else
+ {
+ push @{$self->{items}},
+ Parse::RecDescent::Operator->new(
+ $op->{type}, $minrep, $maxrep, splice(@{$self->{"items"}}, -3));
+ $self->{items}[-1]->sethashname($self);
+ $self->{items}[-1]{name} = $op->{name};
+ }
+ }
+}
+
+sub prevwasreturn
+{
+ my ( $self, $line ) = @_;
+ unless (@{$self->{items}})
+ {
+ Parse::RecDescent::_error(
+ "Incorrect <return:...> specification:
+ expected item missing", $line);
+ Parse::RecDescent::_hint(
+ "The <return:...> directive requires a
+ sequence of at least one item. For example:
+ <return: list>");
+ return;
+ }
+ push @{$self->{items}},
+ Parse::RecDescent::Result->new();
+}
+
+sub additem
+{
+ my ( $self, $item ) = @_;
+ $item->sethashname($self);
+ push @{$self->{"items"}}, $item;
+ return $item;
+}
+
+sub _duplicate_itempos
+{
+ my ($src) = @_;
+ my $dst = {};
+
+ foreach (keys %$src)
+ {
+ %{$dst->{$_}} = %{$src->{$_}};
+ }
+ $dst;
+}
+
+sub _update_itempos
+{
+ my ($dst, $src, $typekeys, $poskeys) = @_;
+
+ my @typekeys = 'ARRAY' eq ref $typekeys ?
+ @$typekeys :
+ keys %$src;
+
+ foreach my $k (keys %$src)
+ {
+ if ('ARRAY' eq ref $poskeys)
+ {
+ @{$dst->{$k}}{@$poskeys} = @{$src->{$k}}{@$poskeys};
+ }
+ else
+ {
+ %{$dst->{$k}} = %{$src->{$k}};
+ }
+ }
+}
+
+sub preitempos
+{
+ return q
+ {
+ push @itempos, {'offset' => {'from'=>$thisoffset, 'to'=>undef},
+ 'line' => {'from'=>$thisline, 'to'=>undef},
+ 'column' => {'from'=>$thiscolumn, 'to'=>undef} };
+ }
+}
+
+sub incitempos
+{
+ return q
+ {
+ $itempos[$#itempos]{'offset'}{'from'} += length($lastsep);
+ $itempos[$#itempos]{'line'}{'from'} = $thisline;
+ $itempos[$#itempos]{'column'}{'from'} = $thiscolumn;
+ }
+}
+
+sub unincitempos
+{
+ # the next incitempos will properly set these two fields, but
+ # {'offset'}{'from'} needs to be decreased by length($lastsep)
+ # $itempos[$#itempos]{'line'}{'from'}
+ # $itempos[$#itempos]{'column'}{'from'}
+ return q
+ {
+ $itempos[$#itempos]{'offset'}{'from'} -= length($lastsep) if defined $lastsep;
+ }
+}
+
+sub postitempos
+{
+ return q
+ {
+ $itempos[$#itempos]{'offset'}{'to'} = $prevoffset;
+ $itempos[$#itempos]{'line'}{'to'} = $prevline;
+ $itempos[$#itempos]{'column'}{'to'} = $prevcolumn;
+ }
+}
+
+sub code($$$$)
+{
+ my ($self,$namespace,$rule,$parser) = @_;
+ my $code =
+'
+ while (!$_matched'
+ . (defined $self->{"uncommit"} ? '' : ' && !$commit')
+ . ')
+ {
+ ' .
+ ($self->changesskip()
+ ? 'local $skip = defined($skip) ? $skip : $Parse::RecDescent::skip;'
+ : '') .'
+ Parse::RecDescent::_trace(q{Trying production: ['
+ . $self->describe . ']},
+ Parse::RecDescent::_tracefirst($_[1]),
+ q{' . $rule ->{name}. '},
+ $tracelevel)
+ if defined $::RD_TRACE;
+ my $thisprod = $thisrule->{"prods"}[' . $self->{"number"} . '];
+ ' . (defined $self->{"error"} ? '' : '$text = $_[1];' ) . '
+ my $_savetext;
+ @item = (q{' . $rule->{"name"} . '});
+ %item = (__RULE__ => q{' . $rule->{"name"} . '});
+ my $repcount = 0;
+
+';
+ $code .=
+' my @itempos = ({});
+' if $parser->{_check}{itempos};
+
+ my $item;
+ my $i;
+
+ for ($i = 0; $i < @{$self->{"items"}}; $i++)
+ {
+ $item = ${$self->{items}}[$i];
+
+ $code .= preitempos() if $parser->{_check}{itempos};
+
+ $code .= $item->code($namespace,$rule,$parser->{_check});
+
+ $code .= postitempos() if $parser->{_check}{itempos};
+
+ }
+
+ if ($parser->{_AUTOACTION} && defined($item) && !$item->isa("Parse::RecDescent::Action"))
+ {
+ $code .= $parser->{_AUTOACTION}->code($namespace,$rule);
+ Parse::RecDescent::_warn(1,"Autogenerating action in rule
+ \"$rule->{name}\":
+ $parser->{_AUTOACTION}{code}")
+ and
+ Parse::RecDescent::_hint("The \$::RD_AUTOACTION was defined,
+ so any production not ending in an
+ explicit action has the specified
+ \"auto-action\" automatically
+ appended.");
+ }
+ elsif ($parser->{_AUTOTREE} && defined($item) && !$item->isa("Parse::RecDescent::Action"))
+ {
+ if ($i==1 && $item->isterminal)
+ {
+ $code .= $parser->{_AUTOTREE}{TERMINAL}->code($namespace,$rule);
+ }
+ else
+ {
+ $code .= $parser->{_AUTOTREE}{NODE}->code($namespace,$rule);
+ }
+ Parse::RecDescent::_warn(1,"Autogenerating tree-building action in rule
+ \"$rule->{name}\"")
+ and
+ Parse::RecDescent::_hint("The directive <autotree> was specified,
+ so any production not ending
+ in an explicit action has
+ some parse-tree building code
+ automatically appended.");
+ }
+
+ $code .=
+'
+ Parse::RecDescent::_trace(q{>>'.Parse::RecDescent::_matchtracemessage($self).' production: ['
+ . $self->describe . ']<<},
+ Parse::RecDescent::_tracefirst($text),
+ q{' . $rule->{name} . '},
+ $tracelevel)
+ if defined $::RD_TRACE;
+
+' . ( $parser->{_check}{itempos} ? '
+ if ( defined($_itempos) )
+ {
+ Parse::RecDescent::Production::_update_itempos($_itempos, $itempos[ 1], undef, [qw(from)]);
+ Parse::RecDescent::Production::_update_itempos($_itempos, $itempos[-1], undef, [qw(to)]);
+ }
+' : '' ) . '
+
+ $_matched = 1;
+ last;
+ }
+
+';
+ return $code;
+}
+
+1;
+
+package Parse::RecDescent::Action;
+
+sub describe { undef }
+
+sub sethashname { $_[0]->{hashname} = '__ACTION' . ++$_[1]->{actcount} .'__'; }
+
+sub new
+{
+ my $class = ref($_[0]) || $_[0];
+ bless
+ {
+ "code" => $_[1],
+ "lookahead" => $_[2],
+ "line" => $_[3],
+ }, $class;
+}
+
+sub issubrule { undef }
+sub isterminal { 0 }
+
+sub code($$$$)
+{
+ my ($self, $namespace, $rule) = @_;
+
+'
+ Parse::RecDescent::_trace(q{Trying action},
+ Parse::RecDescent::_tracefirst($text),
+ q{' . $rule->{name} . '},
+ $tracelevel)
+ if defined $::RD_TRACE;
+ ' . ($self->{"lookahead"} ? '$_savetext = $text;' : '' ) .'
+
+ $_tok = ($_noactions) ? 0 : do ' . $self->{"code"} . ';
+ ' . ($self->{"lookahead"}<0?'if':'unless') . ' (defined $_tok)
+ {
+ Parse::RecDescent::_trace(q{<<'.Parse::RecDescent::_matchtracemessage($self,1).' action>> (return value: [undef])})
+ if defined $::RD_TRACE;
+ last;
+ }
+ Parse::RecDescent::_trace(q{>>'.Parse::RecDescent::_matchtracemessage($self).' action<< (return value: [}
+ . $_tok . q{])},
+ Parse::RecDescent::_tracefirst($text))
+ if defined $::RD_TRACE;
+ push @item, $_tok;
+ ' . ($self->{line}>=0 ? '$item{'. $self->{hashname} .'}=$_tok;' : '' ) .'
+ ' . ($self->{"lookahead"} ? '$text = $_savetext;' : '' ) .'
+'
+}
+
+
+1;
+
+package Parse::RecDescent::Directive;
+
+sub sethashname { $_[0]->{hashname} = '__DIRECTIVE' . ++$_[1]->{dircount} . '__'; }
+
+sub issubrule { undef }
+sub isterminal { 0 }
+sub describe { $_[1] ? '' : $_[0]->{name} }
+
+sub new ($$$$$)
+{
+ my $class = ref($_[0]) || $_[0];
+ bless
+ {
+ "code" => $_[1],
+ "lookahead" => $_[2],
+ "line" => $_[3],
+ "name" => $_[4],
+ }, $class;
+}
+
+sub code($$$$)
+{
+ my ($self, $namespace, $rule) = @_;
+
+'
+ ' . ($self->{"lookahead"} ? '$_savetext = $text;' : '' ) .'
+
+ Parse::RecDescent::_trace(q{Trying directive: ['
+ . $self->describe . ']},
+ Parse::RecDescent::_tracefirst($text),
+ q{' . $rule->{name} . '},
+ $tracelevel)
+ if defined $::RD_TRACE; ' .'
+ $_tok = do { ' . $self->{"code"} . ' };
+ if (defined($_tok))
+ {
+ Parse::RecDescent::_trace(q{>>'.Parse::RecDescent::_matchtracemessage($self).' directive<< (return value: [}
+ . $_tok . q{])},
+ Parse::RecDescent::_tracefirst($text))
+ if defined $::RD_TRACE;
+ }
+ else
+ {
+ Parse::RecDescent::_trace(q{<<'.Parse::RecDescent::_matchtracemessage($self,1).' directive>>},
+ Parse::RecDescent::_tracefirst($text))
+ if defined $::RD_TRACE;
+ }
+ ' . ($self->{"lookahead"} ? '$text = $_savetext and ' : '' ) .'
+ last '
+ . ($self->{"lookahead"}<0?'if':'unless') . ' defined $_tok;
+ push @item, $item{'.$self->{hashname}.'}=$_tok;
+ ' . ($self->{"lookahead"} ? '$text = $_savetext;' : '' ) .'
+'
+}
+
+1;
+
+package Parse::RecDescent::UncondReject;
+
+sub issubrule { undef }
+sub isterminal { 0 }
+sub describe { $_[1] ? '' : $_[0]->{name} }
+sub sethashname { $_[0]->{hashname} = '__DIRECTIVE' . ++$_[1]->{dircount} . '__'; }
+
+sub new ($$$;$)
+{
+ my $class = ref($_[0]) || $_[0];
+ bless
+ {
+ "lookahead" => $_[1],
+ "line" => $_[2],
+ "name" => $_[3],
+ }, $class;
+}
+
+# MARK, YOU MAY WANT TO OPTIMIZE THIS.
+
+
+sub code($$$$)
+{
+ my ($self, $namespace, $rule) = @_;
+
+'
+ Parse::RecDescent::_trace(q{>>Rejecting production<< (found '
+ . $self->describe . ')},
+ Parse::RecDescent::_tracefirst($text),
+ q{' . $rule->{name} . '},
+ $tracelevel)
+ if defined $::RD_TRACE;
+ undef $return;
+ ' . ($self->{"lookahead"} ? '$_savetext = $text;' : '' ) .'
+
+ $_tok = undef;
+ ' . ($self->{"lookahead"} ? '$text = $_savetext and ' : '' ) .'
+ last '
+ . ($self->{"lookahead"}<0?'if':'unless') . ' defined $_tok;
+'
+}
+
+1;
+
+package Parse::RecDescent::Error;
+
+sub issubrule { undef }
+sub isterminal { 0 }
+sub describe { $_[1] ? '' : $_[0]->{commitonly} ? '<error?:...>' : '<error...>' }
+sub sethashname { $_[0]->{hashname} = '__DIRECTIVE' . ++$_[1]->{dircount} . '__'; }
+
+sub new ($$$$$)
+{
+ my $class = ref($_[0]) || $_[0];
+ bless
+ {
+ "msg" => $_[1],
+ "lookahead" => $_[2],
+ "commitonly" => $_[3],
+ "line" => $_[4],
+ }, $class;
+}
+
+sub code($$$$)
+{
+ my ($self, $namespace, $rule) = @_;
+
+ my $action = '';
+
+ if ($self->{"msg"}) # ERROR MESSAGE SUPPLIED
+ {
+ #WAS: $action .= "Parse::RecDescent::_error(qq{$self->{msg}}" . ',$thisline);';
+ $action .= 'push @{$thisparser->{errors}}, [qq{'.$self->{msg}.'},$thisline];';
+
+ }
+ else # GENERATE ERROR MESSAGE DURING PARSE
+ {
+ $action .= '
+ my $rule = $item[0];
+ $rule =~ s/_/ /g;
+ #WAS: Parse::RecDescent::_error("Invalid $rule: " . $expectation->message() ,$thisline);
+ push @{$thisparser->{errors}}, ["Invalid $rule: " . $expectation->message() ,$thisline];
+ ';
+ }
+
+ my $dir =
+ new Parse::RecDescent::Directive('if (' .
+ ($self->{"commitonly"} ? '$commit' : '1') .
+ ") { do {$action} unless ".' $_noactions; undef } else {0}',
+ $self->{"lookahead"},0,$self->describe);
+ $dir->{hashname} = $self->{hashname};
+ return $dir->code($namespace, $rule, 0);
+}
+
+1;
+
+package Parse::RecDescent::Token;
+
+sub sethashname { $_[0]->{hashname} = '__PATTERN' . ++$_[1]->{patcount} . '__'; }
+
+sub issubrule { undef }
+sub isterminal { 1 }
+sub describe ($) { shift->{'description'}}
+
+
+# ARGS ARE: $self, $pattern, $left_delim, $modifiers, $lookahead, $linenum
+sub new ($$$$$$)
+{
+ my $class = ref($_[0]) || $_[0];
+ my $pattern = $_[1];
+ my $pat = $_[1];
+ my $ldel = $_[2];
+ my $rdel = $ldel;
+ $rdel =~ tr/{[(</}])>/;
+
+ my $mod = $_[3];
+
+ my $desc;
+
+ if ($ldel eq '/') { $desc = "$ldel$pattern$rdel$mod" }
+ else { $desc = "m$ldel$pattern$rdel$mod" }
+ $desc =~ s/\\/\\\\/g;
+ $desc =~ s/\$$/\\\$/g;
+ $desc =~ s/}/\\}/g;
+ $desc =~ s/{/\\{/g;
+
+ if (!eval "no strict;
+ local \$SIG{__WARN__} = sub {0};
+ '' =~ m$ldel$pattern$rdel$mod" and $@)
+ {
+ Parse::RecDescent::_warn(3, "Token pattern \"m$ldel$pattern$rdel$mod\"
+ may not be a valid regular expression",
+ $_[5]);
+ $@ =~ s/ at \(eval.*/./;
+ Parse::RecDescent::_hint($@);
+ }
+
+ # QUIETLY PREVENT (WELL-INTENTIONED) CALAMITY
+ $mod =~ s/[gc]//g;
+ $pattern =~ s/(\A|[^\\])\\G/$1/g;
+
+ bless
+ {
+ "pattern" => $pattern,
+ "ldelim" => $ldel,
+ "rdelim" => $rdel,
+ "mod" => $mod,
+ "lookahead" => $_[4],
+ "line" => $_[5],
+ "description" => $desc,
+ }, $class;
+}
+
+
+sub code($$$$$)
+{
+ my ($self, $namespace, $rule, $check) = @_;
+ my $ldel = $self->{"ldelim"};
+ my $rdel = $self->{"rdelim"};
+ my $sdel = $ldel;
+ my $mod = $self->{"mod"};
+
+ $sdel =~ s/[[{(<]/{}/;
+
+my $code = '
+ Parse::RecDescent::_trace(q{Trying terminal: [' . $self->describe
+ . ']}, Parse::RecDescent::_tracefirst($text),
+ q{' . $rule->{name} . '},
+ $tracelevel)
+ if defined $::RD_TRACE;
+ undef $lastsep;
+ $expectation->is(q{' . ($rule->hasleftmost($self) ? ''
+ : $self->describe ) . '})->at($text);
+ ' . ($self->{"lookahead"} ? '$_savetext = $text;' : '' ) . '
+
+ ' . ($self->{"lookahead"}<0?'if':'unless')
+ . ' ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and '
+ . ($check->{itempos}? 'do {'.Parse::RecDescent::Production::incitempos().' 1} and ' : '')
+ . ' $text =~ m' . $ldel . '\A(?:' . $self->{"pattern"} . ')' . $rdel . $mod . ')
+ {
+ '.($self->{"lookahead"} ? '$text = $_savetext;' : '$text = $lastsep . $text if defined $lastsep;') .
+ ($check->{itempos} ? Parse::RecDescent::Production::unincitempos() : '') . '
+ $expectation->failed();
+ Parse::RecDescent::_trace(q{<<Didn\'t match terminal>>},
+ Parse::RecDescent::_tracefirst($text))
+ if defined $::RD_TRACE;
+
+ last;
+ }
+ $current_match = substr($text, $-[0], $+[0] - $-[0]);
+ substr($text,0,length($current_match),q{});
+ Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
+ . $current_match . q{])},
+ Parse::RecDescent::_tracefirst($text))
+ if defined $::RD_TRACE;
+ push @item, $item{'.$self->{hashname}.'}=$current_match;
+ ' . ($self->{"lookahead"} ? '$text = $_savetext;' : '' ) .'
+';
+
+ return $code;
+}
+
+1;
+
+package Parse::RecDescent::Literal;
+
+sub sethashname { $_[0]->{hashname} = '__STRING' . ++$_[1]->{strcount} . '__'; }
+
+sub issubrule { undef }
+sub isterminal { 1 }
+sub describe ($) { shift->{'description'} }
+
+sub new ($$$$)
+{
+ my $class = ref($_[0]) || $_[0];
+
+ my $pattern = $_[1];
+
+ my $desc = $pattern;
+ $desc=~s/\\/\\\\/g;
+ $desc=~s/}/\\}/g;
+ $desc=~s/{/\\{/g;
+
+ bless
+ {
+ "pattern" => $pattern,
+ "lookahead" => $_[2],
+ "line" => $_[3],
+ "description" => "'$desc'",
+ }, $class;
+}
+
+
+sub code($$$$)
+{
+ my ($self, $namespace, $rule, $check) = @_;
+
+my $code = '
+ Parse::RecDescent::_trace(q{Trying terminal: [' . $self->describe
+ . ']},
+ Parse::RecDescent::_tracefirst($text),
+ q{' . $rule->{name} . '},
+ $tracelevel)
+ if defined $::RD_TRACE;
+ undef $lastsep;
+ $expectation->is(q{' . ($rule->hasleftmost($self) ? ''
+ : $self->describe ) . '})->at($text);
+ ' . ($self->{"lookahead"} ? '$_savetext = $text;' : '' ) . '
+
+ ' . ($self->{"lookahead"}<0?'if':'unless')
+ . ' ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and '
+ . ($check->{itempos}? 'do {'.Parse::RecDescent::Production::incitempos().' 1} and ' : '')
+ . ' $text =~ m/\A' . quotemeta($self->{"pattern"}) . '/)
+ {
+ '.($self->{"lookahead"} ? '$text = $_savetext;' : '$text = $lastsep . $text if defined $lastsep;').'
+ '. ($check->{itempos} ? Parse::RecDescent::Production::unincitempos() : '') . '
+ $expectation->failed();
+ Parse::RecDescent::_trace(qq{<<Didn\'t match terminal>>},
+ Parse::RecDescent::_tracefirst($text))
+ if defined $::RD_TRACE;
+ last;
+ }
+ $current_match = substr($text, $-[0], $+[0] - $-[0]);
+ substr($text,0,length($current_match),q{});
+ Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
+ . $current_match . q{])},
+ Parse::RecDescent::_tracefirst($text))
+ if defined $::RD_TRACE;
+ push @item, $item{'.$self->{hashname}.'}=$current_match;
+ ' . ($self->{"lookahead"} ? '$text = $_savetext;' : '' ) .'
+';
+
+ return $code;
+}
+
+1;
+
+package Parse::RecDescent::InterpLit;
+
+sub sethashname { $_[0]->{hashname} = '__STRING' . ++$_[1]->{strcount} . '__'; }
+
+sub issubrule { undef }
+sub isterminal { 1 }
+sub describe ($) { shift->{'description'} }
+
+sub new ($$$$)
+{
+ my $class = ref($_[0]) || $_[0];
+
+ my $pattern = $_[1];
+ $pattern =~ s#/#\\/#g;
+
+ my $desc = $pattern;
+ $desc=~s/\\/\\\\/g;
+ $desc=~s/}/\\}/g;
+ $desc=~s/{/\\{/g;
+
+ bless
+ {
+ "pattern" => $pattern,
+ "lookahead" => $_[2],
+ "line" => $_[3],
+ "description" => "'$desc'",
+ }, $class;
+}
+
+sub code($$$$)
+{
+ my ($self, $namespace, $rule, $check) = @_;
+
+my $code = '
+ Parse::RecDescent::_trace(q{Trying terminal: [' . $self->describe
+ . ']},
+ Parse::RecDescent::_tracefirst($text),
+ q{' . $rule->{name} . '},
+ $tracelevel)
+ if defined $::RD_TRACE;
+ undef $lastsep;
+ $expectation->is(q{' . ($rule->hasleftmost($self) ? ''
+ : $self->describe ) . '})->at($text);
+ ' . ($self->{"lookahead"} ? '$_savetext = $text;' : '' ) . '
+
+ ' . ($self->{"lookahead"}<0?'if':'unless')
+ . ' ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and '
+ . ($check->{itempos}? 'do {'.Parse::RecDescent::Production::incitempos().' 1} and ' : '')
+ . ' do { $_tok = "' . $self->{"pattern"} . '"; 1 } and
+ substr($text,0,length($_tok)) eq $_tok and
+ do { substr($text,0,length($_tok)) = ""; 1; }
+ )
+ {
+ '.($self->{"lookahead"} ? '$text = $_savetext;' : '$text = $lastsep . $text if defined $lastsep;').'
+ '. ($check->{itempos} ? Parse::RecDescent::Production::unincitempos() : '') . '
+ $expectation->failed();
+ Parse::RecDescent::_trace(q{<<Didn\'t match terminal>>},
+ Parse::RecDescent::_tracefirst($text))
+ if defined $::RD_TRACE;
+ last;
+ }
+ Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
+ . $_tok . q{])},
+ Parse::RecDescent::_tracefirst($text))
+ if defined $::RD_TRACE;
+ push @item, $item{'.$self->{hashname}.'}=$_tok;
+ ' . ($self->{"lookahead"} ? '$text = $_savetext;' : '' ) .'
+';
+
+ return $code;
+}
+
+1;
+
+package Parse::RecDescent::Subrule;
+
+sub issubrule ($) { return $_[0]->{"subrule"} }
+sub isterminal { 0 }
+sub sethashname {}
+
+sub describe ($)
+{
+ my $desc = $_[0]->{"implicit"} || $_[0]->{"subrule"};
+ $desc = "<matchrule:$desc>" if $_[0]->{"matchrule"};
+ return $desc;
+}
+
+sub callsyntax($$)
+{
+ if ($_[0]->{"matchrule"})
+ {
+ return "&{'$_[1]'.qq{$_[0]->{subrule}}}";
+ }
+ else
+ {
+ return $_[1].$_[0]->{"subrule"};
+ }
+}
+
+sub new ($$$$;$$$)
+{
+ my $class = ref($_[0]) || $_[0];
+ bless
+ {
+ "subrule" => $_[1],
+ "lookahead" => $_[2],
+ "line" => $_[3],
+ "implicit" => $_[4] || undef,
+ "matchrule" => $_[5],
+ "argcode" => $_[6] || undef,
+ }, $class;
+}
+
+
+sub code($$$$)
+{
+ my ($self, $namespace, $rule, $check) = @_;
+
+'
+ Parse::RecDescent::_trace(q{Trying subrule: [' . $self->{"subrule"} . ']},
+ Parse::RecDescent::_tracefirst($text),
+ q{' . $rule->{"name"} . '},
+ $tracelevel)
+ if defined $::RD_TRACE;
+ if (1) { no strict qw{refs};
+ $expectation->is(' . ($rule->hasleftmost($self) ? 'q{}'
+ # WAS : 'qq{'.$self->describe.'}' ) . ')->at($text);
+ : 'q{'.$self->describe.'}' ) . ')->at($text);
+ ' . ($self->{"lookahead"} ? '$_savetext = $text;' : '' )
+ . ($self->{"lookahead"}<0?'if':'unless')
+ . ' (defined ($_tok = '
+ . $self->callsyntax($namespace.'::')
+ . '($thisparser,$text,$repeating,'
+ . ($self->{"lookahead"}?'1':'$_noactions')
+ . ($check->{"itempos"}?',$itempos[$#itempos]':',undef')
+ . ($self->{argcode} ? ",sub { return $self->{argcode} }"
+ : ',sub { \\@arg }')
+ . ')))
+ {
+ '.($self->{"lookahead"} ? '$text = $_savetext;' : '').'
+ Parse::RecDescent::_trace(q{<<'.Parse::RecDescent::_matchtracemessage($self,1).' subrule: ['
+ . $self->{subrule} . ']>>},
+ Parse::RecDescent::_tracefirst($text),
+ q{' . $rule->{"name"} .'},
+ $tracelevel)
+ if defined $::RD_TRACE;
+ $expectation->failed();
+ last;
+ }
+ Parse::RecDescent::_trace(q{>>'.Parse::RecDescent::_matchtracemessage($self).' subrule: ['
+ . $self->{subrule} . ']<< (return value: [}
+ . $_tok . q{]},
+
+ Parse::RecDescent::_tracefirst($text),
+ q{' . $rule->{"name"} .'},
+ $tracelevel)
+ if defined $::RD_TRACE;
+ $item{q{' . $self->{subrule} . '}} = $_tok;
+ push @item, $_tok;
+ ' . ($self->{"lookahead"} ? '$text = $_savetext;' : '' ) .'
+ }
+'
+}
+
+package Parse::RecDescent::Repetition;
+
+sub issubrule ($) { return $_[0]->{"subrule"} }
+sub isterminal { 0 }
+sub sethashname { }
+
+sub describe ($)
+{
+ my $desc = $_[0]->{"expected"} || $_[0]->{"subrule"};
+ $desc = "<matchrule:$desc>" if $_[0]->{"matchrule"};
+ return $desc;
+}
+
+sub callsyntax($$)
+{
+ if ($_[0]->{matchrule})
+ { return "sub { goto &{''.qq{$_[1]$_[0]->{subrule}}} }"; }
+ else
+ { return "\\&$_[1]$_[0]->{subrule}"; }
+}
+
+sub new ($$$$$$$$$$)
+{
+ my ($self, $subrule, $repspec, $min, $max, $lookahead, $line, $parser, $matchrule, $argcode) = @_;
+ my $class = ref($self) || $self;
+ ($max, $min) = ( $min, $max) if ($max<$min);
+
+ my $desc;
+ if ($subrule=~/\A_alternation_\d+_of_production_\d+_of_rule/)
+ { $desc = $parser->{"rules"}{$subrule}->expected }
+
+ if ($lookahead)
+ {
+ if ($min>0)
+ {
+ return new Parse::RecDescent::Subrule($subrule,$lookahead,$line,$desc,$matchrule,$argcode);
+ }
+ else
+ {
+ Parse::RecDescent::_error("Not symbol (\"!\") before
+ \"$subrule\" doesn't make
+ sense.",$line);
+ Parse::RecDescent::_hint("Lookahead for negated optional
+ repetitions (such as
+ \"!$subrule($repspec)\" can never
+ succeed, since optional items always
+ match (zero times at worst).
+ Did you mean a single \"!$subrule\",
+ instead?");
+ }
+ }
+ bless
+ {
+ "subrule" => $subrule,
+ "repspec" => $repspec,
+ "min" => $min,
+ "max" => $max,
+ "lookahead" => $lookahead,
+ "line" => $line,
+ "expected" => $desc,
+ "argcode" => $argcode || undef,
+ "matchrule" => $matchrule,
+ }, $class;
+}
+
+sub code($$$$)
+{
+ my ($self, $namespace, $rule, $check) = @_;
+
+ my ($subrule, $repspec, $min, $max, $lookahead) =
+ @{$self}{ qw{subrule repspec min max lookahead} };
+
+'
+ Parse::RecDescent::_trace(q{Trying repeated subrule: [' . $self->describe . ']},
+ Parse::RecDescent::_tracefirst($text),
+ q{' . $rule->{"name"} . '},
+ $tracelevel)
+ if defined $::RD_TRACE;
+ $expectation->is(' . ($rule->hasleftmost($self) ? 'q{}'
+ # WAS : 'qq{'.$self->describe.'}' ) . ')->at($text);
+ : 'q{'.$self->describe.'}' ) . ')->at($text);
+ ' . ($self->{"lookahead"} ? '$_savetext = $text;' : '' ) .'
+ unless (defined ($_tok = $thisparser->_parserepeat($text, '
+ . $self->callsyntax($namespace.'::')
+ . ', ' . $min . ', ' . $max . ', '
+ . ($self->{"lookahead"}?'1':'$_noactions')
+ . ($check->{"itempos"}?',$itempos[$#itempos]':',undef')
+ . ',$expectation,'
+ . ($self->{argcode} ? "sub { return $self->{argcode} }"
+ : 'sub { \\@arg }')
+ . ')))
+ {
+ Parse::RecDescent::_trace(q{<<'.Parse::RecDescent::_matchtracemessage($self,1).' repeated subrule: ['
+ . $self->describe . ']>>},
+ Parse::RecDescent::_tracefirst($text),
+ q{' . $rule->{"name"} .'},
+ $tracelevel)
+ if defined $::RD_TRACE;
+ last;
+ }
+ Parse::RecDescent::_trace(q{>>'.Parse::RecDescent::_matchtracemessage($self).' repeated subrule: ['
+ . $self->{subrule} . ']<< (}
+ . @$_tok . q{ times)},
+
+ Parse::RecDescent::_tracefirst($text),
+ q{' . $rule->{"name"} .'},
+ $tracelevel)
+ if defined $::RD_TRACE;
+ $item{q{' . "$self->{subrule}($self->{repspec})" . '}} = $_tok;
+ push @item, $_tok;
+ ' . ($self->{"lookahead"} ? '$text = $_savetext;' : '' ) .'
+
+'
+}
+
+package Parse::RecDescent::Result;
+
+sub issubrule { 0 }
+sub isterminal { 0 }
+sub describe { '' }
+
+sub new
+{
+ my ($class, $pos) = @_;
+
+ bless {}, $class;
+}
+
+sub code($$$$)
+{
+ my ($self, $namespace, $rule) = @_;
+
+ '
+ $return = $item[-1];
+ ';
+}
+
+package Parse::RecDescent::Operator;
+
+my @opertype = ( " non-optional", "n optional" );
+
+sub issubrule { 0 }
+sub isterminal { 0 }
+
+sub describe { $_[0]->{"expected"} }
+sub sethashname { $_[0]->{hashname} = '__DIRECTIVE' . ++$_[1]->{dircount} . '__'; }
+
+
+sub new
+{
+ my ($class, $type, $minrep, $maxrep, $leftarg, $op, $rightarg) = @_;
+
+ bless
+ {
+ "type" => "${type}op",
+ "leftarg" => $leftarg,
+ "op" => $op,
+ "min" => $minrep,
+ "max" => $maxrep,
+ "rightarg" => $rightarg,
+ "expected" => "<${type}op: ".$leftarg->describe." ".$op->describe." ".$rightarg->describe.">",
+ }, $class;
+}
+
+sub code($$$$)
+{
+ my ($self, $namespace, $rule, $check) = @_;
+
+ my @codeargs = @_[1..$#_];
+
+ my ($leftarg, $op, $rightarg) =
+ @{$self}{ qw{leftarg op rightarg} };
+
+ my $code = '
+ Parse::RecDescent::_trace(q{Trying operator: [' . $self->describe . ']},
+ Parse::RecDescent::_tracefirst($text),
+ q{' . $rule->{"name"} . '},
+ $tracelevel)
+ if defined $::RD_TRACE;
+ $expectation->is(' . ($rule->hasleftmost($self) ? 'q{}'
+ # WAS : 'qq{'.$self->describe.'}' ) . ')->at($text);
+ : 'q{'.$self->describe.'}' ) . ')->at($text);
+
+ $_tok = undef;
+ OPLOOP: while (1)
+ {
+ $repcount = 0;
+ my @item;
+ my %item;
+';
+
+ $code .= '
+ my $_itempos = $itempos[-1];
+ my $itemposfirst;
+' if $check->{itempos};
+
+ if ($self->{type} eq "leftop" )
+ {
+ $code .= '
+ # MATCH LEFTARG
+ ' . $leftarg->code(@codeargs) . '
+
+';
+
+ $code .= '
+ if (defined($_itempos) and !defined($itemposfirst))
+ {
+ $itemposfirst = Parse::RecDescent::Production::_duplicate_itempos($_itempos);
+ }
+' if $check->{itempos};
+
+ $code .= '
+ $repcount++;
+
+ my $savetext = $text;
+ my $backtrack;
+
+ # MATCH (OP RIGHTARG)(s)
+ while ($repcount < ' . $self->{max} . ')
+ {
+ $backtrack = 0;
+ ' . $op->code(@codeargs) . '
+ ' . ($op->isterminal() ? 'pop @item;' : '$backtrack=1;' ) . '
+ ' . (ref($op) eq 'Parse::RecDescent::Token'
+ ? 'if (defined $1) {push @item, $item{'.($self->{name}||$self->{hashname}).'}=$1; $backtrack=1;}'
+ : "" ) . '
+ ' . $rightarg->code(@codeargs) . '
+ $savetext = $text;
+ $repcount++;
+ }
+ $text = $savetext;
+ pop @item if $backtrack;
+
+ ';
+ }
+ else
+ {
+ $code .= '
+ my $savetext = $text;
+ my $backtrack;
+ # MATCH (LEFTARG OP)(s)
+ while ($repcount < ' . $self->{max} . ')
+ {
+ $backtrack = 0;
+ ' . $leftarg->code(@codeargs) . '
+';
+ $code .= '
+ if (defined($_itempos) and !defined($itemposfirst))
+ {
+ $itemposfirst = Parse::RecDescent::Production::_duplicate_itempos($_itempos);
+ }
+' if $check->{itempos};
+
+ $code .= '
+ $repcount++;
+ $backtrack = 1;
+ ' . $op->code(@codeargs) . '
+ $savetext = $text;
+ ' . ($op->isterminal() ? 'pop @item;' : "" ) . '
+ ' . (ref($op) eq 'Parse::RecDescent::Token' ? 'do { push @item, $item{'.($self->{name}||$self->{hashname}).'}=$1; } if defined $1;' : "" ) . '
+ }
+ $text = $savetext;
+ pop @item if $backtrack;
+
+ # MATCH RIGHTARG
+ ' . $rightarg->code(@codeargs) . '
+ $repcount++;
+ ';
+ }
+
+ $code .= 'unless (@item) { undef $_tok; last }' unless $self->{min}==0;
+
+ $code .= '
+ $_tok = [ @item ];
+';
+
+
+ $code .= '
+ if (defined $itemposfirst)
+ {
+ Parse::RecDescent::Production::_update_itempos(
+ $_itempos, $itemposfirst, undef, [qw(from)]);
+ }
+' if $check->{itempos};
+
+ $code .= '
+ last;
+ } # end of OPLOOP
+';
+
+ $code .= '
+ unless ($repcount>='.$self->{min}.')
+ {
+ Parse::RecDescent::_trace(q{<<'.Parse::RecDescent::_matchtracemessage($self,1).' operator: ['
+ . $self->describe
+ . ']>>},
+ Parse::RecDescent::_tracefirst($text),
+ q{' . $rule->{"name"} .'},
+ $tracelevel)
+ if defined $::RD_TRACE;
+ $expectation->failed();
+ last;
+ }
+ Parse::RecDescent::_trace(q{>>'.Parse::RecDescent::_matchtracemessage($self).' operator: ['
+ . $self->describe
+ . ']<< (return value: [}
+ . qq{@{$_tok||[]}} . q{]},
+ Parse::RecDescent::_tracefirst($text),
+ q{' . $rule->{"name"} .'},
+ $tracelevel)
+ if defined $::RD_TRACE;
+
+ push @item, $item{'.($self->{name}||$self->{hashname}).'}=$_tok||[];
+';
+
+ return $code;
+}
+
+
+package Parse::RecDescent::Expectation;
+
+sub new ($)
+{
+ bless {
+ "failed" => 0,
+ "expected" => "",
+ "unexpected" => "",
+ "lastexpected" => "",
+ "lastunexpected" => "",
+ "defexpected" => $_[1],
+ };
+}
+
+sub is ($$)
+{
+ $_[0]->{lastexpected} = $_[1]; return $_[0];
+}
+
+sub at ($$)
+{
+ $_[0]->{lastunexpected} = $_[1]; return $_[0];
+}
+
+sub failed ($)
+{
+ return unless $_[0]->{lastexpected};
+ $_[0]->{expected} = $_[0]->{lastexpected} unless $_[0]->{failed};
+ $_[0]->{unexpected} = $_[0]->{lastunexpected} unless $_[0]->{failed};
+ $_[0]->{failed} = 1;
+}
+
+sub message ($)
+{
+ my ($self) = @_;
+ $self->{expected} = $self->{defexpected} unless $self->{expected};
+ $self->{expected} =~ s/_/ /g;
+ if (!$self->{unexpected} || $self->{unexpected} =~ /\A\s*\Z/s)
+ {
+ return "Was expecting $self->{expected}";
+ }
+ else
+ {
+ $self->{unexpected} =~ /\s*(.*)/;
+ return "Was expecting $self->{expected} but found \"$1\" instead";
+ }
+}
+
+1;
+
+package Parse::RecDescent;
+
+use Carp;
+use vars qw ( $AUTOLOAD $VERSION $_FILENAME);
+
+my $ERRORS = 0;
+
+our $VERSION = '1.967006';
+$VERSION = eval $VERSION;
+$_FILENAME=__FILE__;
+
+# BUILDING A PARSER
+
+my $nextnamespace = "namespace000001";
+
+sub _nextnamespace()
+{
+ return "Parse::RecDescent::" . $nextnamespace++;
+}
+
+# ARGS ARE: $class, $grammar, $compiling, $namespace
+sub new ($$$$)
+{
+ my $class = ref($_[0]) || $_[0];
+ local $Parse::RecDescent::compiling = $_[2];
+ my $name_space_name = defined $_[3]
+ ? "Parse::RecDescent::".$_[3]
+ : _nextnamespace();
+ my $self =
+ {
+ "rules" => {},
+ "namespace" => $name_space_name,
+ "startcode" => '',
+ "localvars" => '',
+ "_AUTOACTION" => undef,
+ "_AUTOTREE" => undef,
+ };
+
+
+ if ($::RD_AUTOACTION) {
+ my $sourcecode = $::RD_AUTOACTION;
+ $sourcecode = "{ $sourcecode }"
+ unless $sourcecode =~ /\A\s*\{.*\}\s*\Z/;
+ $self->{_check}{itempos} =
+ $sourcecode =~ /\@itempos\b|\$itempos\s*\[/;
+ $self->{_AUTOACTION}
+ = new Parse::RecDescent::Action($sourcecode,0,-1)
+ }
+
+ bless $self, $class;
+ return $self->Replace($_[1])
+}
+
+sub Compile($$$$) {
+ die "Compilation of Parse::RecDescent grammars not yet implemented\n";
+}
+
+sub DESTROY {
+ my ($self) = @_;
+ my $namespace = $self->{namespace};
+ $namespace =~ s/Parse::RecDescent:://;
+ if (!$self->{_precompiled}) {
+ delete $Parse::RecDescent::{$namespace.'::'};
+ }
+}
+
+# BUILDING A GRAMMAR....
+
+# ARGS ARE: $self, $grammar, $isimplicit, $isleftop
+sub Replace ($$)
+{
+ # set $replace = 1 for _generate
+ splice(@_, 2, 0, 1);
+
+ return _generate(@_);
+}
+
+# ARGS ARE: $self, $grammar, $isimplicit, $isleftop
+sub Extend ($$)
+{
+ # set $replace = 0 for _generate
+ splice(@_, 2, 0, 0);
+
+ return _generate(@_);
+}
+
+sub _no_rule ($$;$)
+{
+ _error("Ruleless $_[0] at start of grammar.",$_[1]);
+ my $desc = $_[2] ? "\"$_[2]\"" : "";
+ _hint("You need to define a rule for the $_[0] $desc
+ to be part of.");
+}
+
+my $NEGLOOKAHEAD = '\G(\s*\.\.\.\!)';
+my $POSLOOKAHEAD = '\G(\s*\.\.\.)';
+my $RULE = '\G\s*(\w+)[ \t]*:';
+my $PROD = '\G\s*([|])';
+my $TOKEN = q{\G\s*/((\\\\/|\\\\\\\\|[^/])*)/([cgimsox]*)};
+my $MTOKEN = q{\G\s*(m\s*[^\w\s])};
+my $LITERAL = q{\G\s*'((\\\\['\\\\]|[^'])*)'};
+my $INTERPLIT = q{\G\s*"((\\\\["\\\\]|[^"])*)"};
+my $SUBRULE = '\G\s*(\w+)';
+my $MATCHRULE = '\G(\s*<matchrule:)';
+my $SIMPLEPAT = '((\\s+/[^/\\\\]*(?:\\\\.[^/\\\\]*)*/)?)';
+my $OPTIONAL = '\G\((\?)'.$SIMPLEPAT.'\)';
+my $ANY = '\G\((s\?)'.$SIMPLEPAT.'\)';
+my $MANY = '\G\((s|\.\.)'.$SIMPLEPAT.'\)';
+my $EXACTLY = '\G\(([1-9]\d*)'.$SIMPLEPAT.'\)';
+my $BETWEEN = '\G\((\d+)\.\.([1-9]\d*)'.$SIMPLEPAT.'\)';
+my $ATLEAST = '\G\((\d+)\.\.'.$SIMPLEPAT.'\)';
+my $ATMOST = '\G\(\.\.([1-9]\d*)'.$SIMPLEPAT.'\)';
+my $BADREP = '\G\((-?\d+)?\.\.(-?\d+)?'.$SIMPLEPAT.'\)';
+my $ACTION = '\G\s*\{';
+my $IMPLICITSUBRULE = '\G\s*\(';
+my $COMMENT = '\G\s*(#.*)';
+my $COMMITMK = '\G\s*<commit>';
+my $UNCOMMITMK = '\G\s*<uncommit>';
+my $QUOTELIKEMK = '\G\s*<perl_quotelike>';
+my $CODEBLOCKMK = '\G\s*<perl_codeblock(?:\s+([][()<>{}]+))?>';
+my $VARIABLEMK = '\G\s*<perl_variable>';
+my $NOCHECKMK = '\G\s*<nocheck>';
+my $AUTOACTIONPATMK = '\G\s*<autoaction:';
+my $AUTOTREEMK = '\G\s*<autotree(?::\s*([\w:]+)\s*)?>';
+my $AUTOSTUBMK = '\G\s*<autostub>';
+my $AUTORULEMK = '\G\s*<autorule:(.*?)>';
+my $REJECTMK = '\G\s*<reject>';
+my $CONDREJECTMK = '\G\s*<reject:';
+my $SCOREMK = '\G\s*<score:';
+my $AUTOSCOREMK = '\G\s*<autoscore:';
+my $SKIPMK = '\G\s*<skip:';
+my $OPMK = '\G\s*<(left|right)op(?:=(\'.*?\'))?:';
+my $ENDDIRECTIVEMK = '\G\s*>';
+my $RESYNCMK = '\G\s*<resync>';
+my $RESYNCPATMK = '\G\s*<resync:';
+my $RULEVARPATMK = '\G\s*<rulevar:';
+my $DEFERPATMK = '\G\s*<defer:';
+my $TOKENPATMK = '\G\s*<token:';
+my $AUTOERRORMK = '\G\s*<error(\??)>';
+my $MSGERRORMK = '\G\s*<error(\??):';
+my $NOCHECK = '\G\s*<nocheck>';
+my $WARNMK = '\G\s*<warn((?::\s*(\d+)\s*)?)>';
+my $HINTMK = '\G\s*<hint>';
+my $TRACEBUILDMK = '\G\s*<trace_build((?::\s*(\d+)\s*)?)>';
+my $TRACEPARSEMK = '\G\s*<trace_parse((?::\s*(\d+)\s*)?)>';
+my $UNCOMMITPROD = $PROD.'\s*<uncommit';
+my $ERRORPROD = $PROD.'\s*<error';
+my $LONECOLON = '\G\s*:';
+my $OTHER = '\G\s*([^\s]+)';
+
+my @lines = 0;
+
+sub _generate
+{
+ my ($self, $grammar, $replace, $isimplicit, $isleftop) = (@_, 0);
+
+ my $aftererror = 0;
+ my $lookahead = 0;
+ my $lookaheadspec = "";
+ my $must_pop_lines;
+ if (! $lines[-1]) {
+ push @lines, _linecount($grammar) ;
+ $must_pop_lines = 1;
+ }
+ $self->{_check}{itempos} = ($grammar =~ /\@itempos\b|\$itempos\s*\[/)
+ unless $self->{_check}{itempos};
+ for (qw(thisoffset thiscolumn prevline prevoffset prevcolumn))
+ {
+ $self->{_check}{$_} =
+ ($grammar =~ /\$$_/) || $self->{_check}{itempos}
+ unless $self->{_check}{$_};
+ }
+ my $line;
+
+ my $rule = undef;
+ my $prod = undef;
+ my $item = undef;
+ my $lastgreedy = '';
+ pos $grammar = 0;
+ study $grammar;
+
+ local $::RD_HINT = $::RD_HINT;
+ local $::RD_WARN = $::RD_WARN;
+ local $::RD_TRACE = $::RD_TRACE;
+ local $::RD_CHECK = $::RD_CHECK;
+
+ while (pos $grammar < length $grammar)
+ {
+ $line = $lines[-1] - _linecount($grammar) + 1;
+ my $commitonly;
+ my $code = "";
+ my @components = ();
+ if ($grammar =~ m/$COMMENT/gco)
+ {
+ _parse("a comment",0,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
+ next;
+ }
+ elsif ($grammar =~ m/$NEGLOOKAHEAD/gco)
+ {
+ _parse("a negative lookahead",$aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
+ $lookahead = $lookahead ? -$lookahead : -1;
+ $lookaheadspec .= $1;
+ next; # SKIP LOOKAHEAD RESET AT END OF while LOOP
+ }
+ elsif ($grammar =~ m/$POSLOOKAHEAD/gco)
+ {
+ _parse("a positive lookahead",$aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
+ $lookahead = $lookahead ? $lookahead : 1;
+ $lookaheadspec .= $1;
+ next; # SKIP LOOKAHEAD RESET AT END OF while LOOP
+ }
+ elsif ($grammar =~ m/(?=$ACTION)/gco
+ and do { ($code) = extract_codeblock($grammar); $code })
+ {
+ _parse("an action", $aftererror, $line, $code);
+ $item = new Parse::RecDescent::Action($code,$lookahead,$line);
+ $prod and $prod->additem($item)
+ or $self->_addstartcode($code);
+ }
+ elsif ($grammar =~ m/(?=$IMPLICITSUBRULE)/gco
+ and do { ($code) = extract_codeblock($grammar,'{([',undef,'(',1);
+ $code })
+ {
+ $code =~ s/\A\s*\(|\)\Z//g;
+ _parse("an implicit subrule", $aftererror, $line,
+ "( $code )");
+ my $implicit = $rule->nextimplicit;
+ return undef
+ if !$self->_generate("$implicit : $code",$replace,1);
+ my $pos = pos $grammar;
+ substr($grammar,$pos,0,$implicit);
+ pos $grammar = $pos;;
+ }
+ elsif ($grammar =~ m/$ENDDIRECTIVEMK/gco)
+ {
+
+ # EXTRACT TRAILING REPETITION SPECIFIER (IF ANY)
+
+ my ($minrep,$maxrep) = (1,$MAXREP);
+ if ($grammar =~ m/\G[(]/gc)
+ {
+ pos($grammar)--;
+
+ if ($grammar =~ m/$OPTIONAL/gco)
+ { ($minrep, $maxrep) = (0,1) }
+ elsif ($grammar =~ m/$ANY/gco)
+ { $minrep = 0 }
+ elsif ($grammar =~ m/$EXACTLY/gco)
+ { ($minrep, $maxrep) = ($1,$1) }
+ elsif ($grammar =~ m/$BETWEEN/gco)
+ { ($minrep, $maxrep) = ($1,$2) }
+ elsif ($grammar =~ m/$ATLEAST/gco)
+ { $minrep = $1 }
+ elsif ($grammar =~ m/$ATMOST/gco)
+ { $maxrep = $1 }
+ elsif ($grammar =~ m/$MANY/gco)
+ { }
+ elsif ($grammar =~ m/$BADREP/gco)
+ {
+ _parse("an invalid repetition specifier", 0,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
+ _error("Incorrect specification of a repeated directive",
+ $line);
+ _hint("Repeated directives cannot have
+ a maximum repetition of zero, nor can they have
+ negative components in their ranges.");
+ }
+ }
+
+ $prod && $prod->enddirective($line,$minrep,$maxrep);
+ }
+ elsif ($grammar =~ m/\G\s*<[^m]/gc)
+ {
+ pos($grammar)-=2;
+
+ if ($grammar =~ m/$OPMK/gco)
+ {
+ # $DB::single=1;
+ _parse("a $1-associative operator directive", $aftererror, $line, "<$1op:...>");
+ $prod->adddirective($1, $line,$2||'');
+ }
+ elsif ($grammar =~ m/$UNCOMMITMK/gco)
+ {
+ _parse("an uncommit marker", $aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
+ $item = new Parse::RecDescent::Directive('$commit=0;1',
+ $lookahead,$line,"<uncommit>");
+ $prod and $prod->additem($item)
+ or _no_rule("<uncommit>",$line);
+ }
+ elsif ($grammar =~ m/$QUOTELIKEMK/gco)
+ {
+ _parse("an perl quotelike marker", $aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
+ $item = new Parse::RecDescent::Directive(
+ 'my ($match,@res);
+ ($match,$text,undef,@res) =
+ Text::Balanced::extract_quotelike($text,$skip);
+ $match ? \@res : undef;
+ ', $lookahead,$line,"<perl_quotelike>");
+ $prod and $prod->additem($item)
+ or _no_rule("<perl_quotelike>",$line);
+ }
+ elsif ($grammar =~ m/$CODEBLOCKMK/gco)
+ {
+ my $outer = $1||"{}";
+ _parse("an perl codeblock marker", $aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
+ $item = new Parse::RecDescent::Directive(
+ 'Text::Balanced::extract_codeblock($text,undef,$skip,\''.$outer.'\');
+ ', $lookahead,$line,"<perl_codeblock>");
+ $prod and $prod->additem($item)
+ or _no_rule("<perl_codeblock>",$line);
+ }
+ elsif ($grammar =~ m/$VARIABLEMK/gco)
+ {
+ _parse("an perl variable marker", $aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
+ $item = new Parse::RecDescent::Directive(
+ 'Text::Balanced::extract_variable($text,$skip);
+ ', $lookahead,$line,"<perl_variable>");
+ $prod and $prod->additem($item)
+ or _no_rule("<perl_variable>",$line);
+ }
+ elsif ($grammar =~ m/$NOCHECKMK/gco)
+ {
+ _parse("a disable checking marker", $aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
+ if ($rule)
+ {
+ _error("<nocheck> directive not at start of grammar", $line);
+ _hint("The <nocheck> directive can only
+ be specified at the start of a
+ grammar (before the first rule
+ is defined.");
+ }
+ else
+ {
+ local $::RD_CHECK = 1;
+ }
+ }
+ elsif ($grammar =~ m/$AUTOSTUBMK/gco)
+ {
+ _parse("an autostub marker", $aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
+ $::RD_AUTOSTUB = "";
+ }
+ elsif ($grammar =~ m/$AUTORULEMK/gco)
+ {
+ _parse("an autorule marker", $aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
+ $::RD_AUTOSTUB = $1;
+ }
+ elsif ($grammar =~ m/$AUTOTREEMK/gco)
+ {
+ my $base = defined($1) ? $1 : "";
+ my $current_match = substr($grammar, $-[0], $+[0] - $-[0]);
+ $base .= "::" if $base && $base !~ /::$/;
+ _parse("an autotree marker", $aftererror,$line, $current_match);
+ if ($rule)
+ {
+ _error("<autotree> directive not at start of grammar", $line);
+ _hint("The <autotree> directive can only
+ be specified at the start of a
+ grammar (before the first rule
+ is defined.");
+ }
+ else
+ {
+ undef $self->{_AUTOACTION};
+ $self->{_AUTOTREE}{NODE}
+ = new Parse::RecDescent::Action(q({bless \%item, ').$base.q('.$item[0]}),0,-1);
+ $self->{_AUTOTREE}{TERMINAL}
+ = new Parse::RecDescent::Action(q({bless {__VALUE__=>$item[1]}, ').$base.q('.$item[0]}),0,-1);
+ }
+ }
+
+ elsif ($grammar =~ m/$REJECTMK/gco)
+ {
+ _parse("an reject marker", $aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
+ $item = new Parse::RecDescent::UncondReject($lookahead,$line,"<reject>");
+ $prod and $prod->additem($item)
+ or _no_rule("<reject>",$line);
+ }
+ elsif ($grammar =~ m/(?=$CONDREJECTMK)/gco
+ and do { ($code) = extract_codeblock($grammar,'{',undef,'<');
+ $code })
+ {
+ _parse("a (conditional) reject marker", $aftererror,$line, $code );
+ $code =~ /\A\s*<reject:(.*)>\Z/s;
+ my $cond = $1;
+ $item = new Parse::RecDescent::Directive(
+ "($1) ? undef : 1", $lookahead,$line,"<reject:$cond>");
+ $prod and $prod->additem($item)
+ or _no_rule("<reject:$cond>",$line);
+ }
+ elsif ($grammar =~ m/(?=$SCOREMK)/gco
+ and do { ($code) = extract_codeblock($grammar,'{',undef,'<');
+ $code })
+ {
+ _parse("a score marker", $aftererror,$line, $code );
+ $code =~ /\A\s*<score:(.*)>\Z/s;
+ $prod and $prod->addscore($1, $lookahead, $line)
+ or _no_rule($code,$line);
+ }
+ elsif ($grammar =~ m/(?=$AUTOSCOREMK)/gco
+ and do { ($code) = extract_codeblock($grammar,'{',undef,'<');
+ $code;
+ } )
+ {
+ _parse("an autoscore specifier", $aftererror,$line,$code);
+ $code =~ /\A\s*<autoscore:(.*)>\Z/s;
+
+ $rule and $rule->addautoscore($1,$self)
+ or _no_rule($code,$line);
+
+ $item = new Parse::RecDescent::UncondReject($lookahead,$line,$code);
+ $prod and $prod->additem($item)
+ or _no_rule($code,$line);
+ }
+ elsif ($grammar =~ m/$RESYNCMK/gco)
+ {
+ _parse("a resync to newline marker", $aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
+ $item = new Parse::RecDescent::Directive(
+ 'if ($text =~ s/(\A[^\n]*\n)//) { $return = 0; $1; } else { undef }',
+ $lookahead,$line,"<resync>");
+ $prod and $prod->additem($item)
+ or _no_rule("<resync>",$line);
+ }
+ elsif ($grammar =~ m/(?=$RESYNCPATMK)/gco
+ and do { ($code) = extract_bracketed($grammar,'<');
+ $code })
+ {
+ _parse("a resync with pattern marker", $aftererror,$line, $code );
+ $code =~ /\A\s*<resync:(.*)>\Z/s;
+ $item = new Parse::RecDescent::Directive(
+ 'if ($text =~ s/(\A'.$1.')//) { $return = 0; $1; } else { undef }',
+ $lookahead,$line,$code);
+ $prod and $prod->additem($item)
+ or _no_rule($code,$line);
+ }
+ elsif ($grammar =~ m/(?=$SKIPMK)/gco
+ and do { ($code) = extract_codeblock($grammar,'<');
+ $code })
+ {
+ _parse("a skip marker", $aftererror,$line, $code );
+ $code =~ /\A\s*<skip:(.*)>\Z/s;
+ if ($rule) {
+ $item = new Parse::RecDescent::Directive(
+ 'my $oldskip = $skip; $skip='.$1.'; $oldskip',
+ $lookahead,$line,$code);
+ $prod and $prod->additem($item)
+ or _no_rule($code,$line);
+ } else {
+ #global <skip> directive
+ $self->{skip} = $1;
+ }
+ }
+ elsif ($grammar =~ m/(?=$RULEVARPATMK)/gco
+ and do { ($code) = extract_codeblock($grammar,'{',undef,'<');
+ $code;
+ } )
+ {
+ _parse("a rule variable specifier", $aftererror,$line,$code);
+ $code =~ /\A\s*<rulevar:(.*)>\Z/s;
+
+ $rule and $rule->addvar($1,$self)
+ or _no_rule($code,$line);
+
+ $item = new Parse::RecDescent::UncondReject($lookahead,$line,$code);
+ $prod and $prod->additem($item)
+ or _no_rule($code,$line);
+ }
+ elsif ($grammar =~ m/(?=$AUTOACTIONPATMK)/gco
+ and do { ($code) = extract_codeblock($grammar,'{',undef,'<');
+ $code;
+ } )
+ {
+ _parse("an autoaction specifier", $aftererror,$line,$code);
+ $code =~ s/\A\s*<autoaction:(.*)>\Z/$1/s;
+ if ($code =~ /\A\s*[^{]|[^}]\s*\Z/) {
+ $code = "{ $code }"
+ }
+ $self->{_check}{itempos} =
+ $code =~ /\@itempos\b|\$itempos\s*\[/;
+ $self->{_AUTOACTION}
+ = new Parse::RecDescent::Action($code,0,-$line)
+ }
+ elsif ($grammar =~ m/(?=$DEFERPATMK)/gco
+ and do { ($code) = extract_codeblock($grammar,'{',undef,'<');
+ $code;
+ } )
+ {
+ _parse("a deferred action specifier", $aftererror,$line,$code);
+ $code =~ s/\A\s*<defer:(.*)>\Z/$1/s;
+ if ($code =~ /\A\s*[^{]|[^}]\s*\Z/)
+ {
+ $code = "{ $code }"
+ }
+
+ $item = new Parse::RecDescent::Directive(
+ "push \@{\$thisparser->{deferred}}, sub $code;",
+ $lookahead,$line,"<defer:$code>");
+ $prod and $prod->additem($item)
+ or _no_rule("<defer:$code>",$line);
+
+ $self->{deferrable} = 1;
+ }
+ elsif ($grammar =~ m/(?=$TOKENPATMK)/gco
+ and do { ($code) = extract_codeblock($grammar,'{',undef,'<');
+ $code;
+ } )
+ {
+ _parse("a token constructor", $aftererror,$line,$code);
+ $code =~ s/\A\s*<token:(.*)>\Z/$1/s;
+
+ my $types = eval 'no strict; local $SIG{__WARN__} = sub {0}; my @arr=('.$code.'); @arr' || ();
+ if (!$types)
+ {
+ _error("Incorrect token specification: \"$@\"", $line);
+ _hint("The <token:...> directive requires a list
+ of one or more strings representing possible
+ types of the specified token. For example:
+ <token:NOUN,VERB>");
+ }
+ else
+ {
+ $item = new Parse::RecDescent::Directive(
+ 'no strict;
+ $return = { text => $item[-1] };
+ @{$return->{type}}{'.$code.'} = (1..'.$types.');',
+ $lookahead,$line,"<token:$code>");
+ $prod and $prod->additem($item)
+ or _no_rule("<token:$code>",$line);
+ }
+ }
+ elsif ($grammar =~ m/$COMMITMK/gco)
+ {
+ _parse("an commit marker", $aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
+ $item = new Parse::RecDescent::Directive('$commit = 1',
+ $lookahead,$line,"<commit>");
+ $prod and $prod->additem($item)
+ or _no_rule("<commit>",$line);
+ }
+ elsif ($grammar =~ m/$NOCHECKMK/gco) {
+ _parse("an hint request", $aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
+ $::RD_CHECK = 0;
+ }
+ elsif ($grammar =~ m/$HINTMK/gco) {
+ _parse("an hint request", $aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
+ $::RD_HINT = $self->{__HINT__} = 1;
+ }
+ elsif ($grammar =~ m/$WARNMK/gco) {
+ _parse("an warning request", $aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
+ $::RD_WARN = $self->{__WARN__} = $1 ? $2+0 : 1;
+ }
+ elsif ($grammar =~ m/$TRACEBUILDMK/gco) {
+ _parse("an grammar build trace request", $aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
+ $::RD_TRACE = $1 ? $2+0 : 1;
+ }
+ elsif ($grammar =~ m/$TRACEPARSEMK/gco) {
+ _parse("an parse trace request", $aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
+ $self->{__TRACE__} = $1 ? $2+0 : 1;
+ }
+ elsif ($grammar =~ m/$AUTOERRORMK/gco)
+ {
+ $commitonly = $1;
+ _parse("an error marker", $aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
+ $item = new Parse::RecDescent::Error('',$lookahead,$1,$line);
+ $prod and $prod->additem($item)
+ or _no_rule("<error>",$line);
+ $aftererror = !$commitonly;
+ }
+ elsif ($grammar =~ m/(?=$MSGERRORMK)/gco
+ and do { $commitonly = $1;
+ ($code) = extract_bracketed($grammar,'<');
+ $code })
+ {
+ _parse("an error marker", $aftererror,$line,$code);
+ $code =~ /\A\s*<error\??:(.*)>\Z/s;
+ $item = new Parse::RecDescent::Error($1,$lookahead,$commitonly,$line);
+ $prod and $prod->additem($item)
+ or _no_rule("$code",$line);
+ $aftererror = !$commitonly;
+ }
+ elsif (do { $commitonly = $1;
+ ($code) = extract_bracketed($grammar,'<');
+ $code })
+ {
+ if ($code =~ /^<[A-Z_]+>$/)
+ {
+ _error("Token items are not yet
+ supported: \"$code\"",
+ $line);
+ _hint("Items like $code that consist of angle
+ brackets enclosing a sequence of
+ uppercase characters will eventually
+ be used to specify pre-lexed tokens
+ in a grammar. That functionality is not
+ yet implemented. Or did you misspell
+ \"$code\"?");
+ }
+ else
+ {
+ _error("Untranslatable item encountered: \"$code\"",
+ $line);
+ _hint("Did you misspell \"$code\"
+ or forget to comment it out?");
+ }
+ }
+ }
+ elsif ($grammar =~ m/$RULE/gco)
+ {
+ _parseunneg("a rule declaration", 0,
+ $lookahead,$line, substr($grammar, $-[0], $+[0] - $-[0]) ) or next;
+ my $rulename = $1;
+ if ($rulename =~ /Replace|Extend|Precompile|Save/ )
+ {
+ _warn(2,"Rule \"$rulename\" hidden by method
+ Parse::RecDescent::$rulename",$line)
+ and
+ _hint("The rule named \"$rulename\" cannot be directly
+ called through the Parse::RecDescent object
+ for this grammar (although it may still
+ be used as a subrule of other rules).
+ It can't be directly called because
+ Parse::RecDescent::$rulename is already defined (it
+ is the standard method of all
+ parsers).");
+ }
+ $rule = new Parse::RecDescent::Rule($rulename,$self,$line,$replace);
+ $prod->check_pending($line) if $prod;
+ $prod = $rule->addprod( new Parse::RecDescent::Production );
+ $aftererror = 0;
+ }
+ elsif ($grammar =~ m/$UNCOMMITPROD/gco)
+ {
+ pos($grammar)-=9;
+ _parseunneg("a new (uncommitted) production",
+ 0, $lookahead, $line, substr($grammar, $-[0], $+[0] - $-[0]) ) or next;
+
+ $prod->check_pending($line) if $prod;
+ $prod = new Parse::RecDescent::Production($line,1);
+ $rule and $rule->addprod($prod)
+ or _no_rule("<uncommit>",$line);
+ $aftererror = 0;
+ }
+ elsif ($grammar =~ m/$ERRORPROD/gco)
+ {
+ pos($grammar)-=6;
+ _parseunneg("a new (error) production", $aftererror,
+ $lookahead,$line, substr($grammar, $-[0], $+[0] - $-[0]) ) or next;
+ $prod->check_pending($line) if $prod;
+ $prod = new Parse::RecDescent::Production($line,0,1);
+ $rule and $rule->addprod($prod)
+ or _no_rule("<error>",$line);
+ $aftererror = 0;
+ }
+ elsif ($grammar =~ m/$PROD/gco)
+ {
+ _parseunneg("a new production", 0,
+ $lookahead,$line, substr($grammar, $-[0], $+[0] - $-[0]) ) or next;
+ $rule
+ and (!$prod || $prod->check_pending($line))
+ and $prod = $rule->addprod(new Parse::RecDescent::Production($line))
+ or _no_rule("production",$line);
+ $aftererror = 0;
+ }
+ elsif ($grammar =~ m/$LITERAL/gco)
+ {
+ my $literal = $1;
+ ($code = $literal) =~ s/\\\\/\\/g;
+ _parse("a literal terminal", $aftererror,$line,$literal);
+ $item = new Parse::RecDescent::Literal($code,$lookahead,$line);
+ $prod and $prod->additem($item)
+ or _no_rule("literal terminal",$line,"'$literal'");
+ }
+ elsif ($grammar =~ m/$INTERPLIT/gco)
+ {
+ _parse("an interpolated literal terminal", $aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
+ $item = new Parse::RecDescent::InterpLit($1,$lookahead,$line);
+ $prod and $prod->additem($item)
+ or _no_rule("interpolated literal terminal",$line,"'$1'");
+ }
+ elsif ($grammar =~ m/$TOKEN/gco)
+ {
+ _parse("a /../ pattern terminal", $aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
+ $item = new Parse::RecDescent::Token($1,'/',$3?$3:'',$lookahead,$line);
+ $prod and $prod->additem($item)
+ or _no_rule("pattern terminal",$line,"/$1/");
+ }
+ elsif ($grammar =~ m/(?=$MTOKEN)/gco
+ and do { ($code, undef, @components)
+ = extract_quotelike($grammar);
+ $code }
+ )
+
+ {
+ _parse("an m/../ pattern terminal", $aftererror,$line,$code);
+ $item = new Parse::RecDescent::Token(@components[3,2,8],
+ $lookahead,$line);
+ $prod and $prod->additem($item)
+ or _no_rule("pattern terminal",$line,$code);
+ }
+ elsif ($grammar =~ m/(?=$MATCHRULE)/gco
+ and do { ($code) = extract_bracketed($grammar,'<');
+ $code
+ }
+ or $grammar =~ m/$SUBRULE/gco
+ and $code = $1)
+ {
+ my $name = $code;
+ my $matchrule = 0;
+ if (substr($name,0,1) eq '<')
+ {
+ $name =~ s/$MATCHRULE\s*//;
+ $name =~ s/\s*>\Z//;
+ $matchrule = 1;
+ }
+
+ # EXTRACT TRAILING ARG LIST (IF ANY)
+
+ my ($argcode) = extract_codeblock($grammar, "[]",'') || '';
+
+ # EXTRACT TRAILING REPETITION SPECIFIER (IF ANY)
+
+ if ($grammar =~ m/\G[(]/gc)
+ {
+ pos($grammar)--;
+
+ if ($grammar =~ m/$OPTIONAL/gco)
+ {
+ _parse("an zero-or-one subrule match", $aftererror,$line,"$code$argcode($1)");
+ $item = new Parse::RecDescent::Repetition($name,$1,0,1,
+ $lookahead,$line,
+ $self,
+ $matchrule,
+ $argcode);
+ $prod and $prod->additem($item)
+ or _no_rule("repetition",$line,"$code$argcode($1)");
+
+ !$matchrule and $rule and $rule->addcall($name);
+ }
+ elsif ($grammar =~ m/$ANY/gco)
+ {
+ _parse("a zero-or-more subrule match", $aftererror,$line,"$code$argcode($1)");
+ if ($2)
+ {
+ my $pos = pos $grammar;
+ substr($grammar,$pos,0,
+ "<leftop='$name(s?)': $name $2 $name>(s?) ");
+
+ pos $grammar = $pos;
+ }
+ else
+ {
+ $item = new Parse::RecDescent::Repetition($name,$1,0,$MAXREP,
+ $lookahead,$line,
+ $self,
+ $matchrule,
+ $argcode);
+ $prod and $prod->additem($item)
+ or _no_rule("repetition",$line,"$code$argcode($1)");
+
+ !$matchrule and $rule and $rule->addcall($name);
+
+ _check_insatiable($name,$1,$grammar,$line) if $::RD_CHECK;
+ }
+ }
+ elsif ($grammar =~ m/$MANY/gco)
+ {
+ _parse("a one-or-more subrule match", $aftererror,$line,"$code$argcode($1)");
+ if ($2)
+ {
+ # $DB::single=1;
+ my $pos = pos $grammar;
+ substr($grammar,$pos,0,
+ "<leftop='$name(s)': $name $2 $name> ");
+
+ pos $grammar = $pos;
+ }
+ else
+ {
+ $item = new Parse::RecDescent::Repetition($name,$1,1,$MAXREP,
+ $lookahead,$line,
+ $self,
+ $matchrule,
+ $argcode);
+
+ $prod and $prod->additem($item)
+ or _no_rule("repetition",$line,"$code$argcode($1)");
+
+ !$matchrule and $rule and $rule->addcall($name);
+
+ _check_insatiable($name,$1,$grammar,$line) if $::RD_CHECK;
+ }
+ }
+ elsif ($grammar =~ m/$EXACTLY/gco)
+ {
+ _parse("an exactly-$1-times subrule match", $aftererror,$line,"$code$argcode($1)");
+ if ($2)
+ {
+ my $pos = pos $grammar;
+ substr($grammar,$pos,0,
+ "<leftop='$name($1)': $name $2 $name>($1) ");
+
+ pos $grammar = $pos;
+ }
+ else
+ {
+ $item = new Parse::RecDescent::Repetition($name,$1,$1,$1,
+ $lookahead,$line,
+ $self,
+ $matchrule,
+ $argcode);
+ $prod and $prod->additem($item)
+ or _no_rule("repetition",$line,"$code$argcode($1)");
+
+ !$matchrule and $rule and $rule->addcall($name);
+ }
+ }
+ elsif ($grammar =~ m/$BETWEEN/gco)
+ {
+ _parse("a $1-to-$2 subrule match", $aftererror,$line,"$code$argcode($1..$2)");
+ if ($3)
+ {
+ my $pos = pos $grammar;
+ substr($grammar,$pos,0,
+ "<leftop='$name($1..$2)': $name $3 $name>($1..$2) ");
+
+ pos $grammar = $pos;
+ }
+ else
+ {
+ $item = new Parse::RecDescent::Repetition($name,"$1..$2",$1,$2,
+ $lookahead,$line,
+ $self,
+ $matchrule,
+ $argcode);
+ $prod and $prod->additem($item)
+ or _no_rule("repetition",$line,"$code$argcode($1..$2)");
+
+ !$matchrule and $rule and $rule->addcall($name);
+ }
+ }
+ elsif ($grammar =~ m/$ATLEAST/gco)
+ {
+ _parse("a $1-or-more subrule match", $aftererror,$line,"$code$argcode($1..)");
+ if ($2)
+ {
+ my $pos = pos $grammar;
+ substr($grammar,$pos,0,
+ "<leftop='$name($1..)': $name $2 $name>($1..) ");
+
+ pos $grammar = $pos;
+ }
+ else
+ {
+ $item = new Parse::RecDescent::Repetition($name,"$1..",$1,$MAXREP,
+ $lookahead,$line,
+ $self,
+ $matchrule,
+ $argcode);
+ $prod and $prod->additem($item)
+ or _no_rule("repetition",$line,"$code$argcode($1..)");
+
+ !$matchrule and $rule and $rule->addcall($name);
+ _check_insatiable($name,"$1..",$grammar,$line) if $::RD_CHECK;
+ }
+ }
+ elsif ($grammar =~ m/$ATMOST/gco)
+ {
+ _parse("a one-to-$1 subrule match", $aftererror,$line,"$code$argcode(..$1)");
+ if ($2)
+ {
+ my $pos = pos $grammar;
+ substr($grammar,$pos,0,
+ "<leftop='$name(..$1)': $name $2 $name>(..$1) ");
+
+ pos $grammar = $pos;
+ }
+ else
+ {
+ $item = new Parse::RecDescent::Repetition($name,"..$1",1,$1,
+ $lookahead,$line,
+ $self,
+ $matchrule,
+ $argcode);
+ $prod and $prod->additem($item)
+ or _no_rule("repetition",$line,"$code$argcode(..$1)");
+
+ !$matchrule and $rule and $rule->addcall($name);
+ }
+ }
+ elsif ($grammar =~ m/$BADREP/gco)
+ {
+ my $current_match = substr($grammar, $-[0], $+[0] - $-[0]);
+ _parse("an subrule match with invalid repetition specifier", 0,$line, $current_match);
+ _error("Incorrect specification of a repeated subrule",
+ $line);
+ _hint("Repeated subrules like \"$code$argcode$current_match\" cannot have
+ a maximum repetition of zero, nor can they have
+ negative components in their ranges.");
+ }
+ }
+ else
+ {
+ _parse("a subrule match", $aftererror,$line,$code);
+ my $desc;
+ if ($name=~/\A_alternation_\d+_of_production_\d+_of_rule/)
+ { $desc = $self->{"rules"}{$name}->expected }
+ $item = new Parse::RecDescent::Subrule($name,
+ $lookahead,
+ $line,
+ $desc,
+ $matchrule,
+ $argcode);
+
+ $prod and $prod->additem($item)
+ or _no_rule("(sub)rule",$line,$name);
+
+ !$matchrule and $rule and $rule->addcall($name);
+ }
+ }
+ elsif ($grammar =~ m/$LONECOLON/gco )
+ {
+ _error("Unexpected colon encountered", $line);
+ _hint("Did you mean \"|\" (to start a new production)?
+ Or perhaps you forgot that the colon
+ in a rule definition must be
+ on the same line as the rule name?");
+ }
+ elsif ($grammar =~ m/$ACTION/gco ) # BAD ACTION, ALREADY FAILED
+ {
+ _error("Malformed action encountered",
+ $line);
+ _hint("Did you forget the closing curly bracket
+ or is there a syntax error in the action?");
+ }
+ elsif ($grammar =~ m/$OTHER/gco )
+ {
+ _error("Untranslatable item encountered: \"$1\"",
+ $line);
+ _hint("Did you misspell \"$1\"
+ or forget to comment it out?");
+ }
+
+ if ($lookaheadspec =~ tr /././ > 3)
+ {
+ $lookaheadspec =~ s/\A\s+//;
+ $lookahead = $lookahead<0
+ ? 'a negative lookahead ("...!")'
+ : 'a positive lookahead ("...")' ;
+ _warn(1,"Found two or more lookahead specifiers in a
+ row.",$line)
+ and
+ _hint("Multiple positive and/or negative lookaheads
+ are simply multiplied together to produce a
+ single positive or negative lookahead
+ specification. In this case the sequence
+ \"$lookaheadspec\" was reduced to $lookahead.
+ Was this your intention?");
+ }
+ $lookahead = 0;
+ $lookaheadspec = "";
+
+ $grammar =~ m/\G\s+/gc;
+ }
+
+ if ($must_pop_lines) {
+ pop @lines;
+ }
+
+ unless ($ERRORS or $isimplicit or !$::RD_CHECK)
+ {
+ $self->_check_grammar();
+ }
+
+ unless ($ERRORS or $isimplicit or $Parse::RecDescent::compiling)
+ {
+ my $code = $self->_code();
+ if (defined $::RD_TRACE)
+ {
+ my $mode = ($nextnamespace eq "namespace000002") ? '>' : '>>';
+ print STDERR "printing code (", length($code),") to RD_TRACE\n";
+ local *TRACE_FILE;
+ open TRACE_FILE, $mode, "RD_TRACE"
+ and print TRACE_FILE "my \$ERRORS;\n$code"
+ and close TRACE_FILE;
+ }
+
+ unless ( eval "$code 1" )
+ {
+ _error("Internal error in generated parser code!");
+ $@ =~ s/at grammar/in grammar at/;
+ _hint($@);
+ }
+ }
+
+ if ($ERRORS and !_verbosity("HINT"))
+ {
+ local $::RD_HINT = defined $::RD_HINT ? $::RD_HINT : 1;
+ _hint('Set $::RD_HINT (or -RD_HINT if you\'re using "perl -s")
+ for hints on fixing these problems. Use $::RD_HINT = 0
+ to disable this message.');
+ }
+ if ($ERRORS) { $ERRORS=0; return }
+ return $self;
+}
+
+
+sub _addstartcode($$)
+{
+ my ($self, $code) = @_;
+ $code =~ s/\A\s*\{(.*)\}\Z/$1/s;
+
+ $self->{"startcode"} .= "$code;\n";
+}
+
+# CHECK FOR GRAMMAR PROBLEMS....
+
+sub _check_insatiable($$$$)
+{
+ my ($subrule,$repspec,$grammar,$line) = @_;
+ pos($grammar)=pos($_[2]);
+ return if $grammar =~ m/$OPTIONAL/gco || $grammar =~ m/$ANY/gco;
+ my $min = 1;
+ if ( $grammar =~ m/$MANY/gco
+ || $grammar =~ m/$EXACTLY/gco
+ || $grammar =~ m/$ATMOST/gco
+ || $grammar =~ m/$BETWEEN/gco && do { $min=$2; 1 }
+ || $grammar =~ m/$ATLEAST/gco && do { $min=$2; 1 }
+ || $grammar =~ m/$SUBRULE(?!\s*:)/gco
+ )
+ {
+ return unless $1 eq $subrule && $min > 0;
+ my $current_match = substr($grammar, $-[0], $+[0] - $-[0]);
+ _warn(3,"Subrule sequence \"$subrule($repspec) $current_match\" will
+ (almost certainly) fail.",$line)
+ and
+ _hint("Unless subrule \"$subrule\" performs some cunning
+ lookahead, the repetition \"$subrule($repspec)\" will
+ insatiably consume as many matches of \"$subrule\" as it
+ can, leaving none to match the \"$current_match\" that follows.");
+ }
+}
+
+sub _check_grammar ($)
+{
+ my $self = shift;
+ my $rules = $self->{"rules"};
+ my $rule;
+ foreach $rule ( values %$rules )
+ {
+ next if ! $rule->{"changed"};
+
+ # CHECK FOR UNDEFINED RULES
+
+ my $call;
+ foreach $call ( @{$rule->{"calls"}} )
+ {
+ if (!defined ${$rules}{$call}
+ &&!defined &{"Parse::RecDescent::$call"})
+ {
+ if (!defined $::RD_AUTOSTUB)
+ {
+ _warn(3,"Undefined (sub)rule \"$call\"
+ used in a production.")
+ and
+ _hint("Will you be providing this rule
+ later, or did you perhaps
+ misspell \"$call\"? Otherwise
+ it will be treated as an
+ immediate <reject>.");
+ eval "sub $self->{namespace}::$call {undef}";
+ }
+ else # EXPERIMENTAL
+ {
+ my $rule = qq{'$call'};
+ if ($::RD_AUTOSTUB and $::RD_AUTOSTUB ne "1") {
+ $rule = $::RD_AUTOSTUB;
+ }
+ _warn(1,"Autogenerating rule: $call")
+ and
+ _hint("A call was made to a subrule
+ named \"$call\", but no such
+ rule was specified. However,
+ since \$::RD_AUTOSTUB
+ was defined, a rule stub
+ ($call : $rule) was
+ automatically created.");
+
+ $self->_generate("$call: $rule",0,1);
+ }
+ }
+ }
+
+ # CHECK FOR LEFT RECURSION
+
+ if ($rule->isleftrec($rules))
+ {
+ _error("Rule \"$rule->{name}\" is left-recursive.");
+ _hint("Redesign the grammar so it's not left-recursive.
+ That will probably mean you need to re-implement
+ repetitions using the '(s)' notation.
+ For example: \"$rule->{name}(s)\".");
+ next;
+ }
+
+ # CHECK FOR PRODUCTIONS FOLLOWING EMPTY PRODUCTIONS
+ {
+ my $hasempty;
+ my $prod;
+ foreach $prod ( @{$rule->{"prods"}} ) {
+ if ($hasempty) {
+ _error("Production " . $prod->describe . " for \"$rule->{name}\"
+ will never be reached (preceding empty production will
+ always match first).");
+ _hint("Reorder the grammar so that the empty production
+ is last in the list or productions.");
+ last;
+ }
+ $hasempty ||= $prod->isempty();
+ }
+ }
+ }
+}
+
+# GENERATE ACTUAL PARSER CODE
+
+sub _code($)
+{
+ my $self = shift;
+ my $initial_skip = defined($self->{skip}) ? $self->{skip} : $skip;
+
+ my $code = qq{
+package $self->{namespace};
+use strict;
+use vars qw(\$skip \$AUTOLOAD $self->{localvars} );
+\@$self->{namespace}\::ISA = ();
+\$skip = '$initial_skip';
+$self->{startcode}
+
+{
+local \$SIG{__WARN__} = sub {0};
+# PRETEND TO BE IN Parse::RecDescent NAMESPACE
+*$self->{namespace}::AUTOLOAD = sub
+{
+ no strict 'refs';
+ \$AUTOLOAD =~ s/^$self->{namespace}/Parse::RecDescent/;
+ goto &{\$AUTOLOAD};
+}
+}
+
+};
+ $code .= "push \@$self->{namespace}\::ISA, 'Parse::RecDescent';";
+ $self->{"startcode"} = '';
+
+ my $rule;
+ foreach $rule ( values %{$self->{"rules"}} )
+ {
+ if ($rule->{"changed"})
+ {
+ $code .= $rule->code($self->{"namespace"},$self);
+ $rule->{"changed"} = 0;
+ }
+ }
+
+ return $code;
+}
+
+
+# EXECUTING A PARSE....
+
+sub AUTOLOAD # ($parser, $text; $linenum, @args)
+{
+ croak "Could not find method: $AUTOLOAD\n" unless ref $_[0];
+ my $class = ref($_[0]) || $_[0];
+ my $text = ref($_[1]) eq 'SCALAR' ? ${$_[1]} : "$_[1]";
+ $_[0]->{lastlinenum} = $_[2]||_linecount($_[1]);
+ $_[0]->{lastlinenum} = _linecount($_[1]);
+ $_[0]->{lastlinenum} += ($_[2]||0) if @_ > 2;
+ $_[0]->{offsetlinenum} = $_[0]->{lastlinenum};
+ $_[0]->{fulltext} = $text;
+ $_[0]->{fulltextlen} = length $text;
+ $_[0]->{linecounter_cache} = {};
+ $_[0]->{deferred} = [];
+ $_[0]->{errors} = [];
+ my @args = @_[3..$#_];
+ my $args = sub { [ @args ] };
+
+ $AUTOLOAD =~ s/$class/$_[0]->{namespace}/;
+ no strict "refs";
+
+ local $::RD_WARN = $::RD_WARN || $_[0]->{__WARN__};
+ local $::RD_HINT = $::RD_HINT || $_[0]->{__HINT__};
+ local $::RD_TRACE = $::RD_TRACE || $_[0]->{__TRACE__};
+
+ croak "Unknown starting rule ($AUTOLOAD) called\n"
+ unless defined &$AUTOLOAD;
+ my $retval = &{$AUTOLOAD}($_[0],$text,undef,undef,undef,$args);
+
+ if (defined $retval)
+ {
+ foreach ( @{$_[0]->{deferred}} ) { &$_; }
+ }
+ else
+ {
+ foreach ( @{$_[0]->{errors}} ) { _error(@$_); }
+ }
+
+ if (ref $_[1] eq 'SCALAR') { ${$_[1]} = $text }
+
+ $ERRORS = 0;
+ return $retval;
+}
+
+sub _parserepeat($$$$$$$$$) # RETURNS A REF TO AN ARRAY OF MATCHES
+{
+ my ($parser, $text, $prod, $min, $max, $_noactions, $_itempos, $expectation, $argcode) = @_;
+ my @tokens = ();
+
+ my $itemposfirst;
+ my $reps;
+ for ($reps=0; $reps<$max;)
+ {
+ $expectation->at($text);
+ my $_savetext = $text;
+ my $prevtextlen = length $text;
+ my $_tok;
+ if (! defined ($_tok = &$prod($parser,$text,1,$_noactions,$_itempos,$argcode)))
+ {
+ $text = $_savetext;
+ last;
+ }
+
+ if (defined($_itempos) and !defined($itemposfirst))
+ {
+ $itemposfirst = Parse::RecDescent::Production::_duplicate_itempos($_itempos);
+ }
+
+ push @tokens, $_tok if defined $_tok;
+ last if ++$reps >= $min and $prevtextlen == length $text;
+ }
+
+ do { $expectation->failed(); return undef} if $reps<$min;
+
+ if (defined $itemposfirst)
+ {
+ Parse::RecDescent::Production::_update_itempos($_itempos, $itemposfirst, undef, [qw(from)]);
+ }
+
+ $_[1] = $text;
+ return [@tokens];
+}
+
+sub set_autoflush {
+ my $orig_selected = select $_[0];
+ $| = 1;
+ select $orig_selected;
+ return;
+}
+
+# ERROR REPORTING....
+
+sub _write_ERROR {
+ my ($errorprefix, $errortext) = @_;
+ return if $errortext !~ /\S/;
+ $errorprefix =~ s/\s+\Z//;
+ local $^A = q{};
+
+ formline(<<'END_FORMAT', $errorprefix, $errortext);
+@>>>>>>>>>>>>>>>>>>>>: ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+END_FORMAT
+ formline(<<'END_FORMAT', $errortext);
+~~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+END_FORMAT
+ print {*STDERR} $^A;
+}
+
+# TRACING
+
+my $TRACE_FORMAT = <<'END_FORMAT';
+@>|@|||||||||@^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<|
+ | ~~ |^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<|
+END_FORMAT
+
+my $TRACECONTEXT_FORMAT = <<'END_FORMAT';
+@>|@|||||||||@ |^<<<<<<<<<<<<<<<<<<<<<<<<<<<
+ | ~~ | |^<<<<<<<<<<<<<<<<<<<<<<<<<<<
+END_FORMAT
+
+sub _write_TRACE {
+ my ($tracelevel, $tracerulename, $tracemsg) = @_;
+ return if $tracemsg !~ /\S/;
+ $tracemsg =~ s/\s*\Z//;
+ local $^A = q{};
+ my $bar = '|';
+ formline($TRACE_FORMAT, $tracelevel, $tracerulename, $bar, $tracemsg, $tracemsg);
+ print {*STDERR} $^A;
+}
+
+sub _write_TRACECONTEXT {
+ my ($tracelevel, $tracerulename, $tracecontext) = @_;
+ return if $tracecontext !~ /\S/;
+ $tracecontext =~ s/\s*\Z//;
+ local $^A = q{};
+ my $bar = '|';
+ formline($TRACECONTEXT_FORMAT, $tracelevel, $tracerulename, $bar, $tracecontext, $tracecontext);
+ print {*STDERR} $^A;
+}
+
+sub _verbosity($)
+{
+ defined $::RD_TRACE
+ or defined $::RD_HINT and $::RD_HINT and $_[0] =~ /ERRORS|WARN|HINT/
+ or defined $::RD_WARN and $::RD_WARN and $_[0] =~ /ERRORS|WARN/
+ or defined $::RD_ERRORS and $::RD_ERRORS and $_[0] =~ /ERRORS/
+}
+
+sub _error($;$)
+{
+ $ERRORS++;
+ return 0 if ! _verbosity("ERRORS");
+ my $errortext = $_[0];
+ my $errorprefix = "ERROR" . ($_[1] ? " (line $_[1])" : "");
+ $errortext =~ s/\s+/ /g;
+ print {*STDERR} "\n" if _verbosity("WARN");
+ _write_ERROR($errorprefix, $errortext);
+ return 1;
+}
+
+sub _warn($$;$)
+{
+ return 0 unless _verbosity("WARN") && ($::RD_HINT || $_[0] >= ($::RD_WARN||1));
+ my $errortext = $_[1];
+ my $errorprefix = "Warning" . ($_[2] ? " (line $_[2])" : "");
+ print {*STDERR} "\n" if _verbosity("HINT");
+ $errortext =~ s/\s+/ /g;
+ _write_ERROR($errorprefix, $errortext);
+ return 1;
+}
+
+sub _hint($)
+{
+ return 0 unless $::RD_HINT;
+ my $errortext = $_[0];
+ my $errorprefix = "Hint" . ($_[1] ? " (line $_[1])" : "");
+ $errortext =~ s/\s+/ /g;
+ _write_ERROR($errorprefix, $errortext);
+ return 1;
+}
+
+sub _tracemax($)
+{
+ if (defined $::RD_TRACE
+ && $::RD_TRACE =~ /\d+/
+ && $::RD_TRACE>1
+ && $::RD_TRACE+10<length($_[0]))
+ {
+ my $count = length($_[0]) - $::RD_TRACE;
+ return substr($_[0],0,$::RD_TRACE/2)
+ . "...<$count>..."
+ . substr($_[0],-$::RD_TRACE/2);
+ }
+ else
+ {
+ return substr($_[0],0,500);
+ }
+}
+
+sub _tracefirst($)
+{
+ if (defined $::RD_TRACE
+ && $::RD_TRACE =~ /\d+/
+ && $::RD_TRACE>1
+ && $::RD_TRACE+10<length($_[0]))
+ {
+ my $count = length($_[0]) - $::RD_TRACE;
+ return substr($_[0],0,$::RD_TRACE) . "...<+$count>";
+ }
+ else
+ {
+ return substr($_[0],0,500);
+ }
+}
+
+my $lastcontext = '';
+my $lastrulename = '';
+my $lastlevel = '';
+
+sub _trace($;$$$)
+{
+ my $tracemsg = $_[0];
+ my $tracecontext = $_[1]||$lastcontext;
+ my $tracerulename = $_[2]||$lastrulename;
+ my $tracelevel = $_[3]||$lastlevel;
+ if ($tracerulename) { $lastrulename = $tracerulename }
+ if ($tracelevel) { $lastlevel = $tracelevel }
+
+ $tracecontext =~ s/\n/\\n/g;
+ $tracecontext =~ s/\s+/ /g;
+ $tracerulename = qq{$tracerulename};
+ _write_TRACE($tracelevel, $tracerulename, $tracemsg);
+ if ($tracecontext ne $lastcontext)
+ {
+ if ($tracecontext)
+ {
+ $lastcontext = _tracefirst($tracecontext);
+ $tracecontext = qq{"$tracecontext"};
+ }
+ else
+ {
+ $tracecontext = qq{<NO TEXT LEFT>};
+ }
+ _write_TRACECONTEXT($tracelevel, $tracerulename, $tracecontext);
+ }
+}
+
+sub _matchtracemessage
+{
+ my ($self, $reject) = @_;
+
+ my $prefix = '';
+ my $postfix = '';
+ my $matched = not $reject;
+ my @t = ("Matched", "Didn't match");
+ if (exists $self->{lookahead} and $self->{lookahead})
+ {
+ $postfix = $reject ? "(reject)" : "(keep)";
+ $prefix = "...";
+ if ($self->{lookahead} < 0)
+ {
+ $prefix .= '!';
+ $matched = not $matched;
+ }
+ }
+ $prefix . ($matched ? $t[0] : $t[1]) . $postfix;
+}
+
+sub _parseunneg($$$$$)
+{
+ _parse($_[0],$_[1],$_[3],$_[4]);
+ if ($_[2]<0)
+ {
+ _error("Can't negate \"$_[4]\".",$_[3]);
+ _hint("You can't negate $_[0]. Remove the \"...!\" before
+ \"$_[4]\".");
+ return 0;
+ }
+ return 1;
+}
+
+sub _parse($$$$)
+{
+ my $what = $_[3];
+ $what =~ s/^\s+//;
+ if ($_[1])
+ {
+ _warn(3,"Found $_[0] ($what) after an unconditional <error>",$_[2])
+ and
+ _hint("An unconditional <error> always causes the
+ production containing it to immediately fail.
+ \u$_[0] that follows an <error>
+ will never be reached. Did you mean to use
+ <error?> instead?");
+ }
+
+ return if ! _verbosity("TRACE");
+ my $errortext = "Treating \"$what\" as $_[0]";
+ my $errorprefix = "Parse::RecDescent";
+ $errortext =~ s/\s+/ /g;
+ _write_ERROR($errorprefix, $errortext);
+}
+
+sub _linecount($) {
+ scalar substr($_[0], pos $_[0]||0) =~ tr/\n//
+}
+
+
+package main;
+
+use vars qw ( $RD_ERRORS $RD_WARN $RD_HINT $RD_TRACE $RD_CHECK );
+$::RD_CHECK = 1;
+$::RD_ERRORS = 1;
+$::RD_WARN = 3;
+
+1;
+
+__END__
+
+=head1 NAME
+
+Parse::RecDescent - Generate Recursive-Descent Parsers
+
+=head1 VERSION
+
+This document describes version 1.967006 of Parse::RecDescent
+released January 29th, 2012.
+
+=head1 SYNOPSIS
+
+ use Parse::RecDescent;
+
+ # Generate a parser from the specification in $grammar:
+
+ $parser = new Parse::RecDescent ($grammar);
+
+ # Generate a parser from the specification in $othergrammar
+
+ $anotherparser = new Parse::RecDescent ($othergrammar);
+
+
+ # Parse $text using rule 'startrule' (which must be
+ # defined in $grammar):
+
+ $parser->startrule($text);
+
+
+ # Parse $text using rule 'otherrule' (which must also
+ # be defined in $grammar):
+
+ $parser->otherrule($text);
+
+
+ # Change the universal token prefix pattern
+ # before building a grammar
+ # (the default is: '\s*'):
+
+ $Parse::RecDescent::skip = '[ \t]+';
+
+
+ # Replace productions of existing rules (or create new ones)
+ # with the productions defined in $newgrammar:
+
+ $parser->Replace($newgrammar);
+
+
+ # Extend existing rules (or create new ones)
+ # by adding extra productions defined in $moregrammar:
+
+ $parser->Extend($moregrammar);
+
+
+ # Global flags (useful as command line arguments under -s):
+
+ $::RD_ERRORS # unless undefined, report fatal errors
+ $::RD_WARN # unless undefined, also report non-fatal problems
+ $::RD_HINT # if defined, also suggestion remedies
+ $::RD_TRACE # if defined, also trace parsers' behaviour
+ $::RD_AUTOSTUB # if defined, generates "stubs" for undefined rules
+ $::RD_AUTOACTION # if defined, appends specified action to productions
+
+
+=head1 DESCRIPTION
+
+=head2 Overview
+
+Parse::RecDescent incrementally generates top-down recursive-descent text
+parsers from simple I<yacc>-like grammar specifications. It provides:
+
+=over 4
+
+=item *
+
+Regular expressions or literal strings as terminals (tokens),
+
+=item *
+
+Multiple (non-contiguous) productions for any rule,
+
+=item *
+
+Repeated and optional subrules within productions,
+
+=item *
+
+Full access to Perl within actions specified as part of the grammar,
+
+=item *
+
+Simple automated error reporting during parser generation and parsing,
+
+=item *
+
+The ability to commit to, uncommit to, or reject particular
+productions during a parse,
+
+=item *
+
+The ability to pass data up and down the parse tree ("down" via subrule
+argument lists, "up" via subrule return values)
+
+=item *
+
+Incremental extension of the parsing grammar (even during a parse),
+
+=item *
+
+Precompilation of parser objects,
+
+=item *
+
+User-definable reduce-reduce conflict resolution via
+"scoring" of matching productions.
+
+=back
+
+=head2 Using C<Parse::RecDescent>
+
+Parser objects are created by calling C<Parse::RecDescent::new>, passing in a
+grammar specification (see the following subsections). If the grammar is
+correct, C<new> returns a blessed reference which can then be used to initiate
+parsing through any rule specified in the original grammar. A typical sequence
+looks like this:
+
+ $grammar = q {
+ # GRAMMAR SPECIFICATION HERE
+ };
+
+ $parser = new Parse::RecDescent ($grammar) or die "Bad grammar!\n";
+
+ # acquire $text
+
+ defined $parser->startrule($text) or print "Bad text!\n";
+
+The rule through which parsing is initiated must be explicitly defined
+in the grammar (i.e. for the above example, the grammar must include a
+rule of the form: "startrule: <subrules>".
+
+If the starting rule succeeds, its value (see below)
+is returned. Failure to generate the original parser or failure to match a text
+is indicated by returning C<undef>. Note that it's easy to set up grammars
+that can succeed, but which return a value of 0, "0", or "". So don't be
+tempted to write:
+
+ $parser->startrule($text) or print "Bad text!\n";
+
+Normally, the parser has no effect on the original text. So in the
+previous example the value of $text would be unchanged after having
+been parsed.
+
+If, however, the text to be matched is passed by reference:
+
+ $parser->startrule(\$text)
+
+then any text which was consumed during the match will be removed from the
+start of $text.
+
+
+=head2 Rules
+
+In the grammar from which the parser is built, rules are specified by
+giving an identifier (which must satisfy /[A-Za-z]\w*/), followed by a
+colon I<on the same line>, followed by one or more productions,
+separated by single vertical bars. The layout of the productions
+is entirely free-format:
+
+ rule1: production1
+ | production2 |
+ production3 | production4
+
+At any point in the grammar previously defined rules may be extended with
+additional productions. This is achieved by redeclaring the rule with the new
+productions. Thus:
+
+ rule1: a | b | c
+ rule2: d | e | f
+ rule1: g | h
+
+is exactly equivalent to:
+
+ rule1: a | b | c | g | h
+ rule2: d | e | f
+
+Each production in a rule consists of zero or more items, each of which
+may be either: the name of another rule to be matched (a "subrule"),
+a pattern or string literal to be matched directly (a "token"), a
+block of Perl code to be executed (an "action"), a special instruction
+to the parser (a "directive"), or a standard Perl comment (which is
+ignored).
+
+A rule matches a text if one of its productions matches. A production
+matches if each of its items match consecutive substrings of the
+text. The productions of a rule being matched are tried in the same
+order that they appear in the original grammar, and the first matching
+production terminates the match attempt (successfully). If all
+productions are tried and none matches, the match attempt fails.
+
+Note that this behaviour is quite different from the "prefer the longer match"
+behaviour of I<yacc>. For example, if I<yacc> were parsing the rule:
+
+ seq : 'A' 'B'
+ | 'A' 'B' 'C'
+
+upon matching "AB" it would look ahead to see if a 'C' is next and, if
+so, will match the second production in preference to the first. In
+other words, I<yacc> effectively tries all the productions of a rule
+breadth-first in parallel, and selects the "best" match, where "best"
+means longest (note that this is a gross simplification of the true
+behaviour of I<yacc> but it will do for our purposes).
+
+In contrast, C<Parse::RecDescent> tries each production depth-first in
+sequence, and selects the "best" match, where "best" means first. This is
+the fundamental difference between "bottom-up" and "recursive descent"
+parsing.
+
+Each successfully matched item in a production is assigned a value,
+which can be accessed in subsequent actions within the same
+production (or, in some cases, as the return value of a successful
+subrule call). Unsuccessful items don't have an associated value,
+since the failure of an item causes the entire surrounding production
+to immediately fail. The following sections describe the various types
+of items and their success values.
+
+
+=head2 Subrules
+
+A subrule which appears in a production is an instruction to the parser to
+attempt to match the named rule at that point in the text being
+parsed. If the named subrule is not defined when requested the
+production containing it immediately fails (unless it was "autostubbed" - see
+L<Autostubbing>).
+
+A rule may (recursively) call itself as a subrule, but I<not> as the
+left-most item in any of its productions (since such recursions are usually
+non-terminating).
+
+The value associated with a subrule is the value associated with its
+C<$return> variable (see L<"Actions"> below), or with the last successfully
+matched item in the subrule match.
+
+Subrules may also be specified with a trailing repetition specifier,
+indicating that they are to be (greedily) matched the specified number
+of times. The available specifiers are:
+
+ subrule(?) # Match one-or-zero times
+ subrule(s) # Match one-or-more times
+ subrule(s?) # Match zero-or-more times
+ subrule(N) # Match exactly N times for integer N > 0
+ subrule(N..M) # Match between N and M times
+ subrule(..M) # Match between 1 and M times
+ subrule(N..) # Match at least N times
+
+Repeated subrules keep matching until either the subrule fails to
+match, or it has matched the minimal number of times but fails to
+consume any of the parsed text (this second condition prevents the
+subrule matching forever in some cases).
+
+Since a repeated subrule may match many instances of the subrule itself, the
+value associated with it is not a simple scalar, but rather a reference to a
+list of scalars, each of which is the value associated with one of the
+individual subrule matches. In other words in the rule:
+
+ program: statement(s)
+
+the value associated with the repeated subrule "statement(s)" is a reference
+to an array containing the values matched by each call to the individual
+subrule "statement".
+
+Repetition modifiers may include a separator pattern:
+
+ program: statement(s /;/)
+
+specifying some sequence of characters to be skipped between each repetition.
+This is really just a shorthand for the E<lt>leftop:...E<gt> directive
+(see below).
+
+=head2 Tokens
+
+If a quote-delimited string or a Perl regex appears in a production,
+the parser attempts to match that string or pattern at that point in
+the text. For example:
+
+ typedef: "typedef" typename identifier ';'
+
+ identifier: /[A-Za-z_][A-Za-z0-9_]*/
+
+As in regular Perl, a single quoted string is uninterpolated, whilst
+a double-quoted string or a pattern is interpolated (at the time
+of matching, I<not> when the parser is constructed). Hence, it is
+possible to define rules in which tokens can be set at run-time:
+
+ typedef: "$::typedefkeyword" typename identifier ';'
+
+ identifier: /$::identpat/
+
+Note that, since each rule is implemented inside a special namespace
+belonging to its parser, it is necessary to explicitly quantify
+variables from the main package.
+
+Regex tokens can be specified using just slashes as delimiters
+or with the explicit C<mE<lt>delimiterE<gt>......E<lt>delimiterE<gt>> syntax:
+
+ typedef: "typedef" typename identifier ';'
+
+ typename: /[A-Za-z_][A-Za-z0-9_]*/
+
+ identifier: m{[A-Za-z_][A-Za-z0-9_]*}
+
+A regex of either type can also have any valid trailing parameter(s)
+(that is, any of [cgimsox]):
+
+ typedef: "typedef" typename identifier ';'
+
+ identifier: / [a-z_] # LEADING ALPHA OR UNDERSCORE
+ [a-z0-9_]* # THEN DIGITS ALSO ALLOWED
+ /ix # CASE/SPACE/COMMENT INSENSITIVE
+
+The value associated with any successfully matched token is a string
+containing the actual text which was matched by the token.
+
+It is important to remember that, since each grammar is specified in a
+Perl string, all instances of the universal escape character '\' within
+a grammar must be "doubled", so that they interpolate to single '\'s when
+the string is compiled. For example, to use the grammar:
+
+ word: /\S+/ | backslash
+ line: prefix word(s) "\n"
+ backslash: '\\'
+
+the following code is required:
+
+ $parser = new Parse::RecDescent (q{
+
+ word: /\\S+/ | backslash
+ line: prefix word(s) "\\n"
+ backslash: '\\\\'
+
+ });
+
+=head2 Anonymous subrules
+
+Parentheses introduce a nested scope that is very like a call to an anonymous
+subrule. Hence they are useful for "in-lining" subroutine calls, and other
+kinds of grouping behaviour. For example, instead of:
+
+ word: /\S+/ | backslash
+ line: prefix word(s) "\n"
+
+you could write:
+
+ line: prefix ( /\S+/ | backslash )(s) "\n"
+
+and get exactly the same effects.
+
+Parentheses are also use for collecting unrepeated alternations within a
+single production.
+
+ secret_identity: "Mr" ("Incredible"|"Fantastic"|"Sheen") ", Esq."
+
+
+=head2 Terminal Separators
+
+For the purpose of matching, each terminal in a production is considered
+to be preceded by a "prefix" - a pattern which must be
+matched before a token match is attempted. By default, the
+prefix is optional whitespace (which always matches, at
+least trivially), but this default may be reset in any production.
+
+The variable C<$Parse::RecDescent::skip> stores the universal
+prefix, which is the default for all terminal matches in all parsers
+built with C<Parse::RecDescent>.
+
+If you want to change the universal prefix using
+C<$Parse::RecDescent::skip>, be careful to set it I<before> creating
+the grammar object, because it is applied statically (when a grammar
+is built) rather than dynamically (when the grammar is used).
+Alternatively you can provide a global C<E<lt>skip:...E<gt>> directive
+in your grammar before any rules (described later).
+
+The prefix for an individual production can be altered
+by using the C<E<lt>skip:...E<gt>> directive (described later).
+Setting this directive in the top-level rule is an alternative approach
+to setting C<$Parse::RecDescent::skip> before creating the object, but
+in this case you don't get the intended skipping behaviour if you
+directly invoke methods different from the top-level rule.
+
+
+=head2 Actions
+
+An action is a block of Perl code which is to be executed (as the
+block of a C<do> statement) when the parser reaches that point in a
+production. The action executes within a special namespace belonging to
+the active parser, so care must be taken in correctly qualifying variable
+names (see also L<Start-up Actions> below).
+
+The action is considered to succeed if the final value of the block
+is defined (that is, if the implied C<do> statement evaluates to a
+defined value - I<even one which would be treated as "false">). Note
+that the value associated with a successful action is also the final
+value in the block.
+
+An action will I<fail> if its last evaluated value is C<undef>. This is
+surprisingly easy to accomplish by accident. For instance, here's an
+infuriating case of an action that makes its production fail, but only
+when debugging I<isn't> activated:
+
+ description: name rank serial_number
+ { print "Got $item[2] $item[1] ($item[3])\n"
+ if $::debugging
+ }
+
+If C<$debugging> is false, no statement in the block is executed, so
+the final value is C<undef>, and the entire production fails. The solution is:
+
+ description: name rank serial_number
+ { print "Got $item[2] $item[1] ($item[3])\n"
+ if $::debugging;
+ 1;
+ }
+
+Within an action, a number of useful parse-time variables are
+available in the special parser namespace (there are other variables
+also accessible, but meddling with them will probably just break your
+parser. As a general rule, if you avoid referring to unqualified
+variables - especially those starting with an underscore - inside an action,
+things should be okay):
+
+=over 4
+
+=item C<@item> and C<%item>
+
+The array slice C<@item[1..$#item]> stores the value associated with each item
+(that is, each subrule, token, or action) in the current production. The
+analogy is to C<$1>, C<$2>, etc. in a I<yacc> grammar.
+Note that, for obvious reasons, C<@item> only contains the
+values of items I<before> the current point in the production.
+
+The first element (C<$item[0]>) stores the name of the current rule
+being matched.
+
+C<@item> is a standard Perl array, so it can also be indexed with negative
+numbers, representing the number of items I<back> from the current position in
+the parse:
+
+ stuff: /various/ bits 'and' pieces "then" data 'end'
+ { print $item[-2] } # PRINTS data
+ # (EASIER THAN: $item[6])
+
+The C<%item> hash complements the <@item> array, providing named
+access to the same item values:
+
+ stuff: /various/ bits 'and' pieces "then" data 'end'
+ { print $item{data} # PRINTS data
+ # (EVEN EASIER THAN USING @item)
+
+
+The results of named subrules are stored in the hash under each
+subrule's name (including the repetition specifier, if any),
+whilst all other items are stored under a "named
+positional" key that indictates their ordinal position within their item
+type: __STRINGI<n>__, __PATTERNI<n>__, __DIRECTIVEI<n>__, __ACTIONI<n>__:
+
+ stuff: /various/ bits 'and' pieces "then" data 'end' { save }
+ { print $item{__PATTERN1__}, # PRINTS 'various'
+ $item{__STRING2__}, # PRINTS 'then'
+ $item{__ACTION1__}, # PRINTS RETURN
+ # VALUE OF save
+ }
+
+
+If you want proper I<named> access to patterns or literals, you need to turn
+them into separate rules:
+
+ stuff: various bits 'and' pieces "then" data 'end'
+ { print $item{various} # PRINTS various
+ }
+
+ various: /various/
+
+
+The special entry C<$item{__RULE__}> stores the name of the current
+rule (i.e. the same value as C<$item[0]>.
+
+The advantage of using C<%item>, instead of C<@items> is that it
+removes the need to track items positions that may change as a grammar
+evolves. For example, adding an interim C<E<lt>skipE<gt>> directive
+of action can silently ruin a trailing action, by moving an C<@item>
+element "down" the array one place. In contrast, the named entry
+of C<%item> is unaffected by such an insertion.
+
+A limitation of the C<%item> hash is that it only records the I<last>
+value of a particular subrule. For example:
+
+ range: '(' number '..' number )'
+ { $return = $item{number} }
+
+will return only the value corresponding to the I<second> match of the
+C<number> subrule. In other words, successive calls to a subrule
+overwrite the corresponding entry in C<%item>. Once again, the
+solution is to rename each subrule in its own rule:
+
+ range: '(' from_num '..' to_num ')'
+ { $return = $item{from_num} }
+
+ from_num: number
+ to_num: number
+
+
+
+=item C<@arg> and C<%arg>
+
+The array C<@arg> and the hash C<%arg> store any arguments passed to
+the rule from some other rule (see L<Subrule argument lists>). Changes
+to the elements of either variable do not propagate back to the calling
+rule (data can be passed back from a subrule via the C<$return>
+variable - see next item).
+
+
+=item C<$return>
+
+If a value is assigned to C<$return> within an action, that value is
+returned if the production containing the action eventually matches
+successfully. Note that setting C<$return> I<doesn't> cause the current
+production to succeed. It merely tells it what to return if it I<does> succeed.
+Hence C<$return> is analogous to C<$$> in a I<yacc> grammar.
+
+If C<$return> is not assigned within a production, the value of the
+last component of the production (namely: C<$item[$#item]>) is
+returned if the production succeeds.
+
+
+=item C<$commit>
+
+The current state of commitment to the current production (see L<"Directives">
+below).
+
+=item C<$skip>
+
+The current terminal prefix (see L<"Directives"> below).
+
+=item C<$text>
+
+The remaining (unparsed) text. Changes to C<$text> I<do not
+propagate> out of unsuccessful productions, but I<do> survive
+successful productions. Hence it is possible to dynamically alter the
+text being parsed - for example, to provide a C<#include>-like facility:
+
+ hash_include: '#include' filename
+ { $text = ::loadfile($item[2]) . $text }
+
+ filename: '<' /[a-z0-9._-]+/i '>' { $return = $item[2] }
+ | '"' /[a-z0-9._-]+/i '"' { $return = $item[2] }
+
+
+=item C<$thisline> and C<$prevline>
+
+C<$thisline> stores the current line number within the current parse
+(starting from 1). C<$prevline> stores the line number for the last
+character which was already successfully parsed (this will be different from
+C<$thisline> at the end of each line).
+
+For efficiency, C<$thisline> and C<$prevline> are actually tied
+hashes, and only recompute the required line number when the variable's
+value is used.
+
+Assignment to C<$thisline> adjusts the line number calculator, so that
+it believes that the current line number is the value being assigned. Note
+that this adjustment will be reflected in all subsequent line numbers
+calculations.
+
+Modifying the value of the variable C<$text> (as in the previous
+C<hash_include> example, for instance) will confuse the line
+counting mechanism. To prevent this, you should call
+C<Parse::RecDescent::LineCounter::resync($thisline)> I<immediately>
+after any assignment to the variable C<$text> (or, at least, before the
+next attempt to use C<$thisline>).
+
+Note that if a production fails after assigning to or
+resync'ing C<$thisline>, the parser's line counter mechanism will
+usually be corrupted.
+
+Also see the entry for C<@itempos>.
+
+The line number can be set to values other than 1, by calling the start
+rule with a second argument. For example:
+
+ $parser = new Parse::RecDescent ($grammar);
+
+ $parser->input($text, 10); # START LINE NUMBERS AT 10
+
+
+=item C<$thiscolumn> and C<$prevcolumn>
+
+C<$thiscolumn> stores the current column number within the current line
+being parsed (starting from 1). C<$prevcolumn> stores the column number
+of the last character which was actually successfully parsed. Usually
+C<$prevcolumn == $thiscolumn-1>, but not at the end of lines.
+
+For efficiency, C<$thiscolumn> and C<$prevcolumn> are
+actually tied hashes, and only recompute the required column number
+when the variable's value is used.
+
+Assignment to C<$thiscolumn> or C<$prevcolumn> is a fatal error.
+
+Modifying the value of the variable C<$text> (as in the previous
+C<hash_include> example, for instance) may confuse the column
+counting mechanism.
+
+Note that C<$thiscolumn> reports the column number I<before> any
+whitespace that might be skipped before reading a token. Hence
+if you wish to know where a token started (and ended) use something like this:
+
+ rule: token1 token2 startcol token3 endcol token4
+ { print "token3: columns $item[3] to $item[5]"; }
+
+ startcol: '' { $thiscolumn } # NEED THE '' TO STEP PAST TOKEN SEP
+ endcol: { $prevcolumn }
+
+Also see the entry for C<@itempos>.
+
+=item C<$thisoffset> and C<$prevoffset>
+
+C<$thisoffset> stores the offset of the current parsing position
+within the complete text
+being parsed (starting from 0). C<$prevoffset> stores the offset
+of the last character which was actually successfully parsed. In all
+cases C<$prevoffset == $thisoffset-1>.
+
+For efficiency, C<$thisoffset> and C<$prevoffset> are
+actually tied hashes, and only recompute the required offset
+when the variable's value is used.
+
+Assignment to C<$thisoffset> or <$prevoffset> is a fatal error.
+
+Modifying the value of the variable C<$text> will I<not> affect the
+offset counting mechanism.
+
+Also see the entry for C<@itempos>.
+
+=item C<@itempos>
+
+The array C<@itempos> stores a hash reference corresponding to
+each element of C<@item>. The elements of the hash provide the
+following:
+
+ $itempos[$n]{offset}{from} # VALUE OF $thisoffset BEFORE $item[$n]
+ $itempos[$n]{offset}{to} # VALUE OF $prevoffset AFTER $item[$n]
+ $itempos[$n]{line}{from} # VALUE OF $thisline BEFORE $item[$n]
+ $itempos[$n]{line}{to} # VALUE OF $prevline AFTER $item[$n]
+ $itempos[$n]{column}{from} # VALUE OF $thiscolumn BEFORE $item[$n]
+ $itempos[$n]{column}{to} # VALUE OF $prevcolumn AFTER $item[$n]
+
+Note that the various C<$itempos[$n]...{from}> values record the
+appropriate value I<after> any token prefix has been skipped.
+
+Hence, instead of the somewhat tedious and error-prone:
+
+ rule: startcol token1 endcol
+ startcol token2 endcol
+ startcol token3 endcol
+ { print "token1: columns $item[1]
+ to $item[3]
+ token2: columns $item[4]
+ to $item[6]
+ token3: columns $item[7]
+ to $item[9]" }
+
+ startcol: '' { $thiscolumn } # NEED THE '' TO STEP PAST TOKEN SEP
+ endcol: { $prevcolumn }
+
+it is possible to write:
+
+ rule: token1 token2 token3
+ { print "token1: columns $itempos[1]{column}{from}
+ to $itempos[1]{column}{to}
+ token2: columns $itempos[2]{column}{from}
+ to $itempos[2]{column}{to}
+ token3: columns $itempos[3]{column}{from}
+ to $itempos[3]{column}{to}" }
+
+Note however that (in the current implementation) the use of C<@itempos>
+anywhere in a grammar implies that item positioning information is
+collected I<everywhere> during the parse. Depending on the grammar
+and the size of the text to be parsed, this may be prohibitively
+expensive and the explicit use of C<$thisline>, C<$thiscolumn>, etc. may
+be a better choice.
+
+
+=item C<$thisparser>
+
+A reference to the S<C<Parse::RecDescent>> object through which
+parsing was initiated.
+
+The value of C<$thisparser> propagates down the subrules of a parse
+but not back up. Hence, you can invoke subrules from another parser
+for the scope of the current rule as follows:
+
+ rule: subrule1 subrule2
+ | { $thisparser = $::otherparser } <reject>
+ | subrule3 subrule4
+ | subrule5
+
+The result is that the production calls "subrule1" and "subrule2" of
+the current parser, and the remaining productions call the named subrules
+from C<$::otherparser>. Note, however that "Bad Things" will happen if
+C<::otherparser> isn't a blessed reference and/or doesn't have methods
+with the same names as the required subrules!
+
+=item C<$thisrule>
+
+A reference to the S<C<Parse::RecDescent::Rule>> object corresponding to the
+rule currently being matched.
+
+=item C<$thisprod>
+
+A reference to the S<C<Parse::RecDescent::Production>> object
+corresponding to the production currently being matched.
+
+=item C<$score> and C<$score_return>
+
+$score stores the best production score to date, as specified by
+an earlier C<E<lt>score:...E<gt>> directive. $score_return stores
+the corresponding return value for the successful production.
+
+See L<Scored productions>.
+
+=back
+
+B<Warning:> the parser relies on the information in the various C<this...>
+objects in some non-obvious ways. Tinkering with the other members of
+these objects will probably cause Bad Things to happen, unless you
+I<really> know what you're doing. The only exception to this advice is
+that the use of C<$this...-E<gt>{local}> is always safe.
+
+
+=head2 Start-up Actions
+
+Any actions which appear I<before> the first rule definition in a
+grammar are treated as "start-up" actions. Each such action is
+stripped of its outermost brackets and then evaluated (in the parser's
+special namespace) just before the rules of the grammar are first
+compiled.
+
+The main use of start-up actions is to declare local variables within the
+parser's special namespace:
+
+ { my $lastitem = '???'; }
+
+ list: item(s) { $return = $lastitem }
+
+ item: book { $lastitem = 'book'; }
+ bell { $lastitem = 'bell'; }
+ candle { $lastitem = 'candle'; }
+
+but start-up actions can be used to execute I<any> valid Perl code
+within a parser's special namespace.
+
+Start-up actions can appear within a grammar extension or replacement
+(that is, a partial grammar installed via C<Parse::RecDescent::Extend()> or
+C<Parse::RecDescent::Replace()> - see L<Incremental Parsing>), and will be
+executed before the new grammar is installed. Note, however, that a
+particular start-up action is only ever executed once.
+
+
+=head2 Autoactions
+
+It is sometimes desirable to be able to specify a default action to be
+taken at the end of every production (for example, in order to easily
+build a parse tree). If the variable C<$::RD_AUTOACTION> is defined
+when C<Parse::RecDescent::new()> is called, the contents of that
+variable are treated as a specification of an action which is to appended
+to each production in the corresponding grammar.
+
+Alternatively, you can hard-code the autoaction within a grammar, using the
+C<< <autoaction:...> >> directive.
+
+So, for example, to construct a simple parse tree you could write:
+
+ $::RD_AUTOACTION = q { [@item] };
+
+ parser = Parse::RecDescent->new(q{
+ expression: and_expr '||' expression | and_expr
+ and_expr: not_expr '&&' and_expr | not_expr
+ not_expr: '!' brack_expr | brack_expr
+ brack_expr: '(' expression ')' | identifier
+ identifier: /[a-z]+/i
+ });
+
+or:
+
+ parser = Parse::RecDescent->new(q{
+ <autoaction: { [@item] } >
+
+ expression: and_expr '||' expression | and_expr
+ and_expr: not_expr '&&' and_expr | not_expr
+ not_expr: '!' brack_expr | brack_expr
+ brack_expr: '(' expression ')' | identifier
+ identifier: /[a-z]+/i
+ });
+
+Either of these is equivalent to:
+
+ parser = new Parse::RecDescent (q{
+ expression: and_expr '||' expression
+ { [@item] }
+ | and_expr
+ { [@item] }
+
+ and_expr: not_expr '&&' and_expr
+ { [@item] }
+ | not_expr
+ { [@item] }
+
+ not_expr: '!' brack_expr
+ { [@item] }
+ | brack_expr
+ { [@item] }
+
+ brack_expr: '(' expression ')'
+ { [@item] }
+ | identifier
+ { [@item] }
+
+ identifier: /[a-z]+/i
+ { [@item] }
+ });
+
+Alternatively, we could take an object-oriented approach, use different
+classes for each node (and also eliminating redundant intermediate nodes):
+
+ $::RD_AUTOACTION = q
+ { $#item==1 ? $item[1] : "$item[0]_node"->new(@item[1..$#item]) };
+
+ parser = Parse::RecDescent->new(q{
+ expression: and_expr '||' expression | and_expr
+ and_expr: not_expr '&&' and_expr | not_expr
+ not_expr: '!' brack_expr | brack_expr
+ brack_expr: '(' expression ')' | identifier
+ identifier: /[a-z]+/i
+ });
+
+or:
+
+ parser = Parse::RecDescent->new(q{
+ <autoaction:
+ $#item==1 ? $item[1] : "$item[0]_node"->new(@item[1..$#item])
+ >
+
+ expression: and_expr '||' expression | and_expr
+ and_expr: not_expr '&&' and_expr | not_expr
+ not_expr: '!' brack_expr | brack_expr
+ brack_expr: '(' expression ')' | identifier
+ identifier: /[a-z]+/i
+ });
+
+which are equivalent to:
+
+ parser = Parse::RecDescent->new(q{
+ expression: and_expr '||' expression
+ { "expression_node"->new(@item[1..3]) }
+ | and_expr
+
+ and_expr: not_expr '&&' and_expr
+ { "and_expr_node"->new(@item[1..3]) }
+ | not_expr
+
+ not_expr: '!' brack_expr
+ { "not_expr_node"->new(@item[1..2]) }
+ | brack_expr
+
+ brack_expr: '(' expression ')'
+ { "brack_expr_node"->new(@item[1..3]) }
+ | identifier
+
+ identifier: /[a-z]+/i
+ { "identifer_node"->new(@item[1]) }
+ });
+
+Note that, if a production already ends in an action, no autoaction is appended
+to it. For example, in this version:
+
+ $::RD_AUTOACTION = q
+ { $#item==1 ? $item[1] : "$item[0]_node"->new(@item[1..$#item]) };
+
+ parser = Parse::RecDescent->new(q{
+ expression: and_expr '&&' expression | and_expr
+ and_expr: not_expr '&&' and_expr | not_expr
+ not_expr: '!' brack_expr | brack_expr
+ brack_expr: '(' expression ')' | identifier
+ identifier: /[a-z]+/i
+ { 'terminal_node'->new($item[1]) }
+ });
+
+each C<identifier> match produces a C<terminal_node> object, I<not> an
+C<identifier_node> object.
+
+A level 1 warning is issued each time an "autoaction" is added to
+some production.
+
+
+=head2 Autotrees
+
+A commonly needed autoaction is one that builds a parse-tree. It is moderately
+tricky to set up such an action (which must treat terminals differently from
+non-terminals), so Parse::RecDescent simplifies the process by providing the
+C<E<lt>autotreeE<gt>> directive.
+
+If this directive appears at the start of grammar, it causes
+Parse::RecDescent to insert autoactions at the end of any rule except
+those which already end in an action. The action inserted depends on whether
+the production is an intermediate rule (two or more items), or a terminal
+of the grammar (i.e. a single pattern or string item).
+
+So, for example, the following grammar:
+
+ <autotree>
+
+ file : command(s)
+ command : get | set | vet
+ get : 'get' ident ';'
+ set : 'set' ident 'to' value ';'
+ vet : 'check' ident 'is' value ';'
+ ident : /\w+/
+ value : /\d+/
+
+is equivalent to:
+
+ file : command(s) { bless \%item, $item[0] }
+ command : get { bless \%item, $item[0] }
+ | set { bless \%item, $item[0] }
+ | vet { bless \%item, $item[0] }
+ get : 'get' ident ';' { bless \%item, $item[0] }
+ set : 'set' ident 'to' value ';' { bless \%item, $item[0] }
+ vet : 'check' ident 'is' value ';' { bless \%item, $item[0] }
+
+ ident : /\w+/ { bless {__VALUE__=>$item[1]}, $item[0] }
+ value : /\d+/ { bless {__VALUE__=>$item[1]}, $item[0] }
+
+Note that each node in the tree is blessed into a class of the same name
+as the rule itself. This makes it easy to build object-oriented
+processors for the parse-trees that the grammar produces. Note too that
+the last two rules produce special objects with the single attribute
+'__VALUE__'. This is because they consist solely of a single terminal.
+
+This autoaction-ed grammar would then produce a parse tree in a data
+structure like this:
+
+ {
+ file => {
+ command => {
+ [ get => {
+ identifier => { __VALUE__ => 'a' },
+ },
+ set => {
+ identifier => { __VALUE__ => 'b' },
+ value => { __VALUE__ => '7' },
+ },
+ vet => {
+ identifier => { __VALUE__ => 'b' },
+ value => { __VALUE__ => '7' },
+ },
+ ],
+ },
+ }
+ }
+
+(except, of course, that each nested hash would also be blessed into
+the appropriate class).
+
+You can also specify a base class for the C<E<lt>autotreeE<gt>> directive.
+The supplied prefix will be prepended to the rule names when creating
+tree nodes. The following are equivalent:
+
+ <autotree:MyBase::Class>
+ <autotree:MyBase::Class::>
+
+And will produce a root node blessed into the C<MyBase::Class::file>
+package in the example above.
+
+
+=head2 Autostubbing
+
+Normally, if a subrule appears in some production, but no rule of that
+name is ever defined in the grammar, the production which refers to the
+non-existent subrule fails immediately. This typically occurs as a
+result of misspellings, and is a sufficiently common occurance that a
+warning is generated for such situations.
+
+However, when prototyping a grammar it is sometimes useful to be
+able to use subrules before a proper specification of them is
+really possible. For example, a grammar might include a section like:
+
+ function_call: identifier '(' arg(s?) ')'
+
+ identifier: /[a-z]\w*/i
+
+where the possible format of an argument is sufficiently complex that
+it is not worth specifying in full until the general function call
+syntax has been debugged. In this situation it is convenient to leave
+the real rule C<arg> undefined and just slip in a placeholder (or
+"stub"):
+
+ arg: 'arg'
+
+so that the function call syntax can be tested with dummy input such as:
+
+ f0()
+ f1(arg)
+ f2(arg arg)
+ f3(arg arg arg)
+
+et cetera.
+
+Early in prototyping, many such "stubs" may be required, so
+C<Parse::RecDescent> provides a means of automating their definition.
+If the variable C<$::RD_AUTOSTUB> is defined when a parser is built, a
+subrule reference to any non-existent rule (say, C<subrule>), will
+cause a "stub" rule to be automatically defined in the generated
+parser. If C<$::RD_AUTOSTUB eq '1'> or is false, a stub rule of the
+form:
+
+ subrule: 'subrule'
+
+will be generated. The special-case for a value of C<'1'> is to allow
+the use of the B<perl -s> with B<-RD_AUTOSTUB> without generating
+C<subrule: '1'> per below. If C<$::RD_AUTOSTUB> is true, a stub rule
+of the form:
+
+ subrule: $::RD_AUTOSTUB
+
+will be generated. C<$::RD_AUTOSTUB> must contain a valid production
+item, no checking is performed. No lazy evaluation of
+C<$::RD_AUTOSTUB> is performed, it is evaluated at the time the Parser
+is generated.
+
+Hence, with C<$::RD_AUTOSTUB> defined, it is possible to only
+partially specify a grammar, and then "fake" matches of the
+unspecified (sub)rules by just typing in their name, or a literal
+value that was assigned to C<$::RD_AUTOSTUB>.
+
+
+
+=head2 Look-ahead
+
+If a subrule, token, or action is prefixed by "...", then it is
+treated as a "look-ahead" request. That means that the current production can
+(as usual) only succeed if the specified item is matched, but that the matching
+I<does not consume any of the text being parsed>. This is very similar to the
+C</(?=...)/> look-ahead construct in Perl patterns. Thus, the rule:
+
+ inner_word: word ...word
+
+will match whatever the subrule "word" matches, provided that match is followed
+by some more text which subrule "word" would also match (although this
+second substring is not actually consumed by "inner_word")
+
+Likewise, a "...!" prefix, causes the following item to succeed (without
+consuming any text) if and only if it would normally fail. Hence, a
+rule such as:
+
+ identifier: ...!keyword ...!'_' /[A-Za-z_]\w*/
+
+matches a string of characters which satisfies the pattern
+C</[A-Za-z_]\w*/>, but only if the same sequence of characters would
+not match either subrule "keyword" or the literal token '_'.
+
+Sequences of look-ahead prefixes accumulate, multiplying their positive and/or
+negative senses. Hence:
+
+ inner_word: word ...!......!word
+
+is exactly equivalent the the original example above (a warning is issued in
+cases like these, since they often indicate something left out, or
+misunderstood).
+
+Note that actions can also be treated as look-aheads. In such cases,
+the state of the parser text (in the local variable C<$text>)
+I<after> the look-ahead action is guaranteed to be identical to its
+state I<before> the action, regardless of how it's changed I<within>
+the action (unless you actually undefine C<$text>, in which case you
+get the disaster you deserve :-).
+
+
+=head2 Directives
+
+Directives are special pre-defined actions which may be used to alter
+the behaviour of the parser. There are currently twenty-three directives:
+C<E<lt>commitE<gt>>,
+C<E<lt>uncommitE<gt>>,
+C<E<lt>rejectE<gt>>,
+C<E<lt>scoreE<gt>>,
+C<E<lt>autoscoreE<gt>>,
+C<E<lt>skipE<gt>>,
+C<E<lt>resyncE<gt>>,
+C<E<lt>errorE<gt>>,
+C<E<lt>warnE<gt>>,
+C<E<lt>hintE<gt>>,
+C<E<lt>trace_buildE<gt>>,
+C<E<lt>trace_parseE<gt>>,
+C<E<lt>nocheckE<gt>>,
+C<E<lt>rulevarE<gt>>,
+C<E<lt>matchruleE<gt>>,
+C<E<lt>leftopE<gt>>,
+C<E<lt>rightopE<gt>>,
+C<E<lt>deferE<gt>>,
+C<E<lt>nocheckE<gt>>,
+C<E<lt>perl_quotelikeE<gt>>,
+C<E<lt>perl_codeblockE<gt>>,
+C<E<lt>perl_variableE<gt>>,
+and C<E<lt>tokenE<gt>>.
+
+=over 4
+
+=item Committing and uncommitting
+
+The C<E<lt>commitE<gt>> and C<E<lt>uncommitE<gt>> directives permit the recursive
+descent of the parse tree to be pruned (or "cut") for efficiency.
+Within a rule, a C<E<lt>commitE<gt>> directive instructs the rule to ignore subsequent
+productions if the current production fails. For example:
+
+ command: 'find' <commit> filename
+ | 'open' <commit> filename
+ | 'move' filename filename
+
+Clearly, if the leading token 'find' is matched in the first production but that
+production fails for some other reason, then the remaining
+productions cannot possibly match. The presence of the
+C<E<lt>commitE<gt>> causes the "command" rule to fail immediately if
+an invalid "find" command is found, and likewise if an invalid "open"
+command is encountered.
+
+It is also possible to revoke a previous commitment. For example:
+
+ if_statement: 'if' <commit> condition
+ 'then' block <uncommit>
+ 'else' block
+ | 'if' <commit> condition
+ 'then' block
+
+In this case, a failure to find an "else" block in the first
+production shouldn't preclude trying the second production, but a
+failure to find a "condition" certainly should.
+
+As a special case, any production in which the I<first> item is an
+C<E<lt>uncommitE<gt>> immediately revokes a preceding C<E<lt>commitE<gt>>
+(even though the production would not otherwise have been tried). For
+example, in the rule:
+
+ request: 'explain' expression
+ | 'explain' <commit> keyword
+ | 'save'
+ | 'quit'
+ | <uncommit> term '?'
+
+if the text being matched was "explain?", and the first two
+productions failed, then the C<E<lt>commitE<gt>> in production two would cause
+productions three and four to be skipped, but the leading
+C<E<lt>uncommitE<gt>> in the production five would allow that production to
+attempt a match.
+
+Note in the preceding example, that the C<E<lt>commitE<gt>> was only placed
+in production two. If production one had been:
+
+ request: 'explain' <commit> expression
+
+then production two would be (inappropriately) skipped if a leading
+"explain..." was encountered.
+
+Both C<E<lt>commitE<gt>> and C<E<lt>uncommitE<gt>> directives always succeed, and their value
+is always 1.
+
+
+=item Rejecting a production
+
+The C<E<lt>rejectE<gt>> directive immediately causes the current production
+to fail (it is exactly equivalent to, but more obvious than, the
+action C<{undef}>). A C<E<lt>rejectE<gt>> is useful when it is desirable to get
+the side effects of the actions in one production, without prejudicing a match
+by some other production later in the rule. For example, to insert
+tracing code into the parse:
+
+ complex_rule: { print "In complex rule...\n"; } <reject>
+
+ complex_rule: simple_rule '+' 'i' '*' simple_rule
+ | 'i' '*' simple_rule
+ | simple_rule
+
+
+It is also possible to specify a conditional rejection, using the
+form C<E<lt>reject:I<condition>E<gt>>, which only rejects if the
+specified condition is true. This form of rejection is exactly
+equivalent to the action C<{(I<condition>)?undef:1}E<gt>>.
+For example:
+
+ command: save_command
+ | restore_command
+ | <reject: defined $::tolerant> { exit }
+ | <error: Unknown command. Ignored.>
+
+A C<E<lt>rejectE<gt>> directive never succeeds (and hence has no
+associated value). A conditional rejection may succeed (if its
+condition is not satisfied), in which case its value is 1.
+
+As an extra optimization, C<Parse::RecDescent> ignores any production
+which I<begins> with an unconditional C<E<lt>rejectE<gt>> directive,
+since any such production can never successfully match or have any
+useful side-effects. A level 1 warning is issued in all such cases.
+
+Note that productions beginning with conditional
+C<E<lt>reject:...E<gt>> directives are I<never> "optimized away" in
+this manner, even if they are always guaranteed to fail (for example:
+C<E<lt>reject:1E<gt>>)
+
+Due to the way grammars are parsed, there is a minor restriction on the
+condition of a conditional C<E<lt>reject:...E<gt>>: it cannot
+contain any raw '<' or '>' characters. For example:
+
+ line: cmd <reject: $thiscolumn > max> data
+
+results in an error when a parser is built from this grammar (since the
+grammar parser has no way of knowing whether the first > is a "less than"
+or the end of the C<E<lt>reject:...E<gt>>.
+
+To overcome this problem, put the condition inside a do{} block:
+
+ line: cmd <reject: do{$thiscolumn > max}> data
+
+Note that the same problem may occur in other directives that take
+arguments. The same solution will work in all cases.
+
+
+=item Skipping between terminals
+
+The C<E<lt>skipE<gt>> directive enables the terminal prefix used in
+a production to be changed. For example:
+
+ OneLiner: Command <skip:'[ \t]*'> Arg(s) /;/
+
+causes only blanks and tabs to be skipped before terminals in the C<Arg>
+subrule (and any of I<its> subrules>, and also before the final C</;/> terminal.
+Once the production is complete, the previous terminal prefix is
+reinstated. Note that this implies that distinct productions of a rule
+must reset their terminal prefixes individually.
+
+The C<E<lt>skipE<gt>> directive evaluates to the I<previous> terminal prefix,
+so it's easy to reinstate a prefix later in a production:
+
+ Command: <skip:","> CSV(s) <skip:$item[1]> Modifier
+
+The value specified after the colon is interpolated into a pattern, so all of
+the following are equivalent (though their efficiency increases down the list):
+
+ <skip: "$colon|$comma"> # ASSUMING THE VARS HOLD THE OBVIOUS VALUES
+
+ <skip: ':|,'>
+
+ <skip: q{[:,]}>
+
+ <skip: qr/[:,]/>
+
+There is no way of directly setting the prefix for
+an entire rule, except as follows:
+
+ Rule: <skip: '[ \t]*'> Prod1
+ | <skip: '[ \t]*'> Prod2a Prod2b
+ | <skip: '[ \t]*'> Prod3
+
+or, better:
+
+ Rule: <skip: '[ \t]*'>
+ (
+ Prod1
+ | Prod2a Prod2b
+ | Prod3
+ )
+
+The skip pattern is passed down to subrules, so setting the skip for
+the top-level rule as described above actually sets the prefix for the
+entire grammar (provided that you only call the method corresponding
+to the top-level rule itself). Alternatively, or if you have more than
+one top-level rule in your grammar, you can provide a global
+C<E<lt>skipE<gt>> directive prior to defining any rules in the
+grammar. These are the preferred alternatives to setting
+C<$Parse::RecDescent::skip>.
+
+Additionally, using C<E<lt>skipE<gt>> actually allows you to have
+a completely dynamic skipping behaviour. For example:
+
+ Rule_with_dynamic_skip: <skip: $::skip_pattern> Rule
+
+Then you can set C<$::skip_pattern> before invoking
+C<Rule_with_dynamic_skip> and have it skip whatever you specified.
+
+B<Note: Up to release 1.51 of Parse::RecDescent, an entirely different
+mechanism was used for specifying terminal prefixes. The current method
+is not backwards-compatible with that early approach. The current approach
+is stable and will not to change again.>
+
+
+=item Resynchronization
+
+The C<E<lt>resyncE<gt>> directive provides a visually distinctive
+means of consuming some of the text being parsed, usually to skip an
+erroneous input. In its simplest form C<E<lt>resyncE<gt>> simply
+consumes text up to and including the next newline (C<"\n">)
+character, succeeding only if the newline is found, in which case it
+causes its surrounding rule to return zero on success.
+
+In other words, a C<E<lt>resyncE<gt>> is exactly equivalent to the token
+C</[^\n]*\n/> followed by the action S<C<{ $return = 0 }>> (except that
+productions beginning with a C<E<lt>resyncE<gt>> are ignored when generating
+error messages). A typical use might be:
+
+ script : command(s)
+
+ command: save_command
+ | restore_command
+ | <resync> # TRY NEXT LINE, IF POSSIBLE
+
+It is also possible to explicitly specify a resynchronization
+pattern, using the C<E<lt>resync:I<pattern>E<gt>> variant. This version
+succeeds only if the specified pattern matches (and consumes) the
+parsed text. In other words, C<E<lt>resync:I<pattern>E<gt>> is exactly
+equivalent to the token C</I<pattern>/> (followed by a S<C<{ $return = 0 }>>
+action). For example, if commands were terminated by newlines or semi-colons:
+
+ command: save_command
+ | restore_command
+ | <resync:[^;\n]*[;\n]>
+
+The value of a successfully matched C<E<lt>resyncE<gt>> directive (of either
+type) is the text that it consumed. Note, however, that since the
+directive also sets C<$return>, a production consisting of a lone
+C<E<lt>resyncE<gt>> succeeds but returns the value zero (which a calling rule
+may find useful to distinguish between "true" matches and "tolerant" matches).
+Remember that returning a zero value indicates that the rule I<succeeded> (since
+only an C<undef> denotes failure within C<Parse::RecDescent> parsers.
+
+
+=item Error handling
+
+The C<E<lt>errorE<gt>> directive provides automatic or user-defined
+generation of error messages during a parse. In its simplest form
+C<E<lt>errorE<gt>> prepares an error message based on
+the mismatch between the last item expected and the text which cause
+it to fail. For example, given the rule:
+
+ McCoy: curse ',' name ', I'm a doctor, not a' a_profession '!'
+ | pronoun 'dead,' name '!'
+ | <error>
+
+the following strings would produce the following messages:
+
+=over 4
+
+=item "Amen, Jim!"
+
+ ERROR (line 1): Invalid McCoy: Expected curse or pronoun
+ not found
+
+=item "Dammit, Jim, I'm a doctor!"
+
+ ERROR (line 1): Invalid McCoy: Expected ", I'm a doctor, not a"
+ but found ", I'm a doctor!" instead
+
+=item "He's dead,\n"
+
+ ERROR (line 2): Invalid McCoy: Expected name not found
+
+=item "He's alive!"
+
+ ERROR (line 1): Invalid McCoy: Expected 'dead,' but found
+ "alive!" instead
+
+=item "Dammit, Jim, I'm a doctor, not a pointy-eared Vulcan!"
+
+ ERROR (line 1): Invalid McCoy: Expected a profession but found
+ "pointy-eared Vulcan!" instead
+
+
+=back
+
+Note that, when autogenerating error messages, all underscores in any
+rule name used in a message are replaced by single spaces (for example
+"a_production" becomes "a production"). Judicious choice of rule
+names can therefore considerably improve the readability of automatic
+error messages (as well as the maintainability of the original
+grammar).
+
+If the automatically generated error is not sufficient, it is possible to
+provide an explicit message as part of the error directive. For example:
+
+ Spock: "Fascinating ',' (name | 'Captain') '.'
+ | "Highly illogical, doctor."
+ | <error: He never said that!>
+
+which would result in I<all> failures to parse a "Spock" subrule printing the
+following message:
+
+ ERROR (line <N>): Invalid Spock: He never said that!
+
+The error message is treated as a "qq{...}" string and interpolated
+when the error is generated (I<not> when the directive is specified!).
+Hence:
+
+ <error: Mystical error near "$text">
+
+would correctly insert the ambient text string which caused the error.
+
+There are two other forms of error directive: C<E<lt>error?E<gt>> and
+S<C<E<lt>error?: msgE<gt>>>. These behave just like C<E<lt>errorE<gt>>
+and S<C<E<lt>error: msgE<gt>>> respectively, except that they are
+only triggered if the rule is "committed" at the time they are
+encountered. For example:
+
+ Scotty: "Ya kenna change the Laws of Phusics," <commit> name
+ | name <commit> ',' 'she's goanta blaw!'
+ | <error?>
+
+will only generate an error for a string beginning with "Ya kenna
+change the Laws o' Phusics," or a valid name, but which still fails to match the
+corresponding production. That is, C<$parser-E<gt>Scotty("Aye, Cap'ain")> will
+fail silently (since neither production will "commit" the rule on that
+input), whereas S<C<$parser-E<gt>Scotty("Mr Spock, ah jest kenna do'ut!")>>
+will fail with the error message:
+
+ ERROR (line 1): Invalid Scotty: expected 'she's goanta blaw!'
+ but found 'I jest kenna do'ut!' instead.
+
+since in that case the second production would commit after matching
+the leading name.
+
+Note that to allow this behaviour, all C<E<lt>errorE<gt>> directives which are
+the first item in a production automatically uncommit the rule just
+long enough to allow their production to be attempted (that is, when
+their production fails, the commitment is reinstated so that
+subsequent productions are skipped).
+
+In order to I<permanently> uncommit the rule before an error message,
+it is necessary to put an explicit C<E<lt>uncommitE<gt>> before the
+C<E<lt>errorE<gt>>. For example:
+
+ line: 'Kirk:' <commit> Kirk
+ | 'Spock:' <commit> Spock
+ | 'McCoy:' <commit> McCoy
+ | <uncommit> <error?> <reject>
+ | <resync>
+
+
+Error messages generated by the various C<E<lt>error...E<gt>> directives
+are not displayed immediately. Instead, they are "queued" in a buffer and
+are only displayed once parsing ultimately fails. Moreover,
+C<E<lt>error...E<gt>> directives that cause one production of a rule
+to fail are automatically removed from the message queue
+if another production subsequently causes the entire rule to succeed.
+This means that you can put
+C<E<lt>error...E<gt>> directives wherever useful diagnosis can be done,
+and only those associated with actual parser failure will ever be
+displayed. Also see L<"GOTCHAS">.
+
+As a general rule, the most useful diagnostics are usually generated
+either at the very lowest level within the grammar, or at the very
+highest. A good rule of thumb is to identify those subrules which
+consist mainly (or entirely) of terminals, and then put an
+C<E<lt>error...E<gt>> directive at the end of any other rule which calls
+one or more of those subrules.
+
+There is one other situation in which the output of the various types of
+error directive is suppressed; namely, when the rule containing them
+is being parsed as part of a "look-ahead" (see L<"Look-ahead">). In this
+case, the error directive will still cause the rule to fail, but will do
+so silently.
+
+An unconditional C<E<lt>errorE<gt>> directive always fails (and hence has no
+associated value). This means that encountering such a directive
+always causes the production containing it to fail. Hence an
+C<E<lt>errorE<gt>> directive will inevitably be the last (useful) item of a
+rule (a level 3 warning is issued if a production contains items after an unconditional
+C<E<lt>errorE<gt>> directive).
+
+An C<E<lt>error?E<gt>> directive will I<succeed> (that is: fail to fail :-), if
+the current rule is uncommitted when the directive is encountered. In
+that case the directive's associated value is zero. Hence, this type
+of error directive I<can> be used before the end of a
+production. For example:
+
+ command: 'do' <commit> something
+ | 'report' <commit> something
+ | <error?: Syntax error> <error: Unknown command>
+
+
+B<Warning:> The C<E<lt>error?E<gt>> directive does I<not> mean "always fail (but
+do so silently unless committed)". It actually means "only fail (and report) if
+committed, otherwise I<succeed>". To achieve the "fail silently if uncommitted"
+semantics, it is necessary to use:
+
+ rule: item <commit> item(s)
+ | <error?> <reject> # FAIL SILENTLY UNLESS COMMITTED
+
+However, because people seem to expect a lone C<E<lt>error?E<gt>> directive
+to work like this:
+
+ rule: item <commit> item(s)
+ | <error?: Error message if committed>
+ | <error: Error message if uncommitted>
+
+Parse::RecDescent automatically appends a
+C<E<lt>rejectE<gt>> directive if the C<E<lt>error?E<gt>> directive
+is the only item in a production. A level 2 warning (see below)
+is issued when this happens.
+
+The level of error reporting during both parser construction and
+parsing is controlled by the presence or absence of four global
+variables: C<$::RD_ERRORS>, C<$::RD_WARN>, C<$::RD_HINT>, and
+<$::RD_TRACE>. If C<$::RD_ERRORS> is defined (and, by default, it is)
+then fatal errors are reported.
+
+Whenever C<$::RD_WARN> is defined, certain non-fatal problems are also reported.
+
+Warnings have an associated "level": 1, 2, or 3. The higher the level,
+the more serious the warning. The value of the corresponding global
+variable (C<$::RD_WARN>) determines the I<lowest> level of warning to
+be displayed. Hence, to see I<all> warnings, set C<$::RD_WARN> to 1.
+To see only the most serious warnings set C<$::RD_WARN> to 3.
+By default C<$::RD_WARN> is initialized to 3, ensuring that serious but
+non-fatal errors are automatically reported.
+
+There is also a grammar directive to turn on warnings from within the
+grammar: C<< <warn> >>. It takes an optional argument, which specifies
+the warning level: C<< <warn: 2> >>.
+
+See F<"DIAGNOSTICS"> for a list of the varous error and warning messages
+that Parse::RecDescent generates when these two variables are defined.
+
+Defining any of the remaining variables (which are not defined by
+default) further increases the amount of information reported.
+Defining C<$::RD_HINT> causes the parser generator to offer
+more detailed analyses and hints on both errors and warnings.
+Note that setting C<$::RD_HINT> at any point automagically
+sets C<$::RD_WARN> to 1. There is also a C<< <hint> >> directive, which can
+be hard-coded into a grammar.
+
+Defining C<$::RD_TRACE> causes the parser generator and the parser to
+report their progress to STDERR in excruciating detail (although, without hints
+unless $::RD_HINT is separately defined). This detail
+can be moderated in only one respect: if C<$::RD_TRACE> has an
+integer value (I<N>) greater than 1, only the I<N> characters of
+the "current parsing context" (that is, where in the input string we
+are at any point in the parse) is reported at any time.
+
+C<$::RD_TRACE> is mainly useful for debugging a grammar that isn't
+behaving as you expected it to. To this end, if C<$::RD_TRACE> is
+defined when a parser is built, any actual parser code which is
+generated is also written to a file named "RD_TRACE" in the local
+directory.
+
+There are two directives associated with the C<$::RD_TRACE> variable.
+If a grammar contains a C<< <trace_build> >> directive anywhere in its
+specification, C<$::RD_TRACE> is turned on during the parser construction
+phase. If a grammar contains a C<< <trace_parse> >> directive anywhere in its
+specification, C<$::RD_TRACE> is turned on during any parse the parser
+performs.
+
+Note that the four variables belong to the "main" package, which
+makes them easier to refer to in the code controlling the parser, and
+also makes it easy to turn them into command line flags ("-RD_ERRORS",
+"-RD_WARN", "-RD_HINT", "-RD_TRACE") under B<perl -s>.
+
+The corresponding directives are useful to "hardwire" the various
+debugging features into a particular grammar (rather than having to set
+and reset external variables).
+
+=item Redirecting diagnostics
+
+The diagnostics provided by the tracing mechanism always go to STDERR.
+If you need them to go elsewhere, localize and reopen STDERR prior to the
+parse.
+
+For example:
+
+ {
+ local *STDERR = IO::File->new(">$filename") or die $!;
+
+ my $result = $parser->startrule($text);
+ }
+
+
+=item Consistency checks
+
+Whenever a parser is build, Parse::RecDescent carries out a number of
+(potentially expensive) consistency checks. These include: verifying that the
+grammar is not left-recursive and that no rules have been left undefined.
+
+These checks are important safeguards during development, but unnecessary
+overheads when the grammar is stable and ready to be deployed. So
+Parse::RecDescent provides a directive to disable them: C<< <nocheck> >>.
+
+If a grammar contains a C<< <nocheck> >> directive anywhere in its
+specification, the extra compile-time checks are by-passed.
+
+
+=item Specifying local variables
+
+It is occasionally convenient to specify variables which are local
+to a single rule. This may be achieved by including a
+C<E<lt>rulevar:...E<gt>> directive anywhere in the rule. For example:
+
+ markup: <rulevar: $tag>
+
+ markup: tag {($tag=$item[1]) =~ s/^<|>$//g} body[$tag]
+
+The example C<E<lt>rulevar: $tagE<gt>> directive causes a "my" variable named
+C<$tag> to be declared at the start of the subroutine implementing the
+C<markup> rule (that is, I<before> the first production, regardless of
+where in the rule it is specified).
+
+Specifically, any directive of the form:
+C<E<lt>rulevar:I<text>E<gt>> causes a line of the form C<my I<text>;>
+to be added at the beginning of the rule subroutine, immediately after
+the definitions of the following local variables:
+
+ $thisparser $commit
+ $thisrule @item
+ $thisline @arg
+ $text %arg
+
+This means that the following C<E<lt>rulevarE<gt>> directives work
+as expected:
+
+ <rulevar: $count = 0 >
+
+ <rulevar: $firstarg = $arg[0] || '' >
+
+ <rulevar: $myItems = \@item >
+
+ <rulevar: @context = ( $thisline, $text, @arg ) >
+
+ <rulevar: ($name,$age) = $arg{"name","age"} >
+
+If a variable that is also visible to subrules is required, it needs
+to be C<local>'d, not C<my>'d. C<rulevar> defaults to C<my>, but if C<local>
+is explicitly specified:
+
+ <rulevar: local $count = 0 >
+
+then a C<local>-ized variable is declared instead, and will be available
+within subrules.
+
+Note however that, because all such variables are "my" variables, their
+values I<do not persist> between match attempts on a given rule. To
+preserve values between match attempts, values can be stored within the
+"local" member of the C<$thisrule> object:
+
+ countedrule: { $thisrule->{"local"}{"count"}++ }
+ <reject>
+ | subrule1
+ | subrule2
+ | <reject: $thisrule->{"local"}{"count"} == 1>
+ subrule3
+
+
+When matching a rule, each C<E<lt>rulevarE<gt>> directive is matched as
+if it were an unconditional C<E<lt>rejectE<gt>> directive (that is, it
+causes any production in which it appears to immediately fail to match).
+For this reason (and to improve readability) it is usual to specify any
+C<E<lt>rulevarE<gt>> directive in a separate production at the start of
+the rule (this has the added advantage that it enables
+C<Parse::RecDescent> to optimize away such productions, just as it does
+for the C<E<lt>rejectE<gt>> directive).
+
+
+=item Dynamically matched rules
+
+Because regexes and double-quoted strings are interpolated, it is relatively
+easy to specify productions with "context sensitive" tokens. For example:
+
+ command: keyword body "end $item[1]"
+
+which ensures that a command block is bounded by a
+"I<E<lt>keywordE<gt>>...end I<E<lt>same keywordE<gt>>" pair.
+
+Building productions in which subrules are context sensitive is also possible,
+via the C<E<lt>matchrule:...E<gt>> directive. This directive behaves
+identically to a subrule item, except that the rule which is invoked to match
+it is determined by the string specified after the colon. For example, we could
+rewrite the C<command> rule like this:
+
+ command: keyword <matchrule:body> "end $item[1]"
+
+Whatever appears after the colon in the directive is treated as an interpolated
+string (that is, as if it appeared in C<qq{...}> operator) and the value of
+that interpolated string is the name of the subrule to be matched.
+
+Of course, just putting a constant string like C<body> in a
+C<E<lt>matchrule:...E<gt>> directive is of little interest or benefit.
+The power of directive is seen when we use a string that interpolates
+to something interesting. For example:
+
+ command: keyword <matchrule:$item[1]_body> "end $item[1]"
+
+ keyword: 'while' | 'if' | 'function'
+
+ while_body: condition block
+
+ if_body: condition block ('else' block)(?)
+
+ function_body: arglist block
+
+Now the C<command> rule selects how to proceed on the basis of the keyword
+that is found. It is as if C<command> were declared:
+
+ command: 'while' while_body "end while"
+ | 'if' if_body "end if"
+ | 'function' function_body "end function"
+
+
+When a C<E<lt>matchrule:...E<gt>> directive is used as a repeated
+subrule, the rule name expression is "late-bound". That is, the name of
+the rule to be called is re-evaluated I<each time> a match attempt is
+made. Hence, the following grammar:
+
+ { $::species = 'dogs' }
+
+ pair: 'two' <matchrule:$::species>(s)
+
+ dogs: /dogs/ { $::species = 'cats' }
+
+ cats: /cats/
+
+will match the string "two dogs cats cats" completely, whereas it will
+only match the string "two dogs dogs dogs" up to the eighth letter. If
+the rule name were "early bound" (that is, evaluated only the first
+time the directive is encountered in a production), the reverse
+behaviour would be expected.
+
+Note that the C<matchrule> directive takes a string that is to be treated
+as a rule name, I<not> as a rule invocation. That is,
+it's like a Perl symbolic reference, not an C<eval>. Just as you can say:
+
+ $subname = 'foo';
+
+ # and later...
+
+ &{$foo}(@args);
+
+but not:
+
+ $subname = 'foo(@args)';
+
+ # and later...
+
+ &{$foo};
+
+likewise you can say:
+
+ $rulename = 'foo';
+
+ # and in the grammar...
+
+ <matchrule:$rulename>[@args]
+
+but not:
+
+ $rulename = 'foo[@args]';
+
+ # and in the grammar...
+
+ <matchrule:$rulename>
+
+
+=item Deferred actions
+
+The C<E<lt>defer:...E<gt>> directive is used to specify an action to be
+performed when (and only if!) the current production ultimately succeeds.
+
+Whenever a C<E<lt>defer:...E<gt>> directive appears, the code it specifies
+is converted to a closure (an anonymous subroutine reference) which is
+queued within the active parser object. Note that,
+because the deferred code is converted to a closure, the values of any
+"local" variable (such as C<$text>, <@item>, etc.) are preserved
+until the deferred code is actually executed.
+
+If the parse ultimately succeeds
+I<and> the production in which the C<E<lt>defer:...E<gt>> directive was
+evaluated formed part of the successful parse, then the deferred code is
+executed immediately before the parse returns. If however the production
+which queued a deferred action fails, or one of the higher-level
+rules which called that production fails, then the deferred action is
+removed from the queue, and hence is never executed.
+
+For example, given the grammar:
+
+ sentence: noun trans noun
+ | noun intrans
+
+ noun: 'the dog'
+ { print "$item[1]\t(noun)\n" }
+ | 'the meat'
+ { print "$item[1]\t(noun)\n" }
+
+ trans: 'ate'
+ { print "$item[1]\t(transitive)\n" }
+
+ intrans: 'ate'
+ { print "$item[1]\t(intransitive)\n" }
+ | 'barked'
+ { print "$item[1]\t(intransitive)\n" }
+
+then parsing the sentence C<"the dog ate"> would produce the output:
+
+ the dog (noun)
+ ate (transitive)
+ the dog (noun)
+ ate (intransitive)
+
+This is because, even though the first production of C<sentence>
+ultimately fails, its initial subrules C<noun> and C<trans> do match,
+and hence they execute their associated actions.
+Then the second production of C<sentence> succeeds, causing the
+actions of the subrules C<noun> and C<intrans> to be executed as well.
+
+On the other hand, if the actions were replaced by C<E<lt>defer:...E<gt>>
+directives:
+
+ sentence: noun trans noun
+ | noun intrans
+
+ noun: 'the dog'
+ <defer: print "$item[1]\t(noun)\n" >
+ | 'the meat'
+ <defer: print "$item[1]\t(noun)\n" >
+
+ trans: 'ate'
+ <defer: print "$item[1]\t(transitive)\n" >
+
+ intrans: 'ate'
+ <defer: print "$item[1]\t(intransitive)\n" >
+ | 'barked'
+ <defer: print "$item[1]\t(intransitive)\n" >
+
+the output would be:
+
+ the dog (noun)
+ ate (intransitive)
+
+since deferred actions are only executed if they were evaluated in
+a production which ultimately contributes to the successful parse.
+
+In this case, even though the first production of C<sentence> caused
+the subrules C<noun> and C<trans> to match, that production ultimately
+failed and so the deferred actions queued by those subrules were subsequently
+disgarded. The second production then succeeded, causing the entire
+parse to succeed, and so the deferred actions queued by the (second) match of
+the C<noun> subrule and the subsequent match of C<intrans> I<are> preserved and
+eventually executed.
+
+Deferred actions provide a means of improving the performance of a parser,
+by only executing those actions which are part of the final parse-tree
+for the input data.
+
+Alternatively, deferred actions can be viewed as a mechanism for building
+(and executing) a
+customized subroutine corresponding to the given input data, much in the
+same way that autoactions (see L<"Autoactions">) can be used to build a
+customized data structure for specific input.
+
+Whether or not the action it specifies is ever executed,
+a C<E<lt>defer:...E<gt>> directive always succeeds, returning the
+number of deferred actions currently queued at that point.
+
+
+=item Parsing Perl
+
+Parse::RecDescent provides limited support for parsing subsets of Perl,
+namely: quote-like operators, Perl variables, and complete code blocks.
+
+The C<E<lt>perl_quotelikeE<gt>> directive can be used to parse any Perl
+quote-like operator: C<'a string'>, C<m/a pattern/>, C<tr{ans}{lation}>,
+etc. It does this by calling Text::Balanced::quotelike().
+
+If a quote-like operator is found, a reference to an array of eight elements
+is returned. Those elements are identical to the last eight elements returned
+by Text::Balanced::extract_quotelike() in an array context, namely:
+
+=over 4
+
+=item [0]
+
+the name of the quotelike operator -- 'q', 'qq', 'm', 's', 'tr' -- if the
+operator was named; otherwise C<undef>,
+
+=item [1]
+
+the left delimiter of the first block of the operation,
+
+=item [2]
+
+the text of the first block of the operation
+(that is, the contents of
+a quote, the regex of a match, or substitution or the target list of a
+translation),
+
+=item [3]
+
+the right delimiter of the first block of the operation,
+
+=item [4]
+
+the left delimiter of the second block of the operation if there is one
+(that is, if it is a C<s>, C<tr>, or C<y>); otherwise C<undef>,
+
+=item [5]
+
+the text of the second block of the operation if there is one
+(that is, the replacement of a substitution or the translation list
+of a translation); otherwise C<undef>,
+
+=item [6]
+
+the right delimiter of the second block of the operation (if any);
+otherwise C<undef>,
+
+=item [7]
+
+the trailing modifiers on the operation (if any); otherwise C<undef>.
+
+=back
+
+If a quote-like expression is not found, the directive fails with the usual
+C<undef> value.
+
+The C<E<lt>perl_variableE<gt>> directive can be used to parse any Perl
+variable: $scalar, @array, %hash, $ref->{field}[$index], etc.
+It does this by calling Text::Balanced::extract_variable().
+
+If the directive matches text representing a valid Perl variable
+specification, it returns that text. Otherwise it fails with the usual
+C<undef> value.
+
+The C<E<lt>perl_codeblockE<gt>> directive can be used to parse curly-brace-delimited block of Perl code, such as: { $a = 1; f() =~ m/pat/; }.
+It does this by calling Text::Balanced::extract_codeblock().
+
+If the directive matches text representing a valid Perl code block,
+it returns that text. Otherwise it fails with the usual C<undef> value.
+
+You can also tell it what kind of brackets to use as the outermost
+delimiters. For example:
+
+ arglist: <perl_codeblock ()>
+
+causes an arglist to match a perl code block whose outermost delimiters
+are C<(...)> (rather than the default C<{...}>).
+
+
+=item Constructing tokens
+
+Eventually, Parse::RecDescent will be able to parse tokenized input, as
+well as ordinary strings. In preparation for this joyous day, the
+C<E<lt>token:...E<gt>> directive has been provided.
+This directive creates a token which will be suitable for
+input to a Parse::RecDescent parser (when it eventually supports
+tokenized input).
+
+The text of the token is the value of the
+immediately preceding item in the production. A
+C<E<lt>token:...E<gt>> directive always succeeds with a return
+value which is the hash reference that is the new token. It also
+sets the return value for the production to that hash ref.
+
+The C<E<lt>token:...E<gt>> directive makes it easy to build
+a Parse::RecDescent-compatible lexer in Parse::RecDescent:
+
+ my $lexer = new Parse::RecDescent q
+ {
+ lex: token(s)
+
+ token: /a\b/ <token:INDEF>
+ | /the\b/ <token:DEF>
+ | /fly\b/ <token:NOUN,VERB>
+ | /[a-z]+/i { lc $item[1] } <token:ALPHA>
+ | <error: Unknown token>
+
+ };
+
+which will eventually be able to be used with a regular Parse::RecDescent
+grammar:
+
+ my $parser = new Parse::RecDescent q
+ {
+ startrule: subrule1 subrule 2
+
+ # ETC...
+ };
+
+either with a pre-lexing phase:
+
+ $parser->startrule( $lexer->lex($data) );
+
+or with a lex-on-demand approach:
+
+ $parser->startrule( sub{$lexer->token(\$data)} );
+
+But at present, only the C<E<lt>token:...E<gt>> directive is
+actually implemented. The rest is vapourware.
+
+=item Specifying operations
+
+One of the commonest requirements when building a parser is to specify
+binary operators. Unfortunately, in a normal grammar, the rules for
+such things are awkward:
+
+ disjunction: conjunction ('or' conjunction)(s?)
+ { $return = [ $item[1], @{$item[2]} ] }
+
+ conjunction: atom ('and' atom)(s?)
+ { $return = [ $item[1], @{$item[2]} ] }
+
+or inefficient:
+
+ disjunction: conjunction 'or' disjunction
+ { $return = [ $item[1], @{$item[2]} ] }
+ | conjunction
+ { $return = [ $item[1] ] }
+
+ conjunction: atom 'and' conjunction
+ { $return = [ $item[1], @{$item[2]} ] }
+ | atom
+ { $return = [ $item[1] ] }
+
+and either way is ugly and hard to get right.
+
+The C<E<lt>leftop:...E<gt>> and C<E<lt>rightop:...E<gt>> directives provide an
+easier way of specifying such operations. Using C<E<lt>leftop:...E<gt>> the
+above examples become:
+
+ disjunction: <leftop: conjunction 'or' conjunction>
+ conjunction: <leftop: atom 'and' atom>
+
+The C<E<lt>leftop:...E<gt>> directive specifies a left-associative binary operator.
+It is specified around three other grammar elements
+(typically subrules or terminals), which match the left operand,
+the operator itself, and the right operand respectively.
+
+A C<E<lt>leftop:...E<gt>> directive such as:
+
+ disjunction: <leftop: conjunction 'or' conjunction>
+
+is converted to the following:
+
+ disjunction: ( conjunction ('or' conjunction)(s?)
+ { $return = [ $item[1], @{$item[2]} ] } )
+
+In other words, a C<E<lt>leftop:...E<gt>> directive matches the left operand followed by zero
+or more repetitions of both the operator and the right operand. It then
+flattens the matched items into an anonymous array which becomes the
+(single) value of the entire C<E<lt>leftop:...E<gt>> directive.
+
+For example, an C<E<lt>leftop:...E<gt>> directive such as:
+
+ output: <leftop: ident '<<' expr >
+
+when given a string such as:
+
+ cout << var << "str" << 3
+
+would match, and C<$item[1]> would be set to:
+
+ [ 'cout', 'var', '"str"', '3' ]
+
+In other words:
+
+ output: <leftop: ident '<<' expr >
+
+is equivalent to a left-associative operator:
+
+ output: ident { $return = [$item[1]] }
+ | ident '<<' expr { $return = [@item[1,3]] }
+ | ident '<<' expr '<<' expr { $return = [@item[1,3,5]] }
+ | ident '<<' expr '<<' expr '<<' expr { $return = [@item[1,3,5,7]] }
+ # ...etc...
+
+
+Similarly, the C<E<lt>rightop:...E<gt>> directive takes a left operand, an operator, and a right operand:
+
+ assign: <rightop: var '=' expr >
+
+and converts them to:
+
+ assign: ( (var '=' {$return=$item[1]})(s?) expr
+ { $return = [ @{$item[1]}, $item[2] ] } )
+
+which is equivalent to a right-associative operator:
+
+ assign: expr { $return = [$item[1]] }
+ | var '=' expr { $return = [@item[1,3]] }
+ | var '=' var '=' expr { $return = [@item[1,3,5]] }
+ | var '=' var '=' var '=' expr { $return = [@item[1,3,5,7]] }
+ # ...etc...
+
+
+Note that for both the C<E<lt>leftop:...E<gt>> and C<E<lt>rightop:...E<gt>> directives, the directive does not normally
+return the operator itself, just a list of the operands involved. This is
+particularly handy for specifying lists:
+
+ list: '(' <leftop: list_item ',' list_item> ')'
+ { $return = $item[2] }
+
+There is, however, a problem: sometimes the operator is itself significant.
+For example, in a Perl list a comma and a C<=E<gt>> are both
+valid separators, but the C<=E<gt>> has additional stringification semantics.
+Hence it's important to know which was used in each case.
+
+To solve this problem the
+C<E<lt>leftop:...E<gt>> and C<E<lt>rightop:...E<gt>> directives
+I<do> return the operator(s) as well, under two circumstances.
+The first case is where the operator is specified as a subrule. In that instance,
+whatever the operator matches is returned (on the assumption that if the operator
+is important enough to have its own subrule, then it's important enough to return).
+
+The second case is where the operator is specified as a regular
+expression. In that case, if the first bracketed subpattern of the
+regular expression matches, that matching value is returned (this is analogous to
+the behaviour of the Perl C<split> function, except that only the first subpattern
+is returned).
+
+In other words, given the input:
+
+ ( a=>1, b=>2 )
+
+the specifications:
+
+ list: '(' <leftop: list_item separator list_item> ')'
+
+ separator: ',' | '=>'
+
+or:
+
+ list: '(' <leftop: list_item /(,|=>)/ list_item> ')'
+
+cause the list separators to be interleaved with the operands in the
+anonymous array in C<$item[2]>:
+
+ [ 'a', '=>', '1', ',', 'b', '=>', '2' ]
+
+
+But the following version:
+
+ list: '(' <leftop: list_item /,|=>/ list_item> ')'
+
+returns only the operators:
+
+ [ 'a', '1', 'b', '2' ]
+
+Of course, none of the above specifications handle the case of an empty
+list, since the C<E<lt>leftop:...E<gt>> and C<E<lt>rightop:...E<gt>> directives
+require at least a single right or left operand to match. To specify
+that the operator can match "trivially",
+it's necessary to add a C<(s?)> qualifier to the directive:
+
+ list: '(' <leftop: list_item /(,|=>)/ list_item>(s?) ')'
+
+Note that in almost all the above examples, the first and third arguments
+of the C<<leftop:...E<gt>> directive were the same subrule. That is because
+C<<leftop:...E<gt>>'s are frequently used to specify "separated" lists of the
+same type of item. To make such lists easier to specify, the following
+syntax:
+
+ list: element(s /,/)
+
+is exactly equivalent to:
+
+ list: <leftop: element /,/ element>
+
+Note that the separator must be specified as a raw pattern (i.e.
+not a string or subrule).
+
+
+=item Scored productions
+
+By default, Parse::RecDescent grammar rules always accept the first
+production that matches the input. But if two or more productions may
+potentially match the same input, choosing the first that does so may
+not be optimal.
+
+For example, if you were parsing the sentence "time flies like an arrow",
+you might use a rule like this:
+
+ sentence: verb noun preposition article noun { [@item] }
+ | adjective noun verb article noun { [@item] }
+ | noun verb preposition article noun { [@item] }
+
+Each of these productions matches the sentence, but the third one
+is the most likely interpretation. However, if the sentence had been
+"fruit flies like a banana", then the second production is probably
+the right match.
+
+To cater for such situtations, the C<E<lt>score:...E<gt>> can be used.
+The directive is equivalent to an unconditional C<E<lt>rejectE<gt>>,
+except that it allows you to specify a "score" for the current
+production. If that score is numerically greater than the best
+score of any preceding production, the current production is cached for later
+consideration. If no later production matches, then the cached
+production is treated as having matched, and the value of the
+item immediately before its C<E<lt>score:...E<gt>> directive is returned as the
+result.
+
+In other words, by putting a C<E<lt>score:...E<gt>> directive at the end of
+each production, you can select which production matches using
+criteria other than specification order. For example:
+
+ sentence: verb noun preposition article noun { [@item] } <score: sensible(@item)>
+ | adjective noun verb article noun { [@item] } <score: sensible(@item)>
+ | noun verb preposition article noun { [@item] } <score: sensible(@item)>
+
+Now, when each production reaches its respective C<E<lt>score:...E<gt>>
+directive, the subroutine C<sensible> will be called to evaluate the
+matched items (somehow). Once all productions have been tried, the
+one which C<sensible> scored most highly will be the one that is
+accepted as a match for the rule.
+
+The variable $score always holds the current best score of any production,
+and the variable $score_return holds the corresponding return value.
+
+As another example, the following grammar matches lines that may be
+separated by commas, colons, or semi-colons. This can be tricky if
+a colon-separated line also contains commas, or vice versa. The grammar
+resolves the ambiguity by selecting the rule that results in the
+fewest fields:
+
+ line: seplist[sep=>','] <score: -@{$item[1]}>
+ | seplist[sep=>':'] <score: -@{$item[1]}>
+ | seplist[sep=>" "] <score: -@{$item[1]}>
+
+ seplist: <skip:""> <leftop: /[^$arg{sep}]*/ "$arg{sep}" /[^$arg{sep}]*/>
+
+Note the use of negation within the C<E<lt>score:...E<gt>> directive
+to ensure that the seplist with the most items gets the lowest score.
+
+As the above examples indicate, it is often the case that all productions
+in a rule use exactly the same C<E<lt>score:...E<gt>> directive. It is
+tedious to have to repeat this identical directive in every production, so
+Parse::RecDescent also provides the C<E<lt>autoscore:...E<gt>> directive.
+
+If an C<E<lt>autoscore:...E<gt>> directive appears in any
+production of a rule, the code it specifies is used as the scoring
+code for every production of that rule, except productions that already
+end with an explicit C<E<lt>score:...E<gt>> directive. Thus the rules above could
+be rewritten:
+
+ line: <autoscore: -@{$item[1]}>
+ line: seplist[sep=>',']
+ | seplist[sep=>':']
+ | seplist[sep=>" "]
+
+
+ sentence: <autoscore: sensible(@item)>
+ | verb noun preposition article noun { [@item] }
+ | adjective noun verb article noun { [@item] }
+ | noun verb preposition article noun { [@item] }
+
+Note that the C<E<lt>autoscore:...E<gt>> directive itself acts as an
+unconditional C<E<lt>rejectE<gt>>, and (like the C<E<lt>rulevar:...E<gt>>
+directive) is pruned at compile-time wherever possible.
+
+
+=item Dispensing with grammar checks
+
+During the compilation phase of parser construction, Parse::RecDescent performs
+a small number of checks on the grammar it's given. Specifically it checks that
+the grammar is not left-recursive, that there are no "insatiable" constructs of
+the form:
+
+ rule: subrule(s) subrule
+
+and that there are no rules missing (i.e. referred to, but never defined).
+
+These checks are important during development, but can slow down parser
+construction in stable code. So Parse::RecDescent provides the
+E<lt>nocheckE<gt> directive to turn them off. The directive can only appear
+before the first rule definition, and switches off checking throughout the rest
+of the current grammar.
+
+Typically, this directive would be added when a parser has been thoroughly
+tested and is ready for release.
+
+=back
+
+
+=head2 Subrule argument lists
+
+It is occasionally useful to pass data to a subrule which is being invoked. For
+example, consider the following grammar fragment:
+
+ classdecl: keyword decl
+
+ keyword: 'struct' | 'class';
+
+ decl: # WHATEVER
+
+The C<decl> rule might wish to know which of the two keywords was used
+(since it may affect some aspect of the way the subsequent declaration
+is interpreted). C<Parse::RecDescent> allows the grammar designer to
+pass data into a rule, by placing that data in an I<argument list>
+(that is, in square brackets) immediately after any subrule item in a
+production. Hence, we could pass the keyword to C<decl> as follows:
+
+ classdecl: keyword decl[ $item[1] ]
+
+ keyword: 'struct' | 'class';
+
+ decl: # WHATEVER
+
+The argument list can consist of any number (including zero!) of comma-separated
+Perl expressions. In other words, it looks exactly like a Perl anonymous
+array reference. For example, we could pass the keyword, the name of the
+surrounding rule, and the literal 'keyword' to C<decl> like so:
+
+ classdecl: keyword decl[$item[1],$item[0],'keyword']
+
+ keyword: 'struct' | 'class';
+
+ decl: # WHATEVER
+
+Within the rule to which the data is passed (C<decl> in the above examples)
+that data is available as the elements of a local variable C<@arg>. Hence
+C<decl> might report its intentions as follows:
+
+ classdecl: keyword decl[$item[1],$item[0],'keyword']
+
+ keyword: 'struct' | 'class';
+
+ decl: { print "Declaring $arg[0] (a $arg[2])\n";
+ print "(this rule called by $arg[1])" }
+
+Subrule argument lists can also be interpreted as hashes, simply by using
+the local variable C<%arg> instead of C<@arg>. Hence we could rewrite the
+previous example:
+
+ classdecl: keyword decl[keyword => $item[1],
+ caller => $item[0],
+ type => 'keyword']
+
+ keyword: 'struct' | 'class';
+
+ decl: { print "Declaring $arg{keyword} (a $arg{type})\n";
+ print "(this rule called by $arg{caller})" }
+
+Both C<@arg> and C<%arg> are always available, so the grammar designer may
+choose whichever convention (or combination of conventions) suits best.
+
+Subrule argument lists are also useful for creating "rule templates"
+(especially when used in conjunction with the C<E<lt>matchrule:...E<gt>>
+directive). For example, the subrule:
+
+ list: <matchrule:$arg{rule}> /$arg{sep}/ list[%arg]
+ { $return = [ $item[1], @{$item[3]} ] }
+ | <matchrule:$arg{rule}>
+ { $return = [ $item[1]] }
+
+is a handy template for the common problem of matching a separated list.
+For example:
+
+ function: 'func' name '(' list[rule=>'param',sep=>';'] ')'
+
+ param: list[rule=>'name',sep=>','] ':' typename
+
+ name: /\w+/
+
+ typename: name
+
+
+When a subrule argument list is used with a repeated subrule, the argument list
+goes I<before> the repetition specifier:
+
+ list: /some|many/ thing[ $item[1] ](s)
+
+The argument list is "late bound". That is, it is re-evaluated for every
+repetition of the repeated subrule.
+This means that each repeated attempt to match the subrule may be
+passed a completely different set of arguments if the value of the
+expression in the argument list changes between attempts. So, for
+example, the grammar:
+
+ { $::species = 'dogs' }
+
+ pair: 'two' animal[$::species](s)
+
+ animal: /$arg[0]/ { $::species = 'cats' }
+
+will match the string "two dogs cats cats" completely, whereas
+it will only match the string "two dogs dogs dogs" up to the
+eighth letter. If the value of the argument list were "early bound"
+(that is, evaluated only the first time a repeated subrule match is
+attempted), one would expect the matching behaviours to be reversed.
+
+Of course, it is possible to effectively "early bind" such argument lists
+by passing them a value which does not change on each repetition. For example:
+
+ { $::species = 'dogs' }
+
+ pair: 'two' { $::species } animal[$item[2]](s)
+
+ animal: /$arg[0]/ { $::species = 'cats' }
+
+
+Arguments can also be passed to the start rule, simply by appending them
+to the argument list with which the start rule is called (I<after> the
+"line number" parameter). For example, given:
+
+ $parser = new Parse::RecDescent ( $grammar );
+
+ $parser->data($text, 1, "str", 2, \@arr);
+
+ # ^^^^^ ^ ^^^^^^^^^^^^^^^
+ # | | |
+ # TEXT TO BE PARSED | |
+ # STARTING LINE NUMBER |
+ # ELEMENTS OF @arg WHICH IS PASSED TO RULE data
+
+then within the productions of the rule C<data>, the array C<@arg> will contain
+C<("str", 2, \@arr)>.
+
+
+=head2 Alternations
+
+Alternations are implicit (unnamed) rules defined as part of a production. An
+alternation is defined as a series of '|'-separated productions inside a
+pair of round brackets. For example:
+
+ character: 'the' ( good | bad | ugly ) /dude/
+
+Every alternation implicitly defines a new subrule, whose
+automatically-generated name indicates its origin:
+"_alternation_<I>_of_production_<P>_of_rule<R>" for the appropriate
+values of <I>, <P>, and <R>. A call to this implicit subrule is then
+inserted in place of the brackets. Hence the above example is merely a
+convenient short-hand for:
+
+ character: 'the'
+ _alternation_1_of_production_1_of_rule_character
+ /dude/
+
+ _alternation_1_of_production_1_of_rule_character:
+ good | bad | ugly
+
+Since alternations are parsed by recursively calling the parser generator,
+any type(s) of item can appear in an alternation. For example:
+
+ character: 'the' ( 'high' "plains" # Silent, with poncho
+ | /no[- ]name/ # Silent, no poncho
+ | vengeance_seeking # Poncho-optional
+ | <error>
+ ) drifter
+
+In this case, if an error occurred, the automatically generated
+message would be:
+
+ ERROR (line <N>): Invalid implicit subrule: Expected
+ 'high' or /no[- ]name/ or generic,
+ but found "pacifist" instead
+
+Since every alternation actually has a name, it's even possible
+to extend or replace them:
+
+ parser->Replace(
+ "_alternation_1_of_production_1_of_rule_character:
+ 'generic Eastwood'"
+ );
+
+More importantly, since alternations are a form of subrule, they can be given
+repetition specifiers:
+
+ character: 'the' ( good | bad | ugly )(?) /dude/
+
+
+=head2 Incremental Parsing
+
+C<Parse::RecDescent> provides two methods - C<Extend> and C<Replace> - which
+can be used to alter the grammar matched by a parser. Both methods
+take the same argument as C<Parse::RecDescent::new>, namely a
+grammar specification string
+
+C<Parse::RecDescent::Extend> interprets the grammar specification and adds any
+productions it finds to the end of the rules for which they are specified. For
+example:
+
+ $add = "name: 'Jimmy-Bob' | 'Bobby-Jim'\ndesc: colour /necks?/";
+ parser->Extend($add);
+
+adds two productions to the rule "name" (creating it if necessary) and one
+production to the rule "desc".
+
+C<Parse::RecDescent::Replace> is identical, except that it first resets are
+rule specified in the additional grammar, removing any existing productions.
+Hence after:
+
+ $add = "name: 'Jimmy-Bob' | 'Bobby-Jim'\ndesc: colour /necks?/";
+ parser->Replace($add);
+
+are are I<only> valid "name"s and the one possible description.
+
+A more interesting use of the C<Extend> and C<Replace> methods is to call them
+inside the action of an executing parser. For example:
+
+ typedef: 'typedef' type_name identifier ';'
+ { $thisparser->Extend("type_name: '$item[3]'") }
+ | <error>
+
+ identifier: ...!type_name /[A-Za-z_]w*/
+
+which automatically prevents type names from being typedef'd, or:
+
+ command: 'map' key_name 'to' abort_key
+ { $thisparser->Replace("abort_key: '$item[2]'") }
+ | 'map' key_name 'to' key_name
+ { map_key($item[2],$item[4]) }
+ | abort_key
+ { exit if confirm("abort?") }
+
+ abort_key: 'q'
+
+ key_name: ...!abort_key /[A-Za-z]/
+
+which allows the user to change the abort key binding, but not to unbind it.
+
+The careful use of such constructs makes it possible to reconfigure a
+a running parser, eliminating the need for semantic feedback by
+providing syntactic feedback instead. However, as currently implemented,
+C<Replace()> and C<Extend()> have to regenerate and re-C<eval> the
+entire parser whenever they are called. This makes them quite slow for
+large grammars.
+
+In such cases, the judicious use of an interpolated regex is likely to
+be far more efficient:
+
+ typedef: 'typedef' type_name/ identifier ';'
+ { $thisparser->{local}{type_name} .= "|$item[3]" }
+ | <error>
+
+ identifier: ...!type_name /[A-Za-z_]w*/
+
+ type_name: /$thisparser->{local}{type_name}/
+
+
+=head2 Precompiling parsers
+
+Normally Parse::RecDescent builds a parser from a grammar at run-time.
+That approach simplifies the design and implementation of parsing code,
+but has the disadvantage that it slows the parsing process down - you
+have to wait for Parse::RecDescent to build the parser every time the
+program runs. Long or complex grammars can be particularly slow to
+build, leading to unacceptable delays at start-up.
+
+To overcome this, the module provides a way of "pre-building" a parser
+object and saving it in a separate module. That module can then be used
+to create clones of the original parser.
+
+A grammar may be precompiled using the C<Precompile> class method.
+For example, to precompile a grammar stored in the scalar $grammar,
+and produce a class named PreGrammar in a module file named PreGrammar.pm,
+you could use:
+
+ use Parse::RecDescent;
+
+ Parse::RecDescent->Precompile([$options_hashref], $grammar, "PreGrammar");
+
+The first required argument is the grammar string, the second is the
+name of the class to be built. The name of the module file is
+generated automatically by appending ".pm" to the last element of the
+class name. Thus
+
+ Parse::RecDescent->Precompile($grammar, "My::New::Parser");
+
+would produce a module file named Parser.pm.
+
+An optional hash reference may be supplied as the first argument to
+C<Precompile>. This argument is currently EXPERIMENTAL, and may change
+in a future release of Parse::RecDescent. The only supported option
+is currently C<-standalone>, see L</"Standalone Precompiled Parsers">.
+
+It is somewhat tedious to have to write a small Perl program just to
+generate a precompiled grammar class, so Parse::RecDescent has some special
+magic that allows you to do the job directly from the command-line.
+
+If your grammar is specified in a file named F<grammar>, you can generate
+a class named Yet::Another::Grammar like so:
+
+ > perl -MParse::RecDescent - grammar Yet::Another::Grammar
+
+This would produce a file named F<Grammar.pm> containing the full
+definition of a class called Yet::Another::Grammar. Of course, to use
+that class, you would need to put the F<Grammar.pm> file in a
+directory named F<Yet/Another>, somewhere in your Perl include path.
+
+Having created the new class, it's very easy to use it to build
+a parser. You simply C<use> the new module, and then call its
+C<new> method to create a parser object. For example:
+
+ use Yet::Another::Grammar;
+ my $parser = Yet::Another::Grammar->new();
+
+The effect of these two lines is exactly the same as:
+
+ use Parse::RecDescent;
+
+ open GRAMMAR_FILE, "grammar" or die;
+ local $/;
+ my $grammar = <GRAMMAR_FILE>;
+
+ my $parser = Parse::RecDescent->new($grammar);
+
+only considerably faster.
+
+Note however that the parsers produced by either approach are exactly
+the same, so whilst precompilation has an effect on I<set-up> speed,
+it has no effect on I<parsing> speed. RecDescent 2.0 will address that
+problem.
+
+=head3 Standalone Precompiled Parsers
+
+Until version 1.967003 of Parse::RecDescent, parser modules built with
+C<Precompile> were dependent on Parse::RecDescent. Future
+Parse::RecDescent releases with different internal implementations
+would break pre-existing precompiled parsers.
+
+Version 1.967_005 added the ability for Parse::RecDescent to include
+itself in the resulting .pm file if you pass the boolean option
+C<-standalone> to C<Precompile>:
+
+ Parse::RecDescent->Precompile({ -standalone = 1, },
+ $grammar, "My::New::Parser");
+
+Parse::RecDescent is included as Parse::RecDescent::_Runtime in order
+to avoid conflicts between an installed version of Parse::RecDescent
+and a precompiled, standalone parser made with another version of
+Parse::RecDescent. This renaming is experimental, and is subject to
+change in future versions.
+
+Precompiled parsers remain dependent on Parse::RecDescent by default,
+as this feature is still considered experimental. In the future,
+standalone parsers will become the default.
+
+=head1 GOTCHAS
+
+This section describes common mistakes that grammar writers seem to
+make on a regular basis.
+
+=head2 1. Expecting an error to always invalidate a parse
+
+A common mistake when using error messages is to write the grammar like this:
+
+ file: line(s)
+
+ line: line_type_1
+ | line_type_2
+ | line_type_3
+ | <error>
+
+The expectation seems to be that any line that is not of type 1, 2 or 3 will
+invoke the C<E<lt>errorE<gt>> directive and thereby cause the parse to fail.
+
+Unfortunately, that only happens if the error occurs in the very first line.
+The first rule states that a C<file> is matched by one or more lines, so if
+even a single line succeeds, the first rule is completely satisfied and the
+parse as a whole succeeds. That means that any error messages generated by
+subsequent failures in the C<line> rule are quietly ignored.
+
+Typically what's really needed is this:
+
+ file: line(s) eofile { $return = $item[1] }
+
+ line: line_type_1
+ | line_type_2
+ | line_type_3
+ | <error>
+
+ eofile: /^\Z/
+
+The addition of the C<eofile> subrule to the first production means that
+a file only matches a series of successful C<line> matches I<that consume the
+complete input text>. If any input text remains after the lines are matched,
+there must have been an error in the last C<line>. In that case the C<eofile>
+rule will fail, causing the entire C<file> rule to fail too.
+
+Note too that C<eofile> must match C</^\Z/> (end-of-text), I<not>
+C</^\cZ/> or C</^\cD/> (end-of-file).
+
+And don't forget the action at the end of the production. If you just
+write:
+
+ file: line(s) eofile
+
+then the value returned by the C<file> rule will be the value of its
+last item: C<eofile>. Since C<eofile> always returns an empty string
+on success, that will cause the C<file> rule to return that empty
+string. Apart from returning the wrong value, returning an empty string
+will trip up code such as:
+
+ $parser->file($filetext) || die;
+
+(since "" is false).
+
+Remember that Parse::RecDescent returns undef on failure,
+so the only safe test for failure is:
+
+ defined($parser->file($filetext)) || die;
+
+
+=head2 2. Using a C<return> in an action
+
+An action is like a C<do> block inside the subroutine implementing the
+surrounding rule. So if you put a C<return> statement in an action:
+
+ range: '(' start '..' end )'
+ { return $item{end} }
+ /\s+/
+
+that subroutine will immediately return, without checking the rest of
+the items in the current production (e.g. the C</\s+/>) and without
+setting up the necessary data structures to tell the parser that the
+rule has succeeded.
+
+The correct way to set a return value in an action is to set the C<$return>
+variable:
+
+ range: '(' start '..' end )'
+ { $return = $item{end} }
+ /\s+/
+
+
+=head2 2. Setting C<$Parse::RecDescent::skip> at parse time
+
+If you want to change the default skipping behaviour (see
+L<Terminal Separators> and the C<E<lt>skip:...E<gt>> directive) by setting
+C<$Parse::RecDescent::skip> you have to remember to set this variable
+I<before> creating the grammar object.
+
+For example, you might want to skip all Perl-like comments with this
+regular expression:
+
+ my $skip_spaces_and_comments = qr/
+ (?mxs:
+ \s+ # either spaces
+ | \# .*?$ # or a dash and whatever up to the end of line
+ )* # repeated at will (in whatever order)
+ /;
+
+And then:
+
+ my $parser1 = Parse::RecDescent->new($grammar);
+
+ $Parse::RecDescent::skip = $skip_spaces_and_comments;
+
+ my $parser2 = Parse::RecDescent->new($grammar);
+
+ $parser1->parse($text); # this does not cope with comments
+ $parser2->parse($text); # this skips comments correctly
+
+The two parsers behave differently, because any skipping behaviour
+specified via C<$Parse::RecDescent::skip> is hard-coded when the
+grammar object is built, not at parse time.
+
+
+=head1 DIAGNOSTICS
+
+Diagnostics are intended to be self-explanatory (particularly if you
+use B<-RD_HINT> (under B<perl -s>) or define C<$::RD_HINT> inside the program).
+
+C<Parse::RecDescent> currently diagnoses the following:
+
+=over 4
+
+=item *
+
+Invalid regular expressions used as pattern terminals (fatal error).
+
+=item *
+
+Invalid Perl code in code blocks (fatal error).
+
+=item *
+
+Lookahead used in the wrong place or in a nonsensical way (fatal error).
+
+=item *
+
+"Obvious" cases of left-recursion (fatal error).
+
+=item *
+
+Missing or extra components in a C<E<lt>leftopE<gt>> or C<E<lt>rightopE<gt>>
+directive.
+
+=item *
+
+Unrecognisable components in the grammar specification (fatal error).
+
+=item *
+
+"Orphaned" rule components specified before the first rule (fatal error)
+or after an C<E<lt>errorE<gt>> directive (level 3 warning).
+
+=item *
+
+Missing rule definitions (this only generates a level 3 warning, since you
+may be providing them later via C<Parse::RecDescent::Extend()>).
+
+=item *
+
+Instances where greedy repetition behaviour will almost certainly
+cause the failure of a production (a level 3 warning - see
+L<"ON-GOING ISSUES AND FUTURE DIRECTIONS"> below).
+
+=item *
+
+Attempts to define rules named 'Replace' or 'Extend', which cannot be
+called directly through the parser object because of the predefined
+meaning of C<Parse::RecDescent::Replace> and
+C<Parse::RecDescent::Extend>. (Only a level 2 warning is generated, since
+such rules I<can> still be used as subrules).
+
+=item *
+
+Productions which consist of a single C<E<lt>error?E<gt>>
+directive, and which therefore may succeed unexpectedly
+(a level 2 warning, since this might conceivably be the desired effect).
+
+=item *
+
+Multiple consecutive lookahead specifiers (a level 1 warning only, since their
+effects simply accumulate).
+
+=item *
+
+Productions which start with a C<E<lt>rejectE<gt>> or C<E<lt>rulevar:...E<gt>>
+directive. Such productions are optimized away (a level 1 warning).
+
+=item *
+
+Rules which are autogenerated under C<$::AUTOSTUB> (a level 1 warning).
+
+=back
+
+=head1 AUTHOR
+
+Damian Conway (damian@conway.org)
+Jeremy T. Braun (JTBRAUN@CPAN.org) [current maintainer]
+
+=head1 BUGS AND IRRITATIONS
+
+There are undoubtedly serious bugs lurking somewhere in this much code :-)
+Bug reports, test cases and other feedback are most welcome.
+
+Ongoing annoyances include:
+
+=over 4
+
+=item *
+
+There's no support for parsing directly from an input stream.
+If and when the Perl Gods give us regular expressions on streams,
+this should be trivial (ahem!) to implement.
+
+=item *
+
+The parser generator can get confused if actions aren't properly
+closed or if they contain particularly nasty Perl syntax errors
+(especially unmatched curly brackets).
+
+=item *
+
+The generator only detects the most obvious form of left recursion
+(potential recursion on the first subrule in a rule). More subtle
+forms of left recursion (for example, through the second item in a
+rule after a "zero" match of a preceding "zero-or-more" repetition,
+or after a match of a subrule with an empty production) are not found.
+
+=item *
+
+Instead of complaining about left-recursion, the generator should
+silently transform the grammar to remove it. Don't expect this
+feature any time soon as it would require a more sophisticated
+approach to parser generation than is currently used.
+
+=item *
+
+The generated parsers don't always run as fast as might be wished.
+
+=item *
+
+The meta-parser should be bootstrapped using C<Parse::RecDescent> :-)
+
+=back
+
+=head1 ON-GOING ISSUES AND FUTURE DIRECTIONS
+
+=over 4
+
+=item 1.
+
+Repetitions are "incorrigibly greedy" in that they will eat everything they can
+and won't backtrack if that behaviour causes a production to fail needlessly.
+So, for example:
+
+ rule: subrule(s) subrule
+
+will I<never> succeed, because the repetition will eat all the
+subrules it finds, leaving none to match the second item. Such
+constructions are relatively rare (and C<Parse::RecDescent::new> generates a
+warning whenever they occur) so this may not be a problem, especially
+since the insatiable behaviour can be overcome "manually" by writing:
+
+ rule: penultimate_subrule(s) subrule
+
+ penultimate_subrule: subrule ...subrule
+
+The issue is that this construction is exactly twice as expensive as the
+original, whereas backtracking would add only 1/I<N> to the cost (for
+matching I<N> repetitions of C<subrule>). I would welcome feedback on
+the need for backtracking; particularly on cases where the lack of it
+makes parsing performance problematical.
+
+=item 2.
+
+Having opened that can of worms, it's also necessary to consider whether there
+is a need for non-greedy repetition specifiers. Again, it's possible (at some
+cost) to manually provide the required functionality:
+
+ rule: nongreedy_subrule(s) othersubrule
+
+ nongreedy_subrule: subrule ...!othersubrule
+
+Overall, the issue is whether the benefit of this extra functionality
+outweighs the drawbacks of further complicating the (currently
+minimalist) grammar specification syntax, and (worse) introducing more overhead
+into the generated parsers.
+
+=item 3.
+
+An C<E<lt>autocommitE<gt>> directive would be nice. That is, it would be useful to be
+able to say:
+
+ command: <autocommit>
+ command: 'find' name
+ | 'find' address
+ | 'do' command 'at' time 'if' condition
+ | 'do' command 'at' time
+ | 'do' command
+ | unusual_command
+
+and have the generator work out that this should be "pruned" thus:
+
+ command: 'find' name
+ | 'find' <commit> address
+ | 'do' <commit> command <uncommit>
+ 'at' time
+ 'if' <commit> condition
+ | 'do' <commit> command <uncommit>
+ 'at' <commit> time
+ | 'do' <commit> command
+ | unusual_command
+
+There are several issues here. Firstly, should the
+C<E<lt>autocommitE<gt>> automatically install an C<E<lt>uncommitE<gt>>
+at the start of the last production (on the grounds that the "command"
+rule doesn't know whether an "unusual_command" might start with "find"
+or "do") or should the "unusual_command" subgraph be analysed (to see
+if it I<might> be viable after a "find" or "do")?
+
+The second issue is how regular expressions should be treated. The simplest
+approach would be simply to uncommit before them (on the grounds that they
+I<might> match). Better efficiency would be obtained by analyzing all preceding
+literal tokens to determine whether the pattern would match them.
+
+Overall, the issues are: can such automated "pruning" approach a hand-tuned
+version sufficiently closely to warrant the extra set-up expense, and (more
+importantly) is the problem important enough to even warrant the non-trivial
+effort of building an automated solution?
+
+=back
+
+=head1 SUPPORT
+
+=head2 Source Code Repository
+
+L<http://github.com/jtbraun/Parse-RecDescent>
+
+=head2 Mailing List
+
+Visit L<http://www.perlfoundation.org/perl5/index.cgi?parse_recdescent> to sign up for the mailing list.
+
+L<http://www.PerlMonks.org> is also a good place to ask
+questions. Previous posts about Parse::RecDescent can typically be
+found with this search:
+L<http://perlmonks.org/index.pl?node=recdescent>.
+
+=head2 FAQ
+
+Visit L<Parse::RecDescent::FAQ> for answers to frequently (and not so
+frequently) asked questions about Parse::RecDescent.
+
+=head2 View/Report Bugs
+
+To view the current bug list or report a new issue visit
+L<https://rt.cpan.org/Public/Dist/Display.html?Name=Parse-RecDescent>.
+
+=head1 SEE ALSO
+
+L<Regexp::Grammars> provides Parse::RecDescent style parsing using native
+Perl 5.10 regular expressions.
+
+
+=head1 LICENCE AND COPYRIGHT
+
+Copyright (c) 1997-2007, Damian Conway C<< <DCONWAY@CPAN.org> >>. All rights
+reserved.
+
+This module is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself. See L<perlartistic>.
+
+
+=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.
diff --git a/mcu/tools/perl/Spreadsheet/ParseExcel.pm b/mcu/tools/perl/Spreadsheet/ParseExcel.pm
new file mode 100644
index 0000000..57554aa
--- /dev/null
+++ b/mcu/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/mcu/tools/perl/Spreadsheet/ParseExcel/Cell.pm b/mcu/tools/perl/Spreadsheet/ParseExcel/Cell.pm
new file mode 100644
index 0000000..2527075
--- /dev/null
+++ b/mcu/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/mcu/tools/perl/Spreadsheet/ParseExcel/Dump.pm b/mcu/tools/perl/Spreadsheet/ParseExcel/Dump.pm
new file mode 100644
index 0000000..5586db2
--- /dev/null
+++ b/mcu/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/mcu/tools/perl/Spreadsheet/ParseExcel/FmtDefault.pm b/mcu/tools/perl/Spreadsheet/ParseExcel/FmtDefault.pm
new file mode 100644
index 0000000..416866f
--- /dev/null
+++ b/mcu/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/mcu/tools/perl/Spreadsheet/ParseExcel/FmtJapan.pm b/mcu/tools/perl/Spreadsheet/ParseExcel/FmtJapan.pm
new file mode 100644
index 0000000..71f2b16
--- /dev/null
+++ b/mcu/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/mcu/tools/perl/Spreadsheet/ParseExcel/FmtJapan2.pm b/mcu/tools/perl/Spreadsheet/ParseExcel/FmtJapan2.pm
new file mode 100644
index 0000000..318cb01
--- /dev/null
+++ b/mcu/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/mcu/tools/perl/Spreadsheet/ParseExcel/FmtUnicode.pm b/mcu/tools/perl/Spreadsheet/ParseExcel/FmtUnicode.pm
new file mode 100644
index 0000000..f0368bc
--- /dev/null
+++ b/mcu/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/mcu/tools/perl/Spreadsheet/ParseExcel/Font.pm b/mcu/tools/perl/Spreadsheet/ParseExcel/Font.pm
new file mode 100644
index 0000000..eb3b1fd
--- /dev/null
+++ b/mcu/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/mcu/tools/perl/Spreadsheet/ParseExcel/Format.pm b/mcu/tools/perl/Spreadsheet/ParseExcel/Format.pm
new file mode 100644
index 0000000..18b762f
--- /dev/null
+++ b/mcu/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/mcu/tools/perl/Spreadsheet/ParseExcel/SaveParser.pm b/mcu/tools/perl/Spreadsheet/ParseExcel/SaveParser.pm
new file mode 100644
index 0000000..3d2cf9c
--- /dev/null
+++ b/mcu/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/mcu/tools/perl/Spreadsheet/ParseExcel/SaveParser/Workbook.pm b/mcu/tools/perl/Spreadsheet/ParseExcel/SaveParser/Workbook.pm
new file mode 100644
index 0000000..7011563
--- /dev/null
+++ b/mcu/tools/perl/Spreadsheet/ParseExcel/SaveParser/Workbook.pm
@@ -0,0 +1,436 @@
+package Spreadsheet::ParseExcel::SaveParser::Workbook;
+
+###############################################################################
+#
+# Spreadsheet::ParseExcel::SaveParser::Workbook - A class for SaveParser 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;
+
+use base 'Spreadsheet::ParseExcel::Workbook';
+our $VERSION = '0.59';
+
+#==============================================================================
+# Spreadsheet::ParseExcel::SaveParser::Workbook
+#==============================================================================
+
+sub new {
+ my ( $sPkg, $oBook ) = @_;
+ return undef unless ( defined $oBook );
+ my %oThis = %$oBook;
+ bless \%oThis, $sPkg;
+
+ # re-bless worksheets (and set their _Book properties !!!)
+ my $sWkP = ref($sPkg) || "$sPkg";
+ $sWkP =~ s/Workbook$/Worksheet/;
+ map { bless( $_, $sWkP ); } @{ $oThis{Worksheet} };
+ map { $_->{_Book} = \%oThis; } @{ $oThis{Worksheet} };
+ return \%oThis;
+}
+
+#------------------------------------------------------------------------------
+# Parse (for Spreadsheet::ParseExcel::SaveParser::Workbook)
+#------------------------------------------------------------------------------
+sub Parse {
+ my ( $sClass, $sFile, $oWkFmt ) = @_;
+ my $oBook = Spreadsheet::ParseExcel::Workbook->Parse( $sFile, $oWkFmt );
+ bless $oBook, $sClass;
+
+ # re-bless worksheets (and set their _Book properties !!!)
+ my $sWkP = ref($sClass) || "$sClass";
+ $sWkP =~ s/Workbook$/Worksheet/;
+ map { bless( $_, $sWkP ); } @{ $oBook->{Worksheet} };
+ map { $_->{_Book} = $oBook; } @{ $oBook->{Worksheet} };
+ return $oBook;
+}
+
+#------------------------------------------------------------------------------
+# SaveAs (for Spreadsheet::ParseExcel::SaveParser::Workbook)
+#------------------------------------------------------------------------------
+sub SaveAs {
+ my ( $oBook, $sName ) = @_;
+
+ # Create a new Excel workbook
+ my $oWrEx = Spreadsheet::WriteExcel->new($sName);
+ $oWrEx->compatibility_mode();
+ my %hFmt;
+
+ my $iNo = 0;
+ my @aAlH = (
+ 'left', 'left', 'center', 'right',
+ 'fill', 'justify', 'merge', 'equal_space'
+ );
+ my @aAlV = ( 'top', 'vcenter', 'bottom', 'vjustify', 'vequal_space' );
+
+ foreach my $pFmt ( @{ $oBook->{Format} } ) {
+ my $oFmt = $oWrEx->addformat(); # Add Formats
+ unless ( $pFmt->{Style} ) {
+ $hFmt{$iNo} = $oFmt;
+ my $rFont = $pFmt->{Font};
+
+ $oFmt->set_font( $rFont->{Name} );
+ $oFmt->set_size( $rFont->{Height} );
+ $oFmt->set_color( $rFont->{Color} );
+ $oFmt->set_bold( $rFont->{Bold} );
+ $oFmt->set_italic( $rFont->{Italic} );
+ $oFmt->set_underline( $rFont->{Underline} );
+ $oFmt->set_font_strikeout( $rFont->{Strikeout} );
+ $oFmt->set_font_script( $rFont->{Super} );
+
+ $oFmt->set_hidden( $rFont->{Hidden} ); #Add
+
+ $oFmt->set_locked( $pFmt->{Lock} );
+
+ $oFmt->set_align( $aAlH[ $pFmt->{AlignH} ] );
+ $oFmt->set_align( $aAlV[ $pFmt->{AlignV} ] );
+
+ $oFmt->set_rotation( $pFmt->{Rotate} );
+
+ $oFmt->set_num_format(
+ $oBook->{FmtClass}->FmtStringDef( $pFmt->{FmtIdx}, $oBook ) );
+
+ $oFmt->set_text_wrap( $pFmt->{Wrap} );
+
+ $oFmt->set_pattern( $pFmt->{Fill}->[0] );
+ $oFmt->set_fg_color( $pFmt->{Fill}->[1] )
+ if ( ( $pFmt->{Fill}->[1] >= 8 )
+ && ( $pFmt->{Fill}->[1] <= 63 ) );
+ $oFmt->set_bg_color( $pFmt->{Fill}->[2] )
+ if ( ( $pFmt->{Fill}->[2] >= 8 )
+ && ( $pFmt->{Fill}->[2] <= 63 ) );
+
+ $oFmt->set_left(
+ ( $pFmt->{BdrStyle}->[0] > 7 ) ? 3 : $pFmt->{BdrStyle}->[0] );
+ $oFmt->set_right(
+ ( $pFmt->{BdrStyle}->[1] > 7 ) ? 3 : $pFmt->{BdrStyle}->[1] );
+ $oFmt->set_top(
+ ( $pFmt->{BdrStyle}->[2] > 7 ) ? 3 : $pFmt->{BdrStyle}->[2] );
+ $oFmt->set_bottom(
+ ( $pFmt->{BdrStyle}->[3] > 7 ) ? 3 : $pFmt->{BdrStyle}->[3] );
+
+ $oFmt->set_left_color( $pFmt->{BdrColor}->[0] )
+ if ( ( $pFmt->{BdrColor}->[0] >= 8 )
+ && ( $pFmt->{BdrColor}->[0] <= 63 ) );
+ $oFmt->set_right_color( $pFmt->{BdrColor}->[1] )
+ if ( ( $pFmt->{BdrColor}->[1] >= 8 )
+ && ( $pFmt->{BdrColor}->[1] <= 63 ) );
+ $oFmt->set_top_color( $pFmt->{BdrColor}->[2] )
+ if ( ( $pFmt->{BdrColor}->[2] >= 8 )
+ && ( $pFmt->{BdrColor}->[2] <= 63 ) );
+ $oFmt->set_bottom_color( $pFmt->{BdrColor}->[3] )
+ if ( ( $pFmt->{BdrColor}->[3] >= 8 )
+ && ( $pFmt->{BdrColor}->[3] <= 63 ) );
+ }
+ $iNo++;
+ }
+ for ( my $iSheet = 0 ; $iSheet < $oBook->{SheetCount} ; $iSheet++ ) {
+ my $oWkS = $oBook->{Worksheet}[$iSheet];
+ my $oWrS = $oWrEx->addworksheet( $oWkS->{Name} );
+
+ #Landscape
+ if ( !$oWkS->{Landscape} ) { # Landscape (0:Horizontal, 1:Vertical)
+ $oWrS->set_landscape();
+ }
+ else {
+ $oWrS->set_portrait();
+ }
+
+ #Protect
+ if ( defined $oWkS->{Protect} )
+ { # Protect ('':NoPassword, Password:Password)
+ if ( $oWkS->{Protect} ne '' ) {
+ $oWrS->protect( $oWkS->{Protect} );
+ }
+ else {
+ $oWrS->protect();
+ }
+ }
+ if ( ( $oWkS->{FitWidth} == 1 ) and ( $oWkS->{FitHeight} == 1 ) ) {
+
+ # Pages on fit with width and Heigt
+ $oWrS->fit_to_pages( $oWkS->{FitWidth}, $oWkS->{FitHeight} );
+
+ #Print Scale
+ $oWrS->set_print_scale( $oWkS->{Scale} );
+ }
+ else {
+
+ #Print Scale
+ $oWrS->set_print_scale( $oWkS->{Scale} );
+
+ # Pages on fit with width and Heigt
+ $oWrS->fit_to_pages( $oWkS->{FitWidth}, $oWkS->{FitHeight} );
+ }
+
+ # Paper Size
+ $oWrS->set_paper( $oWkS->{PaperSize} );
+
+ # Margin
+ $oWrS->set_margin_left( $oWkS->{LeftMargin} );
+ $oWrS->set_margin_right( $oWkS->{RightMargin} );
+ $oWrS->set_margin_top( $oWkS->{TopMargin} );
+ $oWrS->set_margin_bottom( $oWkS->{BottomMargin} );
+
+ # HCenter
+ $oWrS->center_horizontally() if ( $oWkS->{HCenter} );
+
+ # VCenter
+ $oWrS->center_vertically() if ( $oWkS->{VCenter} );
+
+ # Header, Footer
+ $oWrS->set_header( $oWkS->{Header}, $oWkS->{HeaderMargin} );
+ $oWrS->set_footer( $oWkS->{Footer}, $oWkS->{FooterMargin} );
+
+ # Print Area
+ if ( ref( $oBook->{PrintArea}[$iSheet] ) eq 'ARRAY' ) {
+ my $raP;
+ for $raP ( @{ $oBook->{PrintArea}[$iSheet] } ) {
+ $oWrS->print_area(@$raP);
+ }
+ }
+
+ # Print Title
+ my $raW;
+ foreach $raW ( @{ $oBook->{PrintTitle}[$iSheet]->{Row} } ) {
+ $oWrS->repeat_rows(@$raW);
+ }
+ foreach $raW ( @{ $oBook->{PrintTitle}[$iSheet]->{Column} } ) {
+ $oWrS->repeat_columns(@$raW);
+ }
+
+ # Print Gridlines
+ if ( $oWkS->{PrintGrid} == 1 ) {
+ $oWrS->hide_gridlines(0);
+ }
+ else {
+ $oWrS->hide_gridlines(1);
+ }
+
+ # Print Headings
+ if ( $oWkS->{PrintHeaders} ) {
+ $oWrS->print_row_col_headers();
+ }
+
+ # Horizontal Page Breaks
+ $oWrS->set_h_pagebreaks( @{ $oWkS->{HPageBreak} } );
+
+ # Veritical Page Breaks
+ $oWrS->set_v_pagebreaks( @{ $oWkS->{VPageBreak} } );
+
+
+
+# PageStart => $oWkS->{PageStart}, # Page number for start
+# UsePage => $oWkS->{UsePage}, # Use own start page number
+# NoColor => $oWkS->{NoColor}, # Print in blcak-white
+# Draft => $oWkS->{Draft}, # Print in draft mode
+# Notes => $oWkS->{Notes}, # Print notes
+# LeftToRight => $oWkS->{LeftToRight}, # Left to Right
+
+
+ for (
+ my $iC = $oWkS->{MinCol} ;
+ defined $oWkS->{MaxCol} && $iC <= $oWkS->{MaxCol} ;
+ $iC++
+ )
+ {
+ if ( defined $oWkS->{ColWidth}[$iC] ) {
+ if ( $oWkS->{ColWidth}[$iC] > 0 ) {
+ $oWrS->set_column( $iC, $iC, $oWkS->{ColWidth}[$iC] )
+ ; #, undef, 1) ;
+ }
+ else {
+ $oWrS->set_column( $iC, $iC, 0, undef, 1 );
+ }
+ }
+ }
+ for (
+ my $iR = $oWkS->{MinRow} ;
+ defined $oWkS->{MaxRow} && $iR <= $oWkS->{MaxRow} ;
+ $iR++
+ )
+ {
+ $oWrS->set_row( $iR, $oWkS->{RowHeight}[$iR] );
+ for (
+ my $iC = $oWkS->{MinCol} ;
+ defined $oWkS->{MaxCol} && $iC <= $oWkS->{MaxCol} ;
+ $iC++
+ )
+ {
+
+ my $oWkC = $oWkS->{Cells}[$iR][$iC];
+ if ($oWkC) {
+ if ( $oWkC->{Merged} ) {
+ my $oFmtN = $oWrEx->addformat();
+ $oFmtN->copy( $hFmt{ $oWkC->{FormatNo} } );
+ $oFmtN->set_merge(1);
+ $oWrS->write(
+ $iR,
+ $iC,
+ $oBook->{FmtClass}
+ ->TextFmt( $oWkC->{Val}, $oWkC->{Code} ),
+ $oFmtN
+ );
+ }
+ else {
+ $oWrS->write(
+ $iR,
+ $iC,
+ $oBook->{FmtClass}
+ ->TextFmt( $oWkC->{Val}, $oWkC->{Code} ),
+ $hFmt{ $oWkC->{FormatNo} }
+ );
+ }
+ }
+ }
+ }
+ }
+ return $oWrEx;
+}
+
+#------------------------------------------------------------------------------
+# AddWorksheet (for Spreadsheet::ParseExcel::SaveParser::Workbook)
+#------------------------------------------------------------------------------
+sub AddWorksheet {
+ my ( $oBook, $sName, %hAttr ) = @_;
+ $oBook->AddFormat if ( $#{ $oBook->{Format} } < 0 );
+ $hAttr{Name} ||= $sName;
+ $hAttr{LeftMargin} ||= 0;
+ $hAttr{RightMargin} ||= 0;
+ $hAttr{TopMargin} ||= 0;
+ $hAttr{BottomMargin} ||= 0;
+ $hAttr{HeaderMargin} ||= 0;
+ $hAttr{FooterMargin} ||= 0;
+ $hAttr{FitWidth} ||= 0;
+ $hAttr{FitHeight} ||= 0;
+ $hAttr{PrintGrid} ||= 0;
+ my $oWkS = Spreadsheet::ParseExcel::SaveParser::Worksheet->new(%hAttr);
+ $oWkS->{_Book} = $oBook;
+ $oWkS->{_SheetNo} = $oBook->{SheetCount};
+ $oBook->{Worksheet}[ $oBook->{SheetCount} ] = $oWkS;
+ $oBook->{SheetCount}++;
+ return $oWkS; #$oBook->{SheetCount} - 1;
+}
+
+#------------------------------------------------------------------------------
+# AddFont (for Spreadsheet::ParseExcel::SaveParser::Workbook)
+#------------------------------------------------------------------------------
+sub AddFont {
+ my ( $oBook, %hAttr ) = @_;
+ $hAttr{Name} ||= 'Arial';
+ $hAttr{Height} ||= 10;
+ $hAttr{Bold} ||= 0;
+ $hAttr{Italic} ||= 0;
+ $hAttr{Underline} ||= 0;
+ $hAttr{Strikeout} ||= 0;
+ $hAttr{Super} ||= 0;
+ push @{ $oBook->{Font} }, Spreadsheet::ParseExcel::Font->new(%hAttr);
+ return $#{ $oBook->{Font} };
+}
+
+#------------------------------------------------------------------------------
+# AddFormat (for Spreadsheet::ParseExcel::SaveParser::Workbook)
+#------------------------------------------------------------------------------
+sub AddFormat {
+ my ( $oBook, %hAttr ) = @_;
+ $hAttr{Fill} ||= [ 0, 0, 0 ];
+ $hAttr{BdrStyle} ||= [ 0, 0, 0, 0 ];
+ $hAttr{BdrColor} ||= [ 0, 0, 0, 0 ];
+ $hAttr{AlignH} ||= 0;
+ $hAttr{AlignV} ||= 0;
+ $hAttr{Rotate} ||= 0;
+ $hAttr{Landscape} ||= 0;
+ $hAttr{FmtIdx} ||= 0;
+
+ if ( !defined( $hAttr{Font} ) ) {
+ my $oFont;
+ if ( defined $hAttr{FontNo} ) {
+ $oFont = $oBook->{Font}[ $hAttr{FontNo} ];
+ }
+ elsif ( !defined $oFont ) {
+ if ( $#{ $oBook->{Font} } >= 0 ) {
+ $oFont = $oBook->{Font}[0];
+ }
+ else {
+ my $iNo = $oBook->AddFont;
+ $oFont = $oBook->{Font}[$iNo];
+ }
+ }
+ $hAttr{Font} = $oFont;
+ }
+ push @{ $oBook->{Format} }, Spreadsheet::ParseExcel::Format->new(%hAttr);
+ return $#{ $oBook->{Format} };
+}
+
+#------------------------------------------------------------------------------
+# AddCell (for Spreadsheet::ParseExcel::SaveParser::Workbook)
+#------------------------------------------------------------------------------
+sub AddCell {
+ my ( $oBook, $iSheet, $iR, $iC, $sVal, $oCell, $sCode ) = @_;
+ my %rhKey;
+ $oCell ||= 0;
+ my $iFmt =
+ ( UNIVERSAL::isa( $oCell, 'Spreadsheet::ParseExcel::Cell' ) )
+ ? $oCell->{FormatNo}
+ : ( ref($oCell) ) ? 0
+ : $oCell + 0;
+ $rhKey{FormatNo} = $iFmt;
+ $rhKey{Format} = $oBook->{Format}[$iFmt];
+ $rhKey{Val} = $sVal;
+ $rhKey{Code} = $sCode || '_native_';
+ $oBook->{_CurSheet} = $iSheet;
+ my $oNewCell =
+ Spreadsheet::ParseExcel::_NewCell( $oBook, $iR, $iC, %rhKey );
+ Spreadsheet::ParseExcel::_SetDimension( $oBook, $iR, $iC, $iC );
+ return $oNewCell;
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Spreadsheet::ParseExcel::SaveParser::Workbook - A class for SaveParser Workbooks.
+
+=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/mcu/tools/perl/Spreadsheet/ParseExcel/SaveParser/Worksheet.pm b/mcu/tools/perl/Spreadsheet/ParseExcel/SaveParser/Worksheet.pm
new file mode 100644
index 0000000..12e8fa4
--- /dev/null
+++ b/mcu/tools/perl/Spreadsheet/ParseExcel/SaveParser/Worksheet.pm
@@ -0,0 +1,91 @@
+package Spreadsheet::ParseExcel::SaveParser::Worksheet;
+
+###############################################################################
+#
+# Spreadsheet::ParseExcel::SaveParser::Worksheet - A class for SaveParser 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;
+
+#==============================================================================
+# Spreadsheet::ParseExcel::SaveParser::Worksheet
+#==============================================================================
+
+use base 'Spreadsheet::ParseExcel::Worksheet';
+our $VERSION = '0.59';
+
+sub new {
+ my ( $sClass, %rhIni ) = @_;
+ $sClass->SUPER::new(%rhIni); # returns object
+}
+
+#------------------------------------------------------------------------------
+# AddCell (for Spreadsheet::ParseExcel::SaveParser::Worksheet)
+#------------------------------------------------------------------------------
+sub AddCell {
+ my ( $oSelf, $iR, $iC, $sVal, $oCell, $sCode ) = @_;
+ $oSelf->{_Book}
+ ->AddCell( $oSelf->{_SheetNo}, $iR, $iC, $sVal, $oCell, $sCode );
+}
+
+#------------------------------------------------------------------------------
+# Protect (for Spreadsheet::ParseExcel::SaveParser::Worksheet)
+# - Password = undef -> No protect
+# - Password = '' -> Protected. No password
+# - Password = $pwd -> Protected. Password = $pwd
+#------------------------------------------------------------------------------
+sub Protect {
+ my ( $oSelf, $sPassword ) = @_;
+ $oSelf->{Protect} = $sPassword;
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Spreadsheet::ParseExcel::SaveParser::Worksheet - A class for SaveParser Worksheets.
+
+=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/mcu/tools/perl/Spreadsheet/ParseExcel/Utility.pm b/mcu/tools/perl/Spreadsheet/ParseExcel/Utility.pm
new file mode 100644
index 0000000..2eb09e7
--- /dev/null
+++ b/mcu/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/mcu/tools/perl/Spreadsheet/ParseExcel/Workbook.pm b/mcu/tools/perl/Spreadsheet/ParseExcel/Workbook.pm
new file mode 100644
index 0000000..d8a03c0
--- /dev/null
+++ b/mcu/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/mcu/tools/perl/Spreadsheet/ParseExcel/Worksheet.pm b/mcu/tools/perl/Spreadsheet/ParseExcel/Worksheet.pm
new file mode 100644
index 0000000..b9d32d7
--- /dev/null
+++ b/mcu/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
diff --git a/mcu/tools/perl/Spreadsheet/WriteExcel.pm b/mcu/tools/perl/Spreadsheet/WriteExcel.pm
new file mode 100644
index 0000000..2ffcdc1
--- /dev/null
+++ b/mcu/tools/perl/Spreadsheet/WriteExcel.pm
@@ -0,0 +1,5436 @@
+package Spreadsheet::WriteExcel;
+
+###############################################################################
+#
+# WriteExcel.
+#
+# Spreadsheet::WriteExcel - Write to a cross-platform Excel binary file.
+#
+# Copyright 2000-2010, John McNamara, jmcnamara@cpan.org
+#
+# Documentation after __END__
+#
+
+use Exporter;
+
+use strict;
+use Spreadsheet::WriteExcel::Workbook;
+
+
+
+use vars qw($VERSION @ISA);
+@ISA = qw(Spreadsheet::WriteExcel::Workbook Exporter);
+
+$VERSION = '2.37'; # The Life Pursuit
+
+
+
+###############################################################################
+#
+# new()
+#
+# Constructor. Wrapper for a Workbook object.
+# uses: Spreadsheet::WriteExcel::BIFFwriter
+# Spreadsheet::WriteExcel::Chart
+# Spreadsheet::WriteExcel::OLEwriter
+# Spreadsheet::WriteExcel::Workbook
+# Spreadsheet::WriteExcel::Worksheet
+# Spreadsheet::WriteExcel::Format
+# Spreadsheet::WriteExcel::Formula
+# Spreadsheet::WriteExcel::Properties
+#
+sub new {
+
+ my $class = shift;
+ my $self = Spreadsheet::WriteExcel::Workbook->new(@_);
+
+ # Check for file creation failures before re-blessing
+ bless $self, $class if defined $self;
+
+ return $self;
+}
+
+
+1;
+
+
+__END__
+
+
+
+=head1 NAME
+
+Spreadsheet::WriteExcel - Write to a cross-platform Excel binary file.
+
+=head1 VERSION
+
+This document refers to version 2.37 of Spreadsheet::WriteExcel, released February 2, 2010.
+
+
+
+
+=head1 SYNOPSIS
+
+To write a string, a formatted string, a number and a formula to the first worksheet in an Excel workbook called perl.xls:
+
+ use Spreadsheet::WriteExcel;
+
+ # Create a new Excel workbook
+ my $workbook = Spreadsheet::WriteExcel->new('perl.xls');
+
+ # Add a worksheet
+ $worksheet = $workbook->add_worksheet();
+
+ # Add and define a format
+ $format = $workbook->add_format(); # Add a format
+ $format->set_bold();
+ $format->set_color('red');
+ $format->set_align('center');
+
+ # Write a formatted and unformatted string, row and column notation.
+ $col = $row = 0;
+ $worksheet->write($row, $col, 'Hi Excel!', $format);
+ $worksheet->write(1, $col, 'Hi Excel!');
+
+ # Write a number and a formula using A1 notation
+ $worksheet->write('A3', 1.2345);
+ $worksheet->write('A4', '=SIN(PI()/4)');
+
+
+
+
+=head1 DESCRIPTION
+
+The Spreadsheet::WriteExcel Perl module can be used to create a cross-platform Excel binary file. Multiple worksheets can be added to a workbook and formatting can be applied to cells. Text, numbers, formulas, hyperlinks, images and charts can be written to the cells.
+
+The file produced by this module is compatible with Excel 97, 2000, 2002, 2003 and 2007.
+
+The module will work on the majority of Windows, UNIX and Mac platforms. Generated files are also compatible with the Linux/UNIX spreadsheet applications Gnumeric and OpenOffice.org.
+
+This module cannot be used to write to an existing Excel file (See L<MODIFYING AND REWRITING EXCEL FILES>).
+
+
+
+
+=head1 QUICK START
+
+Spreadsheet::WriteExcel tries to provide an interface to as many of Excel's features as possible. As a result there is a lot of documentation to accompany the interface and it can be difficult at first glance to see what it important and what is not. So for those of you who prefer to assemble Ikea furniture first and then read the instructions, here are three easy steps:
+
+1. Create a new Excel I<workbook> (i.e. file) using C<new()>.
+
+2. Add a I<worksheet> to the new workbook using C<add_worksheet()>.
+
+3. Write to the worksheet using C<write()>.
+
+Like this:
+
+ use Spreadsheet::WriteExcel; # Step 0
+
+ my $workbook = Spreadsheet::WriteExcel->new('perl.xls'); # Step 1
+ $worksheet = $workbook->add_worksheet(); # Step 2
+ $worksheet->write('A1', 'Hi Excel!'); # Step 3
+
+This will create an Excel file called C<perl.xls> with a single worksheet and the text C<'Hi Excel!'> in the relevant cell. And that's it. Okay, so there is actually a zeroth step as well, but C<use module> goes without saying. There are also more than 80 examples that come with the distribution and which you can use to get you started. See L<EXAMPLES>.
+
+Those of you who read the instructions first and assemble the furniture afterwards will know how to proceed. ;-)
+
+
+
+
+=head1 WORKBOOK METHODS
+
+The Spreadsheet::WriteExcel module provides an object oriented interface to a new Excel workbook. The following methods are available through a new workbook.
+
+ new()
+ add_worksheet()
+ add_format()
+ add_chart()
+ add_chart_ext()
+ close()
+ compatibility_mode()
+ set_properties()
+ define_name()
+ set_tempdir()
+ set_custom_color()
+ sheets()
+ set_1904()
+ set_codepage()
+
+If you are unfamiliar with object oriented interfaces or the way that they are implemented in Perl have a look at C<perlobj> and C<perltoot> in the main Perl documentation.
+
+
+
+
+=head2 new()
+
+A new Excel workbook is created using the C<new()> constructor which accepts either a filename or a filehandle as a parameter. The following example creates a new Excel file based on a filename:
+
+ my $workbook = Spreadsheet::WriteExcel->new('filename.xls');
+ my $worksheet = $workbook->add_worksheet();
+ $worksheet->write(0, 0, 'Hi Excel!');
+
+Here are some other examples of using C<new()> with filenames:
+
+ my $workbook1 = Spreadsheet::WriteExcel->new($filename);
+ my $workbook2 = Spreadsheet::WriteExcel->new('/tmp/filename.xls');
+ my $workbook3 = Spreadsheet::WriteExcel->new("c:\\tmp\\filename.xls");
+ my $workbook4 = Spreadsheet::WriteExcel->new('c:\tmp\filename.xls');
+
+The last two examples demonstrates how to create a file on DOS or Windows where it is necessary to either escape the directory separator C<\> or to use single quotes to ensure that it isn't interpolated. For more information see C<perlfaq5: Why can't I use "C:\temp\foo" in DOS paths?>.
+
+The C<new()> constructor returns a Spreadsheet::WriteExcel object that you can use to add worksheets and store data. It should be noted that although C<my> is not specifically required it defines the scope of the new workbook variable and, in the majority of cases, ensures that the workbook is closed properly without explicitly calling the C<close()> method.
+
+If the file cannot be created, due to file permissions or some other reason, C<new> will return C<undef>. Therefore, it is good practice to check the return value of C<new> before proceeding. As usual the Perl variable C<$!> will be set if there is a file creation error. You will also see one of the warning messages detailed in L<DIAGNOSTICS>:
+
+ my $workbook = Spreadsheet::WriteExcel->new('protected.xls');
+ die "Problems creating new Excel file: $!" unless defined $workbook;
+
+You can also pass a valid filehandle to the C<new()> constructor. For example in a CGI program you could do something like this:
+
+ binmode(STDOUT);
+ my $workbook = Spreadsheet::WriteExcel->new(\*STDOUT);
+
+The requirement for C<binmode()> is explained below.
+
+For CGI programs you can also use the special Perl filename C<'-'> which will redirect the output to STDOUT:
+
+ my $workbook = Spreadsheet::WriteExcel->new('-');
+
+See also, the C<cgi.pl> program in the C<examples> directory of the distro.
+
+However, this special case will not work in C<mod_perl> programs where you will have to do something like the following:
+
+ # mod_perl 1
+ ...
+ tie *XLS, 'Apache';
+ binmode(XLS);
+ my $workbook = Spreadsheet::WriteExcel->new(\*XLS);
+ ...
+
+ # mod_perl 2
+ ...
+ tie *XLS => $r; # Tie to the Apache::RequestRec object
+ binmode(*XLS);
+ my $workbook = Spreadsheet::WriteExcel->new(\*XLS);
+ ...
+
+See also, the C<mod_perl1.pl> and C<mod_perl2.pl> programs in the C<examples> directory of the distro.
+
+Filehandles can also be useful if you want to stream an Excel file over a socket or if you want to store an Excel file in a scalar.
+
+For example here is a way to write an Excel file to a scalar with C<perl 5.8>:
+
+ #!/usr/bin/perl -w
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ # Requires perl 5.8 or later
+ open my $fh, '>', \my $str or die "Failed to open filehandle: $!";
+
+ my $workbook = Spreadsheet::WriteExcel->new($fh);
+ my $worksheet = $workbook->add_worksheet();
+
+ $worksheet->write(0, 0, 'Hi Excel!');
+
+ $workbook->close();
+
+ # The Excel file in now in $str. Remember to binmode() the output
+ # filehandle before printing it.
+ binmode STDOUT;
+ print $str;
+
+See also the C<write_to_scalar.pl> and C<filehandle.pl> programs in the C<examples> directory of the distro.
+
+B<Note about the requirement for> C<binmode()>. An Excel file is comprised of binary data. Therefore, if you are using a filehandle you should ensure that you C<binmode()> it prior to passing it to C<new()>.You should do this regardless of whether you are on a Windows platform or not. This applies especially to users of perl 5.8 on systems where C<UTF-8> is likely to be in operation such as RedHat Linux 9. If your program, either intentionally or not, writes C<UTF-8> data to a filehandle that is passed to C<new()> it will corrupt the Excel file that is created.
+
+You don't have to worry about C<binmode()> if you are using filenames instead of filehandles. Spreadsheet::WriteExcel performs the C<binmode()> internally when it converts the filename to a filehandle. For more information about C<binmode()> see C<perlfunc> and C<perlopentut> in the main Perl documentation.
+
+
+
+
+
+=head2 add_worksheet($sheetname, $utf_16_be)
+
+At least one worksheet should be added to a new workbook. A worksheet is used to write data into cells:
+
+ $worksheet1 = $workbook->add_worksheet(); # Sheet1
+ $worksheet2 = $workbook->add_worksheet('Foglio2'); # Foglio2
+ $worksheet3 = $workbook->add_worksheet('Data'); # Data
+ $worksheet4 = $workbook->add_worksheet(); # Sheet4
+
+If C<$sheetname> is not specified the default Excel convention will be followed, i.e. Sheet1, Sheet2, etc. The C<$utf_16_be> parameter is optional, see below.
+
+The worksheet name must be a valid Excel worksheet name, i.e. it cannot contain any of the following characters, C<[ ] : * ? / \> and it must be less than 32 characters. In addition, you cannot use the same, case insensitive, C<$sheetname> for more than one worksheet.
+
+On systems with C<perl 5.8> and later the C<add_worksheet()> method will also handle strings in C<UTF-8> format.
+
+ $worksheet = $workbook->add_worksheet("\x{263a}"); # Smiley
+
+On earlier Perl systems your can specify C<UTF-16BE> worksheet names using an additional optional parameter:
+
+ my $name = pack 'n', 0x263a;
+ $worksheet = $workbook->add_worksheet($name, 1); # Smiley
+
+
+
+
+=head2 add_format(%properties)
+
+The C<add_format()> method can be used to create new Format objects which are used to apply formatting to a cell. You can either define the properties at creation time via a hash of property values or later via method calls.
+
+ $format1 = $workbook->add_format(%props); # Set properties at creation
+ $format2 = $workbook->add_format(); # Set properties later
+
+See the L<CELL FORMATTING> section for more details about Format properties and how to set them.
+
+
+
+
+=head2 add_chart(%properties)
+
+This method is use to create a new chart either as a standalone worksheet (the default) or as an embeddable object that can be inserted into a worksheet via the C<insert_chart()> Worksheet method.
+
+ my $chart = $workbook->add_chart( type => 'column' );
+
+The properties that can be set are:
+
+ type (required)
+ name (optional)
+ embedded (optional)
+
+=over
+
+=item * C<type>
+
+This is a required parameter. It defines the type of chart that will be created.
+
+ my $chart = $workbook->add_chart( type => 'line' );
+
+The available types are:
+
+ area
+ bar
+ column
+ line
+ pie
+ scatter
+ stock
+
+=item * C<name>
+
+Set the name for the chart sheet. The name property is optional and if it isn't supplied will default to C<Chart1 .. n>. The name must be a valid Excel worksheet name. See C<add_worksheet()> for more details on valid sheet names. The C<name> property can be omitted for embedded charts.
+
+ my $chart = $workbook->add_chart( type => 'line', name => 'Results Chart' );
+
+=item * C<embedded>
+
+Specifies that the Chart object will be inserted in a worksheet via the C<insert_chart()> Worksheet method. It is an error to try insert a Chart that doesn't have this flag set.
+
+ my $chart = $workbook->add_chart( type => 'line', embedded => 1 );
+
+ # Configure the chart.
+ ...
+
+ # Insert the chart into the a worksheet.
+ $worksheet->insert_chart( 'E2', $chart );
+
+=back
+
+See L<Spreadsheet::WriteExcel::Chart> for details on how to configure the chart object once it is created. See also the C<chart_*.pl> programs in the examples directory of the distro.
+
+
+
+
+=head2 add_chart_ext($chart_data, $chartname)
+
+This method is use to include externally generated charts in a Spreadsheet::WriteExcel file.
+
+ my $chart = $workbook->add_chart_ext('chart01.bin', 'Chart1');
+
+This feature is semi-deprecated in favour of the "native" charts created using C<add_chart()>. Read C<external_charts.txt> (or C<.pod>) in the external_charts directory of the distro for a full explanation.
+
+
+
+
+=head2 close()
+
+In general your Excel file will be closed automatically when your program ends or when the Workbook object goes out of scope, however the C<close()> method can be used to explicitly close an Excel file.
+
+ $workbook->close();
+
+An explicit C<close()> is required if the file must be closed prior to performing some external action on it such as copying it, reading its size or attaching it to an email.
+
+In addition, C<close()> may be required to prevent perl's garbage collector from disposing of the Workbook, Worksheet and Format objects in the wrong order. Situations where this can occur are:
+
+=over 4
+
+=item *
+
+If C<my()> was not used to declare the scope of a workbook variable created using C<new()>.
+
+=item *
+
+If the C<new()>, C<add_worksheet()> or C<add_format()> methods are called in subroutines.
+
+=back
+
+The reason for this is that Spreadsheet::WriteExcel relies on Perl's C<DESTROY> mechanism to trigger destructor methods in a specific sequence. This may not happen in cases where the Workbook, Worksheet and Format variables are not lexically scoped or where they have different lexical scopes.
+
+In general, if you create a file with a size of 0 bytes or you fail to create a file you need to call C<close()>.
+
+The return value of C<close()> is the same as that returned by perl when it closes the file created by C<new()>. This allows you to handle error conditions in the usual way:
+
+ $workbook->close() or die "Error closing file: $!";
+
+
+
+
+=head2 compatibility_mode()
+
+This method is used to improve compatibility with third party applications that read Excel files.
+
+ $workbook->compatibility_mode();
+
+An Excel file is comprised of binary records that describe properties of a spreadsheet. Excel is reasonably liberal about this and, outside of a core subset, it doesn't require every possible record to be present when it reads a file. This is also true of Gnumeric and OpenOffice.Org Calc.
+
+Spreadsheet::WriteExcel takes advantage of this fact to omit some records in order to minimise the amount of data stored in memory and to simplify and speed up the writing of files. However, some third party applications that read Excel files often expect certain records to be present. In "compatibility mode" Spreadsheet::WriteExcel writes these records and tries to be as close to an Excel generated file as possible.
+
+Applications that require C<compatibility_mode()> are Apache POI, Apple Numbers, and Quickoffice on Nokia, Palm and other devices. You should also use C<compatibility_mode()> if your Excel file will be used as an external data source by another Excel file.
+
+If you encounter other situations that require C<compatibility_mode()>, please let me know.
+
+It should be noted that C<compatibility_mode()> requires additional data to be stored in memory and additional processing. This incurs a memory and speed penalty and may not be suitable for very large files (>20MB).
+
+You must call C<compatibility_mode()> before calling C<add_worksheet()>.
+
+
+
+
+=head2 set_properties()
+
+The C<set_properties> method can be used to set the document properties of the Excel file created by C<Spreadsheet::WriteExcel>. These properties are visible when you use the C<< File->Properties >> menu option in Excel and are also available to external applications that read or index windows files.
+
+The properties should be passed as a hash of values as follows:
+
+ $workbook->set_properties(
+ title => 'This is an example spreadsheet',
+ author => 'John McNamara',
+ comments => 'Created with Perl and Spreadsheet::WriteExcel',
+ );
+
+The properties that can be set are:
+
+ title
+ subject
+ author
+ manager
+ company
+ category
+ keywords
+ comments
+
+User defined properties are not supported due to effort required.
+
+In perl 5.8+ you can also pass UTF-8 strings as properties. See L<UNICODE IN EXCEL>.
+
+ my $smiley = chr 0x263A;
+
+ $workbook->set_properties(
+ subject => "Happy now? $smiley",
+ );
+
+With older versions of perl you can use a module to convert a non-ASCII string to a binary representation of UTF-8 and then pass an additional C<utf8> flag to C<set_properties()>:
+
+ my $smiley = pack 'H*', 'E298BA';
+
+ $workbook->set_properties(
+ subject => "Happy now? $smiley",
+ utf8 => 1,
+ );
+
+Usually Spreadsheet::WriteExcel allows you to use UTF-16 with pre 5.8 versions of perl. However, document properties don't support UTF-16 for these type of strings.
+
+In order to promote the usefulness of Perl and the Spreadsheet::WriteExcel module consider adding a comment such as the following when using document properties:
+
+ $workbook->set_properties(
+ ...,
+ comments => 'Created with Perl and Spreadsheet::WriteExcel',
+ ...,
+ );
+
+This feature requires that the C<OLE::Storage_Lite> module is installed (which is usually the case for a standard Spreadsheet::WriteExcel installation). However, this also means that the resulting OLE document may B<possibly> be buggy for files less than 7MB since it hasn't been as rigorously tested in that domain. As a result of this C<set_properties> is currently incompatible with Gnumeric for files less than 7MB. This is being investigated. If you encounter any problems with this features let me know.
+
+For convenience it is possible to pass either a hash or hash ref of arguments to this method.
+
+See also the C<properties.pl> program in the examples directory of the distro.
+
+
+
+
+=head2 define_name()
+
+This method is used to defined a name that can be used to represent a value, a single cell or a range of cells in a workbook.
+
+ $workbook->define_name('Exchange_rate', '=0.96');
+ $workbook->define_name('Sales', '=Sheet1!$G$1:$H$10');
+ $workbook->define_name('Sheet2!Sales', '=Sheet2!$G$1:$G$10');
+
+See the defined_name.pl program in the examples dir of the distro.
+
+Note: This currently a beta feature. More documentation and examples will be added.
+
+
+
+
+=head2 set_tempdir()
+
+For speed and efficiency C<Spreadsheet::WriteExcel> stores worksheet data in temporary files prior to assembling the final workbook.
+
+If Spreadsheet::WriteExcel is unable to create these temporary files it will store the required data in memory. This can be slow for large files.
+
+The problem occurs mainly with IIS on Windows although it could feasibly occur on Unix systems as well. The problem generally occurs because the default temp file directory is defined as C<C:/> or some other directory that IIS doesn't provide write access to.
+
+To check if this might be a problem on a particular system you can run a simple test program with C<-w> or C<use warnings>. This will generate a warning if the module cannot create the required temporary files:
+
+ #!/usr/bin/perl -w
+
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new('test.xls');
+ my $worksheet = $workbook->add_worksheet();
+
+To avoid this problem the C<set_tempdir()> method can be used to specify a directory that is accessible for the creation of temporary files.
+
+The C<File::Temp> module is used to create the temporary files. File::Temp uses C<File::Spec> to determine an appropriate location for these files such as C</tmp> or C<c:\windows\temp>. You can find out which directory is used on your system as follows:
+
+ perl -MFile::Spec -le "print File::Spec->tmpdir"
+
+Even if the default temporary file directory is accessible you may wish to specify an alternative location for security or maintenance reasons:
+
+ $workbook->set_tempdir('/tmp/writeexcel');
+ $workbook->set_tempdir('c:\windows\temp\writeexcel');
+
+The directory for the temporary file must exist, C<set_tempdir()> will not create a new directory.
+
+One disadvantage of using the C<set_tempdir()> method is that on some Windows systems it will limit you to approximately 800 concurrent tempfiles. This means that a single program running on one of these systems will be limited to creating a total of 800 workbook and worksheet objects. You can run multiple, non-concurrent programs to work around this if necessary.
+
+
+
+
+=head2 set_custom_color($index, $red, $green, $blue)
+
+The C<set_custom_color()> method can be used to override one of the built-in palette values with a more suitable colour.
+
+The value for C<$index> should be in the range 8..63, see L<COLOURS IN EXCEL>.
+
+The default named colours use the following indices:
+
+ 8 => black
+ 9 => white
+ 10 => red
+ 11 => lime
+ 12 => blue
+ 13 => yellow
+ 14 => magenta
+ 15 => cyan
+ 16 => brown
+ 17 => green
+ 18 => navy
+ 20 => purple
+ 22 => silver
+ 23 => gray
+ 33 => pink
+ 53 => orange
+
+A new colour is set using its RGB (red green blue) components. The C<$red>, C<$green> and C<$blue> values must be in the range 0..255. You can determine the required values in Excel using the C<Tools-E<gt>Options-E<gt>Colors-E<gt>Modify> dialog.
+
+The C<set_custom_color()> workbook method can also be used with a HTML style C<#rrggbb> hex value:
+
+ $workbook->set_custom_color(40, 255, 102, 0 ); # Orange
+ $workbook->set_custom_color(40, 0xFF, 0x66, 0x00); # Same thing
+ $workbook->set_custom_color(40, '#FF6600' ); # Same thing
+
+ my $font = $workbook->add_format(color => 40); # Use the modified colour
+
+The return value from C<set_custom_color()> is the index of the colour that was changed:
+
+ my $ferrari = $workbook->set_custom_color(40, 216, 12, 12);
+
+ my $format = $workbook->add_format(
+ bg_color => $ferrari,
+ pattern => 1,
+ border => 1
+ );
+
+
+
+
+=head2 sheets(0, 1, ...)
+
+The C<sheets()> method returns a list, or a sliced list, of the worksheets in a workbook.
+
+If no arguments are passed the method returns a list of all the worksheets in the workbook. This is useful if you want to repeat an operation on each worksheet:
+
+ foreach $worksheet ($workbook->sheets()) {
+ print $worksheet->get_name();
+ }
+
+
+You can also specify a slice list to return one or more worksheet objects:
+
+ $worksheet = $workbook->sheets(0);
+ $worksheet->write('A1', 'Hello');
+
+
+Or since return value from C<sheets()> is a reference to a worksheet object you can write the above example as:
+
+ $workbook->sheets(0)->write('A1', 'Hello');
+
+
+The following example returns the first and last worksheet in a workbook:
+
+ foreach $worksheet ($workbook->sheets(0, -1)) {
+ # Do something
+ }
+
+
+Array slices are explained in the perldata manpage.
+
+
+
+
+=head2 set_1904()
+
+Excel stores dates as real numbers where the integer part stores the number of days since the epoch and the fractional part stores the percentage of the day. The epoch can be either 1900 or 1904. Excel for Windows uses 1900 and Excel for Macintosh uses 1904. However, Excel on either platform will convert automatically between one system and the other.
+
+Spreadsheet::WriteExcel stores dates in the 1900 format by default. If you wish to change this you can call the C<set_1904()> workbook method. You can query the current value by calling the C<get_1904()> workbook method. This returns 0 for 1900 and 1 for 1904.
+
+See also L<DATES AND TIME IN EXCEL> for more information about working with Excel's date system.
+
+In general you probably won't need to use C<set_1904()>.
+
+
+
+
+=head2 set_codepage($codepage)
+
+The default code page or character set used by Spreadsheet::WriteExcel is ANSI. This is also the default used by Excel for Windows. Occasionally however it may be necessary to change the code page via the C<set_codepage()> method.
+
+Changing the code page may be required if your are using Spreadsheet::WriteExcel on the Macintosh and you are using characters outside the ASCII 128 character set:
+
+ $workbook->set_codepage(1); # ANSI, MS Windows
+ $workbook->set_codepage(2); # Apple Macintosh
+
+The C<set_codepage()> method is rarely required.
+
+
+
+
+=head1 WORKSHEET METHODS
+
+A new worksheet is created by calling the C<add_worksheet()> method from a workbook object:
+
+ $worksheet1 = $workbook->add_worksheet();
+ $worksheet2 = $workbook->add_worksheet();
+
+The following methods are available through a new worksheet:
+
+ write()
+ write_number()
+ write_string()
+ write_utf16be_string()
+ write_utf16le_string()
+ keep_leading_zeros()
+ write_blank()
+ write_row()
+ write_col()
+ write_date_time()
+ write_url()
+ write_url_range()
+ write_formula()
+ store_formula()
+ repeat_formula()
+ write_comment()
+ show_comments()
+ add_write_handler()
+ insert_image()
+ insert_chart()
+ data_validation()
+ get_name()
+ activate()
+ select()
+ hide()
+ set_first_sheet()
+ protect()
+ set_selection()
+ set_row()
+ set_column()
+ outline_settings()
+ freeze_panes()
+ split_panes()
+ merge_range()
+ set_zoom()
+ right_to_left()
+ hide_zero()
+ set_tab_color()
+ autofilter()
+
+
+
+
+=head2 Cell notation
+
+Spreadsheet::WriteExcel supports two forms of notation to designate the position of cells: Row-column notation and A1 notation.
+
+Row-column notation uses a zero based index for both row and column while A1 notation uses the standard Excel alphanumeric sequence of column letter and 1-based row. For example:
+
+ (0, 0) # The top left cell in row-column notation.
+ ('A1') # The top left cell in A1 notation.
+
+ (1999, 29) # Row-column notation.
+ ('AD2000') # The same cell in A1 notation.
+
+Row-column notation is useful if you are referring to cells programmatically:
+
+ for my $i (0 .. 9) {
+ $worksheet->write($i, 0, 'Hello'); # Cells A1 to A10
+ }
+
+A1 notation is useful for setting up a worksheet manually and for working with formulas:
+
+ $worksheet->write('H1', 200);
+ $worksheet->write('H2', '=H1+1');
+
+In formulas and applicable methods you can also use the C<A:A> column notation:
+
+ $worksheet->write('A1', '=SUM(B:B)');
+
+The C<Spreadsheet::WriteExcel::Utility> module that is included in the distro contains helper functions for dealing with A1 notation, for example:
+
+ use Spreadsheet::WriteExcel::Utility;
+
+ ($row, $col) = xl_cell_to_rowcol('C2'); # (1, 2)
+ $str = xl_rowcol_to_cell(1, 2); # C2
+
+For simplicity, the parameter lists for the worksheet method calls in the following sections are given in terms of row-column notation. In all cases it is also possible to use A1 notation.
+
+Note: in Excel it is also possible to use a R1C1 notation. This is not supported by Spreadsheet::WriteExcel.
+
+
+
+
+=head2 write($row, $column, $token, $format)
+
+Excel makes a distinction between data types such as strings, numbers, blanks, formulas and hyperlinks. To simplify the process of writing data the C<write()> method acts as a general alias for several more specific methods:
+
+ write_string()
+ write_number()
+ write_blank()
+ write_formula()
+ write_url()
+ write_row()
+ write_col()
+
+The general rule is that if the data looks like a I<something> then a I<something> is written. Here are some examples in both row-column and A1 notation:
+
+ # Same as:
+ $worksheet->write(0, 0, 'Hello' ); # write_string()
+ $worksheet->write(1, 0, 'One' ); # write_string()
+ $worksheet->write(2, 0, 2 ); # write_number()
+ $worksheet->write(3, 0, 3.00001 ); # write_number()
+ $worksheet->write(4, 0, "" ); # write_blank()
+ $worksheet->write(5, 0, '' ); # write_blank()
+ $worksheet->write(6, 0, undef ); # write_blank()
+ $worksheet->write(7, 0 ); # write_blank()
+ $worksheet->write(8, 0, 'http://www.perl.com/'); # write_url()
+ $worksheet->write('A9', 'ftp://ftp.cpan.org/' ); # write_url()
+ $worksheet->write('A10', 'internal:Sheet1!A1' ); # write_url()
+ $worksheet->write('A11', 'external:c:\foo.xls' ); # write_url()
+ $worksheet->write('A12', '=A3 + 3*A4' ); # write_formula()
+ $worksheet->write('A13', '=SIN(PI()/4)' ); # write_formula()
+ $worksheet->write('A14', \@array ); # write_row()
+ $worksheet->write('A15', [\@array] ); # write_col()
+
+ # And if the keep_leading_zeros property is set:
+ $worksheet->write('A16, 2 ); # write_number()
+ $worksheet->write('A17, 02 ); # write_string()
+ $worksheet->write('A18, 00002 ); # write_string()
+
+
+The "looks like" rule is defined by regular expressions:
+
+C<write_number()> if C<$token> is a number based on the following regex: C<$token =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/>.
+
+C<write_string()> if C<keep_leading_zeros()> is set and C<$token> is an integer with leading zeros based on the following regex: C<$token =~ /^0\d+$/>.
+
+C<write_blank()> if C<$token> is undef or a blank string: C<undef>, C<""> or C<''>.
+
+C<write_url()> if C<$token> is a http, https, ftp or mailto URL based on the following regexes: C<$token =~ m|^[fh]tt?ps?://|> or C<$token =~ m|^mailto:|>.
+
+C<write_url()> if C<$token> is an internal or external sheet reference based on the following regex: C<$token =~ m[^(in|ex)ternal:]>.
+
+C<write_formula()> if the first character of C<$token> is C<"=">.
+
+C<write_row()> if C<$token> is an array ref.
+
+C<write_col()> if C<$token> is an array ref of array refs.
+
+C<write_string()> if none of the previous conditions apply.
+
+The C<$format> parameter is optional. It should be a valid Format object, see L<CELL FORMATTING>:
+
+ my $format = $workbook->add_format();
+ $format->set_bold();
+ $format->set_color('red');
+ $format->set_align('center');
+
+ $worksheet->write(4, 0, 'Hello', $format); # Formatted string
+
+The write() method will ignore empty strings or C<undef> tokens unless a format is also supplied. As such you needn't worry about special handling for empty or C<undef> values in your data. See also the C<write_blank()> method.
+
+One problem with the C<write()> method is that occasionally data looks like a number but you don't want it treated as a number. For example, zip codes or ID numbers often start with a leading zero. If you write this data as a number then the leading zero(s) will be stripped. You can change this default behaviour by using the C<keep_leading_zeros()> method. While this property is in place any integers with leading zeros will be treated as strings and the zeros will be preserved. See the C<keep_leading_zeros()> section for a full discussion of this issue.
+
+You can also add your own data handlers to the C<write()> method using C<add_write_handler()>.
+
+On systems with C<perl 5.8> and later the C<write()> method will also handle Unicode strings in C<UTF-8> format.
+
+The C<write> methods return:
+
+ 0 for success.
+ -1 for insufficient number of arguments.
+ -2 for row or column out of bounds.
+ -3 for string too long.
+
+
+
+
+=head2 write_number($row, $column, $number, $format)
+
+Write an integer or a float to the cell specified by C<$row> and C<$column>:
+
+ $worksheet->write_number(0, 0, 123456);
+ $worksheet->write_number('A2', 2.3451);
+
+See the note about L<Cell notation>. The C<$format> parameter is optional.
+
+In general it is sufficient to use the C<write()> method.
+
+
+
+
+=head2 write_string($row, $column, $string, $format)
+
+Write a string to the cell specified by C<$row> and C<$column>:
+
+ $worksheet->write_string(0, 0, 'Your text here' );
+ $worksheet->write_string('A2', 'or here' );
+
+The maximum string size is 32767 characters. However the maximum string segment that Excel can display in a cell is 1000. All 32767 characters can be displayed in the formula bar.
+
+The C<$format> parameter is optional.
+
+On systems with C<perl 5.8> and later the C<write()> method will also handle strings in C<UTF-8> format. With older perls you can also write Unicode in C<UTF16> format via the C<write_utf16be_string()> method. See also the C<unicode_*.pl> programs in the examples directory of the distro.
+
+In general it is sufficient to use the C<write()> method. However, you may sometimes wish to use the C<write_string()> method to write data that looks like a number but that you don't want treated as a number. For example, zip codes or phone numbers:
+
+ # Write as a plain string
+ $worksheet->write_string('A1', '01209');
+
+However, if the user edits this string Excel may convert it back to a number. To get around this you can use the Excel text format C<@>:
+
+ # Format as a string. Doesn't change to a number when edited
+ my $format1 = $workbook->add_format(num_format => '@');
+ $worksheet->write_string('A2', '01209', $format1);
+
+See also the note about L<Cell notation>.
+
+
+
+
+=head2 write_utf16be_string($row, $column, $string, $format)
+
+This method is used to write C<UTF-16BE> strings to a cell in Excel. It is functionally the same as the C<write_string()> method except that the string should be in C<UTF-16BE> Unicode format. It is generally easier, when using Spreadsheet::WriteExcel, to write unicode strings in C<UTF-8> format, see L<UNICODE IN EXCEL>. The C<write_utf16be_string()> method is mainly of use in versions of perl prior to 5.8.
+
+
+The following is a simple example showing how to write some Unicode strings in C<UTF-16BE> format:
+
+ #!/usr/bin/perl -w
+
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+ use Unicode::Map();
+
+ my $workbook = Spreadsheet::WriteExcel->new('utf_16_be.xls');
+ my $worksheet = $workbook->add_worksheet();
+
+ # Increase the column width for clarity
+ $worksheet->set_column('A:A', 25);
+
+
+ # Write a Unicode character
+ #
+ my $smiley = pack 'n', 0x263a;
+
+ # Increase the font size for legibility.
+ my $big_font = $workbook->add_format(size => 72);
+
+ $worksheet->write_utf16be_string('A3', $smiley, $big_font);
+
+
+
+ # Write a phrase in Cyrillic using a hex-encoded string
+ #
+ my $str = pack 'H*', '042d0442043e0020044404400430043704300020043d' .
+ '043000200440044304410441043a043e043c0021';
+
+ $worksheet->write_utf16be_string('A5', $str);
+
+
+
+ # Map a string to UTF-16BE using an external module.
+ #
+ my $map = Unicode::Map->new('ISO-8859-1');
+ my $utf16 = $map->to_unicode('Hello world!');
+
+ $worksheet->write_utf16be_string('A7', $utf16);
+
+You can convert ASCII encodings to the required C<UTF-16BE> format using one of the many Unicode modules on CPAN. For example C<Unicode::Map> and C<Unicode::String>: L<http://search.cpan.org/author/MSCHWARTZ/Unicode-Map/Map.pm> and L<http://search.cpan.org/author/GAAS/Unicode-String/String.pm>.
+
+For a full list of the Perl Unicode modules see: L<http://search.cpan.org/search?query=unicode&mode=all>.
+
+C<UTF-16BE> is the format most often returned by C<Perl> modules that generate C<UTF-16>. To write C<UTF-16> strings in little-endian format use the C<write_utf16be_string_le()> method below.
+
+The C<write_utf16be_string()> method was previously called C<write_unicode()>. That, overly general, name is still supported but deprecated.
+
+See also the C<unicode_*.pl> programs in the examples directory of the distro.
+
+
+
+
+=head2 write_utf16le_string($row, $column, $string, $format)
+
+This method is the same as C<write_utf16be()> except that the string should be 16-bit characters in little-endian format. This is generally referred to as C<UTF-16LE>. See L<UNICODE IN EXCEL>.
+
+C<UTF-16> data can be changed from little-endian to big-endian format (and vice-versa) as follows:
+
+ $utf16be = pack 'n*', unpack 'v*', $utf16le;
+
+
+
+
+=head2 keep_leading_zeros()
+
+This method changes the default handling of integers with leading zeros when using the C<write()> method.
+
+The C<write()> method uses regular expressions to determine what type of data to write to an Excel worksheet. If the data looks like a number it writes a number using C<write_number()>. One problem with this approach is that occasionally data looks like a number but you don't want it treated as a number.
+
+Zip codes and ID numbers, for example, often start with a leading zero. If you write this data as a number then the leading zero(s) will be stripped. This is the also the default behaviour when you enter data manually in Excel.
+
+To get around this you can use one of three options. Write a formatted number, write the number as a string or use the C<keep_leading_zeros()> method to change the default behaviour of C<write()>:
+
+ # Implicitly write a number, the leading zero is removed: 1209
+ $worksheet->write('A1', '01209');
+
+ # Write a zero padded number using a format: 01209
+ my $format1 = $workbook->add_format(num_format => '00000');
+ $worksheet->write('A2', '01209', $format1);
+
+ # Write explicitly as a string: 01209
+ $worksheet->write_string('A3', '01209');
+
+ # Write implicitly as a string: 01209
+ $worksheet->keep_leading_zeros();
+ $worksheet->write('A4', '01209');
+
+
+The above code would generate a worksheet that looked like the following:
+
+ -----------------------------------------------------------
+ | | A | B | C | D | ...
+ -----------------------------------------------------------
+ | 1 | 1209 | | | | ...
+ | 2 | 01209 | | | | ...
+ | 3 | 01209 | | | | ...
+ | 4 | 01209 | | | | ...
+
+
+The examples are on different sides of the cells due to the fact that Excel displays strings with a left justification and numbers with a right justification by default. You can change this by using a format to justify the data, see L<CELL FORMATTING>.
+
+It should be noted that if the user edits the data in examples C<A3> and C<A4> the strings will revert back to numbers. Again this is Excel's default behaviour. To avoid this you can use the text format C<@>:
+
+ # Format as a string (01209)
+ my $format2 = $workbook->add_format(num_format => '@');
+ $worksheet->write_string('A5', '01209', $format2);
+
+The C<keep_leading_zeros()> property is off by default. The C<keep_leading_zeros()> method takes 0 or 1 as an argument. It defaults to 1 if an argument isn't specified:
+
+ $worksheet->keep_leading_zeros(); # Set on
+ $worksheet->keep_leading_zeros(1); # Set on
+ $worksheet->keep_leading_zeros(0); # Set off
+
+See also the C<add_write_handler()> method.
+
+
+=head2 write_blank($row, $column, $format)
+
+Write a blank cell specified by C<$row> and C<$column>:
+
+ $worksheet->write_blank(0, 0, $format);
+
+This method is used to add formatting to a cell which doesn't contain a string or number value.
+
+Excel differentiates between an "Empty" cell and a "Blank" cell. An "Empty" cell is a cell which doesn't contain data whilst a "Blank" cell is a cell which doesn't contain data but does contain formatting. Excel stores "Blank" cells but ignores "Empty" cells.
+
+As such, if you write an empty cell without formatting it is ignored:
+
+ $worksheet->write('A1', undef, $format); # write_blank()
+ $worksheet->write('A2', undef ); # Ignored
+
+This seemingly uninteresting fact means that you can write arrays of data without special treatment for undef or empty string values.
+
+See the note about L<Cell notation>.
+
+
+
+
+=head2 write_row($row, $column, $array_ref, $format)
+
+The C<write_row()> method can be used to write a 1D or 2D array of data in one go. This is useful for converting the results of a database query into an Excel worksheet. You must pass a reference to the array of data rather than the array itself. The C<write()> method is then called for each element of the data. For example:
+
+ @array = ('awk', 'gawk', 'mawk');
+ $array_ref = \@array;
+
+ $worksheet->write_row(0, 0, $array_ref);
+
+ # The above example is equivalent to:
+ $worksheet->write(0, 0, $array[0]);
+ $worksheet->write(0, 1, $array[1]);
+ $worksheet->write(0, 2, $array[2]);
+
+
+Note: For convenience the C<write()> method behaves in the same way as C<write_row()> if it is passed an array reference. Therefore the following two method calls are equivalent:
+
+ $worksheet->write_row('A1', $array_ref); # Write a row of data
+ $worksheet->write( 'A1', $array_ref); # Same thing
+
+As with all of the write methods the C<$format> parameter is optional. If a format is specified it is applied to all the elements of the data array.
+
+Array references within the data will be treated as columns. This allows you to write 2D arrays of data in one go. For example:
+
+ @eec = (
+ ['maggie', 'milly', 'molly', 'may' ],
+ [13, 14, 15, 16 ],
+ ['shell', 'star', 'crab', 'stone']
+ );
+
+ $worksheet->write_row('A1', \@eec);
+
+
+Would produce a worksheet as follows:
+
+ -----------------------------------------------------------
+ | | A | B | C | D | E | ...
+ -----------------------------------------------------------
+ | 1 | maggie | 13 | shell | ... | ... | ...
+ | 2 | milly | 14 | star | ... | ... | ...
+ | 3 | molly | 15 | crab | ... | ... | ...
+ | 4 | may | 16 | stone | ... | ... | ...
+ | 5 | ... | ... | ... | ... | ... | ...
+ | 6 | ... | ... | ... | ... | ... | ...
+
+
+To write the data in a row-column order refer to the C<write_col()> method below.
+
+Any C<undef> values in the data will be ignored unless a format is applied to the data, in which case a formatted blank cell will be written. In either case the appropriate row or column value will still be incremented.
+
+To find out more about array references refer to C<perlref> and C<perlreftut> in the main Perl documentation. To find out more about 2D arrays or "lists of lists" refer to C<perllol>.
+
+The C<write_row()> method returns the first error encountered when writing the elements of the data or zero if no errors were encountered. See the return values described for the C<write()> method above.
+
+See also the C<write_arrays.pl> program in the C<examples> directory of the distro.
+
+The C<write_row()> method allows the following idiomatic conversion of a text file to an Excel file:
+
+ #!/usr/bin/perl -w
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new('file.xls');
+ my $worksheet = $workbook->add_worksheet();
+
+ open INPUT, 'file.txt' or die "Couldn't open file: $!";
+
+ $worksheet->write($.-1, 0, [split]) while <INPUT>;
+
+
+
+
+=head2 write_col($row, $column, $array_ref, $format)
+
+The C<write_col()> method can be used to write a 1D or 2D array of data in one go. This is useful for converting the results of a database query into an Excel worksheet. You must pass a reference to the array of data rather than the array itself. The C<write()> method is then called for each element of the data. For example:
+
+ @array = ('awk', 'gawk', 'mawk');
+ $array_ref = \@array;
+
+ $worksheet->write_col(0, 0, $array_ref);
+
+ # The above example is equivalent to:
+ $worksheet->write(0, 0, $array[0]);
+ $worksheet->write(1, 0, $array[1]);
+ $worksheet->write(2, 0, $array[2]);
+
+As with all of the write methods the C<$format> parameter is optional. If a format is specified it is applied to all the elements of the data array.
+
+Array references within the data will be treated as rows. This allows you to write 2D arrays of data in one go. For example:
+
+ @eec = (
+ ['maggie', 'milly', 'molly', 'may' ],
+ [13, 14, 15, 16 ],
+ ['shell', 'star', 'crab', 'stone']
+ );
+
+ $worksheet->write_col('A1', \@eec);
+
+
+Would produce a worksheet as follows:
+
+ -----------------------------------------------------------
+ | | A | B | C | D | E | ...
+ -----------------------------------------------------------
+ | 1 | maggie | milly | molly | may | ... | ...
+ | 2 | 13 | 14 | 15 | 16 | ... | ...
+ | 3 | shell | star | crab | stone | ... | ...
+ | 4 | ... | ... | ... | ... | ... | ...
+ | 5 | ... | ... | ... | ... | ... | ...
+ | 6 | ... | ... | ... | ... | ... | ...
+
+
+To write the data in a column-row order refer to the C<write_row()> method above.
+
+Any C<undef> values in the data will be ignored unless a format is applied to the data, in which case a formatted blank cell will be written. In either case the appropriate row or column value will still be incremented.
+
+As noted above the C<write()> method can be used as a synonym for C<write_row()> and C<write_row()> handles nested array refs as columns. Therefore, the following two method calls are equivalent although the more explicit call to C<write_col()> would be preferable for maintainability:
+
+ $worksheet->write_col('A1', $array_ref ); # Write a column of data
+ $worksheet->write( 'A1', [ $array_ref ]); # Same thing
+
+To find out more about array references refer to C<perlref> and C<perlreftut> in the main Perl documentation. To find out more about 2D arrays or "lists of lists" refer to C<perllol>.
+
+The C<write_col()> method returns the first error encountered when writing the elements of the data or zero if no errors were encountered. See the return values described for the C<write()> method above.
+
+See also the C<write_arrays.pl> program in the C<examples> directory of the distro.
+
+
+
+
+=head2 write_date_time($row, $col, $date_string, $format)
+
+The C<write_date_time()> method can be used to write a date or time to the cell specified by C<$row> and C<$column>:
+
+ $worksheet->write_date_time('A1', '2004-05-13T23:20', $date_format);
+
+The C<$date_string> should be in the following format:
+
+ yyyy-mm-ddThh:mm:ss.sss
+
+This conforms to an ISO8601 date but it should be noted that the full range of ISO8601 formats are not supported.
+
+The following variations on the C<$date_string> parameter are permitted:
+
+ yyyy-mm-ddThh:mm:ss.sss # Standard format
+ yyyy-mm-ddT # No time
+ Thh:mm:ss.sss # No date
+ yyyy-mm-ddThh:mm:ss.sssZ # Additional Z (but not time zones)
+ yyyy-mm-ddThh:mm:ss # No fractional seconds
+ yyyy-mm-ddThh:mm # No seconds
+
+Note that the C<T> is required in all cases.
+
+A date should always have a C<$format>, otherwise it will appear as a number, see L<DATES AND TIME IN EXCEL> and L<CELL FORMATTING>. Here is a typical example:
+
+ my $date_format = $workbook->add_format(num_format => 'mm/dd/yy');
+ $worksheet->write_date_time('A1', '2004-05-13T23:20', $date_format);
+
+Valid dates should be in the range 1900-01-01 to 9999-12-31, for the 1900 epoch and 1904-01-01 to 9999-12-31, for the 1904 epoch. As with Excel, dates outside these ranges will be written as a string.
+
+See also the date_time.pl program in the C<examples> directory of the distro.
+
+
+
+
+=head2 write_url($row, $col, $url, $label, $format)
+
+Write a hyperlink to a URL in the cell specified by C<$row> and C<$column>. The hyperlink is comprised of two elements: the visible label and the invisible link. The visible label is the same as the link unless an alternative label is specified. The parameters C<$label> and the C<$format> are optional and their position is interchangeable.
+
+The label is written using the C<write()> method. Therefore it is possible to write strings, numbers or formulas as labels.
+
+There are four web style URI's supported: C<http://>, C<https://>, C<ftp://> and C<mailto:>:
+
+ $worksheet->write_url(0, 0, 'ftp://www.perl.org/' );
+ $worksheet->write_url(1, 0, 'http://www.perl.com/', 'Perl home' );
+ $worksheet->write_url('A3', 'http://www.perl.com/', $format );
+ $worksheet->write_url('A4', 'http://www.perl.com/', 'Perl', $format);
+ $worksheet->write_url('A5', 'mailto:jmcnamara@cpan.org' );
+
+There are two local URIs supported: C<internal:> and C<external:>. These are used for hyperlinks to internal worksheet references or external workbook and worksheet references:
+
+ $worksheet->write_url('A6', 'internal:Sheet2!A1' );
+ $worksheet->write_url('A7', 'internal:Sheet2!A1', $format );
+ $worksheet->write_url('A8', 'internal:Sheet2!A1:B2' );
+ $worksheet->write_url('A9', q{internal:'Sales Data'!A1} );
+ $worksheet->write_url('A10', 'external:c:\temp\foo.xls' );
+ $worksheet->write_url('A11', 'external:c:\temp\foo.xls#Sheet2!A1' );
+ $worksheet->write_url('A12', 'external:..\..\..\foo.xls' );
+ $worksheet->write_url('A13', 'external:..\..\..\foo.xls#Sheet2!A1' );
+ $worksheet->write_url('A13', 'external:\\\\NETWORK\share\foo.xls' );
+
+All of the these URI types are recognised by the C<write()> method, see above.
+
+Worksheet references are typically of the form C<Sheet1!A1>. You can also refer to a worksheet range using the standard Excel notation: C<Sheet1!A1:B2>.
+
+In external links the workbook and worksheet name must be separated by the C<#> character: C<external:Workbook.xls#Sheet1!A1'>.
+
+You can also link to a named range in the target worksheet. For example say you have a named range called C<my_name> in the workbook C<c:\temp\foo.xls> you could link to it as follows:
+
+ $worksheet->write_url('A14', 'external:c:\temp\foo.xls#my_name');
+
+Note, you cannot currently create named ranges with C<Spreadsheet::WriteExcel>.
+
+Excel requires that worksheet names containing spaces or non alphanumeric characters are single quoted as follows C<'Sales Data'!A1>. If you need to do this in a single quoted string then you can either escape the single quotes C<\'> or use the quote operator C<q{}> as described in C<perlop> in the main Perl documentation.
+
+Links to network files are also supported. MS/Novell Network files normally begin with two back slashes as follows C<\\NETWORK\etc>. In order to generate this in a single or double quoted string you will have to escape the backslashes, C<'\\\\NETWORK\etc'>.
+
+If you are using double quote strings then you should be careful to escape anything that looks like a metacharacter. For more information see C<perlfaq5: Why can't I use "C:\temp\foo" in DOS paths?>.
+
+Finally, you can avoid most of these quoting problems by using forward slashes. These are translated internally to backslashes:
+
+ $worksheet->write_url('A14', "external:c:/temp/foo.xls" );
+ $worksheet->write_url('A15', 'external://NETWORK/share/foo.xls' );
+
+See also, the note about L<Cell notation>.
+
+
+
+
+=head2 write_url_range($row1, $col1, $row2, $col2, $url, $string, $format)
+
+This method is essentially the same as the C<write_url()> method described above. The main difference is that you can specify a link for a range of cells:
+
+ $worksheet->write_url(0, 0, 0, 3, 'ftp://www.perl.org/' );
+ $worksheet->write_url(1, 0, 0, 3, 'http://www.perl.com/', 'Perl home');
+ $worksheet->write_url('A3:D3', 'internal:Sheet2!A1' );
+ $worksheet->write_url('A4:D4', 'external:c:\temp\foo.xls' );
+
+
+This method is generally only required when used in conjunction with merged cells. See the C<merge_range()> method and the C<merge> property of a Format object, L<CELL FORMATTING>.
+
+There is no way to force this behaviour through the C<write()> method.
+
+The parameters C<$string> and the C<$format> are optional and their position is interchangeable. However, they are applied only to the first cell in the range.
+
+See also, the note about L<Cell notation>.
+
+
+
+
+=head2 write_formula($row, $column, $formula, $format, $value)
+
+Write a formula or function to the cell specified by C<$row> and C<$column>:
+
+ $worksheet->write_formula(0, 0, '=$B$3 + B4' );
+ $worksheet->write_formula(1, 0, '=SIN(PI()/4)');
+ $worksheet->write_formula(2, 0, '=SUM(B1:B5)' );
+ $worksheet->write_formula('A4', '=IF(A3>1,"Yes", "No")' );
+ $worksheet->write_formula('A5', '=AVERAGE(1, 2, 3, 4)' );
+ $worksheet->write_formula('A6', '=DATEVALUE("1-Jan-2001")');
+
+See the note about L<Cell notation>. For more information about writing Excel formulas see L<FORMULAS AND FUNCTIONS IN EXCEL>
+
+See also the section "Improving performance when working with formulas" and the C<store_formula()> and C<repeat_formula()> methods.
+
+If required, it is also possible to specify the calculated value of the formula. This is occasionally necessary when working with non-Excel applications that don't calculated the value of the formula. The calculated C<$value> is added at the end of the argument list:
+
+ $worksheet->write('A1', '=2+2', $format, 4);
+
+However, this probably isn't something that will ever need to do. If you do use this feature then do so with care.
+
+
+
+
+=head2 store_formula($formula)
+
+The C<store_formula()> method is used in conjunction with C<repeat_formula()> to speed up the generation of repeated formulas. See "Improving performance when working with formulas" in L<FORMULAS AND FUNCTIONS IN EXCEL>.
+
+The C<store_formula()> method pre-parses a textual representation of a formula and stores it for use at a later stage by the C<repeat_formula()> method.
+
+C<store_formula()> carries the same speed penalty as C<write_formula()>. However, in practice it will be used less frequently.
+
+The return value of this method is a scalar that can be thought of as a reference to a formula.
+
+ my $sin = $worksheet->store_formula('=SIN(A1)');
+ my $cos = $worksheet->store_formula('=COS(A1)');
+
+ $worksheet->repeat_formula('B1', $sin, $format, 'A1', 'A2');
+ $worksheet->repeat_formula('C1', $cos, $format, 'A1', 'A2');
+
+Although C<store_formula()> is a worksheet method the return value can be used in any worksheet:
+
+ my $now = $worksheet->store_formula('=NOW()');
+
+ $worksheet1->repeat_formula('B1', $now);
+ $worksheet2->repeat_formula('B1', $now);
+ $worksheet3->repeat_formula('B1', $now);
+
+
+
+=head2 repeat_formula($row, $col, $formula, $format, ($pattern => $replace, ...))
+
+
+The C<repeat_formula()> method is used in conjunction with C<store_formula()> to speed up the generation of repeated formulas. See "Improving performance when working with formulas" in L<FORMULAS AND FUNCTIONS IN EXCEL>.
+
+In many respects C<repeat_formula()> behaves like C<write_formula()> except that it is significantly faster.
+
+The C<repeat_formula()> method creates a new formula based on the pre-parsed tokens returned by C<store_formula()>. The new formula is generated by substituting C<$pattern>, C<$replace> pairs in the stored formula:
+
+ my $formula = $worksheet->store_formula('=A1 * 3 + 50');
+
+ for my $row (0..99) {
+ $worksheet->repeat_formula($row, 1, $formula, $format, 'A1', 'A'.($row +1));
+ }
+
+It should be noted that C<repeat_formula()> doesn't modify the tokens. In the above example the substitution is always made against the original token, C<A1>, which doesn't change.
+
+As usual, you can use C<undef> if you don't wish to specify a C<$format>:
+
+ $worksheet->repeat_formula('B2', $formula, $format, 'A1', 'A2');
+ $worksheet->repeat_formula('B3', $formula, undef, 'A1', 'A3');
+
+The substitutions are made from left to right and you can use as many C<$pattern>, C<$replace> pairs as you need. However, each substitution is made only once:
+
+ my $formula = $worksheet->store_formula('=A1 + A1');
+
+ # Gives '=B1 + A1'
+ $worksheet->repeat_formula('B1', $formula, undef, 'A1', 'B1');
+
+ # Gives '=B1 + B1'
+ $worksheet->repeat_formula('B2', $formula, undef, ('A1', 'B1') x 2);
+
+Since the C<$pattern> is interpolated each time that it is used it is worth using the C<qr> operator to quote the pattern. The C<qr> operator is explained in the C<perlop> man page.
+
+ $worksheet->repeat_formula('B1', $formula, $format, qr/A1/, 'A2');
+
+Care should be taken with the values that are substituted. The formula returned by C<repeat_formula()> contains several other tokens in addition to those in the formula and these might also match the pattern that you are trying to replace. In particular you should avoid substituting a single 0, 1, 2 or 3.
+
+You should also be careful to avoid false matches. For example the following snippet is meant to change the stored formula in steps from C<=A1 + SIN(A1)> to C<=A10 + SIN(A10)>.
+
+ my $formula = $worksheet->store_formula('=A1 + SIN(A1)');
+
+ for my $row (1 .. 10) {
+ $worksheet->repeat_formula($row -1, 1, $formula, undef,
+ qw/A1/, 'A' . $row, #! Bad.
+ qw/A1/, 'A' . $row #! Bad.
+ );
+ }
+
+However it contains a bug. In the last iteration of the loop when C<$row> is 10 the following substitutions will occur:
+
+ s/A1/A10/; changes =A1 + SIN(A1) to =A10 + SIN(A1)
+ s/A1/A10/; changes =A10 + SIN(A1) to =A100 + SIN(A1) # !!
+
+The solution in this case is to use a more explicit match such as C<qw/^A1$/>:
+
+ $worksheet->repeat_formula($row -1, 1, $formula, undef,
+ qw/^A1$/, 'A' . $row,
+ qw/^A1$/, 'A' . $row
+ );
+
+Another similar problem occurs due to the fact that substitutions are made in order. For example the following snippet is meant to change the stored formula from C<=A10 + A11> to C<=A11 + A12>:
+
+ my $formula = $worksheet->store_formula('=A10 + A11');
+
+ $worksheet->repeat_formula('A1', $formula, undef,
+ qw/A10/, 'A11', #! Bad.
+ qw/A11/, 'A12' #! Bad.
+ );
+
+However, the actual substitution yields C<=A12 + A11>:
+
+ s/A10/A11/; changes =A10 + A11 to =A11 + A11
+ s/A11/A12/; changes =A11 + A11 to =A12 + A11 # !!
+
+The solution here would be to reverse the order of the substitutions or to start with a stored formula that won't yield a false match such as C<=X10 + Y11>:
+
+ my $formula = $worksheet->store_formula('=X10 + Y11');
+
+ $worksheet->repeat_formula('A1', $formula, undef,
+ qw/X10/, 'A11',
+ qw/Y11/, 'A12'
+ );
+
+
+If you think that you have a problem related to a false match you can check the tokens that you are substituting against as follows.
+
+ my $formula = $worksheet->store_formula('=A1*5+4');
+ print "@$formula\n";
+
+See also the C<repeat.pl> program in the C<examples> directory of the distro.
+
+
+
+
+=head2 write_comment($row, $column, $string, ...)
+
+The C<write_comment()> method is used to add a comment to a cell. A cell comment is indicated in Excel by a small red triangle in the upper right-hand corner of the cell. Moving the cursor over the red triangle will reveal the comment.
+
+The following example shows how to add a comment to a cell:
+
+ $worksheet->write (2, 2, 'Hello');
+ $worksheet->write_comment(2, 2, 'This is a comment.');
+
+As usual you can replace the C<$row> and C<$column> parameters with an C<A1> cell reference. See the note about L<Cell notation>.
+
+ $worksheet->write ('C3', 'Hello');
+ $worksheet->write_comment('C3', 'This is a comment.');
+
+On systems with C<perl 5.8> and later the C<write_comment()> method will also handle strings in C<UTF-8> format.
+
+ $worksheet->write_comment('C3', "\x{263a}"); # Smiley
+ $worksheet->write_comment('C4', 'Comment ca va?');
+
+In addition to the basic 3 argument form of C<write_comment()> you can pass in several optional key/value pairs to control the format of the comment. For example:
+
+ $worksheet->write_comment('C3', 'Hello', visible => 1, author => 'Perl');
+
+Most of these options are quite specific and in general the default comment behaviour will be all that you need. However, should you need greater control over the format of the cell comment the following options are available:
+
+ encoding
+ author
+ author_encoding
+ visible
+ x_scale
+ width
+ y_scale
+ height
+ color
+ start_cell
+ start_row
+ start_col
+ x_offset
+ y_offset
+
+
+=over 4
+
+=item Option: encoding
+
+This option is used to indicate that the comment string is encoded as C<UTF-16BE>.
+
+ my $comment = pack 'n', 0x263a; # UTF-16BE Smiley symbol
+
+ $worksheet->write_comment('C3', $comment, encoding => 1);
+
+If you wish to use Unicode characters in the comment string then the preferred method is to use perl 5.8 and C<UTF-8> strings, see L<UNICODE IN EXCEL>.
+
+
+=item Option: author
+
+This option is used to indicate who the author of the comment is. Excel displays the author of the comment in the status bar at the bottom of the worksheet. This is usually of interest in corporate environments where several people might review and provide comments to a workbook.
+
+ $worksheet->write_comment('C3', 'Atonement', author => 'Ian McEwan');
+
+
+=item Option: author_encoding
+
+This option is used to indicate that the author string is encoded as C<UTF-16BE>.
+
+
+=item Option: visible
+
+This option is used to make a cell comment visible when the worksheet is opened. The default behaviour in Excel is that comments are initially hidden. However, it is also possible in Excel to make individual or all comments visible. In Spreadsheet::WriteExcel individual comments can be made visible as follows:
+
+ $worksheet->write_comment('C3', 'Hello', visible => 1);
+
+It is possible to make all comments in a worksheet visible using the C<show_comments()> worksheet method (see below). Alternatively, if all of the cell comments have been made visible you can hide individual comments:
+
+ $worksheet->write_comment('C3', 'Hello', visible => 0);
+
+
+=item Option: x_scale
+
+This option is used to set the width of the cell comment box as a factor of the default width.
+
+ $worksheet->write_comment('C3', 'Hello', x_scale => 2);
+ $worksheet->write_comment('C4', 'Hello', x_scale => 4.2);
+
+
+=item Option: width
+
+This option is used to set the width of the cell comment box explicitly in pixels.
+
+ $worksheet->write_comment('C3', 'Hello', width => 200);
+
+
+=item Option: y_scale
+
+This option is used to set the height of the cell comment box as a factor of the default height.
+
+ $worksheet->write_comment('C3', 'Hello', y_scale => 2);
+ $worksheet->write_comment('C4', 'Hello', y_scale => 4.2);
+
+
+=item Option: height
+
+This option is used to set the height of the cell comment box explicitly in pixels.
+
+ $worksheet->write_comment('C3', 'Hello', height => 200);
+
+
+=item Option: color
+
+This option is used to set the background colour of cell comment box. You can use one of the named colours recognised by Spreadsheet::WriteExcel or a colour index. See L<COLOURS IN EXCEL>.
+
+ $worksheet->write_comment('C3', 'Hello', color => 'green');
+ $worksheet->write_comment('C4', 'Hello', color => 0x35); # Orange
+
+
+=item Option: start_cell
+
+This option is used to set the cell in which the comment will appear. By default Excel displays comments one cell to the right and one cell above the cell to which the comment relates. However, you can change this behaviour if you wish. In the following example the comment which would appear by default in cell C<D2> is moved to C<E2>.
+
+ $worksheet->write_comment('C3', 'Hello', start_cell => 'E2');
+
+
+=item Option: start_row
+
+This option is used to set the row in which the comment will appear. See the C<start_cell> option above. The row is zero indexed.
+
+ $worksheet->write_comment('C3', 'Hello', start_row => 0);
+
+
+=item Option: start_col
+
+This option is used to set the column in which the comment will appear. See the C<start_cell> option above. The column is zero indexed.
+
+ $worksheet->write_comment('C3', 'Hello', start_col => 4);
+
+
+=item Option: x_offset
+
+This option is used to change the x offset, in pixels, of a comment within a cell:
+
+ $worksheet->write_comment('C3', $comment, x_offset => 30);
+
+
+=item Option: y_offset
+
+This option is used to change the y offset, in pixels, of a comment within a cell:
+
+ $worksheet->write_comment('C3', $comment, x_offset => 30);
+
+
+=back
+
+You can apply as many of these options as you require.
+
+B<Note about row height and comments>. If you specify the height of a row that contains a comment then Spreadsheet::WriteExcel will adjust the height of the comment to maintain the default or user specified dimensions. However, the height of a row can also be adjusted automatically by Excel if the text wrap property is set or large fonts are used in the cell. This means that the height of the row is unknown to WriteExcel at run time and thus the comment box is stretched with the row. Use the C<set_row()> method to specify the row height explicitly and avoid this problem.
+
+
+=head2 show_comments()
+
+This method is used to make all cell comments visible when a worksheet is opened.
+
+Individual comments can be made visible using the C<visible> parameter of the C<write_comment> method (see above):
+
+ $worksheet->write_comment('C3', 'Hello', visible => 1);
+
+If all of the cell comments have been made visible you can hide individual comments as follows:
+
+ $worksheet->write_comment('C3', 'Hello', visible => 0);
+
+
+
+
+=head2 add_write_handler($re, $code_ref)
+
+This method is used to extend the Spreadsheet::WriteExcel write() method to handle user defined data.
+
+If you refer to the section on C<write()> above you will see that it acts as an alias for several more specific C<write_*> methods. However, it doesn't always act in exactly the way that you would like it to.
+
+One solution is to filter the input data yourself and call the appropriate C<write_*> method. Another approach is to use the C<add_write_handler()> method to add your own automated behaviour to C<write()>.
+
+The C<add_write_handler()> method take two arguments, C<$re>, a regular expression to match incoming data and C<$code_ref> a callback function to handle the matched data:
+
+ $worksheet->add_write_handler(qr/^\d\d\d\d$/, \&my_write);
+
+(In the these examples the C<qr> operator is used to quote the regular expression strings, see L<perlop> for more details).
+
+The method is used as follows. say you wished to write 7 digit ID numbers as a string so that any leading zeros were preserved*, you could do something like the following:
+
+ $worksheet->add_write_handler(qr/^\d{7}$/, \&write_my_id);
+
+
+ sub write_my_id {
+ my $worksheet = shift;
+ return $worksheet->write_string(@_);
+ }
+
+* You could also use the C<keep_leading_zeros()> method for this.
+
+Then if you call C<write()> with an appropriate string it will be handled automatically:
+
+ # Writes 0000000. It would normally be written as a number; 0.
+ $worksheet->write('A1', '0000000');
+
+The callback function will receive a reference to the calling worksheet and all of the other arguments that were passed to C<write()>. The callback will see an C<@_> argument list that looks like the following:
+
+ $_[0] A ref to the calling worksheet. *
+ $_[1] Zero based row number.
+ $_[2] Zero based column number.
+ $_[3] A number or string or token.
+ $_[4] A format ref if any.
+ $_[5] Any other arguments.
+ ...
+
+ * It is good style to shift this off the list so the @_ is the same
+ as the argument list seen by write().
+
+Your callback should C<return()> the return value of the C<write_*> method that was called or C<undef> to indicate that you rejected the match and want C<write()> to continue as normal.
+
+So for example if you wished to apply the previous filter only to ID values that occur in the first column you could modify your callback function as follows:
+
+
+ sub write_my_id {
+ my $worksheet = shift;
+ my $col = $_[1];
+
+ if ($col == 0) {
+ return $worksheet->write_string(@_);
+ }
+ else {
+ # Reject the match and return control to write()
+ return undef;
+ }
+ }
+
+Now, you will get different behaviour for the first column and other columns:
+
+ $worksheet->write('A1', '0000000'); # Writes 0000000
+ $worksheet->write('B1', '0000000'); # Writes 0
+
+
+You may add more than one handler in which case they will be called in the order that they were added.
+
+Note, the C<add_write_handler()> method is particularly suited for handling dates.
+
+See the C<write_handler 1-4> programs in the C<examples> directory for further examples.
+
+
+
+
+=head2 insert_image($row, $col, $filename, $x, $y, $scale_x, $scale_y)
+
+This method can be used to insert a image into a worksheet. The image can be in PNG, JPEG or BMP format. The C<$x>, C<$y>, C<$scale_x> and C<$scale_y> parameters are optional.
+
+ $worksheet1->insert_image('A1', 'perl.bmp');
+ $worksheet2->insert_image('A1', '../images/perl.bmp');
+ $worksheet3->insert_image('A1', '.c:\images\perl.bmp');
+
+The parameters C<$x> and C<$y> can be used to specify an offset from the top left hand corner of the cell specified by C<$row> and C<$col>. The offset values are in pixels.
+
+ $worksheet1->insert_image('A1', 'perl.bmp', 32, 10);
+
+The default width of a cell is 63 pixels. The default height of a cell is 17 pixels. The pixels offsets can be calculated using the following relationships:
+
+ Wp = int(12We) if We < 1
+ Wp = int(7We +5) if We >= 1
+ Hp = int(4/3He)
+
+ where:
+ We is the cell width in Excels units
+ Wp is width in pixels
+ He is the cell height in Excels units
+ Hp is height in pixels
+
+The offsets can be greater than the width or height of the underlying cell. This can be occasionally useful if you wish to align two or more images relative to the same cell.
+
+The parameters C<$scale_x> and C<$scale_y> can be used to scale the inserted image horizontally and vertically:
+
+ # Scale the inserted image: width x 2.0, height x 0.8
+ $worksheet->insert_image('A1', 'perl.bmp', 0, 0, 2, 0.8);
+
+See also the C<images.pl> program in the C<examples> directory of the distro.
+
+Note: you must call C<set_row()> or C<set_column()> before C<insert_image()> if you wish to change the default dimensions of any of the rows or columns that the image occupies. The height of a row can also change if you use a font that is larger than the default. This in turn will affect the scaling of your image. To avoid this you should explicitly set the height of the row using C<set_row()> if it contains a font size that will change the row height.
+
+
+BMP images must be 24 bit, true colour, bitmaps. In general it is best to avoid BMP images since they aren't compressed. The older C<insert_bitmap()> method is still supported but deprecated.
+
+
+
+
+=head2 insert_chart($row, $col, $chart, $x, $y, $scale_x, $scale_y)
+
+This method can be used to insert a Chart object into a worksheet. The Chart must be created by the C<add_chart()> Workbook method and it must have the C<embedded> option set.
+
+ my $chart = $workbook->add_chart( type => 'line', embedded => 1 );
+
+ # Configure the chart.
+ ...
+
+ # Insert the chart into the a worksheet.
+ $worksheet->insert_chart('E2', $chart);
+
+See C<add_chart()> for details on how to create the Chart object and L<Spreadsheet::WriteExcel::Chart> for details on how to configure it. See also the C<chart_*.pl> programs in the examples directory of the distro.
+
+The C<$x>, C<$y>, C<$scale_x> and C<$scale_y> parameters are optional.
+
+The parameters C<$x> and C<$y> can be used to specify an offset from the top left hand corner of the cell specified by C<$row> and C<$col>. The offset values are in pixels. See the C<insert_image> method above for more information on sizes.
+
+ $worksheet1->insert_chart('E2', $chart, 3, 3);
+
+The parameters C<$scale_x> and C<$scale_y> can be used to scale the inserted image horizontally and vertically:
+
+ # Scale the width by 120% and the height by 150%
+ $worksheet->insert_chart('E2', $chart, 0, 0, 1.2, 1.5);
+
+The easiest way to calculate the required scaling is to create a test chart worksheet with Spreadsheet::WriteExcel. Then open the file, select the chart and drag the corner to get the required size. While holding down the mouse the scale of the resized chart is shown to the left of the formula bar.
+
+Note: you must call C<set_row()> or C<set_column()> before C<insert_chart()> if you wish to change the default dimensions of any of the rows or columns that the chart occupies. The height of a row can also change if you use a font that is larger than the default. This in turn will affect the scaling of your chart. To avoid this you should explicitly set the height of the row using C<set_row()> if it contains a font size that will change the row height.
+
+
+
+
+=head2 embed_chart($row, $col, $filename, $x, $y, $scale_x, $scale_y)
+
+This method can be used to insert a externally generated chart into a worksheet. The chart must first be extracted from an existing Excel file. This feature is semi-deprecated in favour of the "native" charts created using C<add_chart()>. Read C<external_charts.txt> (or C<.pod>) in the external_charts directory of the distro for a full explanation.
+
+Here is an example:
+
+ $worksheet->embed_chart('B2', 'sales_chart.bin');
+
+The C<$x>, C<$y>, C<$scale_x> and C<$scale_y> parameters are optional. See C<insert_chart()> above for details.
+
+
+
+
+=head2 data_validation()
+
+The C<data_validation()> method is used to construct an Excel data validation or to limit the user input to a dropdown list of values.
+
+
+ $worksheet->data_validation('B3',
+ {
+ validate => 'integer',
+ criteria => '>',
+ value => 100,
+ });
+
+ $worksheet->data_validation('B5:B9',
+ {
+ validate => 'list',
+ value => ['open', 'high', 'close'],
+ });
+
+This method contains a lot of parameters and is described in detail in a separate section L<DATA VALIDATION IN EXCEL>.
+
+
+See also the C<data_validate.pl> program in the examples directory of the distro
+
+
+
+
+=head2 get_name()
+
+The C<get_name()> method is used to retrieve the name of a worksheet. For example:
+
+ foreach my $sheet ($workbook->sheets()) {
+ print $sheet->get_name();
+ }
+
+For reasons related to the design of Spreadsheet::WriteExcel and to the internals of Excel there is no C<set_name()> method. The only way to set the worksheet name is via the C<add_worksheet()> method.
+
+
+
+
+=head2 activate()
+
+The C<activate()> method is used to specify which worksheet is initially visible in a multi-sheet workbook:
+
+ $worksheet1 = $workbook->add_worksheet('To');
+ $worksheet2 = $workbook->add_worksheet('the');
+ $worksheet3 = $workbook->add_worksheet('wind');
+
+ $worksheet3->activate();
+
+This is similar to the Excel VBA activate method. More than one worksheet can be selected via the C<select()> method, see below, however only one worksheet can be active.
+
+The default active worksheet is the first worksheet.
+
+
+
+
+=head2 select()
+
+The C<select()> method is used to indicate that a worksheet is selected in a multi-sheet workbook:
+
+ $worksheet1->activate();
+ $worksheet2->select();
+ $worksheet3->select();
+
+A selected worksheet has its tab highlighted. Selecting worksheets is a way of grouping them together so that, for example, several worksheets could be printed in one go. A worksheet that has been activated via the C<activate()> method will also appear as selected.
+
+
+
+
+=head2 hide()
+
+The C<hide()> method is used to hide a worksheet:
+
+ $worksheet2->hide();
+
+You may wish to hide a worksheet in order to avoid confusing a user with intermediate data or calculations.
+
+A hidden worksheet can not be activated or selected so this method is mutually exclusive with the C<activate()> and C<select()> methods. In addition, since the first worksheet will default to being the active worksheet, you cannot hide the first worksheet without activating another sheet:
+
+ $worksheet2->activate();
+ $worksheet1->hide();
+
+
+
+
+=head2 set_first_sheet()
+
+The C<activate()> method determines which worksheet is initially selected. However, if there are a large number of worksheets the selected worksheet may not appear on the screen. To avoid this you can select which is the leftmost visible worksheet using C<set_first_sheet()>:
+
+ for (1..20) {
+ $workbook->add_worksheet;
+ }
+
+ $worksheet21 = $workbook->add_worksheet();
+ $worksheet22 = $workbook->add_worksheet();
+
+ $worksheet21->set_first_sheet();
+ $worksheet22->activate();
+
+This method is not required very often. The default value is the first worksheet.
+
+
+
+
+=head2 protect($password)
+
+The C<protect()> method is used to protect a worksheet from modification:
+
+ $worksheet->protect();
+
+It can be turned off in Excel via the C<Tools-E<gt>Protection-E<gt>Unprotect Sheet> menu command.
+
+The C<protect()> method also has the effect of enabling a cell's C<locked> and C<hidden> properties if they have been set. A "locked" cell cannot be edited. A "hidden" cell will display the results of a formula but not the formula itself. In Excel a cell's locked property is on by default.
+
+ # Set some format properties
+ my $unlocked = $workbook->add_format(locked => 0);
+ my $hidden = $workbook->add_format(hidden => 1);
+
+ # Enable worksheet protection
+ $worksheet->protect();
+
+ # This cell cannot be edited, it is locked by default
+ $worksheet->write('A1', '=1+2');
+
+ # This cell can be edited
+ $worksheet->write('A2', '=1+2', $unlocked);
+
+ # The formula in this cell isn't visible
+ $worksheet->write('A3', '=1+2', $hidden);
+
+See also the C<set_locked> and C<set_hidden> format methods in L<CELL FORMATTING>.
+
+You can optionally add a password to the worksheet protection:
+
+ $worksheet->protect('drowssap');
+
+Note, the worksheet level password in Excel provides very weak protection. It does not encrypt your data in any way and it is very easy to deactivate. Therefore, do not use the above method if you wish to protect sensitive data or calculations. However, before you get worried, Excel's own workbook level password protection does provide strong encryption in Excel 97+. For technical reasons this will never be supported by C<Spreadsheet::WriteExcel>.
+
+
+
+
+=head2 set_selection($first_row, $first_col, $last_row, $last_col)
+
+This method can be used to specify which cell or cells are selected in a worksheet. The most common requirement is to select a single cell, in which case C<$last_row> and C<$last_col> can be omitted. The active cell within a selected range is determined by the order in which C<$first> and C<$last> are specified. It is also possible to specify a cell or a range using A1 notation. See the note about L<Cell notation>.
+
+Examples:
+
+ $worksheet1->set_selection(3, 3); # 1. Cell D4.
+ $worksheet2->set_selection(3, 3, 6, 6); # 2. Cells D4 to G7.
+ $worksheet3->set_selection(6, 6, 3, 3); # 3. Cells G7 to D4.
+ $worksheet4->set_selection('D4'); # Same as 1.
+ $worksheet5->set_selection('D4:G7'); # Same as 2.
+ $worksheet6->set_selection('G7:D4'); # Same as 3.
+
+The default cell selections is (0, 0), 'A1'.
+
+
+
+
+=head2 set_row($row, $height, $format, $hidden, $level, $collapsed)
+
+This method can be used to change the default properties of a row. All parameters apart from C<$row> are optional.
+
+The most common use for this method is to change the height of a row:
+
+ $worksheet->set_row(0, 20); # Row 1 height set to 20
+
+If you wish to set the format without changing the height you can pass C<undef> as the height parameter:
+
+ $worksheet->set_row(0, undef, $format);
+
+The C<$format> parameter will be applied to any cells in the row that don't have a format. For example
+
+ $worksheet->set_row(0, undef, $format1); # Set the format for row 1
+ $worksheet->write('A1', 'Hello'); # Defaults to $format1
+ $worksheet->write('B1', 'Hello', $format2); # Keeps $format2
+
+If you wish to define a row format in this way you should call the method before any calls to C<write()>. Calling it afterwards will overwrite any format that was previously specified.
+
+The C<$hidden> parameter should be set to 1 if you wish to hide a row. This can be used, for example, to hide intermediary steps in a complicated calculation:
+
+ $worksheet->set_row(0, 20, $format, 1);
+ $worksheet->set_row(1, undef, undef, 1);
+
+The C<$level> parameter is used to set the outline level of the row. Outlines are described in L<OUTLINES AND GROUPING IN EXCEL>. Adjacent rows with the same outline level are grouped together into a single outline.
+
+The following example sets an outline level of 1 for rows 1 and 2 (zero-indexed):
+
+ $worksheet->set_row(1, undef, undef, 0, 1);
+ $worksheet->set_row(2, undef, undef, 0, 1);
+
+The C<$hidden> parameter can also be used to hide collapsed outlined rows when used in conjunction with the C<$level> parameter.
+
+ $worksheet->set_row(1, undef, undef, 1, 1);
+ $worksheet->set_row(2, undef, undef, 1, 1);
+
+For collapsed outlines you should also indicate which row has the collapsed C<+> symbol using the optional C<$collapsed> parameter.
+
+ $worksheet->set_row(3, undef, undef, 0, 0, 1);
+
+For a more complete example see the C<outline.pl> and C<outline_collapsed.pl> programs in the examples directory of the distro.
+
+Excel allows up to 7 outline levels. Therefore the C<$level> parameter should be in the range C<0 E<lt>= $level E<lt>= 7>.
+
+
+
+
+=head2 set_column($first_col, $last_col, $width, $format, $hidden, $level, $collapsed)
+
+This method can be used to change the default properties of a single column or a range of columns. All parameters apart from C<$first_col> and C<$last_col> are optional.
+
+If C<set_column()> is applied to a single column the value of C<$first_col> and C<$last_col> should be the same. In the case where C<$last_col> is zero it is set to the same value as C<$first_col>.
+
+It is also possible, and generally clearer, to specify a column range using the form of A1 notation used for columns. See the note about L<Cell notation>.
+
+Examples:
+
+ $worksheet->set_column(0, 0, 20); # Column A width set to 20
+ $worksheet->set_column(1, 3, 30); # Columns B-D width set to 30
+ $worksheet->set_column('E:E', 20); # Column E width set to 20
+ $worksheet->set_column('F:H', 30); # Columns F-H width set to 30
+
+The width corresponds to the column width value that is specified in Excel. It is approximately equal to the length of a string in the default font of Arial 10. Unfortunately, there is no way to specify "AutoFit" for a column in the Excel file format. This feature is only available at runtime from within Excel.
+
+As usual the C<$format> parameter is optional, for additional information, see L<CELL FORMATTING>. If you wish to set the format without changing the width you can pass C<undef> as the width parameter:
+
+ $worksheet->set_column(0, 0, undef, $format);
+
+The C<$format> parameter will be applied to any cells in the column that don't have a format. For example
+
+ $worksheet->set_column('A:A', undef, $format1); # Set format for col 1
+ $worksheet->write('A1', 'Hello'); # Defaults to $format1
+ $worksheet->write('A2', 'Hello', $format2); # Keeps $format2
+
+If you wish to define a column format in this way you should call the method before any calls to C<write()>. If you call it afterwards it won't have any effect.
+
+A default row format takes precedence over a default column format
+
+ $worksheet->set_row(0, undef, $format1); # Set format for row 1
+ $worksheet->set_column('A:A', undef, $format2); # Set format for col 1
+ $worksheet->write('A1', 'Hello'); # Defaults to $format1
+ $worksheet->write('A2', 'Hello'); # Defaults to $format2
+
+The C<$hidden> parameter should be set to 1 if you wish to hide a column. This can be used, for example, to hide intermediary steps in a complicated calculation:
+
+ $worksheet->set_column('D:D', 20, $format, 1);
+ $worksheet->set_column('E:E', undef, undef, 1);
+
+The C<$level> parameter is used to set the outline level of the column. Outlines are described in L<OUTLINES AND GROUPING IN EXCEL>. Adjacent columns with the same outline level are grouped together into a single outline.
+
+The following example sets an outline level of 1 for columns B to G:
+
+ $worksheet->set_column('B:G', undef, undef, 0, 1);
+
+The C<$hidden> parameter can also be used to hide collapsed outlined columns when used in conjunction with the C<$level> parameter.
+
+ $worksheet->set_column('B:G', undef, undef, 1, 1);
+
+For collapsed outlines you should also indicate which row has the collapsed C<+> symbol using the optional C<$collapsed> parameter.
+
+ $worksheet->set_column('H:H', undef, undef, 0, 0, 1);
+
+For a more complete example see the C<outline.pl> and C<outline_collapsed.pl> programs in the examples directory of the distro.
+
+Excel allows up to 7 outline levels. Therefore the C<$level> parameter should be in the range C<0 E<lt>= $level E<lt>= 7>.
+
+
+
+
+=head2 outline_settings($visible, $symbols_below, $symbols_right, $auto_style)
+
+The C<outline_settings()> method is used to control the appearance of outlines in Excel. Outlines are described in L<OUTLINES AND GROUPING IN EXCEL>.
+
+The C<$visible> parameter is used to control whether or not outlines are visible. Setting this parameter to 0 will cause all outlines on the worksheet to be hidden. They can be unhidden in Excel by means of the "Show Outline Symbols" command button. The default setting is 1 for visible outlines.
+
+ $worksheet->outline_settings(0);
+
+The C<$symbols_below> parameter is used to control whether the row outline symbol will appear above or below the outline level bar. The default setting is 1 for symbols to appear below the outline level bar.
+
+The C<symbols_right> parameter is used to control whether the column outline symbol will appear to the left or the right of the outline level bar. The default setting is 1 for symbols to appear to the right of the outline level bar.
+
+The C<$auto_style> parameter is used to control whether the automatic outline generator in Excel uses automatic styles when creating an outline. This has no effect on a file generated by C<Spreadsheet::WriteExcel> but it does have an effect on how the worksheet behaves after it is created. The default setting is 0 for "Automatic Styles" to be turned off.
+
+The default settings for all of these parameters correspond to Excel's default parameters.
+
+
+The worksheet parameters controlled by C<outline_settings()> are rarely used.
+
+
+
+
+=head2 freeze_panes($row, $col, $top_row, $left_col)
+
+This method can be used to divide a worksheet into horizontal or vertical regions known as panes and to also "freeze" these panes so that the splitter bars are not visible. This is the same as the C<Window-E<gt>Freeze Panes> menu command in Excel
+
+The parameters C<$row> and C<$col> are used to specify the location of the split. It should be noted that the split is specified at the top or left of a cell and that the method uses zero based indexing. Therefore to freeze the first row of a worksheet it is necessary to specify the split at row 2 (which is 1 as the zero-based index). This might lead you to think that you are using a 1 based index but this is not the case.
+
+You can set one of the C<$row> and C<$col> parameters as zero if you do not want either a vertical or horizontal split.
+
+Examples:
+
+ $worksheet->freeze_panes(1, 0); # Freeze the first row
+ $worksheet->freeze_panes('A2'); # Same using A1 notation
+ $worksheet->freeze_panes(0, 1); # Freeze the first column
+ $worksheet->freeze_panes('B1'); # Same using A1 notation
+ $worksheet->freeze_panes(1, 2); # Freeze first row and first 2 columns
+ $worksheet->freeze_panes('C2'); # Same using A1 notation
+
+The parameters C<$top_row> and C<$left_col> are optional. They are used to specify the top-most or left-most visible row or column in the scrolling region of the panes. For example to freeze the first row and to have the scrolling region begin at row twenty:
+
+ $worksheet->freeze_panes(1, 0, 20, 0);
+
+You cannot use A1 notation for the C<$top_row> and C<$left_col> parameters.
+
+
+See also the C<panes.pl> program in the C<examples> directory of the distribution.
+
+
+
+
+=head2 split_panes($y, $x, $top_row, $left_col)
+
+This method can be used to divide a worksheet into horizontal or vertical regions known as panes. This method is different from the C<freeze_panes()> method in that the splits between the panes will be visible to the user and each pane will have its own scroll bars.
+
+The parameters C<$y> and C<$x> are used to specify the vertical and horizontal position of the split. The units for C<$y> and C<$x> are the same as those used by Excel to specify row height and column width. However, the vertical and horizontal units are different from each other. Therefore you must specify the C<$y> and C<$x> parameters in terms of the row heights and column widths that you have set or the default values which are C<12.75> for a row and C<8.43> for a column.
+
+You can set one of the C<$y> and C<$x> parameters as zero if you do not want either a vertical or horizontal split. The parameters C<$top_row> and C<$left_col> are optional. They are used to specify the top-most or left-most visible row or column in the bottom-right pane.
+
+Example:
+
+ $worksheet->split_panes(12.75, 0, 1, 0); # First row
+ $worksheet->split_panes(0, 8.43, 0, 1); # First column
+ $worksheet->split_panes(12.75, 8.43, 1, 1); # First row and column
+
+You cannot use A1 notation with this method.
+
+See also the C<freeze_panes()> method and the C<panes.pl> program in the C<examples> directory of the distribution.
+
+
+Note: This C<split_panes()> method was called C<thaw_panes()> in older versions. The older name is still available for backwards compatibility.
+
+
+
+
+=head2 merge_range($first_row, $first_col, $last_row, $last_col, $token, $format, $utf_16_be)
+
+Merging cells can be achieved by setting the C<merge> property of a Format object, see L<CELL FORMATTING>. However, this only allows simple Excel5 style horizontal merging which Excel refers to as "center across selection".
+
+The C<merge_range()> method allows you to do Excel97+ style formatting where the cells can contain other types of alignment in addition to the merging:
+
+ my $format = $workbook->add_format(
+ border => 6,
+ valign => 'vcenter',
+ align => 'center',
+ );
+
+ $worksheet->merge_range('B3:D4', 'Vertical and horizontal', $format);
+
+B<WARNING>. The format object that is used with a C<merge_range()> method call is marked internally as being associated with a merged range. It is a fatal error to use a merged format in a non-merged cell. Instead you should use separate formats for merged and non-merged cells. This restriction will be removed in a future release.
+
+The C<$utf_16_be> parameter is optional, see below.
+
+C<merge_range()> writes its C<$token> argument using the worksheet C<write()> method. Therefore it will handle numbers, strings, formulas or urls as required.
+
+Setting the C<merge> property of the format isn't required when you are using C<merge_range()>. In fact using it will exclude the use of any other horizontal alignment option.
+
+On systems with C<perl 5.8> and later the C<merge_range()> method will also handle strings in C<UTF-8> format.
+
+ $worksheet->merge_range('B3:D4', "\x{263a}", $format); # Smiley
+
+On earlier Perl systems your can specify C<UTF-16BE> worksheet names using an additional optional parameter:
+
+ my $str = pack 'n', 0x263a;
+ $worksheet->merge_range('B3:D4', $str, $format, 1); # Smiley
+
+The full possibilities of this method are shown in the C<merge3.pl> to C<merge6.pl> programs in the C<examples> directory of the distribution.
+
+
+
+
+=head2 set_zoom($scale)
+
+Set the worksheet zoom factor in the range C<10 E<lt>= $scale E<lt>= 400>:
+
+ $worksheet1->set_zoom(50);
+ $worksheet2->set_zoom(75);
+ $worksheet3->set_zoom(300);
+ $worksheet4->set_zoom(400);
+
+The default zoom factor is 100. You cannot zoom to "Selection" because it is calculated by Excel at run-time.
+
+Note, C<set_zoom()> does not affect the scale of the printed page. For that you should use C<set_print_scale()>.
+
+
+
+
+=head2 right_to_left()
+
+The C<right_to_left()> method is used to change the default direction of the worksheet from left-to-right, with the A1 cell in the top left, to right-to-left, with the he A1 cell in the top right.
+
+ $worksheet->right_to_left();
+
+This is useful when creating Arabic, Hebrew or other near or far eastern worksheets that use right-to-left as the default direction.
+
+
+
+
+=head2 hide_zero()
+
+The C<hide_zero()> method is used to hide any zero values that appear in cells.
+
+ $worksheet->hide_zero();
+
+In Excel this option is found under Tools->Options->View.
+
+
+
+
+=head2 set_tab_color()
+
+The C<set_tab_color()> method is used to change the colour of the worksheet tab. This feature is only available in Excel 2002 and later. You can use one of the standard colour names provided by the Format object or a colour index. See L<COLOURS IN EXCEL> and the C<set_custom_color()> method.
+
+ $worksheet1->set_tab_color('red');
+ $worksheet2->set_tab_color(0x0C);
+
+See the C<tab_colors.pl> program in the examples directory of the distro.
+
+
+
+
+=head2 autofilter($first_row, $first_col, $last_row, $last_col)
+
+This method allows an autofilter to be added to a worksheet. An autofilter is a way of adding drop down lists to the headers of a 2D range of worksheet data. This is turn allow users to filter the data based on simple criteria so that some data is shown and some is hidden.
+
+To add an autofilter to a worksheet:
+
+ $worksheet->autofilter(0, 0, 10, 3);
+ $worksheet->autofilter('A1:D11'); # Same as above in A1 notation.
+
+Filter conditions can be applied using the C<filter_column()> method.
+
+See the C<autofilter.pl> program in the examples directory of the distro for a more detailed example.
+
+
+
+
+=head2 filter_column($column, $expression)
+
+
+The C<filter_column> method can be used to filter columns in a autofilter range based on simple conditions.
+
+B<NOTE:> It isn't sufficient to just specify the filter condition. You must also hide any rows that don't match the filter condition. Rows are hidden using the C<set_row()> C<visible> parameter. C<Spreadsheet::WriteExcel> cannot do this automatically since it isn't part of the file format. See the C<autofilter.pl> program in the examples directory of the distro for an example.
+
+The conditions for the filter are specified using simple expressions:
+
+ $worksheet->filter_column('A', 'x > 2000');
+ $worksheet->filter_column('B', 'x > 2000 and x < 5000');
+
+The C<$column> parameter can either be a zero indexed column number or a string column name.
+
+The following operators are available:
+
+ Operator Synonyms
+ == = eq =~
+ != <> ne !=
+ >
+ <
+ >=
+ <=
+
+ and &&
+ or ||
+
+The operator synonyms are just syntactic sugar to make you more comfortable using the expressions. It is important to remember that the expressions will be interpreted by Excel and not by perl.
+
+An expression can comprise a single statement or two statements separated by the C<and> and C<or> operators. For example:
+
+ 'x < 2000'
+ 'x > 2000'
+ 'x == 2000'
+ 'x > 2000 and x < 5000'
+ 'x == 2000 or x == 5000'
+
+Filtering of blank or non-blank data can be achieved by using a value of C<Blanks> or C<NonBlanks> in the expression:
+
+ 'x == Blanks'
+ 'x == NonBlanks'
+
+Top 10 style filters can be specified using a expression like the following:
+
+ Top|Bottom 1-500 Items|%
+
+For example:
+
+ 'Top 10 Items'
+ 'Bottom 5 Items'
+ 'Top 25 %'
+ 'Bottom 50 %'
+
+Excel also allows some simple string matching operations:
+
+ 'x =~ b*' # begins with b
+ 'x !~ b*' # doesn't begin with b
+ 'x =~ *b' # ends with b
+ 'x !~ *b' # doesn't end with b
+ 'x =~ *b*' # contains b
+ 'x !~ *b*' # doesn't contains b
+
+You can also use C<*> to match any character or number and C<?> to match any single character or number. No other regular expression quantifier is supported by Excel's filters. Excel's regular expression characters can be escaped using C<~>.
+
+The placeholder variable C<x> in the above examples can be replaced by any simple string. The actual placeholder name is ignored internally so the following are all equivalent:
+
+ 'x < 2000'
+ 'col < 2000'
+ 'Price < 2000'
+
+Also, note that a filter condition can only be applied to a column in a range specified by the C<autofilter()> Worksheet method.
+
+See the C<autofilter.pl> program in the examples directory of the distro for a more detailed example.
+
+
+
+
+=head1 PAGE SET-UP METHODS
+
+Page set-up methods affect the way that a worksheet looks when it is printed. They control features such as page headers and footers and margins. These methods are really just standard worksheet methods. They are documented here in a separate section for the sake of clarity.
+
+The following methods are available for page set-up:
+
+ set_landscape()
+ set_portrait()
+ set_page_view()
+ set_paper()
+ center_horizontally()
+ center_vertically()
+ set_margins()
+ set_header()
+ set_footer()
+ repeat_rows()
+ repeat_columns()
+ hide_gridlines()
+ print_row_col_headers()
+ print_area()
+ print_across()
+ fit_to_pages()
+ set_start_page()
+ set_print_scale()
+ set_h_pagebreaks()
+ set_v_pagebreaks()
+
+
+A common requirement when working with Spreadsheet::WriteExcel is to apply the same page set-up features to all of the worksheets in a workbook. To do this you can use the C<sheets()> method of the C<workbook> class to access the array of worksheets in a workbook:
+
+ foreach $worksheet ($workbook->sheets()) {
+ $worksheet->set_landscape();
+ }
+
+
+
+
+=head2 set_landscape()
+
+This method is used to set the orientation of a worksheet's printed page to landscape:
+
+ $worksheet->set_landscape(); # Landscape mode
+
+
+
+
+=head2 set_portrait()
+
+This method is used to set the orientation of a worksheet's printed page to portrait. The default worksheet orientation is portrait, so you won't generally need to call this method.
+
+ $worksheet->set_portrait(); # Portrait mode
+
+
+
+=head2 set_page_view()
+
+This method is used to display the worksheet in "Page View" mode. This is currently only supported by Mac Excel, where it is the default.
+
+ $worksheet->set_page_view();
+
+
+
+=head2 set_paper($index)
+
+This method is used to set the paper format for the printed output of a worksheet. The following paper styles are available:
+
+ 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
+
+
+Note, it is likely that not all of these paper types will be available to the end user since it will depend on the paper formats that the user's printer supports. Therefore, it is best to stick to standard paper types.
+
+ $worksheet->set_paper(1); # US Letter
+ $worksheet->set_paper(9); # A4
+
+If you do not specify a paper type the worksheet will print using the printer's default paper.
+
+
+
+
+=head2 center_horizontally()
+
+Center the worksheet data horizontally between the margins on the printed page:
+
+ $worksheet->center_horizontally();
+
+
+
+
+=head2 center_vertically()
+
+Center the worksheet data vertically between the margins on the printed page:
+
+ $worksheet->center_vertically();
+
+
+
+
+=head2 set_margins($inches)
+
+There are several methods available for setting the worksheet margins on the printed page:
+
+ set_margins() # Set all margins to the same value
+ set_margins_LR() # Set left and right margins to the same value
+ set_margins_TB() # Set top and bottom margins to the same value
+ set_margin_left(); # Set left margin
+ set_margin_right(); # Set right margin
+ set_margin_top(); # Set top margin
+ set_margin_bottom(); # Set bottom margin
+
+All of these methods take a distance in inches as a parameter. Note: 1 inch = 25.4mm. ;-) The default left and right margin is 0.75 inch. The default top and bottom margin is 1.00 inch.
+
+
+
+=head2 set_header($string, $margin)
+
+Headers and footers are generated using a C<$string> which is a combination of plain text and control characters. The C<$margin> parameter is optional.
+
+The available control character are:
+
+ Control Category Description
+ ======= ======== ===========
+ &L Justification Left
+ &C Center
+ &R Right
+
+ &P Information Page number
+ &N Total number of pages
+ &D Date
+ &T Time
+ &F File name
+ &A Worksheet name
+ &Z Workbook path
+
+ &fontsize Font Font size
+ &"font,style" Font name and style
+ &U Single underline
+ &E Double underline
+ &S Strikethrough
+ &X Superscript
+ &Y Subscript
+
+ && Miscellaneous Literal ampersand &
+
+
+Text in headers and footers can be justified (aligned) to the left, center and right by prefixing the text with the control characters C<&L>, C<&C> and C<&R>.
+
+For example (with ASCII art representation of the results):
+
+ $worksheet->set_header('&LHello');
+
+ ---------------------------------------------------------------
+ | |
+ | Hello |
+ | |
+
+
+ $worksheet->set_header('&CHello');
+
+ ---------------------------------------------------------------
+ | |
+ | Hello |
+ | |
+
+
+ $worksheet->set_header('&RHello');
+
+ ---------------------------------------------------------------
+ | |
+ | Hello |
+ | |
+
+
+For simple text, if you do not specify any justification the text will be centred. However, you must prefix the text with C<&C> if you specify a font name or any other formatting:
+
+ $worksheet->set_header('Hello');
+
+ ---------------------------------------------------------------
+ | |
+ | Hello |
+ | |
+
+
+You can have text in each of the justification regions:
+
+ $worksheet->set_header('&LCiao&CBello&RCielo');
+
+ ---------------------------------------------------------------
+ | |
+ | Ciao Bello Cielo |
+ | |
+
+
+The information control characters act as variables that Excel will update as the workbook or worksheet changes. Times and dates are in the users default format:
+
+ $worksheet->set_header('&CPage &P of &N');
+
+ ---------------------------------------------------------------
+ | |
+ | Page 1 of 6 |
+ | |
+
+
+ $worksheet->set_header('&CUpdated at &T');
+
+ ---------------------------------------------------------------
+ | |
+ | Updated at 12:30 PM |
+ | |
+
+
+
+You can specify the font size of a section of the text by prefixing it with the control character C<&n> where C<n> is the font size:
+
+ $worksheet1->set_header('&C&30Hello Big' );
+ $worksheet2->set_header('&C&10Hello Small');
+
+You can specify the font of a section of the text by prefixing it with the control sequence C<&"font,style"> where C<fontname> is a font name such as "Courier New" or "Times New Roman" and C<style> is one of the standard Windows font descriptions: "Regular", "Italic", "Bold" or "Bold Italic":
+
+ $worksheet1->set_header('&C&"Courier New,Italic"Hello');
+ $worksheet2->set_header('&C&"Courier New,Bold Italic"Hello');
+ $worksheet3->set_header('&C&"Times New Roman,Regular"Hello');
+
+It is possible to combine all of these features together to create sophisticated headers and footers. As an aid to setting up complicated headers and footers you can record a page set-up as a macro in Excel and look at the format strings that VBA produces. Remember however that VBA uses two double quotes C<""> to indicate a single double quote. For the last example above the equivalent VBA code looks like this:
+
+ .LeftHeader = ""
+ .CenterHeader = "&""Times New Roman,Regular""Hello"
+ .RightHeader = ""
+
+
+To include a single literal ampersand C<&> in a header or footer you should use a double ampersand C<&&>:
+
+ $worksheet1->set_header('&CCuriouser && Curiouser - Attorneys at Law');
+
+As stated above the margin parameter is optional. As with the other margins the value should be in inches. The default header and footer margin is 0.50 inch. The header and footer margin size can be set as follows:
+
+ $worksheet->set_header('&CHello', 0.75);
+
+The header and footer margins are independent of the top and bottom margins.
+
+Note, the header or footer string must be less than 255 characters. Strings longer than this will not be written and a warning will be generated.
+
+On systems with C<perl 5.8> and later the C<set_header()> method can also handle Unicode strings in C<UTF-8> format.
+
+ $worksheet->set_header("&C\x{263a}")
+
+
+See, also the C<headers.pl> program in the C<examples> directory of the distribution.
+
+
+
+
+=head2 set_footer()
+
+The syntax of the C<set_footer()> method is the same as C<set_header()>, see above.
+
+
+
+
+=head2 repeat_rows($first_row, $last_row)
+
+Set the number of rows to repeat at the top of each printed page.
+
+For large Excel documents it is often desirable to have the first row or rows of the worksheet print out at the top of each page. This can be achieved by using the C<repeat_rows()> method. The parameters C<$first_row> and C<$last_row> are zero based. The C<$last_row> parameter is optional if you only wish to specify one row:
+
+ $worksheet1->repeat_rows(0); # Repeat the first row
+ $worksheet2->repeat_rows(0, 1); # Repeat the first two rows
+
+
+
+
+=head2 repeat_columns($first_col, $last_col)
+
+Set the columns to repeat at the left hand side of each printed page.
+
+For large Excel documents it is often desirable to have the first column or columns of the worksheet print out at the left hand side of each page. This can be achieved by using the C<repeat_columns()> method. The parameters C<$first_column> and C<$last_column> are zero based. The C<$last_column> parameter is optional if you only wish to specify one column. You can also specify the columns using A1 column notation, see the note about L<Cell notation>.
+
+ $worksheet1->repeat_columns(0); # Repeat the first column
+ $worksheet2->repeat_columns(0, 1); # Repeat the first two columns
+ $worksheet3->repeat_columns('A:A'); # Repeat the first column
+ $worksheet4->repeat_columns('A:B'); # Repeat the first two columns
+
+
+
+
+=head2 hide_gridlines($option)
+
+This method is used to hide the gridlines on the screen and printed page. Gridlines are the lines that divide the cells on a worksheet. Screen and printed gridlines are turned on by default in an Excel worksheet. If you have defined your own cell borders you may wish to hide the default gridlines.
+
+ $worksheet->hide_gridlines();
+
+The following values of C<$option> are valid:
+
+ 0 : Don't hide gridlines
+ 1 : Hide printed gridlines only
+ 2 : Hide screen and printed gridlines
+
+If you don't supply an argument or use C<undef> the default option is 1, i.e. only the printed gridlines are hidden.
+
+
+
+
+=head2 print_row_col_headers()
+
+Set the option to print the row and column headers on the printed page.
+
+An Excel worksheet looks something like the following;
+
+ ------------------------------------------
+ | | A | B | C | D | ...
+ ------------------------------------------
+ | 1 | | | | | ...
+ | 2 | | | | | ...
+ | 3 | | | | | ...
+ | 4 | | | | | ...
+ |...| ... | ... | ... | ... | ...
+
+The headers are the letters and numbers at the top and the left of the worksheet. Since these headers serve mainly as a indication of position on the worksheet they generally do not appear on the printed page. If you wish to have them printed you can use the C<print_row_col_headers()> method :
+
+ $worksheet->print_row_col_headers();
+
+Do not confuse these headers with page headers as described in the C<set_header()> section above.
+
+
+
+
+=head2 print_area($first_row, $first_col, $last_row, $last_col)
+
+This method is used to specify the area of the worksheet that will be printed. All four parameters must be specified. You can also use A1 notation, see the note about L<Cell notation>.
+
+
+ $worksheet1->print_area('A1:H20'); # Cells A1 to H20
+ $worksheet2->print_area(0, 0, 19, 7); # The same
+ $worksheet2->print_area('A:H'); # Columns A to H if rows have data
+
+
+
+
+=head2 print_across()
+
+The C<print_across> method is used to change the default print direction. This is referred to by Excel as the sheet "page order".
+
+ $worksheet->print_across();
+
+The default page order is shown below for a worksheet that extends over 4 pages. The order is called "down then across":
+
+ [1] [3]
+ [2] [4]
+
+However, by using the C<print_across> method the print order will be changed to "across then down":
+
+ [1] [2]
+ [3] [4]
+
+
+
+
+=head2 fit_to_pages($width, $height)
+
+The C<fit_to_pages()> method is used to fit the printed area to a specific number of pages both vertically and horizontally. If the printed area exceeds the specified number of pages it will be scaled down to fit. This guarantees that the printed area will always appear on the specified number of pages even if the page size or margins change.
+
+ $worksheet1->fit_to_pages(1, 1); # Fit to 1x1 pages
+ $worksheet2->fit_to_pages(2, 1); # Fit to 2x1 pages
+ $worksheet3->fit_to_pages(1, 2); # Fit to 1x2 pages
+
+The print area can be defined using the C<print_area()> method as described above.
+
+A common requirement is to fit the printed output to I<n> pages wide but have the height be as long as necessary. To achieve this set the C<$height> to zero or leave it blank:
+
+ $worksheet1->fit_to_pages(1, 0); # 1 page wide and as long as necessary
+ $worksheet2->fit_to_pages(1); # The same
+
+
+Note that although it is valid to use both C<fit_to_pages()> and C<set_print_scale()> on the same worksheet only one of these options can be active at a time. The last method call made will set the active option.
+
+Note that C<fit_to_pages()> will override any manual page breaks that are defined in the worksheet.
+
+
+
+
+=head2 set_start_page($start_page)
+
+The C<set_start_page()> method is used to set the number of the starting page when the worksheet is printed out. The default value is 1.
+
+ $worksheet->set_start_page(2);
+
+
+
+
+=head2 set_print_scale($scale)
+
+Set the scale factor of the printed page. Scale factors in the range C<10 E<lt>= $scale E<lt>= 400> are valid:
+
+ $worksheet1->set_print_scale(50);
+ $worksheet2->set_print_scale(75);
+ $worksheet3->set_print_scale(300);
+ $worksheet4->set_print_scale(400);
+
+The default scale factor is 100. Note, C<set_print_scale()> does not affect the scale of the visible page in Excel. For that you should use C<set_zoom()>.
+
+Note also that although it is valid to use both C<fit_to_pages()> and C<set_print_scale()> on the same worksheet only one of these options can be active at a time. The last method call made will set the active option.
+
+
+
+
+=head2 set_h_pagebreaks(@breaks)
+
+Add horizontal page breaks to a worksheet. A page break causes all the data that follows it to be printed on the next page. Horizontal page breaks act between rows. To create a page break between rows 20 and 21 you must specify the break at row 21. However in zero index notation this is actually row 20. So you can pretend for a small while that you are using 1 index notation:
+
+ $worksheet1->set_h_pagebreaks(20); # Break between row 20 and 21
+
+The C<set_h_pagebreaks()> method will accept a list of page breaks and you can call it more than once:
+
+ $worksheet2->set_h_pagebreaks( 20, 40, 60, 80, 100); # Add breaks
+ $worksheet2->set_h_pagebreaks(120, 140, 160, 180, 200); # Add some more
+
+Note: If you specify the "fit to page" option via the C<fit_to_pages()> method it will override all manual page breaks.
+
+There is a silent limitation of about 1000 horizontal page breaks per worksheet in line with an Excel internal limitation.
+
+
+
+
+=head2 set_v_pagebreaks(@breaks)
+
+Add vertical page breaks to a worksheet. A page break causes all the data that follows it to be printed on the next page. Vertical page breaks act between columns. To create a page break between columns 20 and 21 you must specify the break at column 21. However in zero index notation this is actually column 20. So you can pretend for a small while that you are using 1 index notation:
+
+ $worksheet1->set_v_pagebreaks(20); # Break between column 20 and 21
+
+The C<set_v_pagebreaks()> method will accept a list of page breaks and you can call it more than once:
+
+ $worksheet2->set_v_pagebreaks( 20, 40, 60, 80, 100); # Add breaks
+ $worksheet2->set_v_pagebreaks(120, 140, 160, 180, 200); # Add some more
+
+Note: If you specify the "fit to page" option via the C<fit_to_pages()> method it will override all manual page breaks.
+
+
+
+
+=head1 CELL FORMATTING
+
+This section describes the methods and properties that are available for formatting cells in Excel. The properties of a cell that can be formatted include: fonts, colours, patterns, borders, alignment and number formatting.
+
+
+=head2 Creating and using a Format object
+
+Cell formatting is defined through a Format object. Format objects are created by calling the workbook C<add_format()> method as follows:
+
+ my $format1 = $workbook->add_format(); # Set properties later
+ my $format2 = $workbook->add_format(%props); # Set at creation
+
+The format object holds all the formatting properties that can be applied to a cell, a row or a column. The process of setting these properties is discussed in the next section.
+
+Once a Format object has been constructed and it properties have been set it can be passed as an argument to the worksheet C<write> methods as follows:
+
+ $worksheet->write(0, 0, 'One', $format);
+ $worksheet->write_string(1, 0, 'Two', $format);
+ $worksheet->write_number(2, 0, 3, $format);
+ $worksheet->write_blank(3, 0, $format);
+
+Formats can also be passed to the worksheet C<set_row()> and C<set_column()> methods to define the default property for a row or column.
+
+ $worksheet->set_row(0, 15, $format);
+ $worksheet->set_column(0, 0, 15, $format);
+
+
+
+
+=head2 Format methods and Format properties
+
+The following table shows the Excel format categories, the formatting properties that can be applied and the equivalent object method:
+
+
+ Category Description Property Method Name
+ -------- ----------- -------- -----------
+ Font Font type font set_font()
+ Font size size set_size()
+ Font color color set_color()
+ Bold bold set_bold()
+ Italic italic set_italic()
+ Underline underline set_underline()
+ Strikeout font_strikeout set_font_strikeout()
+ Super/Subscript font_script set_font_script()
+ Outline font_outline set_font_outline()
+ Shadow font_shadow set_font_shadow()
+
+ Number Numeric format num_format set_num_format()
+
+ Protection Lock cells locked set_locked()
+ Hide formulas hidden set_hidden()
+
+ Alignment Horizontal align align set_align()
+ Vertical align valign set_align()
+ Rotation rotation set_rotation()
+ Text wrap text_wrap set_text_wrap()
+ Justify last text_justlast set_text_justlast()
+ Center across center_across set_center_across()
+ Indentation indent set_indent()
+ Shrink to fit shrink set_shrink()
+
+ Pattern Cell pattern pattern set_pattern()
+ Background color bg_color set_bg_color()
+ Foreground color fg_color set_fg_color()
+
+ Border Cell border border set_border()
+ Bottom border bottom set_bottom()
+ Top border top set_top()
+ Left border left set_left()
+ Right border right set_right()
+ Border color border_color set_border_color()
+ Bottom color bottom_color set_bottom_color()
+ Top color top_color set_top_color()
+ Left color left_color set_left_color()
+ Right color right_color set_right_color()
+
+There are two ways of setting Format properties: by using the object method interface or by setting the property directly. For example, a typical use of the method interface would be as follows:
+
+ my $format = $workbook->add_format();
+ $format->set_bold();
+ $format->set_color('red');
+
+By comparison the properties can be set directly by passing a hash of properties to the Format constructor:
+
+ my $format = $workbook->add_format(bold => 1, color => 'red');
+
+or after the Format has been constructed by means of the C<set_format_properties()> method as follows:
+
+ my $format = $workbook->add_format();
+ $format->set_format_properties(bold => 1, color => 'red');
+
+You can also store the properties in one or more named hashes and pass them to the required method:
+
+ my %font = (
+ font => 'Arial',
+ size => 12,
+ color => 'blue',
+ bold => 1,
+ );
+
+ my %shading = (
+ bg_color => 'green',
+ pattern => 1,
+ );
+
+
+ my $format1 = $workbook->add_format(%font); # Font only
+ my $format2 = $workbook->add_format(%font, %shading); # Font and shading
+
+
+The provision of two ways of setting properties might lead you to wonder which is the best way. The method mechanism may be better is you prefer setting properties via method calls (which the author did when they were code was first written) otherwise passing properties to the constructor has proved to be a little more flexible and self documenting in practice. An additional advantage of working with property hashes is that it allows you to share formatting between workbook objects as shown in the example above.
+
+The Perl/Tk style of adding properties is also supported:
+
+ my %font = (
+ -font => 'Arial',
+ -size => 12,
+ -color => 'blue',
+ -bold => 1,
+ );
+
+
+
+
+=head2 Working with formats
+
+The default format is Arial 10 with all other properties off.
+
+Each unique format in Spreadsheet::WriteExcel must have a corresponding Format object. It isn't possible to use a Format with a write() method and then redefine the Format for use at a later stage. This is because a Format is applied to a cell not in its current state but in its final state. Consider the following example:
+
+ my $format = $workbook->add_format();
+ $format->set_bold();
+ $format->set_color('red');
+ $worksheet->write('A1', 'Cell A1', $format);
+ $format->set_color('green');
+ $worksheet->write('B1', 'Cell B1', $format);
+
+Cell A1 is assigned the Format C<$format> which is initially set to the colour red. However, the colour is subsequently set to green. When Excel displays Cell A1 it will display the final state of the Format which in this case will be the colour green.
+
+In general a method call without an argument will turn a property on, for example:
+
+ my $format1 = $workbook->add_format();
+ $format1->set_bold(); # Turns bold on
+ $format1->set_bold(1); # Also turns bold on
+ $format1->set_bold(0); # Turns bold off
+
+
+
+
+=head1 FORMAT METHODS
+
+The Format object methods are described in more detail in the following sections. In addition, there is a Perl program called C<formats.pl> in the C<examples> directory of the WriteExcel distribution. This program creates an Excel workbook called C<formats.xls> which contains examples of almost all the format types.
+
+The following Format methods are available:
+
+ set_font()
+ set_size()
+ set_color()
+ set_bold()
+ set_italic()
+ set_underline()
+ set_font_strikeout()
+ set_font_script()
+ set_font_outline()
+ set_font_shadow()
+ set_num_format()
+ set_locked()
+ set_hidden()
+ set_align()
+ set_rotation()
+ set_text_wrap()
+ set_text_justlast()
+ set_center_across()
+ set_indent()
+ set_shrink()
+ set_pattern()
+ set_bg_color()
+ set_fg_color()
+ set_border()
+ set_bottom()
+ set_top()
+ set_left()
+ set_right()
+ set_border_color()
+ set_bottom_color()
+ set_top_color()
+ set_left_color()
+ set_right_color()
+
+
+The above methods can also be applied directly as properties. For example C<< $format->set_bold() >> is equivalent to C<< $workbook->add_format(bold => 1) >>.
+
+
+=head2 set_format_properties(%properties)
+
+The properties of an existing Format object can be also be set by means of C<set_format_properties()>:
+
+ my $format = $workbook->add_format();
+ $format->set_format_properties(bold => 1, color => 'red');
+
+However, this method is here mainly for legacy reasons. It is preferable to set the properties in the format constructor:
+
+ my $format = $workbook->add_format(bold => 1, color => 'red');
+
+
+=head2 set_font($fontname)
+
+ Default state: Font is Arial
+ Default action: None
+ Valid args: Any valid font name
+
+Specify the font used:
+
+ $format->set_font('Times New Roman');
+
+Excel can only display fonts that are installed on the system that it is running on. Therefore it is best to use the fonts that come as standard such as 'Arial', 'Times New Roman' and 'Courier New'. See also the Fonts worksheet created by formats.pl
+
+
+
+
+=head2 set_size()
+
+ Default state: Font size is 10
+ Default action: Set font size to 1
+ Valid args: Integer values from 1 to as big as your screen.
+
+
+Set the font size. Excel adjusts the height of a row to accommodate the largest font size in the row. You can also explicitly specify the height of a row using the set_row() worksheet method.
+
+ my $format = $workbook->add_format();
+ $format->set_size(30);
+
+
+
+
+
+=head2 set_color()
+
+ Default state: Excels default color, usually black
+ Default action: Set the default color
+ Valid args: Integers from 8..63 or the following strings:
+ 'black'
+ 'blue'
+ 'brown'
+ 'cyan'
+ 'gray'
+ 'green'
+ 'lime'
+ 'magenta'
+ 'navy'
+ 'orange'
+ 'pink'
+ 'purple'
+ 'red'
+ 'silver'
+ 'white'
+ 'yellow'
+
+Set the font colour. The C<set_color()> method is used as follows:
+
+ my $format = $workbook->add_format();
+ $format->set_color('red');
+ $worksheet->write(0, 0, 'wheelbarrow', $format);
+
+Note: The C<set_color()> method is used to set the colour of the font in a cell. To set the colour of a cell use the C<set_bg_color()> and C<set_pattern()> methods.
+
+For additional examples see the 'Named colors' and 'Standard colors' worksheets created by formats.pl in the examples directory.
+
+See also L<COLOURS IN EXCEL>.
+
+
+
+
+=head2 set_bold()
+
+ Default state: bold is off
+ Default action: Turn bold on
+ Valid args: 0, 1 [1]
+
+Set the bold property of the font:
+
+ $format->set_bold(); # Turn bold on
+
+[1] Actually, values in the range 100..1000 are also valid. 400 is normal, 700 is bold and 1000 is very bold indeed. It is probably best to set the value to 1 and use normal bold.
+
+
+
+
+=head2 set_italic()
+
+ Default state: Italic is off
+ Default action: Turn italic on
+ Valid args: 0, 1
+
+Set the italic property of the font:
+
+ $format->set_italic(); # Turn italic on
+
+
+
+
+=head2 set_underline()
+
+ Default state: Underline is off
+ Default action: Turn on single underline
+ Valid args: 0 = No underline
+ 1 = Single underline
+ 2 = Double underline
+ 33 = Single accounting underline
+ 34 = Double accounting underline
+
+Set the underline property of the font.
+
+ $format->set_underline(); # Single underline
+
+
+
+
+=head2 set_font_strikeout()
+
+ Default state: Strikeout is off
+ Default action: Turn strikeout on
+ Valid args: 0, 1
+
+Set the strikeout property of the font.
+
+
+
+
+=head2 set_font_script()
+
+ Default state: Super/Subscript is off
+ Default action: Turn Superscript on
+ Valid args: 0 = Normal
+ 1 = Superscript
+ 2 = Subscript
+
+Set the superscript/subscript property of the font. This format is currently not very useful.
+
+
+
+
+=head2 set_font_outline()
+
+ Default state: Outline is off
+ Default action: Turn outline on
+ Valid args: 0, 1
+
+Macintosh only.
+
+
+
+
+=head2 set_font_shadow()
+
+ Default state: Shadow is off
+ Default action: Turn shadow on
+ Valid args: 0, 1
+
+Macintosh only.
+
+
+
+
+=head2 set_num_format()
+
+ Default state: General format
+ Default action: Format index 1
+ Valid args: See the following table
+
+This method is used to define the numerical format of a number in Excel. It controls whether a number is displayed as an integer, a floating point number, a date, a currency value or some other user defined format.
+
+The numerical format of a cell can be specified by using a format string or an index to one of Excel's built-in formats:
+
+ my $format1 = $workbook->add_format();
+ my $format2 = $workbook->add_format();
+ $format1->set_num_format('d mmm yyyy'); # Format string
+ $format2->set_num_format(0x0f); # Format index
+
+ $worksheet->write(0, 0, 36892.521, $format1); # 1 Jan 2001
+ $worksheet->write(0, 0, 36892.521, $format2); # 1-Jan-01
+
+
+Using format strings you can define very sophisticated formatting of numbers.
+
+ $format01->set_num_format('0.000');
+ $worksheet->write(0, 0, 3.1415926, $format01); # 3.142
+
+ $format02->set_num_format('#,##0');
+ $worksheet->write(1, 0, 1234.56, $format02); # 1,235
+
+ $format03->set_num_format('#,##0.00');
+ $worksheet->write(2, 0, 1234.56, $format03); # 1,234.56
+
+ $format04->set_num_format('$0.00');
+ $worksheet->write(3, 0, 49.99, $format04); # $49.99
+
+ # Note you can use other currency symbols such as the pound or yen as well.
+ # Other currencies may require the use of Unicode.
+
+ $format07->set_num_format('mm/dd/yy');
+ $worksheet->write(6, 0, 36892.521, $format07); # 01/01/01
+
+ $format08->set_num_format('mmm d yyyy');
+ $worksheet->write(7, 0, 36892.521, $format08); # Jan 1 2001
+
+ $format09->set_num_format('d mmmm yyyy');
+ $worksheet->write(8, 0, 36892.521, $format09); # 1 January 2001
+
+ $format10->set_num_format('dd/mm/yyyy hh:mm AM/PM');
+ $worksheet->write(9, 0, 36892.521, $format10); # 01/01/2001 12:30 AM
+
+ $format11->set_num_format('0 "dollar and" .00 "cents"');
+ $worksheet->write(10, 0, 1.87, $format11); # 1 dollar and .87 cents
+
+ # Conditional formatting
+ $format12->set_num_format('[Green]General;[Red]-General;General');
+ $worksheet->write(11, 0, 123, $format12); # > 0 Green
+ $worksheet->write(12, 0, -45, $format12); # < 0 Red
+ $worksheet->write(13, 0, 0, $format12); # = 0 Default colour
+
+ # Zip code
+ $format13->set_num_format('00000');
+ $worksheet->write(14, 0, '01209', $format13);
+
+
+The number system used for dates is described in L<DATES AND TIME IN EXCEL>.
+
+The colour format should have one of the following values:
+
+ [Black] [Blue] [Cyan] [Green] [Magenta] [Red] [White] [Yellow]
+
+Alternatively you can specify the colour based on a colour index as follows: C<[Color n]>, where n is a standard Excel colour index - 7. See the 'Standard colors' worksheet created by formats.pl.
+
+For more information refer to the documentation on formatting in the C<docs> directory of the Spreadsheet::WriteExcel distro, the Excel on-line help or L<http://office.microsoft.com/en-gb/assistance/HP051995001033.aspx>.
+
+You should ensure that the format string is valid in Excel prior to using it in WriteExcel.
+
+Excel's built-in formats are shown in the following table:
+
+ Index Index Format String
+ 0 0x00 General
+ 1 0x01 0
+ 2 0x02 0.00
+ 3 0x03 #,##0
+ 4 0x04 #,##0.00
+ 5 0x05 ($#,##0_);($#,##0)
+ 6 0x06 ($#,##0_);[Red]($#,##0)
+ 7 0x07 ($#,##0.00_);($#,##0.00)
+ 8 0x08 ($#,##0.00_);[Red]($#,##0.00)
+ 9 0x09 0%
+ 10 0x0a 0.00%
+ 11 0x0b 0.00E+00
+ 12 0x0c # ?/?
+ 13 0x0d # ??/??
+ 14 0x0e m/d/yy
+ 15 0x0f d-mmm-yy
+ 16 0x10 d-mmm
+ 17 0x11 mmm-yy
+ 18 0x12 h:mm AM/PM
+ 19 0x13 h:mm:ss AM/PM
+ 20 0x14 h:mm
+ 21 0x15 h:mm:ss
+ 22 0x16 m/d/yy h:mm
+ .. .... ...........
+ 37 0x25 (#,##0_);(#,##0)
+ 38 0x26 (#,##0_);[Red](#,##0)
+ 39 0x27 (#,##0.00_);(#,##0.00)
+ 40 0x28 (#,##0.00_);[Red](#,##0.00)
+ 41 0x29 _(* #,##0_);_(* (#,##0);_(* "-"_);_(@_)
+ 42 0x2a _($* #,##0_);_($* (#,##0);_($* "-"_);_(@_)
+ 43 0x2b _(* #,##0.00_);_(* (#,##0.00);_(* "-"??_);_(@_)
+ 44 0x2c _($* #,##0.00_);_($* (#,##0.00);_($* "-"??_);_(@_)
+ 45 0x2d mm:ss
+ 46 0x2e [h]:mm:ss
+ 47 0x2f mm:ss.0
+ 48 0x30 ##0.0E+0
+ 49 0x31 @
+
+
+For examples of these formatting codes see the 'Numerical formats' worksheet created by formats.pl. See also the number_formats1.html and the number_formats2.html documents in the C<docs> directory of the distro.
+
+Note 1. Numeric formats 23 to 36 are not documented by Microsoft and may differ in international versions.
+
+Note 2. In Excel 5 the dollar sign appears as a dollar sign. In Excel 97-2000 it appears as the defined local currency symbol.
+
+Note 3. The red negative numeric formats display slightly differently in Excel 5 and Excel 97-2000.
+
+
+
+
+=head2 set_locked()
+
+ Default state: Cell locking is on
+ Default action: Turn locking on
+ Valid args: 0, 1
+
+This property can be used to prevent modification of a cells contents. Following Excel's convention, cell locking is turned on by default. However, it only has an effect if the worksheet has been protected, see the worksheet C<protect()> method.
+
+ my $locked = $workbook->add_format();
+ $locked->set_locked(1); # A non-op
+
+ my $unlocked = $workbook->add_format();
+ $locked->set_locked(0);
+
+ # Enable worksheet protection
+ $worksheet->protect();
+
+ # This cell cannot be edited.
+ $worksheet->write('A1', '=1+2', $locked);
+
+ # This cell can be edited.
+ $worksheet->write('A2', '=1+2', $unlocked);
+
+Note: This offers weak protection even with a password, see the note in relation to the C<protect()> method.
+
+
+
+
+=head2 set_hidden()
+
+ Default state: Formula hiding is off
+ Default action: Turn hiding on
+ Valid args: 0, 1
+
+This property is used to hide a formula while still displaying its result. This is generally used to hide complex calculations from end users who are only interested in the result. It only has an effect if the worksheet has been protected, see the worksheet C<protect()> method.
+
+ my $hidden = $workbook->add_format();
+ $hidden->set_hidden();
+
+ # Enable worksheet protection
+ $worksheet->protect();
+
+ # The formula in this cell isn't visible
+ $worksheet->write('A1', '=1+2', $hidden);
+
+
+Note: This offers weak protection even with a password, see the note in relation to the C<protect()> method.
+
+
+
+
+=head2 set_align()
+
+ Default state: Alignment is off
+ Default action: Left alignment
+ Valid args: 'left' Horizontal
+ 'center'
+ 'right'
+ 'fill'
+ 'justify'
+ 'center_across'
+
+ 'top' Vertical
+ 'vcenter'
+ 'bottom'
+ 'vjustify'
+
+This method is used to set the horizontal and vertical text alignment within a cell. Vertical and horizontal alignments can be combined. The method is used as follows:
+
+ my $format = $workbook->add_format();
+ $format->set_align('center');
+ $format->set_align('vcenter');
+ $worksheet->set_row(0, 30);
+ $worksheet->write(0, 0, 'X', $format);
+
+Text can be aligned across two or more adjacent cells using the C<center_across> property. However, for genuine merged cells it is better to use the C<merge_range()> worksheet method.
+
+The C<vjustify> (vertical justify) option can be used to provide automatic text wrapping in a cell. The height of the cell will be adjusted to accommodate the wrapped text. To specify where the text wraps use the C<set_text_wrap()> method.
+
+
+For further examples see the 'Alignment' worksheet created by formats.pl.
+
+
+
+
+=head2 set_center_across()
+
+ Default state: Center across selection is off
+ Default action: Turn center across on
+ Valid args: 1
+
+Text can be aligned across two or more adjacent cells using the C<set_center_across()> method. This is an alias for the C<set_align('center_across')> method call.
+
+Only one cell should contain the text, the other cells should be blank:
+
+ my $format = $workbook->add_format();
+ $format->set_center_across();
+
+ $worksheet->write(1, 1, 'Center across selection', $format);
+ $worksheet->write_blank(1, 2, $format);
+
+See also the C<merge1.pl> to C<merge6.pl> programs in the C<examples> directory and the C<merge_range()> method.
+
+
+
+=head2 set_text_wrap()
+
+ Default state: Text wrap is off
+ Default action: Turn text wrap on
+ Valid args: 0, 1
+
+
+Here is an example using the text wrap property, the escape character C<\n> is used to indicate the end of line:
+
+ my $format = $workbook->add_format();
+ $format->set_text_wrap();
+ $worksheet->write(0, 0, "It's\na bum\nwrap", $format);
+
+Excel will adjust the height of the row to accommodate the wrapped text. A similar effect can be obtained without newlines using the C<set_align('vjustify')> method. See the C<textwrap.pl> program in the C<examples> directory.
+
+
+
+
+=head2 set_rotation()
+
+ Default state: Text rotation is off
+ Default action: None
+ Valid args: Integers in the range -90 to 90 and 270
+
+Set the rotation of the text in a cell. The rotation can be any angle in the range -90 to 90 degrees.
+
+ my $format = $workbook->add_format();
+ $format->set_rotation(30);
+ $worksheet->write(0, 0, 'This text is rotated', $format);
+
+
+The angle 270 is also supported. This indicates text where the letters run from top to bottom.
+
+
+
+=head2 set_indent()
+
+
+ Default state: Text indentation is off
+ Default action: Indent text 1 level
+ Valid args: Positive integers
+
+
+This method can be used to indent text. The argument, which should be an integer, is taken as the level of indentation:
+
+
+ my $format = $workbook->add_format();
+ $format->set_indent(2);
+ $worksheet->write(0, 0, 'This text is indented', $format);
+
+
+Indentation is a horizontal alignment property. It will override any other horizontal properties but it can be used in conjunction with vertical properties.
+
+
+
+
+=head2 set_shrink()
+
+
+ Default state: Text shrinking is off
+ Default action: Turn "shrink to fit" on
+ Valid args: 1
+
+
+This method can be used to shrink text so that it fits in a cell.
+
+
+ my $format = $workbook->add_format();
+ $format->set_shrink();
+ $worksheet->write(0, 0, 'Honey, I shrunk the text!', $format);
+
+
+
+
+=head2 set_text_justlast()
+
+ Default state: Justify last is off
+ Default action: Turn justify last on
+ Valid args: 0, 1
+
+
+Only applies to Far Eastern versions of Excel.
+
+
+
+
+=head2 set_pattern()
+
+ Default state: Pattern is off
+ Default action: Solid fill is on
+ Valid args: 0 .. 18
+
+Set the background pattern of a cell.
+
+Examples of the available patterns are shown in the 'Patterns' worksheet created by formats.pl. However, it is unlikely that you will ever need anything other than Pattern 1 which is a solid fill of the background color.
+
+
+
+
+=head2 set_bg_color()
+
+ Default state: Color is off
+ Default action: Solid fill.
+ Valid args: See set_color()
+
+The C<set_bg_color()> method can be used to set the background colour of a pattern. Patterns are defined via the C<set_pattern()> method. If a pattern hasn't been defined then a solid fill pattern is used as the default.
+
+Here is an example of how to set up a solid fill in a cell:
+
+ my $format = $workbook->add_format();
+
+ $format->set_pattern(); # This is optional when using a solid fill
+
+ $format->set_bg_color('green');
+ $worksheet->write('A1', 'Ray', $format);
+
+For further examples see the 'Patterns' worksheet created by formats.pl.
+
+
+
+
+=head2 set_fg_color()
+
+ Default state: Color is off
+ Default action: Solid fill.
+ Valid args: See set_color()
+
+
+The C<set_fg_color()> method can be used to set the foreground colour of a pattern.
+
+For further examples see the 'Patterns' worksheet created by formats.pl.
+
+
+
+
+=head2 set_border()
+
+ Also applies to: set_bottom()
+ set_top()
+ set_left()
+ set_right()
+
+ Default state: Border is off
+ Default action: Set border type 1
+ Valid args: 0-13, See below.
+
+A cell border is comprised of a border on the bottom, top, left and right. These can be set to the same value using C<set_border()> or individually using the relevant method calls shown above.
+
+The following shows the border styles sorted by Spreadsheet::WriteExcel index number:
+
+ Index Name Weight Style
+ ===== ============= ====== ===========
+ 0 None 0
+ 1 Continuous 1 -----------
+ 2 Continuous 2 -----------
+ 3 Dash 1 - - - - - -
+ 4 Dot 1 . . . . . .
+ 5 Continuous 3 -----------
+ 6 Double 3 ===========
+ 7 Continuous 0 -----------
+ 8 Dash 2 - - - - - -
+ 9 Dash Dot 1 - . - . - .
+ 10 Dash Dot 2 - . - . - .
+ 11 Dash Dot Dot 1 - . . - . .
+ 12 Dash Dot Dot 2 - . . - . .
+ 13 SlantDash Dot 2 / - . / - .
+
+
+The following shows the borders sorted by style:
+
+ Name Weight Style Index
+ ============= ====== =========== =====
+ Continuous 0 ----------- 7
+ Continuous 1 ----------- 1
+ Continuous 2 ----------- 2
+ Continuous 3 ----------- 5
+ Dash 1 - - - - - - 3
+ Dash 2 - - - - - - 8
+ Dash Dot 1 - . - . - . 9
+ Dash Dot 2 - . - . - . 10
+ Dash Dot Dot 1 - . . - . . 11
+ Dash Dot Dot 2 - . . - . . 12
+ Dot 1 . . . . . . 4
+ Double 3 =========== 6
+ None 0 0
+ SlantDash Dot 2 / - . / - . 13
+
+
+The following shows the borders in the order shown in the Excel Dialog.
+
+ Index Style Index Style
+ ===== ===== ===== =====
+ 0 None 12 - . . - . .
+ 7 ----------- 13 / - . / - .
+ 4 . . . . . . 10 - . - . - .
+ 11 - . . - . . 8 - - - - - -
+ 9 - . - . - . 2 -----------
+ 3 - - - - - - 5 -----------
+ 1 ----------- 6 ===========
+
+
+Examples of the available border styles are shown in the 'Borders' worksheet created by formats.pl.
+
+
+
+
+=head2 set_border_color()
+
+ Also applies to: set_bottom_color()
+ set_top_color()
+ set_left_color()
+ set_right_color()
+
+ Default state: Color is off
+ Default action: Undefined
+ Valid args: See set_color()
+
+
+Set the colour of the cell borders. A cell border is comprised of a border on the bottom, top, left and right. These can be set to the same colour using C<set_border_color()> or individually using the relevant method calls shown above. Examples of the border styles and colours are shown in the 'Borders' worksheet created by formats.pl.
+
+
+
+
+
+=head2 copy($format)
+
+
+This method is used to copy all of the properties from one Format object to another:
+
+ my $lorry1 = $workbook->add_format();
+ $lorry1->set_bold();
+ $lorry1->set_italic();
+ $lorry1->set_color('red'); # lorry1 is bold, italic and red
+
+ my $lorry2 = $workbook->add_format();
+ $lorry2->copy($lorry1);
+ $lorry2->set_color('yellow'); # lorry2 is bold, italic and yellow
+
+The C<copy()> method is only useful if you are using the method interface to Format properties. It generally isn't required if you are setting Format properties directly using hashes.
+
+
+Note: this is not a copy constructor, both objects must exist prior to copying.
+
+
+
+
+=head1 UNICODE IN EXCEL
+
+The following is a brief introduction to handling Unicode in C<Spreadsheet::WriteExcel>.
+
+I<For a more general introduction to Unicode handling in Perl see> L<perlunitut> and L<perluniintro>.
+
+When using Spreadsheet::WriteExcel the best and easiest way to write unicode strings to an Excel file is to use C<UTF-8> encoded strings and perl 5.8 (or later). Spreadsheet::WriteExcel also allows you to write unicode strings using older perls but it generally requires more work, as explained below.
+
+Internally, Excel encodes unicode data as C<UTF-16LE> (where LE means little-endian). If you are using perl 5.8+ then Spreadsheet::WriteExcel will convert C<UTF-8> strings to C<UTF-16LE> when required. No further intervention is required from the programmer, for example:
+
+ # perl 5.8+ example:
+ my $smiley = "\x{263A}";
+
+ $worksheet->write('A1', 'Hello world'); # ASCII
+ $worksheet->write('A2', $smiley); # UTF-8
+
+Spreadsheet::WriteExcel also lets you write unicode data as C<UTF-16>. Since the majority of CPAN modules default to C<UTF-16BE> (big-endian) Spreadsheet::WriteExcel also uses C<UTF-16BE> and converts it internally to C<UTF-16LE>:
+
+ # perl 5.005 example:
+ my $smiley = pack 'n', 0x263A;
+
+ $worksheet->write ('A3', 'Hello world'); # ASCII
+ $worksheet->write_utf16be_string('A4', $smiley); # UTF-16
+
+Although the above examples look similar there is an important difference. With C<uft8> and perl 5.8+ Spreadsheet::WriteExcel treats C<UTF-8> strings in exactly the same way as any other string. However, with C<UTF16> data we need to distinguish it from other strings either by calling a separate function or by passing an additional flag to indicate the data type.
+
+If you are dealing with non-ASCII characters that aren't in C<UTF-8> then perl 5.8+ provides useful tools in the guise of the C<Encode> module to help you to convert to the required format. For example:
+
+ use Encode 'decode';
+
+ my $string = 'some string with koi8-r characters';
+ $string = decode('koi8-r', $string); # koi8-r to utf8
+
+Alternatively you can read data from an encoded file and convert it to C<UTF-8> as you read it in:
+
+
+ my $file = 'unicode_koi8r.txt';
+ open FH, '<:encoding(koi8-r)', $file or die "Couldn't open $file: $!\n";
+
+ my $row = 0;
+ while (<FH>) {
+ # Data read in is now in utf8 format.
+ chomp;
+ $worksheet->write($row++, 0, $_);
+ }
+
+These methodologies are explained in more detail in L<perlunitut>, L<perluniintro> and L<perlunicode>.
+
+See also the C<unicode_*.pl> programs in the examples directory of the distro.
+
+
+
+
+=head1 COLOURS IN EXCEL
+
+Excel provides a colour palette of 56 colours. In Spreadsheet::WriteExcel these colours are accessed via their palette index in the range 8..63. This index is used to set the colour of fonts, cell patterns and cell borders. For example:
+
+ my $format = $workbook->add_format(
+ color => 12, # index for blue
+ font => 'Arial',
+ size => 12,
+ bold => 1,
+ );
+
+The most commonly used colours can also be accessed by name. The name acts as a simple alias for the colour index:
+
+ black => 8
+ blue => 12
+ brown => 16
+ cyan => 15
+ gray => 23
+ green => 17
+ lime => 11
+ magenta => 14
+ navy => 18
+ orange => 53
+ pink => 33
+ purple => 20
+ red => 10
+ silver => 22
+ white => 9
+ yellow => 13
+
+For example:
+
+ my $font = $workbook->add_format(color => 'red');
+
+Users of VBA in Excel should note that the equivalent colour indices are in the range 1..56 instead of 8..63.
+
+If the default palette does not provide a required colour you can override one of the built-in values. This is achieved by using the C<set_custom_color()> workbook method to adjust the RGB (red green blue) components of the colour:
+
+ my $ferrari = $workbook->set_custom_color(40, 216, 12, 12);
+
+ my $format = $workbook->add_format(
+ bg_color => $ferrari,
+ pattern => 1,
+ border => 1
+ );
+
+ $worksheet->write_blank('A1', $format);
+
+The default Excel colour palette is shown in C<palette.html> in the C<docs> directory of the distro. You can generate an Excel version of the palette using C<colors.pl> in the C<examples> directory.
+
+
+
+
+=head1 DATES AND TIME IN EXCEL
+
+There are two important things to understand about dates and times in Excel:
+
+=over 4
+
+=item 1 A date/time in Excel is a real number plus an Excel number format.
+
+=item 2 Spreadsheet::WriteExcel doesn't automatically convert date/time strings in C<write()> to an Excel date/time.
+
+=back
+
+These two points are explained in more detail below along with some suggestions on how to convert times and dates to the required format.
+
+
+=head2 An Excel date/time is a number plus a format
+
+If you write a date string with C<write()> then all you will get is a string:
+
+ $worksheet->write('A1', '02/03/04'); # !! Writes a string not a date. !!
+
+Dates and times in Excel are represented by real numbers, for example "Jan 1 2001 12:30 AM" 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. To have the number display as a date you must apply an Excel number format to it. Here are some examples.
+
+ #!/usr/bin/perl -w
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new('date_examples.xls');
+ my $worksheet = $workbook->add_worksheet();
+
+ $worksheet->set_column('A:A', 30); # For extra visibility.
+
+ my $number = 39506.5;
+
+ $worksheet->write('A1', $number); # 39506.5
+
+ my $format2 = $workbook->add_format(num_format => 'dd/mm/yy');
+ $worksheet->write('A2', $number , $format2); # 28/02/08
+
+ my $format3 = $workbook->add_format(num_format => 'mm/dd/yy');
+ $worksheet->write('A3', $number , $format3); # 02/28/08
+
+ my $format4 = $workbook->add_format(num_format => 'd-m-yyyy');
+ $worksheet->write('A4', $number , $format4); # 28-2-2008
+
+ my $format5 = $workbook->add_format(num_format => 'dd/mm/yy hh:mm');
+ $worksheet->write('A5', $number , $format5); # 28/02/08 12:00
+
+ my $format6 = $workbook->add_format(num_format => 'd mmm yyyy');
+ $worksheet->write('A6', $number , $format6); # 28 Feb 2008
+
+ my $format7 = $workbook->add_format(num_format => 'mmm d yyyy hh:mm AM/PM');
+ $worksheet->write('A7', $number , $format7); # Feb 28 2008 12:00 PM
+
+
+=head2 Spreadsheet::WriteExcel doesn't automatically convert date/time strings
+
+Spreadsheet::WriteExcel doesn't automatically convert input date strings into Excel's formatted date numbers due to the large number of possible date formats and also due to the possibility of misinterpretation.
+
+For example, does C<02/03/04> mean March 2 2004, February 3 2004 or even March 4 2002.
+
+Therefore, in order to handle dates you will have to convert them to numbers and apply an Excel format. Some methods for converting dates are listed in the next section.
+
+The most direct way is to convert your dates to the ISO8601 C<yyyy-mm-ddThh:mm:ss.sss> date format and use the C<write_date_time()> worksheet method:
+
+ $worksheet->write_date_time('A2', '2001-01-01T12:20', $format);
+
+See the C<write_date_time()> section of the documentation for more details.
+
+A general methodology for handling date strings with C<write_date_time()> is:
+
+ 1. Identify incoming date/time strings with a regex.
+ 2. Extract the component parts of the date/time using the same regex.
+ 3. Convert the date/time to the ISO8601 format.
+ 4. Write the date/time using write_date_time() and a number format.
+
+Here is an example:
+
+ #!/usr/bin/perl -w
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new('example.xls');
+ my $worksheet = $workbook->add_worksheet();
+
+ # Set the default format for dates.
+ my $date_format = $workbook->add_format(num_format => 'mmm d yyyy');
+
+ # Increase column width to improve visibility of data.
+ $worksheet->set_column('A:C', 20);
+
+ # Simulate reading from a data source.
+ my $row = 0;
+
+ while (<DATA>) {
+ chomp;
+
+ my $col = 0;
+ my @data = split ' ';
+
+ for my $item (@data) {
+
+ # Match dates in the following formats: d/m/yy, d/m/yyyy
+ if ($item =~ qr[^(\d{1,2})/(\d{1,2})/(\d{4})$]) {
+
+ # Change to the date format required by write_date_time().
+ my $date = sprintf "%4d-%02d-%02dT", $3, $2, $1;
+
+ $worksheet->write_date_time($row, $col++, $date, $date_format);
+ }
+ else {
+ # Just plain data
+ $worksheet->write($row, $col++, $item);
+ }
+ }
+ $row++;
+ }
+
+ __DATA__
+ Item Cost Date
+ Book 10 1/9/2007
+ Beer 4 12/9/2007
+ Bed 500 5/10/2007
+
+For a slightly more advanced solution you can modify the C<write()> method to handle date formats of your choice via the C<add_write_handler()> method. See the C<add_write_handler()> section of the docs and the write_handler3.pl and write_handler4.pl programs in the examples directory of the distro.
+
+
+=head2 Converting dates and times to an Excel date or time
+
+The C<write_date_time()> method above is just one way of handling dates and times.
+
+The L<Spreadsheet::WriteExcel::Utility> module which is included in the distro has date/time handling functions:
+
+ use Spreadsheet::WriteExcel::Utility;
+
+ $date = xl_date_list(2002, 1, 1); # 37257
+ $date = xl_parse_date("11 July 1997"); # 35622
+ $time = xl_parse_time('3:21:36 PM'); # 0.64
+ $date = xl_decode_date_EU("13 May 2002"); # 37389
+
+Note: some of these functions require additional CPAN modules.
+
+For date conversions using the CPAN C<DateTime> framework see L<DateTime::Format::Excel> L<http://search.cpan.org/search?dist=DateTime-Format-Excel>.
+
+
+
+
+=head1 OUTLINES AND GROUPING IN EXCEL
+
+
+Excel allows you to group rows or columns so that they can be hidden or displayed with a single mouse click. This feature is referred to as outlines.
+
+Outlines can reduce complex data down to a few salient sub-totals or summaries.
+
+This feature is best viewed in Excel but the following is an ASCII representation of what a worksheet with three outlines might look like. Rows 3-4 and rows 7-8 are grouped at level 2. Rows 2-9 are grouped at level 1. The lines at the left hand side are called outline level bars.
+
+
+ ------------------------------------------
+ 1 2 3 | | A | B | C | D | ...
+ ------------------------------------------
+ _ | 1 | A | | | | ...
+ | _ | 2 | B | | | | ...
+ | | | 3 | (C) | | | | ...
+ | | | 4 | (D) | | | | ...
+ | - | 5 | E | | | | ...
+ | _ | 6 | F | | | | ...
+ | | | 7 | (G) | | | | ...
+ | | | 8 | (H) | | | | ...
+ | - | 9 | I | | | | ...
+ - | . | ... | ... | ... | ... | ...
+
+
+Clicking the minus sign on each of the level 2 outlines will collapse and hide the data as shown in the next figure. The minus sign changes to a plus sign to indicate that the data in the outline is hidden.
+
+ ------------------------------------------
+ 1 2 3 | | A | B | C | D | ...
+ ------------------------------------------
+ _ | 1 | A | | | | ...
+ | | 2 | B | | | | ...
+ | + | 5 | E | | | | ...
+ | | 6 | F | | | | ...
+ | + | 9 | I | | | | ...
+ - | . | ... | ... | ... | ... | ...
+
+
+Clicking on the minus sign on the level 1 outline will collapse the remaining rows as follows:
+
+ ------------------------------------------
+ 1 2 3 | | A | B | C | D | ...
+ ------------------------------------------
+ | 1 | A | | | | ...
+ + | . | ... | ... | ... | ... | ...
+
+
+Grouping in C<Spreadsheet::WriteExcel> is achieved by setting the outline level via the C<set_row()> and C<set_column()> worksheet methods:
+
+ set_row($row, $height, $format, $hidden, $level, $collapsed)
+ set_column($first_col, $last_col, $width, $format, $hidden, $level, $collapsed)
+
+The following example sets an outline level of 1 for rows 1 and 2 (zero-indexed) and columns B to G. The parameters C<$height> and C<$XF> are assigned default values since they are undefined:
+
+ $worksheet->set_row(1, undef, undef, 0, 1);
+ $worksheet->set_row(2, undef, undef, 0, 1);
+ $worksheet->set_column('B:G', undef, undef, 0, 1);
+
+Excel allows up to 7 outline levels. Therefore the C<$level> parameter should be in the range C<0 E<lt>= $level E<lt>= 7>.
+
+Rows and columns can be collapsed by setting the C<$hidden> flag for the hidden rows/columns and setting the C<$collapsed> flag for the row/column that has the collapsed C<+> symbol:
+
+ $worksheet->set_row(1, undef, undef, 1, 1);
+ $worksheet->set_row(2, undef, undef, 1, 1);
+ $worksheet->set_row(3, undef, undef, 0, 0, 1); # Collapsed flag.
+
+ $worksheet->set_column('B:G', undef, undef, 1, 1);
+ $worksheet->set_column('H:H', undef, undef, 0, 0, 1); # Collapsed flag.
+
+Note: Setting the C<$collapsed> flag is particularly important for compatibility with OpenOffice.org and Gnumeric.
+
+For a more complete example see the C<outline.pl> and C<outline_collapsed.pl> programs in the examples directory of the distro.
+
+Some additional outline properties can be set via the C<outline_settings()> worksheet method, see above.
+
+
+
+
+=head1 DATA VALIDATION IN EXCEL
+
+Data validation is a feature of Excel which allows you to restrict the data that a users enters in a cell and to display help and warning messages. It also allows you to restrict input to values in a drop down list.
+
+A typical use case might be to restrict data in a cell to integer values in a certain range, to provide a help message to indicate the required value and to issue a warning if the input data doesn't meet the stated criteria. In Spreadsheet::WriteExcel we could do that as follows:
+
+ $worksheet->data_validation('B3',
+ {
+ validate => 'integer',
+ criteria => 'between',
+ minimum => 1,
+ maximum => 100,
+ input_title => 'Input an integer:',
+ input_message => 'Between 1 and 100',
+ error_message => 'Sorry, try again.',
+ });
+
+The above example would look like this in Excel: L<http://homepage.eircom.net/~jmcnamara/perl/data_validation.jpg>.
+
+=begin html
+
+<center>
+<img src="http://homepage.eircom.net/~jmcnamara/perl/data_validation.jpg" alt="The output from the above example">
+</center>
+
+=end html
+
+For more information on data validation see the following Microsoft support article "Description and examples of data validation in Excel": L<http://support.microsoft.com/kb/211485>.
+
+The following sections describe how to use the C<data_validation()> method and its various options.
+
+
+=head2 data_validation($row, $col, { parameter => 'value', ... })
+
+The C<data_validation()> method is used to construct an Excel data validation.
+
+It can be applied to a single cell or a range of cells. You can pass 3 parameters such as C<($row, $col, {...})> or 5 parameters such as C<($first_row, $first_col, $last_row, $last_col, {...})>. You can also use C<A1> style notation. For example:
+
+ $worksheet->data_validation(0, 0, {...});
+ $worksheet->data_validation(0, 0, 4, 1, {...});
+
+ # Which are the same as:
+
+ $worksheet->data_validation('A1', {...});
+ $worksheet->data_validation('A1:B5', {...});
+
+See also the note about L<Cell notation> for more information.
+
+
+The last parameter in C<data_validation()> must be a hash ref containing the parameters that describe the type and style of the data validation. The allowable parameters are:
+
+ validate
+ criteria
+ value | minimum | source
+ maximum
+ ignore_blank
+ dropdown
+
+ input_title
+ input_message
+ show_input
+
+ error_title
+ error_message
+ error_type
+ show_error
+
+These parameters are explained in the following sections. Most of the parameters are optional, however, you will generally require the three main options C<validate>, C<criteria> and C<value>.
+
+ $worksheet->data_validation('B3',
+ {
+ validate => 'integer',
+ criteria => '>',
+ value => 100,
+ });
+
+The C<data_validation> method returns:
+
+ 0 for success.
+ -1 for insufficient number of arguments.
+ -2 for row or column out of bounds.
+ -3 for incorrect parameter or value.
+
+
+=head2 validate
+
+This parameter is passed in a hash ref to C<data_validation()>.
+
+The C<validate> parameter is used to set the type of data that you wish to validate. It is always required and it has no default value. Allowable values are:
+
+ any
+ integer
+ decimal
+ list
+ date
+ time
+ length
+ custom
+
+=over
+
+=item * B<any> is used to specify that the type of data is unrestricted. This is the same as not applying a data validation. It is only provided for completeness and isn't used very often in the context of Spreadsheet::WriteExcel.
+
+=item * B<integer> restricts the cell to integer values. Excel refers to this as 'whole number'.
+
+ validate => 'integer',
+ criteria => '>',
+ value => 100,
+
+=item * B<decimal> restricts the cell to decimal values.
+
+ validate => 'decimal',
+ criteria => '>',
+ value => 38.6,
+
+=item * B<list> restricts the cell to a set of user specified values. These can be passed in an array ref or as a cell range (named ranges aren't currently supported):
+
+ validate => 'list',
+ value => ['open', 'high', 'close'],
+ # Or like this:
+ value => 'B1:B3',
+
+Excel requires that range references are only to cells on the same worksheet.
+
+=item * B<date> restricts the cell to date values. Dates in Excel are expressed as integer values but you can also pass an ISO860 style string as used in C<write_date_time()>. See also L<DATES AND TIME IN EXCEL> for more information about working with Excel's dates.
+
+ validate => 'date',
+ criteria => '>',
+ value => 39653, # 24 July 2008
+ # Or like this:
+ value => '2008-07-24T',
+
+=item * B<time> restricts the cell to time values. Times in Excel are expressed as decimal values but you can also pass an ISO860 style string as used in C<write_date_time()>. See also L<DATES AND TIME IN EXCEL> for more information about working with Excel's times.
+
+ validate => 'time',
+ criteria => '>',
+ value => 0.5, # Noon
+ # Or like this:
+ value => 'T12:00:00',
+
+=item * B<length> restricts the cell data based on an integer string length. Excel refers to this as 'Text length'.
+
+ validate => 'length',
+ criteria => '>',
+ value => 10,
+
+=item * B<custom> restricts the cell based on an external Excel formula that returns a C<TRUE/FALSE> value.
+
+ validate => 'custom',
+ value => '=IF(A10>B10,TRUE,FALSE)',
+
+=back
+
+
+=head2 criteria
+
+This parameter is passed in a hash ref to C<data_validation()>.
+
+The C<criteria> parameter is used to set the criteria by which the data in the cell is validated. It is almost always required except for the C<list> and C<custom> validate options. It has no default value. Allowable values are:
+
+ 'between'
+ 'not between'
+ 'equal to' | '==' | '='
+ 'not equal to' | '!=' | '<>'
+ 'greater than' | '>'
+ 'less than' | '<'
+ 'greater than or equal to' | '>='
+ 'less than or equal to' | '<='
+
+You can either use Excel's textual description strings, in the first column above, or the more common operator alternatives. The following are equivalent:
+
+ validate => 'integer',
+ criteria => 'greater than',
+ value => 100,
+
+ validate => 'integer',
+ criteria => '>',
+ value => 100,
+
+The C<list> and C<custom> validate options don't require a C<criteria>. If you specify one it will be ignored.
+
+ validate => 'list',
+ value => ['open', 'high', 'close'],
+
+ validate => 'custom',
+ value => '=IF(A10>B10,TRUE,FALSE)',
+
+
+=head2 value | minimum | source
+
+This parameter is passed in a hash ref to C<data_validation()>.
+
+The C<value> parameter is used to set the limiting value to which the C<criteria> is applied. It is always required and it has no default value. You can also use the synonyms C<minimum> or C<source> to make the validation a little clearer and closer to Excel's description of the parameter:
+
+ # Use 'value'
+ validate => 'integer',
+ criteria => '>',
+ value => 100,
+
+ # Use 'minimum'
+ validate => 'integer',
+ criteria => 'between',
+ minimum => 1,
+ maximum => 100,
+
+ # Use 'source'
+ validate => 'list',
+ source => 'B1:B3',
+
+
+=head2 maximum
+
+This parameter is passed in a hash ref to C<data_validation()>.
+
+The C<maximum> parameter is used to set the upper limiting value when the C<criteria> is either C<'between'> or C<'not between'>:
+
+ validate => 'integer',
+ criteria => 'between',
+ minimum => 1,
+ maximum => 100,
+
+
+=head2 ignore_blank
+
+This parameter is passed in a hash ref to C<data_validation()>.
+
+The C<ignore_blank> parameter is used to toggle on and off the 'Ignore blank' option in the Excel data validation dialog. When the option is on the data validation is not applied to blank data in the cell. It is on by default.
+
+ ignore_blank => 0, # Turn the option off
+
+
+=head2 dropdown
+
+This parameter is passed in a hash ref to C<data_validation()>.
+
+The C<dropdown> parameter is used to toggle on and off the 'In-cell dropdown' option in the Excel data validation dialog. When the option is on a dropdown list will be shown for C<list> validations. It is on by default.
+
+ dropdown => 0, # Turn the option off
+
+
+=head2 input_title
+
+This parameter is passed in a hash ref to C<data_validation()>.
+
+The C<input_title> parameter is used to set the title of the input message that is displayed when a cell is entered. It has no default value and is only displayed if the input message is displayed. See the C<input_message> parameter below.
+
+ input_title => 'This is the input title',
+
+The maximum title length is 32 characters. UTF8 strings are handled automatically in perl 5.8 and later.
+
+
+=head2 input_message
+
+This parameter is passed in a hash ref to C<data_validation()>.
+
+The C<input_message> parameter is used to set the input message that is displayed when a cell is entered. It has no default value.
+
+ validate => 'integer',
+ criteria => 'between',
+ minimum => 1,
+ maximum => 100,
+ input_title => 'Enter the applied discount:',
+ input_message => 'between 1 and 100',
+
+The message can be split over several lines using newlines, C<"\n"> in double quoted strings.
+
+ input_message => "This is\na test.",
+
+The maximum message length is 255 characters. UTF8 strings are handled automatically in perl 5.8 and later.
+
+
+=head2 show_input
+
+This parameter is passed in a hash ref to C<data_validation()>.
+
+The C<show_input> parameter is used to toggle on and off the 'Show input message when cell is selected' option in the Excel data validation dialog. When the option is off an input message is not displayed even if it has been set using C<input_message>. It is on by default.
+
+ show_input => 0, # Turn the option off
+
+
+=head2 error_title
+
+This parameter is passed in a hash ref to C<data_validation()>.
+
+The C<error_title> parameter is used to set the title of the error message that is displayed when the data validation criteria is not met. The default error title is 'Microsoft Excel'.
+
+ error_title => 'Input value is not valid',
+
+The maximum title length is 32 characters. UTF8 strings are handled automatically in perl 5.8 and later.
+
+
+=head2 error_message
+
+This parameter is passed in a hash ref to C<data_validation()>.
+
+The C<error_message> parameter is used to set the error message that is displayed when a cell is entered. The default error message is "The value you entered is not valid.\nA user has restricted values that can be entered into the cell.".
+
+ validate => 'integer',
+ criteria => 'between',
+ minimum => 1,
+ maximum => 100,
+ error_title => 'Input value is not valid',
+ error_message => 'It should be an integer between 1 and 100',
+
+The message can be split over several lines using newlines, C<"\n"> in double quoted strings.
+
+ input_message => "This is\na test.",
+
+The maximum message length is 255 characters. UTF8 strings are handled automatically in perl 5.8 and later.
+
+
+=head2 error_type
+
+This parameter is passed in a hash ref to C<data_validation()>.
+
+The C<error_type> parameter is used to specify the type of error dialog that is displayed. There are 3 options:
+
+ 'stop'
+ 'warning'
+ 'information'
+
+The default is C<'stop'>.
+
+
+=head2 show_error
+
+This parameter is passed in a hash ref to C<data_validation()>.
+
+The C<show_error> parameter is used to toggle on and off the 'Show error alert after invalid data is entered' option in the Excel data validation dialog. When the option is off an error message is not displayed even if it has been set using C<error_message>. It is on by default.
+
+ show_error => 0, # Turn the option off
+
+=head2 Data Validation Examples
+
+Example 1. Limiting input to an integer greater than a fixed value.
+
+ $worksheet->data_validation('A1',
+ {
+ validate => 'integer',
+ criteria => '>',
+ value => 0,
+ });
+
+Example 2. Limiting input to an integer greater than a fixed value where the value is referenced from a cell.
+
+ $worksheet->data_validation('A2',
+ {
+ validate => 'integer',
+ criteria => '>',
+ value => '=E3',
+ });
+
+Example 3. Limiting input to a decimal in a fixed range.
+
+ $worksheet->data_validation('A3',
+ {
+ validate => 'decimal',
+ criteria => 'between',
+ minimum => 0.1,
+ maximum => 0.5,
+ });
+
+Example 4. Limiting input to a value in a dropdown list.
+
+ $worksheet->data_validation('A4',
+ {
+ validate => 'list',
+ source => ['open', 'high', 'close'],
+ });
+
+Example 5. Limiting input to a value in a dropdown list where the list is specified as a cell range.
+
+ $worksheet->data_validation('A5',
+ {
+ validate => 'list',
+ source => '=E4:G4',
+ });
+
+Example 6. Limiting input to a date in a fixed range.
+
+ $worksheet->data_validation('A6',
+ {
+ validate => 'date',
+ criteria => 'between',
+ minimum => '2008-01-01T',
+ maximum => '2008-12-12T',
+ });
+
+Example 7. Displaying a message when the cell is selected.
+
+ $worksheet->data_validation('A7',
+ {
+ validate => 'integer',
+ criteria => 'between',
+ minimum => 1,
+ maximum => 100,
+ input_title => 'Enter an integer:',
+ input_message => 'between 1 and 100',
+ });
+
+See also the C<data_validate.pl> program in the examples directory of the distro.
+
+
+
+
+=head1 FORMULAS AND FUNCTIONS IN EXCEL
+
+
+=head2 Caveats
+
+The first thing to note is that there are still some outstanding issues with the implementation of formulas and functions:
+
+ 1. Writing a formula is much slower than writing the equivalent string.
+ 2. You cannot use array constants, i.e. {1;2;3}, in functions.
+ 3. Unary minus isn't supported.
+ 4. Whitespace is not preserved around operators.
+ 5. Named ranges are not supported.
+ 6. Array formulas are not supported.
+
+However, these constraints will be removed in future versions. They are here because of a trade-off between features and time. Also, it is possible to work around issue 1 using the C<store_formula()> and C<repeat_formula()> methods as described later in this section.
+
+
+
+=head2 Introduction
+
+The following is a brief introduction to formulas and functions in Excel and Spreadsheet::WriteExcel.
+
+A formula is a string that begins with an equals sign:
+
+ '=A1+B1'
+ '=AVERAGE(1, 2, 3)'
+
+The formula can contain numbers, strings, boolean values, cell references, cell ranges and functions. Named ranges are not supported. Formulas should be written as they appear in Excel, that is cells and functions must be in uppercase.
+
+Cells in Excel are referenced using the A1 notation system where the column is designated by a letter and the row by a number. Columns range from A to IV i.e. 0 to 255, rows range from 1 to 65536. The C<Spreadsheet::WriteExcel::Utility> module that is included in the distro contains helper functions for dealing with A1 notation, for example:
+
+ use Spreadsheet::WriteExcel::Utility;
+
+ ($row, $col) = xl_cell_to_rowcol('C2'); # (1, 2)
+ $str = xl_rowcol_to_cell(1, 2); # C2
+
+The Excel C<$> notation in cell references is also supported. This allows you to specify whether a row or column is relative or absolute. This only has an effect if the cell is copied. The following examples show relative and absolute values.
+
+ '=A1' # Column and row are relative
+ '=$A1' # Column is absolute and row is relative
+ '=A$1' # Column is relative and row is absolute
+ '=$A$1' # Column and row are absolute
+
+Formulas can also refer to cells in other worksheets of the current workbook. For example:
+
+ '=Sheet2!A1'
+ '=Sheet2!A1:A5'
+ '=Sheet2:Sheet3!A1'
+ '=Sheet2:Sheet3!A1:A5'
+ q{='Test Data'!A1}
+ q{='Test Data1:Test Data2'!A1}
+
+The sheet reference and the cell reference are separated by C<!> the exclamation mark symbol. If worksheet names contain spaces, commas o parentheses then Excel requires that the name is enclosed in single quotes as shown in the last two examples above. In order to avoid using a lot of escape characters you can use the quote operator C<q{}> to protect the quotes. See C<perlop> in the main Perl documentation. Only valid sheet names that have been added using the C<add_worksheet()> method can be used in formulas. You cannot reference external workbooks.
+
+
+The following table lists the operators that are available in Excel's formulas. The majority of the operators are the same as Perl's, differences are indicated:
+
+ Arithmetic operators:
+ =====================
+ Operator Meaning Example
+ + Addition 1+2
+ - Subtraction 2-1
+ * Multiplication 2*3
+ / Division 1/4
+ ^ Exponentiation 2^3 # Equivalent to **
+ - Unary minus -(1+2) # Not yet supported
+ % Percent (Not modulus) 13% # Not supported, [1]
+
+
+ Comparison operators:
+ =====================
+ Operator Meaning Example
+ = Equal to A1 = B1 # Equivalent to ==
+ <> Not equal to A1 <> B1 # Equivalent to !=
+ > Greater than A1 > B1
+ < Less than A1 < B1
+ >= Greater than or equal to A1 >= B1
+ <= Less than or equal to A1 <= B1
+
+
+ String operator:
+ ================
+ Operator Meaning Example
+ & Concatenation "Hello " & "World!" # [2]
+
+
+ Reference operators:
+ ====================
+ Operator Meaning Example
+ : Range operator A1:A4 # [3]
+ , Union operator SUM(1, 2+2, B3) # [4]
+
+
+ Notes:
+ [1]: You can get a percentage with formatting and modulus with MOD().
+ [2]: Equivalent to ("Hello " . "World!") in Perl.
+ [3]: This range is equivalent to cells A1, A2, A3 and A4.
+ [4]: The comma behaves like the list separator in Perl.
+
+The range and comma operators can have different symbols in non-English versions of Excel. These will be supported in a later version of Spreadsheet::WriteExcel. European users of Excel take note:
+
+ $worksheet->write('A1', '=SUM(1; 2; 3)'); # Wrong!!
+ $worksheet->write('A1', '=SUM(1, 2, 3)'); # Okay
+
+The following table lists all of the core functions supported by Excel 5 and Spreadsheet::WriteExcel. Any additional functions that are available through the "Analysis ToolPak" or other add-ins are not supported. These functions have all been tested to verify that they work.
+
+ ABS DB INDIRECT NORMINV SLN
+ ACOS DCOUNT INFO NORMSDIST SLOPE
+ ACOSH DCOUNTA INT NORMSINV SMALL
+ ADDRESS DDB INTERCEPT NOT SQRT
+ AND DEGREES IPMT NOW STANDARDIZE
+ AREAS DEVSQ IRR NPER STDEV
+ ASIN DGET ISBLANK NPV STDEVP
+ ASINH DMAX ISERR ODD STEYX
+ ATAN DMIN ISERROR OFFSET SUBSTITUTE
+ ATAN2 DOLLAR ISLOGICAL OR SUBTOTAL
+ ATANH DPRODUCT ISNA PEARSON SUM
+ AVEDEV DSTDEV ISNONTEXT PERCENTILE SUMIF
+ AVERAGE DSTDEVP ISNUMBER PERCENTRANK SUMPRODUCT
+ BETADIST DSUM ISREF PERMUT SUMSQ
+ BETAINV DVAR ISTEXT PI SUMX2MY2
+ BINOMDIST DVARP KURT PMT SUMX2PY2
+ CALL ERROR.TYPE LARGE POISSON SUMXMY2
+ CEILING EVEN LEFT POWER SYD
+ CELL EXACT LEN PPMT T
+ CHAR EXP LINEST PROB TAN
+ CHIDIST EXPONDIST LN PRODUCT TANH
+ CHIINV FACT LOG PROPER TDIST
+ CHITEST FALSE LOG10 PV TEXT
+ CHOOSE FDIST LOGEST QUARTILE TIME
+ CLEAN FIND LOGINV RADIANS TIMEVALUE
+ CODE FINV LOGNORMDIST RAND TINV
+ COLUMN FISHER LOOKUP RANK TODAY
+ COLUMNS FISHERINV LOWER RATE TRANSPOSE
+ COMBIN FIXED MATCH REGISTER.ID TREND
+ CONCATENATE FLOOR MAX REPLACE TRIM
+ CONFIDENCE FORECAST MDETERM REPT TRIMMEAN
+ CORREL FREQUENCY MEDIAN RIGHT TRUE
+ COS FTEST MID ROMAN TRUNC
+ COSH FV MIN ROUND TTEST
+ COUNT GAMMADIST MINUTE ROUNDDOWN TYPE
+ COUNTA GAMMAINV MINVERSE ROUNDUP UPPER
+ COUNTBLANK GAMMALN MIRR ROW VALUE
+ COUNTIF GEOMEAN MMULT ROWS VAR
+ COVAR GROWTH MOD RSQ VARP
+ CRITBINOM HARMEAN MODE SEARCH VDB
+ DATE HLOOKUP MONTH SECOND VLOOKUP
+ DATEVALUE HOUR N SIGN WEEKDAY
+ DAVERAGE HYPGEOMDIST NA SIN WEIBULL
+ DAY IF NEGBINOMDIST SINH YEAR
+ DAYS360 INDEX NORMDIST SKEW ZTEST
+
+You can also modify the module to support function names in the following languages: German, French, Spanish, Portuguese, Dutch, Finnish, Italian and Swedish. See the C<function_locale.pl> program in the C<examples> directory of the distro.
+
+For a general introduction to Excel's formulas and an explanation of the syntax of the function refer to the Excel help files or the following: L<http://office.microsoft.com/en-us/assistance/CH062528031033.aspx>.
+
+If your formula doesn't work in Spreadsheet::WriteExcel try the following:
+
+ 1. Verify that the formula works in Excel (or Gnumeric or OpenOffice.org).
+ 2. Ensure that it isn't on the Caveats list shown above.
+ 3. Ensure that cell references and formula names are in uppercase.
+ 4. Ensure that you are using ':' as the range operator, A1:A4.
+ 5. Ensure that you are using ',' as the union operator, SUM(1,2,3).
+ 6. Ensure that the function is in the above table.
+
+If you go through steps 1-6 and you still have a problem, mail me.
+
+
+
+
+=head2 Improving performance when working with formulas
+
+Writing a large number of formulas with Spreadsheet::WriteExcel can be slow. This is due to the fact that each formula has to be parsed and with the current implementation this is computationally expensive.
+
+However, in a lot of cases the formulas that you write will be quite similar, for example:
+
+ $worksheet->write_formula('B1', '=A1 * 3 + 50', $format);
+ $worksheet->write_formula('B2', '=A2 * 3 + 50', $format);
+ ...
+ ...
+ $worksheet->write_formula('B99', '=A999 * 3 + 50', $format);
+ $worksheet->write_formula('B1000', '=A1000 * 3 + 50', $format);
+
+In this example the cell reference changes in iterations from C<A1> to C<A1000>. The parser treats this variable as a I<token> and arranges it according to predefined rules. However, since the parser is oblivious to the value of the token, it is essentially performing the same calculation 1000 times. This is inefficient.
+
+The way to avoid this inefficiency and thereby speed up the writing of formulas is to parse the formula once and then repeatedly substitute similar tokens.
+
+A formula can be parsed and stored via the C<store_formula()> worksheet method. You can then use the C<repeat_formula()> method to substitute C<$pattern>, C<$replace> pairs in the stored formula:
+
+ my $formula = $worksheet->store_formula('=A1 * 3 + 50');
+
+ for my $row (0..999) {
+ $worksheet->repeat_formula($row, 1, $formula, $format, 'A1', 'A'.($row +1));
+ }
+
+On an arbitrary test machine this method was 10 times faster than the brute force method shown above.
+
+For more information about how Spreadsheet::WriteExcel parses and stores formulas see the C<Spreadsheet::WriteExcel::Formula> man page.
+
+It should be noted however that the overall speed of direct formula parsing will be improved in a future version.
+
+
+
+
+=head1 EXAMPLES
+
+See L<Spreadsheet::WriteExcel::Examples> for a full list of examples.
+
+
+=head2 Example 1
+
+The following example shows some of the basic features of Spreadsheet::WriteExcel.
+
+
+ #!/usr/bin/perl -w
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ # Create a new workbook called simple.xls and add a worksheet
+ my $workbook = Spreadsheet::WriteExcel->new('simple.xls');
+ my $worksheet = $workbook->add_worksheet();
+
+ # The general syntax is write($row, $column, $token). Note that row and
+ # column are zero indexed
+
+ # Write some text
+ $worksheet->write(0, 0, 'Hi Excel!');
+
+
+ # Write some numbers
+ $worksheet->write(2, 0, 3); # Writes 3
+ $worksheet->write(3, 0, 3.00000); # Writes 3
+ $worksheet->write(4, 0, 3.00001); # Writes 3.00001
+ $worksheet->write(5, 0, 3.14159); # TeX revision no.?
+
+
+ # Write some formulas
+ $worksheet->write(7, 0, '=A3 + A6');
+ $worksheet->write(8, 0, '=IF(A5>3,"Yes", "No")');
+
+
+ # Write a hyperlink
+ $worksheet->write(10, 0, 'http://www.perl.com/');
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/a_simple.jpg" width="640" height="420" alt="Output from a_simple.pl" /></center></p>
+
+=end html
+
+
+
+
+=head2 Example 2
+
+The following is a general example which demonstrates some features of working with multiple worksheets.
+
+ #!/usr/bin/perl -w
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ # Create a new Excel workbook
+ my $workbook = Spreadsheet::WriteExcel->new('regions.xls');
+
+ # Add some worksheets
+ my $north = $workbook->add_worksheet('North');
+ my $south = $workbook->add_worksheet('South');
+ my $east = $workbook->add_worksheet('East');
+ my $west = $workbook->add_worksheet('West');
+
+ # Add a Format
+ my $format = $workbook->add_format();
+ $format->set_bold();
+ $format->set_color('blue');
+
+ # Add a caption to each worksheet
+ foreach my $worksheet ($workbook->sheets()) {
+ $worksheet->write(0, 0, 'Sales', $format);
+ }
+
+ # Write some data
+ $north->write(0, 1, 200000);
+ $south->write(0, 1, 100000);
+ $east->write (0, 1, 150000);
+ $west->write (0, 1, 100000);
+
+ # Set the active worksheet
+ $south->activate();
+
+ # Set the width of the first column
+ $south->set_column(0, 0, 20);
+
+ # Set the active cell
+ $south->set_selection(0, 1);
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/regions.jpg" width="640" height="420" alt="Output from regions.pl" /></center></p>
+
+=end html
+
+
+
+
+=head2 Example 3
+
+This example shows how to use a conditional numerical format with colours to indicate if a share price has gone up or down.
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ # Create a new workbook and add a worksheet
+ my $workbook = Spreadsheet::WriteExcel->new('stocks.xls');
+ my $worksheet = $workbook->add_worksheet();
+
+ # Set the column width for columns 1, 2, 3 and 4
+ $worksheet->set_column(0, 3, 15);
+
+
+ # Create a format for the column headings
+ my $header = $workbook->add_format();
+ $header->set_bold();
+ $header->set_size(12);
+ $header->set_color('blue');
+
+
+ # Create a format for the stock price
+ my $f_price = $workbook->add_format();
+ $f_price->set_align('left');
+ $f_price->set_num_format('$0.00');
+
+
+ # Create a format for the stock volume
+ my $f_volume = $workbook->add_format();
+ $f_volume->set_align('left');
+ $f_volume->set_num_format('#,##0');
+
+
+ # Create a format for the price change. This is an example of a
+ # conditional format. The number is formatted as a percentage. If it is
+ # positive it is formatted in green, if it is negative it is formatted
+ # in red and if it is zero it is formatted as the default font colour
+ # (in this case black). Note: the [Green] format produces an unappealing
+ # lime green. Try [Color 10] instead for a dark green.
+ #
+ my $f_change = $workbook->add_format();
+ $f_change->set_align('left');
+ $f_change->set_num_format('[Green]0.0%;[Red]-0.0%;0.0%');
+
+
+ # Write out the data
+ $worksheet->write(0, 0, 'Company',$header);
+ $worksheet->write(0, 1, 'Price', $header);
+ $worksheet->write(0, 2, 'Volume', $header);
+ $worksheet->write(0, 3, 'Change', $header);
+
+ $worksheet->write(1, 0, 'Damage Inc.' );
+ $worksheet->write(1, 1, 30.25, $f_price ); # $30.25
+ $worksheet->write(1, 2, 1234567, $f_volume); # 1,234,567
+ $worksheet->write(1, 3, 0.085, $f_change); # 8.5% in green
+
+ $worksheet->write(2, 0, 'Dump Corp.' );
+ $worksheet->write(2, 1, 1.56, $f_price ); # $1.56
+ $worksheet->write(2, 2, 7564, $f_volume); # 7,564
+ $worksheet->write(2, 3, -0.015, $f_change); # -1.5% in red
+
+ $worksheet->write(3, 0, 'Rev Ltd.' );
+ $worksheet->write(3, 1, 0.13, $f_price ); # $0.13
+ $worksheet->write(3, 2, 321, $f_volume); # 321
+ $worksheet->write(3, 3, 0, $f_change); # 0 in the font color (black)
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/stocks.jpg" width="640" height="420" alt="Output from stocks.pl" /></center></p>
+
+=end html
+
+
+
+
+=head2 Example 4
+
+The following is a simple example of using functions.
+
+ #!/usr/bin/perl -w
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ # Create a new workbook and add a worksheet
+ my $workbook = Spreadsheet::WriteExcel->new('stats.xls');
+ my $worksheet = $workbook->add_worksheet('Test data');
+
+ # Set the column width for columns 1
+ $worksheet->set_column(0, 0, 20);
+
+
+ # Create a format for the headings
+ my $format = $workbook->add_format();
+ $format->set_bold();
+
+
+ # Write the sample data
+ $worksheet->write(0, 0, 'Sample', $format);
+ $worksheet->write(0, 1, 1);
+ $worksheet->write(0, 2, 2);
+ $worksheet->write(0, 3, 3);
+ $worksheet->write(0, 4, 4);
+ $worksheet->write(0, 5, 5);
+ $worksheet->write(0, 6, 6);
+ $worksheet->write(0, 7, 7);
+ $worksheet->write(0, 8, 8);
+
+ $worksheet->write(1, 0, 'Length', $format);
+ $worksheet->write(1, 1, 25.4);
+ $worksheet->write(1, 2, 25.4);
+ $worksheet->write(1, 3, 24.8);
+ $worksheet->write(1, 4, 25.0);
+ $worksheet->write(1, 5, 25.3);
+ $worksheet->write(1, 6, 24.9);
+ $worksheet->write(1, 7, 25.2);
+ $worksheet->write(1, 8, 24.8);
+
+ # Write some statistical functions
+ $worksheet->write(4, 0, 'Count', $format);
+ $worksheet->write(4, 1, '=COUNT(B1:I1)');
+
+ $worksheet->write(5, 0, 'Sum', $format);
+ $worksheet->write(5, 1, '=SUM(B2:I2)');
+
+ $worksheet->write(6, 0, 'Average', $format);
+ $worksheet->write(6, 1, '=AVERAGE(B2:I2)');
+
+ $worksheet->write(7, 0, 'Min', $format);
+ $worksheet->write(7, 1, '=MIN(B2:I2)');
+
+ $worksheet->write(8, 0, 'Max', $format);
+ $worksheet->write(8, 1, '=MAX(B2:I2)');
+
+ $worksheet->write(9, 0, 'Standard Deviation', $format);
+ $worksheet->write(9, 1, '=STDEV(B2:I2)');
+
+ $worksheet->write(10, 0, 'Kurtosis', $format);
+ $worksheet->write(10, 1, '=KURT(B2:I2)');
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/stats.jpg" width="640" height="420" alt="Output from stats.pl" /></center></p>
+
+=end html
+
+
+
+
+=head2 Example 5
+
+The following example converts a tab separated file called C<tab.txt> into an Excel file called C<tab.xls>.
+
+ #!/usr/bin/perl -w
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ open (TABFILE, 'tab.txt') or die "tab.txt: $!";
+
+ my $workbook = Spreadsheet::WriteExcel->new('tab.xls');
+ my $worksheet = $workbook->add_worksheet();
+
+ # Row and column are zero indexed
+ my $row = 0;
+
+ while (<TABFILE>) {
+ chomp;
+ # Split on single tab
+ my @Fld = split('\t', $_);
+
+ my $col = 0;
+ foreach my $token (@Fld) {
+ $worksheet->write($row, $col, $token);
+ $col++;
+ }
+ $row++;
+ }
+
+
+NOTE: This is a simple conversion program for illustrative purposes only. For converting a CSV or Tab separated or any other type of delimited text file to Excel I recommend the more rigorous csv2xls program that is part of H.Merijn Brand's Text::CSV_XS module distro.
+
+See the examples/csv2xls link here: L<http://search.cpan.org/~hmbrand/Text-CSV_XS/MANIFEST>.
+
+
+
+
+=head2 Additional Examples
+
+The following is a description of the example files that are provided
+in the standard Spreadsheet::WriteExcel distribution. They demonstrate the
+different features and options of the module.
+See L<Spreadsheet::WriteExcel::Examples> for more details.
+
+ Getting started
+ ===============
+ a_simple.pl A get started example with some basic features.
+ demo.pl A demo of some of the available features.
+ regions.pl A simple example of multiple worksheets.
+ stats.pl Basic formulas and functions.
+ formats.pl All the available formatting on several worksheets.
+ bug_report.pl A template for submitting bug reports.
+
+
+ Advanced
+ ========
+ autofilter.pl Examples of worksheet autofilters.
+ autofit.pl Simulate Excel's autofit for column widths.
+ bigfile.pl Write past the 7MB limit with OLE::Storage_Lite.
+ cgi.pl A simple CGI program.
+ chart_area.pl A demo of area style charts.
+ chart_bar.pl A demo of bar (vertical histogram) style charts.
+ chart_column.pl A demo of column (histogram) style charts.
+ chart_line.pl A demo of line style charts.
+ chart_pie.pl A demo of pie style charts.
+ chart_scatter.pl A demo of scatter style charts.
+ chart_stock.pl A demo of stock style charts.
+ chess.pl An example of reusing formatting via properties.
+ colors.pl A demo of the colour palette and named colours.
+ comments1.pl Add comments to worksheet cells.
+ comments2.pl Add comments with advanced options.
+ copyformat.pl Example of copying a cell format.
+ data_validate.pl An example of data validation and dropdown lists.
+ date_time.pl Write dates and times with write_date_time().
+ defined_name.pl Example of how to create defined names.
+ diag_border.pl A simple example of diagonal cell borders.
+ easter_egg.pl Expose the Excel97 flight simulator.
+ filehandle.pl Examples of working with filehandles.
+ formula_result.pl Formulas with user specified results.
+ headers.pl Examples of worksheet headers and footers.
+ hide_sheet.pl Simple example of hiding a worksheet.
+ hyperlink1.pl Shows how to create web hyperlinks.
+ hyperlink2.pl Examples of internal and external hyperlinks.
+ images.pl Adding images to worksheets.
+ indent.pl An example of cell indentation.
+ merge1.pl A simple example of cell merging.
+ merge2.pl A simple example of cell merging with formatting.
+ merge3.pl Add hyperlinks to merged cells.
+ merge4.pl An advanced example of merging with formatting.
+ merge5.pl An advanced example of merging with formatting.
+ merge6.pl An example of merging with Unicode strings.
+ mod_perl1.pl A simple mod_perl 1 program.
+ mod_perl2.pl A simple mod_perl 2 program.
+ outline.pl An example of outlines and grouping.
+ outline_collapsed.pl An example of collapsed outlines.
+ panes.pl An examples of how to create panes.
+ properties.pl Add document properties to a workbook.
+ protection.pl Example of cell locking and formula hiding.
+ repeat.pl Example of writing repeated formulas.
+ right_to_left.pl Change default sheet direction to right to left.
+ row_wrap.pl How to wrap data from one worksheet onto another.
+ sales.pl An example of a simple sales spreadsheet.
+ sendmail.pl Send an Excel email attachment using Mail::Sender.
+ stats_ext.pl Same as stats.pl with external references.
+ stocks.pl Demonstrates conditional formatting.
+ tab_colors.pl Example of how to set worksheet tab colours.
+ textwrap.pl Demonstrates text wrapping options.
+ win32ole.pl A sample Win32::OLE example for comparison.
+ write_arrays.pl Example of writing 1D or 2D arrays of data.
+ write_handler1.pl Example of extending the write() method. Step 1.
+ write_handler2.pl Example of extending the write() method. Step 2.
+ write_handler3.pl Example of extending the write() method. Step 3.
+ write_handler4.pl Example of extending the write() method. Step 4.
+ write_to_scalar.pl Example of writing an Excel file to a Perl scalar.
+
+
+ Unicode
+ =======
+ unicode_utf16.pl Simple example of using Unicode UTF16 strings.
+ unicode_utf16_japan.pl Write Japanese Unicode strings using UTF-16.
+ unicode_cyrillic.pl Write Russian Cyrillic strings using UTF-8.
+ unicode_list.pl List the chars in a Unicode font.
+ unicode_2022_jp.pl Japanese: ISO-2022-JP to utf8 in perl 5.8.
+ unicode_8859_11.pl Thai: ISO-8859_11 to utf8 in perl 5.8.
+ unicode_8859_7.pl Greek: ISO-8859_7 to utf8 in perl 5.8.
+ unicode_big5.pl Chinese: BIG5 to utf8 in perl 5.8.
+ unicode_cp1251.pl Russian: CP1251 to utf8 in perl 5.8.
+ unicode_cp1256.pl Arabic: CP1256 to utf8 in perl 5.8.
+ unicode_koi8r.pl Russian: KOI8-R to utf8 in perl 5.8.
+ unicode_polish_utf8.pl Polish : UTF8 to utf8 in perl 5.8.
+ unicode_shift_jis.pl Japanese: Shift JIS to utf8 in perl 5.8.
+
+
+ Utility
+ =======
+ csv2xls.pl Program to convert a CSV file to an Excel file.
+ tab2xls.pl Program to convert a tab separated file to xls.
+ datecalc1.pl Convert Unix/Perl time to Excel time.
+ datecalc2.pl Calculate an Excel date using Date::Calc.
+ lecxe.pl Convert Excel to WriteExcel using Win32::OLE.
+
+
+ Developer
+ =========
+ convertA1.pl Helper functions for dealing with A1 notation.
+ function_locale.pl Add non-English function names to Formula.pm.
+ writeA1.pl Example of how to extend the module.
+
+
+
+=head1 LIMITATIONS
+
+The following limits are imposed by Excel:
+
+ Description Limit
+ ----------------------------------- ------
+ Maximum number of chars in a string 32767
+ Maximum number of columns 256
+ Maximum number of rows 65536
+ Maximum chars in a sheet name 31
+ Maximum chars in a header/footer 254
+
+
+The minimum file size is 6K due to the OLE overhead. The maximum file size is approximately 7MB (7087104 bytes) of BIFF data. This can be extended by installing Takanori Kawai's OLE::Storage_Lite module L<http://search.cpan.org/search?dist=OLE-Storage_Lite> see the C<bigfile.pl> example in the C<examples> directory of the distro.
+
+
+
+
+=head1 DOWNLOADING
+
+The latest version of this module is always available at: L<http://search.cpan.org/search?dist=Spreadsheet-WriteExcel/>.
+
+
+
+
+=head1 REQUIREMENTS
+
+This module requires Perl >= 5.005, Parse::RecDescent, File::Temp and OLE::Storage_Lite:
+
+ http://search.cpan.org/search?dist=Parse-RecDescent/ # For formulas.
+ http://search.cpan.org/search?dist=File-Temp/ # For set_tempdir().
+ http://search.cpan.org/search?dist=OLE-Storage_Lite/ # For files > 7MB.
+
+Note, these aren't strict requirements. Spreadsheet::WriteExcel will work without these modules if you don't use write_formula(), set_tempdir() or create files greater than 7MB. However, it is best to install them if possible and they will be installed automatically if you use a tool such as CPAN.pm or ppm.
+
+
+=head1 INSTALLATION
+
+See the INSTALL or install.html docs that come with the distribution or: L<http://search.cpan.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.31/INSTALL>.
+
+
+
+
+=head1 PORTABILITY
+
+Spreadsheet::WriteExcel will work on the majority of Windows, UNIX and Macintosh platforms. Specifically, the module will work on any system where perl packs floats in the 64 bit IEEE format. The float must also be in little-endian format but it will be reversed if necessary. Thus:
+
+ print join(' ', map { sprintf '%#02x', $_ } unpack('C*', pack 'd', 1.2345)), "\n";
+
+should give (or in reverse order):
+
+ 0x8d 0x97 0x6e 0x12 0x83 0xc0 0xf3 0x3f
+
+In general, if you don't know whether your system supports a 64 bit IEEE float or not, it probably does. If your system doesn't, WriteExcel will C<croak()> with the message given in the L<DIAGNOSTICS> section. You can check which platforms the module has been tested on at the CPAN testers site: L<http://testers.cpan.org/search?request=dist&dist=Spreadsheet-WriteExcel>.
+
+
+
+
+=head1 DIAGNOSTICS
+
+
+=over 4
+
+=item Filename required by Spreadsheet::WriteExcel->new()
+
+A filename must be given in the constructor.
+
+=item Can't open filename. It may be in use or protected.
+
+The file cannot be opened for writing. The directory that you are writing to may be protected or the file may be in use by another program.
+
+=item Unable to create tmp files via File::Temp::tempfile()...
+
+This is a C<-w> warning. You will see it if you are using Spreadsheet::WriteExcel in an environment where temporary files cannot be created, in which case all data will be stored in memory. The warning is for information only: it does not affect creation but it will affect the speed of execution for large files. See the C<set_tempdir> workbook method.
+
+
+=item Maximum file size, 7087104, exceeded.
+
+The current OLE implementation only supports a maximum BIFF file of this size. This limit can be extended, see the L<LIMITATIONS> section.
+
+=item Can't locate Parse/RecDescent.pm in @INC ...
+
+Spreadsheet::WriteExcel requires the Parse::RecDescent module. Download it from CPAN: L<http://search.cpan.org/search?dist=Parse-RecDescent>
+
+=item Couldn't parse formula ...
+
+There are a large number of warnings which relate to badly formed formulas and functions. See the L<FORMULAS AND FUNCTIONS IN EXCEL> section for suggestions on how to avoid these errors. You should also check the formula in Excel to ensure that it is valid.
+
+=item Required floating point format not supported on this platform.
+
+Operating system doesn't support 64 bit IEEE float or it is byte-ordered in a way unknown to WriteExcel.
+
+
+=item 'file.xls' cannot be accessed. The file may be read-only ...
+
+You may sometimes encounter the following error when trying to open a file in Excel: "file.xls cannot be accessed. The file may be read-only, or you may be trying to access a read-only location. Or, the server the document is stored on may not be responding."
+
+This error generally means that the Excel file has been corrupted. There are two likely causes of this: the file was FTPed in ASCII mode instead of binary mode or else the file was created with C<UTF-8> data returned by an XML parser. See L<Warning about XML::Parser and perl 5.6> for further details.
+
+=back
+
+
+
+
+=head1 THE EXCEL BINARY FORMAT
+
+The following is some general information about the Excel binary format for anyone who may be interested.
+
+Excel data is stored in the "Binary Interchange File Format" (BIFF) file format. Details of this format are given in "Excel 97-2007 Binary File Format Specification" L<http://www.microsoft.com/interop/docs/OfficeBinaryFormats.mspx>.
+
+Daniel Rentz of OpenOffice.org has also written a detailed description of the Excel workbook records, see L<http://sc.openoffice.org/excelfileformat.pdf>.
+
+Charles Wybble has collected together additional information about the Excel file format. See "The Chicago Project" at L<http://chicago.sourceforge.net/devel/>.
+
+The BIFF data is stored along with other data in an OLE Compound File. This is a structured storage which acts like a file system within a file. A Compound File is comprised of storages and streams which, to follow the file system analogy, are like directories and files.
+
+The OLE format is explained in the "Windows Compound Binary File Format Specification" L<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 L<http://www.i3a.org/pdf/wg1n1017.pdf>.
+
+Please note that the provision of this information does not constitute an invitation to start hacking at the BIFF or OLE file formats. There are more interesting ways to waste your time. ;-)
+
+
+
+
+=head1 WRITING EXCEL FILES
+
+Depending on your requirements, background and general sensibilities you may prefer one of the following methods of getting data into Excel:
+
+=over 4
+
+=item * Win32::OLE module and office automation
+
+This requires a Windows platform and an installed copy of Excel. This is the most powerful and complete method for interfacing with Excel. See L<http://www.activestate.com/ASPN/Reference/Products/ActivePerl-5.6/faq/Windows/ActivePerl-Winfaq12.html> and L<http://www.activestate.com/ASPN/Reference/Products/ActivePerl-5.6/site/lib/Win32/OLE.html>. If your main platform is UNIX but you have the resources to set up a separate Win32/MSOffice server, you can convert office documents to text, postscript or PDF using Win32::OLE. For a demonstration of how to do this using Perl see Docserver: L<http://search.cpan.org/search?mode=module&query=docserver>.
+
+=item * CSV, comma separated variables or text
+
+If the file extension is C<csv>, Excel will open and convert this format automatically. Generating a valid CSV file isn't as easy as it seems. Have a look at the DBD::RAM, DBD::CSV, Text::xSV and Text::CSV_XS modules.
+
+=item * DBI with DBD::ADO or DBD::ODBC
+
+Excel files contain an internal index table that allows them to act like a database file. Using one of the standard Perl database modules you can connect to an Excel file as a database.
+
+=item * DBD::Excel
+
+You can also access Spreadsheet::WriteExcel using the standard DBI interface via Takanori Kawai's DBD::Excel module L<http://search.cpan.org/dist/DBD-Excel>
+
+=item * Spreadsheet::WriteExcelXML
+
+This module allows you to create an Excel XML file using the same interface as Spreadsheet::WriteExcel. See: L<http://search.cpan.org/dist/Spreadsheet-WriteExcelXML>
+
+=item * Excel::Template
+
+This module allows you to create an Excel file from an XML template in a manner similar to HTML::Template. See L<http://search.cpan.org/dist/Excel-Template/>.
+
+=item * Spreadsheet::WriteExcel::FromXML
+
+This module allows you to turn a simple XML file into an Excel file using Spreadsheet::WriteExcel as a back-end. The format of the XML file is defined by a supplied DTD: L<http://search.cpan.org/dist/Spreadsheet-WriteExcel-FromXML>.
+
+=item * Spreadsheet::WriteExcel::Simple
+
+This provides an easier interface to Spreadsheet::WriteExcel: L<http://search.cpan.org/dist/Spreadsheet-WriteExcel-Simple>.
+
+=item * Spreadsheet::WriteExcel::FromDB
+
+This is a useful module for creating Excel files directly from a DB table: L<http://search.cpan.org/dist/Spreadsheet-WriteExcel-FromDB>.
+
+=item * HTML tables
+
+This is an easy way of adding formatting via a text based format.
+
+=item * XML or HTML
+
+The Excel XML and HTML file specification are available from L<http://msdn.microsoft.com/library/officedev/ofxml2k/ofxml2k.htm>.
+
+=back
+
+For other Perl-Excel modules try the following search: L<http://search.cpan.org/search?mode=module&query=excel>.
+
+
+
+
+=head1 READING EXCEL FILES
+
+To read data from Excel files try:
+
+=over 4
+
+=item * Spreadsheet::ParseExcel
+
+This uses the OLE::Storage-Lite module to extract data from an Excel file. L<http://search.cpan.org/dist/Spreadsheet-ParseExcel>.
+
+=item * Spreadsheet::ParseExcel_XLHTML
+
+This module uses Spreadsheet::ParseExcel's interface but uses xlHtml (see below) to do the conversion: L<http://search.cpan.org/dist/Spreadsheet-ParseExcel_XLHTML>
+Spreadsheet::ParseExcel_XLHTML
+
+=item * xlHtml
+
+This is an open source "Excel to HTML Converter" C/C++ project at L<http://chicago.sourceforge.net/xlhtml/>.
+
+=item * DBD::Excel (reading)
+
+You can also access Spreadsheet::ParseExcel using the standard DBI interface via Takanori Kawai's DBD::Excel module L<http://search.cpan.org/dist/DBD-Excel>.
+
+=item * Win32::OLE module and office automation (reading)
+
+See, the section L<WRITING EXCEL FILES>.
+
+=item * HTML tables (reading)
+
+If the files are saved from Excel in a HTML format the data can be accessed using HTML::TableExtract L<http://search.cpan.org/dist/HTML-TableExtract>.
+
+=item * DBI with DBD::ADO or DBD::ODBC.
+
+See, the section L<WRITING EXCEL FILES>.
+
+=item * XML::Excel
+
+Converts Excel files to XML using Spreadsheet::ParseExcel L<http://search.cpan.org/dist/XML-Excel>.
+
+=item * OLE::Storage, aka LAOLA
+
+This is a Perl interface to OLE file formats. In particular, the distro contains an Excel to HTML converter called Herbert, L<http://user.cs.tu-berlin.de/~schwartz/pmh/>. This has been superseded by the Spreadsheet::ParseExcel module.
+
+=back
+
+
+For other Perl-Excel modules try the following search: L<http://search.cpan.org/search?mode=module&query=excel>.
+
+If you wish to view Excel files on a UNIX/Linux platform check out the excellent Gnumeric spreadsheet application at L<http://www.gnome.org/projects/gnumeric/> or OpenOffice.org at L<http://www.openoffice.org/>.
+
+If you wish to view Excel files on a Windows platform which doesn't have Excel installed you can use the free Microsoft Excel Viewer L<http://office.microsoft.com/downloads/2000/xlviewer.aspx>.
+
+
+
+
+=head1 MODIFYING AND REWRITING EXCEL FILES
+
+An Excel file is a binary file within a binary file. It contains several interlinked checksums and changing even one byte can cause it to become corrupted.
+
+As such you cannot simply append or update an Excel file. The only way to achieve this is to read the entire file into memory, make the required changes or additions and then write the file out again.
+
+You can read and rewrite an Excel file using the Spreadsheet::ParseExcel::SaveParser module which is a wrapper around Spreadsheet::ParseExcel and Spreadsheet::WriteExcel. It is part of the Spreadsheet::ParseExcel package: L<http://search.cpan.org/search?dist=Spreadsheet-ParseExcel>.
+
+However, 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.
+
+Here is an example:
+
+ #!/usr/bin/perl -w
+
+ use strict;
+ use Spreadsheet::ParseExcel;
+ use Spreadsheet::ParseExcel::SaveParser;
+
+ # Open the template with SaveParser
+ my $parser = new Spreadsheet::ParseExcel::SaveParser;
+ my $template = $parser->Parse('template.xls');
+
+ my $sheet = 0;
+ my $row = 0;
+ my $col = 0;
+
+ # Get the format from the cell
+ my $format = $template->{Worksheet}[$sheet]
+ ->{Cells}[$row][$col]
+ ->{FormatNo};
+
+ # Write data to some cells
+ $template->AddCell(0, $row, $col, 1, $format);
+ $template->AddCell(0, $row+1, $col, "Hello", $format);
+
+ # Add a new worksheet
+ $template->AddWorksheet('New Data');
+
+ # The SaveParser SaveAs() method returns a reference to a
+ # Spreadsheet::WriteExcel object. If you wish you can then
+ # use this to access any of the methods that aren't
+ # available from the SaveParser object. If you don't need
+ # to do this just use SaveAs().
+ #
+ my $workbook;
+
+ {
+ # SaveAs generates a lot of harmless warnings about unset
+ # Worksheet properties. You can ignore them if you wish.
+ local $^W = 0;
+
+ # Rewrite the file or save as a new file
+ $workbook = $template->SaveAs('new.xls');
+ }
+
+ # Use Spreadsheet::WriteExcel methods
+ my $worksheet = $workbook->sheets(0);
+
+ $worksheet->write($row+2, $col, "World2");
+
+ $workbook->close();
+
+
+
+
+=head1 Warning about XML::Parser and perl 5.6
+
+You must be careful when using Spreadsheet::WriteExcel in conjunction with perl 5.6 and XML::Parser (and other XML parsers) due to the fact that the data returned by the parser is generally in C<UTF-8> format.
+
+When C<UTF-8> strings are added to Spreadsheet::WriteExcel's internal data it causes the generated Excel file to become corrupt.
+
+Note, this doesn't affect perl 5.005 (which doesn't try to handle C<UTF-8>) or 5.8 (which handles it correctly).
+
+To avoid this problem you should upgrade to perl 5.8, if possible, or else you should convert the output data from XML::Parser to ASCII or ISO-8859-1 using one of the following methods:
+
+ $new_str = pack 'C*', unpack 'U*', $utf8_str;
+
+
+ use Unicode::MapUTF8 'from_utf8';
+ $new_str = from_utf8({-str => $utf8_str, -charset => 'ISO-8859-1'});
+
+
+
+
+=head1 Warning about Office Service Pack 3
+
+If you have Office Service Pack 3 (SP3) installed you may see the following warning when you open a file created by Spreadsheet::WriteExcel:
+
+ "File Error: data may have been lost".
+
+This is usually caused by multiple instances of data in a cell.
+
+SP3 changed Excel's default behaviour when it encounters multiple data in a cell so that it issues a warning when the file is opened and it displays the first data that was written. Prior to SP3 it didn't issue a warning and displayed the last data written.
+
+For a longer discussion and some workarounds see the following: L<http://groups.google.com/group/spreadsheet-writeexcel/browse_thread/thread/3dcea40e6620af3a>.
+
+
+
+
+=head1 BUGS
+
+Formulas are formulae.
+
+XML and C<UTF-8> data on perl 5.6 can cause Excel files created by Spreadsheet::WriteExcel to become corrupt. See L<Warning about XML::Parser and perl 5.6> for further details.
+
+The format object that is used with a C<merge_range()> method call is marked internally as being associated with a merged range. It is a fatal error to use a merged format in a non-merged cell. The current workaround is to use separate formats for merged and non-merged cell. This restriction will be removed in a future release.
+
+Nested formulas sometimes aren't parsed correctly and give a result of "#VALUE". If you come across a formula that parses like this, let me know.
+
+Spreadsheet::ParseExcel: All formulas created by Spreadsheet::WriteExcel are read as having a value of zero. This is because Spreadsheet::WriteExcel only stores the formula and not the calculated result.
+
+OpenOffice.org: No known issues in this release.
+
+Gnumeric: No known issues in this release.
+
+If you wish to submit a bug report run the C<bug_report.pl> program in the C<examples> directory of the distro.
+
+
+
+
+=head1 TO DO
+
+The roadmap is as follows:
+
+=over 4
+
+=item * Enhance named ranges.
+
+=back
+
+Also, here are some of the most requested features that probably won't get added:
+
+=over 4
+
+=item * Macros.
+
+This would solve some other problems neatly. However, the format of Excel macros isn't documented.
+
+=item * Some feature that you really need. ;-)
+
+
+=back
+
+If there is some feature of an Excel file that you really, really need then you should use Win32::OLE with Excel on Windows. If you are on Unix you could consider connecting to a Windows server via Docserver or SOAP, see L<WRITING EXCEL FILES>.
+
+
+
+
+=head1 REPOSITORY
+
+The Spreadsheet::WriteExcel source code in host on github: L<http://github.com/jmcnamara/spreadsheet-writeexcel>.
+
+
+
+
+=head1 MAILING LIST
+
+There is a Google group for discussing and asking questions about Spreadsheet::WriteExcel. This is a good place to search to see if your question has been asked before: L<http://groups.google.com/group/spreadsheet-writeexcel>.
+
+=begin html
+
+<center>
+<table style="background-color: #fff; padding: 5px;" cellspacing=0>
+ <tr><td>
+ <img src="http://groups.google.com/intl/en/images/logos/groups_logo_sm.gif"
+ height=30 width=140 alt="Google Groups">
+ </td></tr>
+ <tr><td>
+ <a href="http://groups.google.com/group/spreadsheet-writeexcel">Spreadsheet::WriteExcel</a>
+ </td></tr>
+</table>
+</center>
+
+=end html
+
+
+
+Alternatively you can keep up to date with future releases by subscribing at:
+L<http://freshmeat.net/projects/writeexcel/>.
+
+
+
+
+=head1 DONATIONS
+
+If you'd care to donate to the Spreadsheet::WriteExcel project, you can do so via PayPal: L<http://tinyurl.com/7ayes>.
+
+
+
+
+=head1 SEE ALSO
+
+Spreadsheet::ParseExcel: L<http://search.cpan.org/dist/Spreadsheet-ParseExcel>.
+
+Spreadsheet-WriteExcel-FromXML: L<http://search.cpan.org/dist/Spreadsheet-WriteExcel-FromXML>.
+
+Spreadsheet::WriteExcel::FromDB: L<http://search.cpan.org/dist/Spreadsheet-WriteExcel-FromDB>.
+
+Excel::Template: L<http://search.cpan.org/~rkinyon/Excel-Template/>.
+
+DateTime::Format::Excel: L<http://search.cpan.org/dist/DateTime-Format-Excel>.
+
+"Reading and writing Excel files with Perl" by Teodor Zlatanov, at IBM developerWorks: L<http://www-106.ibm.com/developerworks/library/l-pexcel/>.
+
+"Excel-Dateien mit Perl erstellen - Controller im Gluck" by Peter Dintelmann and Christian Kirsch in the German Unix/web journal iX: L<http://www.heise.de/ix/artikel/2001/06/175/>.
+
+Spreadsheet::WriteExcel documentation in Japanese by Takanori Kawai. L<http://member.nifty.ne.jp/hippo2000/perltips/Spreadsheet/WriteExcel.htm>.
+
+Oesterly user brushes with fame:
+L<http://oesterly.com/releases/12102000.html>.
+
+The csv2xls program that is part of Text::CSV_XS:
+L<http://search.cpan.org/~hmbrand/Text-CSV_XS/MANIFEST>.
+
+
+
+=head1 ACKNOWLEDGMENTS
+
+
+The following people contributed to the debugging and testing of Spreadsheet::WriteExcel:
+
+Alexander Farber, Andre de Bruin, Arthur@ais, Artur Silveira da Cunha, Bob Rose, Borgar Olsen, Brian Foley, Brian White, Bob Mackay, Cedric Bouvier, Chad Johnson, CPAN testers, Damyan Ivanov, Daniel Berger, Daniel Gardner, Dmitry Kochurov, Eric Frazier, Ernesto Baschny, Felipe Perez Galiana, Gordon Simpson, Hanc Pavel, Harold Bamford, James Holmes, James Wilkinson, Johan Ekenberg, Johann Hanne, Jonathan Scott Duff, J.C. Wren, Kenneth Stacey, Keith Miller, Kyle Krom, Marc Rosenthal, Markus Schmitz, Michael Braig, Michael Buschauer, Mike Blazer, Michael Erickson, Michael W J West, Ning Xie, Paul J. Falbe, Paul Medynski, Peter Dintelmann, Pierre Laplante, Praveen Kotha, Reto Badertscher, Rich Sorden, Shane Ashby, Sharron McKenzie, Shenyu Zheng, Stephan Loescher, Steve Sapovits, Sven Passig, Svetoslav Marinov, Tamas Gulacsi, Troy Daniels, Vahe Sarkissian.
+
+The following people contributed patches, examples or Excel information:
+
+Andrew Benham, Bill Young, Cedric Bouvier, Charles Wybble, Daniel Rentz, David Robins, Franco Venturi, Guy Albertelli, Ian Penman, John Heitmann, Jon Guy, Kyle R. Burton, Pierre-Jean Vouette, Rubio, Marco Geri, Mark Fowler, Matisse Enzer, Sam Kington, Takanori Kawai, Tom O'Sullivan.
+
+Many thanks to Ron McKelvey, Ronzo Consulting for Siemens, who sponsored the development of the formula caching routines.
+
+Many thanks to Cassens Transport who sponsored the development of the embedded charts and autofilters.
+
+Additional thanks to Takanori Kawai for translating the documentation into Japanese.
+
+Gunnar Wolf maintains the Debian distro.
+
+Thanks to Damian Conway for the excellent Parse::RecDescent.
+
+Thanks to Tim Jenness for File::Temp.
+
+Thanks to Michael Meeks and Jody Goldberg for their work on Gnumeric.
+
+
+
+
+=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
+
+John McNamara jmcnamara@cpan.org
+
+ Another day in June, we'll pick eleven for football
+ (Pick eleven for football)
+ We're playing for our lives the referee gives us fuck all
+ (Ref you're giving us fuck all)
+ I saw you with the corner of my eye on the sidelines
+ Your dark mascara bids me to historical deeds
+
+ -- Belle and Sebastian
+
+
+
+
+=head1 COPYRIGHT
+
+Copyright MM-MMX, John McNamara.
+
+All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself.
+
diff --git a/mcu/tools/perl/Spreadsheet/WriteExcel/BIFFwriter.pm b/mcu/tools/perl/Spreadsheet/WriteExcel/BIFFwriter.pm
new file mode 100644
index 0000000..7f618a7
--- /dev/null
+++ b/mcu/tools/perl/Spreadsheet/WriteExcel/BIFFwriter.pm
@@ -0,0 +1,316 @@
+package Spreadsheet::WriteExcel::BIFFwriter;
+
+###############################################################################
+#
+# BIFFwriter - An abstract base class for Excel workbooks and worksheets.
+#
+#
+# Used in conjunction with Spreadsheet::WriteExcel
+#
+# Copyright 2000-2010, John McNamara, jmcnamara@cpan.org
+#
+# Documentation after __END__
+#
+
+use Exporter;
+use strict;
+
+
+
+
+
+
+
+use vars qw($VERSION @ISA);
+@ISA = qw(Exporter);
+
+$VERSION = '2.37';
+
+###############################################################################
+#
+# Class data.
+#
+my $byte_order = '';
+my $BIFF_version = 0x0600;
+
+
+###############################################################################
+#
+# new()
+#
+# Constructor
+#
+sub new {
+
+ my $class = $_[0];
+
+ my $self = {
+ _byte_order => '',
+ _data => '',
+ _datasize => 0,
+ _limit => 8224,
+ _ignore_continue => 0,
+ };
+
+ bless $self, $class;
+ $self->_set_byte_order();
+ return $self;
+}
+
+
+###############################################################################
+#
+# _set_byte_order()
+#
+# Determine the byte order and store it as class data to avoid
+# recalculating it for each call to new().
+#
+sub _set_byte_order {
+
+ my $self = shift;
+
+ if ($byte_order eq ''){
+ # Check if "pack" gives the required IEEE 64bit float
+ my $teststr = pack "d", 1.2345;
+ my @hexdata =(0x8D, 0x97, 0x6E, 0x12, 0x83, 0xC0, 0xF3, 0x3F);
+ my $number = pack "C8", @hexdata;
+
+ if ($number eq $teststr) {
+ $byte_order = 0; # Little Endian
+ }
+ elsif ($number eq reverse($teststr)){
+ $byte_order = 1; # Big Endian
+ }
+ else {
+ # Give up. I'll fix this in a later version.
+ croak ( "Required floating point format not supported " .
+ "on this platform. See the portability section " .
+ "of the documentation."
+ );
+ }
+ }
+ $self->{_byte_order} = $byte_order;
+}
+
+
+###############################################################################
+#
+# _prepend($data)
+#
+# General storage function
+#
+sub _prepend {
+
+ my $self = shift;
+ my $data = join('', @_);
+
+ $data = $self->_add_continue($data) if length($data) > $self->{_limit};
+
+ $self->{_data} = $data . $self->{_data};
+ $self->{_datasize} += length($data);
+
+ return $data;
+}
+
+
+###############################################################################
+#
+# _append($data)
+#
+# General storage function
+#
+sub _append {
+
+ my $self = shift;
+ my $data = join('', @_);
+
+ $data = $self->_add_continue($data) if length($data) > $self->{_limit};
+
+ $self->{_data} = $self->{_data} . $data;
+ $self->{_datasize} += length($data);
+
+ return $data;
+}
+
+
+###############################################################################
+#
+# _store_bof($type)
+#
+# $type = 0x0005, Workbook
+# $type = 0x0010, Worksheet
+# $type = 0x0020, Chart
+#
+# Writes Excel BOF record to indicate the beginning of a stream or
+# sub-stream in the BIFF file.
+#
+sub _store_bof {
+
+ my $self = shift;
+ my $record = 0x0809; # Record identifier
+ my $length = 0x0010; # Number of bytes to follow
+
+ my $version = $BIFF_version;
+ my $type = $_[0];
+
+ # According to the SDK $build and $year should be set to zero.
+ # However, this throws a warning in Excel 5. So, use these
+ # magic numbers.
+ my $build = 0x0DBB;
+ my $year = 0x07CC;
+
+ my $bfh = 0x00000041;
+ my $sfo = 0x00000006;
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("vvvvVV", $version, $type, $build, $year, $bfh, $sfo);
+
+ $self->_prepend($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_eof()
+#
+# Writes Excel EOF record to indicate the end of a BIFF stream.
+#
+sub _store_eof {
+
+ my $self = shift;
+ my $record = 0x000A; # Record identifier
+ my $length = 0x0000; # Number of bytes to follow
+
+ my $header = pack("vv", $record, $length);
+
+ $self->_append($header);
+}
+
+
+###############################################################################
+#
+# _add_continue()
+#
+# Excel limits the size of BIFF records. In Excel 5 the limit is 2084 bytes. In
+# Excel 97 the limit is 8228 bytes. Records that are longer than these limits
+# must be split up into CONTINUE blocks.
+#
+# This function take a long BIFF record and inserts CONTINUE records as
+# necessary.
+#
+# Some records have their own specialised Continue blocks so there is also an
+# option to bypass this function.
+#
+sub _add_continue {
+
+ my $self = shift;
+ my $data = $_[0];
+ my $limit = $self->{_limit};
+ my $record = 0x003C; # Record identifier
+ my $header;
+ my $tmp;
+
+ # Skip this if another method handles the continue blocks.
+ return $data if $self->{_ignore_continue};
+
+ # The first 2080/8224 bytes remain intact. However, we have to change
+ # the length field of the record.
+ #
+ $tmp = substr($data, 0, $limit, "");
+ substr($tmp, 2, 2, pack("v", $limit-4));
+
+ # Strip out chunks of 2080/8224 bytes +4 for the header.
+ while (length($data) > $limit) {
+ $header = pack("vv", $record, $limit);
+ $tmp .= $header;
+ $tmp .= substr($data, 0, $limit, "");
+ }
+
+ # Mop up the last of the data
+ $header = pack("vv", $record, length($data));
+ $tmp .= $header;
+ $tmp .= $data;
+
+ return $tmp ;
+}
+
+
+###############################################################################
+#
+# _add_mso_generic()
+#
+# Create a mso structure that is part of an Escher drawing object. These are
+# are used for images, comments and filters. This generic method is used by
+# other methods to create specific mso records.
+#
+# Returns the packed record.
+#
+sub _add_mso_generic {
+
+ my $self = shift;
+ my $type = $_[0];
+ my $version = $_[1];
+ my $instance = $_[2];
+ my $data = $_[3];
+ my $length = defined $_[4] ? $_[4] : length($data);
+
+ # The header contains version and instance info packed into 2 bytes.
+ my $header = $version | ($instance << 4);
+
+ my $record = pack "vvV", $header, $type, $length;
+ $record .= $data;
+
+ return $record;
+}
+
+
+###############################################################################
+#
+# For debugging
+#
+sub _hexout {
+
+ my $self = shift;
+
+ print +(caller(1))[3], "\n";
+
+ my $data = join '', @_;
+
+ my @bytes = unpack("H*", $data) =~ /../g;
+
+ while (@bytes > 16) {
+ print join " ", splice @bytes, 0, 16;
+ print "\n";
+ }
+ print join " ", @bytes, "\n\n";
+}
+
+
+
+1;
+
+
+__END__
+
+
+=head1 NAME
+
+BIFFwriter - An abstract base class for Excel workbooks and worksheets.
+
+=head1 SYNOPSIS
+
+See the documentation for Spreadsheet::WriteExcel
+
+=head1 DESCRIPTION
+
+This module is used in conjunction with Spreadsheet::WriteExcel.
+
+=head1 AUTHOR
+
+John McNamara jmcnamara@cpan.org
+
+=head1 COPYRIGHT
+
+© MM-MMX, John McNamara.
+
+All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself.
diff --git a/mcu/tools/perl/Spreadsheet/WriteExcel/Big.pm b/mcu/tools/perl/Spreadsheet/WriteExcel/Big.pm
new file mode 100644
index 0000000..2f26fe6
--- /dev/null
+++ b/mcu/tools/perl/Spreadsheet/WriteExcel/Big.pm
@@ -0,0 +1,94 @@
+package Spreadsheet::WriteExcel::Big;
+
+###############################################################################
+#
+# WriteExcel::Big
+#
+# Spreadsheet::WriteExcel - Write formatted text and numbers to a
+# cross-platform Excel binary file.
+#
+# Copyright 2000-2010, John McNamara.
+#
+#
+
+require Exporter;
+
+use strict;
+use Spreadsheet::WriteExcel::Workbook;
+
+
+
+
+
+
+use vars qw($VERSION @ISA);
+@ISA = qw(Spreadsheet::WriteExcel::Workbook Exporter);
+
+$VERSION = '2.37';
+
+###############################################################################
+#
+# new()
+#
+# Constructor. Thin wrapper for a Workbook object.
+#
+# This module is no longer required directly and its use is deprecated. See
+# the Pod documentation below.
+#
+sub new {
+
+ my $class = shift;
+ my $self = Spreadsheet::WriteExcel::Workbook->new(@_);
+
+ # Check for file creation failures before re-blessing
+ bless $self, $class if defined $self;
+
+ return $self;
+}
+
+
+1;
+
+
+__END__
+
+
+
+=head1 NAME
+
+
+Big - A class for creating Excel files > 7MB.
+
+
+=head1 SYNOPSIS
+
+Use of this module is deprecated. See below.
+
+
+=head1 DESCRIPTION
+
+The module was a sub-class of Spreadsheet::WriteExcel used for creating Excel files greater than 7MB. However, it is no longer required and is now deprecated.
+
+As of version 2.17 Spreadsheet::WriteExcel can create files larger than 7MB directly if OLE::Storage_Lite is installed.
+
+This module only exists for backwards compatibility. If your programs use ::Big you should convert them to use Spreadsheet::WritExcel directly.
+
+
+=head1 REQUIREMENTS
+
+L<OLE::Storage_Lite>.
+
+
+=head1 AUTHOR
+
+
+John McNamara jmcnamara@cpan.org
+
+
+=head1 COPYRIGHT
+
+
+© MM-MMX, John McNamara.
+
+
+All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself.
diff --git a/mcu/tools/perl/Spreadsheet/WriteExcel/Chart.pm b/mcu/tools/perl/Spreadsheet/WriteExcel/Chart.pm
new file mode 100644
index 0000000..892f492
--- /dev/null
+++ b/mcu/tools/perl/Spreadsheet/WriteExcel/Chart.pm
@@ -0,0 +1,3062 @@
+package Spreadsheet::WriteExcel::Chart;
+
+###############################################################################
+#
+# Chart - A writer class for Excel Charts.
+#
+# Used in conjunction with Spreadsheet::WriteExcel.
+#
+# Copyright 2000-2010, John McNamara, jmcnamara@cpan.org
+#
+# Documentation after __END__
+#
+
+use Exporter;
+use strict;
+use Carp;
+use FileHandle;
+use Spreadsheet::WriteExcel::Worksheet;
+
+
+use vars qw($VERSION @ISA);
+@ISA = qw(Spreadsheet::WriteExcel::Worksheet);
+
+$VERSION = '2.37';
+
+###############################################################################
+#
+# Formatting information.
+#
+# perltidy with options: -mbl=2 -pt=0 -nola
+#
+# Any camel case Hungarian notation style variable names in the BIFF record
+# writing sub-routines below are for similarity with names used in the Excel
+# documentation. Otherwise lowercase underscore style names are used.
+#
+
+
+###############################################################################
+#
+# The chart class hierarchy is as follows. Chart.pm acts as a factory for the
+# sub-classes.
+#
+#
+# Spreadsheet::WriteExcel::BIFFwriter
+# ^
+# |
+# Spreadsheet::WriteExcel::Worksheet
+# ^
+# |
+# Spreadsheet::WriteExcel::Chart
+# ^
+# |
+# Spreadsheet::WriteExcel::Chart::* (sub-types)
+#
+
+
+###############################################################################
+#
+# factory()
+#
+# Factory method for returning chart objects based on their class type.
+#
+sub factory {
+
+ my $current_class = shift;
+ my $chart_subclass = shift;
+
+ $chart_subclass = ucfirst lc $chart_subclass;
+
+ my $module = "Spreadsheet::WriteExcel::Chart::" . $chart_subclass;
+
+ eval "require $module";
+
+ # TODO. Need to re-raise this error from Workbook::add_chart().
+ die "Chart type '$chart_subclass' not supported in add_chart()\n" if $@;
+
+ return $module->new( @_ );
+}
+
+
+###############################################################################
+#
+# new()
+#
+# Default constructor for sub-classes.
+#
+sub new {
+
+ my $class = shift;
+ my $self = Spreadsheet::WriteExcel::Worksheet->new( @_ );
+
+ $self->{_sheet_type} = 0x0200;
+ $self->{_orientation} = 0x0;
+ $self->{_series} = [];
+ $self->{_embedded} = 0;
+
+ bless $self, $class;
+ $self->_set_default_properties();
+ $self->_set_default_config_data();
+ return $self;
+}
+
+
+###############################################################################
+#
+# Public methods.
+#
+###############################################################################
+
+
+###############################################################################
+#
+# add_series()
+#
+# Add a series and it's properties to a chart.
+#
+sub add_series {
+
+ my $self = shift;
+ my %arg = @_;
+
+ croak "Must specify 'values' in add_series()" if !exists $arg{values};
+
+ # Parse the ranges to validate them and extract salient information.
+ my @value_data = $self->_parse_series_formula( $arg{values} );
+ my @category_data = $self->_parse_series_formula( $arg{categories} );
+ my $name_formula = $self->_parse_series_formula( $arg{name_formula} );
+
+ # Default category count to the same as the value count if not defined.
+ if ( !defined $category_data[1] ) {
+ $category_data[1] = $value_data[1];
+ }
+
+ # Add the parsed data to the user supplied data.
+ %arg = (
+ @_,
+ _values => \@value_data,
+ _categories => \@category_data,
+ _name_formula => $name_formula
+ );
+
+ # Encode the Series name.
+ my ( $name, $encoding ) =
+ $self->_encode_utf16( $arg{name}, $arg{name_encoding} );
+
+ $arg{name} = $name;
+ $arg{name_encoding} = $encoding;
+
+ push @{ $self->{_series} }, \%arg;
+}
+
+
+###############################################################################
+#
+# set_x_axis()
+#
+# Set the properties of the X-axis.
+#
+sub set_x_axis {
+
+ my $self = shift;
+ my %arg = @_;
+
+ my ( $name, $encoding ) =
+ $self->_encode_utf16( $arg{name}, $arg{name_encoding} );
+
+ my $formula = $self->_parse_series_formula( $arg{name_formula} );
+
+ $self->{_x_axis_name} = $name;
+ $self->{_x_axis_encoding} = $encoding;
+ $self->{_x_axis_formula} = $formula;
+}
+
+
+###############################################################################
+#
+# set_y_axis()
+#
+# Set the properties of the Y-axis.
+#
+sub set_y_axis {
+
+ my $self = shift;
+ my %arg = @_;
+
+ my ( $name, $encoding ) =
+ $self->_encode_utf16( $arg{name}, $arg{name_encoding} );
+
+ my $formula = $self->_parse_series_formula( $arg{name_formula} );
+
+ $self->{_y_axis_name} = $name;
+ $self->{_y_axis_encoding} = $encoding;
+ $self->{_y_axis_formula} = $formula;
+}
+
+
+###############################################################################
+#
+# set_title()
+#
+# Set the properties of the chart title.
+#
+sub set_title {
+
+ my $self = shift;
+ my %arg = @_;
+
+ my ( $name, $encoding ) =
+ $self->_encode_utf16( $arg{name}, $arg{name_encoding} );
+
+ my $formula = $self->_parse_series_formula( $arg{name_formula} );
+
+ $self->{_title_name} = $name;
+ $self->{_title_encoding} = $encoding;
+ $self->{_title_formula} = $formula;
+}
+
+
+###############################################################################
+#
+# set_legend()
+#
+# Set the properties of the chart legend.
+#
+sub set_legend {
+
+ my $self = shift;
+ my %arg = @_;
+
+ if ( defined $arg{position} ) {
+ if ( lc $arg{position} eq 'none' ) {
+ $self->{_legend}->{_visible} = 0;
+ }
+ }
+}
+
+
+###############################################################################
+#
+# set_plotarea()
+#
+# Set the properties of the chart plotarea.
+#
+sub set_plotarea {
+
+ my $self = shift;
+ my %arg = @_;
+ return unless keys %arg;
+
+ my $area = $self->{_plotarea};
+
+ # Set the plotarea visibility.
+ if ( defined $arg{visible} ) {
+ $area->{_visible} = $arg{visible};
+ return if !$area->{_visible};
+ }
+
+ # TODO. could move this out of if statement.
+ $area->{_bg_color_index} = 0x08;
+
+ # Set the chart background colour.
+ if ( defined $arg{color} ) {
+ my ( $index, $rgb ) = $self->_get_color_indices( $arg{color} );
+ if ( defined $index ) {
+ $area->{_fg_color_index} = $index;
+ $area->{_fg_color_rgb} = $rgb;
+ $area->{_bg_color_index} = 0x08;
+ $area->{_bg_color_rgb} = 0x000000;
+ }
+ }
+
+ # Set the border line colour.
+ if ( defined $arg{line_color} ) {
+ my ( $index, $rgb ) = $self->_get_color_indices( $arg{line_color} );
+ if ( defined $index ) {
+ $area->{_line_color_index} = $index;
+ $area->{_line_color_rgb} = $rgb;
+ }
+ }
+
+ # Set the border line pattern.
+ if ( defined $arg{line_pattern} ) {
+ my $pattern = $self->_get_line_pattern( $arg{line_pattern} );
+ $area->{_line_pattern} = $pattern;
+ }
+
+ # Set the border line weight.
+ if ( defined $arg{line_weight} ) {
+ my $weight = $self->_get_line_weight( $arg{line_weight} );
+ $area->{_line_weight} = $weight;
+ }
+}
+
+
+###############################################################################
+#
+# set_chartarea()
+#
+# Set the properties of the chart chartarea.
+#
+sub set_chartarea {
+
+ my $self = shift;
+ my %arg = @_;
+ return unless keys %arg;
+
+ my $area = $self->{_chartarea};
+
+ # Embedded automatic line weight has a different default value.
+ $area->{_line_weight} = 0xFFFF if $self->{_embedded};
+
+
+ # Set the chart background colour.
+ if ( defined $arg{color} ) {
+ my ( $index, $rgb ) = $self->_get_color_indices( $arg{color} );
+ if ( defined $index ) {
+ $area->{_fg_color_index} = $index;
+ $area->{_fg_color_rgb} = $rgb;
+ $area->{_bg_color_index} = 0x08;
+ $area->{_bg_color_rgb} = 0x000000;
+ $area->{_area_pattern} = 1;
+ $area->{_area_options} = 0x0000 if $self->{_embedded};
+ $area->{_visible} = 1;
+ }
+ }
+
+ # Set the border line colour.
+ if ( defined $arg{line_color} ) {
+ my ( $index, $rgb ) = $self->_get_color_indices( $arg{line_color} );
+ if ( defined $index ) {
+ $area->{_line_color_index} = $index;
+ $area->{_line_color_rgb} = $rgb;
+ $area->{_line_pattern} = 0x00;
+ $area->{_line_options} = 0x0000;
+ $area->{_visible} = 1;
+ }
+ }
+
+ # Set the border line pattern.
+ if ( defined $arg{line_pattern} ) {
+ my $pattern = $self->_get_line_pattern( $arg{line_pattern} );
+ $area->{_line_pattern} = $pattern;
+ $area->{_line_options} = 0x0000;
+ $area->{_line_color_index} = 0x4F if !defined $arg{line_color};
+ $area->{_visible} = 1;
+ }
+
+ # Set the border line weight.
+ if ( defined $arg{line_weight} ) {
+ my $weight = $self->_get_line_weight( $arg{line_weight} );
+ $area->{_line_weight} = $weight;
+ $area->{_line_options} = 0x0000;
+ $area->{_line_pattern} = 0x00 if !defined $arg{line_pattern};
+ $area->{_line_color_index} = 0x4F if !defined $arg{line_color};
+ $area->{_visible} = 1;
+ }
+}
+
+
+###############################################################################
+#
+# Internal methods. The following section of methods are used for the internal
+# structuring of the Chart object and file format.
+#
+###############################################################################
+
+
+###############################################################################
+#
+# _prepend(), overridden.
+#
+# The parent Worksheet class needs to store some data in memory and some in
+# temporary files for efficiency. The Chart* classes don't need to do this
+# since they are dealing with smaller amounts of data so we override
+# _prepend() to turn it into an _append() method. This allows for a more
+# natural method calling order.
+#
+sub _prepend {
+
+ my $self = shift;
+
+ $self->{_using_tmpfile} = 0;
+
+ return $self->_append( @_ );
+}
+
+
+###############################################################################
+#
+# _close(), overridden.
+#
+# Create and store the Chart data structures.
+#
+sub _close {
+
+ my $self = shift;
+
+ # Ignore any data that has been written so far since it is probably
+ # from unwanted Worksheet method calls.
+ $self->{_data} = '';
+
+ # TODO. Check for charts without a series?
+
+ # Store the chart BOF.
+ $self->_store_bof( 0x0020 );
+
+ # Store the page header
+ $self->_store_header();
+
+ # Store the page footer
+ $self->_store_footer();
+
+ # Store the page horizontal centering
+ $self->_store_hcenter();
+
+ # Store the page vertical centering
+ $self->_store_vcenter();
+
+ # Store the left margin
+ $self->_store_margin_left();
+
+ # Store the right margin
+ $self->_store_margin_right();
+
+ # Store the top margin
+ $self->_store_margin_top();
+
+ # Store the bottom margin
+ $self->_store_margin_bottom();
+
+ # Store the page setup
+ $self->_store_setup();
+
+ # Store the sheet password
+ $self->_store_password();
+
+ # Start of Chart specific records.
+
+ # Store the FBI font records.
+ $self->_store_fbi( @{ $self->{_config}->{_font_numbers} } );
+ $self->_store_fbi( @{ $self->{_config}->{_font_series} } );
+ $self->_store_fbi( @{ $self->{_config}->{_font_title} } );
+ $self->_store_fbi( @{ $self->{_config}->{_font_axes} } );
+
+ # Ignore UNITS record.
+
+ # Store the Chart sub-stream.
+ $self->_store_chart_stream();
+
+ # Append the sheet dimensions
+ $self->_store_dimensions();
+
+ # TODO add SINDEX and NUMBER records.
+
+ if ( !$self->{_embedded} ) {
+ $self->_store_window2();
+ }
+
+ $self->_store_eof();
+}
+
+
+###############################################################################
+#
+# _store_window2(), overridden.
+#
+# Write BIFF record Window2. Note, this overrides the parent Worksheet
+# record because the Chart version of the record is smaller and is used
+# mainly to indicate if the chart tab is selected or not.
+#
+sub _store_window2 {
+
+ use integer; # Avoid << shift bug in Perl 5.6.0 on HP-UX
+
+ my $self = shift;
+
+ my $record = 0x023E; # Record identifier
+ my $length = 0x000A; # Number of bytes to follow
+ my $grbit = 0x0000; # Option flags
+ my $rwTop = 0x0000; # Top visible row
+ my $colLeft = 0x0000; # Leftmost visible column
+ my $rgbHdr = 0x0000; # Row/col heading, grid color
+
+ # The options flags that comprise $grbit
+ my $fDspFmla = 0; # 0 - bit
+ my $fDspGrid = 0; # 1
+ my $fDspRwCol = 0; # 2
+ my $fFrozen = 0; # 3
+ my $fDspZeros = 0; # 4
+ my $fDefaultHdr = 0; # 5
+ my $fArabic = 0; # 6
+ my $fDspGuts = 0; # 7
+ my $fFrozenNoSplit = 0; # 0 - bit
+ my $fSelected = $self->{_selected}; # 1
+ my $fPaged = 0; # 2
+ my $fBreakPreview = 0; # 3
+
+ #<<< Perltidy ignore this.
+ $grbit = $fDspFmla;
+ $grbit |= $fDspGrid << 1;
+ $grbit |= $fDspRwCol << 2;
+ $grbit |= $fFrozen << 3;
+ $grbit |= $fDspZeros << 4;
+ $grbit |= $fDefaultHdr << 5;
+ $grbit |= $fArabic << 6;
+ $grbit |= $fDspGuts << 7;
+ $grbit |= $fFrozenNoSplit << 8;
+ $grbit |= $fSelected << 9;
+ $grbit |= $fPaged << 10;
+ $grbit |= $fBreakPreview << 11;
+ #>>>
+
+ my $header = pack( "vv", $record, $length );
+ my $data = pack( "vvvV", $grbit, $rwTop, $colLeft, $rgbHdr );
+
+ $self->_append( $header, $data );
+}
+
+
+###############################################################################
+#
+# _parse_series_formula()
+#
+# Parse the formula used to define a series. We also extract some range
+# information required for _store_series() and the SERIES record.
+#
+sub _parse_series_formula {
+
+ my $self = shift;
+
+ my $formula = $_[0];
+ my $encoding = 0;
+ my $length = 0;
+ my $count = 0;
+ my @tokens;
+
+ return '' if !defined $formula;
+
+ # Strip the = sign at the beginning of the formula string
+ $formula =~ s(^=)();
+
+ # Parse the formula using the parser in Formula.pm
+ my $parser = $self->{_parser};
+
+ # In order to raise formula errors from the point of view of the calling
+ # program we use an eval block and re-raise the error from here.
+ #
+ eval { @tokens = $parser->parse_formula( $formula ) };
+
+ if ( $@ ) {
+ $@ =~ s/\n$//; # Strip the \n used in the Formula.pm die().
+ croak $@; # Re-raise the error.
+ }
+
+ # Force ranges to be a reference class.
+ s/_ref3d/_ref3dR/ for @tokens;
+ s/_range3d/_range3dR/ for @tokens;
+ s/_name/_nameR/ for @tokens;
+
+ # Parse the tokens into a formula string.
+ $formula = $parser->parse_tokens( @tokens );
+
+ # Return formula for a single cell as used by title and series name.
+ if ( ord $formula == 0x3A ) {
+ return $formula;
+ }
+
+ # Extract the range from the parse formula.
+ if ( ord $formula == 0x3B ) {
+ my ( $ptg, $ext_ref, $row_1, $row_2, $col_1, $col_2 ) = unpack 'Cv5',
+ $formula;
+
+ # TODO. Remove high bit on relative references.
+ $count = $row_2 - $row_1 + 1;
+ }
+
+ return ( $formula, $count );
+}
+
+###############################################################################
+#
+# _encode_utf16()
+#
+# Convert UTF8 strings used in the chart to UTF16.
+#
+sub _encode_utf16 {
+
+ my $self = shift;
+
+ my $string = shift;
+ my $encoding = shift || 0;
+
+ # Exit if the $string isn't defined, i.e., hasn't been set by user.
+ return ( undef, undef ) if !defined $string;
+
+ # Return if encoding is set, i.e., string has been manually encoded.
+ #return ( undef, undef ) if $string == 1;
+
+ # Handle utf8 strings in perl 5.8.
+ if ( $] >= 5.008 ) {
+ require Encode;
+
+ if ( Encode::is_utf8( $string ) ) {
+ $string = Encode::encode( "UTF-16BE", $string );
+ $encoding = 1;
+ }
+ }
+
+ # Chart strings are limited to 255 characters.
+ my $limit = $encoding ? 255 * 2 : 255;
+
+ if ( length $string >= $limit ) {
+
+ # truncate the string and raise a warning.
+ $string = substr $string, 0, $limit;
+ carp 'Chart strings must be less than 256 characters. '
+ . 'String truncated';
+ }
+
+ return ( $string, $encoding );
+}
+
+
+###############################################################################
+#
+# _get_color_indices()
+#
+# Convert the user specified colour index or string to an colour index and
+# RGB colour number.
+#
+sub _get_color_indices {
+
+ my $self = shift;
+ my $color = shift;
+ my $index;
+ my $rgb;
+
+ return ( undef, undef ) if !defined $color;
+
+ my %colors = (
+ aqua => 0x0F,
+ cyan => 0x0F,
+ black => 0x08,
+ blue => 0x0C,
+ brown => 0x10,
+ magenta => 0x0E,
+ fuchsia => 0x0E,
+ gray => 0x17,
+ grey => 0x17,
+ green => 0x11,
+ lime => 0x0B,
+ navy => 0x12,
+ orange => 0x35,
+ pink => 0x21,
+ purple => 0x14,
+ red => 0x0A,
+ silver => 0x16,
+ white => 0x09,
+ yellow => 0x0D,
+ );
+
+
+ # Check for the various supported colour index/name possibilities.
+ if ( exists $colors{$color} ) {
+
+ # Colour matches one of the supported colour names.
+ $index = $colors{$color};
+ }
+ elsif ( $color =~ m/\D/ ) {
+
+ # Return undef if $color is a string but not one of the supported ones.
+ return ( undef, undef );
+ }
+ elsif ( $color < 8 || $color > 63 ) {
+
+ # Return undef if index is out of range.
+ return ( undef, undef );
+ }
+ else {
+
+ # We should have a valid color index in a valid range.
+ $index = $color;
+ }
+
+ $rgb = $self->_get_color_rbg( $index );
+ return ( $index, $rgb );
+}
+
+
+###############################################################################
+#
+# _get_color_rbg()
+#
+# Get the RedGreenBlue number for the colour index from the Workbook palette.
+#
+sub _get_color_rbg {
+
+ my $self = shift;
+ my $index = shift;
+
+ # Adjust colour index from 8-63 (user range) to 0-55 (Excel range).
+ $index -= 8;
+
+ my @red_green_blue = @{ $self->{_palette}->[$index] };
+ return unpack 'V', pack 'C*', @red_green_blue;
+}
+
+
+###############################################################################
+#
+# _get_line_pattern()
+#
+# Get the Excel chart index for line pattern that corresponds to the user
+# defined value.
+#
+sub _get_line_pattern {
+
+ my $self = shift;
+ my $value = lc shift;
+ my $default = 0;
+ my $pattern;
+
+ my %patterns = (
+ 0 => 5,
+ 1 => 0,
+ 2 => 1,
+ 3 => 2,
+ 4 => 3,
+ 5 => 4,
+ 6 => 7,
+ 7 => 6,
+ 8 => 8,
+ 'solid' => 0,
+ 'dash' => 1,
+ 'dot' => 2,
+ 'dash-dot' => 3,
+ 'dash-dot-dot' => 4,
+ 'none' => 5,
+ 'dark-gray' => 6,
+ 'medium-gray' => 7,
+ 'light-gray' => 8,
+ );
+
+ if ( exists $patterns{$value} ) {
+ $pattern = $patterns{$value};
+ }
+ else {
+ $pattern = $default;
+ }
+
+ return $pattern;
+}
+
+
+###############################################################################
+#
+# _get_line_weight()
+#
+# Get the Excel chart index for line weight that corresponds to the user
+# defined value.
+#
+sub _get_line_weight {
+
+ my $self = shift;
+ my $value = lc shift;
+ my $default = 0;
+ my $weight;
+
+ my %weights = (
+ 1 => -1,
+ 2 => 0,
+ 3 => 1,
+ 4 => 2,
+ 'hairline' => -1,
+ 'narrow' => 0,
+ 'medium' => 1,
+ 'wide' => 2,
+ );
+
+ if ( exists $weights{$value} ) {
+ $weight = $weights{$value};
+ }
+ else {
+ $weight = $default;
+ }
+
+ return $weight;
+}
+
+
+###############################################################################
+#
+# _store_chart_stream()
+#
+# Store the CHART record and it's substreams.
+#
+sub _store_chart_stream {
+
+ my $self = shift;
+
+ $self->_store_chart( @{ $self->{_config}->{_chart} } );
+
+ $self->_store_begin();
+
+ # Ignore SCL record for now.
+ $self->_store_plotgrowth();
+
+ if ( $self->{_chartarea}->{_visible} ) {
+ $self->_store_chartarea_frame_stream();
+ }
+
+ # Store SERIES stream for each series.
+ my $index = 0;
+ for my $series ( @{ $self->{_series} } ) {
+
+ $self->_store_series_stream(
+ _index => $index,
+ _value_formula => $series->{_values}->[0],
+ _value_count => $series->{_values}->[1],
+ _category_count => $series->{_categories}->[1],
+ _category_formula => $series->{_categories}->[0],
+ _name => $series->{name},
+ _name_encoding => $series->{name_encoding},
+ _name_formula => $series->{_name_formula},
+ );
+
+ $index++;
+ }
+
+ $self->_store_shtprops();
+
+ # Write the TEXT streams.
+ for my $font_index ( 5 .. 6 ) {
+ $self->_store_defaulttext();
+ $self->_store_series_text_stream( $font_index );
+ }
+
+ $self->_store_axesused( 1 );
+ $self->_store_axisparent_stream();
+
+ if ( defined $self->{_title_name} || defined $self->{_title_formula} ) {
+ $self->_store_title_text_stream();
+ }
+
+ $self->_store_end();
+
+}
+
+
+###############################################################################
+#
+# _store_series_stream()
+#
+# Write the SERIES chart substream.
+#
+sub _store_series_stream {
+
+ my $self = shift;
+ my %arg = @_;
+
+ my $name_type = $arg{_name_formula} ? 2 : 1;
+ my $value_type = $arg{_value_formula} ? 2 : 0;
+ my $category_type = $arg{_category_formula} ? 2 : 0;
+
+ $self->_store_series( $arg{_value_count}, $arg{_category_count} );
+
+ $self->_store_begin();
+
+ # Store the Series name AI record.
+ $self->_store_ai( 0, $name_type, $arg{_name_formula} );
+ if ( defined $arg{_name} ) {
+ $self->_store_seriestext( $arg{_name}, $arg{_name_encoding} );
+ }
+
+ $self->_store_ai( 1, $value_type, $arg{_value_formula} );
+ $self->_store_ai( 2, $category_type, $arg{_category_formula} );
+ $self->_store_ai( 3, 1, '' );
+
+ $self->_store_dataformat_stream( $arg{_index}, $arg{_index}, 0xFFFF );
+ $self->_store_sertocrt( 0 );
+ $self->_store_end();
+}
+
+
+###############################################################################
+#
+# _store_dataformat_stream()
+#
+# Write the DATAFORMAT chart substream.
+#
+sub _store_dataformat_stream {
+
+ my $self = shift;
+
+ my $series_index = shift;
+
+ $self->_store_dataformat( $series_index, $series_index, 0xFFFF );
+
+ $self->_store_begin();
+ $self->_store_3dbarshape();
+ $self->_store_end();
+}
+
+
+###############################################################################
+#
+# _store_series_text_stream()
+#
+# Write the series TEXT substream.
+#
+sub _store_series_text_stream {
+
+ my $self = shift;
+
+ my $font_index = shift;
+
+ $self->_store_text( @{ $self->{_config}->{_series_text} } );
+
+ $self->_store_begin();
+ $self->_store_pos( @{ $self->{_config}->{_series_text_pos} } );
+ $self->_store_fontx( $font_index );
+ $self->_store_ai( 0, 1, '' );
+ $self->_store_end();
+}
+
+
+###############################################################################
+#
+# _store_x_axis_text_stream()
+#
+# Write the X-axis TEXT substream.
+#
+sub _store_x_axis_text_stream {
+
+ my $self = shift;
+
+ my $formula = $self->{_x_axis_formula};
+ my $ai_type = $formula ? 2 : 1;
+
+ $self->_store_text( @{ $self->{_config}->{_x_axis_text} } );
+
+ $self->_store_begin();
+ $self->_store_pos( @{ $self->{_config}->{_x_axis_text_pos} } );
+ $self->_store_fontx( 8 );
+ $self->_store_ai( 0, $ai_type, $formula );
+
+ if ( defined $self->{_x_axis_name} ) {
+ $self->_store_seriestext( $self->{_x_axis_name},
+ $self->{_x_axis_encoding},
+ );
+ }
+
+ $self->_store_objectlink( 3 );
+ $self->_store_end();
+}
+
+
+###############################################################################
+#
+# _store_y_axis_text_stream()
+#
+# Write the Y-axis TEXT substream.
+#
+sub _store_y_axis_text_stream {
+
+ my $self = shift;
+
+ my $formula = $self->{_y_axis_formula};
+ my $ai_type = $formula ? 2 : 1;
+
+ $self->_store_text( @{ $self->{_config}->{_y_axis_text} } );
+
+ $self->_store_begin();
+ $self->_store_pos( @{ $self->{_config}->{_y_axis_text_pos} } );
+ $self->_store_fontx( 8 );
+ $self->_store_ai( 0, $ai_type, $formula );
+
+ if ( defined $self->{_y_axis_name} ) {
+ $self->_store_seriestext( $self->{_y_axis_name},
+ $self->{_y_axis_encoding},
+ );
+ }
+
+ $self->_store_objectlink( 2 );
+ $self->_store_end();
+}
+
+
+###############################################################################
+#
+# _store_legend_text_stream()
+#
+# Write the legend TEXT substream.
+#
+sub _store_legend_text_stream {
+
+ my $self = shift;
+
+ $self->_store_text( @{ $self->{_config}->{_legend_text} } );
+
+ $self->_store_begin();
+ $self->_store_pos( @{ $self->{_config}->{_legend_text_pos} } );
+ $self->_store_ai( 0, 1, '' );
+
+ $self->_store_end();
+}
+
+
+###############################################################################
+#
+# _store_title_text_stream()
+#
+# Write the title TEXT substream.
+#
+sub _store_title_text_stream {
+
+ my $self = shift;
+
+ my $formula = $self->{_title_formula};
+ my $ai_type = $formula ? 2 : 1;
+
+ $self->_store_text( @{ $self->{_config}->{_title_text} } );
+
+ $self->_store_begin();
+ $self->_store_pos( @{ $self->{_config}->{_title_text_pos} } );
+ $self->_store_fontx( 7 );
+ $self->_store_ai( 0, $ai_type, $formula );
+
+ if ( defined $self->{_title_name} ) {
+ $self->_store_seriestext( $self->{_title_name},
+ $self->{_title_encoding},
+ );
+ }
+
+ $self->_store_objectlink( 1 );
+ $self->_store_end();
+}
+
+
+###############################################################################
+#
+# _store_axisparent_stream()
+#
+# Write the AXISPARENT chart substream.
+#
+sub _store_axisparent_stream {
+
+ my $self = shift;
+
+ $self->_store_axisparent( @{ $self->{_config}->{_axisparent} } );
+
+ $self->_store_begin();
+ $self->_store_pos( @{ $self->{_config}->{_axisparent_pos} } );
+ $self->_store_axis_category_stream();
+ $self->_store_axis_values_stream();
+
+ if ( defined $self->{_x_axis_name} || defined $self->{_x_axis_formula} ) {
+ $self->_store_x_axis_text_stream();
+ }
+
+ if ( defined $self->{_y_axis_name} || defined $self->{_y_axis_formula} ) {
+ $self->_store_y_axis_text_stream();
+ }
+
+ if ( $self->{_plotarea}->{_visible} ) {
+ $self->_store_plotarea();
+ $self->_store_plotarea_frame_stream();
+ }
+
+ $self->_store_chartformat_stream();
+ $self->_store_end();
+}
+
+
+###############################################################################
+#
+# _store_axis_category_stream()
+#
+# Write the AXIS chart substream for the chart category.
+#
+sub _store_axis_category_stream {
+
+ my $self = shift;
+
+ $self->_store_axis( 0 );
+
+ $self->_store_begin();
+ $self->_store_catserrange();
+ $self->_store_axcext();
+ $self->_store_tick();
+ $self->_store_end();
+}
+
+
+###############################################################################
+#
+# _store_axis_values_stream()
+#
+# Write the AXIS chart substream for the chart values.
+#
+sub _store_axis_values_stream {
+
+ my $self = shift;
+
+ $self->_store_axis( 1 );
+
+ $self->_store_begin();
+ $self->_store_valuerange();
+ $self->_store_tick();
+ $self->_store_axislineformat();
+ $self->_store_lineformat( 0x00000000, 0x0000, 0xFFFF, 0x0009, 0x004D );
+ $self->_store_end();
+}
+
+
+###############################################################################
+#
+# _store_plotarea_frame_stream()
+#
+# Write the FRAME chart substream for the plotarea.
+#
+sub _store_plotarea_frame_stream {
+
+ my $self = shift;
+
+ my $area = $self->{_plotarea};
+
+ $self->_store_frame( 0x00, 0x03 );
+ $self->_store_begin();
+
+ $self->_store_lineformat(
+ $area->{_line_color_rgb}, $area->{_line_pattern},
+ $area->{_line_weight}, $area->{_line_options},
+ $area->{_line_color_index}
+ );
+
+ $self->_store_areaformat(
+ $area->{_fg_color_rgb}, $area->{_bg_color_rgb},
+ $area->{_area_pattern}, $area->{_area_options},
+ $area->{_fg_color_index}, $area->{_bg_color_index}
+ );
+
+ $self->_store_end();
+}
+
+
+###############################################################################
+#
+# _store_chartarea_frame_stream()
+#
+# Write the FRAME chart substream for the chartarea.
+#
+sub _store_chartarea_frame_stream {
+
+ my $self = shift;
+
+ my $area = $self->{_chartarea};
+
+ $self->_store_frame( 0x00, 0x02 );
+ $self->_store_begin();
+
+ $self->_store_lineformat(
+ $area->{_line_color_rgb}, $area->{_line_pattern},
+ $area->{_line_weight}, $area->{_line_options},
+ $area->{_line_color_index}
+ );
+
+ $self->_store_areaformat(
+ $area->{_fg_color_rgb}, $area->{_bg_color_rgb},
+ $area->{_area_pattern}, $area->{_area_options},
+ $area->{_fg_color_index}, $area->{_bg_color_index}
+ );
+
+ $self->_store_end();
+}
+
+###############################################################################
+#
+# _store_chartformat_stream()
+#
+# Write the CHARTFORMAT chart substream.
+#
+sub _store_chartformat_stream {
+
+ my $self = shift;
+
+ # The _vary_data_color is set by classes that need it, like Pie.
+ $self->_store_chartformat( $self->{_vary_data_color} );
+
+ $self->_store_begin();
+
+ # Store the BIFF record that will define the chart type.
+ $self->_store_chart_type();
+
+ # Note, the CHARTFORMATLINK record is only written by Excel.
+
+ if ( $self->{_legend}->{_visible} ) {
+ $self->_store_legend_stream();
+ }
+
+ $self->_store_marker_dataformat_stream();
+ $self->_store_end();
+}
+
+
+###############################################################################
+#
+# _store_chart_type()
+#
+# This is an abstract method that is overridden by the sub-classes to define
+# the chart types such as Column, Line, Pie, etc.
+#
+sub _store_chart_type {
+
+}
+
+
+###############################################################################
+#
+# _store_marker_dataformat_stream()
+#
+# This is an abstract method that is overridden by the sub-classes to define
+# properties of markers, linetypes, pie formats and other.
+#
+sub _store_marker_dataformat_stream {
+
+}
+
+
+###############################################################################
+#
+# _store_legend_stream()
+#
+# Write the LEGEND chart substream.
+#
+sub _store_legend_stream {
+
+ my $self = shift;
+
+ $self->_store_legend( @{ $self->{_config}->{_legend} } );
+
+ $self->_store_begin();
+ $self->_store_pos( @{ $self->{_config}->{_legend_pos} } );
+ $self->_store_legend_text_stream();
+ $self->_store_end();
+}
+
+
+###############################################################################
+#
+# BIFF Records.
+#
+###############################################################################
+
+
+###############################################################################
+#
+# _store_3dbarshape()
+#
+# Write the 3DBARSHAPE chart BIFF record.
+#
+sub _store_3dbarshape {
+
+ my $self = shift;
+
+ my $record = 0x105F; # Record identifier.
+ my $length = 0x0002; # Number of bytes to follow.
+ my $riser = 0x00; # Shape of base.
+ my $taper = 0x00; # Column taper type.
+
+ my $header = pack 'vv', $record, $length;
+ my $data = '';
+ $data .= pack 'C', $riser;
+ $data .= pack 'C', $taper;
+
+ $self->_append( $header, $data );
+}
+
+
+###############################################################################
+#
+# _store_ai()
+#
+# Write the AI chart BIFF record.
+#
+sub _store_ai {
+
+ my $self = shift;
+
+ my $record = 0x1051; # Record identifier.
+ my $length = 0x0008; # Number of bytes to follow.
+ my $id = $_[0]; # Link index.
+ my $type = $_[1]; # Reference type.
+ my $formula = $_[2]; # Pre-parsed formula.
+ my $format_index = $_[3] || 0; # Num format index.
+ my $grbit = 0x0000; # Option flags.
+
+ my $formula_length = length $formula;
+
+ $length += $formula_length;
+
+ my $header = pack 'vv', $record, $length;
+ my $data = '';
+ $data .= pack 'C', $id;
+ $data .= pack 'C', $type;
+ $data .= pack 'v', $grbit;
+ $data .= pack 'v', $format_index;
+ $data .= pack 'v', $formula_length;
+ $data .= $formula;
+
+ $self->_append( $header, $data );
+}
+
+
+###############################################################################
+#
+# _store_areaformat()
+#
+# Write the AREAFORMAT chart BIFF record. Contains the patterns and colours
+# of a chart area.
+#
+sub _store_areaformat {
+
+ my $self = shift;
+
+ my $record = 0x100A; # Record identifier.
+ my $length = 0x0010; # Number of bytes to follow.
+ my $rgbFore = $_[0]; # Foreground RGB colour.
+ my $rgbBack = $_[1]; # Background RGB colour.
+ my $pattern = $_[2]; # Pattern.
+ my $grbit = $_[3]; # Option flags.
+ my $indexFore = $_[4]; # Index to Foreground colour.
+ my $indexBack = $_[5]; # Index to Background colour.
+
+ my $header = pack 'vv', $record, $length;
+ my $data = '';
+ $data .= pack 'V', $rgbFore;
+ $data .= pack 'V', $rgbBack;
+ $data .= pack 'v', $pattern;
+ $data .= pack 'v', $grbit;
+ $data .= pack 'v', $indexFore;
+ $data .= pack 'v', $indexBack;
+
+ $self->_append( $header, $data );
+}
+
+
+###############################################################################
+#
+# _store_axcext()
+#
+# Write the AXCEXT chart BIFF record.
+#
+sub _store_axcext {
+
+ my $self = shift;
+
+ my $record = 0x1062; # Record identifier.
+ my $length = 0x0012; # Number of bytes to follow.
+ my $catMin = 0x0000; # Minimum category on axis.
+ my $catMax = 0x0000; # Maximum category on axis.
+ my $catMajor = 0x0001; # Value of major unit.
+ my $unitMajor = 0x0000; # Units of major unit.
+ my $catMinor = 0x0001; # Value of minor unit.
+ my $unitMinor = 0x0000; # Units of minor unit.
+ my $unitBase = 0x0000; # Base unit of axis.
+ my $catCrossDate = 0x0000; # Crossing point.
+ my $grbit = 0x00EF; # Option flags.
+
+ my $header = pack 'vv', $record, $length;
+ my $data = '';
+ $data .= pack 'v', $catMin;
+ $data .= pack 'v', $catMax;
+ $data .= pack 'v', $catMajor;
+ $data .= pack 'v', $unitMajor;
+ $data .= pack 'v', $catMinor;
+ $data .= pack 'v', $unitMinor;
+ $data .= pack 'v', $unitBase;
+ $data .= pack 'v', $catCrossDate;
+ $data .= pack 'v', $grbit;
+
+ $self->_append( $header, $data );
+}
+
+
+###############################################################################
+#
+# _store_axesused()
+#
+# Write the AXESUSED chart BIFF record.
+#
+sub _store_axesused {
+
+ my $self = shift;
+
+ my $record = 0x1046; # Record identifier.
+ my $length = 0x0002; # Number of bytes to follow.
+ my $num_axes = $_[0]; # Number of axes used.
+
+ my $header = pack 'vv', $record, $length;
+ my $data = pack 'v', $num_axes;
+
+ $self->_append( $header, $data );
+}
+
+
+###############################################################################
+#
+# _store_axis()
+#
+# Write the AXIS chart BIFF record to define the axis type.
+#
+sub _store_axis {
+
+ my $self = shift;
+
+ my $record = 0x101D; # Record identifier.
+ my $length = 0x0012; # Number of bytes to follow.
+ my $type = $_[0]; # Axis type.
+ my $reserved1 = 0x00000000; # Reserved.
+ my $reserved2 = 0x00000000; # Reserved.
+ my $reserved3 = 0x00000000; # Reserved.
+ my $reserved4 = 0x00000000; # Reserved.
+
+ my $header = pack 'vv', $record, $length;
+ my $data = '';
+ $data .= pack 'v', $type;
+ $data .= pack 'V', $reserved1;
+ $data .= pack 'V', $reserved2;
+ $data .= pack 'V', $reserved3;
+ $data .= pack 'V', $reserved4;
+
+ $self->_append( $header, $data );
+}
+
+
+###############################################################################
+#
+# _store_axislineformat()
+#
+# Write the AXISLINEFORMAT chart BIFF record.
+#
+sub _store_axislineformat {
+
+ my $self = shift;
+
+ my $record = 0x1021; # Record identifier.
+ my $length = 0x0002; # Number of bytes to follow.
+ my $line_format = 0x0001; # Axis line format.
+
+ my $header = pack 'vv', $record, $length;
+ my $data = pack 'v', $line_format;
+
+ $self->_append( $header, $data );
+}
+
+
+###############################################################################
+#
+# _store_axisparent()
+#
+# Write the AXISPARENT chart BIFF record.
+#
+sub _store_axisparent {
+
+ my $self = shift;
+
+ my $record = 0x1041; # Record identifier.
+ my $length = 0x0012; # Number of bytes to follow.
+ my $iax = $_[0]; # Axis index.
+ my $x = $_[1]; # X-coord.
+ my $y = $_[2]; # Y-coord.
+ my $dx = $_[3]; # Length of x axis.
+ my $dy = $_[4]; # Length of y axis.
+
+ my $header = pack 'vv', $record, $length;
+ my $data = '';
+ $data .= pack 'v', $iax;
+ $data .= pack 'V', $x;
+ $data .= pack 'V', $y;
+ $data .= pack 'V', $dx;
+ $data .= pack 'V', $dy;
+
+ $self->_append( $header, $data );
+}
+
+
+###############################################################################
+#
+# _store_begin()
+#
+# Write the BEGIN chart BIFF record to indicate the start of a sub stream.
+#
+sub _store_begin {
+
+ my $self = shift;
+
+ my $record = 0x1033; # Record identifier.
+ my $length = 0x0000; # Number of bytes to follow.
+
+ my $header = pack 'vv', $record, $length;
+
+ $self->_append( $header );
+}
+
+
+###############################################################################
+#
+# _store_catserrange()
+#
+# Write the CATSERRANGE chart BIFF record.
+#
+sub _store_catserrange {
+
+ my $self = shift;
+
+ my $record = 0x1020; # Record identifier.
+ my $length = 0x0008; # Number of bytes to follow.
+ my $catCross = 0x0001; # Value/category crossing.
+ my $catLabel = 0x0001; # Frequency of labels.
+ my $catMark = 0x0001; # Frequency of ticks.
+ my $grbit = 0x0001; # Option flags.
+
+ my $header = pack 'vv', $record, $length;
+ my $data = '';
+ $data .= pack 'v', $catCross;
+ $data .= pack 'v', $catLabel;
+ $data .= pack 'v', $catMark;
+ $data .= pack 'v', $grbit;
+
+ $self->_append( $header, $data );
+}
+
+
+###############################################################################
+#
+# _store_chart()
+#
+# Write the CHART BIFF record. This indicates the start of the chart sub-stream
+# and contains dimensions of the chart on the display. Units are in 1/72 inch
+# and are 2 byte integer with 2 byte fraction.
+#
+sub _store_chart {
+
+ my $self = shift;
+
+ my $record = 0x1002; # Record identifier.
+ my $length = 0x0010; # Number of bytes to follow.
+ my $x_pos = $_[0]; # X pos of top left corner.
+ my $y_pos = $_[1]; # Y pos of top left corner.
+ my $dx = $_[2]; # X size.
+ my $dy = $_[3]; # Y size.
+
+ my $header = pack 'vv', $record, $length;
+ my $data = '';
+ $data .= pack 'V', $x_pos;
+ $data .= pack 'V', $y_pos;
+ $data .= pack 'V', $dx;
+ $data .= pack 'V', $dy;
+
+ $self->_append( $header, $data );
+}
+
+
+###############################################################################
+#
+# _store_chartformat()
+#
+# Write the CHARTFORMAT chart BIFF record. The parent record for formatting
+# of a chart group.
+#
+sub _store_chartformat {
+
+ my $self = shift;
+
+ my $record = 0x1014; # Record identifier.
+ my $length = 0x0014; # Number of bytes to follow.
+ my $reserved1 = 0x00000000; # Reserved.
+ my $reserved2 = 0x00000000; # Reserved.
+ my $reserved3 = 0x00000000; # Reserved.
+ my $reserved4 = 0x00000000; # Reserved.
+ my $grbit = $_[0] || 0; # Option flags.
+ my $icrt = 0x0000; # Drawing order.
+
+ my $header = pack 'vv', $record, $length;
+ my $data = '';
+ $data .= pack 'V', $reserved1;
+ $data .= pack 'V', $reserved2;
+ $data .= pack 'V', $reserved3;
+ $data .= pack 'V', $reserved4;
+ $data .= pack 'v', $grbit;
+ $data .= pack 'v', $icrt;
+
+ $self->_append( $header, $data );
+}
+
+
+###############################################################################
+#
+# _store_chartline()
+#
+# Write the CHARTLINE chart BIFF record.
+#
+sub _store_chartline {
+
+ my $self = shift;
+
+ my $record = 0x101C; # Record identifier.
+ my $length = 0x0002; # Number of bytes to follow.
+ my $type = 0x0001; # Drop/hi-lo line type.
+
+ my $header = pack 'vv', $record, $length;
+ my $data = pack 'v', $type;
+
+ $self->_append( $header, $data );
+}
+
+
+###############################################################################
+#
+# _store_charttext()
+#
+# Write the TEXT chart BIFF record.
+#
+sub _store_charttext {
+
+ my $self = shift;
+
+ my $record = 0x1025; # Record identifier.
+ my $length = 0x0020; # Number of bytes to follow.
+ my $horz_align = 0x02; # Horizontal alignment.
+ my $vert_align = 0x02; # Vertical alignment.
+ my $bg_mode = 0x0001; # Background display.
+ my $text_color_rgb = 0x00000000; # Text RGB colour.
+ my $text_x = 0xFFFFFF46; # Text x-pos.
+ my $text_y = 0xFFFFFF06; # Text y-pos.
+ my $text_dx = 0x00000000; # Width.
+ my $text_dy = 0x00000000; # Height.
+ my $grbit1 = 0x00B1; # Options
+ my $text_color_index = 0x004D; # Auto Colour.
+ my $grbit2 = 0x0000; # Data label placement.
+ my $rotation = 0x0000; # Text rotation.
+
+ my $header = pack 'vv', $record, $length;
+ my $data = '';
+ $data .= pack 'C', $horz_align;
+ $data .= pack 'C', $vert_align;
+ $data .= pack 'v', $bg_mode;
+ $data .= pack 'V', $text_color_rgb;
+ $data .= pack 'V', $text_x;
+ $data .= pack 'V', $text_y;
+ $data .= pack 'V', $text_dx;
+ $data .= pack 'V', $text_dy;
+ $data .= pack 'v', $grbit1;
+ $data .= pack 'v', $text_color_index;
+ $data .= pack 'v', $grbit2;
+ $data .= pack 'v', $rotation;
+
+ $self->_append( $header, $data );
+}
+
+
+###############################################################################
+#
+# _store_dataformat()
+#
+# Write the DATAFORMAT chart BIFF record. This record specifies the series
+# that the subsequent sub stream refers to.
+#
+sub _store_dataformat {
+
+ my $self = shift;
+
+ my $record = 0x1006; # Record identifier.
+ my $length = 0x0008; # Number of bytes to follow.
+ my $series_index = $_[0]; # Series index.
+ my $series_number = $_[1]; # Series number. (Same as index).
+ my $point_number = $_[2]; # Point number.
+ my $grbit = 0x0000; # Format flags.
+
+ my $header = pack 'vv', $record, $length;
+ my $data = '';
+ $data .= pack 'v', $point_number;
+ $data .= pack 'v', $series_index;
+ $data .= pack 'v', $series_number;
+ $data .= pack 'v', $grbit;
+
+ $self->_append( $header, $data );
+}
+
+
+###############################################################################
+#
+# _store_defaulttext()
+#
+# Write the DEFAULTTEXT chart BIFF record. Identifier for subsequent TEXT
+# record.
+#
+sub _store_defaulttext {
+
+ my $self = shift;
+
+ my $record = 0x1024; # Record identifier.
+ my $length = 0x0002; # Number of bytes to follow.
+ my $type = 0x0002; # Type.
+
+ my $header = pack 'vv', $record, $length;
+ my $data = pack 'v', $type;
+
+ $self->_append( $header, $data );
+}
+
+
+###############################################################################
+#
+# _store_dropbar()
+#
+# Write the DROPBAR chart BIFF record.
+#
+sub _store_dropbar {
+
+ my $self = shift;
+
+ my $record = 0x103D; # Record identifier.
+ my $length = 0x0002; # Number of bytes to follow.
+ my $percent_gap = 0x0096; # Drop bar width gap (%).
+
+ my $header = pack 'vv', $record, $length;
+ my $data = pack 'v', $percent_gap;
+
+ $self->_append( $header, $data );
+}
+
+
+###############################################################################
+#
+# _store_end()
+#
+# Write the END chart BIFF record to indicate the end of a sub stream.
+#
+sub _store_end {
+
+ my $self = shift;
+
+ my $record = 0x1034; # Record identifier.
+ my $length = 0x0000; # Number of bytes to follow.
+
+ my $header = pack 'vv', $record, $length;
+
+ $self->_append( $header );
+}
+
+
+###############################################################################
+#
+# _store_fbi()
+#
+# Write the FBI chart BIFF record. Specifies the font information at the time
+# it was applied to the chart.
+#
+sub _store_fbi {
+
+ my $self = shift;
+
+ my $record = 0x1060; # Record identifier.
+ my $length = 0x000A; # Number of bytes to follow.
+ my $index = $_[0]; # Font index.
+ my $height = $_[1] * 20; # Default font height in twips.
+ my $width_basis = $_[2]; # Width basis, in twips.
+ my $height_basis = $_[3]; # Height basis, in twips.
+ my $scale_basis = $_[4]; # Scale by chart area or plot area.
+
+ my $header = pack 'vv', $record, $length;
+ my $data = '';
+ $data .= pack 'v', $width_basis;
+ $data .= pack 'v', $height_basis;
+ $data .= pack 'v', $height;
+ $data .= pack 'v', $scale_basis;
+ $data .= pack 'v', $index;
+
+ $self->_append( $header, $data );
+}
+
+
+###############################################################################
+#
+# _store_fontx()
+#
+# Write the FONTX chart BIFF record which contains the index of the FONT
+# record in the Workbook.
+#
+sub _store_fontx {
+
+ my $self = shift;
+
+ my $record = 0x1026; # Record identifier.
+ my $length = 0x0002; # Number of bytes to follow.
+ my $index = $_[0]; # Font index.
+
+ my $header = pack 'vv', $record, $length;
+ my $data = pack 'v', $index;
+
+ $self->_append( $header, $data );
+}
+
+
+###############################################################################
+#
+# _store_frame()
+#
+# Write the FRAME chart BIFF record.
+#
+sub _store_frame {
+
+ my $self = shift;
+
+ my $record = 0x1032; # Record identifier.
+ my $length = 0x0004; # Number of bytes to follow.
+ my $frame_type = $_[0]; # Frame type.
+ my $grbit = $_[1]; # Option flags.
+
+ my $header = pack 'vv', $record, $length;
+ my $data = '';
+ $data .= pack 'v', $frame_type;
+ $data .= pack 'v', $grbit;
+
+ $self->_append( $header, $data );
+}
+
+
+###############################################################################
+#
+# _store_legend()
+#
+# Write the LEGEND chart BIFF record. The Marcus Horan method.
+#
+sub _store_legend {
+
+ my $self = shift;
+
+ my $record = 0x1015; # Record identifier.
+ my $length = 0x0014; # Number of bytes to follow.
+ my $x = $_[0]; # X-position.
+ my $y = $_[1]; # Y-position.
+ my $width = $_[2]; # Width.
+ my $height = $_[3]; # Height.
+ my $wType = $_[4]; # Type.
+ my $wSpacing = $_[5]; # Spacing.
+ my $grbit = $_[6]; # Option flags.
+
+ my $header = pack 'vv', $record, $length;
+ my $data = '';
+ $data .= pack 'V', $x;
+ $data .= pack 'V', $y;
+ $data .= pack 'V', $width;
+ $data .= pack 'V', $height;
+ $data .= pack 'C', $wType;
+ $data .= pack 'C', $wSpacing;
+ $data .= pack 'v', $grbit;
+
+ $self->_append( $header, $data );
+}
+
+
+###############################################################################
+#
+# _store_lineformat()
+#
+# Write the LINEFORMAT chart BIFF record.
+#
+sub _store_lineformat {
+
+ my $self = shift;
+
+ my $record = 0x1007; # Record identifier.
+ my $length = 0x000C; # Number of bytes to follow.
+ my $rgb = $_[0]; # Line RGB colour.
+ my $lns = $_[1]; # Line pattern.
+ my $we = $_[2]; # Line weight.
+ my $grbit = $_[3]; # Option flags.
+ my $index = $_[4]; # Index to colour of line.
+
+ my $header = pack 'vv', $record, $length;
+ my $data = '';
+ $data .= pack 'V', $rgb;
+ $data .= pack 'v', $lns;
+ $data .= pack 'v', $we;
+ $data .= pack 'v', $grbit;
+ $data .= pack 'v', $index;
+
+ $self->_append( $header, $data );
+}
+
+
+###############################################################################
+#
+# _store_markerformat()
+#
+# Write the MARKERFORMAT chart BIFF record.
+#
+sub _store_markerformat {
+
+ my $self = shift;
+
+ my $record = 0x1009; # Record identifier.
+ my $length = 0x0014; # Number of bytes to follow.
+ my $rgbFore = $_[0]; # Foreground RGB color.
+ my $rgbBack = $_[1]; # Background RGB color.
+ my $marker = $_[2]; # Type of marker.
+ my $grbit = $_[3]; # Format flags.
+ my $icvFore = $_[4]; # Color index marker border.
+ my $icvBack = $_[5]; # Color index marker fill.
+ my $miSize = $_[6]; # Size of line markers.
+
+ my $header = pack 'vv', $record, $length;
+ my $data = '';
+ $data .= pack 'V', $rgbFore;
+ $data .= pack 'V', $rgbBack;
+ $data .= pack 'v', $marker;
+ $data .= pack 'v', $grbit;
+ $data .= pack 'v', $icvFore;
+ $data .= pack 'v', $icvBack;
+ $data .= pack 'V', $miSize;
+
+ $self->_append( $header, $data );
+}
+
+
+###############################################################################
+#
+# _store_objectlink()
+#
+# Write the OBJECTLINK chart BIFF record.
+#
+sub _store_objectlink {
+
+ my $self = shift;
+
+ my $record = 0x1027; # Record identifier.
+ my $length = 0x0006; # Number of bytes to follow.
+ my $link_type = $_[0]; # Object text link type.
+ my $link_index1 = 0x0000; # Link index 1.
+ my $link_index2 = 0x0000; # Link index 2.
+
+ my $header = pack 'vv', $record, $length;
+ my $data = '';
+ $data .= pack 'v', $link_type;
+ $data .= pack 'v', $link_index1;
+ $data .= pack 'v', $link_index2;
+
+ $self->_append( $header, $data );
+}
+
+
+###############################################################################
+#
+# _store_pieformat()
+#
+# Write the PIEFORMAT chart BIFF record.
+#
+sub _store_pieformat {
+
+ my $self = shift;
+
+ my $record = 0x100B; # Record identifier.
+ my $length = 0x0002; # Number of bytes to follow.
+ my $percent = 0x0000; # Distance % from center.
+
+ my $header = pack 'vv', $record, $length;
+ my $data = '';
+ $data .= pack 'v', $percent;
+
+ $self->_append( $header, $data );
+}
+
+
+###############################################################################
+#
+# _store_plotarea()
+#
+# Write the PLOTAREA chart BIFF record. This indicates that the subsequent
+# FRAME record belongs to a plot area.
+#
+sub _store_plotarea {
+
+ my $self = shift;
+
+ my $record = 0x1035; # Record identifier.
+ my $length = 0x0000; # Number of bytes to follow.
+
+ my $header = pack 'vv', $record, $length;
+
+ $self->_append( $header );
+}
+
+
+###############################################################################
+#
+# _store_plotgrowth()
+#
+# Write the PLOTGROWTH chart BIFF record.
+#
+sub _store_plotgrowth {
+
+ my $self = shift;
+
+ my $record = 0x1064; # Record identifier.
+ my $length = 0x0008; # Number of bytes to follow.
+ my $dx_plot = 0x00010000; # Horz growth for font scale.
+ my $dy_plot = 0x00010000; # Vert growth for font scale.
+
+ my $header = pack 'vv', $record, $length;
+ my $data = '';
+ $data .= pack 'V', $dx_plot;
+ $data .= pack 'V', $dy_plot;
+
+ $self->_append( $header, $data );
+}
+
+
+###############################################################################
+#
+# _store_pos()
+#
+# Write the POS chart BIFF record. Generally not required when using
+# automatic positioning.
+#
+sub _store_pos {
+
+ my $self = shift;
+
+ my $record = 0x104F; # Record identifier.
+ my $length = 0x0014; # Number of bytes to follow.
+ my $mdTopLt = $_[0]; # Top left.
+ my $mdBotRt = $_[1]; # Bottom right.
+ my $x1 = $_[2]; # X coordinate.
+ my $y1 = $_[3]; # Y coordinate.
+ my $x2 = $_[4]; # Width.
+ my $y2 = $_[5]; # Height.
+
+ my $header = pack 'vv', $record, $length;
+ my $data = '';
+ $data .= pack 'v', $mdTopLt;
+ $data .= pack 'v', $mdBotRt;
+ $data .= pack 'V', $x1;
+ $data .= pack 'V', $y1;
+ $data .= pack 'V', $x2;
+ $data .= pack 'V', $y2;
+
+ $self->_append( $header, $data );
+}
+
+
+###############################################################################
+#
+# _store_serauxtrend()
+#
+# Write the SERAUXTREND chart BIFF record.
+#
+sub _store_serauxtrend {
+
+ my $self = shift;
+
+ my $record = 0x104B; # Record identifier.
+ my $length = 0x001C; # Number of bytes to follow.
+ my $reg_type = $_[0]; # Regression type.
+ my $poly_order = $_[1]; # Polynomial order.
+ my $equation = $_[2]; # Display equation.
+ my $r_squared = $_[3]; # Display R-squared.
+ my $intercept; # Forced intercept.
+ my $forecast; # Forecast forward.
+ my $backcast; # Forecast backward.
+
+ # TODO. When supported, intercept needs to be NAN if not used.
+ # Also need to reverse doubles.
+ $intercept = pack 'H*', 'FFFFFFFF0001FFFF';
+ $forecast = pack 'H*', '0000000000000000';
+ $backcast = pack 'H*', '0000000000000000';
+
+
+ my $header = pack 'vv', $record, $length;
+ my $data = '';
+ $data .= pack 'C', $reg_type;
+ $data .= pack 'C', $poly_order;
+ $data .= $intercept;
+ $data .= pack 'C', $equation;
+ $data .= pack 'C', $r_squared;
+ $data .= $forecast;
+ $data .= $backcast;
+
+ $self->_append( $header, $data );
+}
+
+
+###############################################################################
+#
+# _store_series()
+#
+# Write the SERIES chart BIFF record.
+#
+sub _store_series {
+
+ my $self = shift;
+
+ my $record = 0x1003; # Record identifier.
+ my $length = 0x000C; # Number of bytes to follow.
+ my $category_type = 0x0001; # Type: category.
+ my $value_type = 0x0001; # Type: value.
+ my $category_count = $_[0]; # Num of categories.
+ my $value_count = $_[1]; # Num of values.
+ my $bubble_type = 0x0001; # Type: bubble.
+ my $bubble_count = 0x0000; # Num of bubble values.
+
+ my $header = pack 'vv', $record, $length;
+ my $data = '';
+ $data .= pack 'v', $category_type;
+ $data .= pack 'v', $value_type;
+ $data .= pack 'v', $category_count;
+ $data .= pack 'v', $value_count;
+ $data .= pack 'v', $bubble_type;
+ $data .= pack 'v', $bubble_count;
+
+ $self->_append( $header, $data );
+}
+
+
+###############################################################################
+#
+# _store_seriestext()
+#
+# Write the SERIESTEXT chart BIFF record.
+#
+sub _store_seriestext {
+
+ my $self = shift;
+
+ my $record = 0x100D; # Record identifier.
+ my $length = 0x0000; # Number of bytes to follow.
+ my $id = 0x0000; # Text id.
+ my $str = $_[0]; # Text.
+ my $encoding = $_[1]; # String encoding.
+ my $cch = length $str; # String length.
+
+ # Character length is num of chars not num of bytes
+ $cch /= 2 if $encoding;
+
+ # Change the UTF-16 name from BE to LE
+ $str = pack 'n*', unpack 'v*', $str if $encoding;
+
+ $length = 4 + length( $str );
+
+ my $header = pack 'vv', $record, $length;
+ my $data = '';
+ $data .= pack 'v', $id;
+ $data .= pack 'C', $cch;
+ $data .= pack 'C', $encoding;
+
+ $self->_append( $header, $data, $str );
+}
+
+
+###############################################################################
+#
+# _store_serparent()
+#
+# Write the SERPARENT chart BIFF record.
+#
+sub _store_serparent {
+
+ my $self = shift;
+
+ my $record = 0x104A; # Record identifier.
+ my $length = 0x0002; # Number of bytes to follow.
+ my $series = $_[0]; # Series parent.
+
+ my $header = pack 'vv', $record, $length;
+ my $data = pack 'v', $series;
+
+ $self->_append( $header, $data );
+}
+
+
+###############################################################################
+#
+# _store_sertocrt()
+#
+# Write the SERTOCRT chart BIFF record to indicate the chart group index.
+#
+sub _store_sertocrt {
+
+ my $self = shift;
+
+ my $record = 0x1045; # Record identifier.
+ my $length = 0x0002; # Number of bytes to follow.
+ my $chartgroup = 0x0000; # Chart group index.
+
+ my $header = pack 'vv', $record, $length;
+ my $data = pack 'v', $chartgroup;
+
+ $self->_append( $header, $data );
+}
+
+
+###############################################################################
+#
+# _store_shtprops()
+#
+# Write the SHTPROPS chart BIFF record.
+#
+sub _store_shtprops {
+
+ my $self = shift;
+
+ my $record = 0x1044; # Record identifier.
+ my $length = 0x0004; # Number of bytes to follow.
+ my $grbit = 0x000E; # Option flags.
+ my $empty_cells = 0x0000; # Empty cell handling.
+
+ $grbit = 0x000A if $self->{_embedded};
+
+ my $header = pack 'vv', $record, $length;
+ my $data = '';
+ $data .= pack 'v', $grbit;
+ $data .= pack 'v', $empty_cells;
+
+ $self->_append( $header, $data );
+}
+
+
+###############################################################################
+#
+# _store_text()
+#
+# Write the TEXT chart BIFF record.
+#
+sub _store_text {
+
+ my $self = shift;
+
+ my $record = 0x1025; # Record identifier.
+ my $length = 0x0020; # Number of bytes to follow.
+ my $at = 0x02; # Horizontal alignment.
+ my $vat = 0x02; # Vertical alignment.
+ my $wBkgMode = 0x0001; # Background display.
+ my $rgbText = 0x0000; # Text RGB colour.
+ my $x = $_[0]; # Text x-pos.
+ my $y = $_[1]; # Text y-pos.
+ my $dx = $_[2]; # Width.
+ my $dy = $_[3]; # Height.
+ my $grbit1 = $_[4]; # Option flags.
+ my $icvText = 0x004D; # Auto Colour.
+ my $grbit2 = $_[5]; # Show legend.
+ my $rotation = $_[6] || 0x00; # Show value.
+
+
+ my $header = pack 'vv', $record, $length;
+ my $data = '';
+ $data .= pack 'C', $at;
+ $data .= pack 'C', $vat;
+ $data .= pack 'v', $wBkgMode;
+ $data .= pack 'V', $rgbText;
+ $data .= pack 'V', $x;
+ $data .= pack 'V', $y;
+ $data .= pack 'V', $dx;
+ $data .= pack 'V', $dy;
+ $data .= pack 'v', $grbit1;
+ $data .= pack 'v', $icvText;
+ $data .= pack 'v', $grbit2;
+ $data .= pack 'v', $rotation;
+
+ $self->_append( $header, $data );
+}
+
+###############################################################################
+#
+# _store_tick()
+#
+# Write the TICK chart BIFF record.
+#
+sub _store_tick {
+
+ my $self = shift;
+
+ my $record = 0x101E; # Record identifier.
+ my $length = 0x001E; # Number of bytes to follow.
+ my $tktMajor = 0x02; # Type of major tick mark.
+ my $tktMinor = 0x00; # Type of minor tick mark.
+ my $tlt = 0x03; # Tick label position.
+ my $wBkgMode = 0x01; # Background mode.
+ my $rgb = 0x00000000; # Tick-label RGB colour.
+ my $reserved1 = 0x00000000; # Reserved.
+ my $reserved2 = 0x00000000; # Reserved.
+ my $reserved3 = 0x00000000; # Reserved.
+ my $reserved4 = 0x00000000; # Reserved.
+ my $grbit = 0x0023; # Option flags.
+ my $index = 0x004D; # Colour index.
+ my $reserved5 = 0x0000; # Reserved.
+
+ my $header = pack 'vv', $record, $length;
+ my $data = '';
+ $data .= pack 'C', $tktMajor;
+ $data .= pack 'C', $tktMinor;
+ $data .= pack 'C', $tlt;
+ $data .= pack 'C', $wBkgMode;
+ $data .= pack 'V', $rgb;
+ $data .= pack 'V', $reserved1;
+ $data .= pack 'V', $reserved2;
+ $data .= pack 'V', $reserved3;
+ $data .= pack 'V', $reserved4;
+ $data .= pack 'v', $grbit;
+ $data .= pack 'v', $index;
+ $data .= pack 'v', $reserved5;
+
+ $self->_append( $header, $data );
+}
+
+
+###############################################################################
+#
+# _store_valuerange()
+#
+# Write the VALUERANGE chart BIFF record.
+#
+sub _store_valuerange {
+
+ my $self = shift;
+
+ my $record = 0x101F; # Record identifier.
+ my $length = 0x002A; # Number of bytes to follow.
+ my $numMin = 0x00000000; # Minimum value on axis.
+ my $numMax = 0x00000000; # Maximum value on axis.
+ my $numMajor = 0x00000000; # Value of major increment.
+ my $numMinor = 0x00000000; # Value of minor increment.
+ my $numCross = 0x00000000; # Value where category axis crosses.
+ my $grbit = 0x011F; # Format flags.
+
+ # TODO. Reverse doubles when they are handled.
+
+ my $header = pack 'vv', $record, $length;
+ my $data = '';
+ $data .= pack 'd', $numMin;
+ $data .= pack 'd', $numMax;
+ $data .= pack 'd', $numMajor;
+ $data .= pack 'd', $numMinor;
+ $data .= pack 'd', $numCross;
+ $data .= pack 'v', $grbit;
+
+ $self->_append( $header, $data );
+}
+
+
+###############################################################################
+#
+# Config data.
+#
+###############################################################################
+
+
+###############################################################################
+#
+# _set_default_properties()
+#
+# Setup the default properties for a chart.
+#
+sub _set_default_properties {
+
+ my $self = shift;
+
+ $self->{_legend} = {
+ _visible => 1,
+ _position => 0,
+ _vertical => 0,
+ };
+
+ $self->{_chartarea} = {
+ _visible => 0,
+ _fg_color_index => 0x4E,
+ _fg_color_rgb => 0xFFFFFF,
+ _bg_color_index => 0x4D,
+ _bg_color_rgb => 0x000000,
+ _area_pattern => 0x0000,
+ _area_options => 0x0000,
+ _line_pattern => 0x0005,
+ _line_weight => 0xFFFF,
+ _line_color_index => 0x4D,
+ _line_color_rgb => 0x000000,
+ _line_options => 0x0008,
+ };
+
+ $self->{_plotarea} = {
+ _visible => 1,
+ _fg_color_index => 0x16,
+ _fg_color_rgb => 0xC0C0C0,
+ _bg_color_index => 0x4F,
+ _bg_color_rgb => 0x000000,
+ _area_pattern => 0x0001,
+ _area_options => 0x0000,
+ _line_pattern => 0x0000,
+ _line_weight => 0x0000,
+ _line_color_index => 0x17,
+ _line_color_rgb => 0x808080,
+ _line_options => 0x0000,
+ };
+}
+
+
+###############################################################################
+#
+# _set_default_config_data()
+#
+# Setup the default configuration data for a chart.
+#
+sub _set_default_config_data {
+
+ my $self = shift;
+
+ #<<< Perltidy ignore this.
+ $self->{_config} = {
+ _axisparent => [ 0, 0x00F8, 0x01F5, 0x0E7F, 0x0B36 ],
+ _axisparent_pos => [ 2, 2, 0x008C, 0x01AA, 0x0EEA, 0x0C52 ],
+ _chart => [ 0x0000, 0x0000, 0x02DD51E0, 0x01C2B838 ],
+ _font_numbers => [ 5, 10, 0x38B8, 0x22A1, 0x0000 ],
+ _font_series => [ 6, 10, 0x38B8, 0x22A1, 0x0001 ],
+ _font_title => [ 7, 12, 0x38B8, 0x22A1, 0x0000 ],
+ _font_axes => [ 8, 10, 0x38B8, 0x22A1, 0x0001 ],
+ _legend => [ 0x05F9, 0x0EE9, 0x047D, 0x9C, 0x00, 0x01, 0x0F ],
+ _legend_pos => [ 5, 2, 0x05F9, 0x0EE9, 0, 0 ],
+ _legend_text => [ 0xFFFFFF46, 0xFFFFFF06, 0, 0, 0x00B1, 0x0000 ],
+ _legend_text_pos => [ 2, 2, 0, 0, 0, 0 ],
+ _series_text => [ 0xFFFFFF46, 0xFFFFFF06, 0, 0, 0x00B1, 0x1020 ],
+ _series_text_pos => [ 2, 2, 0, 0, 0, 0 ],
+ _title_text => [ 0x06E4, 0x0051, 0x01DB, 0x00C4, 0x0081, 0x1030 ],
+ _title_text_pos => [ 2, 2, 0, 0, 0x73, 0x1D ],
+ _x_axis_text => [ 0x07E1, 0x0DFC, 0xB2, 0x9C, 0x0081, 0x0000 ],
+ _x_axis_text_pos => [ 2, 2, 0, 0, 0x2B, 0x17 ],
+ _y_axis_text => [ 0x002D, 0x06AA, 0x5F, 0x1CC, 0x0281, 0x00, 90 ],
+ _y_axis_text_pos => [ 2, 2, 0, 0, 0x17, 0x44 ],
+ }; #>>>
+
+
+}
+
+
+###############################################################################
+#
+# _set_embedded_config_data()
+#
+# Setup the default configuration data for an embedded chart.
+#
+sub _set_embedded_config_data {
+
+ my $self = shift;
+
+ $self->{_embedded} = 1;
+
+ $self->{_chartarea} = {
+ _visible => 1,
+ _fg_color_index => 0x4E,
+ _fg_color_rgb => 0xFFFFFF,
+ _bg_color_index => 0x4D,
+ _bg_color_rgb => 0x000000,
+ _area_pattern => 0x0001,
+ _area_options => 0x0001,
+ _line_pattern => 0x0000,
+ _line_weight => 0x0000,
+ _line_color_index => 0x4D,
+ _line_color_rgb => 0x000000,
+ _line_options => 0x0009,
+ };
+
+
+ #<<< Perltidy ignore this.
+ $self->{_config} = {
+ _axisparent => [ 0, 0x01D8, 0x031D, 0x0D79, 0x07E9 ],
+ _axisparent_pos => [ 2, 2, 0x010C, 0x0292, 0x0E46, 0x09FD ],
+ _chart => [ 0x0000, 0x0000, 0x01847FE8, 0x00F47FE8 ],
+ _font_numbers => [ 5, 10, 0x1DC4, 0x1284, 0x0000 ],
+ _font_series => [ 6, 10, 0x1DC4, 0x1284, 0x0001 ],
+ _font_title => [ 7, 12, 0x1DC4, 0x1284, 0x0000 ],
+ _font_axes => [ 8, 10, 0x1DC4, 0x1284, 0x0001 ],
+ _legend => [ 0x044E, 0x0E4A, 0x088D, 0x0123, 0x0, 0x1, 0xF ],
+ _legend_pos => [ 5, 2, 0x044E, 0x0E4A, 0, 0 ],
+ _legend_text => [ 0xFFFFFFD9, 0xFFFFFFC1, 0, 0, 0x00B1, 0x0000 ],
+ _legend_text_pos => [ 2, 2, 0, 0, 0, 0 ],
+ _series_text => [ 0xFFFFFFD9, 0xFFFFFFC1, 0, 0, 0x00B1, 0x1020 ],
+ _series_text_pos => [ 2, 2, 0, 0, 0, 0 ],
+ _title_text => [ 0x060F, 0x004C, 0x038A, 0x016F, 0x0081, 0x1030 ],
+ _title_text_pos => [ 2, 2, 0, 0, 0x73, 0x1D ],
+ _x_axis_text => [ 0x07EF, 0x0C8F, 0x153, 0x123, 0x81, 0x00 ],
+ _x_axis_text_pos => [ 2, 2, 0, 0, 0x2B, 0x17 ],
+ _y_axis_text => [ 0x0057, 0x0564, 0xB5, 0x035D, 0x0281, 0x00, 90 ],
+ _y_axis_text_pos => [ 2, 2, 0, 0, 0x17, 0x44 ],
+ }; #>>>
+}
+
+
+
+1;
+
+
+__END__
+
+
+=head1 NAME
+
+Chart - A writer class for Excel Charts.
+
+=head1 SYNOPSIS
+
+To create a simple Excel file with a chart using Spreadsheet::WriteExcel:
+
+ #!/usr/bin/perl -w
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new( 'chart.xls' );
+ my $worksheet = $workbook->add_worksheet();
+
+ my $chart = $workbook->add_chart( type => 'column' );
+
+ # Configure the chart.
+ $chart->add_series(
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$B$2:$B$7',
+ );
+
+ # Add the worksheet data the chart refers to.
+ my $data = [
+ [ 'Category', 2, 3, 4, 5, 6, 7 ],
+ [ 'Value', 1, 4, 5, 2, 1, 5 ],
+ ];
+
+ $worksheet->write( 'A1', $data );
+
+ __END__
+
+
+=head1 DESCRIPTION
+
+The C<Chart> module is an abstract base class for modules that implement charts in L<Spreadsheet::WriteExcel>. The information below is applicable to all of the available subclasses.
+
+The C<Chart> module isn't used directly, a chart object is created via the Workbook C<add_chart()> method where the chart type is specified:
+
+ my $chart = $workbook->add_chart( type => 'column' );
+
+Currently the supported chart types are:
+
+=over
+
+=item * C<area>: Creates an Area (filled line) style chart. See L<Spreadsheet::WriteExcel::Chart::Area>.
+
+=item * C<bar>: Creates a Bar style (transposed histogram) chart. See L<Spreadsheet::WriteExcel::Chart::Bar>.
+
+=item * C<column>: Creates a column style (histogram) chart. See L<Spreadsheet::WriteExcel::Chart::Column>.
+
+=item * C<line>: Creates a Line style chart. See L<Spreadsheet::WriteExcel::Chart::Line>.
+
+=item * C<pie>: Creates an Pie style chart. See L<Spreadsheet::WriteExcel::Chart::Pie>.
+
+=item * C<scatter>: Creates an Scatter style chart. See L<Spreadsheet::WriteExcel::Chart::Scatter>.
+
+=item * C<stock>: Creates an Stock style chart. See L<Spreadsheet::WriteExcel::Chart::Stock>.
+
+=back
+
+More charts and sub-types will be supported in time. See the L</TODO> section.
+
+Methods that are common to all chart types are documented below.
+
+=head1 CHART METHODS
+
+=head2 add_series()
+
+In an Excel chart a "series" is a collection of information such as values, x-axis labels and the name that define which data is plotted. These settings are displayed when you select the C<< Chart -> Source Data... >> menu option.
+
+With a Spreadsheet::WriteExcel chart object the C<add_series()> method is used to set the properties for a series:
+
+ $chart->add_series(
+ categories => '=Sheet1!$A$2:$A$10',
+ values => '=Sheet1!$B$2:$B$10',
+ name => 'Series name',
+ name_formula => '=Sheet1!$B$1',
+ );
+
+The properties that can be set are:
+
+=over
+
+=item * C<values>
+
+This is the most important property of a series and must be set for every chart object. It links the chart with the worksheet data that it displays. Note the format that should be used for the formula. See L</Working with Cell Ranges>.
+
+=item * C<categories>
+
+This sets the chart category labels. The category is more or less the same as the X-axis. In most chart types the C<categories> property is optional and the chart will just assume a sequential series from C<1 .. n>.
+
+=item * C<name>
+
+Set the name for the series. The name is displayed in the chart legend and in the formula bar. The name property is optional and if it isn't supplied will default to C<Series 1 .. n>.
+
+=item * C<name_formula>
+
+Optional, can be used to link the name to a worksheet cell. See L</Chart names and links>.
+
+=back
+
+You can add more than one series to a chart, in fact some chart types such as C<stock> require it. The series numbering and order in the final chart is the same as the order in which that are added.
+
+ # Add the first series.
+ $chart->add_series(
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$B$2:$B$7',
+ name => 'Test data series 1',
+ );
+
+ # Add another series. Category is the same but values are different.
+ $chart->add_series(
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$C$2:$C$7',
+ name => 'Test data series 2',
+ );
+
+
+
+=head2 set_x_axis()
+
+The C<set_x_axis()> method is used to set properties of the X axis.
+
+ $chart->set_x_axis( name => 'Sample length (m)' );
+
+The properties that can be set are:
+
+=over
+
+=item * C<name>
+
+Set the name (title or caption) for the axis. The name is displayed below the X axis. This property is optional. The default is to have no axis name.
+
+=item * C<name_formula>
+
+Optional, can be used to link the name to a worksheet cell. See L</Chart names and links>.
+
+=back
+
+Additional axis properties such as range, divisions and ticks will be made available in later releases. See the L</TODO> section.
+
+
+=head2 set_y_axis()
+
+The C<set_y_axis()> method is used to set properties of the Y axis.
+
+ $chart->set_y_axis( name => 'Sample weight (kg)' );
+
+The properties that can be set are:
+
+=over
+
+=item * C<name>
+
+Set the name (title or caption) for the axis. The name is displayed to the left of the Y axis. This property is optional. The default is to have no axis name.
+
+=item * C<name_formula>
+
+Optional, can be used to link the name to a worksheet cell. See L</Chart names and links>.
+
+=back
+
+Additional axis properties such as range, divisions and ticks will be made available in later releases. See the L</TODO> section.
+
+=head2 set_title()
+
+The C<set_title()> method is used to set properties of the chart title.
+
+ $chart->set_title( name => 'Year End Results' );
+
+The properties that can be set are:
+
+=over
+
+=item * C<name>
+
+Set the name (title) for the chart. The name is displayed above the chart. This property is optional. The default is to have no chart title.
+
+=item * C<name_formula>
+
+Optional, can be used to link the name to a worksheet cell. See L</Chart names and links>.
+
+=back
+
+
+=head2 set_legend()
+
+The C<set_legend()> method is used to set properties of the chart legend.
+
+ $chart->set_legend( position => 'none' );
+
+The properties that can be set are:
+
+=over
+
+=item * C<position>
+
+Set the position of the chart legend.
+
+ $chart->set_legend( position => 'none' );
+
+The default legend position is C<bottom>. The currently supported chart positions are:
+
+ none
+ bottom
+
+The other legend positions will be added soon.
+
+=back
+
+
+=head2 set_chartarea()
+
+The C<set_chartarea()> method is used to set the properties of the chart area. In Excel the chart area is the background area behind the chart.
+
+The properties that can be set are:
+
+=over
+
+=item * C<color>
+
+Set the colour of the chart area. The Excel default chart area color is 'white', index 9. See L</Chart object colours>.
+
+=item * C<line_color>
+
+Set the colour of the chart area border line. The Excel default border line colour is 'black', index 9. See L</Chart object colours>.
+
+=item * C<line_pattern>
+
+Set the pattern of the of the chart area border line. The Excel default pattern is 'none', index 0 for a chart sheet and 'solid', index 1, for an embedded chart. See L</Chart line patterns>.
+
+=item * C<line_weight>
+
+Set the weight of the of the chart area border line. The Excel default weight is 'narrow', index 2. See L</Chart line weights>.
+
+=back
+
+Here is an example of setting several properties:
+
+ $chart->set_chartarea(
+ color => 'red',
+ line_color => 'black',
+ line_pattern => 2,
+ line_weight => 3,
+ );
+
+Note, for chart sheets the chart area border is off by default. For embedded charts is is on by default.
+
+=head2 set_plotarea()
+
+The C<set_plotarea()> method is used to set properties of the plot area of a chart. In Excel the plot area is the area between the axes on which the chart series are plotted.
+
+The properties that can be set are:
+
+=over
+
+=item * C<visible>
+
+Set the visibility of the plot area. The default is 1 for visible. Set to 0 to hide the plot area and have the same colour as the background chart area.
+
+=item * C<color>
+
+Set the colour of the plot area. The Excel default plot area color is 'silver', index 23. See L</Chart object colours>.
+
+=item * C<line_color>
+
+Set the colour of the plot area border line. The Excel default border line colour is 'gray', index 22. See L</Chart object colours>.
+
+=item * C<line_pattern>
+
+Set the pattern of the of the plot area border line. The Excel default pattern is 'solid', index 1. See L</Chart line patterns>.
+
+=item * C<line_weight>
+
+Set the weight of the of the plot area border line. The Excel default weight is 'narrow', index 2. See L</Chart line weights>.
+
+=back
+
+Here is an example of setting several properties:
+
+ $chart->set_plotarea(
+ color => 'red',
+ line_color => 'black',
+ line_pattern => 2,
+ line_weight => 3,
+ );
+
+
+
+=head1 WORKSHEET METHODS
+
+In Excel a chart sheet (i.e, a chart that isn't embedded) shares properties with data worksheets such as tab selection, headers, footers, margins and print properties.
+
+In Spreadsheet::WriteExcel you can set chart sheet properties using the same methods that are used for Worksheet objects.
+
+The following Worksheet methods are also available through a non-embedded Chart object:
+
+ get_name()
+ activate()
+ select()
+ hide()
+ set_first_sheet()
+ protect()
+ set_zoom()
+ set_tab_color()
+
+ set_landscape()
+ set_portrait()
+ set_paper()
+ set_margins()
+ set_header()
+ set_footer()
+
+See L<Spreadsheet::WriteExcel> for a detailed explanation of these methods.
+
+=head1 EXAMPLE
+
+Here is a complete example that demonstrates some of the available features when creating a chart.
+
+ #!/usr/bin/perl -w
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new( 'chart_area.xls' );
+ my $worksheet = $workbook->add_worksheet();
+ my $bold = $workbook->add_format( bold => 1 );
+
+ # Add the worksheet data that the charts will refer to.
+ my $headings = [ 'Number', 'Sample 1', 'Sample 2' ];
+ my $data = [
+ [ 2, 3, 4, 5, 6, 7 ],
+ [ 1, 4, 5, 2, 1, 5 ],
+ [ 3, 6, 7, 5, 4, 3 ],
+ ];
+
+ $worksheet->write( 'A1', $headings, $bold );
+ $worksheet->write( 'A2', $data );
+
+ # Create a new chart object. In this case an embedded chart.
+ my $chart = $workbook->add_chart( type => 'area', embedded => 1 );
+
+ # Configure the first series. (Sample 1)
+ $chart->add_series(
+ name => 'Sample 1',
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$B$2:$B$7',
+ );
+
+ # Configure the second series. (Sample 2)
+ $chart->add_series(
+ name => 'Sample 2',
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$C$2:$C$7',
+ );
+
+ # Add a chart title and some axis labels.
+ $chart->set_title ( name => 'Results of sample analysis' );
+ $chart->set_x_axis( name => 'Test number' );
+ $chart->set_y_axis( name => 'Sample length (cm)' );
+
+ # Insert the chart into the worksheet (with an offset).
+ $worksheet->insert_chart( 'D2', $chart, 25, 10 );
+
+ __END__
+
+
+=begin html
+
+<p>This will produce a chart that looks like this:</p>
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/area1.jpg" width="527" height="320" alt="Chart example." /></center></p>
+
+=end html
+
+
+=head1 Chart object colours
+
+Many of the chart objects supported by Spreadsheet::WriteExcl allow the default colours to be changed. Excel provides a palette of 56 colours and in Spreadsheet::WriteExcel these colours are accessed via their palette index in the range 8..63.
+
+The most commonly used colours can be accessed by name or index.
+
+ black => 8, green => 17, navy => 18,
+ white => 9, orange => 53, pink => 33,
+ red => 10, gray => 23, purple => 20,
+ blue => 12, lime => 11, silver => 22,
+ yellow => 13, cyan => 15,
+ brown => 16, magenta => 14,
+
+For example the following are equivalent.
+
+ $chart->set_plotarea( color => 10 );
+ $chart->set_plotarea( color => 'red' );
+
+The colour palette is shown in C<palette.html> in the C<docs> directory of the distro. An Excel version of the palette can be generated using C<colors.pl> in the C<examples> directory.
+
+User defined colours can be set using the C<set_custom_color()> workbook method. This and other aspects of using colours are discussed in the "Colours in Excel" section of the main Spreadsheet::WriteExcel documentation: L<http://search.cpan.org/dist/Spreadsheet-WriteExcel/lib/Spreadsheet/WriteExcel.pm#COLOURS_IN_EXCEL>.
+
+=head1 Chart line patterns
+
+Chart lines patterns can be set using either an index or a name:
+
+ $chart->set_plotarea( weight => 2 );
+ $chart->set_plotarea( weight => 'dash' );
+
+Chart lines have 9 possible patterns are follows:
+
+ 'none' => 0,
+ 'solid' => 1,
+ 'dash' => 2,
+ 'dot' => 3,
+ 'dash-dot' => 4,
+ 'dash-dot-dot' => 5,
+ 'medium-gray' => 6,
+ 'dark-gray' => 7,
+ 'light-gray' => 8,
+
+The patterns 1-8 are shown in order in the drop down dialog boxes in Excel. The default pattern is 'solid', index 1.
+
+
+=head1 Chart line weights
+
+Chart lines weights can be set using either an index or a name:
+
+ $chart->set_plotarea( weight => 1 );
+ $chart->set_plotarea( weight => 'hairline' );
+
+Chart lines have 4 possible weights are follows:
+
+ 'hairline' => 1,
+ 'narrow' => 2,
+ 'medium' => 3,
+ 'wide' => 4,
+
+The weights 1-4 are shown in order in the drop down dialog boxes in Excel. The default weight is 'narrow', index 2.
+
+
+=head1 Chart names and links
+
+The C<add_series())>, C<set_x_axis()>, C<set_y_axis()> and C<set_title()> methods all support a C<name> property. In general these names can be either a static string or a link to a worksheet cell. If you choose to use the C<name_formula> property to specify a link then you should also the C<name> property. This isn't strictly required by Excel but some third party applications expect it to be present.
+
+ $chart->set_title(
+ name => 'Year End Results',
+ name_formula => '=Sheet1!$C$1',
+ );
+
+These links should be used sparingly since they aren't commonly used in Excel charts.
+
+
+=head1 Chart names and Unicode
+
+The C<add_series())>, C<set_x_axis()>, C<set_y_axis()> and C<set_title()> methods all support a C<name> property. These names can be UTF8 strings if you are using perl 5.8+.
+
+
+ # perl 5.8+ example:
+ my $smiley = "\x{263A}";
+
+ $chart->set_title( name => "Best. Results. Ever! $smiley" );
+
+For older perls you write Unicode strings as UTF-16BE by adding a C<name_encoding> property:
+
+ # perl 5.005 example:
+ my $utf16be_name = pack 'n', 0x263A;
+
+ $chart->set_title(
+ name => $utf16be_name,
+ name_encoding => 1,
+ );
+
+This methodology is explained in the "UNICODE IN EXCEL" section of L<Spreadsheet::WriteExcel> but is semi-deprecated. If you are using Unicode the easiest option is to just use UTF8 in perl 5.8+.
+
+
+=head1 Working with Cell Ranges
+
+
+In the section on C<add_series()> it was noted that the series must be defined using a range formula:
+
+ $chart->add_series( values => '=Sheet1!$B$2:$B$10' );
+
+The worksheet name must be specified (even for embedded charts) and the cell references must be "absolute" references, i.e., they must contain C<$> signs. This is the format that is required by Excel for chart references.
+
+Since it isn't very convenient to work with this type of string programmatically the L<Spreadsheet::WriteExcel::Utility> module, which is included with Spreadsheet::WriteExcel, provides a function called C<xl_range_formula()> to convert from zero based row and column cell references to an A1 style formula string.
+
+The syntax is:
+
+ xl_range_formula($sheetname, $row_1, $row_2, $col_1, $col_2)
+
+If you include it in your program, using the standard import syntax, you can use the function as follows:
+
+
+ # Include the Utility module or just the function you need.
+ use Spreadsheet::WriteExcel::Utility qw( xl_range_formula );
+ ...
+
+ # Then use it as required.
+ $chart->add_series(
+ categories => xl_range_formula( 'Sheet1', 1, 9, 0, 0 ),
+ values => xl_range_formula( 'Sheet1', 1, 9, 1, 1 );,
+ );
+
+ # Which is the same as:
+ $chart->add_series(
+ categories => '=Sheet1!$A$2:$A$10',
+ values => '=Sheet1!$B$2:$B$10',
+ );
+
+See L<Spreadsheet::WriteExcel::Utility> for more details.
+
+
+=head1 TODO
+
+Charts in Spreadsheet::WriteExcel are a work in progress. More chart types and features will be added in time. Please be patient. Even a small feature can take a week or more to implement, test and document.
+
+Features that are on the TODO list and will be added are:
+
+=over
+
+=item * Chart sub-types.
+
+=item * Colours and formatting options. For now you will have to make do with the default Excel colours and formats.
+
+=item * Axis controls, gridlines.
+
+=item * 3D charts.
+
+=item * Embedded data in charts for third party application support. See Known Issues.
+
+=item * Additional chart types such as Bubble and Radar. Send an email if you are interested in other types and they will be added to the queue.
+
+=back
+
+If you are interested in sponsoring a feature let me know.
+
+=head1 KNOWN ISSUES
+
+=over
+
+=item * Currently charts don't contain embedded data from which the charts can be rendered. Excel and most other third party applications ignore this and read the data via the links that have been specified. However, some applications may complain or not render charts correctly. The preview option in Mac OS X is an known example. This will be fixed in a later release.
+
+=item * When there are several charts with titles set in a workbook some of the titles may display at a font size of 10 instead of the default 12 until another chart with the title set is viewed.
+
+=item * Stock (and other) charts should have the X-axis dates aligned at an angle for clarity. This will be fixed at a later stage.
+
+=back
+
+
+=head1 AUTHOR
+
+John McNamara jmcnamara@cpan.org
+
+=head1 COPYRIGHT
+
+Copyright MM-MMX, John McNamara.
+
+All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself.
+
diff --git a/mcu/tools/perl/Spreadsheet/WriteExcel/Chart/Area.pm b/mcu/tools/perl/Spreadsheet/WriteExcel/Chart/Area.pm
new file mode 100644
index 0000000..9025798
--- /dev/null
+++ b/mcu/tools/perl/Spreadsheet/WriteExcel/Chart/Area.pm
@@ -0,0 +1,194 @@
+package Spreadsheet::WriteExcel::Chart::Area;
+
+###############################################################################
+#
+# Area - A writer class for Excel Area charts.
+#
+# Used in conjunction with Spreadsheet::WriteExcel::Chart.
+#
+# See formatting note in Spreadsheet::WriteExcel::Chart.
+#
+# Copyright 2000-2010, John McNamara, jmcnamara@cpan.org
+#
+# Documentation after __END__
+#
+
+require Exporter;
+
+use strict;
+use Spreadsheet::WriteExcel::Chart;
+
+
+use vars qw($VERSION @ISA);
+@ISA = qw(Spreadsheet::WriteExcel::Chart Exporter);
+
+$VERSION = '2.37';
+
+###############################################################################
+#
+# new()
+#
+#
+sub new {
+
+ my $class = shift;
+ my $self = Spreadsheet::WriteExcel::Chart->new( @_ );
+
+ bless $self, $class;
+ return $self;
+}
+
+
+###############################################################################
+#
+# _store_chart_type()
+#
+# Implementation of the abstract method from the specific chart class.
+#
+# Write the AREA chart BIFF record. Defines a area chart type.
+#
+sub _store_chart_type {
+
+ my $self = shift;
+
+ my $record = 0x101A; # Record identifier.
+ my $length = 0x0002; # Number of bytes to follow.
+ my $grbit = 0x0001; # Option flags.
+
+ my $header = pack 'vv', $record, $length;
+ my $data = pack 'v', $grbit;
+
+ $self->_append( $header, $data );
+}
+
+
+1;
+
+
+__END__
+
+
+=head1 NAME
+
+Area - A writer class for Excel Area charts.
+
+=head1 SYNOPSIS
+
+To create a simple Excel file with a Area chart using Spreadsheet::WriteExcel:
+
+ #!/usr/bin/perl -w
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new( 'chart.xls' );
+ my $worksheet = $workbook->add_worksheet();
+
+ my $chart = $workbook->add_chart( type => 'area' );
+
+ # Configure the chart.
+ $chart->add_series(
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$B$2:$B$7',
+ );
+
+ # Add the worksheet data the chart refers to.
+ my $data = [
+ [ 'Category', 2, 3, 4, 5, 6, 7 ],
+ [ 'Value', 1, 4, 5, 2, 1, 5 ],
+ ];
+
+ $worksheet->write( 'A1', $data );
+
+ __END__
+
+=head1 DESCRIPTION
+
+This module implements Area charts for L<Spreadsheet::WriteExcel>. The chart object is created via the Workbook C<add_chart()> method:
+
+ my $chart = $workbook->add_chart( type => 'area' );
+
+Once the object is created it can be configured via the following methods that are common to all chart classes:
+
+ $chart->add_series();
+ $chart->set_x_axis();
+ $chart->set_y_axis();
+ $chart->set_title();
+
+These methods are explained in detail in L<Spreadsheet::WriteExcel::Chart>. Class specific methods or settings, if any, are explained below.
+
+=head1 Area Chart Methods
+
+There aren't currently any area chart specific methods. See the TODO section of L<Spreadsheet::WriteExcel::Chart>.
+
+=head1 EXAMPLE
+
+Here is a complete example that demonstrates most of the available features when creating a chart.
+
+ #!/usr/bin/perl -w
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new( 'chart_area.xls' );
+ my $worksheet = $workbook->add_worksheet();
+ my $bold = $workbook->add_format( bold => 1 );
+
+ # Add the worksheet data that the charts will refer to.
+ my $headings = [ 'Number', 'Sample 1', 'Sample 2' ];
+ my $data = [
+ [ 2, 3, 4, 5, 6, 7 ],
+ [ 1, 4, 5, 2, 1, 5 ],
+ [ 3, 6, 7, 5, 4, 3 ],
+ ];
+
+ $worksheet->write( 'A1', $headings, $bold );
+ $worksheet->write( 'A2', $data );
+
+ # Create a new chart object. In this case an embedded chart.
+ my $chart = $workbook->add_chart( type => 'area', embedded => 1 );
+
+ # Configure the first series. (Sample 1)
+ $chart->add_series(
+ name => 'Sample 1',
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$B$2:$B$7',
+ );
+
+ # Configure the second series. (Sample 2)
+ $chart->add_series(
+ name => 'Sample 2',
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$C$2:$C$7',
+ );
+
+ # Add a chart title and some axis labels.
+ $chart->set_title ( name => 'Results of sample analysis' );
+ $chart->set_x_axis( name => 'Test number' );
+ $chart->set_y_axis( name => 'Sample length (cm)' );
+
+ # Insert the chart into the worksheet (with an offset).
+ $worksheet->insert_chart( 'D2', $chart, 25, 10 );
+
+ __END__
+
+
+=begin html
+
+<p>This will produce a chart that looks like this:</p>
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/area1.jpg" width="527" height="320" alt="Chart example." /></center></p>
+
+=end html
+
+
+=head1 AUTHOR
+
+John McNamara jmcnamara@cpan.org
+
+=head1 COPYRIGHT
+
+Copyright MM-MMX, John McNamara.
+
+All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself.
+
diff --git a/mcu/tools/perl/Spreadsheet/WriteExcel/Chart/Bar.pm b/mcu/tools/perl/Spreadsheet/WriteExcel/Chart/Bar.pm
new file mode 100644
index 0000000..6e0d9b7
--- /dev/null
+++ b/mcu/tools/perl/Spreadsheet/WriteExcel/Chart/Bar.pm
@@ -0,0 +1,228 @@
+package Spreadsheet::WriteExcel::Chart::Bar;
+
+###############################################################################
+#
+# Bar - A writer class for Excel Bar charts.
+#
+# Used in conjunction with Spreadsheet::WriteExcel::Chart.
+#
+# See formatting note in Spreadsheet::WriteExcel::Chart.
+#
+# Copyright 2000-2010, John McNamara, jmcnamara@cpan.org
+#
+# Documentation after __END__
+#
+
+require Exporter;
+
+use strict;
+use Spreadsheet::WriteExcel::Chart;
+
+
+use vars qw($VERSION @ISA);
+@ISA = qw(Spreadsheet::WriteExcel::Chart Exporter);
+
+$VERSION = '2.37';
+
+###############################################################################
+#
+# new()
+#
+#
+sub new {
+
+ my $class = shift;
+ my $self = Spreadsheet::WriteExcel::Chart->new( @_ );
+
+ bless $self, $class;
+
+ # The axis positions are reversed for a bar chart so we change the config.
+ my $c = $self->{_config};
+ $c->{_x_axis_text} = [ 0x2D, 0x6D9, 0x5F, 0x1CC, 0x281, 0x0, 90 ];
+ $c->{_x_axis_text_pos} = [ 2, 2, 0, 0, 0x17, 0x2A ];
+ $c->{_y_axis_text} = [ 0x078A, 0x0DFC, 0x011D, 0x9C, 0x0081, 0x0000 ];
+ $c->{_y_axis_text_pos} = [ 2, 2, 0, 0, 0x45, 0x17 ];
+
+ return $self;
+}
+
+
+###############################################################################
+#
+# _store_chart_type()
+#
+# Implementation of the abstract method from the specific chart class.
+#
+# Write the BAR chart BIFF record. Defines a bar or column chart type.
+#
+sub _store_chart_type {
+
+ my $self = shift;
+
+ my $record = 0x1017; # Record identifier.
+ my $length = 0x0006; # Number of bytes to follow.
+ my $pcOverlap = 0x0000; # Space between bars.
+ my $pcGap = 0x0096; # Space between cats.
+ my $grbit = 0x0001; # Option flags.
+
+ my $header = pack 'vv', $record, $length;
+ my $data = '';
+ $data .= pack 'v', $pcOverlap;
+ $data .= pack 'v', $pcGap;
+ $data .= pack 'v', $grbit;
+
+ $self->_append( $header, $data );
+}
+
+###############################################################################
+#
+# _set_embedded_config_data()
+#
+# Override some of the default configuration data for an embedded chart.
+#
+sub _set_embedded_config_data {
+
+ my $self = shift;
+
+ # Set the parent configuration first.
+ $self->SUPER::_set_embedded_config_data();
+
+ # The axis positions are reversed for a bar chart so we change the config.
+ my $c = $self->{_config};
+ $c->{_x_axis_text} = [ 0x57, 0x5BC, 0xB5, 0x214, 0x281, 0x0, 90 ];
+ $c->{_x_axis_text_pos} = [ 2, 2, 0, 0, 0x17, 0x2A ];
+ $c->{_y_axis_text} = [ 0x074A, 0x0C8F, 0x021F, 0x123, 0x81, 0x0000 ];
+ $c->{_y_axis_text_pos} = [ 2, 2, 0, 0, 0x45, 0x17 ];
+
+}
+
+1;
+
+
+__END__
+
+
+=head1 NAME
+
+Bar - A writer class for Excel Bar charts.
+
+=head1 SYNOPSIS
+
+To create a simple Excel file with a Bar chart using Spreadsheet::WriteExcel:
+
+ #!/usr/bin/perl -w
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new( 'chart.xls' );
+ my $worksheet = $workbook->add_worksheet();
+
+ my $chart = $workbook->add_chart( type => 'bar' );
+
+ # Configure the chart.
+ $chart->add_series(
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$B$2:$B$7',
+ );
+
+ # Add the worksheet data the chart refers to.
+ my $data = [
+ [ 'Category', 2, 3, 4, 5, 6, 7 ],
+ [ 'Value', 1, 4, 5, 2, 1, 5 ],
+ ];
+
+ $worksheet->write( 'A1', $data );
+
+ __END__
+
+=head1 DESCRIPTION
+
+This module implements Bar charts for L<Spreadsheet::WriteExcel>. The chart object is created via the Workbook C<add_chart()> method:
+
+ my $chart = $workbook->add_chart( type => 'bar' );
+
+Once the object is created it can be configured via the following methods that are common to all chart classes:
+
+ $chart->add_series();
+ $chart->set_x_axis();
+ $chart->set_y_axis();
+ $chart->set_title();
+
+These methods are explained in detail in L<Spreadsheet::WriteExcel::Chart>. Class specific methods or settings, if any, are explained below.
+
+=head1 Bar Chart Methods
+
+There aren't currently any bar chart specific methods. See the TODO section of L<Spreadsheet::WriteExcel::Chart>.
+
+=head1 EXAMPLE
+
+Here is a complete example that demonstrates most of the available features when creating a chart.
+
+ #!/usr/bin/perl -w
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new( 'chart_bar.xls' );
+ my $worksheet = $workbook->add_worksheet();
+ my $bold = $workbook->add_format( bold => 1 );
+
+ # Add the worksheet data that the charts will refer to.
+ my $headings = [ 'Number', 'Sample 1', 'Sample 2' ];
+ my $data = [
+ [ 2, 3, 4, 5, 6, 7 ],
+ [ 1, 4, 5, 2, 1, 5 ],
+ [ 3, 6, 7, 5, 4, 3 ],
+ ];
+
+ $worksheet->write( 'A1', $headings, $bold );
+ $worksheet->write( 'A2', $data );
+
+ # Create a new chart object. In this case an embedded chart.
+ my $chart = $workbook->add_chart( type => 'bar', embedded => 1 );
+
+ # Configure the first series. (Sample 1)
+ $chart->add_series(
+ name => 'Sample 1',
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$B$2:$B$7',
+ );
+
+ # Configure the second series. (Sample 2)
+ $chart->add_series(
+ name => 'Sample 2',
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$C$2:$C$7',
+ );
+
+ # Add a chart title and some axis labels.
+ $chart->set_title ( name => 'Results of sample analysis' );
+ $chart->set_x_axis( name => 'Test number' );
+ $chart->set_y_axis( name => 'Sample length (cm)' );
+
+ # Insert the chart into the worksheet (with an offset).
+ $worksheet->insert_chart( 'D2', $chart, 25, 10 );
+
+ __END__
+
+
+=begin html
+
+<p>This will produce a chart that looks like this:</p>
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/bar1.jpg" width="527" height="320" alt="Chart example." /></center></p>
+
+=end html
+
+
+=head1 AUTHOR
+
+John McNamara jmcnamara@cpan.org
+
+=head1 COPYRIGHT
+
+Copyright MM-MMX, John McNamara.
+
+All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself.
+
diff --git a/mcu/tools/perl/Spreadsheet/WriteExcel/Chart/Column.pm b/mcu/tools/perl/Spreadsheet/WriteExcel/Chart/Column.pm
new file mode 100644
index 0000000..d0d0443
--- /dev/null
+++ b/mcu/tools/perl/Spreadsheet/WriteExcel/Chart/Column.pm
@@ -0,0 +1,199 @@
+package Spreadsheet::WriteExcel::Chart::Column;
+
+###############################################################################
+#
+# Column - A writer class for Excel Column charts.
+#
+# Used in conjunction with Spreadsheet::WriteExcel::Chart.
+#
+# See formatting note in Spreadsheet::WriteExcel::Chart.
+#
+# Copyright 2000-2010, John McNamara, jmcnamara@cpan.org
+#
+# Documentation after __END__
+#
+
+require Exporter;
+
+use strict;
+use Spreadsheet::WriteExcel::Chart;
+
+
+use vars qw($VERSION @ISA);
+@ISA = qw(Spreadsheet::WriteExcel::Chart Exporter);
+
+$VERSION = '2.37';
+
+###############################################################################
+#
+# new()
+#
+#
+sub new {
+
+ my $class = shift;
+ my $self = Spreadsheet::WriteExcel::Chart->new( @_ );
+
+ bless $self, $class;
+ return $self;
+}
+
+
+###############################################################################
+#
+# _store_chart_type()
+#
+# Implementation of the abstract method from the specific chart class.
+#
+# Write the BAR chart BIFF record. Defines a bar or column chart type.
+#
+sub _store_chart_type {
+
+ my $self = shift;
+
+ my $record = 0x1017; # Record identifier.
+ my $length = 0x0006; # Number of bytes to follow.
+ my $pcOverlap = 0x0000; # Space between bars.
+ my $pcGap = 0x0096; # Space between cats.
+ my $grbit = 0x0000; # Option flags.
+
+ my $header = pack 'vv', $record, $length;
+ my $data = '';
+ $data .= pack 'v', $pcOverlap;
+ $data .= pack 'v', $pcGap;
+ $data .= pack 'v', $grbit;
+
+ $self->_append( $header, $data );
+}
+
+
+1;
+
+
+__END__
+
+
+=head1 NAME
+
+Column - A writer class for Excel Column charts.
+
+=head1 SYNOPSIS
+
+To create a simple Excel file with a Column chart using Spreadsheet::WriteExcel:
+
+ #!/usr/bin/perl -w
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new( 'chart.xls' );
+ my $worksheet = $workbook->add_worksheet();
+
+ my $chart = $workbook->add_chart( type => 'column' );
+
+ # Configure the chart.
+ $chart->add_series(
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$B$2:$B$7',
+ );
+
+ # Add the worksheet data the chart refers to.
+ my $data = [
+ [ 'Category', 2, 3, 4, 5, 6, 7 ],
+ [ 'Value', 1, 4, 5, 2, 1, 5 ],
+ ];
+
+ $worksheet->write( 'A1', $data );
+
+ __END__
+
+=head1 DESCRIPTION
+
+This module implements Column charts for L<Spreadsheet::WriteExcel>. The chart object is created via the Workbook C<add_chart()> method:
+
+ my $chart = $workbook->add_chart( type => 'column' );
+
+Once the object is created it can be configured via the following methods that are common to all chart classes:
+
+ $chart->add_series();
+ $chart->set_x_axis();
+ $chart->set_y_axis();
+ $chart->set_title();
+
+These methods are explained in detail in L<Spreadsheet::WriteExcel::Chart>. Class specific methods or settings, if any, are explained below.
+
+=head1 Column Chart Methods
+
+There aren't currently any column chart specific methods. See the TODO section of L<Spreadsheet::WriteExcel::Chart>.
+
+=head1 EXAMPLE
+
+Here is a complete example that demonstrates most of the available features when creating a chart.
+
+ #!/usr/bin/perl -w
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new( 'chart_column.xls' );
+ my $worksheet = $workbook->add_worksheet();
+ my $bold = $workbook->add_format( bold => 1 );
+
+ # Add the worksheet data that the charts will refer to.
+ my $headings = [ 'Number', 'Sample 1', 'Sample 2' ];
+ my $data = [
+ [ 2, 3, 4, 5, 6, 7 ],
+ [ 1, 4, 5, 2, 1, 5 ],
+ [ 3, 6, 7, 5, 4, 3 ],
+ ];
+
+ $worksheet->write( 'A1', $headings, $bold );
+ $worksheet->write( 'A2', $data );
+
+ # Create a new chart object. In this case an embedded chart.
+ my $chart = $workbook->add_chart( type => 'column', embedded => 1 );
+
+ # Configure the first series. (Sample 1)
+ $chart->add_series(
+ name => 'Sample 1',
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$B$2:$B$7',
+ );
+
+ # Configure the second series. (Sample 2)
+ $chart->add_series(
+ name => 'Sample 2',
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$C$2:$C$7',
+ );
+
+ # Add a chart title and some axis labels.
+ $chart->set_title ( name => 'Results of sample analysis' );
+ $chart->set_x_axis( name => 'Test number' );
+ $chart->set_y_axis( name => 'Sample length (cm)' );
+
+ # Insert the chart into the worksheet (with an offset).
+ $worksheet->insert_chart( 'D2', $chart, 25, 10 );
+
+ __END__
+
+
+=begin html
+
+<p>This will produce a chart that looks like this:</p>
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/column1.jpg" width="527" height="320" alt="Chart example." /></center></p>
+
+=end html
+
+
+=head1 AUTHOR
+
+John McNamara jmcnamara@cpan.org
+
+=head1 COPYRIGHT
+
+Copyright MM-MMX, John McNamara.
+
+All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself.
+
diff --git a/mcu/tools/perl/Spreadsheet/WriteExcel/Chart/External.pm b/mcu/tools/perl/Spreadsheet/WriteExcel/Chart/External.pm
new file mode 100644
index 0000000..3e40b85
--- /dev/null
+++ b/mcu/tools/perl/Spreadsheet/WriteExcel/Chart/External.pm
@@ -0,0 +1,119 @@
+package Spreadsheet::WriteExcel::Chart::External;
+
+###############################################################################
+#
+# External - A writer class for Excel external charts.
+#
+# Used in conjunction with Spreadsheet::WriteExcel
+#
+# perltidy with options: -mbl=2 -pt=0 -nola
+#
+# Copyright 2000-2010, John McNamara, jmcnamara@cpan.org
+#
+# Documentation after __END__
+#
+
+require Exporter;
+
+use strict;
+use Spreadsheet::WriteExcel::Chart;
+
+
+use vars qw($VERSION @ISA);
+@ISA = qw(Spreadsheet::WriteExcel::Chart Exporter);
+
+$VERSION = '2.37';
+
+###############################################################################
+#
+# new()
+#
+#
+sub new {
+
+ my $class = shift;
+ my $external_filename = shift;
+ my $self = Spreadsheet::WriteExcel::Chart->new( @_ );
+
+ $self->{_filename} = $external_filename;
+ $self->{_external_bin} = 1;
+
+ bless $self, $class;
+ $self->_initialize(); # Requires overridden initialize().
+ return $self;
+}
+
+###############################################################################
+#
+# _initialize()
+#
+# Read all the data into memory for the external binary style chart.
+#
+#
+sub _initialize {
+
+ my $self = shift;
+
+ my $filename = $self->{_filename};
+ my $filehandle = FileHandle->new( $filename )
+ or die "Couldn't open $filename in add_chart_ext(): $!.\n";
+
+ binmode( $filehandle );
+
+ $self->{_filehandle} = $filehandle;
+ $self->{_datasize} = -s $filehandle;
+ $self->{_using_tmpfile} = 0;
+
+ # Read the entire external chart binary into the the data buffer.
+ # This will be retrieved by _get_data() when the chart is closed().
+ read( $self->{_filehandle}, $self->{_data}, $self->{_datasize} );
+}
+
+
+###############################################################################
+#
+# _close()
+#
+# We don't need to create or store Chart data structures when using an
+# external binary, so we have a default close method.
+#
+sub _close {
+
+ my $self = shift;
+
+ return undef;
+}
+
+1;
+
+
+__END__
+
+
+=head1 NAME
+
+External - A writer class for Excel external charts.
+
+=head1 SYNOPSIS
+
+This module is used to include external charts in Spreadsheet::WriteExcel.
+
+=head1 DESCRIPTION
+
+This module is used to include external charts in L<Spreadsheet::WriteExcel>. It is an internal module and isn't used directly by the end user.
+
+It is semi-deprecated in favour of using "native" charts. See L<Spreadsheet::WriteExcel::Chart>.
+
+For information on how to used external charts see the C<external_charts.txt> (or C<.pod>) in the C<external_charts> directory of the distro.
+
+
+=head1 AUTHOR
+
+John McNamara jmcnamara@cpan.org
+
+=head1 COPYRIGHT
+
+Copyright MM-MMX, John McNamara.
+
+All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself.
+
diff --git a/mcu/tools/perl/Spreadsheet/WriteExcel/Chart/Line.pm b/mcu/tools/perl/Spreadsheet/WriteExcel/Chart/Line.pm
new file mode 100644
index 0000000..60320b6
--- /dev/null
+++ b/mcu/tools/perl/Spreadsheet/WriteExcel/Chart/Line.pm
@@ -0,0 +1,194 @@
+package Spreadsheet::WriteExcel::Chart::Line;
+
+###############################################################################
+#
+# Line - A writer class for Excel Line charts.
+#
+# Used in conjunction with Spreadsheet::WriteExcel::Chart.
+#
+# See formatting note in Spreadsheet::WriteExcel::Chart.
+#
+# Copyright 2000-2010, John McNamara, jmcnamara@cpan.org
+#
+# Documentation after __END__
+#
+
+require Exporter;
+
+use strict;
+use Spreadsheet::WriteExcel::Chart;
+
+
+use vars qw($VERSION @ISA);
+@ISA = qw(Spreadsheet::WriteExcel::Chart Exporter);
+
+$VERSION = '2.37';
+
+###############################################################################
+#
+# new()
+#
+#
+sub new {
+
+ my $class = shift;
+ my $self = Spreadsheet::WriteExcel::Chart->new( @_ );
+
+ bless $self, $class;
+ return $self;
+}
+
+
+###############################################################################
+#
+# _store_chart_type()
+#
+# Implementation of the abstract method from the specific chart class.
+#
+# Write the LINE chart BIFF record. Defines a line chart type.
+#
+sub _store_chart_type {
+
+ my $self = shift;
+
+ my $record = 0x1018; # Record identifier.
+ my $length = 0x0002; # Number of bytes to follow.
+ my $grbit = 0x0000; # Option flags.
+
+ my $header = pack 'vv', $record, $length;
+ my $data = pack 'v', $grbit;
+
+ $self->_append( $header, $data );
+}
+
+
+1;
+
+
+__END__
+
+
+=head1 NAME
+
+Line - A writer class for Excel Line charts.
+
+=head1 SYNOPSIS
+
+To create a simple Excel file with a Line chart using Spreadsheet::WriteExcel:
+
+ #!/usr/bin/perl -w
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new( 'chart.xls' );
+ my $worksheet = $workbook->add_worksheet();
+
+ my $chart = $workbook->add_chart( type => 'line' );
+
+ # Configure the chart.
+ $chart->add_series(
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$B$2:$B$7',
+ );
+
+ # Add the worksheet data the chart refers to.
+ my $data = [
+ [ 'Category', 2, 3, 4, 5, 6, 7 ],
+ [ 'Value', 1, 4, 5, 2, 1, 5 ],
+ ];
+
+ $worksheet->write( 'A1', $data );
+
+ __END__
+
+=head1 DESCRIPTION
+
+This module implements Line charts for L<Spreadsheet::WriteExcel>. The chart object is created via the Workbook C<add_chart()> method:
+
+ my $chart = $workbook->add_chart( type => 'line' );
+
+Once the object is created it can be configured via the following methods that are common to all chart classes:
+
+ $chart->add_series();
+ $chart->set_x_axis();
+ $chart->set_y_axis();
+ $chart->set_title();
+
+These methods are explained in detail in L<Spreadsheet::WriteExcel::Chart>. Class specific methods or settings, if any, are explained below.
+
+=head1 Line Chart Methods
+
+There aren't currently any line chart specific methods. See the TODO section of L<Spreadsheet::WriteExcel::Chart>.
+
+=head1 EXAMPLE
+
+Here is a complete example that demonstrates most of the available features when creating a chart.
+
+ #!/usr/bin/perl -w
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new( 'chart_line.xls' );
+ my $worksheet = $workbook->add_worksheet();
+ my $bold = $workbook->add_format( bold => 1 );
+
+ # Add the worksheet data that the charts will refer to.
+ my $headings = [ 'Number', 'Sample 1', 'Sample 2' ];
+ my $data = [
+ [ 2, 3, 4, 5, 6, 7 ],
+ [ 1, 4, 5, 2, 1, 5 ],
+ [ 3, 6, 7, 5, 4, 3 ],
+ ];
+
+ $worksheet->write( 'A1', $headings, $bold );
+ $worksheet->write( 'A2', $data );
+
+ # Create a new chart object. In this case an embedded chart.
+ my $chart = $workbook->add_chart( type => 'line', embedded => 1 );
+
+ # Configure the first series. (Sample 1)
+ $chart->add_series(
+ name => 'Sample 1',
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$B$2:$B$7',
+ );
+
+ # Configure the second series. (Sample 2)
+ $chart->add_series(
+ name => 'Sample 2',
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$C$2:$C$7',
+ );
+
+ # Add a chart title and some axis labels.
+ $chart->set_title ( name => 'Results of sample analysis' );
+ $chart->set_x_axis( name => 'Test number' );
+ $chart->set_y_axis( name => 'Sample length (cm)' );
+
+ # Insert the chart into the worksheet (with an offset).
+ $worksheet->insert_chart( 'D2', $chart, 25, 10 );
+
+ __END__
+
+
+=begin html
+
+<p>This will produce a chart that looks like this:</p>
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/line1.jpg" width="527" height="320" alt="Chart example." /></center></p>
+
+=end html
+
+
+=head1 AUTHOR
+
+John McNamara jmcnamara@cpan.org
+
+=head1 COPYRIGHT
+
+Copyright MM-MMX, John McNamara.
+
+All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself.
+
diff --git a/mcu/tools/perl/Spreadsheet/WriteExcel/Chart/Pie.pm b/mcu/tools/perl/Spreadsheet/WriteExcel/Chart/Pie.pm
new file mode 100644
index 0000000..6427e40
--- /dev/null
+++ b/mcu/tools/perl/Spreadsheet/WriteExcel/Chart/Pie.pm
@@ -0,0 +1,217 @@
+package Spreadsheet::WriteExcel::Chart::Pie;
+
+###############################################################################
+#
+# Pie - A writer class for Excel Pie charts.
+#
+# Used in conjunction with Spreadsheet::WriteExcel::Chart.
+#
+# See formatting note in Spreadsheet::WriteExcel::Chart.
+#
+# Copyright 2000-2010, John McNamara, jmcnamara@cpan.org
+#
+# Documentation after __END__
+#
+
+require Exporter;
+
+use strict;
+use Spreadsheet::WriteExcel::Chart;
+
+
+use vars qw($VERSION @ISA);
+@ISA = qw(Spreadsheet::WriteExcel::Chart Exporter);
+
+$VERSION = '2.37';
+
+###############################################################################
+#
+# new()
+#
+#
+sub new {
+
+ my $class = shift;
+ my $self = Spreadsheet::WriteExcel::Chart->new( @_ );
+
+ $self->{_vary_data_color} = 1;
+
+ bless $self, $class;
+ return $self;
+}
+
+
+###############################################################################
+#
+# _store_chart_type()
+#
+# Implementation of the abstract method from the specific chart class.
+#
+# Write the Pie chart BIFF record.
+#
+sub _store_chart_type {
+
+ my $self = shift;
+
+ my $record = 0x1019; # Record identifier.
+ my $length = 0x0006; # Number of bytes to follow.
+ my $angle = 0x0000; # Angle.
+ my $donut = 0x0000; # Donut hole size.
+ my $grbit = 0x0002; # Option flags.
+
+ my $header = pack 'vv', $record, $length;
+ my $data = '';
+ $data .= pack 'v', $angle;
+ $data .= pack 'v', $donut;
+ $data .= pack 'v', $grbit;
+
+ $self->_append( $header, $data );
+}
+
+
+###############################################################################
+#
+# _store_axisparent_stream(). Overridden.
+#
+# Write the AXISPARENT chart substream.
+#
+# A Pie chart has no X or Y axis so we override this method to remove them.
+#
+sub _store_axisparent_stream {
+
+ my $self = shift;
+
+ $self->_store_axisparent( @{ $self->{_config}->{_axisparent} } );
+
+ $self->_store_begin();
+ $self->_store_pos( @{ $self->{_config}->{_axisparent_pos} } );
+
+ $self->_store_chartformat_stream();
+ $self->_store_end();
+}
+
+
+1;
+
+
+__END__
+
+
+=head1 NAME
+
+Pie - A writer class for Excel Pie charts.
+
+=head1 SYNOPSIS
+
+To create a simple Excel file with a Pie chart using Spreadsheet::WriteExcel:
+
+ #!/usr/bin/perl -w
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new( 'chart.xls' );
+ my $worksheet = $workbook->add_worksheet();
+
+ my $chart = $workbook->add_chart( type => 'pie' );
+
+ # Configure the chart.
+ $chart->add_series(
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$B$2:$B$7',
+ );
+
+ # Add the worksheet data the chart refers to.
+ my $data = [
+ [ 'Category', 2, 3, 4, 5, 6, 7 ],
+ [ 'Value', 1, 4, 5, 2, 1, 5 ],
+ ];
+
+ $worksheet->write( 'A1', $data );
+
+ __END__
+
+=head1 DESCRIPTION
+
+This module implements Pie charts for L<Spreadsheet::WriteExcel>. The chart object is created via the Workbook C<add_chart()> method:
+
+ my $chart = $workbook->add_chart( type => 'pie' );
+
+Once the object is created it can be configured via the following methods that are common to all chart classes:
+
+ $chart->add_series();
+ $chart->set_title();
+
+These methods are explained in detail in L<Spreadsheet::WriteExcel::Chart>. Class specific methods or settings, if any, are explained below.
+
+=head1 Pie Chart Methods
+
+There aren't currently any pie chart specific methods. See the TODO section of L<Spreadsheet::WriteExcel::Chart>.
+
+A Pie chart doesn't have an X or Y axis so the following common chart methods are ignored.
+
+ $chart->set_x_axis();
+ $chart->set_y_axis();
+
+=head1 EXAMPLE
+
+Here is a complete example that demonstrates most of the available features when creating a chart.
+
+ #!/usr/bin/perl -w
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new( 'chart_pie.xls' );
+ my $worksheet = $workbook->add_worksheet();
+ my $bold = $workbook->add_format( bold => 1 );
+
+ # Add the worksheet data that the charts will refer to.
+ my $headings = [ 'Category', 'Values' ];
+ my $data = [
+ [ 'Apple', 'Cherry', 'Pecan' ],
+ [ 60, 30, 10 ],
+ ];
+
+ $worksheet->write( 'A1', $headings, $bold );
+ $worksheet->write( 'A2', $data );
+
+ # Create a new chart object. In this case an embedded chart.
+ my $chart = $workbook->add_chart( type => 'pie', embedded => 1 );
+
+ # Configure the series.
+ $chart->add_series(
+ name => 'Pie sales data',
+ categories => '=Sheet1!$A$2:$A$4',
+ values => '=Sheet1!$B$2:$B$4',
+ );
+
+ # Add a title.
+ $chart->set_title( name => 'Popular Pie Types' );
+
+
+ # Insert the chart into the worksheet (with an offset).
+ $worksheet->insert_chart( 'C2', $chart, 25, 10 );
+
+ __END__
+
+
+=begin html
+
+<p>This will produce a chart that looks like this:</p>
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/pie1.jpg" width="527" height="320" alt="Chart example." /></center></p>
+
+=end html
+
+
+=head1 AUTHOR
+
+John McNamara jmcnamara@cpan.org
+
+=head1 COPYRIGHT
+
+Copyright MM-MMX, John McNamara.
+
+All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself.
+
diff --git a/mcu/tools/perl/Spreadsheet/WriteExcel/Chart/Scatter.pm b/mcu/tools/perl/Spreadsheet/WriteExcel/Chart/Scatter.pm
new file mode 100644
index 0000000..54205de
--- /dev/null
+++ b/mcu/tools/perl/Spreadsheet/WriteExcel/Chart/Scatter.pm
@@ -0,0 +1,245 @@
+package Spreadsheet::WriteExcel::Chart::Scatter;
+
+###############################################################################
+#
+# Scatter - A writer class for Excel Scatter charts.
+#
+# Used in conjunction with Spreadsheet::WriteExcel::Chart.
+#
+# See formatting note in Spreadsheet::WriteExcel::Chart.
+#
+# Copyright 2000-2010, John McNamara, jmcnamara@cpan.org
+#
+# Documentation after __END__
+#
+
+require Exporter;
+
+use strict;
+use Spreadsheet::WriteExcel::Chart;
+
+
+use vars qw($VERSION @ISA);
+@ISA = qw(Spreadsheet::WriteExcel::Chart Exporter);
+
+$VERSION = '2.37';
+
+###############################################################################
+#
+# new()
+#
+#
+sub new {
+
+ my $class = shift;
+ my $self = Spreadsheet::WriteExcel::Chart->new( @_ );
+
+ bless $self, $class;
+ return $self;
+}
+
+
+###############################################################################
+#
+# _store_chart_type()
+#
+# Implementation of the abstract method from the specific chart class.
+#
+# Write the SCATTER chart BIFF record. Defines a scatter chart type.
+#
+sub _store_chart_type {
+
+ my $self = shift;
+
+ my $record = 0x101B; # Record identifier.
+ my $length = 0x0006; # Number of bytes to follow.
+ my $bubble_ratio = 0x0064; # Bubble ratio.
+ my $bubble_type = 0x0001; # Bubble type.
+ my $grbit = 0x0000; # Option flags.
+
+ my $header = pack 'vv', $record, $length;
+ my $data = '';
+ $data .= pack 'v', $bubble_ratio;
+ $data .= pack 'v', $bubble_type;
+ $data .= pack 'v', $grbit;
+
+ $self->_append( $header, $data );
+}
+
+
+###############################################################################
+#
+# _store_axis_category_stream(). Overridden.
+#
+# Write the AXIS chart substream for the chart category.
+#
+# For a Scatter chart the category stream is replace with a values stream. We
+# override this method and turn it into a values stream.
+#
+sub _store_axis_category_stream {
+
+ my $self = shift;
+
+ $self->_store_axis( 0 );
+
+ $self->_store_begin();
+ $self->_store_valuerange();
+ $self->_store_tick();
+ $self->_store_end();
+}
+
+
+###############################################################################
+#
+# _store_marker_dataformat_stream(). Overridden.
+#
+# This is an implementation of the parent abstract method to define
+# properties of markers, linetypes, pie formats and other.
+#
+sub _store_marker_dataformat_stream {
+
+ my $self = shift;
+
+ $self->_store_dataformat( 0x0000, 0xFFFD, 0x0000 );
+
+ $self->_store_begin();
+ $self->_store_3dbarshape();
+ $self->_store_lineformat( 0x00000000, 0x0005, 0xFFFF, 0x0008, 0x004D );
+ $self->_store_areaformat( 0x00FFFFFF, 0x0000, 0x01, 0x01, 0x4E, 0x4D );
+ $self->_store_pieformat();
+ $self->_store_markerformat( 0x00, 0x00, 0x02, 0x01, 0x4D, 0x4D, 0x3C );
+ $self->_store_end();
+
+}
+
+
+1;
+
+
+__END__
+
+
+=head1 NAME
+
+Scatter - A writer class for Excel Scatter charts.
+
+=head1 SYNOPSIS
+
+To create a simple Excel file with a Scatter chart using Spreadsheet::WriteExcel:
+
+ #!/usr/bin/perl -w
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new( 'chart.xls' );
+ my $worksheet = $workbook->add_worksheet();
+
+ my $chart = $workbook->add_chart( type => 'scatter' );
+
+ # Configure the chart.
+ $chart->add_series(
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$B$2:$B$7',
+ );
+
+ # Add the worksheet data the chart refers to.
+ my $data = [
+ [ 'Category', 2, 3, 4, 5, 6, 7 ],
+ [ 'Value', 1, 4, 5, 2, 1, 5 ],
+ ];
+
+ $worksheet->write( 'A1', $data );
+
+ __END__
+
+=head1 DESCRIPTION
+
+This module implements Scatter charts for L<Spreadsheet::WriteExcel>. The chart object is created via the Workbook C<add_chart()> method:
+
+ my $chart = $workbook->add_chart( type => 'scatter' );
+
+Once the object is created it can be configured via the following methods that are common to all chart classes:
+
+ $chart->add_series();
+ $chart->set_x_axis();
+ $chart->set_y_axis();
+ $chart->set_title();
+
+These methods are explained in detail in L<Spreadsheet::WriteExcel::Chart>. Class specific methods or settings, if any, are explained below.
+
+=head1 Scatter Chart Methods
+
+There aren't currently any scatter chart specific methods. See the TODO section of L<Spreadsheet::WriteExcel::Chart>.
+
+=head1 EXAMPLE
+
+Here is a complete example that demonstrates most of the available features when creating a chart.
+
+ #!/usr/bin/perl -w
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new( 'chart_scatter.xls' );
+ my $worksheet = $workbook->add_worksheet();
+ my $bold = $workbook->add_format( bold => 1 );
+
+ # Add the worksheet data that the charts will refer to.
+ my $headings = [ 'Number', 'Sample 1', 'Sample 2' ];
+ my $data = [
+ [ 2, 3, 4, 5, 6, 7 ],
+ [ 1, 4, 5, 2, 1, 5 ],
+ [ 3, 6, 7, 5, 4, 3 ],
+ ];
+
+ $worksheet->write( 'A1', $headings, $bold );
+ $worksheet->write( 'A2', $data );
+
+ # Create a new chart object. In this case an embedded chart.
+ my $chart = $workbook->add_chart( type => 'scatter', embedded => 1 );
+
+ # Configure the first series. (Sample 1)
+ $chart->add_series(
+ name => 'Sample 1',
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$B$2:$B$7',
+ );
+
+ # Configure the second series. (Sample 2)
+ $chart->add_series(
+ name => 'Sample 2',
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$C$2:$C$7',
+ );
+
+ # Add a chart title and some axis labels.
+ $chart->set_title ( name => 'Results of sample analysis' );
+ $chart->set_x_axis( name => 'Test number' );
+ $chart->set_y_axis( name => 'Sample length (cm)' );
+
+ # Insert the chart into the worksheet (with an offset).
+ $worksheet->insert_chart( 'D2', $chart, 25, 10 );
+
+ __END__
+
+
+=begin html
+
+<p>This will produce a chart that looks like this:</p>
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/scatter1.jpg" width="527" height="320" alt="Chart example." /></center></p>
+
+=end html
+
+
+=head1 AUTHOR
+
+John McNamara jmcnamara@cpan.org
+
+=head1 COPYRIGHT
+
+Copyright MM-MMX, John McNamara.
+
+All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself.
+
diff --git a/mcu/tools/perl/Spreadsheet/WriteExcel/Chart/Stock.pm b/mcu/tools/perl/Spreadsheet/WriteExcel/Chart/Stock.pm
new file mode 100644
index 0000000..6a529f0
--- /dev/null
+++ b/mcu/tools/perl/Spreadsheet/WriteExcel/Chart/Stock.pm
@@ -0,0 +1,257 @@
+package Spreadsheet::WriteExcel::Chart::Stock;
+
+###############################################################################
+#
+# Stock - A writer class for Excel Stock charts.
+#
+# Used in conjunction with Spreadsheet::WriteExcel::Chart.
+#
+# See formatting note in Spreadsheet::WriteExcel::Chart.
+#
+# Copyright 2000-2010, John McNamara, jmcnamara@cpan.org
+#
+# Documentation after __END__
+#
+
+require Exporter;
+
+use strict;
+use Spreadsheet::WriteExcel::Chart;
+
+
+use vars qw($VERSION @ISA);
+@ISA = qw(Spreadsheet::WriteExcel::Chart Exporter);
+
+$VERSION = '2.37';
+
+###############################################################################
+#
+# new()
+#
+#
+sub new {
+
+ my $class = shift;
+ my $self = Spreadsheet::WriteExcel::Chart->new( @_ );
+
+ bless $self, $class;
+ return $self;
+}
+
+
+###############################################################################
+#
+# _store_chart_type()
+#
+# Implementation of the abstract method from the specific chart class.
+#
+# Write the LINE chart BIFF record. A stock chart uses the same LINE record
+# as a line chart but with additional DROPBAR and CHARTLINE records to define
+# the stock style.
+#
+sub _store_chart_type {
+
+ my $self = shift;
+
+ my $record = 0x1018; # Record identifier.
+ my $length = 0x0002; # Number of bytes to follow.
+ my $grbit = 0x0000; # Option flags.
+
+ my $header = pack 'vv', $record, $length;
+ my $data = pack 'v', $grbit;
+
+ $self->_append( $header, $data );
+}
+
+###############################################################################
+#
+# _store_marker_dataformat_stream(). Overridden.
+#
+# This is an implementation of the parent abstract method to define
+# properties of markers, linetypes, pie formats and other.
+#
+sub _store_marker_dataformat_stream {
+
+ my $self = shift;
+
+ $self->_store_dropbar();
+ $self->_store_begin();
+ $self->_store_lineformat( 0x00000000, 0x0000, 0xFFFF, 0x0001, 0x004F );
+ $self->_store_areaformat( 0x00FFFFFF, 0x0000, 0x01, 0x01, 0x09, 0x08 );
+ $self->_store_end();
+
+ $self->_store_dropbar();
+ $self->_store_begin();
+ $self->_store_lineformat( 0x00000000, 0x0000, 0xFFFF, 0x0001, 0x004F );
+ $self->_store_areaformat( 0x0000, 0x00FFFFFF, 0x01, 0x01, 0x08, 0x09 );
+ $self->_store_end();
+
+ $self->_store_chartline();
+ $self->_store_lineformat( 0x00000000, 0x0000, 0xFFFF, 0x0000, 0x004F );
+
+
+ $self->_store_dataformat( 0x0000, 0xFFFD, 0x0000 );
+ $self->_store_begin();
+ $self->_store_3dbarshape();
+ $self->_store_lineformat( 0x00000000, 0x0005, 0xFFFF, 0x0000, 0x004F );
+ $self->_store_areaformat( 0x00000000, 0x0000, 0x00, 0x01, 0x4D, 0x4D );
+ $self->_store_pieformat();
+ $self->_store_markerformat( 0x00, 0x00, 0x00, 0x00, 0x4D, 0x4D, 0x3C );
+ $self->_store_end();
+
+}
+
+
+1;
+
+
+__END__
+
+
+=head1 NAME
+
+Stock - A writer class for Excel Stock charts.
+
+=head1 SYNOPSIS
+
+To create a simple Excel file with a Stock chart using Spreadsheet::WriteExcel:
+
+ #!/usr/bin/perl -w
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new( 'chart.xls' );
+ my $worksheet = $workbook->add_worksheet();
+
+ my $chart = $workbook->add_chart( type => 'stock' );
+
+ # Add a series for each Open-High-Low-Close.
+ $chart->add_series( categories => '=Sheet1!$A$2:$A$6', values => '=Sheet1!$B$2:$B$6' );
+ $chart->add_series( categories => '=Sheet1!$A$2:$A$6', values => '=Sheet1!$C$2:$C$6' );
+ $chart->add_series( categories => '=Sheet1!$A$2:$A$6', values => '=Sheet1!$D$2:$D$6' );
+ $chart->add_series( categories => '=Sheet1!$A$2:$A$6', values => '=Sheet1!$E$2:$E$6' );
+
+ # Add the worksheet data the chart refers to.
+ # ... See the full example below.
+
+ __END__
+
+
+=head1 DESCRIPTION
+
+This module implements Stock charts for L<Spreadsheet::WriteExcel>. The chart object is created via the Workbook C<add_chart()> method:
+
+ my $chart = $workbook->add_chart( type => 'stock' );
+
+Once the object is created it can be configured via the following methods that are common to all chart classes:
+
+ $chart->add_series();
+ $chart->set_x_axis();
+ $chart->set_y_axis();
+ $chart->set_title();
+
+These methods are explained in detail in L<Spreadsheet::WriteExcel::Chart>. Class specific methods or settings, if any, are explained below.
+
+=head1 Stock Chart Methods
+
+There aren't currently any stock chart specific methods. See the TODO section of L<Spreadsheet::WriteExcel::Chart>.
+
+The default Stock chart is an Open-High-Low-Close chart. A series must be added for each of these data sources.
+
+The default Stock chart is in black and white. User defined colours will be added at a later stage.
+
+=head1 EXAMPLE
+
+Here is a complete example that demonstrates most of the available features when creating a Stock chart.
+
+ #!/usr/bin/perl -w
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new( 'chart_stock_ex.xls' );
+ my $worksheet = $workbook->add_worksheet();
+ my $bold = $workbook->add_format( bold => 1 );
+ my $date_format = $workbook->add_format( num_format => 'dd/mm/yyyy' );
+
+ # Add the worksheet data that the charts will refer to.
+ my $headings = [ 'Date', 'Open', 'High', 'Low', 'Close' ];
+ my @data = (
+ [ '2009-08-23', 110.75, 113.48, 109.05, 109.40 ],
+ [ '2009-08-24', 111.24, 111.60, 103.57, 104.87 ],
+ [ '2009-08-25', 104.96, 108.00, 103.88, 106.00 ],
+ [ '2009-08-26', 104.95, 107.95, 104.66, 107.91 ],
+ [ '2009-08-27', 108.10, 108.62, 105.69, 106.15 ],
+ );
+
+ $worksheet->write( 'A1', $headings, $bold );
+
+ my $row = 1;
+ for my $data ( @data ) {
+ $worksheet->write( $row, 0, $data->[0], $date_format );
+ $worksheet->write( $row, 1, $data->[1] );
+ $worksheet->write( $row, 2, $data->[2] );
+ $worksheet->write( $row, 3, $data->[3] );
+ $worksheet->write( $row, 4, $data->[4] );
+ $row++;
+ }
+
+ # Create a new chart object. In this case an embedded chart.
+ my $chart = $workbook->add_chart( type => 'stock', embedded => 1 );
+
+ # Add a series for each of the Open-High-Low-Close columns.
+ $chart->add_series(
+ categories => '=Sheet1!$A$2:$A$6',
+ values => '=Sheet1!$B$2:$B$6',
+ name => 'Open',
+ );
+
+ $chart->add_series(
+ categories => '=Sheet1!$A$2:$A$6',
+ values => '=Sheet1!$C$2:$C$6',
+ name => 'High',
+ );
+
+ $chart->add_series(
+ categories => '=Sheet1!$A$2:$A$6',
+ values => '=Sheet1!$D$2:$D$6',
+ name => 'Low',
+ );
+
+ $chart->add_series(
+ categories => '=Sheet1!$A$2:$A$6',
+ values => '=Sheet1!$E$2:$E$6',
+ name => 'Close',
+ );
+
+ # Add a chart title and some axis labels.
+ $chart->set_title( name => 'Open-High-Low-Close', );
+ $chart->set_x_axis( name => 'Date', );
+ $chart->set_y_axis( name => 'Share price', );
+
+ # Insert the chart into the worksheet (with an offset).
+ $worksheet->insert_chart( 'F2', $chart, 25, 10 );
+
+ __END__
+
+
+=begin html
+
+<p>This will produce a chart that looks like this:</p>
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/stock1.jpg" width="527" height="320" alt="Chart example." /></center></p>
+
+=end html
+
+
+=head1 AUTHOR
+
+John McNamara jmcnamara@cpan.org
+
+=head1 COPYRIGHT
+
+Copyright MM-MMX, John McNamara.
+
+All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself.
+
diff --git a/mcu/tools/perl/Spreadsheet/WriteExcel/Examples.pm b/mcu/tools/perl/Spreadsheet/WriteExcel/Examples.pm
new file mode 100644
index 0000000..4a29697
--- /dev/null
+++ b/mcu/tools/perl/Spreadsheet/WriteExcel/Examples.pm
@@ -0,0 +1,10638 @@
+package Spreadsheet::WriteExcel::Examples;
+
+###############################################################################
+#
+# Examples - Spreadsheet::WriteExcel examples.
+#
+# A documentation only module showing the examples that are
+# included in the Spreadsheet::WriteExcel distribution. This
+# file was generated automatically via the gen_examples_pod.pl
+# program that is also included in the examples directory.
+#
+# Copyright 2000-2010, John McNamara, jmcnamara@cpan.org
+#
+# Documentation after __END__
+#
+
+use strict;
+use vars qw($VERSION);
+$VERSION = '2.37';
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Examples - Spreadsheet::WriteExcel example programs.
+
+=head1 DESCRIPTION
+
+This is a documentation only module showing the examples that are
+included in the L<Spreadsheet::WriteExcel> distribution.
+
+This file was auto-generated via the gen_examples_pod.pl
+program that is also included in the examples directory.
+
+=head1 Example programs
+
+The following is a list of the 85 example programs that are included in the Spreadsheet::WriteExcel distribution.
+
+=over
+
+=item * L<Example: a_simple.pl> A get started example with some basic features.
+
+=item * L<Example: demo.pl> A demo of some of the available features.
+
+=item * L<Example: regions.pl> A simple example of multiple worksheets.
+
+=item * L<Example: stats.pl> Basic formulas and functions.
+
+=item * L<Example: formats.pl> All the available formatting on several worksheets.
+
+=item * L<Example: bug_report.pl> A template for submitting bug reports.
+
+=item * L<Example: autofilter.pl> Examples of worksheet autofilters.
+
+=item * L<Example: autofit.pl> Simulate Excel's autofit for column widths.
+
+=item * L<Example: bigfile.pl> Write past the 7MB limit with OLE::Storage_Lite.
+
+=item * L<Example: cgi.pl> A simple CGI program.
+
+=item * L<Example: chart_area.pl> A demo of area style charts.
+
+=item * L<Example: chart_bar.pl> A demo of bar (vertical histogram) style charts.
+
+=item * L<Example: chart_column.pl> A demo of column (histogram) style charts.
+
+=item * L<Example: chart_line.pl> A demo of line style charts.
+
+=item * L<Example: chart_pie.pl> A demo of pie style charts.
+
+=item * L<Example: chart_scatter.pl> A demo of scatter style charts.
+
+=item * L<Example: chart_stock.pl> A demo of stock style charts.
+
+=item * L<Example: chess.pl> An example of reusing formatting via properties.
+
+=item * L<Example: colors.pl> A demo of the colour palette and named colours.
+
+=item * L<Example: comments1.pl> Add comments to worksheet cells.
+
+=item * L<Example: comments2.pl> Add comments with advanced options.
+
+=item * L<Example: copyformat.pl> Example of copying a cell format.
+
+=item * L<Example: data_validate.pl> An example of data validation and dropdown lists.
+
+=item * L<Example: date_time.pl> Write dates and times with write_date_time().
+
+=item * L<Example: defined_name.pl> Example of how to create defined names.
+
+=item * L<Example: diag_border.pl> A simple example of diagonal cell borders.
+
+=item * L<Example: easter_egg.pl> Expose the Excel97 flight simulator.
+
+=item * L<Example: filehandle.pl> Examples of working with filehandles.
+
+=item * L<Example: formula_result.pl> Formulas with user specified results.
+
+=item * L<Example: headers.pl> Examples of worksheet headers and footers.
+
+=item * L<Example: hide_sheet.pl> Simple example of hiding a worksheet.
+
+=item * L<Example: hyperlink1.pl> Shows how to create web hyperlinks.
+
+=item * L<Example: hyperlink2.pl> Examples of internal and external hyperlinks.
+
+=item * L<Example: images.pl> Adding images to worksheets.
+
+=item * L<Example: indent.pl> An example of cell indentation.
+
+=item * L<Example: merge1.pl> A simple example of cell merging.
+
+=item * L<Example: merge2.pl> A simple example of cell merging with formatting.
+
+=item * L<Example: merge3.pl> Add hyperlinks to merged cells.
+
+=item * L<Example: merge4.pl> An advanced example of merging with formatting.
+
+=item * L<Example: merge5.pl> An advanced example of merging with formatting.
+
+=item * L<Example: merge6.pl> An example of merging with Unicode strings.
+
+=item * L<Example: mod_perl1.pl> A simple mod_perl 1 program.
+
+=item * L<Example: mod_perl2.pl> A simple mod_perl 2 program.
+
+=item * L<Example: outline.pl> An example of outlines and grouping.
+
+=item * L<Example: outline_collapsed.pl> An example of collapsed outlines.
+
+=item * L<Example: panes.pl> An examples of how to create panes.
+
+=item * L<Example: properties.pl> Add document properties to a workbook.
+
+=item * L<Example: protection.pl> Example of cell locking and formula hiding.
+
+=item * L<Example: repeat.pl> Example of writing repeated formulas.
+
+=item * L<Example: right_to_left.pl> Change default sheet direction to right to left.
+
+=item * L<Example: row_wrap.pl> How to wrap data from one worksheet onto another.
+
+=item * L<Example: sales.pl> An example of a simple sales spreadsheet.
+
+=item * L<Example: sendmail.pl> Send an Excel email attachment using Mail::Sender.
+
+=item * L<Example: stats_ext.pl> Same as stats.pl with external references.
+
+=item * L<Example: stocks.pl> Demonstrates conditional formatting.
+
+=item * L<Example: tab_colors.pl> Example of how to set worksheet tab colours.
+
+=item * L<Example: textwrap.pl> Demonstrates text wrapping options.
+
+=item * L<Example: win32ole.pl> A sample Win32::OLE example for comparison.
+
+=item * L<Example: write_arrays.pl> Example of writing 1D or 2D arrays of data.
+
+=item * L<Example: write_handler1.pl> Example of extending the write() method. Step 1.
+
+=item * L<Example: write_handler2.pl> Example of extending the write() method. Step 2.
+
+=item * L<Example: write_handler3.pl> Example of extending the write() method. Step 3.
+
+=item * L<Example: write_handler4.pl> Example of extending the write() method. Step 4.
+
+=item * L<Example: write_to_scalar.pl> Example of writing an Excel file to a Perl scalar.
+
+=item * L<Example: unicode_utf16.pl> Simple example of using Unicode UTF16 strings.
+
+=item * L<Example: unicode_utf16_japan.pl> Write Japanese Unicode strings using UTF-16.
+
+=item * L<Example: unicode_cyrillic.pl> Write Russian Cyrillic strings using UTF-8.
+
+=item * L<Example: unicode_list.pl> List the chars in a Unicode font.
+
+=item * L<Example: unicode_2022_jp.pl> Japanese: ISO-2022-JP to utf8 in perl 5.8.
+
+=item * L<Example: unicode_8859_11.pl> Thai: ISO-8859_11 to utf8 in perl 5.8.
+
+=item * L<Example: unicode_8859_7.pl> Greek: ISO-8859_7 to utf8 in perl 5.8.
+
+=item * L<Example: unicode_big5.pl> Chinese: BIG5 to utf8 in perl 5.8.
+
+=item * L<Example: unicode_cp1251.pl> Russian: CP1251 to utf8 in perl 5.8.
+
+=item * L<Example: unicode_cp1256.pl> Arabic: CP1256 to utf8 in perl 5.8.
+
+=item * L<Example: unicode_koi8r.pl> Russian: KOI8-R to utf8 in perl 5.8.
+
+=item * L<Example: unicode_polish_utf8.pl> Polish : UTF8 to utf8 in perl 5.8.
+
+=item * L<Example: unicode_shift_jis.pl> Japanese: Shift JIS to utf8 in perl 5.8.
+
+=item * L<Example: csv2xls.pl> Program to convert a CSV file to an Excel file.
+
+=item * L<Example: tab2xls.pl> Program to convert a tab separated file to xls.
+
+=item * L<Example: datecalc1.pl> Convert Unix/Perl time to Excel time.
+
+=item * L<Example: datecalc2.pl> Calculate an Excel date using Date::Calc.
+
+=item * L<Example: lecxe.pl> Convert Excel to WriteExcel using Win32::OLE.
+
+=item * L<Example: convertA1.pl> Helper functions for dealing with A1 notation.
+
+=item * L<Example: function_locale.pl> Add non-English function names to Formula.pm.
+
+=item * L<Example: writeA1.pl> Example of how to extend the module.
+
+=back
+
+=head2 Example: a_simple.pl
+
+
+
+A simple example of how to use the Spreadsheet::WriteExcel module to write
+some text and numbers to an Excel binary file.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/a_simple.jpg" width="640" height="420" alt="Output from a_simple.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # A simple example of how to use the Spreadsheet::WriteExcel module to write
+ # some text and numbers to an Excel binary file.
+ #
+ # reverse('©'), March 2001, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ # Create a new workbook called simple.xls and add a worksheet
+ my $workbook = Spreadsheet::WriteExcel->new('a_simple.xls');
+ my $worksheet = $workbook->add_worksheet();
+
+ # The general syntax is write($row, $column, $token). Note that row and
+ # column are zero indexed
+ #
+
+ # Write some text
+ $worksheet->write(0, 0, "Hi Excel!");
+
+
+ # Write some numbers
+ $worksheet->write(2, 0, 3); # Writes 3
+ $worksheet->write(3, 0, 3.00000); # Writes 3
+ $worksheet->write(4, 0, 3.00001); # Writes 3.00001
+ $worksheet->write(5, 0, 3.14159); # TeX revision no.?
+
+
+ # Write some formulas
+ $worksheet->write(7, 0, '=A3 + A6');
+ $worksheet->write(8, 0, '=IF(A5>3,"Yes", "No")');
+
+
+ # Write a hyperlink
+ $worksheet->write(10, 0, 'http://www.perl.com/');
+
+ __END__
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/a_simple.pl>
+
+=head2 Example: demo.pl
+
+
+
+A simple demo of some of the features of Spreadsheet::WriteExcel.
+
+This program is used to create the project screenshot for Freshmeat:
+L<http://freshmeat.net/projects/writeexcel/>
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/demo.jpg" width="640" height="420" alt="Output from demo.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ #######################################################################
+ #
+ # A simple demo of some of the features of Spreadsheet::WriteExcel.
+ #
+ # This program is used to create the project screenshot for Freshmeat:
+ # L<http://freshmeat.net/projects/writeexcel/>
+ #
+ # reverse('©'), October 2001, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new("demo.xls");
+ my $worksheet = $workbook->add_worksheet('Demo');
+ my $worksheet2 = $workbook->add_worksheet('Another sheet');
+ my $worksheet3 = $workbook->add_worksheet('And another');
+
+ my $bold = $workbook->add_format(bold => 1);
+
+
+ #######################################################################
+ #
+ # Write a general heading
+ #
+ $worksheet->set_column('A:A', 36, $bold);
+ $worksheet->set_column('B:B', 20 );
+ $worksheet->set_row (0, 40 );
+
+ my $heading = $workbook->add_format(
+ bold => 1,
+ color => 'blue',
+ size => 16,
+ merge => 1,
+ align => 'vcenter',
+ );
+
+ my @headings = ('Features of Spreadsheet::WriteExcel', '');
+ $worksheet->write_row('A1', \@headings, $heading);
+
+
+ #######################################################################
+ #
+ # Some text examples
+ #
+ my $text_format = $workbook->add_format(
+ bold => 1,
+ italic => 1,
+ color => 'red',
+ size => 18,
+ font =>'Lucida Calligraphy'
+ );
+
+ # A phrase in Cyrillic
+ my $unicode = pack "H*", "042d0442043e002004440440043004370430002004".
+ "3d043000200440044304410441043a043e043c0021";
+
+
+ $worksheet->write('A2', "Text");
+ $worksheet->write('B2', "Hello Excel");
+ $worksheet->write('A3', "Formatted text");
+ $worksheet->write('B3', "Hello Excel", $text_format);
+ $worksheet->write('A4', "Unicode text");
+ $worksheet->write_utf16be_string('B4', $unicode);
+
+ #######################################################################
+ #
+ # Some numeric examples
+ #
+ my $num1_format = $workbook->add_format(num_format => '$#,##0.00');
+ my $num2_format = $workbook->add_format(num_format => ' d mmmm yyy');
+
+
+ $worksheet->write('A5', "Numbers");
+ $worksheet->write('B5', 1234.56);
+ $worksheet->write('A6', "Formatted numbers");
+ $worksheet->write('B6', 1234.56, $num1_format);
+ $worksheet->write('A7', "Formatted numbers");
+ $worksheet->write('B7', 37257, $num2_format);
+
+
+ #######################################################################
+ #
+ # Formulae
+ #
+ $worksheet->set_selection('B8');
+ $worksheet->write('A8', 'Formulas and functions, "=SIN(PI()/4)"');
+ $worksheet->write('B8', '=SIN(PI()/4)');
+
+
+ #######################################################################
+ #
+ # Hyperlinks
+ #
+ $worksheet->write('A9', "Hyperlinks");
+ $worksheet->write('B9', 'http://www.perl.com/' );
+
+
+ #######################################################################
+ #
+ # Images
+ #
+ $worksheet->write('A10', "Images");
+ $worksheet->insert_image('B10', 'republic.png', 16, 8);
+
+
+ #######################################################################
+ #
+ # Misc
+ #
+ $worksheet->write('A18', "Page/printer setup");
+ $worksheet->write('A19', "Multiple worksheets");
+
+ __END__
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/demo.pl>
+
+=head2 Example: regions.pl
+
+
+
+An example of how to use the Spreadsheet:WriteExcel module to write a basic
+Excel workbook with multiple worksheets.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/regions.jpg" width="640" height="420" alt="Output from regions.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # An example of how to use the Spreadsheet:WriteExcel module to write a basic
+ # Excel workbook with multiple worksheets.
+ #
+ # reverse('©'), March 2001, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ # Create a new Excel workbook
+ my $workbook = Spreadsheet::WriteExcel->new("regions.xls");
+
+ # Add some worksheets
+ my $north = $workbook->add_worksheet("North");
+ my $south = $workbook->add_worksheet("South");
+ my $east = $workbook->add_worksheet("East");
+ my $west = $workbook->add_worksheet("West");
+
+ # Add a Format
+ my $format = $workbook->add_format();
+ $format->set_bold();
+ $format->set_color('blue');
+
+ # Add a caption to each worksheet
+ foreach my $worksheet ($workbook->sheets()) {
+ $worksheet->write(0, 0, "Sales", $format);
+ }
+
+ # Write some data
+ $north->write(0, 1, 200000);
+ $south->write(0, 1, 100000);
+ $east->write (0, 1, 150000);
+ $west->write (0, 1, 100000);
+
+ # Set the active worksheet
+ $south->activate();
+
+ # Set the width of the first column
+ $south->set_column(0, 0, 20);
+
+ # Set the active cell
+ $south->set_selection(0, 1);
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/regions.pl>
+
+=head2 Example: stats.pl
+
+
+
+A simple example of how to use functions with the Spreadsheet::WriteExcel
+module.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/stats.jpg" width="640" height="420" alt="Output from stats.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # A simple example of how to use functions with the Spreadsheet::WriteExcel
+ # module.
+ #
+ # reverse('©'), March 2001, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ # Create a new workbook and add a worksheet
+ my $workbook = Spreadsheet::WriteExcel->new("stats.xls");
+ my $worksheet = $workbook->add_worksheet('Test data');
+
+ # Set the column width for columns 1
+ $worksheet->set_column(0, 0, 20);
+
+
+ # Create a format for the headings
+ my $format = $workbook->add_format();
+ $format->set_bold();
+
+
+ # Write the sample data
+ $worksheet->write(0, 0, 'Sample', $format);
+ $worksheet->write(0, 1, 1);
+ $worksheet->write(0, 2, 2);
+ $worksheet->write(0, 3, 3);
+ $worksheet->write(0, 4, 4);
+ $worksheet->write(0, 5, 5);
+ $worksheet->write(0, 6, 6);
+ $worksheet->write(0, 7, 7);
+ $worksheet->write(0, 8, 8);
+
+ $worksheet->write(1, 0, 'Length', $format);
+ $worksheet->write(1, 1, 25.4);
+ $worksheet->write(1, 2, 25.4);
+ $worksheet->write(1, 3, 24.8);
+ $worksheet->write(1, 4, 25.0);
+ $worksheet->write(1, 5, 25.3);
+ $worksheet->write(1, 6, 24.9);
+ $worksheet->write(1, 7, 25.2);
+ $worksheet->write(1, 8, 24.8);
+
+ # Write some statistical functions
+ $worksheet->write(4, 0, 'Count', $format);
+ $worksheet->write(4, 1, '=COUNT(B1:I1)');
+
+ $worksheet->write(5, 0, 'Sum', $format);
+ $worksheet->write(5, 1, '=SUM(B2:I2)');
+
+ $worksheet->write(6, 0, 'Average', $format);
+ $worksheet->write(6, 1, '=AVERAGE(B2:I2)');
+
+ $worksheet->write(7, 0, 'Min', $format);
+ $worksheet->write(7, 1, '=MIN(B2:I2)');
+
+ $worksheet->write(8, 0, 'Max', $format);
+ $worksheet->write(8, 1, '=MAX(B2:I2)');
+
+ $worksheet->write(9, 0, 'Standard Deviation', $format);
+ $worksheet->write(9, 1, '=STDEV(B2:I2)');
+
+ $worksheet->write(10, 0, 'Kurtosis', $format);
+ $worksheet->write(10, 1, '=KURT(B2:I2)');
+
+ __END__
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/stats.pl>
+
+=head2 Example: formats.pl
+
+
+
+Examples of formatting using the Spreadsheet::WriteExcel module.
+
+This program demonstrates almost all possible formatting options. It is worth
+running this program and viewing the output Excel file if you are interested
+in the various formatting possibilities.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/formats.jpg" width="640" height="420" alt="Output from formats.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # Examples of formatting using the Spreadsheet::WriteExcel module.
+ #
+ # This program demonstrates almost all possible formatting options. It is worth
+ # running this program and viewing the output Excel file if you are interested
+ # in the various formatting possibilities.
+ #
+ # reverse('©'), September 2002, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new('formats.xls');
+
+ # Some common formats
+ my $center = $workbook->add_format(align => 'center');
+ my $heading = $workbook->add_format(align => 'center', bold => 1);
+
+ # The named colors
+ my %colors = (
+ 0x08, 'black',
+ 0x0C, 'blue',
+ 0x10, 'brown',
+ 0x0F, 'cyan',
+ 0x17, 'gray',
+ 0x11, 'green',
+ 0x0B, 'lime',
+ 0x0E, 'magenta',
+ 0x12, 'navy',
+ 0x35, 'orange',
+ 0x21, 'pink',
+ 0x14, 'purple',
+ 0x0A, 'red',
+ 0x16, 'silver',
+ 0x09, 'white',
+ 0x0D, 'yellow',
+ );
+
+ # Call these subroutines to demonstrate different formatting options
+ intro();
+ fonts();
+ named_colors();
+ standard_colors();
+ numeric_formats();
+ borders();
+ patterns();
+ alignment();
+ misc();
+
+ # Note: this is required
+ $workbook->close();
+
+
+ ######################################################################
+ #
+ # Intro.
+ #
+ sub intro {
+
+ my $worksheet = $workbook->add_worksheet('Introduction');
+
+ $worksheet->set_column(0, 0, 60);
+
+ my $format = $workbook->add_format();
+ $format->set_bold();
+ $format->set_size(14);
+ $format->set_color('blue');
+ $format->set_align('center');
+
+ my $format2 = $workbook->add_format();
+ $format2->set_bold();
+ $format2->set_color('blue');
+
+ $worksheet->write(2, 0, 'This workbook demonstrates some of', $format);
+ $worksheet->write(3, 0, 'the formatting options provided by', $format);
+ $worksheet->write(4, 0, 'the Spreadsheet::WriteExcel module.', $format);
+
+ $worksheet->write('A7', 'Sections:', $format2);
+ $worksheet->write('A8', "internal:Fonts!A1", 'Fonts' );
+ $worksheet->write('A9', "internal:'Named colors'!A1", 'Named colors' );
+ $worksheet->write('A10', "internal:'Standard colors'!A1", 'Standard colors');
+ $worksheet->write('A11', "internal:'Numeric formats'!A1", 'Numeric formats');
+ $worksheet->write('A12', "internal:Borders!A1", 'Borders' );
+ $worksheet->write('A13', "internal:Patterns!A1", 'Patterns' );
+ $worksheet->write('A14', "internal:Alignment!A1", 'Alignment' );
+ $worksheet->write('A15', "internal:Miscellaneous!A1", 'Miscellaneous' );
+
+ }
+
+
+ ######################################################################
+ #
+ # Demonstrate the named colors.
+ #
+ sub named_colors {
+
+ my $worksheet = $workbook->add_worksheet('Named colors');
+
+ $worksheet->set_column(0, 3, 15);
+
+ $worksheet->write(0, 0, "Index", $heading);
+ $worksheet->write(0, 1, "Index", $heading);
+ $worksheet->write(0, 2, "Name", $heading);
+ $worksheet->write(0, 3, "Color", $heading);
+
+ my $i = 1;
+
+ while (my($index, $color) = each %colors) {
+ my $format = $workbook->add_format(
+ bg_color => $color,
+ pattern => 1,
+ border => 1
+ );
+
+ $worksheet->write($i+1, 0, $index, $center);
+ $worksheet->write($i+1, 1, sprintf("0x%02X", $index), $center);
+ $worksheet->write($i+1, 2, $color, $center);
+ $worksheet->write($i+1, 3, '', $format);
+ $i++;
+ }
+ }
+
+
+ ######################################################################
+ #
+ # Demonstrate the standard Excel colors in the range 8..63.
+ #
+ sub standard_colors {
+
+ my $worksheet = $workbook->add_worksheet('Standard colors');
+
+ $worksheet->set_column(0, 3, 15);
+
+ $worksheet->write(0, 0, "Index", $heading);
+ $worksheet->write(0, 1, "Index", $heading);
+ $worksheet->write(0, 2, "Color", $heading);
+ $worksheet->write(0, 3, "Name", $heading);
+
+ for my $i (8..63) {
+ my $format = $workbook->add_format(
+ bg_color => $i,
+ pattern => 1,
+ border => 1
+ );
+
+ $worksheet->write(($i -7), 0, $i, $center);
+ $worksheet->write(($i -7), 1, sprintf("0x%02X", $i), $center);
+ $worksheet->write(($i -7), 2, '', $format);
+
+ # Add the color names
+ if (exists $colors{$i}) {
+ $worksheet->write(($i -7), 3, $colors{$i}, $center);
+
+ }
+ }
+ }
+
+
+ ######################################################################
+ #
+ # Demonstrate the standard numeric formats.
+ #
+ sub numeric_formats {
+
+ my $worksheet = $workbook->add_worksheet('Numeric formats');
+
+ $worksheet->set_column(0, 4, 15);
+ $worksheet->set_column(5, 5, 45);
+
+ $worksheet->write(0, 0, "Index", $heading);
+ $worksheet->write(0, 1, "Index", $heading);
+ $worksheet->write(0, 2, "Unformatted", $heading);
+ $worksheet->write(0, 3, "Formatted", $heading);
+ $worksheet->write(0, 4, "Negative", $heading);
+ $worksheet->write(0, 5, "Format", $heading);
+
+ my @formats;
+ push @formats, [ 0x00, 1234.567, 0, 'General' ];
+ push @formats, [ 0x01, 1234.567, 0, '0' ];
+ push @formats, [ 0x02, 1234.567, 0, '0.00' ];
+ push @formats, [ 0x03, 1234.567, 0, '#,##0' ];
+ push @formats, [ 0x04, 1234.567, 0, '#,##0.00' ];
+ push @formats, [ 0x05, 1234.567, -1234.567, '($#,##0_);($#,##0)' ];
+ push @formats, [ 0x06, 1234.567, -1234.567, '($#,##0_);[Red]($#,##0)' ];
+ push @formats, [ 0x07, 1234.567, -1234.567, '($#,##0.00_);($#,##0.00)' ];
+ push @formats, [ 0x08, 1234.567, -1234.567, '($#,##0.00_);[Red]($#,##0.00)' ];
+ push @formats, [ 0x09, 0.567, 0, '0%' ];
+ push @formats, [ 0x0a, 0.567, 0, '0.00%' ];
+ push @formats, [ 0x0b, 1234.567, 0, '0.00E+00' ];
+ push @formats, [ 0x0c, 0.75, 0, '# ?/?' ];
+ push @formats, [ 0x0d, 0.3125, 0, '# ??/??' ];
+ push @formats, [ 0x0e, 36892.521, 0, 'm/d/yy' ];
+ push @formats, [ 0x0f, 36892.521, 0, 'd-mmm-yy' ];
+ push @formats, [ 0x10, 36892.521, 0, 'd-mmm' ];
+ push @formats, [ 0x11, 36892.521, 0, 'mmm-yy' ];
+ push @formats, [ 0x12, 36892.521, 0, 'h:mm AM/PM' ];
+ push @formats, [ 0x13, 36892.521, 0, 'h:mm:ss AM/PM' ];
+ push @formats, [ 0x14, 36892.521, 0, 'h:mm' ];
+ push @formats, [ 0x15, 36892.521, 0, 'h:mm:ss' ];
+ push @formats, [ 0x16, 36892.521, 0, 'm/d/yy h:mm' ];
+ push @formats, [ 0x25, 1234.567, -1234.567, '(#,##0_);(#,##0)' ];
+ push @formats, [ 0x26, 1234.567, -1234.567, '(#,##0_);[Red](#,##0)' ];
+ push @formats, [ 0x27, 1234.567, -1234.567, '(#,##0.00_);(#,##0.00)' ];
+ push @formats, [ 0x28, 1234.567, -1234.567, '(#,##0.00_);[Red](#,##0.00)' ];
+ push @formats, [ 0x29, 1234.567, -1234.567, '_(* #,##0_);_(* (#,##0);_(* "-"_);_(@_)' ];
+ push @formats, [ 0x2a, 1234.567, -1234.567, '_($* #,##0_);_($* (#,##0);_($* "-"_);_(@_)' ];
+ push @formats, [ 0x2b, 1234.567, -1234.567, '_(* #,##0.00_);_(* (#,##0.00);_(* "-"??_);_(@_)' ];
+ push @formats, [ 0x2c, 1234.567, -1234.567, '_($* #,##0.00_);_($* (#,##0.00);_($* "-"??_);_(@_)' ];
+ push @formats, [ 0x2d, 36892.521, 0, 'mm:ss' ];
+ push @formats, [ 0x2e, 3.0153, 0, '[h]:mm:ss' ];
+ push @formats, [ 0x2f, 36892.521, 0, 'mm:ss.0' ];
+ push @formats, [ 0x30, 1234.567, 0, '##0.0E+0' ];
+ push @formats, [ 0x31, 1234.567, 0, '@' ];
+
+ my $i;
+ foreach my $format (@formats){
+ my $style = $workbook->add_format();
+ $style->set_num_format($format->[0]);
+
+ $i++;
+ $worksheet->write($i, 0, $format->[0], $center);
+ $worksheet->write($i, 1, sprintf("0x%02X", $format->[0]), $center);
+ $worksheet->write($i, 2, $format->[1], $center);
+ $worksheet->write($i, 3, $format->[1], $style);
+
+ if ($format->[2]) {
+ $worksheet->write($i, 4, $format->[2], $style);
+ }
+
+ $worksheet->write_string($i, 5, $format->[3]);
+ }
+ }
+
+
+ ######################################################################
+ #
+ # Demonstrate the font options.
+ #
+ sub fonts {
+
+ my $worksheet = $workbook->add_worksheet('Fonts');
+
+ $worksheet->set_column(0, 0, 30);
+ $worksheet->set_column(1, 1, 10);
+
+ $worksheet->write(0, 0, "Font name", $heading);
+ $worksheet->write(0, 1, "Font size", $heading);
+
+ my @fonts;
+ push @fonts, [ 10, 'Arial' ];
+ push @fonts, [ 12, 'Arial' ];
+ push @fonts, [ 14, 'Arial' ];
+ push @fonts, [ 12, 'Arial Black' ];
+ push @fonts, [ 12, 'Arial Narrow' ];
+ push @fonts, [ 12, 'Century Schoolbook' ];
+ push @fonts, [ 12, 'Courier' ];
+ push @fonts, [ 12, 'Courier New' ];
+ push @fonts, [ 12, 'Garamond' ];
+ push @fonts, [ 12, 'Impact' ];
+ push @fonts, [ 12, 'Lucida Handwriting'] ;
+ push @fonts, [ 12, 'Times New Roman' ];
+ push @fonts, [ 12, 'Symbol' ];
+ push @fonts, [ 12, 'Wingdings' ];
+ push @fonts, [ 12, 'A font that doesn\'t exist' ];
+
+ my $i;
+ foreach my $font (@fonts){
+ my $format = $workbook->add_format();
+
+ $format->set_size($font->[0]);
+ $format->set_font($font->[1]);
+
+ $i++;
+ $worksheet->write($i, 0, $font->[1], $format);
+ $worksheet->write($i, 1, $font->[0], $format);
+ }
+
+ }
+
+
+ ######################################################################
+ #
+ # Demonstrate the standard Excel border styles.
+ #
+ sub borders {
+
+ my $worksheet = $workbook->add_worksheet('Borders');
+
+ $worksheet->set_column(0, 4, 10);
+ $worksheet->set_column(5, 5, 40);
+
+ $worksheet->write(0, 0, "Index", $heading);
+ $worksheet->write(0, 1, "Index", $heading);
+ $worksheet->write(0, 3, "Style", $heading);
+ $worksheet->write(0, 5, "The style is highlighted in red for ", $heading);
+ $worksheet->write(1, 5, "emphasis, the default color is black.", $heading);
+
+ for my $i (0..13){
+ my $format = $workbook->add_format();
+ $format->set_border($i);
+ $format->set_border_color('red');
+ $format->set_align('center');
+
+ $worksheet->write((2*($i+1)), 0, $i, $center);
+ $worksheet->write((2*($i+1)), 1, sprintf("0x%02X", $i), $center);
+
+ $worksheet->write((2*($i+1)), 3, "Border", $format);
+ }
+
+ $worksheet->write(30, 0, "Diag type", $heading);
+ $worksheet->write(30, 1, "Index", $heading);
+ $worksheet->write(30, 3, "Style", $heading);
+ $worksheet->write(30, 5, "Diagonal Boder styles", $heading);
+
+ for my $i (1..3){
+ my $format = $workbook->add_format();
+ $format->set_diag_type($i);
+ $format->set_diag_border(1);
+ $format->set_diag_color('red');
+ $format->set_align('center');
+
+ $worksheet->write((2*($i+15)), 0, $i, $center);
+ $worksheet->write((2*($i+15)), 1, sprintf("0x%02X", $i), $center);
+
+ $worksheet->write((2*($i+15)), 3, "Border", $format);
+ }
+ }
+
+
+
+ ######################################################################
+ #
+ # Demonstrate the standard Excel cell patterns.
+ #
+ sub patterns {
+
+ my $worksheet = $workbook->add_worksheet('Patterns');
+
+ $worksheet->set_column(0, 4, 10);
+ $worksheet->set_column(5, 5, 50);
+
+ $worksheet->write(0, 0, "Index", $heading);
+ $worksheet->write(0, 1, "Index", $heading);
+ $worksheet->write(0, 3, "Pattern", $heading);
+
+ $worksheet->write(0, 5, "The background colour has been set to silver.", $heading);
+ $worksheet->write(1, 5, "The foreground colour has been set to green.", $heading);
+
+ for my $i (0..18){
+ my $format = $workbook->add_format();
+
+ $format->set_pattern($i);
+ $format->set_bg_color('silver');
+ $format->set_fg_color('green');
+ $format->set_align('center');
+
+ $worksheet->write((2*($i+1)), 0, $i, $center);
+ $worksheet->write((2*($i+1)), 1, sprintf("0x%02X", $i), $center);
+
+ $worksheet->write((2*($i+1)), 3, "Pattern", $format);
+
+ if ($i == 1) {
+ $worksheet->write((2*($i+1)), 5, "This is solid colour, the most useful pattern.", $heading);
+ }
+ }
+ }
+
+
+ ######################################################################
+ #
+ # Demonstrate the standard Excel cell alignments.
+ #
+ sub alignment {
+
+ my $worksheet = $workbook->add_worksheet('Alignment');
+
+ $worksheet->set_column(0, 7, 12);
+ $worksheet->set_row(0, 40);
+ $worksheet->set_selection(7, 0);
+
+ my $format01 = $workbook->add_format();
+ my $format02 = $workbook->add_format();
+ my $format03 = $workbook->add_format();
+ my $format04 = $workbook->add_format();
+ my $format05 = $workbook->add_format();
+ my $format06 = $workbook->add_format();
+ my $format07 = $workbook->add_format();
+ my $format08 = $workbook->add_format();
+ my $format09 = $workbook->add_format();
+ my $format10 = $workbook->add_format();
+ my $format11 = $workbook->add_format();
+ my $format12 = $workbook->add_format();
+ my $format13 = $workbook->add_format();
+ my $format14 = $workbook->add_format();
+ my $format15 = $workbook->add_format();
+ my $format16 = $workbook->add_format();
+ my $format17 = $workbook->add_format();
+
+ $format02->set_align('top');
+ $format03->set_align('bottom');
+ $format04->set_align('vcenter');
+ $format05->set_align('vjustify');
+ $format06->set_text_wrap();
+
+ $format07->set_align('left');
+ $format08->set_align('right');
+ $format09->set_align('center');
+ $format10->set_align('fill');
+ $format11->set_align('justify');
+ $format12->set_merge();
+
+ $format13->set_rotation(45);
+ $format14->set_rotation(-45);
+ $format15->set_rotation(270);
+
+ $format16->set_shrink();
+ $format17->set_indent(1);
+
+ $worksheet->write(0, 0, 'Vertical', $heading);
+ $worksheet->write(0, 1, 'top', $format02);
+ $worksheet->write(0, 2, 'bottom', $format03);
+ $worksheet->write(0, 3, 'vcenter', $format04);
+ $worksheet->write(0, 4, 'vjustify', $format05);
+ $worksheet->write(0, 5, "text\nwrap", $format06);
+
+ $worksheet->write(2, 0, 'Horizontal', $heading);
+ $worksheet->write(2, 1, 'left', $format07);
+ $worksheet->write(2, 2, 'right', $format08);
+ $worksheet->write(2, 3, 'center', $format09);
+ $worksheet->write(2, 4, 'fill', $format10);
+ $worksheet->write(2, 5, 'justify', $format11);
+
+ $worksheet->write(3, 1, 'merge', $format12);
+ $worksheet->write(3, 2, '', $format12);
+
+ $worksheet->write(3, 3, 'Shrink ' x 3, $format16);
+ $worksheet->write(3, 4, 'Indent', $format17);
+
+
+ $worksheet->write(5, 0, 'Rotation', $heading);
+ $worksheet->write(5, 1, 'Rotate 45', $format13);
+ $worksheet->write(6, 1, 'Rotate -45', $format14);
+ $worksheet->write(7, 1, 'Rotate 270', $format15);
+ }
+
+
+ ######################################################################
+ #
+ # Demonstrate other miscellaneous features.
+ #
+ sub misc {
+
+ my $worksheet = $workbook->add_worksheet('Miscellaneous');
+
+ $worksheet->set_column(2, 2, 25);
+
+ my $format01 = $workbook->add_format();
+ my $format02 = $workbook->add_format();
+ my $format03 = $workbook->add_format();
+ my $format04 = $workbook->add_format();
+ my $format05 = $workbook->add_format();
+ my $format06 = $workbook->add_format();
+ my $format07 = $workbook->add_format();
+
+ $format01->set_underline(0x01);
+ $format02->set_underline(0x02);
+ $format03->set_underline(0x21);
+ $format04->set_underline(0x22);
+ $format05->set_font_strikeout();
+ $format06->set_font_outline();
+ $format07->set_font_shadow();
+
+ $worksheet->write(1, 2, 'Underline 0x01', $format01);
+ $worksheet->write(3, 2, 'Underline 0x02', $format02);
+ $worksheet->write(5, 2, 'Underline 0x21', $format03);
+ $worksheet->write(7, 2, 'Underline 0x22', $format04);
+ $worksheet->write(9, 2, 'Strikeout', $format05);
+ $worksheet->write(11, 2, 'Outline (Macintosh only)', $format06);
+ $worksheet->write(13, 2, 'Shadow (Macintosh only)', $format07);
+ }
+
+ __END__
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/formats.pl>
+
+=head2 Example: bug_report.pl
+
+
+
+A template for submitting a bug report.
+
+Run this program and read the output from the command line.
+
+
+
+ #!/usr/bin/perl -w
+
+
+ ###############################################################################
+ #
+ # A template for submitting a bug report.
+ #
+ # Run this program and read the output from the command line.
+ #
+ # reverse('©'), March 2004, John McNamara, jmcnamara@cpan.org
+ #
+
+
+ use strict;
+
+ print << 'HINTS_1';
+
+ REPORTING A BUG OR ASKING A QUESTION
+
+ Feel free to report bugs or ask questions. However, to save time
+ consider the following steps first:
+
+ Read the documentation:
+
+ The Spreadsheet::WriteExcel documentation has been refined in
+ response to user questions. Therefore, if you have a question it is
+ possible that someone else has asked it before you and that it is
+ already addressed in the documentation. Since there is a lot of
+ documentation to get through you should at least read the table of
+ contents and search for keywords that you are interested in.
+
+ Look at the example programs:
+
+ There are over 70 example programs shipped with the standard
+ Spreadsheet::WriteExcel distribution. Many of these were created in
+ response to user questions. Try to identify an example program that
+ corresponds to your query and adapt it to your needs.
+
+ HINTS_1
+ print "Press enter ..."; <STDIN>;
+
+ print << 'HINTS_2';
+
+ If you submit a bug report here are some pointers.
+
+ 1. Put "WriteExcel:" at the beginning of the subject line. This helps
+ to filter genuine messages from spam.
+
+ 2. Describe the problems as clearly and as concisely as possible.
+
+ 3. Send a sample program. It is often easier to describe a problem in
+ code than in written prose.
+
+ 4. The sample program should be as small as possible to demonstrate the
+ problem. Don't copy and past large sections of your program. The
+ program should also be self contained and working.
+
+ A sample bug report is generated below. If you use this format then it
+ will help to analyse your question and respond to it more quickly.
+
+ Please don't send patches without contacting the author first.
+
+
+ HINTS_2
+ print "Press enter ..."; <STDIN>;
+
+
+ print << 'EMAIL';
+
+ =======================================================================
+
+ To: John McNamara <jmcnamara@cpan.org>
+ Subject: WriteExcel: Problem with something.
+
+ Hi John,
+
+ I am using Spreadsheet::WriteExcel and I have encountered a problem. I
+ want it to do SOMETHING but the module appears to do SOMETHING_ELSE.
+
+ Here is some code that demonstrates the problem.
+
+ #!/usr/bin/perl -w
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new("reload.xls");
+ my $worksheet = $workbook->add_worksheet();
+
+ $worksheet->write(0, 0, "Hi Excel!");
+
+ __END__
+
+
+ I tested using Excel XX (or Gnumeric or OpenOffice.org).
+
+ My automatically generated system details are as follows:
+ EMAIL
+
+
+ print "\n Perl version : $]";
+ print "\n OS name : $^O";
+ print "\n Module versions: (not all are required)\n";
+
+
+ my @modules = qw(
+ Spreadsheet::WriteExcel
+ Spreadsheet::ParseExcel
+ OLE::Storage_Lite
+ Parse::RecDescent
+ File::Temp
+ Digest::MD4
+ Digest::Perl::MD4
+ Digest::MD5
+ );
+
+
+ for my $module (@modules) {
+ my $version;
+ eval "require $module";
+
+ if (not $@) {
+ $version = $module->VERSION;
+ $version = '(unknown)' if not defined $version;
+ }
+ else {
+ $version = '(not installed)';
+ }
+
+ printf "%21s%-24s\t%s\n", "", $module, $version;
+ }
+
+
+ print << "BYE";
+ Yours etc.,
+
+ A. Person
+ --
+
+ BYE
+
+ __END__
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/bug_report.pl>
+
+=head2 Example: autofilter.pl
+
+
+
+An example of how to create autofilters with Spreadsheet::WriteExcel.
+
+An autofilter is a way of adding drop down lists to the headers of a 2D range
+of worksheet data. This is turn allow users to filter the data based on
+simple criteria so that some data is shown and some is hidden.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/autofilter.jpg" width="640" height="420" alt="Output from autofilter.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # An example of how to create autofilters with Spreadsheet::WriteExcel.
+ #
+ # An autofilter is a way of adding drop down lists to the headers of a 2D range
+ # of worksheet data. This is turn allow users to filter the data based on
+ # simple criteria so that some data is shown and some is hidden.
+ #
+ # reverse('©'), September 2007, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new('autofilter.xls');
+
+ die "Couldn't create new Excel file: $!.\n" unless defined $workbook;
+
+ my $worksheet1 = $workbook->add_worksheet();
+ my $worksheet2 = $workbook->add_worksheet();
+ my $worksheet3 = $workbook->add_worksheet();
+ my $worksheet4 = $workbook->add_worksheet();
+ my $worksheet5 = $workbook->add_worksheet();
+ my $worksheet6 = $workbook->add_worksheet();
+
+ my $bold = $workbook->add_format(bold => 1);
+
+
+ # Extract the data embedded at the end of this file.
+ my @headings = split ' ', <DATA>;
+ my @data;
+ push @data, [split] while <DATA>;
+
+
+ # Set up several sheets with the same data.
+ for my $worksheet ($workbook->sheets()) {
+ $worksheet->set_column('A:D', 12);
+ $worksheet->set_row(0, 20, $bold);
+ $worksheet->write('A1', \@headings);
+ }
+
+
+ ###############################################################################
+ #
+ # Example 1. Autofilter without conditions.
+ #
+
+ $worksheet1->autofilter('A1:D51');
+ $worksheet1->write('A2', [[@data]]);
+
+
+ ###############################################################################
+ #
+ #
+ # Example 2. Autofilter with a filter condition in the first column.
+ #
+
+ # The range in this example is the same as above but in row-column notation.
+ $worksheet2->autofilter(0, 0, 50, 3);
+
+ # The placeholder "Region" in the filter is ignored and can be any string
+ # that adds clarity to the expression.
+ #
+ $worksheet2->filter_column(0, 'Region eq East');
+
+ #
+ # Hide the rows that don't match the filter criteria.
+ #
+ my $row = 1;
+
+ for my $row_data (@data) {
+ my $region = $row_data->[0];
+
+ if ($region eq 'East') {
+ # Row is visible.
+ }
+ else {
+ # Hide row.
+ $worksheet2->set_row($row, undef, undef, 1);
+ }
+
+ $worksheet2->write($row++, 0, $row_data);
+ }
+
+
+ ###############################################################################
+ #
+ #
+ # Example 3. Autofilter with a dual filter condition in one of the columns.
+ #
+
+ $worksheet3->autofilter('A1:D51');
+
+ $worksheet3->filter_column('A', 'x eq East or x eq South');
+
+ #
+ # Hide the rows that don't match the filter criteria.
+ #
+ $row = 1;
+
+ for my $row_data (@data) {
+ my $region = $row_data->[0];
+
+ if ($region eq 'East' or $region eq 'South') {
+ # Row is visible.
+ }
+ else {
+ # Hide row.
+ $worksheet3->set_row($row, undef, undef, 1);
+ }
+
+ $worksheet3->write($row++, 0, $row_data);
+ }
+
+
+ ###############################################################################
+ #
+ #
+ # Example 4. Autofilter with filter conditions in two columns.
+ #
+
+ $worksheet4->autofilter('A1:D51');
+
+ $worksheet4->filter_column('A', 'x eq East');
+ $worksheet4->filter_column('C', 'x > 3000 and x < 8000' );
+
+ #
+ # Hide the rows that don't match the filter criteria.
+ #
+ $row = 1;
+
+ for my $row_data (@data) {
+ my $region = $row_data->[0];
+ my $volume = $row_data->[2];
+
+ if ($region eq 'East' and
+ $volume > 3000 and $volume < 8000
+ )
+ {
+ # Row is visible.
+ }
+ else {
+ # Hide row.
+ $worksheet4->set_row($row, undef, undef, 1);
+ }
+
+ $worksheet4->write($row++, 0, $row_data);
+ }
+
+
+ ###############################################################################
+ #
+ #
+ # Example 5. Autofilter with filter for blanks.
+ #
+
+ # Create a blank cell in our test data.
+ $data[5]->[0] = '';
+
+
+ $worksheet5->autofilter('A1:D51');
+ $worksheet5->filter_column('A', 'x == Blanks');
+
+ #
+ # Hide the rows that don't match the filter criteria.
+ #
+ $row = 1;
+
+ for my $row_data (@data) {
+ my $region = $row_data->[0];
+
+ if ($region eq '')
+ {
+ # Row is visible.
+ }
+ else {
+ # Hide row.
+ $worksheet5->set_row($row, undef, undef, 1);
+ }
+
+ $worksheet5->write($row++, 0, $row_data);
+ }
+
+
+ ###############################################################################
+ #
+ #
+ # Example 6. Autofilter with filter for non-blanks.
+ #
+
+
+ $worksheet6->autofilter('A1:D51');
+ $worksheet6->filter_column('A', 'x == NonBlanks');
+
+ #
+ # Hide the rows that don't match the filter criteria.
+ #
+ $row = 1;
+
+ for my $row_data (@data) {
+ my $region = $row_data->[0];
+
+ if ($region ne '')
+ {
+ # Row is visible.
+ }
+ else {
+ # Hide row.
+ $worksheet6->set_row($row, undef, undef, 1);
+ }
+
+ $worksheet6->write($row++, 0, $row_data);
+ }
+
+
+
+ __DATA__
+ Region Item Volume Month
+ East Apple 9000 July
+ East Apple 5000 July
+ South Orange 9000 September
+ North Apple 2000 November
+ West Apple 9000 November
+ South Pear 7000 October
+ North Pear 9000 August
+ West Orange 1000 December
+ West Grape 1000 November
+ South Pear 10000 April
+ West Grape 6000 January
+ South Orange 3000 May
+ North Apple 3000 December
+ South Apple 7000 February
+ West Grape 1000 December
+ East Grape 8000 February
+ South Grape 10000 June
+ West Pear 7000 December
+ South Apple 2000 October
+ East Grape 7000 December
+ North Grape 6000 April
+ East Pear 8000 February
+ North Apple 7000 August
+ North Orange 7000 July
+ North Apple 6000 June
+ South Grape 8000 September
+ West Apple 3000 October
+ South Orange 10000 November
+ West Grape 4000 July
+ North Orange 5000 August
+ East Orange 1000 November
+ East Orange 4000 October
+ North Grape 5000 August
+ East Apple 1000 December
+ South Apple 10000 March
+ East Grape 7000 October
+ West Grape 1000 September
+ East Grape 10000 October
+ South Orange 8000 March
+ North Apple 4000 July
+ South Orange 5000 July
+ West Apple 4000 June
+ East Apple 5000 April
+ North Pear 3000 August
+ East Grape 9000 November
+ North Orange 8000 October
+ East Apple 10000 June
+ South Pear 1000 December
+ North Grape 10000 July
+ East Grape 6000 February
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/autofilter.pl>
+
+=head2 Example: autofit.pl
+
+
+
+Simulate Excel's autofit for column widths.
+
+Excel provides a function called Autofit (Format->Columns->Autofit) that
+adjusts column widths to match the length of the longest string in a column.
+Excel calculates these widths at run time when it has access to information
+about string lengths and font information. This function is *not* a feature
+of the file format and thus cannot be implemented by Spreadsheet::WriteExcel.
+
+However, we can make an attempt to simulate it by keeping track of the
+longest string written to each column and then adjusting the column widths
+prior to closing the file.
+
+We keep track of the longest strings by adding a handler to the write()
+function. See add_handler() in the S::WE docs for more information.
+
+The main problem with trying to simulate Autofit lies in defining a
+relationship between a string length and its width in a arbitrary font and
+size. We use two approaches below. The first is a simple direct relationship
+obtained by trial and error. The second is a slightly more sophisticated
+method using an external module. For more complicated applications you will
+probably have to work out your own methods.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/autofit.jpg" width="640" height="420" alt="Output from autofit.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ##############################################################################
+ #
+ # Simulate Excel's autofit for column widths.
+ #
+ # Excel provides a function called Autofit (Format->Columns->Autofit) that
+ # adjusts column widths to match the length of the longest string in a column.
+ # Excel calculates these widths at run time when it has access to information
+ # about string lengths and font information. This function is *not* a feature
+ # of the file format and thus cannot be implemented by Spreadsheet::WriteExcel.
+ #
+ # However, we can make an attempt to simulate it by keeping track of the
+ # longest string written to each column and then adjusting the column widths
+ # prior to closing the file.
+ #
+ # We keep track of the longest strings by adding a handler to the write()
+ # function. See add_handler() in the S::WE docs for more information.
+ #
+ # The main problem with trying to simulate Autofit lies in defining a
+ # relationship between a string length and its width in a arbitrary font and
+ # size. We use two approaches below. The first is a simple direct relationship
+ # obtained by trial and error. The second is a slightly more sophisticated
+ # method using an external module. For more complicated applications you will
+ # probably have to work out your own methods.
+ #
+ # reverse('©'), May 2006, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new('autofit.xls');
+ my $worksheet = $workbook->add_worksheet();
+
+
+ ###############################################################################
+ #
+ # Add a handler to store the width of the longest string written to a column.
+ # We use the stored width to simulate an autofit of the column widths.
+ #
+ # You should do this for every worksheet you want to autofit.
+ #
+ $worksheet->add_write_handler(qr[\w], \&store_string_widths);
+
+
+
+ $worksheet->write('A1', 'Hello');
+ $worksheet->write('B1', 'Hello World');
+ $worksheet->write('D1', 'Hello');
+ $worksheet->write('F1', 'This is a long string as an example.');
+
+ # Run the autofit after you have finished writing strings to the workbook.
+ autofit_columns($worksheet);
+
+
+
+ ###############################################################################
+ #
+ # Functions used for Autofit.
+ #
+ ###############################################################################
+
+ ###############################################################################
+ #
+ # Adjust the column widths to fit the longest string in the column.
+ #
+ sub autofit_columns {
+
+ my $worksheet = shift;
+ my $col = 0;
+
+ for my $width (@{$worksheet->{__col_widths}}) {
+
+ $worksheet->set_column($col, $col, $width) if $width;
+ $col++;
+ }
+ }
+
+
+ ###############################################################################
+ #
+ # The following function is a callback that was added via add_write_handler()
+ # above. It modifies the write() function so that it stores the maximum
+ # unwrapped width of a string in a column.
+ #
+ sub store_string_widths {
+
+ my $worksheet = shift;
+ my $col = $_[1];
+ my $token = $_[2];
+
+ # Ignore some tokens that we aren't interested in.
+ return if not defined $token; # Ignore undefs.
+ return if $token eq ''; # Ignore blank cells.
+ return if ref $token eq 'ARRAY'; # Ignore array refs.
+ return if $token =~ /^=/; # Ignore formula
+
+ # Ignore numbers
+ return if $token =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/;
+
+ # Ignore various internal and external hyperlinks. In a real scenario
+ # you may wish to track the length of the optional strings used with
+ # urls.
+ return if $token =~ m{^[fh]tt?ps?://};
+ return if $token =~ m{^mailto:};
+ return if $token =~ m{^(?:in|ex)ternal:};
+
+
+ # We store the string width as data in the Worksheet object. We use
+ # a double underscore key name to avoid conflicts with future names.
+ #
+ my $old_width = $worksheet->{__col_widths}->[$col];
+ my $string_width = string_width($token);
+
+ if (not defined $old_width or $string_width > $old_width) {
+ # You may wish to set a minimum column width as follows.
+ #return undef if $string_width < 10;
+
+ $worksheet->{__col_widths}->[$col] = $string_width;
+ }
+
+
+ # Return control to write();
+ return undef;
+ }
+
+
+ ###############################################################################
+ #
+ # Very simple conversion between string length and string width for Arial 10.
+ # See below for a more sophisticated method.
+ #
+ sub string_width {
+
+ return 0.9 * length $_[0];
+ }
+
+ __END__
+
+
+
+ ###############################################################################
+ #
+ # This function uses an external module to get a more accurate width for a
+ # string. Note that in a real program you could "use" the module instead of
+ # "require"-ing it and you could make the Font object global to avoid repeated
+ # initialisation.
+ #
+ # Note also that the $pixel_width to $cell_width is specific to Arial. For
+ # other fonts you should calculate appropriate relationships. A future version
+ # of S::WE will provide a way of specifying column widths in pixels instead of
+ # cell units in order to simplify this conversion.
+ #
+ sub string_width {
+
+ require Font::TTFMetrics;
+
+ my $arial = Font::TTFMetrics->new('c:\windows\fonts\arial.ttf');
+
+ my $font_size = 10;
+ my $dpi = 96;
+ my $units_per_em = $arial->get_units_per_em();
+ my $font_width = $arial->string_width($_[0]);
+
+ # Convert to pixels as per TTFMetrics docs.
+ my $pixel_width = 6 + $font_width *$font_size *$dpi /(72 *$units_per_em);
+
+ # Add extra pixels for border around text.
+ $pixel_width += 6;
+
+ # Convert to cell width (for Arial) and for cell widths > 1.
+ my $cell_width = ($pixel_width -5) /7;
+
+ return $cell_width;
+
+ }
+
+ __END__
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/autofit.pl>
+
+=head2 Example: bigfile.pl
+
+
+
+Example of creating a Spreadsheet::WriteExcel that is larger than the
+default 7MB limit.
+
+This is exactly that same as any other Spreadsheet::WriteExcel program except
+that is requires that the OLE::Storage module is installed.
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/bigfile.jpg" width="640" height="420" alt="Output from bigfile.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # Example of creating a Spreadsheet::WriteExcel that is larger than the
+ # default 7MB limit.
+ #
+ # This is exactly that same as any other Spreadsheet::WriteExcel program except
+ # that is requires that the OLE::Storage module is installed.
+ #
+ # reverse('©'), Jan 2007, John McNamara, jmcnamara@cpan.org
+
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+
+ my $workbook = Spreadsheet::WriteExcel->new('bigfile.xls');
+ my $worksheet = $workbook->add_worksheet();
+
+ $worksheet->set_column(0, 50, 18);
+
+ for my $col (0 .. 50) {
+ for my $row (0 .. 6000) {
+ $worksheet->write($row, $col, "Row: $row Col: $col");
+ }
+ }
+
+ __END__
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/bigfile.pl>
+
+=head2 Example: cgi.pl
+
+
+
+Example of how to use the Spreadsheet::WriteExcel module to send an Excel
+file to a browser in a CGI program.
+
+On Windows the hash-bang line should be something like:
+
+ #!C:\Perl\bin\perl.exe
+
+The "Content-Disposition" line will cause a prompt to be generated to save
+the file. If you want to stream the file to the browser instead, comment out
+that line as shown below.
+
+
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # Example of how to use the Spreadsheet::WriteExcel module to send an Excel
+ # file to a browser in a CGI program.
+ #
+ # On Windows the hash-bang line should be something like:
+ #
+ # #!C:\Perl\bin\perl.exe
+ #
+ # The "Content-Disposition" line will cause a prompt to be generated to save
+ # the file. If you want to stream the file to the browser instead, comment out
+ # that line as shown below.
+ #
+ # reverse('©'), March 2001, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ # Set the filename and send the content type
+ my $filename ="cgitest.xls";
+
+ print "Content-type: application/vnd.ms-excel\n";
+ # The Content-Disposition will generate a prompt to save the file. If you want
+ # to stream the file to the browser, comment out the following line.
+ print "Content-Disposition: attachment; filename=$filename\n";
+ print "\n";
+
+ # Create a new workbook and add a worksheet. The special Perl filehandle - will
+ # redirect the output to STDOUT
+ #
+ my $workbook = Spreadsheet::WriteExcel->new("-");
+ my $worksheet = $workbook->add_worksheet();
+
+
+ # Set the column width for column 1
+ $worksheet->set_column(0, 0, 20);
+
+
+ # Create a format
+ my $format = $workbook->add_format();
+ $format->set_bold();
+ $format->set_size(15);
+ $format->set_color('blue');
+
+
+ # Write to the workbook
+ $worksheet->write(0, 0, "Hi Excel!", $format);
+
+ __END__
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/cgi.pl>
+
+=head2 Example: chart_area.pl
+
+
+
+A simple demo of Area charts in Spreadsheet::WriteExcel.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/chart_area.jpg" width="640" height="420" alt="Output from chart_area.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # A simple demo of Area charts in Spreadsheet::WriteExcel.
+ #
+ # reverse('©'), December 2009, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new( 'chart_area.xls' );
+ my $worksheet = $workbook->add_worksheet();
+ my $bold = $workbook->add_format( bold => 1 );
+
+ # Add the worksheet data that the charts will refer to.
+ my $headings = [ 'Category', 'Values 1', 'Values 2' ];
+ my $data = [
+ [ 2, 3, 4, 5, 6, 7 ],
+ [ 1, 4, 5, 2, 1, 5 ],
+ [ 3, 6, 7, 5, 4, 3 ],
+ ];
+
+ $worksheet->write( 'A1', $headings, $bold );
+ $worksheet->write( 'A2', $data );
+
+
+ ###############################################################################
+ #
+ # Example 1. A minimal chart.
+ #
+ my $chart1 = $workbook->add_chart( type => 'area' );
+
+ # Add values only. Use the default categories.
+ $chart1->add_series( values => '=Sheet1!$B$2:$B$7' );
+
+
+ ###############################################################################
+ #
+ # Example 2. A minimal chart with user specified categories (X axis)
+ # and a series name.
+ #
+ my $chart2 = $workbook->add_chart( type => 'area' );
+
+ # Configure the series.
+ $chart2->add_series(
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$B$2:$B$7',
+ name => 'Test data series 1',
+ );
+
+
+ ###############################################################################
+ #
+ # Example 3. Same as previous chart but with added title and axes labels.
+ #
+ my $chart3 = $workbook->add_chart( type => 'area' );
+
+ # Configure the series.
+ $chart3->add_series(
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$B$2:$B$7',
+ name => 'Test data series 1',
+ );
+
+ # Add some labels.
+ $chart3->set_title( name => 'Results of sample analysis' );
+ $chart3->set_x_axis( name => 'Sample number' );
+ $chart3->set_y_axis( name => 'Sample length (cm)' );
+
+
+ ###############################################################################
+ #
+ # Example 4. Same as previous chart but with an added series and with a
+ # user specified chart sheet name.
+ #
+ my $chart4 = $workbook->add_chart( name => 'Results Chart', type => 'area' );
+
+ # Configure the series.
+ $chart4->add_series(
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$B$2:$B$7',
+ name => 'Test data series 1',
+ );
+
+ # Add another series.
+ $chart4->add_series(
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$C$2:$C$7',
+ name => 'Test data series 2',
+ );
+
+ # Add some labels.
+ $chart4->set_title( name => 'Results of sample analysis' );
+ $chart4->set_x_axis( name => 'Sample number' );
+ $chart4->set_y_axis( name => 'Sample length (cm)' );
+
+
+ ###############################################################################
+ #
+ # Example 5. Same as Example 3 but as an embedded chart.
+ #
+ my $chart5 = $workbook->add_chart( type => 'area', embedded => 1 );
+
+ # Configure the series.
+ $chart5->add_series(
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$B$2:$B$7',
+ name => 'Test data series 1',
+ );
+
+ # Add some labels.
+ $chart5->set_title( name => 'Results of sample analysis' );
+ $chart5->set_x_axis( name => 'Sample number' );
+ $chart5->set_y_axis( name => 'Sample length (cm)' );
+
+ # Insert the chart into the main worksheet.
+ $worksheet->insert_chart( 'E2', $chart5 );
+
+ __END__
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/chart_area.pl>
+
+=head2 Example: chart_bar.pl
+
+
+
+A simple demo of Bar charts in Spreadsheet::WriteExcel.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/chart_bar.jpg" width="640" height="420" alt="Output from chart_bar.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # A simple demo of Bar charts in Spreadsheet::WriteExcel.
+ #
+ # reverse('©'), December 2009, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new( 'chart_bar.xls' );
+ my $worksheet = $workbook->add_worksheet();
+ my $bold = $workbook->add_format( bold => 1 );
+
+ # Add the worksheet data that the charts will refer to.
+ my $headings = [ 'Category', 'Values 1', 'Values 2' ];
+ my $data = [
+ [ 2, 3, 4, 5, 6, 7 ],
+ [ 1, 4, 5, 2, 1, 5 ],
+ [ 3, 6, 7, 5, 4, 3 ],
+ ];
+
+ $worksheet->write( 'A1', $headings, $bold );
+ $worksheet->write( 'A2', $data );
+
+
+ ###############################################################################
+ #
+ # Example 1. A minimal chart.
+ #
+ my $chart1 = $workbook->add_chart( type => 'bar' );
+
+ # Add values only. Use the default categories.
+ $chart1->add_series( values => '=Sheet1!$B$2:$B$7' );
+
+
+ ###############################################################################
+ #
+ # Example 2. A minimal chart with user specified categories (X axis)
+ # and a series name.
+ #
+ my $chart2 = $workbook->add_chart( type => 'bar' );
+
+ # Configure the series.
+ $chart2->add_series(
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$B$2:$B$7',
+ name => 'Test data series 1',
+ );
+
+
+ ###############################################################################
+ #
+ # Example 3. Same as previous chart but with added title and axes labels.
+ #
+ my $chart3 = $workbook->add_chart( type => 'bar' );
+
+ # Configure the series.
+ $chart3->add_series(
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$B$2:$B$7',
+ name => 'Test data series 1',
+ );
+
+ # Add some labels.
+ $chart3->set_title( name => 'Results of sample analysis' );
+ $chart3->set_x_axis( name => 'Sample number' );
+ $chart3->set_y_axis( name => 'Sample length (cm)' );
+
+
+ ###############################################################################
+ #
+ # Example 4. Same as previous chart but with an added series and with a
+ # user specified chart sheet name.
+ #
+ my $chart4 = $workbook->add_chart( name => 'Results Chart', type => 'bar' );
+
+ # Configure the series.
+ $chart4->add_series(
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$B$2:$B$7',
+ name => 'Test data series 1',
+ );
+
+ # Add another series.
+ $chart4->add_series(
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$C$2:$C$7',
+ name => 'Test data series 2',
+ );
+
+ # Add some labels.
+ $chart4->set_title( name => 'Results of sample analysis' );
+ $chart4->set_x_axis( name => 'Sample number' );
+ $chart4->set_y_axis( name => 'Sample length (cm)' );
+
+
+ ###############################################################################
+ #
+ # Example 5. Same as Example 3 but as an embedded chart.
+ #
+ my $chart5 = $workbook->add_chart( type => 'bar', embedded => 1 );
+
+ # Configure the series.
+ $chart5->add_series(
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$B$2:$B$7',
+ name => 'Test data series 1',
+ );
+
+ # Add some labels.
+ $chart5->set_title( name => 'Results of sample analysis' );
+ $chart5->set_x_axis( name => 'Sample number' );
+ $chart5->set_y_axis( name => 'Sample length (cm)' );
+
+ # Insert the chart into the main worksheet.
+ $worksheet->insert_chart( 'E2', $chart5 );
+
+ __END__
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/chart_bar.pl>
+
+=head2 Example: chart_column.pl
+
+
+
+A simple demo of Column charts in Spreadsheet::WriteExcel.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/chart_column.jpg" width="640" height="420" alt="Output from chart_column.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # A simple demo of Column charts in Spreadsheet::WriteExcel.
+ #
+ # reverse('©'), December 2009, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new( 'chart_column.xls' );
+ my $worksheet = $workbook->add_worksheet();
+ my $bold = $workbook->add_format( bold => 1 );
+
+ # Add the worksheet data that the charts will refer to.
+ my $headings = [ 'Category', 'Values 1', 'Values 2' ];
+ my $data = [
+ [ 2, 3, 4, 5, 6, 7 ],
+ [ 1, 4, 5, 2, 1, 5 ],
+ [ 3, 6, 7, 5, 4, 3 ],
+ ];
+
+ $worksheet->write( 'A1', $headings, $bold );
+ $worksheet->write( 'A2', $data );
+
+
+ ###############################################################################
+ #
+ # Example 1. A minimal chart.
+ #
+ my $chart1 = $workbook->add_chart( type => 'column' );
+
+ # Add values only. Use the default categories.
+ $chart1->add_series( values => '=Sheet1!$B$2:$B$7' );
+
+
+ ###############################################################################
+ #
+ # Example 2. A minimal chart with user specified categories (X axis)
+ # and a series name.
+ #
+ my $chart2 = $workbook->add_chart( type => 'column' );
+
+ # Configure the series.
+ $chart2->add_series(
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$B$2:$B$7',
+ name => 'Test data series 1',
+ );
+
+
+ ###############################################################################
+ #
+ # Example 3. Same as previous chart but with added title and axes labels.
+ #
+ my $chart3 = $workbook->add_chart( type => 'column' );
+
+ # Configure the series.
+ $chart3->add_series(
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$B$2:$B$7',
+ name => 'Test data series 1',
+ );
+
+ # Add some labels.
+ $chart3->set_title( name => 'Results of sample analysis' );
+ $chart3->set_x_axis( name => 'Sample number' );
+ $chart3->set_y_axis( name => 'Sample length (cm)' );
+
+
+ ###############################################################################
+ #
+ # Example 4. Same as previous chart but with an added series and with a
+ # user specified chart sheet name.
+ #
+ my $chart4 = $workbook->add_chart( name => 'Results Chart', type => 'column' );
+
+ # Configure the series.
+ $chart4->add_series(
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$B$2:$B$7',
+ name => 'Test data series 1',
+ );
+
+ # Add another series.
+ $chart4->add_series(
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$C$2:$C$7',
+ name => 'Test data series 2',
+ );
+
+ # Add some labels.
+ $chart4->set_title( name => 'Results of sample analysis' );
+ $chart4->set_x_axis( name => 'Sample number' );
+ $chart4->set_y_axis( name => 'Sample length (cm)' );
+
+
+ ###############################################################################
+ #
+ # Example 5. Same as Example 3 but as an embedded chart.
+ #
+ my $chart5 = $workbook->add_chart( type => 'column', embedded => 1 );
+
+ # Configure the series.
+ $chart5->add_series(
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$B$2:$B$7',
+ name => 'Test data series 1',
+ );
+
+ # Add some labels.
+ $chart5->set_title( name => 'Results of sample analysis' );
+ $chart5->set_x_axis( name => 'Sample number' );
+ $chart5->set_y_axis( name => 'Sample length (cm)' );
+
+ # Insert the chart into the main worksheet.
+ $worksheet->insert_chart( 'E2', $chart5 );
+
+ __END__
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/chart_column.pl>
+
+=head2 Example: chart_line.pl
+
+
+
+A simple demo of Line charts in Spreadsheet::WriteExcel.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/chart_line.jpg" width="640" height="420" alt="Output from chart_line.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # A simple demo of Line charts in Spreadsheet::WriteExcel.
+ #
+ # reverse('©'), December 2009, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new( 'chart_line.xls' );
+ my $worksheet = $workbook->add_worksheet();
+ my $bold = $workbook->add_format( bold => 1 );
+
+ # Add the worksheet data that the charts will refer to.
+ my $headings = [ 'Category', 'Values 1', 'Values 2' ];
+ my $data = [
+ [ 2, 3, 4, 5, 6, 7 ],
+ [ 1, 4, 5, 2, 1, 5 ],
+ [ 3, 6, 7, 5, 4, 3 ],
+ ];
+
+ $worksheet->write( 'A1', $headings, $bold );
+ $worksheet->write( 'A2', $data );
+
+
+ ###############################################################################
+ #
+ # Example 1. A minimal chart.
+ #
+ my $chart1 = $workbook->add_chart( type => 'line' );
+
+ # Add values only. Use the default categories.
+ $chart1->add_series( values => '=Sheet1!$B$2:$B$7' );
+
+
+ ###############################################################################
+ #
+ # Example 2. A minimal chart with user specified categories (X axis)
+ # and a series name.
+ #
+ my $chart2 = $workbook->add_chart( type => 'line' );
+
+ # Configure the series.
+ $chart2->add_series(
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$B$2:$B$7',
+ name => 'Test data series 1',
+ );
+
+
+ ###############################################################################
+ #
+ # Example 3. Same as previous chart but with added title and axes labels.
+ #
+ my $chart3 = $workbook->add_chart( type => 'line' );
+
+ # Configure the series.
+ $chart3->add_series(
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$B$2:$B$7',
+ name => 'Test data series 1',
+ );
+
+ # Add some labels.
+ $chart3->set_title( name => 'Results of sample analysis' );
+ $chart3->set_x_axis( name => 'Sample number' );
+ $chart3->set_y_axis( name => 'Sample length (cm)' );
+
+
+ ###############################################################################
+ #
+ # Example 4. Same as previous chart but with an added series and with a
+ # user specified chart sheet name.
+ #
+ my $chart4 = $workbook->add_chart( name => 'Results Chart', type => 'line' );
+
+ # Configure the series.
+ $chart4->add_series(
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$B$2:$B$7',
+ name => 'Test data series 1',
+ );
+
+ # Add another series.
+ $chart4->add_series(
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$C$2:$C$7',
+ name => 'Test data series 2',
+ );
+
+ # Add some labels.
+ $chart4->set_title( name => 'Results of sample analysis' );
+ $chart4->set_x_axis( name => 'Sample number' );
+ $chart4->set_y_axis( name => 'Sample length (cm)' );
+
+
+ ###############################################################################
+ #
+ # Example 5. Same as Example 3 but as an embedded chart.
+ #
+ my $chart5 = $workbook->add_chart( type => 'line', embedded => 1 );
+
+ # Configure the series.
+ $chart5->add_series(
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$B$2:$B$7',
+ name => 'Test data series 1',
+ );
+
+ # Add some labels.
+ $chart5->set_title( name => 'Results of sample analysis' );
+ $chart5->set_x_axis( name => 'Sample number' );
+ $chart5->set_y_axis( name => 'Sample length (cm)' );
+
+ # Insert the chart into the main worksheet.
+ $worksheet->insert_chart( 'E2', $chart5 );
+
+ __END__
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/chart_line.pl>
+
+=head2 Example: chart_pie.pl
+
+
+
+A simple demo of Pie charts in Spreadsheet::WriteExcel.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/chart_pie.jpg" width="640" height="420" alt="Output from chart_pie.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # A simple demo of Pie charts in Spreadsheet::WriteExcel.
+ #
+ # reverse('©'), December 2009, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new( 'chart_pie.xls' );
+ my $worksheet = $workbook->add_worksheet();
+ my $bold = $workbook->add_format( bold => 1 );
+
+ # Add the worksheet data that the charts will refer to.
+ my $headings = [ 'Category', 'Values' ];
+ my $data = [
+ [ 'Apple', 'Cherry', 'Pecan' ],
+ [ 60, 30, 10 ],
+ ];
+
+ $worksheet->write( 'A1', $headings, $bold );
+ $worksheet->write( 'A2', $data );
+
+
+ ###############################################################################
+ #
+ # Example 1. A minimal chart.
+ #
+ my $chart1 = $workbook->add_chart( type => 'pie' );
+
+ # Add values only. Use the default categories.
+ $chart1->add_series( values => '=Sheet1!$B$2:$B$4' );
+
+
+ ###############################################################################
+ #
+ # Example 2. A minimal chart with user specified categories and a series name.
+ #
+ my $chart2 = $workbook->add_chart( type => 'pie' );
+
+ # Configure the series.
+ $chart2->add_series(
+ categories => '=Sheet1!$A$2:$A$4',
+ values => '=Sheet1!$B$2:$B$4',
+ name => 'Pie sales data',
+ );
+
+
+ ###############################################################################
+ #
+ # Example 3. Same as previous chart but with an added title.
+ #
+ my $chart3 = $workbook->add_chart( type => 'pie' );
+
+ # Configure the series.
+ $chart3->add_series(
+ categories => '=Sheet1!$A$2:$A$4',
+ values => '=Sheet1!$B$2:$B$4',
+ name => 'Pie sales data',
+ );
+
+ # Add a title.
+ $chart3->set_title( name => 'Popular Pie Types' );
+
+
+ ###############################################################################
+ #
+ # Example 4. Same as previous chart with a user specified chart sheet name.
+ #
+ my $chart4 = $workbook->add_chart( name => 'Results Chart', type => 'pie' );
+
+ # Configure the series.
+ $chart4->add_series(
+ categories => '=Sheet1!$A$2:$A$4',
+ values => '=Sheet1!$B$2:$B$4',
+ name => 'Pie sales data',
+ );
+
+ # The other chart_*.pl examples add a second series in example 4 but additional
+ # series aren't plotted in a pie chart.
+
+ # Add a title.
+ $chart4->set_title( name => 'Popular Pie Types' );
+
+
+ ###############################################################################
+ #
+ # Example 5. Same as Example 3 but as an embedded chart.
+ #
+ my $chart5 = $workbook->add_chart( type => 'pie', embedded => 1 );
+
+ # Configure the series.
+ $chart5->add_series(
+ categories => '=Sheet1!$A$2:$A$4',
+ values => '=Sheet1!$B$2:$B$4',
+ name => 'Pie sales data',
+ );
+
+ # Add a title.
+ $chart5->set_title( name => 'Popular Pie Types' );
+
+ # Insert the chart into the main worksheet.
+ $worksheet->insert_chart( 'D2', $chart5 );
+
+ __END__
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/chart_pie.pl>
+
+=head2 Example: chart_scatter.pl
+
+
+
+A simple demo of Scatter charts in Spreadsheet::WriteExcel.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/chart_scatter.jpg" width="640" height="420" alt="Output from chart_scatter.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # A simple demo of Scatter charts in Spreadsheet::WriteExcel.
+ #
+ # reverse('©'), December 2009, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new( 'chart_scatter.xls' );
+ my $worksheet = $workbook->add_worksheet();
+ my $bold = $workbook->add_format( bold => 1 );
+
+ # Add the worksheet data that the charts will refer to.
+ my $headings = [ 'Category', 'Values 1', 'Values 2' ];
+ my $data = [
+ [ 2, 3, 4, 5, 6, 7 ],
+ [ 1, 4, 5, 2, 1, 5 ],
+ [ 3, 6, 7, 5, 4, 3 ],
+ ];
+
+ $worksheet->write( 'A1', $headings, $bold );
+ $worksheet->write( 'A2', $data );
+
+
+ ###############################################################################
+ #
+ # Example 1. A minimal chart.
+ #
+ my $chart1 = $workbook->add_chart( type => 'scatter' );
+
+ # Add values only. Use the default categories.
+ $chart1->add_series( values => '=Sheet1!$B$2:$B$7' );
+
+
+ ###############################################################################
+ #
+ # Example 2. A minimal chart with user specified categories (X axis)
+ # and a series name.
+ #
+ my $chart2 = $workbook->add_chart( type => 'scatter' );
+
+ # Configure the series.
+ $chart2->add_series(
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$B$2:$B$7',
+ name => 'Test data series 1',
+ );
+
+
+ ###############################################################################
+ #
+ # Example 3. Same as previous chart but with added title and axes labels.
+ #
+ my $chart3 = $workbook->add_chart( type => 'scatter' );
+
+ # Configure the series.
+ $chart3->add_series(
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$B$2:$B$7',
+ name => 'Test data series 1',
+ );
+
+ # Add some labels.
+ $chart3->set_title( name => 'Results of sample analysis' );
+ $chart3->set_x_axis( name => 'Sample number' );
+ $chart3->set_y_axis( name => 'Sample length (cm)' );
+
+
+ ###############################################################################
+ #
+ # Example 4. Same as previous chart but with an added series and with a
+ # user specified chart sheet name.
+ #
+ my $chart4 = $workbook->add_chart( name => 'Results Chart', type => 'scatter' );
+
+ # Configure the series.
+ $chart4->add_series(
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$B$2:$B$7',
+ name => 'Test data series 1',
+ );
+
+ # Add another series.
+ $chart4->add_series(
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$C$2:$C$7',
+ name => 'Test data series 2',
+ );
+
+ # Add some labels.
+ $chart4->set_title( name => 'Results of sample analysis' );
+ $chart4->set_x_axis( name => 'Sample number' );
+ $chart4->set_y_axis( name => 'Sample length (cm)' );
+
+
+ ###############################################################################
+ #
+ # Example 5. Same as Example 3 but as an embedded chart.
+ #
+ my $chart5 = $workbook->add_chart( type => 'scatter', embedded => 1 );
+
+ # Configure the series.
+ $chart5->add_series(
+ categories => '=Sheet1!$A$2:$A$7',
+ values => '=Sheet1!$B$2:$B$7',
+ name => 'Test data series 1',
+ );
+
+ # Add some labels.
+ $chart5->set_title( name => 'Results of sample analysis' );
+ $chart5->set_x_axis( name => 'Sample number' );
+ $chart5->set_y_axis( name => 'Sample length (cm)' );
+
+ # Insert the chart into the main worksheet.
+ $worksheet->insert_chart( 'E2', $chart5 );
+
+ __END__
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/chart_scatter.pl>
+
+=head2 Example: chart_stock.pl
+
+
+
+A simple demo of Stock charts in Spreadsheet::WriteExcel.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/chart_stock.jpg" width="640" height="420" alt="Output from chart_stock.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # A simple demo of Stock charts in Spreadsheet::WriteExcel.
+ #
+ # reverse('©'), January 2010, John McNamara, jmcnamara@cpan.org
+ #
+
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new( 'chart_stock.xls' );
+ my $worksheet = $workbook->add_worksheet();
+
+
+ ###############################################################################
+ #
+ # Set up the data worksheet that the charts will refer to. We read the example
+ # data from the __DATA__ section at the end of the file. This simulates
+ # reading the data from a database or other source.
+ #
+ # The default Excel Stock chart is an Open-High-Low-Close chart. Therefore
+ # we will need data for each of those series.
+ #
+ # The layout of the __DATA__ section is similar to the layout of the worksheet.
+ #
+
+ # Add some formats.
+ my $bold = $workbook->add_format( bold => 1 );
+ my $date_format = $workbook->add_format( num_format => 'dd/mm/yyyy' );
+
+ # Increase the width of the column used for date to make it clearer.
+ $worksheet->set_column( 'A:A', 12 );
+
+ # Read the data from the __DATA__ section at the end. In a real example this
+ # would probably be a database query.
+ my @stock_data;
+
+ while ( <DATA> ) {
+ next unless /\S/; # Skip blank lines.
+ next if /^#/; # Skip comments.
+
+ push @stock_data, [split];
+ }
+
+ # Write the data to the worksheet.
+ my $row = 0;
+ my $col = 0;
+
+ my $headers = shift @stock_data;
+ $worksheet->write( $row++, $col, $headers, $bold );
+
+ for my $stock_data ( @stock_data ) {
+
+ my @data = @$stock_data;
+ my $date = shift @data;
+
+ $worksheet->write( $row, $col, $date, $date_format );
+ $worksheet->write( $row, $col + 1, \@data );
+
+ $row++;
+ }
+
+
+ ###############################################################################
+ #
+ # Example 1. A default Open-High-Low-Close chart with series names, axes labels
+ # and a title.
+ #
+
+ my $chart1 = $workbook->add_chart( type => 'stock' );
+
+ # Add a series for each of the Open-High-Low-Close columns. The categories are
+ # the dates in the first column.
+
+ $chart1->add_series(
+ categories => '=Sheet1!$A$2:$A$10',
+ values => '=Sheet1!$B$2:$B$10',
+ name => 'Open',
+ );
+
+ $chart1->add_series(
+ categories => '=Sheet1!$A$2:$A$10',
+ values => '=Sheet1!$C$2:$C$10',
+ name => 'High',
+ );
+
+ $chart1->add_series(
+ categories => '=Sheet1!$A$2:$A$10',
+ values => '=Sheet1!$D$2:$D$10',
+ name => 'Low',
+ );
+
+ $chart1->add_series(
+ categories => '=Sheet1!$A$2:$A$10',
+ values => '=Sheet1!$E$2:$E$10',
+ name => 'Close',
+ );
+
+ # Add a chart title and axes labels.
+ $chart1->set_title( name => 'Open-High-Low-Close', );
+ $chart1->set_x_axis( name => 'Date', );
+ $chart1->set_y_axis( name => 'Share price', );
+
+ ###############################################################################
+ #
+ # Example 2. Same as the previous as an embedded chart.
+ #
+
+ my $chart2 = $workbook->add_chart( type => 'stock', embedded => 1 );
+
+ # Add a series for each of the Open-High-Low-Close columns. The categories are
+ # the dates in the first column.
+
+ $chart2->add_series(
+ categories => '=Sheet1!$A$2:$A$10',
+ values => '=Sheet1!$B$2:$B$10',
+ name => 'Open',
+ );
+
+ $chart2->add_series(
+ categories => '=Sheet1!$A$2:$A$10',
+ values => '=Sheet1!$C$2:$C$10',
+ name => 'High',
+ );
+
+ $chart2->add_series(
+ categories => '=Sheet1!$A$2:$A$10',
+ values => '=Sheet1!$D$2:$D$10',
+ name => 'Low',
+ );
+
+ $chart2->add_series(
+ categories => '=Sheet1!$A$2:$A$10',
+ values => '=Sheet1!$E$2:$E$10',
+ name => 'Close',
+ );
+
+ # Add a chart title and axes labels.
+ $chart2->set_title( name => 'Open-High-Low-Close', );
+ $chart2->set_x_axis( name => 'Date', );
+ $chart2->set_y_axis( name => 'Share price', );
+
+ # Insert the chart into the main worksheet.
+ $worksheet->insert_chart( 'G2', $chart2 );
+
+
+ __DATA__
+ # Some sample stock data used for charting.
+ Date Open High Low Close
+ 2009-08-19 100.00 104.06 95.96 100.34
+ 2009-08-20 101.01 109.08 100.50 108.31
+ 2009-08-23 110.75 113.48 109.05 109.40
+ 2009-08-24 111.24 111.60 103.57 104.87
+ 2009-08-25 104.96 108.00 103.88 106.00
+ 2009-08-26 104.95 107.95 104.66 107.91
+ 2009-08-27 108.10 108.62 105.69 106.15
+ 2009-08-30 105.28 105.49 102.01 102.01
+ 2009-08-31 102.30 103.71 102.16 102.37
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/chart_stock.pl>
+
+=head2 Example: chess.pl
+
+
+
+Example of formatting using the Spreadsheet::WriteExcel module via
+property hashes.
+
+Setting format properties via hashes of values is useful when you have
+to deal with a large number of similar formats. Consider for example a
+chess board pattern with black squares, white unformatted squares and
+a border.
+
+This relatively simple example requires 14 separate Format
+objects although there are only 5 different properties: black
+background, top border, bottom border, left border and right border.
+
+Using property hashes it is possible to define these 5 sets of
+properties and then add them together to create the 14 Format
+configurations.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/chess.jpg" width="640" height="420" alt="Output from chess.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ########################################################################
+ #
+ # Example of formatting using the Spreadsheet::WriteExcel module via
+ # property hashes.
+ #
+ # Setting format properties via hashes of values is useful when you have
+ # to deal with a large number of similar formats. Consider for example a
+ # chess board pattern with black squares, white unformatted squares and
+ # a border.
+ #
+ # This relatively simple example requires 14 separate Format
+ # objects although there are only 5 different properties: black
+ # background, top border, bottom border, left border and right border.
+ #
+ # Using property hashes it is possible to define these 5 sets of
+ # properties and then add them together to create the 14 Format
+ # configurations.
+ #
+ # reverse('©'), July 2001, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new("chess.xls");
+ my $worksheet = $workbook->add_worksheet();
+
+
+ # Some row and column formatting
+ $worksheet->set_column('B:I', 10);
+
+ for my $i (1..8) {
+ $worksheet->set_row($i, 50);
+ }
+
+
+ # Define the property hashes
+ #
+ my %black = (
+ 'fg_color' => 'black',
+ 'pattern' => 1,
+ );
+
+ my %top = ( 'top' => 6 );
+ my %bottom = ( 'bottom' => 6 );
+ my %left = ( 'left' => 6 );
+ my %right = ( 'right' => 6 );
+
+
+ # Define the formats
+ #
+ my $format01 = $workbook->add_format(%top, %left );
+ my $format02 = $workbook->add_format(%top, %black );
+ my $format03 = $workbook->add_format(%top, );
+ my $format04 = $workbook->add_format(%top, %right, %black );
+
+ my $format05 = $workbook->add_format(%left );
+ my $format06 = $workbook->add_format(%black );
+ my $format07 = $workbook->add_format( );
+ my $format08 = $workbook->add_format(%right, %black );
+ my $format09 = $workbook->add_format(%right );
+ my $format10 = $workbook->add_format(%left, %black );
+
+ my $format11 = $workbook->add_format(%bottom, %left, %black );
+ my $format12 = $workbook->add_format(%bottom );
+ my $format13 = $workbook->add_format(%bottom, %black );
+ my $format14 = $workbook->add_format(%bottom, %right );
+
+
+ # Draw the pattern
+ $worksheet->write('B2', '', $format01);
+ $worksheet->write('C2', '', $format02);
+ $worksheet->write('D2', '', $format03);
+ $worksheet->write('E2', '', $format02);
+ $worksheet->write('F2', '', $format03);
+ $worksheet->write('G2', '', $format02);
+ $worksheet->write('H2', '', $format03);
+ $worksheet->write('I2', '', $format04);
+
+ $worksheet->write('B3', '', $format10);
+ $worksheet->write('C3', '', $format07);
+ $worksheet->write('D3', '', $format06);
+ $worksheet->write('E3', '', $format07);
+ $worksheet->write('F3', '', $format06);
+ $worksheet->write('G3', '', $format07);
+ $worksheet->write('H3', '', $format06);
+ $worksheet->write('I3', '', $format09);
+
+ $worksheet->write('B4', '', $format05);
+ $worksheet->write('C4', '', $format06);
+ $worksheet->write('D4', '', $format07);
+ $worksheet->write('E4', '', $format06);
+ $worksheet->write('F4', '', $format07);
+ $worksheet->write('G4', '', $format06);
+ $worksheet->write('H4', '', $format07);
+ $worksheet->write('I4', '', $format08);
+
+ $worksheet->write('B5', '', $format10);
+ $worksheet->write('C5', '', $format07);
+ $worksheet->write('D5', '', $format06);
+ $worksheet->write('E5', '', $format07);
+ $worksheet->write('F5', '', $format06);
+ $worksheet->write('G5', '', $format07);
+ $worksheet->write('H5', '', $format06);
+ $worksheet->write('I5', '', $format09);
+
+ $worksheet->write('B6', '', $format05);
+ $worksheet->write('C6', '', $format06);
+ $worksheet->write('D6', '', $format07);
+ $worksheet->write('E6', '', $format06);
+ $worksheet->write('F6', '', $format07);
+ $worksheet->write('G6', '', $format06);
+ $worksheet->write('H6', '', $format07);
+ $worksheet->write('I6', '', $format08);
+
+ $worksheet->write('B7', '', $format10);
+ $worksheet->write('C7', '', $format07);
+ $worksheet->write('D7', '', $format06);
+ $worksheet->write('E7', '', $format07);
+ $worksheet->write('F7', '', $format06);
+ $worksheet->write('G7', '', $format07);
+ $worksheet->write('H7', '', $format06);
+ $worksheet->write('I7', '', $format09);
+
+ $worksheet->write('B8', '', $format05);
+ $worksheet->write('C8', '', $format06);
+ $worksheet->write('D8', '', $format07);
+ $worksheet->write('E8', '', $format06);
+ $worksheet->write('F8', '', $format07);
+ $worksheet->write('G8', '', $format06);
+ $worksheet->write('H8', '', $format07);
+ $worksheet->write('I8', '', $format08);
+
+ $worksheet->write('B9', '', $format11);
+ $worksheet->write('C9', '', $format12);
+ $worksheet->write('D9', '', $format13);
+ $worksheet->write('E9', '', $format12);
+ $worksheet->write('F9', '', $format13);
+ $worksheet->write('G9', '', $format12);
+ $worksheet->write('H9', '', $format13);
+ $worksheet->write('I9', '', $format14);
+
+
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/chess.pl>
+
+=head2 Example: colors.pl
+
+
+
+Demonstrates Spreadsheet::WriteExcel's named colors and the Excel color
+palette.
+
+The set_custom_color() Worksheet method can be used to override one of the
+built-in palette values with a more suitable colour. See the main docs.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/colors.jpg" width="640" height="420" alt="Output from colors.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ################################################################################
+ #
+ # Demonstrates Spreadsheet::WriteExcel's named colors and the Excel color
+ # palette.
+ #
+ # The set_custom_color() Worksheet method can be used to override one of the
+ # built-in palette values with a more suitable colour. See the main docs.
+ #
+ # reverse('©'), March 2002, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new("colors.xls");
+
+ # Some common formats
+ my $center = $workbook->add_format(align => 'center');
+ my $heading = $workbook->add_format(align => 'center', bold => 1);
+
+
+ ######################################################################
+ #
+ # Demonstrate the named colors.
+ #
+
+ my %colors = (
+ 0x08, 'black',
+ 0x0C, 'blue',
+ 0x10, 'brown',
+ 0x0F, 'cyan',
+ 0x17, 'gray',
+ 0x11, 'green',
+ 0x0B, 'lime',
+ 0x0E, 'magenta',
+ 0x12, 'navy',
+ 0x35, 'orange',
+ 0x21, 'pink',
+ 0x14, 'purple',
+ 0x0A, 'red',
+ 0x16, 'silver',
+ 0x09, 'white',
+ 0x0D, 'yellow',
+ );
+
+ my $worksheet1 = $workbook->add_worksheet('Named colors');
+
+ $worksheet1->set_column(0, 3, 15);
+
+ $worksheet1->write(0, 0, "Index", $heading);
+ $worksheet1->write(0, 1, "Index", $heading);
+ $worksheet1->write(0, 2, "Name", $heading);
+ $worksheet1->write(0, 3, "Color", $heading);
+
+ my $i = 1;
+
+ while (my($index, $color) = each %colors) {
+ my $format = $workbook->add_format(
+ fg_color => $color,
+ pattern => 1,
+ border => 1
+ );
+
+ $worksheet1->write($i+1, 0, $index, $center);
+ $worksheet1->write($i+1, 1, sprintf("0x%02X", $index), $center);
+ $worksheet1->write($i+1, 2, $color, $center);
+ $worksheet1->write($i+1, 3, '', $format);
+ $i++;
+ }
+
+
+ ######################################################################
+ #
+ # Demonstrate the standard Excel colors in the range 8..63.
+ #
+
+ my $worksheet2 = $workbook->add_worksheet('Standard colors');
+
+ $worksheet2->set_column(0, 3, 15);
+
+ $worksheet2->write(0, 0, "Index", $heading);
+ $worksheet2->write(0, 1, "Index", $heading);
+ $worksheet2->write(0, 2, "Color", $heading);
+ $worksheet2->write(0, 3, "Name", $heading);
+
+ for my $i (8..63) {
+ my $format = $workbook->add_format(
+ fg_color => $i,
+ pattern => 1,
+ border => 1
+ );
+
+ $worksheet2->write(($i -7), 0, $i, $center);
+ $worksheet2->write(($i -7), 1, sprintf("0x%02X", $i), $center);
+ $worksheet2->write(($i -7), 2, '', $format);
+
+ # Add the color names
+ if (exists $colors{$i}) {
+ $worksheet2->write(($i -7), 3, $colors{$i}, $center);
+
+ }
+ }
+
+ __END__
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/colors.pl>
+
+=head2 Example: comments1.pl
+
+
+
+This example demonstrates writing cell comments.
+
+A cell comment is indicated in Excel by a small red triangle in the upper
+right-hand corner of the cell.
+
+For more advanced comment options see comments2.pl.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/comments1.jpg" width="640" height="420" alt="Output from comments1.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # This example demonstrates writing cell comments.
+ #
+ # A cell comment is indicated in Excel by a small red triangle in the upper
+ # right-hand corner of the cell.
+ #
+ # For more advanced comment options see comments2.pl.
+ #
+ # reverse('©'), November 2005, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new("comments1.xls");
+ my $worksheet = $workbook->add_worksheet();
+
+
+
+ $worksheet->write ('A1', 'Hello' );
+ $worksheet->write_comment('A1', 'This is a comment');
+
+ __END__
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/comments1.pl>
+
+=head2 Example: comments2.pl
+
+
+
+This example demonstrates writing cell comments.
+
+A cell comment is indicated in Excel by a small red triangle in the upper
+right-hand corner of the cell.
+
+Each of the worksheets demonstrates different features of cell comments.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/comments2.jpg" width="640" height="420" alt="Output from comments2.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # This example demonstrates writing cell comments.
+ #
+ # A cell comment is indicated in Excel by a small red triangle in the upper
+ # right-hand corner of the cell.
+ #
+ # Each of the worksheets demonstrates different features of cell comments.
+ #
+ # reverse('©'), November 2005, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new("comments2.xls");
+ my $text_wrap = $workbook->add_format(text_wrap => 1, valign => 'top');
+ my $worksheet1 = $workbook->add_worksheet();
+ my $worksheet2 = $workbook->add_worksheet();
+ my $worksheet3 = $workbook->add_worksheet();
+ my $worksheet4 = $workbook->add_worksheet();
+ my $worksheet5 = $workbook->add_worksheet();
+ my $worksheet6 = $workbook->add_worksheet();
+ my $worksheet7 = $workbook->add_worksheet();
+ my $worksheet8 = $workbook->add_worksheet();
+
+
+ # Variables that we will use in each example.
+ my $cell_text = '';
+ my $comment = '';
+
+
+
+
+ ###############################################################################
+ #
+ # Example 1. Demonstrates a simple cell comment without formatting and Unicode
+ # comments encoded as UTF-16 and as UTF-8.
+ #
+
+ # Set up some formatting.
+ $worksheet1->set_column('C:C', 25);
+ $worksheet1->set_row(2, 50);
+ $worksheet1->set_row(5, 50);
+
+
+ # Simple ascii string.
+ $cell_text = 'Hold the mouse over this cell to see the comment.';
+
+ $comment = 'This is a comment.';
+
+ $worksheet1->write ('C3', $cell_text, $text_wrap);
+ $worksheet1->write_comment('C3', $comment);
+
+
+ # UTF-16 string.
+ $cell_text = 'This is a UTF-16 comment.';
+
+ $comment = pack "n", 0x263a;
+
+ $worksheet1->write ('C6', $cell_text, $text_wrap);
+ $worksheet1->write_comment('C6', $comment, encoding => 1);
+
+
+ # UTF-8 string in perl 5.8.
+ if ($] >= 5.008) {
+
+ $worksheet1->set_row(8, 50);
+ $cell_text = 'This is a UTF-8 string.';
+ $comment = chr 0x263a;
+
+ $worksheet1->write ('C9', $cell_text, $text_wrap);
+ $worksheet1->write_comment('C9', $comment);
+ }
+
+
+
+ ###############################################################################
+ #
+ # Example 2. Demonstrates visible and hidden comments.
+ #
+
+ # Set up some formatting.
+ $worksheet2->set_column('C:C', 25);
+ $worksheet2->set_row(2, 50);
+ $worksheet2->set_row(5, 50);
+
+
+ $cell_text = 'This cell comment is visible.';
+
+ $comment = 'Hello.';
+
+ $worksheet2->write ('C3', $cell_text, $text_wrap);
+ $worksheet2->write_comment('C3', $comment, visible => 1);
+
+
+ $cell_text = "This cell comment isn't visible (the default).";
+
+ $comment = 'Hello.';
+
+ $worksheet2->write ('C6', $cell_text, $text_wrap);
+ $worksheet2->write_comment('C6', $comment);
+
+
+
+
+ ###############################################################################
+ #
+ # Example 3. Demonstrates visible and hidden comments set at the worksheet
+ # level.
+ #
+
+ # Set up some formatting.
+ $worksheet3->set_column('C:C', 25);
+ $worksheet3->set_row(2, 50);
+ $worksheet3->set_row(5, 50);
+ $worksheet3->set_row(8, 50);
+
+ # Make all comments on the worksheet visible.
+ $worksheet3->show_comments();
+
+ $cell_text = 'This cell comment is visible, explicitly.';
+
+ $comment = 'Hello.';
+
+ $worksheet3->write ('C3', $cell_text, $text_wrap);
+ $worksheet3->write_comment('C3', $comment, visible => 1);
+
+
+ $cell_text = 'This cell comment is also visible because '.
+ 'we used show_comments().';
+
+ $comment = 'Hello.';
+
+ $worksheet3->write ('C6', $cell_text, $text_wrap);
+ $worksheet3->write_comment('C6', $comment);
+
+
+ $cell_text = 'However, we can still override it locally.';
+
+ $comment = 'Hello.';
+
+ $worksheet3->write ('C9', $cell_text, $text_wrap);
+ $worksheet3->write_comment('C9', $comment, visible => 0);
+
+
+
+
+ ###############################################################################
+ #
+ # Example 4. Demonstrates changes to the comment box dimensions.
+ #
+
+ # Set up some formatting.
+ $worksheet4->set_column('C:C', 25);
+ $worksheet4->set_row(2, 50);
+ $worksheet4->set_row(5, 50);
+ $worksheet4->set_row(8, 50);
+ $worksheet4->set_row(15, 50);
+
+ $worksheet4->show_comments();
+
+ $cell_text = 'This cell comment is default size.';
+
+ $comment = 'Hello.';
+
+ $worksheet4->write ('C3', $cell_text, $text_wrap);
+ $worksheet4->write_comment('C3', $comment);
+
+
+ $cell_text = 'This cell comment is twice as wide.';
+
+ $comment = 'Hello.';
+
+ $worksheet4->write ('C6', $cell_text, $text_wrap);
+ $worksheet4->write_comment('C6', $comment, x_scale => 2);
+
+
+ $cell_text = 'This cell comment is twice as high.';
+
+ $comment = 'Hello.';
+
+ $worksheet4->write ('C9', $cell_text, $text_wrap);
+ $worksheet4->write_comment('C9', $comment, y_scale => 2);
+
+
+ $cell_text = 'This cell comment is scaled in both directions.';
+
+ $comment = 'Hello.';
+
+ $worksheet4->write ('C16', $cell_text, $text_wrap);
+ $worksheet4->write_comment('C16', $comment, x_scale => 1.2, y_scale => 0.8);
+
+
+ $cell_text = 'This cell comment has width and height specified in pixels.';
+
+ $comment = 'Hello.';
+
+ $worksheet4->write ('C19', $cell_text, $text_wrap);
+ $worksheet4->write_comment('C19', $comment, width => 200, height => 20);
+
+
+
+ ###############################################################################
+ #
+ # Example 5. Demonstrates changes to the cell comment position.
+ #
+
+ $worksheet5->set_column('C:C', 25);
+ $worksheet5->set_row(2, 50);
+ $worksheet5->set_row(5, 50);
+ $worksheet5->set_row(8, 50);
+ $worksheet5->set_row(11, 50);
+
+ $worksheet5->show_comments();
+
+ $cell_text = 'This cell comment is in the default position.';
+
+ $comment = 'Hello.';
+
+ $worksheet5->write ('C3', $cell_text, $text_wrap);
+ $worksheet5->write_comment('C3', $comment);
+
+
+ $cell_text = 'This cell comment has been moved to another cell.';
+
+ $comment = 'Hello.';
+
+ $worksheet5->write ('C6', $cell_text, $text_wrap);
+ $worksheet5->write_comment('C6', $comment, start_cell => 'E4');
+
+
+ $cell_text = 'This cell comment has been moved to another cell.';
+
+ $comment = 'Hello.';
+
+ $worksheet5->write ('C9', $cell_text, $text_wrap);
+ $worksheet5->write_comment('C9', $comment, start_row => 8, start_col => 4);
+
+
+ $cell_text = 'This cell comment has been shifted within its default cell.';
+
+ $comment = 'Hello.';
+
+ $worksheet5->write ('C12', $cell_text, $text_wrap);
+ $worksheet5->write_comment('C12', $comment, x_offset => 30, y_offset => 12);
+
+
+
+ ###############################################################################
+ #
+ # Example 6. Demonstrates changes to the comment background colour.
+ #
+
+ $worksheet6->set_column('C:C', 25);
+ $worksheet6->set_row(2, 50);
+ $worksheet6->set_row(5, 50);
+ $worksheet6->set_row(8, 50);
+
+ $worksheet6->show_comments();
+
+ $cell_text = 'This cell comment has a different colour.';
+
+ $comment = 'Hello.';
+
+ $worksheet6->write ('C3', $cell_text, $text_wrap);
+ $worksheet6->write_comment('C3', $comment, color => 'green');
+
+
+ $cell_text = 'This cell comment has the default colour.';
+
+ $comment = 'Hello.';
+
+ $worksheet6->write ('C6', $cell_text, $text_wrap);
+ $worksheet6->write_comment('C6', $comment);
+
+
+ $cell_text = 'This cell comment has a different colour.';
+
+ $comment = 'Hello.';
+
+ $worksheet6->write ('C9', $cell_text, $text_wrap);
+ $worksheet6->write_comment('C9', $comment, color => 0x35);
+
+
+
+
+ ###############################################################################
+ #
+ # Example 7. Demonstrates how to set the cell comment author.
+ #
+
+ $worksheet7->set_column('C:C', 30);
+ $worksheet7->set_row(2, 50);
+ $worksheet7->set_row(5, 50);
+ $worksheet7->set_row(8, 50);
+ $worksheet7->set_row(11, 50);
+
+ my $author = '';
+ my $cell = 'C3';
+
+ $cell_text = "Move the mouse over this cell and you will see 'Cell commented ".
+ "by $author' (blank) in the status bar at the bottom";
+
+ $comment = 'Hello.';
+
+ $worksheet7->write ($cell, $cell_text, $text_wrap);
+ $worksheet7->write_comment($cell, $comment);
+
+
+ $author = 'Perl';
+ $cell = 'C6';
+ $cell_text = "Move the mouse over this cell and you will see 'Cell commented ".
+ "by $author' in the status bar at the bottom";
+
+ $comment = 'Hello.';
+
+ $worksheet7->write ($cell, $cell_text, $text_wrap);
+ $worksheet7->write_comment($cell, $comment, author => $author);
+
+
+ $author = pack "n", 0x20AC; # UTF-16 Euro
+ $cell = 'C9';
+ $cell_text = "Move the mouse over this cell and you will see 'Cell commented ".
+ "by Euro' in the status bar at the bottom";
+
+ $comment = 'Hello.';
+
+ $worksheet7->write ($cell, $cell_text, $text_wrap);
+ $worksheet7->write_comment($cell, $comment, author => $author,
+ author_encoding => 1 );
+
+ # UTF-8 string in perl 5.8.
+ if ($] >= 5.008) {
+ $author = chr 0x20AC;
+ $cell = 'C12';
+ $cell_text = "Move the mouse over this cell and you will see 'Cell commented ".
+ "by $author' in the status bar at the bottom";
+ $comment = 'Hello.';
+
+ $worksheet7->write ($cell, $cell_text, $text_wrap);
+ $worksheet7->write_comment($cell, $comment, author => $author);
+
+ }
+
+
+ ###############################################################################
+ #
+ # Example 8. Demonstrates the need to explicitly set the row height.
+ #
+
+ # Set up some formatting.
+ $worksheet8->set_column('C:C', 25);
+ $worksheet8->set_row(2, 80);
+
+ $worksheet8->show_comments();
+
+
+ $cell_text = 'The height of this row has been adjusted explicitly using ' .
+ 'set_row(). The size of the comment box is adjusted ' .
+ 'accordingly by WriteExcel.';
+
+ $comment = 'Hello.';
+
+ $worksheet8->write ('C3', $cell_text, $text_wrap);
+ $worksheet8->write_comment('C3', $comment);
+
+
+ $cell_text = 'The height of this row has been adjusted by Excel due to the ' .
+ 'text wrap property being set. Unfortunately this means that ' .
+ 'the height of the row is unknown to WriteExcel at run time ' .
+ "and thus the comment box is stretched as well.\n\n" .
+ 'Use set_row() to specify the row height explicitly to avoid ' .
+ 'this problem.';
+
+ $comment = 'Hello.';
+
+ $worksheet8->write ('C6', $cell_text, $text_wrap);
+ $worksheet8->write_comment('C6', $comment);
+
+ __END__
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/comments2.pl>
+
+=head2 Example: copyformat.pl
+
+
+
+Example of how to use the format copying method with Spreadsheet::WriteExcel.
+
+This feature isn't required very often.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/copyformat.jpg" width="640" height="420" alt="Output from copyformat.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # Example of how to use the format copying method with Spreadsheet::WriteExcel.
+ #
+ # This feature isn't required very often.
+ #
+ # reverse('©'), March 2001, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ # Create workbook1
+ my $workbook1 = Spreadsheet::WriteExcel->new("workbook1.xls");
+ my $worksheet1 = $workbook1->add_worksheet();
+ my $format1a = $workbook1->add_format();
+ my $format1b = $workbook1->add_format();
+
+ # Create workbook2
+ my $workbook2 = Spreadsheet::WriteExcel->new("workbook2.xls");
+ my $worksheet2 = $workbook2->add_worksheet();
+ my $format2a = $workbook2->add_format();
+ my $format2b = $workbook2->add_format();
+
+
+ # Create a global format object that isn't tied to a workbook
+ my $global_format = Spreadsheet::WriteExcel::Format->new();
+
+ # Set the formatting
+ $global_format->set_color('blue');
+ $global_format->set_bold();
+ $global_format->set_italic();
+
+ # Create another example format
+ $format1b->set_color('red');
+
+ # Copy the global format properties to the worksheet formats
+ $format1a->copy($global_format);
+ $format2a->copy($global_format);
+
+ # Copy a format from worksheet1 to worksheet2
+ $format2b->copy($format1b);
+
+ # Write some output
+ $worksheet1->write(0, 0, "Ciao", $format1a);
+ $worksheet1->write(1, 0, "Ciao", $format1b);
+
+ $worksheet2->write(0, 0, "Hello", $format2a);
+ $worksheet2->write(1, 0, "Hello", $format2b);
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/copyformat.pl>
+
+=head2 Example: data_validate.pl
+
+
+
+Example of how to add data validation and dropdown lists to a
+Spreadsheet::WriteExcel file.
+
+Data validation is a feature of Excel which allows you to restrict the data
+that a users enters in a cell and to display help and warning messages. It
+also allows you to restrict input to values in a drop down list.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/data_validate.jpg" width="640" height="420" alt="Output from data_validate.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # Example of how to add data validation and dropdown lists to a
+ # Spreadsheet::WriteExcel file.
+ #
+ # Data validation is a feature of Excel which allows you to restrict the data
+ # that a users enters in a cell and to display help and warning messages. It
+ # also allows you to restrict input to values in a drop down list.
+ #
+ # reverse('©'), August 2008, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new('data_validate.xls');
+ my $worksheet = $workbook->add_worksheet();
+
+ # Add a format for the header cells.
+ my $header_format = $workbook->add_format(
+ border => 1,
+ bg_color => 43,
+ bold => 1,
+ text_wrap => 1,
+ valign => 'vcenter',
+ indent => 1,
+ );
+
+ # Set up layout of the worksheet.
+ $worksheet->set_column('A:A', 64);
+ $worksheet->set_column('B:B', 15);
+ $worksheet->set_column('D:D', 15);
+ $worksheet->set_row(0, 36);
+ $worksheet->set_selection('B3');
+
+
+ # Write the header cells and some data that will be used in the examples.
+ my $row = 0;
+ my $txt;
+ my $heading1 = 'Some examples of data validation in Spreadsheet::WriteExcel';
+ my $heading2 = 'Enter values in this column';
+ my $heading3 = 'Sample Data';
+
+ $worksheet->write('A1', $heading1, $header_format);
+ $worksheet->write('B1', $heading2, $header_format);
+ $worksheet->write('D1', $heading3, $header_format);
+
+ $worksheet->write('D3', ['Integers', 1, 10]);
+ $worksheet->write('D4', ['List data', 'open', 'high', 'close']);
+ $worksheet->write('D5', ['Formula', '=AND(F5=50,G5=60)', 50, 60]);
+
+
+ #
+ # Example 1. Limiting input to an integer in a fixed range.
+ #
+ $txt = 'Enter an integer between 1 and 10';
+ $row += 2;
+
+ $worksheet->write($row, 0, $txt);
+ $worksheet->data_validation($row, 1,
+ {
+ validate => 'integer',
+ criteria => 'between',
+ minimum => 1,
+ maximum => 10,
+ });
+
+
+ #
+ # Example 2. Limiting input to an integer outside a fixed range.
+ #
+ $txt = 'Enter an integer that is not between 1 and 10 (using cell references)';
+ $row += 2;
+
+ $worksheet->write($row, 0, $txt);
+ $worksheet->data_validation($row, 1,
+ {
+ validate => 'integer',
+ criteria => 'not between',
+ minimum => '=E3',
+ maximum => '=F3',
+ });
+
+
+ #
+ # Example 3. Limiting input to an integer greater than a fixed value.
+ #
+ $txt = 'Enter an integer greater than 0';
+ $row += 2;
+
+ $worksheet->write($row, 0, $txt);
+ $worksheet->data_validation($row, 1,
+ {
+ validate => 'integer',
+ criteria => '>',
+ value => 0,
+ });
+
+
+ #
+ # Example 4. Limiting input to an integer less than a fixed value.
+ #
+ $txt = 'Enter an integer less than 10';
+ $row += 2;
+
+ $worksheet->write($row, 0, $txt);
+ $worksheet->data_validation($row, 1,
+ {
+ validate => 'integer',
+ criteria => '<',
+ value => 10,
+ });
+
+
+ #
+ # Example 5. Limiting input to a decimal in a fixed range.
+ #
+ $txt = 'Enter a decimal between 0.1 and 0.5';
+ $row += 2;
+
+ $worksheet->write($row, 0, $txt);
+ $worksheet->data_validation($row, 1,
+ {
+ validate => 'decimal',
+ criteria => 'between',
+ minimum => 0.1,
+ maximum => 0.5,
+ });
+
+
+ #
+ # Example 6. Limiting input to a value in a dropdown list.
+ #
+ $txt = 'Select a value from a drop down list';
+ $row += 2;
+
+ $worksheet->write($row, 0, $txt);
+ $worksheet->data_validation($row, 1,
+ {
+ validate => 'list',
+ source => ['open', 'high', 'close'],
+ });
+
+
+ #
+ # Example 6. Limiting input to a value in a dropdown list.
+ #
+ $txt = 'Select a value from a drop down list (using a cell range)';
+ $row += 2;
+
+ $worksheet->write($row, 0, $txt);
+ $worksheet->data_validation($row, 1,
+ {
+ validate => 'list',
+ source => '=E4:G4',
+ });
+
+
+ #
+ # Example 7. Limiting input to a date in a fixed range.
+ #
+ $txt = 'Enter a date between 1/1/2008 and 12/12/2008';
+ $row += 2;
+
+ $worksheet->write($row, 0, $txt);
+ $worksheet->data_validation($row, 1,
+ {
+ validate => 'date',
+ criteria => 'between',
+ minimum => '2008-01-01T',
+ maximum => '2008-12-12T',
+ });
+
+
+ #
+ # Example 8. Limiting input to a time in a fixed range.
+ #
+ $txt = 'Enter a time between 6:00 and 12:00';
+ $row += 2;
+
+ $worksheet->write($row, 0, $txt);
+ $worksheet->data_validation($row, 1,
+ {
+ validate => 'time',
+ criteria => 'between',
+ minimum => 'T06:00',
+ maximum => 'T12:00',
+ });
+
+
+ #
+ # Example 9. Limiting input to a string greater than a fixed length.
+ #
+ $txt = 'Enter a string longer than 3 characters';
+ $row += 2;
+
+ $worksheet->write($row, 0, $txt);
+ $worksheet->data_validation($row, 1,
+ {
+ validate => 'length',
+ criteria => '>',
+ value => 3,
+ });
+
+
+ #
+ # Example 10. Limiting input based on a formula.
+ #
+ $txt = 'Enter a value if the following is true "=AND(F5=50,G5=60)"';
+ $row += 2;
+
+ $worksheet->write($row, 0, $txt);
+ $worksheet->data_validation($row, 1,
+ {
+ validate => 'custom',
+ value => '=AND(F5=50,G5=60)',
+ });
+
+
+ #
+ # Example 11. Displaying and modify data validation messages.
+ #
+ $txt = 'Displays a message when you select the cell';
+ $row += 2;
+
+ $worksheet->write($row, 0, $txt);
+ $worksheet->data_validation($row, 1,
+ {
+ validate => 'integer',
+ criteria => 'between',
+ minimum => 1,
+ maximum => 100,
+ input_title => 'Enter an integer:',
+ input_message => 'between 1 and 100',
+ });
+
+
+ #
+ # Example 12. Displaying and modify data validation messages.
+ #
+ $txt = 'Display a custom error message when integer isn\'t between 1 and 100';
+ $row += 2;
+
+ $worksheet->write($row, 0, $txt);
+ $worksheet->data_validation($row, 1,
+ {
+ validate => 'integer',
+ criteria => 'between',
+ minimum => 1,
+ maximum => 100,
+ input_title => 'Enter an integer:',
+ input_message => 'between 1 and 100',
+ error_title => 'Input value is not valid!',
+ error_message => 'It should be an integer between 1 and 100',
+ });
+
+
+ #
+ # Example 13. Displaying and modify data validation messages.
+ #
+ $txt = 'Display a custom information message when integer isn\'t between 1 and 100';
+ $row += 2;
+
+ $worksheet->write($row, 0, $txt);
+ $worksheet->data_validation($row, 1,
+ {
+ validate => 'integer',
+ criteria => 'between',
+ minimum => 1,
+ maximum => 100,
+ input_title => 'Enter an integer:',
+ input_message => 'between 1 and 100',
+ error_title => 'Input value is not valid!',
+ error_message => 'It should be an integer between 1 and 100',
+ error_type => 'information',
+ });
+
+
+ __END__
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/data_validate.pl>
+
+=head2 Example: date_time.pl
+
+
+
+Spreadsheet::WriteExcel example of writing dates and times using the
+write_date_time() Worksheet method.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/date_time.jpg" width="640" height="420" alt="Output from date_time.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # Spreadsheet::WriteExcel example of writing dates and times using the
+ # write_date_time() Worksheet method.
+ #
+ # reverse('©'), August 2004, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+
+ # Create a new workbook and add a worksheet
+ my $workbook = Spreadsheet::WriteExcel->new("date_time.xls");
+ my $worksheet = $workbook->add_worksheet();
+ my $bold = $workbook->add_format(bold => 1);
+ my $row = 0;
+
+
+ # Expand the first column so that the date is visible.
+ $worksheet->set_column("A:B", 30);
+
+
+ # Write the column headers
+ $worksheet->write('A1', 'Formatted date', $bold);
+ $worksheet->write('B1', 'Format', $bold);
+
+
+ # Examples date and time formats. In the output file compare how changing
+ # the format codes change the appearance of the date.
+ #
+ my @date_formats = (
+ 'dd/mm/yy',
+ 'mm/dd/yy',
+ '',
+ 'd mm yy',
+ 'dd mm yy',
+ '',
+ 'dd m yy',
+ 'dd mm yy',
+ 'dd mmm yy',
+ 'dd mmmm yy',
+ '',
+ 'dd mm y',
+ 'dd mm yyy',
+ 'dd mm yyyy',
+ '',
+ 'd mmmm yyyy',
+ '',
+ 'dd/mm/yy',
+ 'dd/mm/yy hh:mm',
+ 'dd/mm/yy hh:mm:ss',
+ 'dd/mm/yy hh:mm:ss.000',
+ '',
+ 'hh:mm',
+ 'hh:mm:ss',
+ 'hh:mm:ss.000',
+ );
+
+
+ # Write the same date and time using each of the above formats. The empty
+ # string formats create a blank line to make the example clearer.
+ #
+ for my $date_format (@date_formats) {
+ $row++;
+ next if $date_format eq '';
+
+ # Create a format for the date or time.
+ my $format = $workbook->add_format(
+ num_format => $date_format,
+ align => 'left'
+ );
+
+ # Write the same date using different formats.
+ $worksheet->write_date_time($row, 0, '2004-08-01T12:30:45.123', $format);
+ $worksheet->write ($row, 1, $date_format);
+ }
+
+
+ # The following is an example of an invalid date. It is written as a string
+ # instead of a number. This is also Excel's default behaviour.
+ #
+ $row += 2;
+ $worksheet->write_date_time($row, 0, '2004-13-01T12:30:45.123');
+ $worksheet->write ($row, 1, 'Invalid date. Written as string.', $bold);
+
+ __END__
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/date_time.pl>
+
+=head2 Example: defined_name.pl
+
+
+
+Example of how to create defined names in a Spreadsheet::WriteExcel file.
+
+This method is used to defined a name that can be used to represent a value,
+a single cell or a range of cells in a workbook.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/defined_name.jpg" width="640" height="420" alt="Output from defined_name.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # Example of how to create defined names in a Spreadsheet::WriteExcel file.
+ #
+ # This method is used to defined a name that can be used to represent a value,
+ # a single cell or a range of cells in a workbook.
+ #
+ # reverse('©'), September 2008, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new('defined_name.xls');
+ my $worksheet1 = $workbook->add_worksheet();
+ my $worksheet2 = $workbook->add_worksheet();
+
+
+ $workbook->define_name('Exchange_rate', '=0.96');
+ $workbook->define_name('Sales', '=Sheet1!$G$1:$H$10');
+ $workbook->define_name('Sheet2!Sales', '=Sheet2!$G$1:$G$10');
+
+
+ for my $worksheet ($workbook->sheets()) {
+ $worksheet->set_column('A:A', 45);
+ $worksheet->write('A2', 'This worksheet contains some defined names,');
+ $worksheet->write('A3', 'See the Insert -> Name -> Define dialog.');
+
+ }
+
+
+ $worksheet1->write('A4', '=Exchange_rate');
+
+ __END__
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/defined_name.pl>
+
+=head2 Example: diag_border.pl
+
+
+
+A simple formatting example that demonstrates how to add a diagonal cell
+border with Spreadsheet::WriteExcel
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/diag_border.jpg" width="640" height="420" alt="Output from diag_border.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ##############################################################################
+ #
+ # A simple formatting example that demonstrates how to add a diagonal cell
+ # border with Spreadsheet::WriteExcel
+ #
+ # reverse('©'), May 2004, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+
+ my $workbook = Spreadsheet::WriteExcel->new('diag_border.xls');
+ my $worksheet = $workbook->add_worksheet();
+
+
+ my $format1 = $workbook->add_format(diag_type => '1');
+
+ my $format2 = $workbook->add_format(diag_type => '2');
+
+ my $format3 = $workbook->add_format(diag_type => '3');
+
+ my $format4 = $workbook->add_format(
+ diag_type => '3',
+ diag_border => '7',
+ diag_color => 'red',
+ );
+
+
+ $worksheet->write('B3', 'Text', $format1);
+ $worksheet->write('B6', 'Text', $format2);
+ $worksheet->write('B9', 'Text', $format3);
+ $worksheet->write('B12', 'Text', $format4);
+
+
+
+ __END__
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/diag_border.pl>
+
+=head2 Example: easter_egg.pl
+
+
+
+This uses the Win32::OLE module to expose the Flight Simulator easter egg
+in Excel 97 SR2.
+
+
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # This uses the Win32::OLE module to expose the Flight Simulator easter egg
+ # in Excel 97 SR2.
+ #
+ # reverse('©'), March 2001, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Win32::OLE;
+
+ my $application = Win32::OLE->new("Excel.Application");
+ my $workbook = $application->Workbooks->Add;
+ my $worksheet = $workbook->Worksheets(1);
+
+ $application->{Visible} = 1;
+
+ $worksheet->Range("L97:X97")->Select;
+ $worksheet->Range("M97")->Activate;
+
+ my $message = "Hold down Shift and Ctrl and click the ".
+ "Chart Wizard icon on the toolbar.\n\n".
+ "Use the mouse motion and buttons to control ".
+ "movement. Try to find the monolith. ".
+ "Close this dialog first.";
+
+ $application->InputBox($message);
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/easter_egg.pl>
+
+=head2 Example: filehandle.pl
+
+
+
+Example of using Spreadsheet::WriteExcel to write Excel files to
+different filehandles.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/filehandle.jpg" width="640" height="420" alt="Output from filehandle.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # Example of using Spreadsheet::WriteExcel to write Excel files to
+ # different filehandles.
+ #
+ # reverse('©'), April 2003, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+ use IO::Scalar;
+
+
+
+
+ ###############################################################################
+ #
+ # Example 1. This demonstrates the standard way of creating an Excel file by
+ # specifying a file name.
+ #
+
+ my $workbook1 = Spreadsheet::WriteExcel->new('fh_01.xls');
+ my $worksheet1 = $workbook1->add_worksheet();
+
+ $worksheet1->write(0, 0, "Hi Excel!");
+
+
+
+
+ ###############################################################################
+ #
+ # Example 2. Write an Excel file to an existing filehandle.
+ #
+
+ open TEST, "> fh_02.xls" or die "Couldn't open file: $!";
+ binmode TEST; # Always do this regardless of whether the platform requires it.
+
+ my $workbook2 = Spreadsheet::WriteExcel->new(\*TEST);
+ my $worksheet2 = $workbook2->add_worksheet();
+
+ $worksheet2->write(0, 0, "Hi Excel!");
+
+
+
+
+ ###############################################################################
+ #
+ # Example 3. Write an Excel file to an existing OO style filehandle.
+ #
+
+ my $fh = FileHandle->new("> fh_03.xls")
+ or die "Couldn't open file: $!";
+
+ binmode($fh);
+
+ my $workbook3 = Spreadsheet::WriteExcel->new($fh);
+ my $worksheet3 = $workbook3->add_worksheet();
+
+ $worksheet3->write(0, 0, "Hi Excel!");
+
+
+
+
+ ###############################################################################
+ #
+ # Example 4. Write an Excel file to a string via IO::Scalar. Please refer to
+ # the IO::Scalar documentation for further details.
+ #
+
+ my $xls_str;
+
+ tie *XLS, 'IO::Scalar', \$xls_str;
+
+ my $workbook4 = Spreadsheet::WriteExcel->new(\*XLS);
+ my $worksheet4 = $workbook4->add_worksheet();
+
+ $worksheet4->write(0, 0, "Hi Excel 4");
+ $workbook4->close(); # This is required before we use the scalar
+
+
+ # The Excel file is now in $xls_str. As a demonstration, print it to a file.
+ open TMP, "> fh_04.xls" or die "Couldn't open file: $!";
+ binmode TMP;
+ print TMP $xls_str;
+ close TMP;
+
+
+
+
+ ###############################################################################
+ #
+ # Example 5. Write an Excel file to a string via IO::Scalar's newer interface.
+ # Please refer to the IO::Scalar documentation for further details.
+ #
+ my $xls_str2;
+
+ my $fh5 = IO::Scalar->new(\$xls_str2);
+
+
+ my $workbook5 = Spreadsheet::WriteExcel->new($fh5);
+ my $worksheet5 = $workbook5->add_worksheet();
+
+ $worksheet5->write(0, 0, "Hi Excel 5");
+ $workbook5->close(); # This is required before we use the scalar
+
+ # The Excel file is now in $xls_str. As a demonstration, print it to a file.
+ open TMP, "> fh_05.xls" or die "Couldn't open file: $!";
+ binmode TMP;
+ print TMP $xls_str2;
+ close TMP;
+
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/filehandle.pl>
+
+=head2 Example: formula_result.pl
+
+
+
+Example of how to write Spreadsheet::WriteExcel formulas with a user
+specified result.
+
+This is generally only required when writing a spreadsheet for an
+application other than Excel where the formula isn't evaluated.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/formula_result.jpg" width="640" height="420" alt="Output from formula_result.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ #######################################################################
+ #
+ # Example of how to write Spreadsheet::WriteExcel formulas with a user
+ # specified result.
+ #
+ # This is generally only required when writing a spreadsheet for an
+ # application other than Excel where the formula isn't evaluated.
+ #
+ # reverse('©'), August 2005, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new('formula_result.xls');
+ my $worksheet = $workbook->add_worksheet();
+ my $format = $workbook->add_format(color => 'blue');
+
+
+ $worksheet->write('A1', '=1+2');
+ $worksheet->write('A2', '=1+2', $format, 4);
+ $worksheet->write('A3', '="ABC"', undef, 'DEF');
+ $worksheet->write('A4', '=IF(A1 > 1, TRUE, FALSE)', undef, 'TRUE');
+ $worksheet->write('A5', '=1/0', undef, '#DIV/0!');
+
+
+ __END__
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/formula_result.pl>
+
+=head2 Example: headers.pl
+
+
+
+This program shows several examples of how to set up headers and
+footers with Spreadsheet::WriteExcel.
+
+The control characters used in the header/footer strings are:
+
+ Control Category Description
+ ======= ======== ===========
+ &L Justification Left
+ &C Center
+ &R Right
+
+ &P Information Page number
+ &N Total number of pages
+ &D Date
+ &T Time
+ &F File name
+ &A Worksheet name
+
+ &fontsize Font Font size
+ &"font,style" Font name and style
+ &U Single underline
+ &E Double underline
+ &S Strikethrough
+ &X Superscript
+ &Y Subscript
+
+ && Miscellaneous Literal ampersand &
+
+See the main Spreadsheet::WriteExcel documentation for more information.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/headers.jpg" width="640" height="420" alt="Output from headers.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ######################################################################
+ #
+ # This program shows several examples of how to set up headers and
+ # footers with Spreadsheet::WriteExcel.
+ #
+ # The control characters used in the header/footer strings are:
+ #
+ # Control Category Description
+ # ======= ======== ===========
+ # &L Justification Left
+ # &C Center
+ # &R Right
+ #
+ # &P Information Page number
+ # &N Total number of pages
+ # &D Date
+ # &T Time
+ # &F File name
+ # &A Worksheet name
+ #
+ # &fontsize Font Font size
+ # &"font,style" Font name and style
+ # &U Single underline
+ # &E Double underline
+ # &S Strikethrough
+ # &X Superscript
+ # &Y Subscript
+ #
+ # && Miscellaneous Literal ampersand &
+ #
+ # See the main Spreadsheet::WriteExcel documentation for more information.
+ #
+ # reverse('©'), March 2002, John McNamara, jmcnamara@cpan.org
+ #
+
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new("headers.xls");
+ my $preview = "Select Print Preview to see the header and footer";
+
+
+ ######################################################################
+ #
+ # A simple example to start
+ #
+ my $worksheet1 = $workbook->add_worksheet('Simple');
+
+ my $header1 = '&CHere is some centred text.';
+
+ my $footer1 = '&LHere is some left aligned text.';
+
+
+ $worksheet1->set_header($header1);
+ $worksheet1->set_footer($footer1);
+
+ $worksheet1->set_column('A:A', 50);
+ $worksheet1->write('A1', $preview);
+
+
+
+
+ ######################################################################
+ #
+ # This is an example of some of the header/footer variables.
+ #
+ my $worksheet2 = $workbook->add_worksheet('Variables');
+
+ my $header2 = '&LPage &P of &N'.
+ '&CFilename: &F' .
+ '&RSheetname: &A';
+
+ my $footer2 = '&LCurrent date: &D'.
+ '&RCurrent time: &T';
+
+
+
+ $worksheet2->set_header($header2);
+ $worksheet2->set_footer($footer2);
+
+
+ $worksheet2->set_column('A:A', 50);
+ $worksheet2->write('A1', $preview);
+ $worksheet2->write('A21', "Next sheet");
+ $worksheet2->set_h_pagebreaks(20);
+
+
+
+ ######################################################################
+ #
+ # This example shows how to use more than one font
+ #
+ my $worksheet3 = $workbook->add_worksheet('Mixed fonts');
+
+ my $header3 = '&C' .
+ '&"Courier New,Bold"Hello ' .
+ '&"Arial,Italic"World';
+
+ my $footer3 = '&C' .
+ '&"Symbol"e' .
+ '&"Arial" = mc&X2';
+
+ $worksheet3->set_header($header3);
+ $worksheet3->set_footer($footer3);
+
+ $worksheet3->set_column('A:A', 50);
+ $worksheet3->write('A1', $preview);
+
+
+
+
+ ######################################################################
+ #
+ # Example of line wrapping
+ #
+ my $worksheet4 = $workbook->add_worksheet('Word wrap');
+
+ my $header4 = "&CHeading 1\nHeading 2\nHeading 3";
+
+ $worksheet4->set_header($header4);
+
+ $worksheet4->set_column('A:A', 50);
+ $worksheet4->write('A1', $preview);
+
+
+
+
+ ######################################################################
+ #
+ # Example of inserting a literal ampersand &
+ #
+ my $worksheet5 = $workbook->add_worksheet('Ampersand');
+
+ my $header5 = "&CCuriouser && Curiouser - Attorneys at Law";
+
+ $worksheet5->set_header($header5);
+
+ $worksheet5->set_column('A:A', 50);
+ $worksheet5->write('A1', $preview);
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/headers.pl>
+
+=head2 Example: hide_sheet.pl
+
+
+
+Example of how to hide a worksheet with Spreadsheet::WriteExcel.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/hide_sheet.jpg" width="640" height="420" alt="Output from hide_sheet.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ #######################################################################
+ #
+ # Example of how to hide a worksheet with Spreadsheet::WriteExcel.
+ #
+ # reverse('©'), April 2005, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new('hidden.xls');
+ my $worksheet1 = $workbook->add_worksheet();
+ my $worksheet2 = $workbook->add_worksheet();
+ my $worksheet3 = $workbook->add_worksheet();
+
+ # Sheet2 won't be visible until it is unhidden in Excel.
+ $worksheet2->hide();
+
+ $worksheet1->write(0, 0, 'Sheet2 is hidden');
+ $worksheet2->write(0, 0, 'How did you find me?');
+ $worksheet3->write(0, 0, 'Sheet2 is hidden');
+
+
+ __END__
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/hide_sheet.pl>
+
+=head2 Example: hyperlink1.pl
+
+
+
+Example of how to use the WriteExcel module to write hyperlinks.
+
+See also hyperlink2.pl for worksheet URL examples.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/hyperlink1.jpg" width="640" height="420" alt="Output from hyperlink1.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # Example of how to use the WriteExcel module to write hyperlinks.
+ #
+ # See also hyperlink2.pl for worksheet URL examples.
+ #
+ # reverse('©'), March 2001, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ # Create a new workbook and add a worksheet
+ my $workbook = Spreadsheet::WriteExcel->new("hyperlink.xls");
+ my $worksheet = $workbook->add_worksheet('Hyperlinks');
+
+ # Format the first column
+ $worksheet->set_column('A:A', 30);
+ $worksheet->set_selection('B1');
+
+
+ # Add a sample format
+ my $format = $workbook->add_format();
+ $format->set_size(12);
+ $format->set_bold();
+ $format->set_color('red');
+ $format->set_underline();
+
+
+ # Write some hyperlinks
+ $worksheet->write('A1', 'http://www.perl.com/' );
+ $worksheet->write('A3', 'http://www.perl.com/', 'Perl home' );
+ $worksheet->write('A5', 'http://www.perl.com/', undef, $format);
+ $worksheet->write('A7', 'mailto:jmcnamara@cpan.org', 'Mail me');
+
+ # Write a URL that isn't a hyperlink
+ $worksheet->write_string('A9', 'http://www.perl.com/');
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/hyperlink1.pl>
+
+=head2 Example: hyperlink2.pl
+
+
+
+Example of how to use the WriteExcel module to write internal and internal
+hyperlinks.
+
+If you wish to run this program and follow the hyperlinks you should create
+the following directory structure:
+
+ C:\ -- Temp --+-- Europe
+ |
+ \-- Asia
+
+
+See also hyperlink1.pl for web URL examples.
+
+
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # Example of how to use the WriteExcel module to write internal and internal
+ # hyperlinks.
+ #
+ # If you wish to run this program and follow the hyperlinks you should create
+ # the following directory structure:
+ #
+ # C:\ -- Temp --+-- Europe
+ # |
+ # \-- Asia
+ #
+ #
+ # See also hyperlink1.pl for web URL examples.
+ #
+ # reverse('©'), February 2002, John McNamara, jmcnamara@cpan.org
+ #
+
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ # Create three workbooks:
+ # C:\Temp\Europe\Ireland.xls
+ # C:\Temp\Europe\Italy.xls
+ # C:\Temp\Asia\China.xls
+ #
+ my $ireland = Spreadsheet::WriteExcel->new('C:\Temp\Europe\Ireland.xls');
+ my $ire_links = $ireland->add_worksheet('Links');
+ my $ire_sales = $ireland->add_worksheet('Sales');
+ my $ire_data = $ireland->add_worksheet('Product Data');
+
+ my $italy = Spreadsheet::WriteExcel->new('C:\Temp\Europe\Italy.xls');
+ my $ita_links = $italy->add_worksheet('Links');
+ my $ita_sales = $italy->add_worksheet('Sales');
+ my $ita_data = $italy->add_worksheet('Product Data');
+
+ my $china = Spreadsheet::WriteExcel->new('C:\Temp\Asia\China.xls');
+ my $cha_links = $china->add_worksheet('Links');
+ my $cha_sales = $china->add_worksheet('Sales');
+ my $cha_data = $china->add_worksheet('Product Data');
+
+ # Add a format
+ my $format = $ireland->add_format(color => 'green', bold => 1);
+ $ire_links->set_column('A:B', 25);
+
+
+ ###############################################################################
+ #
+ # Examples of internal links
+ #
+ $ire_links->write('A1', 'Internal links', $format);
+
+ # Internal link
+ $ire_links->write('A2', 'internal:Sales!A2');
+
+ # Internal link to a range
+ $ire_links->write('A3', 'internal:Sales!A3:D3');
+
+ # Internal link with an alternative string
+ $ire_links->write('A4', 'internal:Sales!A4', 'Link');
+
+ # Internal link with a format
+ $ire_links->write('A5', 'internal:Sales!A5', $format);
+
+ # Internal link with an alternative string and format
+ $ire_links->write('A6', 'internal:Sales!A6', 'Link', $format);
+
+ # Internal link (spaces in worksheet name)
+ $ire_links->write('A7', q{internal:'Product Data'!A7});
+
+
+ ###############################################################################
+ #
+ # Examples of external links
+ #
+ $ire_links->write('B1', 'External links', $format);
+
+ # External link to a local file
+ $ire_links->write('B2', 'external:Italy.xls');
+
+ # External link to a local file with worksheet
+ $ire_links->write('B3', 'external:Italy.xls#Sales!B3');
+
+ # External link to a local file with worksheet and alternative string
+ $ire_links->write('B4', 'external:Italy.xls#Sales!B4', 'Link');
+
+ # External link to a local file with worksheet and format
+ $ire_links->write('B5', 'external:Italy.xls#Sales!B5', $format);
+
+ # External link to a remote file, absolute path
+ $ire_links->write('B6', 'external:c:/Temp/Asia/China.xls');
+
+ # External link to a remote file, relative path
+ $ire_links->write('B7', 'external:../Asia/China.xls');
+
+ # External link to a remote file with worksheet
+ $ire_links->write('B8', 'external:c:/Temp/Asia/China.xls#Sales!B8');
+
+ # External link to a remote file with worksheet (with spaces in the name)
+ $ire_links->write('B9', q{external:c:/Temp/Asia/China.xls#'Product Data'!B9});
+
+
+ ###############################################################################
+ #
+ # Some utility links to return to the main sheet
+ #
+ $ire_sales->write('A2', 'internal:Links!A2', 'Back');
+ $ire_sales->write('A3', 'internal:Links!A3', 'Back');
+ $ire_sales->write('A4', 'internal:Links!A4', 'Back');
+ $ire_sales->write('A5', 'internal:Links!A5', 'Back');
+ $ire_sales->write('A6', 'internal:Links!A6', 'Back');
+ $ire_data-> write('A7', 'internal:Links!A7', 'Back');
+
+ $ita_links->write('A1', 'external:Ireland.xls#Links!B2', 'Back');
+ $ita_sales->write('B3', 'external:Ireland.xls#Links!B3', 'Back');
+ $ita_sales->write('B4', 'external:Ireland.xls#Links!B4', 'Back');
+ $ita_sales->write('B5', 'external:Ireland.xls#Links!B5', 'Back');
+ $cha_links->write('A1', 'external:../Europe/Ireland.xls#Links!B6', 'Back');
+ $cha_sales->write('B8', 'external:../Europe/Ireland.xls#Links!B8', 'Back');
+ $cha_data-> write('B9', 'external:../Europe/Ireland.xls#Links!B9', 'Back');
+
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/hyperlink2.pl>
+
+=head2 Example: images.pl
+
+
+
+Example of how to insert images into an Excel worksheet using the
+Spreadsheet::WriteExcel insert_image() method.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/images.jpg" width="640" height="420" alt="Output from images.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ #######################################################################
+ #
+ # Example of how to insert images into an Excel worksheet using the
+ # Spreadsheet::WriteExcel insert_image() method.
+ #
+ # reverse('©'), October 2001, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ # Create a new workbook called simple.xls and add a worksheet
+ my $workbook = Spreadsheet::WriteExcel->new("images.xls");
+ my $worksheet1 = $workbook->add_worksheet('Image 1');
+ my $worksheet2 = $workbook->add_worksheet('Image 2');
+ my $worksheet3 = $workbook->add_worksheet('Image 3');
+ my $worksheet4 = $workbook->add_worksheet('Image 4');
+
+ # Insert a basic image
+ $worksheet1->write('A10', "Image inserted into worksheet.");
+ $worksheet1->insert_image('A1', 'republic.png');
+
+
+ # Insert an image with an offset
+ $worksheet2->write('A10', "Image inserted with an offset.");
+ $worksheet2->insert_image('A1', 'republic.png', 32, 10);
+
+ # Insert a scaled image
+ $worksheet3->write('A10', "Image scaled: width x 2, height x 0.8.");
+ $worksheet3->insert_image('A1', 'republic.png', 0, 0, 2, 0.8);
+
+ # Insert an image over varied column and row sizes
+ # This does not require any additional work
+
+ # Set the cols and row sizes
+ # NOTE: you must do this before you call insert_image()
+ $worksheet4->set_column('A:A', 5);
+ $worksheet4->set_column('B:B', undef, undef, 1); # Hidden
+ $worksheet4->set_column('C:D', 10);
+ $worksheet4->set_row(0, 30);
+ $worksheet4->set_row(3, 5);
+
+ $worksheet4->write('A10', "Image inserted over scaled rows and columns.");
+ $worksheet4->insert_image('A1', 'republic.png');
+
+
+
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/images.pl>
+
+=head2 Example: indent.pl
+
+
+
+A simple formatting example using Spreadsheet::WriteExcel.
+
+This program demonstrates the indentation cell format.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/indent.jpg" width="640" height="420" alt="Output from indent.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ##############################################################################
+ #
+ # A simple formatting example using Spreadsheet::WriteExcel.
+ #
+ # This program demonstrates the indentation cell format.
+ #
+ # reverse('©'), May 2004, John McNamara, jmcnamara@cpan.org
+ #
+
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new('indent.xls');
+
+ my $worksheet = $workbook->add_worksheet();
+ my $indent1 = $workbook->add_format(indent => 1);
+ my $indent2 = $workbook->add_format(indent => 2);
+
+ $worksheet->set_column('A:A', 40);
+
+
+ $worksheet->write('A1', "This text is indented 1 level", $indent1);
+ $worksheet->write('A2', "This text is indented 2 levels", $indent2);
+
+
+ __END__
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/indent.pl>
+
+=head2 Example: merge1.pl
+
+
+
+Simple example of merging cells using the Spreadsheet::WriteExcel module.
+
+This example merges three cells using the "Centre Across Selection"
+alignment which was the Excel 5 method of achieving a merge. For a more
+modern approach use the merge_range() worksheet method instead.
+See the merge3.pl - merge6.pl programs.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/merge1.jpg" width="640" height="420" alt="Output from merge1.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # Simple example of merging cells using the Spreadsheet::WriteExcel module.
+ #
+ # This example merges three cells using the "Centre Across Selection"
+ # alignment which was the Excel 5 method of achieving a merge. For a more
+ # modern approach use the merge_range() worksheet method instead.
+ # See the merge3.pl - merge6.pl programs.
+ #
+ # reverse('©'), August 2002, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ # Create a new workbook and add a worksheet
+ my $workbook = Spreadsheet::WriteExcel->new("merge1.xls");
+ my $worksheet = $workbook->add_worksheet();
+
+
+ # Increase the cell size of the merged cells to highlight the formatting.
+ $worksheet->set_column('B:D', 20);
+ $worksheet->set_row(2, 30);
+
+
+ # Create a merge format
+ my $format = $workbook->add_format(center_across => 1);
+
+
+ # Only one cell should contain text, the others should be blank.
+ $worksheet->write (2, 1, "Center across selection", $format);
+ $worksheet->write_blank(2, 2, $format);
+ $worksheet->write_blank(2, 3, $format);
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/merge1.pl>
+
+=head2 Example: merge2.pl
+
+
+
+Simple example of merging cells using the Spreadsheet::WriteExcel module
+
+This example merges three cells using the "Centre Across Selection"
+alignment which was the Excel 5 method of achieving a merge. For a more
+modern approach use the merge_range() worksheet method instead.
+See the merge3.pl - merge6.pl programs.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/merge2.jpg" width="640" height="420" alt="Output from merge2.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # Simple example of merging cells using the Spreadsheet::WriteExcel module
+ #
+ # This example merges three cells using the "Centre Across Selection"
+ # alignment which was the Excel 5 method of achieving a merge. For a more
+ # modern approach use the merge_range() worksheet method instead.
+ # See the merge3.pl - merge6.pl programs.
+ #
+ # reverse('©'), August 2002, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ # Create a new workbook and add a worksheet
+ my $workbook = Spreadsheet::WriteExcel->new("merge2.xls");
+ my $worksheet = $workbook->add_worksheet();
+
+
+ # Increase the cell size of the merged cells to highlight the formatting.
+ $worksheet->set_column(1, 2, 30);
+ $worksheet->set_row(2, 40);
+
+
+ # Create a merged format
+ my $format = $workbook->add_format(
+ center_across => 1,
+ bold => 1,
+ size => 15,
+ pattern => 1,
+ border => 6,
+ color => 'white',
+ fg_color => 'green',
+ border_color => 'yellow',
+ align => 'vcenter',
+ );
+
+
+ # Only one cell should contain text, the others should be blank.
+ $worksheet->write (2, 1, "Center across selection", $format);
+ $worksheet->write_blank(2, 2, $format);
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/merge2.pl>
+
+=head2 Example: merge3.pl
+
+
+
+Example of how to use Spreadsheet::WriteExcel to write a hyperlink in a
+merged cell. There are two options write_url_range() with a standard merge
+format or merge_range().
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/merge3.jpg" width="640" height="420" alt="Output from merge3.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # Example of how to use Spreadsheet::WriteExcel to write a hyperlink in a
+ # merged cell. There are two options write_url_range() with a standard merge
+ # format or merge_range().
+ #
+ # reverse('©'), September 2002, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ # Create a new workbook and add a worksheet
+ my $workbook = Spreadsheet::WriteExcel->new('merge3.xls');
+ my $worksheet = $workbook->add_worksheet();
+
+
+ # Increase the cell size of the merged cells to highlight the formatting.
+ $worksheet->set_row($_, 30) for (1, 3, 6, 7);
+ $worksheet->set_column('B:D', 20);
+
+
+ ###############################################################################
+ #
+ # Example 1: Merge cells containing a hyperlink using write_url_range()
+ # and the standard Excel 5+ merge property.
+ #
+ my $format1 = $workbook->add_format(
+ center_across => 1,
+ border => 1,
+ underline => 1,
+ color => 'blue',
+ );
+
+ # Write the cells to be merged
+ $worksheet->write_url_range('B2:D2', 'http://www.perl.com', $format1);
+ $worksheet->write_blank('C2', $format1);
+ $worksheet->write_blank('D2', $format1);
+
+
+
+ ###############################################################################
+ #
+ # Example 2: Merge cells containing a hyperlink using merge_range().
+ #
+ my $format2 = $workbook->add_format(
+ border => 1,
+ underline => 1,
+ color => 'blue',
+ align => 'center',
+ valign => 'vcenter',
+ );
+
+ # Merge 3 cells
+ $worksheet->merge_range('B4:D4', 'http://www.perl.com', $format2);
+
+
+ # Merge 3 cells over two rows
+ $worksheet->merge_range('B7:D8', 'http://www.perl.com', $format2);
+
+
+
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/merge3.pl>
+
+=head2 Example: merge4.pl
+
+
+
+Example of how to use the Spreadsheet::WriteExcel merge_range() workbook
+method with complex formatting.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/merge4.jpg" width="640" height="420" alt="Output from merge4.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # Example of how to use the Spreadsheet::WriteExcel merge_range() workbook
+ # method with complex formatting.
+ #
+ # reverse('©'), September 2002, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ # Create a new workbook and add a worksheet
+ my $workbook = Spreadsheet::WriteExcel->new('merge4.xls');
+ my $worksheet = $workbook->add_worksheet();
+
+
+ # Increase the cell size of the merged cells to highlight the formatting.
+ $worksheet->set_row($_, 30) for (1..11);
+ $worksheet->set_column('B:D', 20);
+
+
+ ###############################################################################
+ #
+ # Example 1: Text centered vertically and horizontally
+ #
+ my $format1 = $workbook->add_format(
+ border => 6,
+ bold => 1,
+ color => 'red',
+ valign => 'vcenter',
+ align => 'center',
+ );
+
+
+
+ $worksheet->merge_range('B2:D3', 'Vertical and horizontal', $format1);
+
+
+ ###############################################################################
+ #
+ # Example 2: Text aligned to the top and left
+ #
+ my $format2 = $workbook->add_format(
+ border => 6,
+ bold => 1,
+ color => 'red',
+ valign => 'top',
+ align => 'left',
+ );
+
+
+
+ $worksheet->merge_range('B5:D6', 'Aligned to the top and left', $format2);
+
+
+ ###############################################################################
+ #
+ # Example 3: Text aligned to the bottom and right
+ #
+ my $format3 = $workbook->add_format(
+ border => 6,
+ bold => 1,
+ color => 'red',
+ valign => 'bottom',
+ align => 'right',
+ );
+
+
+
+ $worksheet->merge_range('B8:D9', 'Aligned to the bottom and right', $format3);
+
+
+ ###############################################################################
+ #
+ # Example 4: Text justified (i.e. wrapped) in the cell
+ #
+ my $format4 = $workbook->add_format(
+ border => 6,
+ bold => 1,
+ color => 'red',
+ valign => 'top',
+ align => 'justify',
+ );
+
+
+
+ $worksheet->merge_range('B11:D12', 'Justified: '.'so on and ' x18, $format4);
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/merge4.pl>
+
+=head2 Example: merge5.pl
+
+
+
+Example of how to use the Spreadsheet::WriteExcel merge_cells() workbook
+method with complex formatting and rotation.
+
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/merge5.jpg" width="640" height="420" alt="Output from merge5.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # Example of how to use the Spreadsheet::WriteExcel merge_cells() workbook
+ # method with complex formatting and rotation.
+ #
+ #
+ # reverse('©'), September 2002, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ # Create a new workbook and add a worksheet
+ my $workbook = Spreadsheet::WriteExcel->new('merge5.xls');
+ my $worksheet = $workbook->add_worksheet();
+
+
+ # Increase the cell size of the merged cells to highlight the formatting.
+ $worksheet->set_row($_, 36) for (3..8);
+ $worksheet->set_column($_, $_ , 15) for (1,3,5);
+
+
+ ###############################################################################
+ #
+ # Rotation 1, letters run from top to bottom
+ #
+ my $format1 = $workbook->add_format(
+ border => 6,
+ bold => 1,
+ color => 'red',
+ valign => 'vcentre',
+ align => 'centre',
+ rotation => 270,
+ );
+
+
+ $worksheet->merge_range('B4:B9', 'Rotation 270', $format1);
+
+
+ ###############################################################################
+ #
+ # Rotation 2, 90° anticlockwise
+ #
+ my $format2 = $workbook->add_format(
+ border => 6,
+ bold => 1,
+ color => 'red',
+ valign => 'vcentre',
+ align => 'centre',
+ rotation => 90,
+ );
+
+
+ $worksheet->merge_range('D4:D9', 'Rotation 90°', $format2);
+
+
+
+ ###############################################################################
+ #
+ # Rotation 3, 90° clockwise
+ #
+ my $format3 = $workbook->add_format(
+ border => 6,
+ bold => 1,
+ color => 'red',
+ valign => 'vcentre',
+ align => 'centre',
+ rotation => -90,
+ );
+
+
+ $worksheet->merge_range('F4:F9', 'Rotation -90°', $format3);
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/merge5.pl>
+
+=head2 Example: merge6.pl
+
+
+
+Example of how to use the Spreadsheet::WriteExcel merge_cells() workbook
+method with Unicode strings.
+
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/merge6.jpg" width="640" height="420" alt="Output from merge6.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # Example of how to use the Spreadsheet::WriteExcel merge_cells() workbook
+ # method with Unicode strings.
+ #
+ #
+ # reverse('©'), December 2005, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ # Create a new workbook and add a worksheet
+ my $workbook = Spreadsheet::WriteExcel->new('merge6.xls');
+ my $worksheet = $workbook->add_worksheet();
+
+
+ # Increase the cell size of the merged cells to highlight the formatting.
+ $worksheet->set_row($_, 36) for 2..9;
+ $worksheet->set_column('B:D', 25);
+
+
+ # Format for the merged cells.
+ my $format = $workbook->add_format(
+ border => 6,
+ bold => 1,
+ color => 'red',
+ size => 20,
+ valign => 'vcentre',
+ align => 'left',
+ indent => 1,
+ );
+
+
+
+
+ ###############################################################################
+ #
+ # Write an Ascii string.
+ #
+
+ $worksheet->merge_range('B3:D4', 'ASCII: A simple string', $format);
+
+
+
+
+ ###############################################################################
+ #
+ # Write a UTF-16 Unicode string.
+ #
+
+ # A phrase in Cyrillic encoded as UTF-16BE.
+ my $utf16_str = pack "H*", '005500540046002d00310036003a0020'.
+ '042d0442043e002004440440043004370430002004'.
+ '3d043000200440044304410441043a043e043c0021';
+
+ # Note the extra parameter at the end to indicate UTF-16 encoding.
+ $worksheet->merge_range('B6:D7', $utf16_str, $format, 1);
+
+
+
+
+ ###############################################################################
+ #
+ # Write a UTF-8 Unicode string.
+ #
+
+ if ($] >= 5.008) {
+ my $smiley = chr 0x263a;
+ $worksheet->merge_range('B9:D10', "UTF-8: A Unicode smiley $smiley",
+ $format);
+ }
+ else {
+ $worksheet->merge_range('B9:D10', "UTF-8: Requires Perl 5.8", $format);
+ }
+
+
+
+
+ __END__
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/merge6.pl>
+
+=head2 Example: mod_perl1.pl
+
+
+
+Example of how to use the Spreadsheet::WriteExcel module to send an Excel
+file to a browser using mod_perl 1 and Apache
+
+This module ties *XLS directly to Apache, and with the correct
+content-disposition/types it will prompt the user to save
+the file, or open it at this location.
+
+This script is a modification of the Spreadsheet::WriteExcel cgi.pl example.
+
+Change the name of this file to Cgi.pm.
+Change the package location to where ever you locate this package.
+In the example below it is located in the WriteExcel directory.
+
+Your httpd.conf entry for this module, should you choose to use it
+as a stand alone app, should look similar to the following:
+
+ <Location /spreadsheet-test>
+ SetHandler perl-script
+ PerlHandler Spreadsheet::WriteExcel::Cgi
+ PerlSendHeader On
+ </Location>
+
+The PerlHandler name above and the package name below *have* to match.
+
+ ###############################################################################
+ #
+ # Example of how to use the Spreadsheet::WriteExcel module to send an Excel
+ # file to a browser using mod_perl 1 and Apache
+ #
+ # This module ties *XLS directly to Apache, and with the correct
+ # content-disposition/types it will prompt the user to save
+ # the file, or open it at this location.
+ #
+ # This script is a modification of the Spreadsheet::WriteExcel cgi.pl example.
+ #
+ # Change the name of this file to Cgi.pm.
+ # Change the package location to where ever you locate this package.
+ # In the example below it is located in the WriteExcel directory.
+ #
+ # Your httpd.conf entry for this module, should you choose to use it
+ # as a stand alone app, should look similar to the following:
+ #
+ # <Location /spreadsheet-test>
+ # SetHandler perl-script
+ # PerlHandler Spreadsheet::WriteExcel::Cgi
+ # PerlSendHeader On
+ # </Location>
+ #
+ # The PerlHandler name above and the package name below *have* to match.
+
+ # Apr 2001, Thomas Sullivan, webmaster@860.org
+ # Feb 2001, John McNamara, jmcnamara@cpan.org
+
+ package Spreadsheet::WriteExcel::Cgi;
+
+ ##########################################
+ # Pragma Definitions
+ ##########################################
+ use strict;
+
+ ##########################################
+ # Required Modules
+ ##########################################
+ use Apache::Constants qw(:common);
+ use Apache::Request;
+ use Apache::URI; # This may not be needed
+ use Spreadsheet::WriteExcel;
+
+ ##########################################
+ # Main App Body
+ ##########################################
+ sub handler {
+ # New apache object
+ # Should you decide to use it.
+ my $r = Apache::Request->new(shift);
+
+ # Set the filename and send the content type
+ # This will appear when they save the spreadsheet
+ my $filename ="cgitest.xls";
+
+ ####################################################
+ ## Send the content type headers
+ ####################################################
+ print "Content-disposition: attachment;filename=$filename\n";
+ print "Content-type: application/vnd.ms-excel\n\n";
+
+ ####################################################
+ # Tie a filehandle to Apache's STDOUT.
+ # Create a new workbook and add a worksheet.
+ ####################################################
+ tie *XLS => 'Apache';
+ binmode(*XLS);
+
+ my $workbook = Spreadsheet::WriteExcel->new(\*XLS);
+ my $worksheet = $workbook->add_worksheet();
+
+
+ # Set the column width for column 1
+ $worksheet->set_column(0, 0, 20);
+
+
+ # Create a format
+ my $format = $workbook->add_format();
+ $format->set_bold();
+ $format->set_size(15);
+ $format->set_color('blue');
+
+
+ # Write to the workbook
+ $worksheet->write(0, 0, "Hi Excel!", $format);
+
+ # You must close the workbook for Content-disposition
+ $workbook->close();
+ }
+
+ 1;
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/mod_perl1.pl>
+
+=head2 Example: mod_perl2.pl
+
+
+
+Example of how to use the Spreadsheet::WriteExcel module to send an Excel
+file to a browser using mod_perl 2 and Apache.
+
+This module ties *XLS directly to Apache, and with the correct
+content-disposition/types it will prompt the user to save
+the file, or open it at this location.
+
+This script is a modification of the Spreadsheet::WriteExcel cgi.pl example.
+
+Change the name of this file to MP2Test.pm.
+Change the package location to where ever you locate this package.
+In the example below it is located in the WriteExcel directory.
+
+Your httpd.conf entry for this module, should you choose to use it
+as a stand alone app, should look similar to the following:
+
+ PerlModule Apache2::RequestRec
+ PerlModule APR::Table
+ PerlModule Apache2::RequestIO
+
+ <Location /spreadsheet-test>
+ SetHandler perl-script
+ PerlResponseHandler Spreadsheet::WriteExcel::MP2Test
+ </Location>
+
+The PerlResponseHandler must match the package name below.
+
+ ###############################################################################
+ #
+ # Example of how to use the Spreadsheet::WriteExcel module to send an Excel
+ # file to a browser using mod_perl 2 and Apache.
+ #
+ # This module ties *XLS directly to Apache, and with the correct
+ # content-disposition/types it will prompt the user to save
+ # the file, or open it at this location.
+ #
+ # This script is a modification of the Spreadsheet::WriteExcel cgi.pl example.
+ #
+ # Change the name of this file to MP2Test.pm.
+ # Change the package location to where ever you locate this package.
+ # In the example below it is located in the WriteExcel directory.
+ #
+ # Your httpd.conf entry for this module, should you choose to use it
+ # as a stand alone app, should look similar to the following:
+ #
+ # PerlModule Apache2::RequestRec
+ # PerlModule APR::Table
+ # PerlModule Apache2::RequestIO
+ #
+ # <Location /spreadsheet-test>
+ # SetHandler perl-script
+ # PerlResponseHandler Spreadsheet::WriteExcel::MP2Test
+ # </Location>
+ #
+ # The PerlResponseHandler must match the package name below.
+
+ # Jun 2004, Matisse Enzer, matisse@matisse.net (mod_perl 2 version)
+ # Apr 2001, Thomas Sullivan, webmaster@860.org
+ # Feb 2001, John McNamara, jmcnamara@cpan.org
+
+ package Spreadsheet::WriteExcel::MP2Test;
+
+ ##########################################
+ # Pragma Definitions
+ ##########################################
+ use strict;
+
+ ##########################################
+ # Required Modules
+ ##########################################
+ use Apache2::Const -compile => qw( :common );
+ use Spreadsheet::WriteExcel;
+
+ ##########################################
+ # Main App Body
+ ##########################################
+ sub handler {
+ my($r) = @_; # Apache request object is passed to handler in mod_perl 2
+
+ # Set the filename and send the content type
+ # This will appear when they save the spreadsheet
+ my $filename ="mod_perl2_test.xls";
+
+ ####################################################
+ ## Send the content type headers the mod_perl 2 way
+ ####################################################
+ $r->headers_out->{'Content-Disposition'} = "attachment;filename=$filename";
+ $r->content_type('application/vnd.ms-excel');
+
+ ####################################################
+ # Tie a filehandle to Apache's STDOUT.
+ # Create a new workbook and add a worksheet.
+ ####################################################
+ tie *XLS => $r; # The mod_perl 2 way. Tie to the Apache::RequestRec object
+ binmode(*XLS);
+
+ my $workbook = Spreadsheet::WriteExcel->new(\*XLS);
+ my $worksheet = $workbook->add_worksheet();
+
+
+ # Set the column width for column 1
+ $worksheet->set_column(0, 0, 20);
+
+
+ # Create a format
+ my $format = $workbook->add_format();
+ $format->set_bold();
+ $format->set_size(15);
+ $format->set_color('blue');
+
+
+ # Write to the workbook
+ $worksheet->write(0, 0, 'Hi Excel! from ' . $r->hostname , $format);
+
+ # You must close the workbook for Content-disposition
+ $workbook->close();
+ return Apache2::Const::OK;
+ }
+
+ 1;
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/mod_perl2.pl>
+
+=head2 Example: outline.pl
+
+
+
+Example of how use Spreadsheet::WriteExcel to generate Excel outlines and
+grouping.
+
+
+Excel allows you to group rows or columns so that they can be hidden or
+displayed with a single mouse click. This feature is referred to as outlines.
+
+Outlines can reduce complex data down to a few salient sub-totals or
+summaries.
+
+This feature is best viewed in Excel but the following is an ASCII
+representation of what a worksheet with three outlines might look like.
+Rows 3-4 and rows 7-8 are grouped at level 2. Rows 2-9 are grouped at
+level 1. The lines at the left hand side are called outline level bars.
+
+
+ ------------------------------------------
+ 1 2 3 | | A | B | C | D | ...
+ ------------------------------------------
+ _ | 1 | A | | | | ...
+ | _ | 2 | B | | | | ...
+ | | | 3 | (C) | | | | ...
+ | | | 4 | (D) | | | | ...
+ | - | 5 | E | | | | ...
+ | _ | 6 | F | | | | ...
+ | | | 7 | (G) | | | | ...
+ | | | 8 | (H) | | | | ...
+ | - | 9 | I | | | | ...
+ - | . | ... | ... | ... | ... | ...
+
+
+Clicking the minus sign on each of the level 2 outlines will collapse and
+hide the data as shown in the next figure. The minus sign changes to a plus
+sign to indicate that the data in the outline is hidden.
+
+ ------------------------------------------
+ 1 2 3 | | A | B | C | D | ...
+ ------------------------------------------
+ _ | 1 | A | | | | ...
+ | | 2 | B | | | | ...
+ | + | 5 | E | | | | ...
+ | | 6 | F | | | | ...
+ | + | 9 | I | | | | ...
+ - | . | ... | ... | ... | ... | ...
+
+
+Clicking on the minus sign on the level 1 outline will collapse the remaining
+rows as follows:
+
+ ------------------------------------------
+ 1 2 3 | | A | B | C | D | ...
+ ------------------------------------------
+ | 1 | A | | | | ...
+ + | . | ... | ... | ... | ... | ...
+
+See the main Spreadsheet::WriteExcel documentation for more information.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/outline.jpg" width="640" height="420" alt="Output from outline.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # Example of how use Spreadsheet::WriteExcel to generate Excel outlines and
+ # grouping.
+ #
+ #
+ # Excel allows you to group rows or columns so that they can be hidden or
+ # displayed with a single mouse click. This feature is referred to as outlines.
+ #
+ # Outlines can reduce complex data down to a few salient sub-totals or
+ # summaries.
+ #
+ # This feature is best viewed in Excel but the following is an ASCII
+ # representation of what a worksheet with three outlines might look like.
+ # Rows 3-4 and rows 7-8 are grouped at level 2. Rows 2-9 are grouped at
+ # level 1. The lines at the left hand side are called outline level bars.
+ #
+ #
+ # ------------------------------------------
+ # 1 2 3 | | A | B | C | D | ...
+ # ------------------------------------------
+ # _ | 1 | A | | | | ...
+ # | _ | 2 | B | | | | ...
+ # | | | 3 | (C) | | | | ...
+ # | | | 4 | (D) | | | | ...
+ # | - | 5 | E | | | | ...
+ # | _ | 6 | F | | | | ...
+ # | | | 7 | (G) | | | | ...
+ # | | | 8 | (H) | | | | ...
+ # | - | 9 | I | | | | ...
+ # - | . | ... | ... | ... | ... | ...
+ #
+ #
+ # Clicking the minus sign on each of the level 2 outlines will collapse and
+ # hide the data as shown in the next figure. The minus sign changes to a plus
+ # sign to indicate that the data in the outline is hidden.
+ #
+ # ------------------------------------------
+ # 1 2 3 | | A | B | C | D | ...
+ # ------------------------------------------
+ # _ | 1 | A | | | | ...
+ # | | 2 | B | | | | ...
+ # | + | 5 | E | | | | ...
+ # | | 6 | F | | | | ...
+ # | + | 9 | I | | | | ...
+ # - | . | ... | ... | ... | ... | ...
+ #
+ #
+ # Clicking on the minus sign on the level 1 outline will collapse the remaining
+ # rows as follows:
+ #
+ # ------------------------------------------
+ # 1 2 3 | | A | B | C | D | ...
+ # ------------------------------------------
+ # | 1 | A | | | | ...
+ # + | . | ... | ... | ... | ... | ...
+ #
+ # See the main Spreadsheet::WriteExcel documentation for more information.
+ #
+ # reverse('©'), April 2003, John McNamara, jmcnamara@cpan.org
+ #
+
+
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ # Create a new workbook and add some worksheets
+ my $workbook = Spreadsheet::WriteExcel->new('outline.xls');
+ my $worksheet1 = $workbook->add_worksheet('Outlined Rows');
+ my $worksheet2 = $workbook->add_worksheet('Collapsed Rows');
+ my $worksheet3 = $workbook->add_worksheet('Outline Columns');
+ my $worksheet4 = $workbook->add_worksheet('Outline levels');
+
+ # Add a general format
+ my $bold = $workbook->add_format(bold => 1);
+
+
+
+ ###############################################################################
+ #
+ # Example 1: Create a worksheet with outlined rows. It also includes SUBTOTAL()
+ # functions so that it looks like the type of automatic outlines that are
+ # generated when you use the Excel Data->SubTotals menu item.
+ #
+
+
+ # For outlines the important parameters are $hidden and $level. Rows with the
+ # same $level are grouped together. The group will be collapsed if $hidden is
+ # non-zero. $height and $XF are assigned default values if they are undef.
+ #
+ # The syntax is: set_row($row, $height, $XF, $hidden, $level, $collapsed)
+ #
+ $worksheet1->set_row(1, undef, undef, 0, 2);
+ $worksheet1->set_row(2, undef, undef, 0, 2);
+ $worksheet1->set_row(3, undef, undef, 0, 2);
+ $worksheet1->set_row(4, undef, undef, 0, 2);
+ $worksheet1->set_row(5, undef, undef, 0, 1);
+
+ $worksheet1->set_row(6, undef, undef, 0, 2);
+ $worksheet1->set_row(7, undef, undef, 0, 2);
+ $worksheet1->set_row(8, undef, undef, 0, 2);
+ $worksheet1->set_row(9, undef, undef, 0, 2);
+ $worksheet1->set_row(10, undef, undef, 0, 1);
+
+
+ # Add a column format for clarity
+ $worksheet1->set_column('A:A', 20);
+
+ # Add the data, labels and formulas
+ $worksheet1->write('A1', 'Region', $bold);
+ $worksheet1->write('A2', 'North');
+ $worksheet1->write('A3', 'North');
+ $worksheet1->write('A4', 'North');
+ $worksheet1->write('A5', 'North');
+ $worksheet1->write('A6', 'North Total', $bold);
+
+ $worksheet1->write('B1', 'Sales', $bold);
+ $worksheet1->write('B2', 1000);
+ $worksheet1->write('B3', 1200);
+ $worksheet1->write('B4', 900);
+ $worksheet1->write('B5', 1200);
+ $worksheet1->write('B6', '=SUBTOTAL(9,B2:B5)', $bold);
+
+ $worksheet1->write('A7', 'South');
+ $worksheet1->write('A8', 'South');
+ $worksheet1->write('A9', 'South');
+ $worksheet1->write('A10', 'South');
+ $worksheet1->write('A11', 'South Total', $bold);
+
+ $worksheet1->write('B7', 400);
+ $worksheet1->write('B8', 600);
+ $worksheet1->write('B9', 500);
+ $worksheet1->write('B10', 600);
+ $worksheet1->write('B11', '=SUBTOTAL(9,B7:B10)', $bold);
+
+ $worksheet1->write('A12', 'Grand Total', $bold);
+ $worksheet1->write('B12', '=SUBTOTAL(9,B2:B10)', $bold);
+
+
+ ###############################################################################
+ #
+ # Example 2: Create a worksheet with outlined rows. This is the same as the
+ # previous example except that the rows are collapsed.
+ # Note: We need to indicate the row that contains the collapsed symbol '+'
+ # with the optional parameter, $collapsed.
+
+ # The group will be collapsed if $hidden is non-zero.
+ # The syntax is: set_row($row, $height, $XF, $hidden, $level, $collapsed)
+ #
+ $worksheet2->set_row(1, undef, undef, 1, 2);
+ $worksheet2->set_row(2, undef, undef, 1, 2);
+ $worksheet2->set_row(3, undef, undef, 1, 2);
+ $worksheet2->set_row(4, undef, undef, 1, 2);
+ $worksheet2->set_row(5, undef, undef, 1, 1);
+
+ $worksheet2->set_row(6, undef, undef, 1, 2);
+ $worksheet2->set_row(7, undef, undef, 1, 2);
+ $worksheet2->set_row(8, undef, undef, 1, 2);
+ $worksheet2->set_row(9, undef, undef, 1, 2);
+ $worksheet2->set_row(10, undef, undef, 1, 1);
+ $worksheet2->set_row(11, undef, undef, 0, 0, 1);
+
+
+ # Add a column format for clarity
+ $worksheet2->set_column('A:A', 20);
+
+ # Add the data, labels and formulas
+ $worksheet2->write('A1', 'Region', $bold);
+ $worksheet2->write('A2', 'North');
+ $worksheet2->write('A3', 'North');
+ $worksheet2->write('A4', 'North');
+ $worksheet2->write('A5', 'North');
+ $worksheet2->write('A6', 'North Total', $bold);
+
+ $worksheet2->write('B1', 'Sales', $bold);
+ $worksheet2->write('B2', 1000);
+ $worksheet2->write('B3', 1200);
+ $worksheet2->write('B4', 900);
+ $worksheet2->write('B5', 1200);
+ $worksheet2->write('B6', '=SUBTOTAL(9,B2:B5)', $bold);
+
+ $worksheet2->write('A7', 'South');
+ $worksheet2->write('A8', 'South');
+ $worksheet2->write('A9', 'South');
+ $worksheet2->write('A10', 'South');
+ $worksheet2->write('A11', 'South Total', $bold);
+
+ $worksheet2->write('B7', 400);
+ $worksheet2->write('B8', 600);
+ $worksheet2->write('B9', 500);
+ $worksheet2->write('B10', 600);
+ $worksheet2->write('B11', '=SUBTOTAL(9,B7:B10)', $bold);
+
+ $worksheet2->write('A12', 'Grand Total', $bold);
+ $worksheet2->write('B12', '=SUBTOTAL(9,B2:B10)', $bold);
+
+
+
+ ###############################################################################
+ #
+ # Example 3: Create a worksheet with outlined columns.
+ #
+ my $data = [
+ ['Month', 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',' Total'],
+ ['North', 50, 20, 15, 25, 65, 80, ,'=SUM(B2:G2)'],
+ ['South', 10, 20, 30, 50, 50, 50, ,'=SUM(B3:G3)'],
+ ['East', 45, 75, 50, 15, 75, 100, ,'=SUM(B4:G4)'],
+ ['West', 15, 15, 55, 35, 20, 50, ,'=SUM(B5:G6)'],
+ ];
+
+ # Add bold format to the first row
+ $worksheet3->set_row(0, undef, $bold);
+
+ # Syntax: set_column($col1, $col2, $width, $XF, $hidden, $level, $collapsed)
+ $worksheet3->set_column('A:A', 10, $bold );
+ $worksheet3->set_column('B:G', 5, undef, 0, 1);
+ $worksheet3->set_column('H:H', 10);
+
+ # Write the data and a formula
+ $worksheet3->write_col('A1', $data);
+ $worksheet3->write('H6', '=SUM(H2:H5)', $bold);
+
+
+
+ ###############################################################################
+ #
+ # Example 4: Show all possible outline levels.
+ #
+ my $levels = ["Level 1", "Level 2", "Level 3", "Level 4",
+ "Level 5", "Level 6", "Level 7", "Level 6",
+ "Level 5", "Level 4", "Level 3", "Level 2", "Level 1"];
+
+
+ $worksheet4->write_col('A1', $levels);
+
+ $worksheet4->set_row(0, undef, undef, undef, 1);
+ $worksheet4->set_row(1, undef, undef, undef, 2);
+ $worksheet4->set_row(2, undef, undef, undef, 3);
+ $worksheet4->set_row(3, undef, undef, undef, 4);
+ $worksheet4->set_row(4, undef, undef, undef, 5);
+ $worksheet4->set_row(5, undef, undef, undef, 6);
+ $worksheet4->set_row(6, undef, undef, undef, 7);
+ $worksheet4->set_row(7, undef, undef, undef, 6);
+ $worksheet4->set_row(8, undef, undef, undef, 5);
+ $worksheet4->set_row(9, undef, undef, undef, 4);
+ $worksheet4->set_row(10, undef, undef, undef, 3);
+ $worksheet4->set_row(11, undef, undef, undef, 2);
+ $worksheet4->set_row(12, undef, undef, undef, 1);
+
+
+
+ __END__
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/outline.pl>
+
+=head2 Example: outline_collapsed.pl
+
+
+
+Example of how use Spreadsheet::WriteExcel to generate Excel outlines and
+grouping.
+
+These example focus mainly on collapsed outlines. See also the
+outlines.pl example program for more general examples.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/outline_collapsed.jpg" width="640" height="420" alt="Output from outline_collapsed.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # Example of how use Spreadsheet::WriteExcel to generate Excel outlines and
+ # grouping.
+ #
+ # These example focus mainly on collapsed outlines. See also the
+ # outlines.pl example program for more general examples.
+ #
+ # reverse('©'), March 2008, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ # Create a new workbook and add some worksheets
+ my $workbook = Spreadsheet::WriteExcel->new('outline_collapsed.xls');
+ my $worksheet1 = $workbook->add_worksheet('Outlined Rows');
+ my $worksheet2 = $workbook->add_worksheet('Collapsed Rows 1');
+ my $worksheet3 = $workbook->add_worksheet('Collapsed Rows 2');
+ my $worksheet4 = $workbook->add_worksheet('Collapsed Rows 3');
+ my $worksheet5 = $workbook->add_worksheet('Outline Columns');
+ my $worksheet6 = $workbook->add_worksheet('Collapsed Columns');
+
+
+ # Add a general format
+ my $bold = $workbook->add_format(bold => 1);
+
+
+ #
+ # This function will generate the same data and sub-totals on each worksheet.
+ #
+ sub create_sub_totals {
+
+ my $worksheet = $_[0];
+
+ # Add a column format for clarity
+ $worksheet->set_column('A:A', 20);
+
+ # Add the data, labels and formulas
+ $worksheet->write('A1', 'Region', $bold);
+ $worksheet->write('A2', 'North');
+ $worksheet->write('A3', 'North');
+ $worksheet->write('A4', 'North');
+ $worksheet->write('A5', 'North');
+ $worksheet->write('A6', 'North Total', $bold);
+
+ $worksheet->write('B1', 'Sales', $bold);
+ $worksheet->write('B2', 1000);
+ $worksheet->write('B3', 1200);
+ $worksheet->write('B4', 900);
+ $worksheet->write('B5', 1200);
+ $worksheet->write('B6', '=SUBTOTAL(9,B2:B5)', $bold);
+
+ $worksheet->write('A7', 'South');
+ $worksheet->write('A8', 'South');
+ $worksheet->write('A9', 'South');
+ $worksheet->write('A10', 'South');
+ $worksheet->write('A11', 'South Total', $bold);
+
+ $worksheet->write('B7', 400);
+ $worksheet->write('B8', 600);
+ $worksheet->write('B9', 500);
+ $worksheet->write('B10', 600);
+ $worksheet->write('B11', '=SUBTOTAL(9,B7:B10)', $bold);
+
+ $worksheet->write('A12', 'Grand Total', $bold);
+ $worksheet->write('B12', '=SUBTOTAL(9,B2:B10)', $bold);
+
+ }
+
+
+ ###############################################################################
+ #
+ # Example 1: Create a worksheet with outlined rows. It also includes SUBTOTAL()
+ # functions so that it looks like the type of automatic outlines that are
+ # generated when you use the Excel Data->SubTotals menu item.
+ #
+
+ # The syntax is: set_row($row, $height, $XF, $hidden, $level, $collapsed)
+ $worksheet1->set_row(1, undef, undef, 0, 2);
+ $worksheet1->set_row(2, undef, undef, 0, 2);
+ $worksheet1->set_row(3, undef, undef, 0, 2);
+ $worksheet1->set_row(4, undef, undef, 0, 2);
+ $worksheet1->set_row(5, undef, undef, 0, 1);
+
+ $worksheet1->set_row(6, undef, undef, 0, 2);
+ $worksheet1->set_row(7, undef, undef, 0, 2);
+ $worksheet1->set_row(8, undef, undef, 0, 2);
+ $worksheet1->set_row(9, undef, undef, 0, 2);
+ $worksheet1->set_row(10, undef, undef, 0, 1);
+
+ # Write the sub-total data that is common to the row examples.
+ create_sub_totals($worksheet1);
+
+
+ ###############################################################################
+ #
+ # Example 2: Create a worksheet with collapsed outlined rows.
+ # This is the same as the example 1 except that the all rows are collapsed.
+ # Note: We need to indicate the row that contains the collapsed symbol '+' with
+ # the optional parameter, $collapsed.
+
+ $worksheet2->set_row(1, undef, undef, 1, 2);
+ $worksheet2->set_row(2, undef, undef, 1, 2);
+ $worksheet2->set_row(3, undef, undef, 1, 2);
+ $worksheet2->set_row(4, undef, undef, 1, 2);
+ $worksheet2->set_row(5, undef, undef, 1, 1);
+
+ $worksheet2->set_row(6, undef, undef, 1, 2);
+ $worksheet2->set_row(7, undef, undef, 1, 2);
+ $worksheet2->set_row(8, undef, undef, 1, 2);
+ $worksheet2->set_row(9, undef, undef, 1, 2);
+ $worksheet2->set_row(10, undef, undef, 1, 1);
+
+ $worksheet2->set_row(11, undef, undef, 0, 0, 1);
+
+ # Write the sub-total data that is common to the row examples.
+ create_sub_totals($worksheet2);
+
+
+ ###############################################################################
+ #
+ # Example 3: Create a worksheet with collapsed outlined rows.
+ # Same as the example 1 except that the two sub-totals are collapsed.
+
+ $worksheet3->set_row(1, undef, undef, 1, 2);
+ $worksheet3->set_row(2, undef, undef, 1, 2);
+ $worksheet3->set_row(3, undef, undef, 1, 2);
+ $worksheet3->set_row(4, undef, undef, 1, 2);
+ $worksheet3->set_row(5, undef, undef, 0, 1, 1);
+
+ $worksheet3->set_row(6, undef, undef, 1, 2);
+ $worksheet3->set_row(7, undef, undef, 1, 2);
+ $worksheet3->set_row(8, undef, undef, 1, 2);
+ $worksheet3->set_row(9, undef, undef, 1, 2);
+ $worksheet3->set_row(10, undef, undef, 0, 1, 1);
+
+
+ # Write the sub-total data that is common to the row examples.
+ create_sub_totals($worksheet3);
+
+
+ ###############################################################################
+ #
+ # Example 4: Create a worksheet with outlined rows.
+ # Same as the example 1 except that the two sub-totals are collapsed.
+
+ $worksheet4->set_row(1, undef, undef, 1, 2);
+ $worksheet4->set_row(2, undef, undef, 1, 2);
+ $worksheet4->set_row(3, undef, undef, 1, 2);
+ $worksheet4->set_row(4, undef, undef, 1, 2);
+ $worksheet4->set_row(5, undef, undef, 1, 1, 1);
+
+ $worksheet4->set_row(6, undef, undef, 1, 2);
+ $worksheet4->set_row(7, undef, undef, 1, 2);
+ $worksheet4->set_row(8, undef, undef, 1, 2);
+ $worksheet4->set_row(9, undef, undef, 1, 2);
+ $worksheet4->set_row(10, undef, undef, 1, 1, 1);
+
+ $worksheet4->set_row(11, undef, undef, 0, 0, 1);
+
+ # Write the sub-total data that is common to the row examples.
+ create_sub_totals($worksheet4);
+
+
+
+ ###############################################################################
+ #
+ # Example 5: Create a worksheet with outlined columns.
+ #
+ my $data = [
+ ['Month', 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',' Total'],
+ ['North', 50, 20, 15, 25, 65, 80, ,'=SUM(B2:G2)'],
+ ['South', 10, 20, 30, 50, 50, 50, ,'=SUM(B3:G3)'],
+ ['East', 45, 75, 50, 15, 75, 100, ,'=SUM(B4:G4)'],
+ ['West', 15, 15, 55, 35, 20, 50, ,'=SUM(B5:G6)'],
+ ];
+
+ # Add bold format to the first row
+ $worksheet5->set_row(0, undef, $bold);
+
+ # Syntax: set_column($col1, $col2, $width, $XF, $hidden, $level, $collapsed)
+ $worksheet5->set_column('A:A', 10, $bold );
+ $worksheet5->set_column('B:G', 5, undef, 0, 1);
+ $worksheet5->set_column('H:H', 10 );
+
+ # Write the data and a formula
+ $worksheet5->write_col('A1', $data);
+ $worksheet5->write('H6', '=SUM(H2:H5)', $bold);
+
+
+ ###############################################################################
+ #
+ # Example 6: Create a worksheet with collapsed outlined columns.
+ # This is the same as the previous example except collapsed columns.
+
+ # Add bold format to the first row
+ $worksheet6->set_row(0, undef, $bold);
+
+ # Syntax: set_column($col1, $col2, $width, $XF, $hidden, $level, $collapsed)
+ $worksheet6->set_column('A:A', 10, $bold );
+ $worksheet6->set_column('B:G', 5, undef, 1, 1 );
+ $worksheet6->set_column('H:H', 10, undef, 0, 0, 1);
+
+ # Write the data and a formula
+ $worksheet6->write_col('A1', $data);
+ $worksheet6->write('H6', '=SUM(H2:H5)', $bold);
+
+
+ __END__
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/outline_collapsed.pl>
+
+=head2 Example: panes.pl
+
+
+
+Example of using the WriteExcel module to create worksheet panes.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/panes.jpg" width="640" height="420" alt="Output from panes.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ #######################################################################
+ #
+ # Example of using the WriteExcel module to create worksheet panes.
+ #
+ # reverse('©'), May 2001, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new("panes.xls");
+
+ my $worksheet1 = $workbook->add_worksheet('Panes 1');
+ my $worksheet2 = $workbook->add_worksheet('Panes 2');
+ my $worksheet3 = $workbook->add_worksheet('Panes 3');
+ my $worksheet4 = $workbook->add_worksheet('Panes 4');
+
+ # Freeze panes
+ $worksheet1->freeze_panes(1, 0); # 1 row
+
+ $worksheet2->freeze_panes(0, 1); # 1 column
+ $worksheet3->freeze_panes(1, 1); # 1 row and column
+
+ # Split panes.
+ # The divisions must be specified in terms of row and column dimensions.
+ # The default row height is 12.75 and the default column width is 8.43
+ #
+ $worksheet4->split_panes(12.75, 8.43, 1, 1); # 1 row and column
+
+
+ #######################################################################
+ #
+ # Set up some formatting and text to highlight the panes
+ #
+
+ my $header = $workbook->add_format();
+ $header->set_color('white');
+ $header->set_align('center');
+ $header->set_align('vcenter');
+ $header->set_pattern();
+ $header->set_fg_color('green');
+
+ my $center = $workbook->add_format();
+ $center->set_align('center');
+
+
+ #######################################################################
+ #
+ # Sheet 1
+ #
+
+ $worksheet1->set_column('A:I', 16);
+ $worksheet1->set_row(0, 20);
+ $worksheet1->set_selection('C3');
+
+ for my $i (0..8){
+ $worksheet1->write(0, $i, 'Scroll down', $header);
+ }
+
+ for my $i (1..100){
+ for my $j (0..8){
+ $worksheet1->write($i, $j, $i+1, $center);
+ }
+ }
+
+
+ #######################################################################
+ #
+ # Sheet 2
+ #
+
+ $worksheet2->set_column('A:A', 16);
+ $worksheet2->set_selection('C3');
+
+ for my $i (0..49){
+ $worksheet2->set_row($i, 15);
+ $worksheet2->write($i, 0, 'Scroll right', $header);
+ }
+
+ for my $i (0..49){
+ for my $j (1..25){
+ $worksheet2->write($i, $j, $j, $center);
+ }
+ }
+
+
+ #######################################################################
+ #
+ # Sheet 3
+ #
+
+ $worksheet3->set_column('A:Z', 16);
+ $worksheet3->set_selection('C3');
+
+ for my $i (1..25){
+ $worksheet3->write(0, $i, 'Scroll down', $header);
+ }
+
+ for my $i (1..49){
+ $worksheet3->write($i, 0, 'Scroll right', $header);
+ }
+
+ for my $i (1..49){
+ for my $j (1..25){
+ $worksheet3->write($i, $j, $j, $center);
+ }
+ }
+
+
+ #######################################################################
+ #
+ # Sheet 4
+ #
+
+ $worksheet4->set_selection('C3');
+
+ for my $i (1..25){
+ $worksheet4->write(0, $i, 'Scroll', $center);
+ }
+
+ for my $i (1..49){
+ $worksheet4->write($i, 0, 'Scroll', $center);
+ }
+
+ for my $i (1..49){
+ for my $j (1..25){
+ $worksheet4->write($i, $j, $j, $center);
+ }
+ }
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/panes.pl>
+
+=head2 Example: properties.pl
+
+
+
+An example of adding document properties to a Spreadsheet::WriteExcel file.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/properties.jpg" width="640" height="420" alt="Output from properties.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ##############################################################################
+ #
+ # An example of adding document properties to a Spreadsheet::WriteExcel file.
+ #
+ # reverse('©'), August 2008, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new('properties.xls');
+ my $worksheet = $workbook->add_worksheet();
+
+
+ $workbook->set_properties(
+ title => 'This is an example spreadsheet',
+ subject => 'With document properties',
+ author => 'John McNamara',
+ manager => 'Dr. Heinz Doofenshmirtz ',
+ company => 'of Wolves',
+ category => 'Example spreadsheets',
+ keywords => 'Sample, Example, Properties',
+ comments => 'Created with Perl and Spreadsheet::WriteExcel',
+ );
+
+
+ $worksheet->set_column('A:A', 50);
+ $worksheet->write('A1', 'Select File->Properties to see the file properties');
+
+
+ __END__
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/properties.pl>
+
+=head2 Example: protection.pl
+
+
+
+Example of cell locking and formula hiding in an Excel worksheet via
+the Spreadsheet::WriteExcel module.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/protection.jpg" width="640" height="420" alt="Output from protection.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ########################################################################
+ #
+ # Example of cell locking and formula hiding in an Excel worksheet via
+ # the Spreadsheet::WriteExcel module.
+ #
+ # reverse('©'), August 2001, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new("protection.xls");
+ my $worksheet = $workbook->add_worksheet();
+
+ # Create some format objects
+ my $locked = $workbook->add_format(locked => 1);
+ my $unlocked = $workbook->add_format(locked => 0);
+ my $hidden = $workbook->add_format(hidden => 1);
+
+ # Format the columns
+ $worksheet->set_column('A:A', 42);
+ $worksheet->set_selection('B3:B3');
+
+ # Protect the worksheet
+ $worksheet->protect();
+
+ # Examples of cell locking and hiding
+ $worksheet->write('A1', 'Cell B1 is locked. It cannot be edited.');
+ $worksheet->write('B1', '=1+2', $locked);
+
+ $worksheet->write('A2', 'Cell B2 is unlocked. It can be edited.');
+ $worksheet->write('B2', '=1+2', $unlocked);
+
+ $worksheet->write('A3', "Cell B3 is hidden. The formula isn't visible.");
+ $worksheet->write('B3', '=1+2', $hidden);
+
+ $worksheet->write('A5', 'Use Menu->Tools->Protection->Unprotect Sheet');
+ $worksheet->write('A6', 'to remove the worksheet protection. ');
+
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/protection.pl>
+
+=head2 Example: repeat.pl
+
+
+
+Example of writing repeated formulas.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/repeat.jpg" width="640" height="420" alt="Output from repeat.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ######################################################################
+ #
+ # Example of writing repeated formulas.
+ #
+ # reverse('©'), August 2002, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new("repeat.xls");
+ my $worksheet = $workbook->add_worksheet();
+
+
+ my $limit = 1000;
+
+ # Write a column of numbers
+ for my $row (0..$limit) {
+ $worksheet->write($row, 0, $row);
+ }
+
+
+ # Store a formula
+ my $formula = $worksheet->store_formula('=A1*5+4');
+
+
+ # Write a column of formulas based on the stored formula
+ for my $row (0..$limit) {
+ $worksheet->repeat_formula($row, 1, $formula, undef,
+ qr/^A1$/, 'A'.($row+1));
+ }
+
+
+ # Direct formula writing. As a speed comparison uncomment the
+ # following and run the program again
+
+ #for my $row (0..$limit) {
+ # $worksheet->write_formula($row, 2, '=A'.($row+1).'*5+4');
+ #}
+
+
+
+ __END__
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/repeat.pl>
+
+=head2 Example: right_to_left.pl
+
+
+
+Example of how to change the default worksheet direction from
+left-to-right to right-to-left as required by some eastern verions
+of Excel.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/right_to_left.jpg" width="640" height="420" alt="Output from right_to_left.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ #######################################################################
+ #
+ # Example of how to change the default worksheet direction from
+ # left-to-right to right-to-left as required by some eastern verions
+ # of Excel.
+ #
+ # reverse('©'), January 2006, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new("right_to_left.xls");
+ my $worksheet1 = $workbook->add_worksheet();
+ my $worksheet2 = $workbook->add_worksheet();
+
+ $worksheet2->right_to_left();
+
+ $worksheet1->write(0, 0, 'Hello'); # A1, B1, C1, ...
+ $worksheet2->write(0, 0, 'Hello'); # ..., C1, B1, A1
+
+
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/right_to_left.pl>
+
+=head2 Example: row_wrap.pl
+
+
+
+Demonstrates how to wrap data from one worksheet onto another.
+
+Excel has a row limit of 65536 rows. Sometimes the amount of row data to be
+written to a file is greater than this limit. In this case it is a useful
+technique to wrap the data from one worksheet onto the next so that we get
+something like the following:
+
+ Sheet1 Row 1 - 65536
+ Sheet2 Row 65537 - 131072
+ Sheet3 Row 131073 - ...
+
+In order to achieve this we use a single worksheet reference and
+reinitialise it to point to a new worksheet when required.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/row_wrap.jpg" width="640" height="420" alt="Output from row_wrap.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ##############################################################################
+ #
+ # Demonstrates how to wrap data from one worksheet onto another.
+ #
+ # Excel has a row limit of 65536 rows. Sometimes the amount of row data to be
+ # written to a file is greater than this limit. In this case it is a useful
+ # technique to wrap the data from one worksheet onto the next so that we get
+ # something like the following:
+ #
+ # Sheet1 Row 1 - 65536
+ # Sheet2 Row 65537 - 131072
+ # Sheet3 Row 131073 - ...
+ #
+ # In order to achieve this we use a single worksheet reference and
+ # reinitialise it to point to a new worksheet when required.
+ #
+ # reverse('©'), May 2006, John McNamara, jmcnamara@cpan.org
+ #
+
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ my $workbook = Spreadsheet::WriteExcel->new('row_wrap.xls');
+ my $worksheet = $workbook->add_worksheet();
+
+
+ # Worksheet formatting.
+ $worksheet->set_column('A:A', 20);
+
+
+ # For the sake of this example we will use a small row limit. In order to use
+ # the entire row range set the $row_limit to 65536.
+ my $row_limit = 10;
+ my $row = 0;
+
+ for my $count (1 .. 2 * $row_limit +10) {
+
+ # When we hit the row limit we redirect the output
+ # to a new worksheet and reset the row number.
+ if ($row == $row_limit) {
+ $worksheet = $workbook->add_worksheet();
+ $row = 0;
+
+ # Repeat any worksheet formatting.
+ $worksheet->set_column('A:A', 20);
+ }
+
+ $worksheet->write($row, 0, "This is row $count");
+ $row++;
+ }
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/row_wrap.pl>
+
+=head2 Example: sales.pl
+
+
+
+Example of a sales worksheet to demonstrate several different features.
+Also uses functions from the L<Spreadsheet::WriteExcel::Utility> module.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/sales.jpg" width="640" height="420" alt="Output from sales.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # Example of a sales worksheet to demonstrate several different features.
+ # Also uses functions from the L<Spreadsheet::WriteExcel::Utility> module.
+ #
+ # reverse('©'), October 2001, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+ use Spreadsheet::WriteExcel::Utility;
+
+ # Create a new workbook and add a worksheet
+ my $workbook = Spreadsheet::WriteExcel->new("sales.xls");
+ my $worksheet = $workbook->add_worksheet('May Sales');
+
+
+ # Set up some formats
+ my %heading = (
+ bold => 1,
+ pattern => 1,
+ fg_color => 19,
+ border => 1,
+ align => 'center',
+ );
+
+ my %total = (
+ bold => 1,
+ top => 1,
+ num_format => '$#,##0.00'
+ );
+
+ my $heading = $workbook->add_format(%heading);
+ my $total_format = $workbook->add_format(%total);
+ my $price_format = $workbook->add_format(num_format => '$#,##0.00');
+ my $date_format = $workbook->add_format(num_format => 'mmm d yyy');
+
+
+ # Write the main headings
+ $worksheet->freeze_panes(1); # Freeze the first row
+ $worksheet->write('A1', 'Item', $heading);
+ $worksheet->write('B1', 'Quantity', $heading);
+ $worksheet->write('C1', 'Price', $heading);
+ $worksheet->write('D1', 'Total', $heading);
+ $worksheet->write('E1', 'Date', $heading);
+
+ # Set the column widths
+ $worksheet->set_column('A:A', 25);
+ $worksheet->set_column('B:B', 10);
+ $worksheet->set_column('C:E', 16);
+
+
+ # Extract the sales data from the __DATA__ section at the end of the file.
+ # In reality this information would probably come from a database
+ my @sales;
+
+ foreach my $line (<DATA>) {
+ chomp $line;
+ next if $line eq '';
+ # Simple-minded processing of CSV data. Refer to the Text::CSV_XS
+ # and Text::xSV modules for a more complete CSV handling.
+ my @items = split /,/, $line;
+ push @sales, \@items;
+ }
+
+
+ # Write out the items from each row
+ my $row = 1;
+ foreach my $sale (@sales) {
+
+ $worksheet->write($row, 0, @$sale[0]);
+ $worksheet->write($row, 1, @$sale[1]);
+ $worksheet->write($row, 2, @$sale[2], $price_format);
+
+ # Create a formula like '=B2*C2'
+ my $formula = '='
+ . xl_rowcol_to_cell($row, 1)
+ . "*"
+ . xl_rowcol_to_cell($row, 2);
+
+ $worksheet->write($row, 3, $formula, $price_format);
+
+ # Parse the date
+ my $date = xl_decode_date_US(@$sale[3]);
+ $worksheet->write($row, 4, $date, $date_format);
+ $row++;
+ }
+
+ # Create a formula to sum the totals, like '=SUM(D2:D6)'
+ my $total = '=SUM(D2:'
+ . xl_rowcol_to_cell($row-1, 3)
+ . ")";
+
+ $worksheet->write($row, 3, $total, $total_format);
+
+
+
+ __DATA__
+ 586 card,20,125.50,5/12/01
+ Flat Screen Monitor,1,1300.00,5/12/01
+ 64 MB dimms,45,49.99,5/13/01
+ 15 GB HD,12,300.00,5/13/01
+ Speakers (pair),5,15.50,5/14/01
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/sales.pl>
+
+=head2 Example: sendmail.pl
+
+
+
+Example of how to use Mail::Sender to send a Spreadsheet::WriteExcel Excel
+file as an attachment.
+
+The main thing is to ensure that you close() the Worbook before you send it.
+
+See the L<Mail::Sender> module for further details.
+
+
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # Example of how to use Mail::Sender to send a Spreadsheet::WriteExcel Excel
+ # file as an attachment.
+ #
+ # The main thing is to ensure that you close() the Worbook before you send it.
+ #
+ # See the L<Mail::Sender> module for further details.
+ #
+ # reverse('©'), August 2002, John McNamara, jmcnamara@cpan.org
+ #
+
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+ use Mail::Sender;
+
+ # Create an Excel file
+ my $workbook = Spreadsheet::WriteExcel->new("sendmail.xls");
+ my $worksheet = $workbook->add_worksheet;
+
+ $worksheet->write('A1', "Hello World!");
+
+ $workbook->close(); # Must close before sending
+
+
+
+ # Send the file. Change all variables to suit
+ my $sender = new Mail::Sender
+ {
+ smtp => '123.123.123.123',
+ from => 'Someone'
+ };
+
+ $sender->MailFile(
+ {
+ to => 'another@mail.com',
+ subject => 'Excel file',
+ msg => "Here is the data.\n",
+ file => 'mail.xls',
+ });
+
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/sendmail.pl>
+
+=head2 Example: stats_ext.pl
+
+
+
+Example of formatting using the Spreadsheet::WriteExcel module
+
+This is a simple example of how to use functions that reference cells in
+other worksheets within the same workbook.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/stats_ext.jpg" width="640" height="420" alt="Output from stats_ext.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # Example of formatting using the Spreadsheet::WriteExcel module
+ #
+ # This is a simple example of how to use functions that reference cells in
+ # other worksheets within the same workbook.
+ #
+ # reverse('©'), March 2001, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ # Create a new workbook and add a worksheet
+ my $workbook = Spreadsheet::WriteExcel->new("stats_ext.xls");
+ my $worksheet1 = $workbook->add_worksheet('Test results');
+ my $worksheet2 = $workbook->add_worksheet('Data');
+
+ # Set the column width for columns 1
+ $worksheet1->set_column('A:A', 20);
+
+
+ # Create a format for the headings
+ my $heading = $workbook->add_format();
+ $heading->set_bold();
+
+ # Create a numerical format
+ my $numformat = $workbook->add_format();
+ $numformat->set_num_format('0.00');
+
+
+
+
+ # Write some statistical functions
+ $worksheet1->write('A1', 'Count', $heading);
+ $worksheet1->write('B1', '=COUNT(Data!B2:B9)');
+
+ $worksheet1->write('A2', 'Sum', $heading);
+ $worksheet1->write('B2', '=SUM(Data!B2:B9)');
+
+ $worksheet1->write('A3', 'Average', $heading);
+ $worksheet1->write('B3', '=AVERAGE(Data!B2:B9)');
+
+ $worksheet1->write('A4', 'Min', $heading);
+ $worksheet1->write('B4', '=MIN(Data!B2:B9)');
+
+ $worksheet1->write('A5', 'Max', $heading);
+ $worksheet1->write('B5', '=MAX(Data!B2:B9)');
+
+ $worksheet1->write('A6', 'Standard Deviation', $heading);
+ $worksheet1->write('B6', '=STDEV(Data!B2:B9)');
+
+ $worksheet1->write('A7', 'Kurtosis', $heading);
+ $worksheet1->write('B7', '=KURT(Data!B2:B9)');
+
+
+ # Write the sample data
+ $worksheet2->write('A1', 'Sample', $heading);
+ $worksheet2->write('A2', 1);
+ $worksheet2->write('A3', 2);
+ $worksheet2->write('A4', 3);
+ $worksheet2->write('A5', 4);
+ $worksheet2->write('A6', 5);
+ $worksheet2->write('A7', 6);
+ $worksheet2->write('A8', 7);
+ $worksheet2->write('A9', 8);
+
+ $worksheet2->write('B1', 'Length', $heading);
+ $worksheet2->write('B2', 25.4, $numformat);
+ $worksheet2->write('B3', 25.4, $numformat);
+ $worksheet2->write('B4', 24.8, $numformat);
+ $worksheet2->write('B5', 25.0, $numformat);
+ $worksheet2->write('B6', 25.3, $numformat);
+ $worksheet2->write('B7', 24.9, $numformat);
+ $worksheet2->write('B8', 25.2, $numformat);
+ $worksheet2->write('B9', 24.8, $numformat);
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/stats_ext.pl>
+
+=head2 Example: stocks.pl
+
+
+
+Example of formatting using the Spreadsheet::WriteExcel module
+
+This example shows how to use a conditional numerical format
+with colours to indicate if a share price has gone up or down.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/stocks.jpg" width="640" height="420" alt="Output from stocks.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # Example of formatting using the Spreadsheet::WriteExcel module
+ #
+ # This example shows how to use a conditional numerical format
+ # with colours to indicate if a share price has gone up or down.
+ #
+ # reverse('©'), March 2001, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ # Create a new workbook and add a worksheet
+ my $workbook = Spreadsheet::WriteExcel->new("stocks.xls");
+ my $worksheet = $workbook->add_worksheet();
+
+ # Set the column width for columns 1, 2, 3 and 4
+ $worksheet->set_column(0, 3, 15);
+
+
+ # Create a format for the column headings
+ my $header = $workbook->add_format();
+ $header->set_bold();
+ $header->set_size(12);
+ $header->set_color('blue');
+
+
+ # Create a format for the stock price
+ my $f_price = $workbook->add_format();
+ $f_price->set_align('left');
+ $f_price->set_num_format('$0.00');
+
+
+ # Create a format for the stock volume
+ my $f_volume = $workbook->add_format();
+ $f_volume->set_align('left');
+ $f_volume->set_num_format('#,##0');
+
+
+ # Create a format for the price change. This is an example of a conditional
+ # format. The number is formatted as a percentage. If it is positive it is
+ # formatted in green, if it is negative it is formatted in red and if it is
+ # zero it is formatted as the default font colour (in this case black).
+ # Note: the [Green] format produces an unappealing lime green. Try
+ # [Color 10] instead for a dark green.
+ #
+ my $f_change = $workbook->add_format();
+ $f_change->set_align('left');
+ $f_change->set_num_format('[Green]0.0%;[Red]-0.0%;0.0%');
+
+
+ # Write out the data
+ $worksheet->write(0, 0, 'Company', $header);
+ $worksheet->write(0, 1, 'Price', $header);
+ $worksheet->write(0, 2, 'Volume', $header);
+ $worksheet->write(0, 3, 'Change', $header);
+
+ $worksheet->write(1, 0, 'Damage Inc.' );
+ $worksheet->write(1, 1, 30.25, $f_price); # $30.25
+ $worksheet->write(1, 2, 1234567, $f_volume); # 1,234,567
+ $worksheet->write(1, 3, 0.085, $f_change); # 8.5% in green
+
+ $worksheet->write(2, 0, 'Dump Corp.' );
+ $worksheet->write(2, 1, 1.56, $f_price); # $1.56
+ $worksheet->write(2, 2, 7564, $f_volume); # 7,564
+ $worksheet->write(2, 3, -0.015, $f_change); # -1.5% in red
+
+ $worksheet->write(3, 0, 'Rev Ltd.' );
+ $worksheet->write(3, 1, 0.13, $f_price); # $0.13
+ $worksheet->write(3, 2, 321, $f_volume); # 321
+ $worksheet->write(3, 3, 0, $f_change); # 0 in the font color (black)
+
+
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/stocks.pl>
+
+=head2 Example: tab_colors.pl
+
+
+
+Example of how to set Excel worksheet tab colours.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/tab_colors.jpg" width="640" height="420" alt="Output from tab_colors.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ #######################################################################
+ #
+ # Example of how to set Excel worksheet tab colours.
+ #
+ # reverse('©'), May 2006, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+
+ my $workbook = Spreadsheet::WriteExcel->new('tab_colors.xls');
+
+ my $worksheet1 = $workbook->add_worksheet();
+ my $worksheet2 = $workbook->add_worksheet();
+ my $worksheet3 = $workbook->add_worksheet();
+ my $worksheet4 = $workbook->add_worksheet();
+
+ # Worksheet1 will have the default tab colour.
+ $worksheet2->set_tab_color('red');
+ $worksheet3->set_tab_color('green');
+ $worksheet4->set_tab_color(0x35); # Orange
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/tab_colors.pl>
+
+=head2 Example: textwrap.pl
+
+
+
+Example of formatting using the Spreadsheet::WriteExcel module
+
+This example shows how to wrap text in a cell. There are two alternatives,
+vertical justification and text wrap.
+
+With vertical justification the text is wrapped automatically to fit the
+column width. With text wrap you must specify a newline with an embedded \n.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/textwrap.jpg" width="640" height="420" alt="Output from textwrap.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # Example of formatting using the Spreadsheet::WriteExcel module
+ #
+ # This example shows how to wrap text in a cell. There are two alternatives,
+ # vertical justification and text wrap.
+ #
+ # With vertical justification the text is wrapped automatically to fit the
+ # column width. With text wrap you must specify a newline with an embedded \n.
+ #
+ # reverse('©'), March 2001, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ # Create a new workbook and add a worksheet
+ my $workbook = Spreadsheet::WriteExcel->new("textwrap.xls");
+ my $worksheet = $workbook->add_worksheet();
+
+ # Set the column width for columns 1, 2 and 3
+ $worksheet->set_column(1, 1, 24);
+ $worksheet->set_column(2, 2, 34);
+ $worksheet->set_column(3, 3, 34);
+
+ # Set the row height for rows 1, 4, and 6. The height of row 2 will adjust
+ # automatically to fit the text.
+ #
+ $worksheet->set_row(0, 30);
+ $worksheet->set_row(3, 40);
+ $worksheet->set_row(5, 80);
+
+
+ # No newlines
+ my $str1 = "For whatever we lose (like a you or a me) ";
+ $str1 .= "it's always ourselves we find in the sea";
+
+ # Embedded newlines
+ my $str2 = "For whatever we lose\n(like a you or a me)\n";
+ $str2 .= "it's always ourselves\nwe find in the sea";
+
+
+ # Create a format for the column headings
+ my $header = $workbook->add_format();
+ $header->set_bold();
+ $header->set_font("Courier New");
+ $header->set_align('center');
+ $header->set_align('vcenter');
+
+ # Create a "vertical justification" format
+ my $format1 = $workbook->add_format();
+ $format1->set_align('vjustify');
+
+ # Create a "text wrap" format
+ my $format2 = $workbook->add_format();
+ $format2->set_text_wrap();
+
+ # Write the headers
+ $worksheet->write(0, 1, "set_align('vjustify')", $header);
+ $worksheet->write(0, 2, "set_align('vjustify')", $header);
+ $worksheet->write(0, 3, "set_text_wrap()", $header);
+
+ # Write some examples
+ $worksheet->write(1, 1, $str1, $format1);
+ $worksheet->write(1, 2, $str1, $format1);
+ $worksheet->write(1, 3, $str2, $format2);
+
+ $worksheet->write(3, 1, $str1, $format1);
+ $worksheet->write(3, 2, $str1, $format1);
+ $worksheet->write(3, 3, $str2, $format2);
+
+ $worksheet->write(5, 1, $str1, $format1);
+ $worksheet->write(5, 2, $str1, $format1);
+ $worksheet->write(5, 3, $str2, $format2);
+
+
+
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/textwrap.pl>
+
+=head2 Example: win32ole.pl
+
+
+
+This is a simple example of how to create an Excel file using the
+Win32::OLE module for the sake of comparison.
+
+
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # This is a simple example of how to create an Excel file using the
+ # Win32::OLE module for the sake of comparison.
+ #
+ # reverse('©'), March 2001, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Cwd;
+ use Win32::OLE;
+ use Win32::OLE::Const 'Microsoft Excel';
+
+
+ my $application = Win32::OLE->new("Excel.Application");
+ my $workbook = $application->Workbooks->Add;
+ my $worksheet = $workbook->Worksheets(1);
+
+ $worksheet->Cells(1,1)->{Value} = "Hello World";
+ $worksheet->Cells(2,1)->{Value} = "One";
+ $worksheet->Cells(3,1)->{Value} = "Two";
+ $worksheet->Cells(4,1)->{Value} = 3;
+ $worksheet->Cells(5,1)->{Value} = 4.0000001;
+
+ # Add some formatting
+ $worksheet->Cells(1,1)->Font->{Bold} = "True";
+ $worksheet->Cells(1,1)->Font->{Size} = 16;
+ $worksheet->Cells(1,1)->Font->{ColorIndex} = 3;
+ $worksheet->Columns("A:A")->{ColumnWidth} = 25;
+
+ # Write a hyperlink
+ my $range = $worksheet->Range("A7:A7");
+ $worksheet->Hyperlinks->Add({ Anchor => $range, Address => "http://www.perl.com/"});
+
+ # Get current directory using Cwd.pm
+ my $dir = cwd();
+
+ $workbook->SaveAs({
+ FileName => $dir . '/win32ole.xls',
+ FileFormat => xlNormal,
+ });
+ $workbook->Close;
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/win32ole.pl>
+
+=head2 Example: write_arrays.pl
+
+
+
+Example of how to use the Spreadsheet::WriteExcel module to
+write 1D and 2D arrays of data.
+
+To find out more about array references refer(!!) to the perlref and
+perlreftut manpages. To find out more about 2D arrays or "list of
+lists" refer to the perllol manpage.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/write_arrays.jpg" width="640" height="420" alt="Output from write_arrays.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ #######################################################################
+ #
+ # Example of how to use the Spreadsheet::WriteExcel module to
+ # write 1D and 2D arrays of data.
+ #
+ # To find out more about array references refer(!!) to the perlref and
+ # perlreftut manpages. To find out more about 2D arrays or "list of
+ # lists" refer to the perllol manpage.
+ #
+ # reverse('©'), March 2002, John McNamara, jmcnamara@cpan.org
+ #
+
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+
+ my $workbook = Spreadsheet::WriteExcel->new("write_arrays.xls");
+ my $worksheet1 = $workbook->add_worksheet('Example 1');
+ my $worksheet2 = $workbook->add_worksheet('Example 2');
+ my $worksheet3 = $workbook->add_worksheet('Example 3');
+ my $worksheet4 = $workbook->add_worksheet('Example 4');
+ my $worksheet5 = $workbook->add_worksheet('Example 5');
+ my $worksheet6 = $workbook->add_worksheet('Example 6');
+ my $worksheet7 = $workbook->add_worksheet('Example 7');
+ my $worksheet8 = $workbook->add_worksheet('Example 8');
+
+ my $format = $workbook->add_format(color => 'red', bold => 1);
+
+
+ # Data arrays used in the following examples.
+ # undef values are written as blank cells (with format if specified).
+ #
+ my @array = ( 'one', 'two', undef, 'four' );
+
+ my @array2d = (
+ ['maggie', 'milly', 'molly', 'may' ],
+ [13, 14, 15, 16 ],
+ ['shell', 'star', 'crab', 'stone'],
+ );
+
+
+ # 1. Write a row of data using an array reference.
+ $worksheet1->write('A1', \@array);
+
+ # 2. Same as 1. above using an anonymous array ref.
+ $worksheet2->write('A1', [ @array ]);
+
+ # 3. Write a row of data using an explicit write_row() method call.
+ # This is the same as calling write() in Ex. 1 above.
+ #
+ $worksheet3->write_row('A1', \@array);
+
+ # 4. Write a column of data using the write_col() method call.
+ $worksheet4->write_col('A1', \@array);
+
+ # 5. Write a column of data using a ref to an array ref, i.e. a 2D array.
+ $worksheet5->write('A1', [ \@array ]);
+
+ # 6. Write a 2D array in col-row order.
+ $worksheet6->write('A1', \@array2d);
+
+ # 7. Write a 2D array in row-col order.
+ $worksheet7->write_col('A1', \@array2d);
+
+ # 8. Write a row of data with formatting. The blank cell is also formatted.
+ $worksheet8->write('A1', \@array, $format);
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/write_arrays.pl>
+
+=head2 Example: write_handler1.pl
+
+
+
+Example of how to add a user defined data handler to the Spreadsheet::
+WriteExcel write() method.
+
+The following example shows how to add a handler for a 7 digit ID number.
+
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/write_handler1.jpg" width="640" height="420" alt="Output from write_handler1.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # Example of how to add a user defined data handler to the Spreadsheet::
+ # WriteExcel write() method.
+ #
+ # The following example shows how to add a handler for a 7 digit ID number.
+ #
+ #
+ # reverse('©'), September 2004, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+
+ my $workbook = Spreadsheet::WriteExcel->new("write_handler1.xls");
+ my $worksheet = $workbook->add_worksheet();
+
+
+ ###############################################################################
+ #
+ # Add a handler for 7 digit id numbers. This is useful when you want a string
+ # such as 0000001 written as a string instead of a number and thus preserve
+ # the leading zeroes.
+ #
+ # Note: you can get the same effect using the keep_leading_zeros() method but
+ # this serves as a simple example.
+ #
+ $worksheet->add_write_handler(qr[^\d{7}$], \&write_my_id);
+
+
+ ###############################################################################
+ #
+ # The following function processes the data when a match is found.
+ #
+ sub write_my_id {
+
+ my $worksheet = shift;
+
+ return $worksheet->write_string(@_);
+ }
+
+
+ # This format maintains the cell as text even if it is edited.
+ my $id_format = $workbook->add_format(num_format => '@');
+
+
+ # Write some numbers in the user defined format
+ $worksheet->write('A1', '0000000', $id_format);
+ $worksheet->write('A2', '0000001', $id_format);
+ $worksheet->write('A3', '0004000', $id_format);
+ $worksheet->write('A4', '1234567', $id_format);
+
+ # Write some numbers that don't match the defined format
+ $worksheet->write('A6', '000000', $id_format);
+ $worksheet->write('A7', '000001', $id_format);
+ $worksheet->write('A8', '004000', $id_format);
+ $worksheet->write('A9', '123456', $id_format);
+
+
+ __END__
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/write_handler1.pl>
+
+=head2 Example: write_handler2.pl
+
+
+
+Example of how to add a user defined data handler to the Spreadsheet::
+WriteExcel write() method.
+
+The following example shows how to add a handler for a 7 digit ID number.
+It adds an additional constraint to the write_handler1.pl in that it only
+filters data that isn't in the third column.
+
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/write_handler2.jpg" width="640" height="420" alt="Output from write_handler2.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # Example of how to add a user defined data handler to the Spreadsheet::
+ # WriteExcel write() method.
+ #
+ # The following example shows how to add a handler for a 7 digit ID number.
+ # It adds an additional constraint to the write_handler1.pl in that it only
+ # filters data that isn't in the third column.
+ #
+ #
+ # reverse('©'), September 2004, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+
+ my $workbook = Spreadsheet::WriteExcel->new("write_handler2.xls");
+ my $worksheet = $workbook->add_worksheet();
+
+
+ ###############################################################################
+ #
+ # Add a handler for 7 digit id numbers. This is useful when you want a string
+ # such as 0000001 written as a string instead of a number and thus preserve
+ # the leading zeroes.
+ #
+ # Note: you can get the same effect using the keep_leading_zeros() method but
+ # this serves as a simple example.
+ #
+ $worksheet->add_write_handler(qr[^\d{7}$], \&write_my_id);
+
+
+ ###############################################################################
+ #
+ # The following function processes the data when a match is found. The handler
+ # is set up so that it only filters data if it is in the third column.
+ #
+ sub write_my_id {
+
+ my $worksheet = shift;
+ my $col = $_[1];
+
+ # col is zero based
+ if ($col != 2) {
+ return $worksheet->write_string(@_);
+ }
+ else {
+ # Reject the match and return control to write()
+ return undef;
+ }
+
+ }
+
+
+ # This format maintains the cell as text even if it is edited.
+ my $id_format = $workbook->add_format(num_format => '@');
+
+
+ # Write some numbers in the user defined format
+ $worksheet->write('A1', '0000000', $id_format);
+ $worksheet->write('B1', '0000001', $id_format);
+ $worksheet->write('C1', '0000002', $id_format);
+ $worksheet->write('D1', '0000003', $id_format);
+
+
+
+ __END__
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/write_handler2.pl>
+
+=head2 Example: write_handler3.pl
+
+
+
+Example of how to add a user defined data handler to the Spreadsheet::
+WriteExcel write() method.
+
+The following example shows how to add a handler for dates in a specific
+format.
+
+See write_handler4.pl for a more rigorous example with error handling.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/write_handler3.jpg" width="640" height="420" alt="Output from write_handler3.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # Example of how to add a user defined data handler to the Spreadsheet::
+ # WriteExcel write() method.
+ #
+ # The following example shows how to add a handler for dates in a specific
+ # format.
+ #
+ # See write_handler4.pl for a more rigorous example with error handling.
+ #
+ # reverse('©'), September 2004, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+
+ my $workbook = Spreadsheet::WriteExcel->new("write_handler3.xls");
+ my $worksheet = $workbook->add_worksheet();
+ my $date_format = $workbook->add_format(num_format => 'dd/mm/yy');
+
+
+ ###############################################################################
+ #
+ # Add a handler to match dates in the following format: d/m/yyyy
+ #
+ # The day and month can be single or double digits.
+ #
+ $worksheet->add_write_handler(qr[^\d{1,2}/\d{1,2}/\d{4}$], \&write_my_date);
+
+
+ ###############################################################################
+ #
+ # The following function processes the data when a match is found.
+ # See write_handler4.pl for a more rigorous example with error handling.
+ #
+ sub write_my_date {
+
+ my $worksheet = shift;
+ my @args = @_;
+
+ my $token = $args[2];
+ $token =~ qr[^(\d{1,2})/(\d{1,2})/(\d{4})$];
+
+ # Change to the date format required by write_date_time().
+ my $date = sprintf "%4d-%02d-%02dT", $3, $2, $1;
+
+ $args[2] = $date;
+
+ return $worksheet->write_date_time(@args);
+ }
+
+
+ # Write some dates in the user defined format
+ $worksheet->write('A1', '22/12/2004', $date_format);
+ $worksheet->write('A2', '1/1/1995', $date_format);
+ $worksheet->write('A3', '01/01/1995', $date_format);
+
+
+
+ __END__
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/write_handler3.pl>
+
+=head2 Example: write_handler4.pl
+
+
+
+Example of how to add a user defined data handler to the Spreadsheet::
+WriteExcel write() method.
+
+The following example shows how to add a handler for dates in a specific
+format.
+
+This is a more rigorous version of write_handler3.pl.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/write_handler4.jpg" width="640" height="420" alt="Output from write_handler4.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # Example of how to add a user defined data handler to the Spreadsheet::
+ # WriteExcel write() method.
+ #
+ # The following example shows how to add a handler for dates in a specific
+ # format.
+ #
+ # This is a more rigorous version of write_handler3.pl.
+ #
+ # reverse('©'), September 2004, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+
+ my $workbook = Spreadsheet::WriteExcel->new("write_handler4.xls");
+ my $worksheet = $workbook->add_worksheet();
+ my $date_format = $workbook->add_format(num_format => 'dd/mm/yy');
+
+
+ ###############################################################################
+ #
+ # Add a handler to match dates in the following formats: d/m/yy, d/m/yyyy
+ #
+ # The day and month can be single or double digits and the year can be 2 or 4
+ # digits.
+ #
+ $worksheet->add_write_handler(qr[^\d{1,2}/\d{1,2}/\d{2,4}$], \&write_my_date);
+
+
+ ###############################################################################
+ #
+ # The following function processes the data when a match is found.
+ #
+ sub write_my_date {
+
+ my $worksheet = shift;
+ my @args = @_;
+
+ my $token = $args[2];
+
+ if ($token =~ qr[^(\d{1,2})/(\d{1,2})/(\d{2,4})$]) {
+
+ my $day = $1;
+ my $mon = $2;
+ my $year = $3;
+
+ # Use a window for 2 digit dates. This will keep some ragged Perl
+ # programmer employed in thirty years time. :-)
+ if (length $year == 2) {
+ if ($year < 50) {
+ $year += 2000;
+ }
+ else {
+ $year += 1900;
+ }
+ }
+
+ my $date = sprintf "%4d-%02d-%02dT", $year, $mon, $day;
+
+ # Convert the ISO ISO8601 style string to an Excel date
+ $date = $worksheet->convert_date_time($date);
+
+ if (defined $date) {
+ # Date was valid
+ $args[2] = $date;
+ return $worksheet->write_number(@args);
+ }
+ else {
+ # Not a valid date therefore write as a string
+ return $worksheet->write_string(@args);
+ }
+ }
+ else {
+ # Shouldn't happen if the same match is used in the re and sub.
+ return undef;
+ }
+ }
+
+
+ # Write some dates in the user defined format
+ $worksheet->write('A1', '22/12/2004', $date_format);
+ $worksheet->write('A2', '22/12/04', $date_format);
+ $worksheet->write('A3', '2/12/04', $date_format);
+ $worksheet->write('A4', '2/5/04', $date_format);
+ $worksheet->write('A5', '2/5/95', $date_format);
+ $worksheet->write('A6', '2/5/1995', $date_format);
+
+ # Some erroneous dates
+ $worksheet->write('A8', '2/5/1895', $date_format); # Date out of Excel range
+ $worksheet->write('A9', '29/2/2003', $date_format); # Invalid leap day
+ $worksheet->write('A10','50/50/50', $date_format); # Matches but isn't a date
+
+
+ __END__
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/write_handler4.pl>
+
+=head2 Example: write_to_scalar.pl
+
+
+
+An example of writing an Excel file to a Perl scalar using Spreadsheet::
+WriteExcel and the new features of perl 5.8.
+
+For an examples of how to write to a scalar in versions prior to perl 5.8
+see the filehandle.pl program and IO:Scalar.
+
+
+
+ #!/usr/bin/perl -w
+
+ ##############################################################################
+ #
+ # An example of writing an Excel file to a Perl scalar using Spreadsheet::
+ # WriteExcel and the new features of perl 5.8.
+ #
+ # For an examples of how to write to a scalar in versions prior to perl 5.8
+ # see the filehandle.pl program and IO:Scalar.
+ #
+ # reverse('©'), September 2004, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ require 5.008;
+
+
+ # Use perl 5.8's feature of using a scalar as a filehandle.
+ my $fh;
+ my $str = '';
+ open $fh, '>', \$str or die "Failed to open filehandle: $!";;
+
+
+ # Or replace the previous three lines with this:
+ # open my $fh, '>', \my $str or die "Failed to open filehandle: $!";
+
+
+ # Spreadsheet::WriteExce accepts filehandle as well as file names.
+ my $workbook = Spreadsheet::WriteExcel->new($fh);
+ my $worksheet = $workbook->add_worksheet();
+
+ $worksheet->write(0, 0, "Hi Excel!");
+
+ $workbook->close();
+
+
+ # The Excel file in now in $str. Remember to binmode() the output
+ # filehandle before printing it.
+ binmode STDOUT;
+ print $str;
+
+
+ __END__
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/write_to_scalar.pl>
+
+=head2 Example: unicode_utf16.pl
+
+
+
+A simple example of writing some Unicode text with Spreadsheet::WriteExcel.
+
+This example shows UTF16 encoding. With perl 5.8 it is also possible to use
+utf8 without modification.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/unicode_utf16.jpg" width="640" height="420" alt="Output from unicode_utf16.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ##############################################################################
+ #
+ # A simple example of writing some Unicode text with Spreadsheet::WriteExcel.
+ #
+ # This example shows UTF16 encoding. With perl 5.8 it is also possible to use
+ # utf8 without modification.
+ #
+ # reverse('©'), May 2004, John McNamara, jmcnamara@cpan.org
+ #
+
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+
+ my $workbook = Spreadsheet::WriteExcel->new('unicode_utf16.xls');
+ my $worksheet = $workbook->add_worksheet();
+
+
+ # Write the Unicode smiley face (with increased font for legibility)
+ my $smiley = pack "n", 0x263a;
+ my $big_font = $workbook->add_format(size => 40);
+
+ $worksheet->write_utf16be_string('A3', $smiley, $big_font);
+
+
+ # Write a phrase in Cyrillic
+ my $uni_str = pack "H*", "042d0442043e002004440440043004370430002004".
+ "3d043000200440044304410441043a043e043c0021";
+
+ $worksheet->write_utf16be_string('A5', $uni_str);
+
+
+ $worksheet->write_utf16be_string('A7', pack "H*", "0074006500730074");
+
+
+
+
+
+ __END__
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/unicode_utf16.pl>
+
+=head2 Example: unicode_utf16_japan.pl
+
+
+
+A simple example of writing some Unicode text with Spreadsheet::WriteExcel.
+
+This creates an Excel file with the word Nippon in 3 character sets.
+
+This example shows UTF16 encoding. With perl 5.8 it is also possible to use
+utf8 without modification.
+
+See also the unicode_2022_jp.pl and unicode_shift_jis.pl examples.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/unicode_utf16_japan.jpg" width="640" height="420" alt="Output from unicode_utf16_japan.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ##############################################################################
+ #
+ # A simple example of writing some Unicode text with Spreadsheet::WriteExcel.
+ #
+ # This creates an Excel file with the word Nippon in 3 character sets.
+ #
+ # This example shows UTF16 encoding. With perl 5.8 it is also possible to use
+ # utf8 without modification.
+ #
+ # See also the unicode_2022_jp.pl and unicode_shift_jis.pl examples.
+ #
+ # reverse('©'), May 2004, John McNamara, jmcnamara@cpan.org
+ #
+
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+
+ my $workbook = Spreadsheet::WriteExcel->new('unicode_utf16_japan.xls');
+ my $worksheet = $workbook->add_worksheet();
+
+
+ # Set a Unicode font.
+ my $uni_font = $workbook->add_format(font => 'Arial Unicode MS');
+
+
+ # Create some UTF-16BE Unicode text.
+ my $kanji = pack 'n*', 0x65e5, 0x672c;
+ my $katakana = pack 'n*', 0xff86, 0xff8e, 0xff9d;
+ my $hiragana = pack 'n*', 0x306b, 0x307b, 0x3093;
+
+
+
+ $worksheet->write_utf16be_string('A1', $kanji, $uni_font);
+ $worksheet->write_utf16be_string('A2', $katakana, $uni_font);
+ $worksheet->write_utf16be_string('A3', $hiragana, $uni_font);
+
+
+ $worksheet->write('B1', 'Kanji');
+ $worksheet->write('B2', 'Katakana');
+ $worksheet->write('B3', 'Hiragana');
+
+
+ __END__
+
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/unicode_utf16_japan.pl>
+
+=head2 Example: unicode_cyrillic.pl
+
+
+
+A simple example of writing some Russian cyrillic text using
+Spreadsheet::WriteExcel and perl 5.8.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/unicode_cyrillic.jpg" width="640" height="420" alt="Output from unicode_cyrillic.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ##############################################################################
+ #
+ # A simple example of writing some Russian cyrillic text using
+ # Spreadsheet::WriteExcel and perl 5.8.
+ #
+ # reverse('©'), March 2005, John McNamara, jmcnamara@cpan.org
+ #
+
+
+
+ # Perl 5.8 or later is required for proper utf8 handling. For older perl
+ # versions you should use UTF16 and the write_utf16be_string() method.
+ # See the write_utf16be_string section of the Spreadsheet::WriteExcel docs.
+ #
+ require 5.008;
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+
+ # In this example we generate utf8 strings from character data but in a
+ # real application we would expect them to come from an external source.
+ #
+
+
+ # Create a Russian worksheet name in utf8.
+ my $sheet = pack "U*", 0x0421, 0x0442, 0x0440, 0x0430, 0x043D, 0x0438,
+ 0x0446, 0x0430;
+
+
+ # Create a Russian string.
+ my $str = pack "U*", 0x0417, 0x0434, 0x0440, 0x0430, 0x0432, 0x0441,
+ 0x0442, 0x0432, 0x0443, 0x0439, 0x0020, 0x041C,
+ 0x0438, 0x0440, 0x0021;
+
+
+
+ my $workbook = Spreadsheet::WriteExcel->new("unicode_cyrillic.xls");
+ my $worksheet = $workbook->add_worksheet($sheet . '1');
+
+ $worksheet->set_column('A:A', 18);
+ $worksheet->write('A1', $str);
+
+
+ __END__
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/unicode_cyrillic.pl>
+
+=head2 Example: unicode_list.pl
+
+
+
+A simple example using Spreadsheet::WriteExcel to display all available
+Unicode characters in a font.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/unicode_list.jpg" width="640" height="420" alt="Output from unicode_list.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ##############################################################################
+ #
+ # A simple example using Spreadsheet::WriteExcel to display all available
+ # Unicode characters in a font.
+ #
+ # reverse('©'), May 2004, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+
+ my $workbook = Spreadsheet::WriteExcel->new('unicode_list.xls');
+ my $worksheet = $workbook->add_worksheet();
+
+
+ # Set a Unicode font.
+ my $uni_font = $workbook->add_format(font => 'Arial Unicode MS');
+
+ # Ascii font for labels.
+ my $courier = $workbook->add_format(font => 'Courier New');
+
+
+ my $char = 0;
+
+ # Loop through all 32768 UTF-16BE characters.
+ #
+ for my $row (0 .. 2 ** 12 -1) {
+ for my $col (0 .. 31) {
+
+ last if $char == 0xffff;
+
+ if ($col % 2 == 0){
+ $worksheet->write_string($row, $col,
+ sprintf('0x%04X', $char), $courier);
+ }
+ else {
+ $worksheet->write_utf16be_string($row, $col,
+ pack('n', $char++), $uni_font);
+ }
+ }
+ }
+
+
+
+ __END__
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/unicode_list.pl>
+
+=head2 Example: unicode_2022_jp.pl
+
+
+
+A simple example of converting some Unicode text to an Excel file using
+Spreadsheet::WriteExcel and perl 5.8.
+
+This example generates some Japanese from a file with ISO-2022-JP
+encoded text.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/unicode_2022_jp.jpg" width="640" height="420" alt="Output from unicode_2022_jp.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ##############################################################################
+ #
+ # A simple example of converting some Unicode text to an Excel file using
+ # Spreadsheet::WriteExcel and perl 5.8.
+ #
+ # This example generates some Japanese from a file with ISO-2022-JP
+ # encoded text.
+ #
+ # reverse('©'), September 2004, John McNamara, jmcnamara@cpan.org
+ #
+
+
+
+ # Perl 5.8 or later is required for proper utf8 handling. For older perl
+ # versions you should use UTF16 and the write_utf16be_string() method.
+ # See the write_utf16be_string section of the Spreadsheet::WriteExcel docs.
+ #
+ require 5.008;
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+
+ my $workbook = Spreadsheet::WriteExcel->new("unicode_2022_jp.xls");
+ my $worksheet = $workbook->add_worksheet();
+ $worksheet->set_column('A:A', 50);
+
+
+ my $file = 'unicode_2022_jp.txt';
+
+ open FH, '<:encoding(iso-2022-jp)', $file or die "Couldn't open $file: $!\n";
+
+ my $row = 0;
+
+ while (<FH>) {
+ next if /^#/; # Ignore the comments in the sample file.
+ chomp;
+ $worksheet->write($row++, 0, $_);
+ }
+
+
+ __END__
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/unicode_2022_jp.pl>
+
+=head2 Example: unicode_8859_11.pl
+
+
+
+A simple example of converting some Unicode text to an Excel file using
+Spreadsheet::WriteExcel and perl 5.8.
+
+This example generates some Thai from a file with ISO-8859-11 encoded text.
+
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/unicode_8859_11.jpg" width="640" height="420" alt="Output from unicode_8859_11.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ##############################################################################
+ #
+ # A simple example of converting some Unicode text to an Excel file using
+ # Spreadsheet::WriteExcel and perl 5.8.
+ #
+ # This example generates some Thai from a file with ISO-8859-11 encoded text.
+ #
+ #
+ # reverse('©'), September 2004, John McNamara, jmcnamara@cpan.org
+ #
+
+
+
+ # Perl 5.8 or later is required for proper utf8 handling. For older perl
+ # versions you should use UTF16 and the write_utf16be_string() method.
+ # See the write_utf16be_string section of the Spreadsheet::WriteExcel docs.
+ #
+ require 5.008;
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+
+ my $workbook = Spreadsheet::WriteExcel->new("unicode_8859_11.xls");
+ my $worksheet = $workbook->add_worksheet();
+ $worksheet->set_column('A:A', 50);
+
+
+ my $file = 'unicode_8859_11.txt';
+
+ open FH, '<:encoding(iso-8859-11)', $file or die "Couldn't open $file: $!\n";
+
+ my $row = 0;
+
+ while (<FH>) {
+ next if /^#/; # Ignore the comments in the sample file.
+ chomp;
+ $worksheet->write($row++, 0, $_);
+ }
+
+
+ __END__
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/unicode_8859_11.pl>
+
+=head2 Example: unicode_8859_7.pl
+
+
+
+A simple example of converting some Unicode text to an Excel file using
+Spreadsheet::WriteExcel and perl 5.8.
+
+This example generates some Greek from a file with ISO-8859-7 encoded text.
+
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/unicode_8859_7.jpg" width="640" height="420" alt="Output from unicode_8859_7.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ##############################################################################
+ #
+ # A simple example of converting some Unicode text to an Excel file using
+ # Spreadsheet::WriteExcel and perl 5.8.
+ #
+ # This example generates some Greek from a file with ISO-8859-7 encoded text.
+ #
+ #
+ # reverse('©'), September 2004, John McNamara, jmcnamara@cpan.org
+ #
+
+
+
+ # Perl 5.8 or later is required for proper utf8 handling. For older perl
+ # versions you should use UTF16 and the write_utf16be_string() method.
+ # See the write_utf16be_string section of the Spreadsheet::WriteExcel docs.
+ #
+ require 5.008;
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+
+ my $workbook = Spreadsheet::WriteExcel->new("unicode_8859_7.xls");
+ my $worksheet = $workbook->add_worksheet();
+ $worksheet->set_column('A:A', 50);
+
+
+ my $file = 'unicode_8859_7.txt';
+
+ open FH, '<:encoding(iso-8859-7)', $file or die "Couldn't open $file: $!\n";
+
+ my $row = 0;
+
+ while (<FH>) {
+ next if /^#/; # Ignore the comments in the sample file.
+ chomp;
+ $worksheet->write($row++, 0, $_);
+ }
+
+
+ __END__
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/unicode_8859_7.pl>
+
+=head2 Example: unicode_big5.pl
+
+
+
+A simple example of converting some Unicode text to an Excel file using
+Spreadsheet::WriteExcel and perl 5.8.
+
+This example generates some Chinese from a file with BIG5 encoded text.
+
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/unicode_big5.jpg" width="640" height="420" alt="Output from unicode_big5.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ##############################################################################
+ #
+ # A simple example of converting some Unicode text to an Excel file using
+ # Spreadsheet::WriteExcel and perl 5.8.
+ #
+ # This example generates some Chinese from a file with BIG5 encoded text.
+ #
+ #
+ # reverse('©'), September 2004, John McNamara, jmcnamara@cpan.org
+ #
+
+
+
+ # Perl 5.8 or later is required for proper utf8 handling. For older perl
+ # versions you should use UTF16 and the write_utf16be_string() method.
+ # See the write_utf16be_string section of the Spreadsheet::WriteExcel docs.
+ #
+ require 5.008;
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+
+ my $workbook = Spreadsheet::WriteExcel->new("unicode_big5.xls");
+ my $worksheet = $workbook->add_worksheet();
+ $worksheet->set_column('A:A', 80);
+
+
+ my $file = 'unicode_big5.txt';
+
+ open FH, '<:encoding(big5)', $file or die "Couldn't open $file: $!\n";
+
+ my $row = 0;
+
+ while (<FH>) {
+ next if /^#/; # Ignore the comments in the sample file.
+ chomp;
+ $worksheet->write($row++, 0, $_);
+ }
+
+
+ __END__
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/unicode_big5.pl>
+
+=head2 Example: unicode_cp1251.pl
+
+
+
+A simple example of converting some Unicode text to an Excel file using
+Spreadsheet::WriteExcel and perl 5.8.
+
+This example generates some Russian from a file with CP1251 encoded text.
+
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/unicode_cp1251.jpg" width="640" height="420" alt="Output from unicode_cp1251.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ##############################################################################
+ #
+ # A simple example of converting some Unicode text to an Excel file using
+ # Spreadsheet::WriteExcel and perl 5.8.
+ #
+ # This example generates some Russian from a file with CP1251 encoded text.
+ #
+ #
+ # reverse('©'), September 2004, John McNamara, jmcnamara@cpan.org
+ #
+
+
+
+ # Perl 5.8 or later is required for proper utf8 handling. For older perl
+ # versions you should use UTF16 and the write_utf16be_string() method.
+ # See the write_utf16be_string section of the Spreadsheet::WriteExcel docs.
+ #
+ require 5.008;
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+
+ my $workbook = Spreadsheet::WriteExcel->new("unicode_cp1251.xls");
+ my $worksheet = $workbook->add_worksheet();
+ $worksheet->set_column('A:A', 50);
+
+
+ my $file = 'unicode_cp1251.txt';
+
+ open FH, '<:encoding(cp1251)', $file or die "Couldn't open $file: $!\n";
+
+ my $row = 0;
+
+ while (<FH>) {
+ next if /^#/; # Ignore the comments in the sample file.
+ chomp;
+ $worksheet->write($row++, 0, $_);
+ }
+
+
+ __END__
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/unicode_cp1251.pl>
+
+=head2 Example: unicode_cp1256.pl
+
+
+
+A simple example of converting some Unicode text to an Excel file using
+Spreadsheet::WriteExcel and perl 5.8.
+
+This example generates some Arabic text from a CP-1256 encoded file.
+
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/unicode_cp1256.jpg" width="640" height="420" alt="Output from unicode_cp1256.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ##############################################################################
+ #
+ # A simple example of converting some Unicode text to an Excel file using
+ # Spreadsheet::WriteExcel and perl 5.8.
+ #
+ # This example generates some Arabic text from a CP-1256 encoded file.
+ #
+ #
+ # reverse('©'), September 2004, John McNamara, jmcnamara@cpan.org
+ #
+
+
+
+ # Perl 5.8 or later is required for proper utf8 handling. For older perl
+ # versions you should use UTF16 and the write_utf16be_string() method.
+ # See the write_utf16be_string section of the Spreadsheet::WriteExcel docs.
+ #
+ require 5.008;
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+
+ my $workbook = Spreadsheet::WriteExcel->new("unicode_cp1256.xls");
+ my $worksheet = $workbook->add_worksheet();
+ $worksheet->set_column('A:A', 50);
+
+
+ my $file = 'unicode_cp1256.txt';
+
+ open FH, '<:encoding(cp1256)', $file or die "Couldn't open $file: $!\n";
+
+ my $row = 0;
+
+ while (<FH>) {
+ next if /^#/; # Ignore the comments in the sample file.
+ chomp;
+ $worksheet->write($row++, 0, $_);
+ }
+
+
+ __END__
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/unicode_cp1256.pl>
+
+=head2 Example: unicode_koi8r.pl
+
+
+
+A simple example of converting some Unicode text to an Excel file using
+Spreadsheet::WriteExcel and perl 5.8.
+
+This example generates some Russian from a file with KOI8-R encoded text.
+
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/unicode_koi8r.jpg" width="640" height="420" alt="Output from unicode_koi8r.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ##############################################################################
+ #
+ # A simple example of converting some Unicode text to an Excel file using
+ # Spreadsheet::WriteExcel and perl 5.8.
+ #
+ # This example generates some Russian from a file with KOI8-R encoded text.
+ #
+ #
+ # reverse('©'), September 2004, John McNamara, jmcnamara@cpan.org
+ #
+
+
+
+ # Perl 5.8 or later is required for proper utf8 handling. For older perl
+ # versions you should use UTF16 and the write_utf16be_string() method.
+ # See the write_utf16be_string section of the Spreadsheet::WriteExcel docs.
+ #
+ require 5.008;
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+
+ my $workbook = Spreadsheet::WriteExcel->new("unicode_koi8r.xls");
+ my $worksheet = $workbook->add_worksheet();
+ $worksheet->set_column('A:A', 50);
+
+
+ my $file = 'unicode_koi8r.txt';
+
+ open FH, '<:encoding(koi8-r)', $file or die "Couldn't open $file: $!\n";
+
+ my $row = 0;
+
+ while (<FH>) {
+ next if /^#/; # Ignore the comments in the sample file.
+ chomp;
+ $worksheet->write($row++, 0, $_);
+ }
+
+
+ __END__
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/unicode_koi8r.pl>
+
+=head2 Example: unicode_polish_utf8.pl
+
+
+
+A simple example of converting some Unicode text to an Excel file using
+Spreadsheet::WriteExcel and perl 5.8.
+
+This example generates some Polish from a file with UTF8 encoded text.
+
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/unicode_polish_utf8.jpg" width="640" height="420" alt="Output from unicode_polish_utf8.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ##############################################################################
+ #
+ # A simple example of converting some Unicode text to an Excel file using
+ # Spreadsheet::WriteExcel and perl 5.8.
+ #
+ # This example generates some Polish from a file with UTF8 encoded text.
+ #
+ #
+ # reverse('©'), September 2004, John McNamara, jmcnamara@cpan.org
+ #
+
+
+
+ # Perl 5.8 or later is required for proper utf8 handling. For older perl
+ # versions you should use UTF16 and the write_utf16be_string() method.
+ # See the write_utf16be_string section of the Spreadsheet::WriteExcel docs.
+ #
+ require 5.008;
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+
+ my $workbook = Spreadsheet::WriteExcel->new("unicode_polish_utf8.xls");
+ my $worksheet = $workbook->add_worksheet();
+ $worksheet->set_column('A:A', 50);
+
+
+ my $file = 'unicode_polish_utf8.txt';
+
+ open FH, '<:encoding(utf8)', $file or die "Couldn't open $file: $!\n";
+
+ my $row = 0;
+
+ while (<FH>) {
+ next if /^#/; # Ignore the comments in the sample file.
+ chomp;
+ $worksheet->write($row++, 0, $_);
+ }
+
+
+ __END__
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/unicode_polish_utf8.pl>
+
+=head2 Example: unicode_shift_jis.pl
+
+
+
+A simple example of converting some Unicode text to an Excel file using
+Spreadsheet::WriteExcel and perl 5.8.
+
+This example generates some Japenese text from a file with Shift-JIS
+encoded text.
+
+
+
+=begin html
+
+<p><center><img src="http://homepage.eircom.net/~jmcnamara/perl/images/unicode_shift_jis.jpg" width="640" height="420" alt="Output from unicode_shift_jis.pl" /></center></p>
+
+=end html
+
+Source code for this example:
+
+ #!/usr/bin/perl -w
+
+ ##############################################################################
+ #
+ # A simple example of converting some Unicode text to an Excel file using
+ # Spreadsheet::WriteExcel and perl 5.8.
+ #
+ # This example generates some Japenese text from a file with Shift-JIS
+ # encoded text.
+ #
+ # reverse('©'), September 2004, John McNamara, jmcnamara@cpan.org
+ #
+
+
+
+ # Perl 5.8 or later is required for proper utf8 handling. For older perl
+ # versions you should use UTF16 and the write_utf16be_string() method.
+ # See the write_utf16be_string section of the Spreadsheet::WriteExcel docs.
+ #
+ require 5.008;
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+
+ my $workbook = Spreadsheet::WriteExcel->new("unicode_shift_jis.xls");
+ my $worksheet = $workbook->add_worksheet();
+ $worksheet->set_column('A:A', 50);
+
+
+ my $file = 'unicode_shift_jis.txt';
+
+ open FH, '<:encoding(shiftjis)', $file or die "Couldn't open $file: $!\n";
+
+ my $row = 0;
+
+ while (<FH>) {
+ next if /^#/; # Ignore the comments in the sample file.
+ chomp;
+ $worksheet->write($row++, 0, $_);
+ }
+
+
+ __END__
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/unicode_shift_jis.pl>
+
+=head2 Example: csv2xls.pl
+
+
+
+Example of how to use the WriteExcel module
+
+Simple program to convert a CSV comma-separated value file to an Excel file.
+This is more or less an non-op since Excel can read CSV files.
+The program uses Text::CSV_XS to parse the CSV.
+
+Usage: csv2xls.pl file.csv newfile.xls
+
+
+NOTE: This is only a simple conversion utility for illustrative purposes.
+For converting a CSV or Tab separated or any other type of delimited
+text file to Excel I recommend the more rigorous csv2xls program that is
+part of H.Merijn Brand's Text::CSV_XS module distro.
+
+See the examples/csv2xls link here:
+ L<http://search.cpan.org/~hmbrand/Text-CSV_XS/MANIFEST>
+
+
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # Example of how to use the WriteExcel module
+ #
+ # Simple program to convert a CSV comma-separated value file to an Excel file.
+ # This is more or less an non-op since Excel can read CSV files.
+ # The program uses Text::CSV_XS to parse the CSV.
+ #
+ # Usage: csv2xls.pl file.csv newfile.xls
+ #
+ #
+ # NOTE: This is only a simple conversion utility for illustrative purposes.
+ # For converting a CSV or Tab separated or any other type of delimited
+ # text file to Excel I recommend the more rigorous csv2xls program that is
+ # part of H.Merijn Brand's Text::CSV_XS module distro.
+ #
+ # See the examples/csv2xls link here:
+ # L<http://search.cpan.org/~hmbrand/Text-CSV_XS/MANIFEST>
+ #
+ # reverse('©'), March 2001, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+ use Text::CSV_XS;
+
+ # Check for valid number of arguments
+ if (($#ARGV < 1) || ($#ARGV > 2)) {
+ die("Usage: csv2xls csvfile.txt newfile.xls\n");
+ };
+
+ # Open the Comma Separated Variable file
+ open (CSVFILE, $ARGV[0]) or die "$ARGV[0]: $!";
+
+ # Create a new Excel workbook
+ my $workbook = Spreadsheet::WriteExcel->new($ARGV[1]);
+ my $worksheet = $workbook->add_worksheet();
+
+ # Create a new CSV parsing object
+ my $csv = Text::CSV_XS->new;
+
+ # Row and column are zero indexed
+ my $row = 0;
+
+
+ while (<CSVFILE>) {
+ if ($csv->parse($_)) {
+ my @Fld = $csv->fields;
+
+ my $col = 0;
+ foreach my $token (@Fld) {
+ $worksheet->write($row, $col, $token);
+ $col++;
+ }
+ $row++;
+ }
+ else {
+ my $err = $csv->error_input;
+ print "Text::CSV_XS parse() failed on argument: ", $err, "\n";
+ }
+ }
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/csv2xls.pl>
+
+=head2 Example: tab2xls.pl
+
+
+
+Example of how to use the WriteExcel module
+
+The following converts a tab separated file into an Excel file
+
+Usage: tab2xls.pl tabfile.txt newfile.xls
+
+
+NOTE: This is only a simple conversion utility for illustrative purposes.
+For converting a CSV or Tab separated or any other type of delimited
+text file to Excel I recommend the more rigorous csv2xls program that is
+part of H.Merijn Brand's Text::CSV_XS module distro.
+
+See the examples/csv2xls link here:
+ L<http://search.cpan.org/~hmbrand/Text-CSV_XS/MANIFEST>
+
+
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # Example of how to use the WriteExcel module
+ #
+ # The following converts a tab separated file into an Excel file
+ #
+ # Usage: tab2xls.pl tabfile.txt newfile.xls
+ #
+ #
+ # NOTE: This is only a simple conversion utility for illustrative purposes.
+ # For converting a CSV or Tab separated or any other type of delimited
+ # text file to Excel I recommend the more rigorous csv2xls program that is
+ # part of H.Merijn Brand's Text::CSV_XS module distro.
+ #
+ # See the examples/csv2xls link here:
+ # L<http://search.cpan.org/~hmbrand/Text-CSV_XS/MANIFEST>
+ #
+ # reverse('©'), March 2001, John McNamara, jmcnamara@cpan.org
+ #
+
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+
+ # Check for valid number of arguments
+ if (($#ARGV < 1) || ($#ARGV > 2)) {
+ die("Usage: tab2xls tabfile.txt newfile.xls\n");
+ };
+
+
+ # Open the tab delimited file
+ open (TABFILE, $ARGV[0]) or die "$ARGV[0]: $!";
+
+
+ # Create a new Excel workbook
+ my $workbook = Spreadsheet::WriteExcel->new($ARGV[1]);
+ my $worksheet = $workbook->add_worksheet();
+
+ # Row and column are zero indexed
+ my $row = 0;
+
+ while (<TABFILE>) {
+ chomp;
+ # Split on single tab
+ my @Fld = split('\t', $_);
+
+ my $col = 0;
+ foreach my $token (@Fld) {
+ $worksheet->write($row, $col, $token);
+ $col++;
+ }
+ $row++;
+ }
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/tab2xls.pl>
+
+=head2 Example: datecalc1.pl
+
+
+
+NOTE: An easier way of writing dates and times is to use the newer
+ write_date_time() Worksheet method. See the date_time.pl example.
+
+
+
+Demonstration of writing date/time cells to Excel spreadsheets,
+using UNIX/Perl time as source of date/time.
+
+
+
+UNIX/Perl time is the time since the Epoch (00:00:00 GMT, 1 Jan 1970)
+measured in seconds.
+
+An Excel file can use exactly one of two different date/time systems.
+In these systems, a floating point number represents the number of days
+(and fractional parts of the day) since a start point. The floating point
+number is referred to as a 'serial'.
+
+The two systems ('1900' and '1904') use different starting points:
+
+ '1900'; '1.00' is 1 Jan 1900 BUT 1900 is erroneously regarded as
+ a leap year - see:
+ http://support.microsoft.com/support/kb/articles/Q181/3/70.asp
+ for the excuse^H^H^H^H^H^Hreason.
+ '1904'; '1.00' is 2 Jan 1904.
+
+The '1904' system is the default for Apple Macs. Windows versions of
+Excel have the option to use the '1904' system.
+
+Note that Visual Basic's "DateSerial" function does NOT erroneously
+regard 1900 as a leap year, and thus its serials do not agree with
+the 1900 serials of Excel for dates before 1 Mar 1900.
+
+Note that StarOffice (at least at version 5.2) does NOT erroneously
+regard 1900 as a leap year, and thus its serials do not agree with
+the 1900 serials of Excel for dates before 1 Mar 1900.
+
+
+ #!/usr/bin/perl -w
+
+
+ ######################################################################
+ #
+ # NOTE: An easier way of writing dates and times is to use the newer
+ # write_date_time() Worksheet method. See the date_time.pl example.
+ #
+ ######################################################################
+ #
+ # Demonstration of writing date/time cells to Excel spreadsheets,
+ # using UNIX/Perl time as source of date/time.
+ #
+ ######################################################################
+ #
+ # UNIX/Perl time is the time since the Epoch (00:00:00 GMT, 1 Jan 1970)
+ # measured in seconds.
+ #
+ # An Excel file can use exactly one of two different date/time systems.
+ # In these systems, a floating point number represents the number of days
+ # (and fractional parts of the day) since a start point. The floating point
+ # number is referred to as a 'serial'.
+ #
+ # The two systems ('1900' and '1904') use different starting points:
+ #
+ # '1900'; '1.00' is 1 Jan 1900 BUT 1900 is erroneously regarded as
+ # a leap year - see:
+ # http://support.microsoft.com/support/kb/articles/Q181/3/70.asp
+ # for the excuse^H^H^H^H^H^Hreason.
+ # '1904'; '1.00' is 2 Jan 1904.
+ #
+ # The '1904' system is the default for Apple Macs. Windows versions of
+ # Excel have the option to use the '1904' system.
+ #
+ # Note that Visual Basic's "DateSerial" function does NOT erroneously
+ # regard 1900 as a leap year, and thus its serials do not agree with
+ # the 1900 serials of Excel for dates before 1 Mar 1900.
+ #
+ # Note that StarOffice (at least at version 5.2) does NOT erroneously
+ # regard 1900 as a leap year, and thus its serials do not agree with
+ # the 1900 serials of Excel for dates before 1 Mar 1900.
+ #
+
+ # Copyright 2000, Andrew Benham, adsb@bigfoot.com
+ #
+
+ ######################################################################
+ #
+ # Calculation description
+ # =======================
+ #
+ # 1900 system
+ # -----------
+ # Unix time is '0' at 00:00:00 GMT 1 Jan 1970, i.e. 70 years after 1 Jan 1900.
+ # Of those 70 years, 17 (1904,08,12,16,20,24,28,32,36,40,44,48,52,56,60,64,68)
+ # were leap years with an extra day.
+ # Thus there were 17 + 70*365 days = 25567 days between 1 Jan 1900 and
+ # 1 Jan 1970.
+ # In the 1900 system, '1' is 1 Jan 1900, but as 1900 was not a leap year
+ # 1 Jan 1900 should really be '2', so 1 Jan 1970 is '25569'.
+ #
+ # 1904 system
+ # -----------
+ # Unix time is '0' at 00:00:00 GMT 1 Jan 1970, i.e. 66 years after 1 Jan 1904.
+ # Of those 66 years, 17 (1904,08,12,16,20,24,28,32,36,40,44,48,52,56,60,64,68)
+ # were leap years with an extra day.
+ # Thus there were 17 + 66*365 days = 24107 days between 1 Jan 1904 and
+ # 1 Jan 1970.
+ # In the 1904 system, 2 Jan 1904 being '1', 1 Jan 1970 is '24107'.
+ #
+ ######################################################################
+ #
+ # Copyright (c) 2000, Andrew Benham.
+ # This program is free software. It may be used, redistributed and/or
+ # modified under the same terms as Perl itself.
+ #
+ # Andrew Benham, adsb@bigfoot.com
+ # London, United Kingdom
+ # 11 Nov 2000
+ #
+ ######################################################################
+
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ use Time::Local;
+
+ use vars qw/$DATE_SYSTEM/;
+
+ # Use 1900 date system on all platforms other than Apple Mac (for which
+ # use 1904 date system).
+ $DATE_SYSTEM = ($^O eq 'MacOS') ? 1 : 0;
+
+ my $workbook = Spreadsheet::WriteExcel->new("dates.xls");
+ my $worksheet = $workbook->add_worksheet();
+
+ my $format_date = $workbook->add_format();
+ $format_date->set_num_format('d mmmm yyy');
+
+ $worksheet->set_column(0,1,21);
+
+ $worksheet->write_string (0,0,"The epoch (GMT)");
+ $worksheet->write_number (0,1,&calc_serial(0,1),0x16);
+
+ $worksheet->write_string (1,0,"The epoch (localtime)");
+ $worksheet->write_number (1,1,&calc_serial(0,0),0x16);
+
+ $worksheet->write_string (2,0,"Today");
+ $worksheet->write_number (2,1,&calc_serial(),$format_date);
+
+ my $christmas2000 = timelocal(0,0,0,25,11,100);
+ $worksheet->write_string (3,0,"Christmas 2000");
+ $worksheet->write_number (3,1,&calc_serial($christmas2000),$format_date);
+
+ $workbook->close();
+
+ #-----------------------------------------------------------
+ # calc_serial()
+ #
+ # Called with (up to) 2 parameters.
+ # 1. Unix timestamp. If omitted, uses current time.
+ # 2. GMT flag. Set to '1' to return serial in GMT.
+ # If omitted, returns serial in appropriate timezone.
+ #
+ # Returns date/time serial according to $DATE_SYSTEM selected
+ #-----------------------------------------------------------
+ sub calc_serial {
+ my $time = (defined $_[0]) ? $_[0] : time();
+ my $gmtflag = (defined $_[1]) ? $_[1] : 0;
+
+ # Divide timestamp by number of seconds in a day.
+ # This gives a date serial with '0' on 1 Jan 1970.
+ my $serial = $time / 86400;
+
+ # Adjust the date serial by the offset appropriate to the
+ # currently selected system (1900/1904).
+ if ($DATE_SYSTEM == 0) { # use 1900 system
+ $serial += 25569;
+ } else { # use 1904 system
+ $serial += 24107;
+ }
+
+ unless ($gmtflag) {
+ # Now have a 'raw' serial with the right offset. But this
+ # gives a serial in GMT, which is false unless the timezone
+ # is GMT. We need to adjust the serial by the appropriate
+ # timezone offset.
+ # Calculate the appropriate timezone offset by seeing what
+ # the differences between localtime and gmtime for the given
+ # time are.
+
+ my @gmtime = gmtime($time);
+ my @ltime = localtime($time);
+
+ # For the first 7 elements of the two arrays, adjust the
+ # date serial where the elements differ.
+ for (0 .. 6) {
+ my $diff = $ltime[$_] - $gmtime[$_];
+ if ($diff) {
+ $serial += _adjustment($diff,$_);
+ }
+ }
+ }
+
+ # Perpetuate the error that 1900 was a leap year by decrementing
+ # the serial if we're using the 1900 system and the date is prior to
+ # 1 Mar 1900. This has the effect of making serial value '60'
+ # 29 Feb 1900.
+
+ # This fix only has any effect if UNIX/Perl time on the platform
+ # can represent 1900. Many can't.
+
+ unless ($DATE_SYSTEM) {
+ $serial-- if ($serial < 61); # '61' is 1 Mar 1900
+ }
+ return $serial;
+ }
+
+ sub _adjustment {
+ # Based on the difference in the localtime/gmtime array elements
+ # number, return the adjustment required to the serial.
+
+ # We only look at some elements of the localtime/gmtime arrays:
+ # seconds unlikely to be different as all known timezones
+ # have an offset of integral multiples of 15 minutes,
+ # but it's easy to do.
+ # minutes will be different for timezone offsets which are
+ # not an exact number of hours.
+ # hours very likely to be different.
+ # weekday will differ when localtime/gmtime difference
+ # straddles midnight.
+ #
+ # Assume that difference between localtime and gmtime is less than
+ # 5 days, then don't have to do maths for day of month, month number,
+ # year number, etc...
+
+ my ($delta,$element) = @_;
+ my $adjust = 0;
+
+ if ($element == 0) { # Seconds
+ $adjust = $delta/86400; # 60 * 60 * 24
+ } elsif ($element == 1) { # Minutes
+ $adjust = $delta/1440; # 60 * 24
+ } elsif ($element == 2) { # Hours
+ $adjust = $delta/24; # 24
+ } elsif ($element == 6) { # Day of week number
+ # Catch difference straddling Sat/Sun in either direction
+ $delta += 7 if ($delta < -4);
+ $delta -= 7 if ($delta > 4);
+
+ $adjust = $delta;
+ }
+ return $adjust;
+ }
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/datecalc1.pl>
+
+=head2 Example: datecalc2.pl
+
+
+
+Example of how to using the Date::Calc module to calculate Excel dates.
+
+NOTE: An easier way of writing dates and times is to use the newer
+ write_date_time() Worksheet method. See the date_time.pl example.
+
+
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # Example of how to using the Date::Calc module to calculate Excel dates.
+ #
+ # NOTE: An easier way of writing dates and times is to use the newer
+ # write_date_time() Worksheet method. See the date_time.pl example.
+ #
+ # reverse('©'), June 2001, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+ use Date::Calc qw(Delta_DHMS); # You may need to install this module.
+
+
+ # Create a new workbook and add a worksheet
+ my $workbook = Spreadsheet::WriteExcel->new("excel_date2.xls");
+ my $worksheet = $workbook->add_worksheet();
+
+ # Expand the first column so that the date is visible.
+ $worksheet->set_column("A:A", 25);
+
+
+ # Add a format for the date
+ my $format = $workbook->add_format();
+ $format->set_num_format('d mmmm yyy HH:MM:SS');
+
+
+ my $date;
+
+ # Write some dates and times
+ $date = excel_date(1900, 1, 1);
+ $worksheet->write("A1", $date, $format);
+
+ $date = excel_date(2000, 1, 1);
+ $worksheet->write("A2", $date, $format);
+
+ $date = excel_date(2000, 4, 17, 14, 33, 15);
+ $worksheet->write("A3", $date, $format);
+
+
+ ###############################################################################
+ #
+ # excel_date($years, $months, $days, $hours, $minutes, $seconds)
+ #
+ # Create an Excel date in the 1900 format. All of the arguments are optional
+ # but you should at least add $years.
+ #
+ # Corrects for Excel's missing leap day in 1900. See excel_time1.pl for an
+ # explanation.
+ #
+ sub excel_date {
+
+ my $years = $_[0] || 1900;
+ my $months = $_[1] || 1;
+ my $days = $_[2] || 1;
+ my $hours = $_[3] || 0;
+ my $minutes = $_[4] || 0;
+ my $seconds = $_[5] || 0;
+
+ my @date = ($years, $months, $days, $hours, $minutes, $seconds);
+ my @epoch = (1899, 12, 31, 0, 0, 0);
+
+ ($days, $hours, $minutes, $seconds) = Delta_DHMS(@epoch, @date);
+
+ my $date = $days + ($hours*3600 +$minutes*60 +$seconds)/(24*60*60);
+
+ # Add a day for Excel's missing leap day in 1900
+ $date++ if ($date > 59);
+
+ return $date;
+ }
+
+ ###############################################################################
+ #
+ # excel_date($years, $months, $days, $hours, $minutes, $seconds)
+ #
+ # Create an Excel date in the 1904 format. All of the arguments are optional
+ # but you should at least add $years.
+ #
+ # You will also need to call $workbook->set_1904() for this format to be valid.
+ #
+ sub excel_date_1904 {
+
+ my $years = $_[0] || 1900;
+ my $months = $_[1] || 1;
+ my $days = $_[2] || 1;
+ my $hours = $_[3] || 0;
+ my $minutes = $_[4] || 0;
+ my $seconds = $_[5] || 0;
+
+ my @date = ($years, $months, $days, $hours, $minutes, $seconds);
+ my @epoch = (1904, 1, 1, 0, 0, 0);
+
+ ($days, $hours, $minutes, $seconds) = Delta_DHMS(@epoch, @date);
+
+ my $date = $days + ($hours*3600 +$minutes*60 +$seconds)/(24*60*60);
+
+ return $date;
+ }
+
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/datecalc2.pl>
+
+=head2 Example: lecxe.pl
+
+
+Utility program to convert an Excel file into a Spreadsheet::WriteExcel
+program using Win32::OLE
+
+
+ #!/usr/bin/perl -w
+
+ #
+ # Utility program to convert an Excel file into a Spreadsheet::WriteExcel
+ # program using Win32::OLE
+ #
+
+ #
+ # lecxe program
+ # by t0mas@netlords.net
+ #
+ # Version 0.01a Initial release (alpha)
+
+
+ # Modules
+ use strict;
+ use Win32::OLE;
+ use Win32::OLE::Const;
+ use Getopt::Std;
+
+
+ # Vars
+ use vars qw(%opts);
+
+
+ # Get options
+ getopts('i:o:v',\%opts);
+
+
+ # Not enough options
+ exit &usage unless ($opts{i} && $opts{o});
+
+
+ # Create Excel object
+ my $Excel = new Win32::OLE("Excel.Application","Quit") or
+ die "Can't start excel: $!";
+
+
+ # Get constants
+ my $ExcelConst=Win32::OLE::Const->Load("Microsoft Excel");
+
+
+ # Show Excel
+ $Excel->{Visible} = 1 if ($opts{v});
+
+
+ # Open infile
+ my $Workbook = $Excel->Workbooks->Open({Filename=>$opts{i}});
+
+
+ # Open outfile
+ open (OUTFILE,">$opts{o}") or die "Can't open outfile $opts{o}: $!";
+
+
+ # Print header for outfile
+ print OUTFILE <<'EOH';
+ #!/usr/bin/perl -w
+
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+
+ use vars qw($workbook %worksheets %formats);
+
+
+ $workbook = Spreadsheet::WriteExcel->new("_change_me_.xls");
+
+
+ EOH
+
+
+ # Loop all sheets
+ foreach my $sheetnum (1..$Excel->Workbooks(1)->Worksheets->Count) {
+
+
+ # Format sheet
+ my $name=$Excel->Workbooks(1)->Worksheets($sheetnum)->Name;
+ print "Sheet $name\n" if ($opts{v});
+ print OUTFILE "# Sheet $name\n";
+ print OUTFILE "\$worksheets{'$name'} = \$workbook->add_worksheet('$name');\n";
+
+
+ # Get usedrange of cells in worksheet
+ my $usedrange=$Excel->Workbooks(1)->Worksheets($sheetnum)->UsedRange;
+
+
+ # Loop all columns in used range
+ foreach my $j (1..$usedrange->Columns->Count){
+
+
+ # Format column
+ print "Col $j\n" if ($opts{v});
+ my ($colwidth);
+ $colwidth=$usedrange->Columns($j)->ColumnWidth;
+ print OUTFILE "# Column $j\n";
+ print OUTFILE "\$worksheets{'$name'}->set_column(".($j-1).",".($j-1).
+ ", $colwidth);\n";
+
+
+ # Loop all rows in used range
+ foreach my $i (1..$usedrange->Rows->Count){
+
+
+ # Format row
+ print "Row $i\n" if ($opts{v});
+ print OUTFILE "# Row $i\n";
+ do {
+ my ($rowheight);
+ $rowheight=$usedrange->Rows($i)->RowHeight;
+ print OUTFILE "\$worksheets{'$name'}->set_row(".($i-1).
+ ", $rowheight);\n";
+ } if ($j==1);
+
+
+ # Start creating cell format
+ my $fname="\$formats{'".$name.'R'.$i.'C'.$j."'}";
+ my $format="$fname=\$workbook->add_format();\n";
+ my $print_format=0;
+
+ # Check for borders
+ my @bfnames=qw(left right top bottom);
+ foreach my $k (1..$usedrange->Cells($i,$j)->Borders->Count) {
+ my $lstyle=$usedrange->Cells($i,$j)->Borders($k)->LineStyle;
+ if ($lstyle > 0) {
+ $format.=$fname."->set_".$bfnames[$k-1]."($lstyle);\n";
+ $print_format=1;
+ }
+ }
+
+
+ # Check for font
+ my ($fontattr,$prop,$func,%fontsets,$fontColor);
+ %fontsets=(Name=>'set_font',
+ Size=>'set_size');
+ while (($prop,$func) = each %fontsets) {
+ $fontattr=$usedrange->Cells($i,$j)->Font->$prop;
+ if ($fontattr ne "") {
+ $format.=$fname."->$func('$fontattr');\n";
+ $print_format=1;
+ }
+
+
+ }
+ %fontsets=(Bold=>'set_bold(1)',
+ Italic=>'set_italic(1)',
+ Underline=>'set_underline(1)',
+ Strikethrough=>'set_strikeout(1)',
+ Superscript=>'set_script(1)',
+ Subscript=>'set_script(2)',
+ OutlineFont=>'set_outline(1)',
+ Shadow=>'set_shadow(1)');
+ while (($prop,$func) = each %fontsets) {
+ $fontattr=$usedrange->Cells($i,$j)->Font->$prop;
+ if ($fontattr==1) {
+ $format.=$fname."->$func;\n" ;
+
+ $print_format=1;
+ }
+ }
+ $fontColor=$usedrange->Cells($i,$j)->Font->ColorIndex();
+ if ($fontColor>0&&$fontColor!=$ExcelConst->{xlColorIndexAutomatic}) {
+ $format.=$fname."->set_color(".($fontColor+7).");\n" ;
+ $print_format=1;
+ }
+
+
+
+ # Check text alignment, merging and wrapping
+ my ($halign,$valign,$merge,$wrap);
+ $halign=$usedrange->Cells($i,$j)->HorizontalAlignment;
+ my %hAligns=($ExcelConst->{xlHAlignCenter}=>"'center'",
+ $ExcelConst->{xlHAlignJustify}=>"'justify'",
+ $ExcelConst->{xlHAlignLeft}=>"'left'",
+ $ExcelConst->{xlHAlignRight}=>"'right'",
+ $ExcelConst->{xlHAlignFill}=>"'fill'",
+ $ExcelConst->{xlHAlignCenterAcrossSelection}=>"'merge'");
+ if ($halign!=$ExcelConst->{xlHAlignGeneral}) {
+ $format.=$fname."->set_align($hAligns{$halign});\n";
+ $print_format=1;
+ }
+ $valign=$usedrange->Cells($i,$j)->VerticalAlignment;
+ my %vAligns=($ExcelConst->{xlVAlignBottom}=>"'bottom'",
+ $ExcelConst->{xlVAlignCenter}=>"'vcenter'",
+ $ExcelConst->{xlVAlignJustify}=>"'vjustify'",
+ $ExcelConst->{xlVAlignTop}=>"'top'");
+ if ($valign) {
+ $format.=$fname."->set_align($vAligns{$valign});\n";
+ $print_format=1;
+ }
+ $merge=$usedrange->Cells($i,$j)->MergeCells;
+ if ($merge==1) {
+ $format.=$fname."->set_merge();\n";
+
+ $print_format=1;
+ }
+ $wrap=$usedrange->Cells($i,$j)->WrapText;
+ if ($wrap==1) {
+ $format.=$fname."->set_text_wrap(1);\n";
+
+ $print_format=1;
+ }
+
+
+ # Check patterns
+ my ($pattern,%pats);
+ %pats=(-4142=>0,-4125=>2,-4126=>3,-4124=>4,-4128=>5,-4166=>6,
+ -4121=>7,-4162=>8);
+ $pattern=$usedrange->Cells($i,$j)->Interior->Pattern;
+ if ($pattern&&$pattern!=$ExcelConst->{xlPatternAutomatic}) {
+ $pattern=$pats{$pattern} if ($pattern<0 && defined $pats{$pattern});
+ $format.=$fname."->set_pattern($pattern);\n";
+
+ # Colors fg/bg
+ my ($cIndex);
+ $cIndex=$usedrange->Cells($i,$j)->Interior->PatternColorIndex;
+ if ($cIndex>0&&$cIndex!=$ExcelConst->{xlColorIndexAutomatic}) {
+ $format.=$fname."->set_bg_color(".($cIndex+7).");\n";
+ }
+ $cIndex=$usedrange->Cells($i,$j)->Interior->ColorIndex;
+ if ($cIndex>0&&$cIndex!=$ExcelConst->{xlColorIndexAutomatic}) {
+ $format.=$fname."->set_fg_color(".($cIndex+7).");\n";
+ }
+ $print_format=1;
+ }
+
+
+ # Check for number format
+ my ($num_format);
+ $num_format=$usedrange->Cells($i,$j)->NumberFormat;
+ if ($num_format ne "") {
+ $format.=$fname."->set_num_format('$num_format');\n";
+ $print_format=1;
+ }
+
+
+ # Check for contents (text or formula)
+ my ($contents);
+ $contents=$usedrange->Cells($i,$j)->Formula;
+ $contents=$usedrange->Cells($i,$j)->Text if ($contents eq "");
+
+
+ # Print cell
+ if ($contents ne "" or $print_format) {
+ print OUTFILE "# Cell($i,$j)\n";
+ print OUTFILE $format if ($print_format);
+ print OUTFILE "\$worksheets{'$name'}->write(".($i-1).",".($j-1).
+ ",'$contents'";
+ print OUTFILE ",$fname" if ($print_format);
+ print OUTFILE ");\n";
+ }
+ }
+ }
+ }
+
+
+ # Famous last words...
+ print OUTFILE "\$workbook->close();\n";
+
+
+ # Close outfile
+ close (OUTFILE) or die "Can't close outfile $opts{o}: $!";
+
+
+ ####################################################################
+ sub usage {
+ printf STDERR "usage: $0 [options]\n".
+ "\tOptions:\n".
+ "\t\t-v \tverbose mode\n" .
+ "\t\t-i <name>\tname of input file\n" .
+ "\t\t-o <name>\tname of output file\n";
+ }
+
+
+ ####################################################################
+ sub END {
+ # Quit excel
+ do {
+ $Excel->{DisplayAlerts} = 0;
+ $Excel->Quit;
+ } if (defined $Excel);
+ }
+
+
+ __END__
+
+
+ =head1 NAME
+
+
+ lecxe - A Excel file to Spreadsheet::WriteExcel code converter
+
+
+ =head1 DESCRIPTION
+
+
+ This program takes an MS Excel workbook file as input and from
+ that file, produces an output file with Perl code that uses the
+ Spreadsheet::WriteExcel module to reproduce the original
+ file.
+
+
+ =head1 STUFF
+
+
+ Additional hands-on editing of the output file might be neccecary
+ as:
+
+
+ * This program always names the file produced by output script
+ _change_me_.xls
+
+
+ * Users of international Excel versions will have som work to do
+ on list separators and numeric punctation characters.
+
+
+ =head1 SEE ALSO
+
+
+ L<Win32::OLE>, L<Win32::OLE::Variant>, L<Spreadsheet::WriteExcel>
+
+
+ =head1 BUGS
+
+
+ * Picks wrong color on cells sometimes.
+
+
+ * Probably a few other...
+
+
+ =head1 DISCLAIMER
+
+
+ I do not guarantee B<ANYTHING> with this program. If you use it you
+ are doing so B<AT YOUR OWN RISK>! I may or may not support this
+ depending on my time schedule...
+
+
+ =head1 AUTHOR
+
+
+ t0mas@netlords.net
+
+
+ =head1 COPYRIGHT
+
+
+ Copyright 2001, t0mas@netlords.net
+
+
+ This package is free software; you can redistribute it and/or
+ modify it under the same terms as Perl itself.
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/lecxe.pl>
+
+=head2 Example: convertA1.pl
+
+
+
+This program contains helper functions to deal with the Excel A1 cell
+reference notation.
+
+These functions have been superseded by L<Spreadsheet::WriteExcel::Utility>.
+
+
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # This program contains helper functions to deal with the Excel A1 cell
+ # reference notation.
+ #
+ # These functions have been superseded by L<Spreadsheet::WriteExcel::Utility>.
+ #
+ # reverse('©'), March 2001, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+
+ print "\n";
+ print "Cell B7 is equivalent to (";
+ print join " ", cell_to_rowcol('B7');
+ print ") in row column notation.\n";
+
+ print "Cell \$B7 is equivalent to (";
+ print join " ", cell_to_rowcol('$B7');
+ print ") in row column notation.\n";
+
+ print "Cell B\$7 is equivalent to (";
+ print join " ", cell_to_rowcol('B$7');
+ print ") in row column notation.\n";
+
+ print "Cell \$B\$7 is equivalent to (";
+ print join " ", cell_to_rowcol('$B$7');
+ print ") in row column notation.\n\n";
+
+ print "Row and column (1999, 29) are equivalent to ";
+ print rowcol_to_cell(1999, 29), ".\n";
+
+ print "Row and column (1999, 29, 0, 1) are equivalent to ";
+ print rowcol_to_cell(1999, 29, 0, 1), ".\n\n";
+
+ print "The base cell is: Z7\n";
+ print "Increment the row: ", inc_cell_row('Z7'), "\n";
+ print "Decrement the row: ", dec_cell_row('Z7'), "\n";
+ print "Increment the column: ", inc_cell_col('Z7'), "\n";
+ print "Decrement the column: ", dec_cell_col('Z7'), "\n\n";
+
+
+ ###############################################################################
+ #
+ # rowcol_to_cell($row, $col, $row_absolute, $col_absolute)
+ #
+ # Convert a zero based row and column reference to a A1 reference. For example
+ # (0, 2) to C1. $row_absolute, $col_absolute are optional. They are boolean
+ # values used to indicate if the row or column value is absolute, i.e. if it is
+ # prefixed by a $ sign: eg. (0, 2, 0, 1) converts to $C1.
+ #
+ # Returns: a cell reference string.
+ #
+ sub rowcol_to_cell {
+
+ my $row = $_[0];
+ my $col = $_[1];
+ my $row_abs = $_[2] || 0;
+ my $col_abs = $_[3] || 0;
+
+
+ if ($row_abs) {
+ $row_abs = '$'
+ }
+ else {
+ $row_abs = ''
+ }
+
+ if ($col_abs) {
+ $col_abs = '$'
+ }
+ else {
+ $col_abs = ''
+ }
+
+
+ my $int = int ($col / 26);
+ my $frac = $col % 26 +1;
+
+ my $chr1 ='';
+ my $chr2 ='';
+
+
+ if ($frac != 0) {
+ $chr2 = chr (ord('A') + $frac -1);;
+ }
+
+ if ($int > 0) {
+ $chr1 = chr (ord('A') + $int -1);
+ }
+
+ $row++; # Zero index to 1-index
+
+ return $col_abs . $chr1 . $chr2 . $row_abs. $row;
+ }
+
+
+ ###############################################################################
+ #
+ # cell_to_rowcol($cell_ref)
+ #
+ # Convert an Excel cell reference in A1 notation to a zero based row and column
+ # reference; converts C1 to (0, 2, 0, 0).
+ #
+ # Returns: row, column, row_is_absolute, column_is_absolute
+ #
+ #
+ sub cell_to_rowcol {
+
+ my $cell = shift;
+
+ $cell =~ /(\$?)([A-I]?[A-Z])(\$?)(\d+)/;
+
+ my $col_abs = $1 eq "" ? 0 : 1;
+ my $col = $2;
+ my $row_abs = $3 eq "" ? 0 : 1;
+ my $row = $4;
+
+ # Convert base26 column string to number
+ # All your Base are belong to us.
+ my @chars = split //, $col;
+ my $expn = 0;
+ $col = 0;
+
+ while (@chars) {
+ my $char = pop(@chars); # LS char first
+ $col += (ord($char) -ord('A') +1) * (26**$expn);
+ $expn++;
+ }
+
+ # Convert 1-index to zero-index
+ $row--;
+ $col--;
+
+ return $row, $col, $row_abs, $col_abs;
+ }
+
+
+ ###############################################################################
+ #
+ # inc_cell_row($cell_ref)
+ #
+ # Increments the row number of an Excel cell reference in A1 notation.
+ # For example C3 to C4
+ #
+ # Returns: a cell reference string.
+ #
+ sub inc_cell_row {
+
+ my $cell = shift;
+ my ($row, $col, $row_abs, $col_abs) = cell_to_rowcol($cell);
+
+ $row++;
+
+ return rowcol_to_cell($row, $col, $row_abs, $col_abs);
+ }
+
+
+ ###############################################################################
+ #
+ # dec_cell_row($cell_ref)
+ #
+ # Decrements the row number of an Excel cell reference in A1 notation.
+ # For example C4 to C3
+ #
+ # Returns: a cell reference string.
+ #
+ sub dec_cell_row {
+
+ my $cell = shift;
+ my ($row, $col, $row_abs, $col_abs) = cell_to_rowcol($cell);
+
+ $row--;
+
+ return rowcol_to_cell($row, $col, $row_abs, $col_abs);
+ }
+
+
+ ###############################################################################
+ #
+ # inc_cell_col($cell_ref)
+ #
+ # Increments the column number of an Excel cell reference in A1 notation.
+ # For example C3 to D3
+ #
+ # Returns: a cell reference string.
+ #
+ sub inc_cell_col {
+
+ my $cell = shift;
+ my ($row, $col, $row_abs, $col_abs) = cell_to_rowcol($cell);
+
+ $col++;
+
+ return rowcol_to_cell($row, $col, $row_abs, $col_abs);
+ }
+
+
+ ###############################################################################
+ #
+ # dec_cell_col($cell_ref)
+ #
+ # Decrements the column number of an Excel cell reference in A1 notation.
+ # For example D3 to C3
+ #
+ # Returns: a cell reference string.
+ #
+ sub dec_cell_col {
+
+ my $cell = shift;
+ my ($row, $col, $row_abs, $col_abs) = cell_to_rowcol($cell);
+
+ $col--;
+
+ return rowcol_to_cell($row, $col, $row_abs, $col_abs);
+ }
+
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/convertA1.pl>
+
+=head2 Example: function_locale.pl
+
+
+
+Generate function names for different locales.
+
+This program can be used to generate the hash of known functions for use in
+the Formula.pm module. By default the function names are in English but you
+can also choose to support the following languages: German, French, Spanish,
+Portuguese, Dutch, Finnish, Italian and Swedish.
+
+This would allow you to do something like the following:
+
+ $worksheet->write(0, 0, '=SUM(C1:C3)' );
+ $worksheet->write(1, 0, '=SUMME(C1:C3)');
+ $worksheet->write(2, 0, '=SOMME(C1:C3)');
+ $worksheet->write(3, 0, '=SUMA(C1:C3)' );
+ $worksheet->write(4, 0, '=SOMA(C1:C3)' );
+ $worksheet->write(5, 0, '=SOM(C1:C3)' );
+ $worksheet->write(6, 0, '=SUMMA(C1:C3)');
+ $worksheet->write(7, 0, '=SOMMA(C1:C3)');
+
+Unfortunately, if you wish to support more than one language there are some
+conflicts between function names:
+
+ Function Language 1 Language 2
+ ======== ========== ==========
+ NB French Dutch
+ NA English/French Finnish
+ TRIM French English
+ DIA Spanish/Portuguese German
+
+Therefore, if you try to generate a hash of function names to support both
+French and English then the function TRIM will be assigned the meaning of the
+first language that defines it, which in this case is French. You can get
+around this by renaming the function for one of the languages and documenting
+the change, for example: TRIM.EN or TRIM.FR.
+
+Please note that this only partially solves the problem of localisation.
+There are also number formats to consider (1.5 == 1,5) and the fact that the
+list separator "," and the array separator ";" are interchanged in different
+locales.
+
+The longest function name is LOI.NORMALE.STANDARD.INVERSE (29 chars) followed
+by NORM.JAKAUMA.NORMIT.KÄÄNT (25 chars).
+The shortest function name in all languages is T.
+
+
+
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # Generate function names for different locales.
+ #
+ # This program can be used to generate the hash of known functions for use in
+ # the Formula.pm module. By default the function names are in English but you
+ # can also choose to support the following languages: German, French, Spanish,
+ # Portuguese, Dutch, Finnish, Italian and Swedish.
+ #
+ # This would allow you to do something like the following:
+ #
+ # $worksheet->write(0, 0, '=SUM(C1:C3)' );
+ # $worksheet->write(1, 0, '=SUMME(C1:C3)');
+ # $worksheet->write(2, 0, '=SOMME(C1:C3)');
+ # $worksheet->write(3, 0, '=SUMA(C1:C3)' );
+ # $worksheet->write(4, 0, '=SOMA(C1:C3)' );
+ # $worksheet->write(5, 0, '=SOM(C1:C3)' );
+ # $worksheet->write(6, 0, '=SUMMA(C1:C3)');
+ # $worksheet->write(7, 0, '=SOMMA(C1:C3)');
+ #
+ # Unfortunately, if you wish to support more than one language there are some
+ # conflicts between function names:
+ #
+ # Function Language 1 Language 2
+ # ======== ========== ==========
+ # NB French Dutch
+ # NA English/French Finnish
+ # TRIM French English
+ # DIA Spanish/Portuguese German
+ #
+ # Therefore, if you try to generate a hash of function names to support both
+ # French and English then the function TRIM will be assigned the meaning of the
+ # first language that defines it, which in this case is French. You can get
+ # around this by renaming the function for one of the languages and documenting
+ # the change, for example: TRIM.EN or TRIM.FR.
+ #
+ # Please note that this only partially solves the problem of localisation.
+ # There are also number formats to consider (1.5 == 1,5) and the fact that the
+ # list separator "," and the array separator ";" are interchanged in different
+ # locales.
+ #
+ # The longest function name is LOI.NORMALE.STANDARD.INVERSE (29 chars) followed
+ # by NORM.JAKAUMA.NORMIT.KÄÄNT (25 chars).
+ # The shortest function name in all languages is T.
+ #
+ #
+ # reverse('©'); John McNamara, March 2001, jmcnamara@cpan.org
+ #
+
+
+
+ use strict;
+
+
+ #
+ # Modify the following variables to add the language to the function name hash
+ #
+ my $english = 1;
+ my $german = 0;
+ my $french = 0;
+ my $spanish = 0;
+ my $portuguese = 0;
+ my $dutch = 0;
+ my $finnish = 0;
+ my $italian = 0;
+ my $swedish = 0;
+
+ my %funcs;
+
+ # Ignore the headings
+ <DATA>;
+
+ # Print the beginning of the hash definition
+ print " %functions = (\n";
+ print " #" . " " x 37 ;
+ print "ptg args class vol\n";
+
+ while (<DATA>){
+ my @F = split " ";
+ my $value = $F[0];
+ my $args = $F[1];
+ my $ref = $F[2];
+ my $vol = $F[3];
+
+ print_function($F[4], $value, $args, $ref, $vol) if $english;
+ print_function($F[5], $value, $args, $ref, $vol) if $german;
+ print_function($F[6], $value, $args, $ref, $vol) if $french;
+ print_function($F[7], $value, $args, $ref, $vol) if $spanish;
+ print_function($F[8], $value, $args, $ref, $vol) if $portuguese;
+ print_function($F[9], $value, $args, $ref, $vol) if $dutch;
+ print_function($F[10], $value, $args, $ref, $vol) if $finnish;
+ print_function($F[11], $value, $args, $ref, $vol) if $italian;
+ print_function($F[12], $value, $args, $ref, $vol) if $swedish;
+ }
+ # Print the end of the hash definition
+ print " );\n";
+
+
+ ###############################################################################
+ #
+ # Function to print the function names. It prints a warning if there is a
+ # clash.
+ #
+ sub print_function {
+
+ my $func = shift;
+ my $value = shift;
+ my $args = shift;
+ my $ref = shift;
+ my $vol = shift;
+
+ $func = "'$func'";
+
+ if (not exists $funcs{$func}) {
+ printf(" %-31s => [%4d, %4d, %4d, %4d ],\n",
+ $func, $value, $args, $ref, $vol);
+ $funcs{$func} = $value;
+ }
+ else {
+ if ($funcs{$func} != $value) {
+ print " # Warning ";
+ print $func, " is already defined in another language\n";
+ printf(" #%-31s => [%4d, %4d, %4d, %4d ],\n",
+ $func, $value, $args, $ref, $vol);
+ }
+ }
+ }
+
+
+ # Note: The following data contains the function names in the various
+ # languages. These lines are LONG.
+
+ __DATA__
+ Value Args Refclass Volatile English German French Spanish Portuguese Dutch Finnish Italian Swedish
+ 0 -1 0 0 COUNT ANZAHL NB CONTAR CONT.NÚM AANTAL LASKE CONTA.NUMERI ANTAL
+ 1 -1 1 0 IF WENN SI SI SE ALS JOS SE OM
+ 2 1 1 0 ISNA ISTNV ESTNA ESNOD É.NÃO.DISP ISNB ONPUUTTUU VAL.NON.DISP ÄRSAKNAD
+ 3 1 1 0 ISERROR ISTFEHLER ESTERREUR ESERROR ÉERROS ISFOUT ONVIRHE VAL.ERRORE ÄRFEL
+ 4 -1 0 0 SUM SUMME SOMME SUMA SOMA SOM SUMMA SOMMA SUMMA
+ 5 -1 0 0 AVERAGE MITTELWERT MOYENNE PROMEDIO MÉDIA GEMIDDELDE KESKIARVO MEDIA MEDEL
+ 6 -1 0 0 MIN MIN MIN MIN MÍNIMO MIN MIN MIN MIN
+ 7 -1 0 0 MAX MAX MAX MAX MÁXIMO MAX MAKS MAX MAX
+ 8 -1 0 0 ROW ZEILE LIGNE FILA LIN RIJ RIVI RIF.RIGA RAD
+ 9 -1 0 0 COLUMN SPALTE COLONNE COLUMNA COL KOLOM SARAKE RIF.COLONNA KOLUMN
+ 10 0 0 0 NA NV NA NOD NÃO.DISP NB PUUTTUU NON.DISP SAKNAS
+ 11 -1 1 0 NPV NBW VAN VNA VPL NHW NNA VAN NETNUVÄRDE
+ 12 -1 0 0 STDEV STABW ECARTYPE DESVEST DESVPAD STDEV KESKIHAJONTA DEV.ST STDAV
+ 13 -1 1 0 DOLLAR DM FRANC MONEDA MOEDA GULDEN VALUUTTA VALUTA VALUTA
+ 14 -1 1 0 FIXED FEST CTXT DECIMAL DEF.NÚM.DEC VAST KIINTEÄ FISSO FASTTAL
+ 15 1 1 0 SIN SIN SIN SENO SEN SIN SIN SEN SIN
+ 16 1 1 0 COS COS COS COS COS COS COS COS COS
+ 17 1 1 0 TAN TAN TAN TAN TAN TAN TAN TAN TAN
+ 18 1 1 0 ATAN ARCTAN ATAN ATAN ATAN BOOGTAN ATAN ARCTAN ARCTAN
+ 19 0 1 0 PI PI PI PI PI PI PII PI.GRECO PI
+ 20 1 1 0 SQRT WURZEL RACINE RAIZ RAIZ WORTEL NELIÖJUURI RADQ ROT
+ 21 1 1 0 EXP EXP EXP EXP EXP EXP EKSPONENTTI EXP EXP
+ 22 1 1 0 LN LN LN LN LN LN LUONNLOG LN LN
+ 23 1 1 0 LOG10 LOG10 LOG10 LOG10 LOG10 LOG10 LOG10 LOG10 LOG10
+ 24 1 1 0 ABS ABS ABS ABS ABS ABS ITSEISARVO ASS ABS
+ 25 1 1 0 INT GANZZAHL ENT ENTERO INT INTEGER KOKONAISLUKU INT HELTAL
+ 26 1 1 0 SIGN VORZEICHEN SIGNE SIGNO SINAL POS.NEG ETUMERKKI SEGNO TECKEN
+ 27 2 1 0 ROUND RUNDEN ARRONDI REDONDEAR ARRED AFRONDEN PYÖRISTÄ ARROTONDA AVRUNDA
+ 28 -1 0 0 LOOKUP VERWEIS RECHERCHE BUSCAR PROC ZOEKEN HAKU CERCA LETAUPP
+ 29 -1 0 1 INDEX INDEX INDEX INDICE ÍNDICE INDEX INDEKSI INDICE INDEX
+ 30 2 1 0 REPT WIEDERHOLEN REPT REPETIR REPETIR HERHALING TOISTA RIPETI REP
+ 31 3 1 0 MID TEIL STXT EXTRAE EXT.TEXTO DEEL POIMI.TEKSTI STRINGA.ESTRAI EXTEXT
+ 32 1 1 0 LEN LÄNGE NBCAR LARGO NÚM.CARACT LENGTE PITUUS LUNGHEZZA LÄNGD
+ 33 1 1 0 VALUE WERT CNUM VALOR VALOR WAARDE ARVO VALORE TEXTNUM
+ 34 0 1 0 TRUE WAHR VRAI VERDADERO VERDADEIRO WAAR TOSI VERO SANT
+ 35 0 1 0 FALSE FALSCH FAUX FALSO FALSO ONWAAR EPÄTOSI FALSO FALSKT
+ 36 -1 0 0 AND UND ET Y E EN JA E OCH
+ 37 -1 0 0 OR ODER OU O OU OF TAI O ELLER
+ 38 1 1 0 NOT NICHT NON NO NÃO NIET EI NON ICKE
+ 39 2 1 0 MOD REST MOD RESIDUO MOD REST JAKOJ RESTO REST
+ 40 3 0 0 DCOUNT DBANZAHL BDNB BDCONTAR BDCONTAR DBAANTAL TLASKE DB.CONTA.NUMERI DANTAL
+ 41 3 0 0 DSUM DBSUMME BDSOMME BDSUMA BDSOMA DBSOM TSUMMA DB.SOMMA DSUMMA
+ 42 3 0 0 DAVERAGE DBMITTELWERT BDMOYENNE BDPROMEDIO BDMÉDIA DBGEMIDDELDE TKESKIARVO DB.MEDIA DMEDEL
+ 43 3 0 0 DMIN DBMIN BDMIN BDMIN BDMÍN DBMIN TMIN DB.MIN DMIN
+ 44 3 0 0 DMAX DBMAX BDMAX BDMAX BDMÁX DBMAX TMAKS DB.MAX DMAX
+ 45 3 0 0 DSTDEV DBSTDABW BDECARTYPE BDDESVEST BDEST DBSTDEV TKESKIHAJONTA DB.DEV.ST DSTDAV
+ 46 -1 0 0 VAR VARIANZ VAR VAR VAR VAR VAR VAR VARIANS
+ 47 3 0 0 DVAR DBVARIANZ BDVAR BDVAR BDVAREST DBVAR TVARIANSSI DB.VAR DVARIANS
+ 48 2 1 0 TEXT TEXT TEXTE TEXTO TEXTO TEKST TEKSTI TESTO TEXT
+ 49 -1 0 0 LINEST RGP DROITEREG ESTIMACION.LINEAL PROJ.LIN LIJNSCH LINREGR REGR.LIN REGR
+ 50 -1 0 0 TREND TREND TENDANCE TENDENCIA TENDÊNCIA TREND SUUNTAUS TENDENZA TREND
+ 51 -1 0 0 LOGEST RKP LOGREG ESTIMACION.LOGARITMICA PROJ.LOG LOGSCH LOGREGR REGR.LOG EXPREGR
+ 52 -1 0 0 GROWTH VARIATION CROISSANCE CRECIMIENTO CRESCIMENTO GROEI KASVU CRESCITA EXPTREND
+ 56 -1 1 0 PV BW VA VA VP HW NA VA NUVÄRDE
+ 57 -1 1 0 FV ZW VC VF VF TW TULEVA.ARVO VAL.FUT SLUTVÄRDE
+ 58 -1 1 0 NPER ZZR NPM NPER NPER NPER NJAKSO NUM.RATE PERIODER
+ 59 -1 1 0 PMT RMZ VPM PAGO PGTO BET MAKSU RATA BETALNING
+ 60 -1 1 0 RATE ZINS TAUX TASA TAXA RENTE KORKO TASSO RÄNTA
+ 61 3 0 0 MIRR QIKV TRIM TIRM MTIR GIR MSISÄINEN TIR.VAR MODIR
+ 62 -1 0 0 IRR IKV TRI TIR TIR IR SISÄINEN.KORKO TIR.COST IR
+ 63 0 1 1 RAND ZUFALLSZAHL ALEA ALEATORIO ALEATÓRIO ASELECT SATUNNAISLUKU CASUALE SLUMP
+ 64 -1 0 0 MATCH VERGLEICH EQUIV COINCIDIR CORRESP VERGELIJKEN VASTINE CONFRONTA PASSA
+ 65 3 1 0 DATE DATUM DATE FECHA DATA DATUM PÄIVÄYS DATA DATUM
+ 66 3 1 0 TIME ZEIT TEMPS NSHORA TEMPO TIJD AIKA ORARIO KLOCKSLAG
+ 67 1 1 0 DAY TAG JOUR DIA DIA DAG PÄIVÄ GIORNO DAG
+ 68 1 1 0 MONTH MONAT MOIS MES MÊS MAAND KUUKAUSI MESE MÅNAD
+ 69 1 1 0 YEAR JAHR ANNEE AÑO ANO JAAR VUOSI ANNO ÅR
+ 70 -1 1 0 WEEKDAY WOCHENTAG JOURSEM DIASEM DIA.DA.SEMANA WEEKDAG VIIKONPÄIVÄ GIORNO.SETTIMANA VECKODAG
+ 71 1 1 0 HOUR STUNDE HEURE HORA HORA UUR TUNNIT ORA TIMME
+ 72 1 1 0 MINUTE MINUTE MINUTE MINUTO MINUTO MINUUT MINUUTIT MINUTO MINUT
+ 73 1 1 0 SECOND SEKUNDE SECONDE SEGUNDO SEGUNDO SECONDE SEKUNNIT SECONDO SEKUND
+ 74 0 1 1 NOW JETZT MAINTENANT AHORA AGORA NU NYT ADESSO NU
+ 75 1 0 1 AREAS BEREICHE ZONES AREAS ÁREAS BEREIKEN ALUEET AREE OMRÅDEN
+ 76 1 0 1 ROWS ZEILEN LIGNES FILAS LINS RIJEN RIVIT RIGHE RADER
+ 77 1 0 1 COLUMNS SPALTEN COLONNES COLUMNAS COLS KOLOMMEN SARAKKEET COLONNE KOLUMNER
+ 78 -1 0 1 OFFSET BEREICH.VERSCHIEBEN DECALER DESREF DESLOC VERSCHUIVING SIIRTYMÄ SCARTO FÖRSKJUTNING
+ 82 -1 1 0 SEARCH SUCHEN CHERCHE HALLAR LOCALIZAR VIND.SPEC KÄY.LÄPI RICERCA SÖK
+ 83 1 1 0 TRANSPOSE MTRANS TRANSPOSE TRANSPONER TRANSPOR TRANSPONEREN TRANSPONOI MATR.TRASPOSTA TRANSPONERA
+ 86 1 1 0 TYPE TYP TYPE TIPO TIPO TYPE TYYPPI TIPO VÄRDETYP
+ 97 2 1 0 ATAN2 ARCTAN2 ATAN2 ATAN2 ATAN2 BOOGTAN2 ATAN2 ARCTAN.2 ARCTAN2
+ 98 1 1 0 ASIN ARCSIN ASIN ASENO ASEN BOOGSIN ASIN ARCSEN ARCSIN
+ 99 1 1 0 ACOS ARCCOS ACOS ACOS ACOS BOOGCOS ACOS ARCCOS ARCCOS
+ 100 -1 1 0 CHOOSE WAHL CHOISIR ELEGIR ESCOLHER KIEZEN VALITSE.INDEKSI SCEGLI VÄLJ
+ 101 -1 0 0 HLOOKUP WVERWEIS RECHERCHEH BUSCARH PROCH HORIZ.ZOEKEN VHAKU CERCA.ORIZZ LETAKOLUMN
+ 102 -1 0 0 VLOOKUP SVERWEIS RECHERCHEV BUSCARV PROCV VERT.ZOEKEN PHAKU CERCA.VERT LETARAD
+ 105 1 0 0 ISREF ISTBEZUG ESTREF ESREF ÉREF ISVERWIJZING ONVIITT VAL.RIF ÄRREF
+ 109 -1 1 0 LOG LOG LOG LOG LOG LOG LOG LOG LOG
+ 111 1 1 0 CHAR ZEICHEN CAR CARACTER CARACT TEKEN MERKKI CODICE.CARATT TECKENKOD
+ 112 1 1 0 LOWER KLEIN MINUSCULE MINUSC MINÚSCULA KLEINE.LETTERS PIENET MINUSC GEMENER
+ 113 1 1 0 UPPER GROSS MAJUSCULE MAYUSC MAIÚSCULA HOOFDLETTERS ISOT MAIUSC VERSALER
+ 114 1 1 0 PROPER GROSS2 NOMPROPRE NOMPROPIO PRI.MAIÚSCULA BEGINLETTERS ERISNIMI MAIUSC.INIZ INITIAL
+ 115 -1 1 0 LEFT LINKS GAUCHE IZQUIERDA ESQUERDA LINKS VASEN SINISTRA VÄNSTER
+ 116 -1 1 0 RIGHT RECHTS DROITE DERECHA DIREITA RECHTS OIKEA DESTRA HÖGER
+ 117 2 1 0 EXACT IDENTISCH EXACT IGUAL EXATO GELIJK VERTAA IDENTICO EXAKT
+ 118 1 1 0 TRIM GLÄTTEN SUPPRESPACE ESPACIOS ARRUMAR SPATIES.WISSEN POISTA.VÄLIT ANNULLA.SPAZI RENSA
+ 119 4 1 0 REPLACE ERSETZEN REMPLACER REEMPLAZAR MUDAR VERVANGEN KORVAA RIMPIAZZA ERSÄTT
+ 120 -1 1 0 SUBSTITUTE WECHSELN SUBSTITUE SUSTITUIR SUBSTITUIR SUBSTITUEREN VAIHDA SOSTITUISCI BYT.UT
+ 121 1 1 0 CODE CODE CODE CODIGO CÓDIGO CODE KOODI CODICE KOD
+ 124 -1 1 0 FIND FINDEN TROUVE ENCONTRAR PROCURAR VIND.ALLES ETSI TROVA HITTA
+ 125 -1 0 1 CELL ZELLE CELLULE CELDA CÉL CEL SOLU CELLA CELL
+ 126 1 1 0 ISERR ISTFEHL ESTERR ESERR ÉERRO ISFOUT2 ONVIRH VAL.ERR ÄRF
+ 127 1 1 0 ISTEXT ISTTEXT ESTTEXTE ESTEXTO ÉTEXTO ISTEKST ONTEKSTI VAL.TESTO ÄRTEXT
+ 128 1 1 0 ISNUMBER ISTZAHL ESTNUM ESNUMERO ÉNÚM ISGETAL ONLUKU VAL.NUMERO ÄRTAL
+ 129 1 1 0 ISBLANK ISTLEER ESTVIDE ESBLANCO ÉCÉL.VAZIA ISLEEG ONTYHJÄ VAL.VUOTO ÄRTOM
+ 130 1 0 0 T T T T T T T T T
+ 131 1 0 0 N N N N N N N NUM N
+ 140 1 1 0 DATEVALUE DATWERT DATEVAL FECHANUMERO DATA.VALOR DATUMWAARDE PÄIVÄYSARVO DATA.VALORE DATUMVÄRDE
+ 141 1 1 0 TIMEVALUE ZEITWERT TEMPSVAL HORANUMERO VALOR.TEMPO TIJDWAARDE AIKA_ARVO ORARIO.VALORE TIDVÄRDE
+ 142 3 1 0 SLN LIA AMORLIN SLN DPD LIN.AFSCHR STP AMMORT.COST LINAVSKR
+ 143 4 1 0 SYD DIA SYD SYD SDA SYD VUOSIPOISTO AMMORT.ANNUO ÅRSAVSKR
+ 144 -1 1 0 DDB GDA DDB DDB BDD DDB DDB AMMORT DEGAVSKR
+ 148 -1 1 1 INDIRECT INDIREKT INDIRECT INDIRECTO INDIRETO INDIRECT EPÄSUORA INDIRETTO INDIREKT
+ 150 -1 1 0 CALL AUFRUFEN FONCTION.APPELANTE LLAMAR CHAMAR ROEPEN KUTSU RICHIAMA ANROPA
+ 162 1 1 0 CLEAN SÄUBERN EPURAGE LIMPIAR TIRAR WISSEN.CONTROL SIIVOA LIBERA STÄDA
+ 163 1 2 0 MDETERM MDET DETERMAT MDETERM MATRIZ.DETERM DETERMINANTMAT MDETERM MATR.DETERM MDETERM
+ 164 1 2 0 MINVERSE MINV INVERSEMAT MINVERSA MATRIZ.INVERSO INVERSEMAT MKÄÄNTEINEN MATR.INVERSA MINVERT
+ 165 2 2 0 MMULT MMULT PRODUITMAT MMULT MATRIZ.MULT PRODUKTMAT MKERRO MATR.PRODOTTO MMULT
+ 167 -1 1 0 IPMT ZINSZ INTPER PAGOINT IPGTO IBET IPMT INTERESSI RBETALNING
+ 168 -1 1 0 PPMT KAPZ PRINCPER PAGOPRIN PPGTO PBET PPMT P.RATA AMORT
+ 169 -1 0 0 COUNTA ANZAHL2 NBVAL CONTARA CONT.VALORES AANTALARG LASKE.A CONTA.VALORI ANTALV
+ 183 -1 0 0 PRODUCT PRODUKT PRODUIT PRODUCTO MULT PRODUKT TULO PRODOTTO PRODUKT
+ 184 1 1 0 FACT FAKULTÄT FACT FACT FATORIAL FACULTEIT KERTOMA FATTORIALE FAKULTET
+ 189 3 0 0 DPRODUCT DBPRODUKT BDPRODUIT BDPRODUCTO BDMULTIPL DBPRODUKT TTULO DB.PRODOTTO DPRODUKT
+ 190 1 1 0 ISNONTEXT ISTKTEXT ESTNONTEXTE ESNOTEXTO É.NÃO.TEXTO ISGEENTEKST ONEI_TEKSTI VAL.NON.TESTO ÄREJTEXT
+ 193 -1 0 0 STDEVP STABWN ECARTYPEP DESVESTP DESVPADP STDEVP KESKIHAJONTAP DEV.ST.POP STDAVP
+ 194 -1 0 0 VARP VARIANZEN VAR.P VARP VARP VARP VARP VAR.POP VARIANSP
+ 195 3 0 0 DSTDEVP DBSTDABWN BDECARTYPEP BDDESVESTP BDDESVPA DBSTDEVP TKESKIHAJONTAP DB.DEV.ST.POP DSTDAVP
+ 196 3 0 0 DVARP DBVARIANZEN BDVARP BDVARP BDVARP DBVARP TVARIANSSIP DB.VAR.POP DVARIANSP
+ 197 -1 1 0 TRUNC KÜRZEN TRONQUE TRUNCAR TRUNCAR GEHEEL KATKAISE TRONCA AVKORTA
+ 198 1 1 0 ISLOGICAL ISTLOG ESTLOGIQUE ESLOGICO ÉLÓGICO ISLOGISCH ONTOTUUS VAL.LOGICO ÄRLOGISK
+ 199 3 0 0 DCOUNTA DBANZAHL2 BDNBVAL BDCONTARA BDCONTARA DBAANTALC TLASKEA DB.CONTA.VALORI DANTALV
+ 212 2 1 0 ROUNDUP AUFRUNDEN ARRONDI.SUP REDONDEAR.MAS ARREDONDAR.PARA.CIMA AFRONDEN.NAAR.BOVEN PYÖRISTÄ.DES.YLÖS ARROTONDA.PER.ECC AVRUNDA.UPPÅT
+ 213 2 1 0 ROUNDDOWN ABRUNDEN ARRONDI.INF REDONDEAR.MENOS ARREDONDAR.PARA.BAIXO AFRONDEN.NAAR.BENEDEN PYÖRISTÄ.DES.ALAS ARROTONDA.PER.DIF AVRUNDA.NEDÅT
+ 216 -1 0 0 RANK RANG RANG JERARQUIA ORDEM RANG ARVON.MUKAAN RANGO RANG
+ 219 -1 1 0 ADDRESS ADRESSE ADRESSE DIRECCION ENDEREÇO ADRES OSOITE INDIRIZZO ADRESS
+ 220 -1 1 0 DAYS360 TAGE360 JOURS360 DIAS360 DIAS360 DAGEN360 PÄIVÄT360 GIORNO360 DAGAR360
+ 221 0 1 1 TODAY HEUTE AUJOURDHUI HOY HOJE VANDAAG TÄMÄ.PÄIVÄ OGGI IDAG
+ 222 -1 1 0 VDB VDB VDB DVS BDV VDB VDB AMMORT.VAR VDEGRAVSKR
+ 227 -1 0 0 MEDIAN MEDIAN MEDIANE MEDIANA MED MEDIAAN MEDIAANI MEDIANA MEDIAN
+ 228 -1 2 0 SUMPRODUCT SUMMENPRODUKT SOMMEPROD SUMAPRODUCTO SOMARPRODUTO SOMPRODUKT TULOJEN.SUMMA MATR.SOMMA.PRODOTTO PRODUKTSUMMA
+ 229 1 1 0 SINH SINHYP SINH SENOH SENH SINH SINH SENH SINH
+ 230 1 1 0 COSH COSHYP COSH COSH COSH COSH COSH COSH COSH
+ 231 1 1 0 TANH TANHYP TANH TANH TANH TANH TANH TANH TANH
+ 232 1 1 0 ASINH ARCSINHYP ASINH ASENOH ASENH BOOGSINH ASINH ARCSENH ARCSINH
+ 233 1 1 0 ACOSH ARCCOSHYP ACOSH ACOSH ACOSH BOOGCOSH ACOSH ARCCOSH ARCCOSH
+ 234 1 1 0 ATANH ARCTANHYP ATANH ATANH ATANH BOOGTANH ATANH ARCTANH ARCTANH
+ 235 3 0 0 DGET DBAUSZUG BDLIRE BDEXTRAER BDEXTRAIR DBLEZEN TNOUDA DB.VALORI DHÄMTA
+ 244 1 1 1 INFO INFO INFO INFO INFORMAÇÃO INFO KUVAUS AMBIENTE.INFO INFO
+ 247 -1 1 0 DB GDA2 DB DB BD DB DB AMMORT.FISSO DB
+ 252 2 0 0 FREQUENCY HÄUFIGKEIT FREQUENCE FRECUENCIA FREQÜÊNCIA INTERVAL TAAJUUS FREQUENZA FREKVENS
+ 261 1 1 0 ERROR.TYPE FEHLER.TYP TYPE.ERREUR TIPO.DE.ERROR TIPO.ERRO TYPE.FOUT VIRHEEN.LAJI ERRORE.TIPO FEL.TYP
+ 267 -1 1 0 REGISTER.ID REGISTER.KENNUMMER REGISTRE.NUMERO ID.REGISTRO IDENT.REGISTRO REGISTRATIE.ID REKISTERI.TUNNUS IDENTIFICATORE.REGISTRO REGISTRERA.ID
+ 269 -1 0 0 AVEDEV MITTELABW ECART.MOYEN DESVPROM DESV.MÉDIO GEM.DEVIATIE KESKIPOIKKEAMA MEDIA.DEV MEDELAVV
+ 270 -1 1 0 BETADIST BETAVERT LOI.BETA DISTR.BETA DISTBETA BETA.VERD BEETAJAKAUMA DISTRIB.BETA BETAFÖRD
+ 271 1 1 0 GAMMALN GAMMALN LNGAMMA GAMMA.LN LNGAMA GAMMA.LN GAMMALN LN.GAMMA GAMMALN
+ 272 -1 1 0 BETAINV BETAINV BETA.INVERSE DISTR.BETA.INV BETA.ACUM.INV BETA.INV BEETAJAKAUMA.KÄÄNT INV.BETA BETAINV
+ 273 4 1 0 BINOMDIST BINOMVERT LOI.BINOMIALE DISTR.BINOM DISTRBINOM BINOMIALE.VERD BINOMIJAKAUMA DISTRIB.BINOM BINOMFÖRD
+ 274 2 1 0 CHIDIST CHIVERT LOI.KHIDEUX DISTR.CHI DIST.QUI CHI.KWADRAAT CHIJAKAUMA DISTRIB.CHI CHI2FÖRD
+ 275 2 1 0 CHIINV CHIINV KHIDEUX.INVERSE PRUEBA.CHI.INV INV.QUI CHI.KWADRAAT.INV CHIJAKAUMA.KÄÄNT INV.CHI CHI2INV
+ 276 2 1 0 COMBIN KOMBINATIONEN COMBIN COMBINAT COMBIN COMBINATIES KOMBINAATIO COMBINAZIONE KOMBIN
+ 277 3 1 0 CONFIDENCE KONFIDENZ INTERVALLE.CONFIANCE INTERVALO.CONFIANZA INT.CONFIANÇA BETROUWBAARHEID LUOTTAMUSVÄLI CONFIDENZA KONFIDENS
+ 278 3 1 0 CRITBINOM KRITBINOM CRITERE.LOI.BINOMIALE BINOM.CRIT CRIT.BINOM CRIT.BINOM BINOMIJAKAUMA.KRIT CRIT.BINOM KRITBINOM
+ 279 1 1 0 EVEN GERADE PAIR REDONDEA.PAR PAR EVEN PARILLINEN PARI JÄMN
+ 280 3 1 0 EXPONDIST EXPONVERT LOI.EXPONENTIELLE DISTR.EXP DISTEXPON EXPON.VERD EKSPONENTIAALIJAKAUMA DISTRIB.EXP EXPONFÖRD
+ 281 3 1 0 FDIST FVERT LOI.F DISTR.F DISTF F.VERDELING FJAKAUMA DISTRIB.F FFÖRD
+ 282 3 1 0 FINV FINV INVERSE.LOI.F DISTR.F.INV INVF F.INVERSE FJAKAUMA.KÄÄNT INV.F FINV
+ 283 1 1 0 FISHER FISHER FISHER FISHER FISHER FISHER FISHER FISHER FISHER
+ 284 1 1 0 FISHERINV FISHERINV FISHER.INVERSE PRUEBA.FISHER.INV FISHERINV FISHER.INV FISHER.KÄÄNT INV.FISHER FISHERINV
+ 285 2 1 0 FLOOR UNTERGRENZE PLANCHER MULTIPLO.INFERIOR ARREDMULTB AFRONDEN.BENEDEN PYÖRISTÄ.KERR.ALAS ARROTONDA.DIFETTO RUNDA.NER
+ 286 4 1 0 GAMMADIST GAMMAVERT LOI.GAMMA DISTR.GAMMA DISTGAMA GAMMA.VERD GAMMAJAKAUMA DISTRIB.GAMMA GAMMAFÖRD
+ 287 3 1 0 GAMMAINV GAMMAINV LOI.GAMMA.INVERSE DISTR.GAMMA.INV INVGAMA GAMMA.INV GAMMAJAKAUMA.KÄÄNT INV.GAMMA GAMMAINV
+ 288 2 1 0 CEILING OBERGRENZE PLAFOND MULTIPLO.SUPERIOR TETO AFRONDEN.BOVEN PYÖRISTÄ.KERR.YLÖS ARROTONDA.ECCESSO RUNDA.UPP
+ 289 4 1 0 HYPGEOMDIST HYPGEOMVERT LOI.HYPERGEOMETRIQUE DISTR.HIPERGEOM DIST.HIPERGEOM HYPERGEO.VERD HYPERGEOM.JAKAUMA DISTRIB.IPERGEOM HYPGEOMFÖRD
+ 290 3 1 0 LOGNORMDIST LOGNORMVERT LOI.LOGNORMALE DISTR.LOG.NORM DIST.LOGNORMAL LOG.NORM.VERD LOGNORM.JAKAUMA DISTRIB.LOGNORM LOGNORMFÖRD
+ 291 3 1 0 LOGINV LOGINV LOI.LOGNORMALE.INVERSE DISTR.LOG.INV INVLOG LOG.NORM.INV LOGNORM.JAKAUMA.KÄÄNT INV.LOGNORM LOGINV
+ 292 3 1 0 NEGBINOMDIST NEGBINOMVERT LOI.BINOMIALE.NEG NEGBINOMDIST DIST.BIN.NEG NEG.BINOM.VERD BINOMIJAKAUMA.NEG DISTRIB.BINOM.NEG NEGBINOMFÖRD
+ 293 4 1 0 NORMDIST NORMVERT LOI.NORMALE DISTR.NORM DIST.NORM NORM.VERD NORM.JAKAUMA DISTRIB.NORM NORMFÖRD
+ 294 1 1 0 NORMSDIST STANDNORMVERT LOI.NORMALE.STANDARD DISTR.NORM.ESTAND DIST.NORMP STAND.NORM.VERD NORM.JAKAUMA.NORMIT DISTRIB.NORM.ST NORMSFÖRD
+ 295 3 1 0 NORMINV NORMINV LOI.NORMALE.INVERSE DISTR.NORM.INV INV.NORM NORM.INV NORM.JAKAUMA.KÄÄNT INV.NORM NORMINV
+ 296 1 1 0 NORMSINV STANDNORMINV LOI.NORMALE.STANDARD.INVERSE DISTR.NORM.ESTAND.INV INV.NORMP STAND.NORM.INV NORM.JAKAUMA.NORMIT.KÄÄNT INV.NORM.ST NORMSINV
+ 297 3 1 0 STANDARDIZE STANDARDISIERUNG CENTREE.REDUITE NORMALIZACION PADRONIZAR NORMALISEREN NORMITA NORMALIZZA STANDARDISERA
+ 298 1 1 0 ODD UNGERADE IMPAIR REDONDEA.IMPAR ÍMPAR ONEVEN PARITON DISPARI UDDA
+ 299 2 1 0 PERMUT VARIATIONEN PERMUTATION PERMUTACIONES PERMUT PERMUTATIES PERMUTAATIO PERMUTAZIONE PERMUT
+ 300 3 1 0 POISSON POISSON LOI.POISSON POISSON POISSON POISSON POISSON POISSON POISSON
+ 301 3 1 0 TDIST TVERT LOI.STUDENT DISTR.T DISTT T.VERD TJAKAUMA DISTRIB.T TFÖRD
+ 302 4 1 0 WEIBULL WEIBULL LOI.WEIBULL DIST.WEIBULL WEIBULL WEIBULL WEIBULL WEIBULL WEIBULL
+ 303 2 2 0 SUMXMY2 SUMMEXMY2 SOMME.XMY2 SUMAXMENOSY2 SOMAXMY2 SOM.XMINY.2 EROTUSTEN.NELIÖSUMMA SOMMA.Q.DIFF SUMMAXMY2
+ 304 2 2 0 SUMX2MY2 SUMMEX2MY2 SOMME.X2MY2 SUMAX2MENOSY2 SOMAX2DY2 SOM.X2MINY2 NELIÖSUMMIEN.EROTUS SOMMA.DIFF.Q SUMMAX2MY2
+ 305 2 2 0 SUMX2PY2 SUMMEX2PY2 SOMME.X2PY2 SUMAX2MASY2 SOMAX2SY2 SOM.X2PLUSY2 NELIÖSUMMIEN.SUMMA SOMMA.SOMMA.Q SUMMAX2PY2
+ 306 2 2 0 CHITEST CHITEST TEST.KHIDEUX PRUEBA.CHI TESTE.QUI CHI.TOETS CHITESTI TEST.CHI CHI2TEST
+ 307 2 2 0 CORREL KORREL COEFFICIENT.CORRELATION COEF.DE.CORREL CORREL CORRELATIE KORRELAATIO CORRELAZIONE KORREL
+ 308 2 2 0 COVAR KOVAR COVARIANCE COVAR COVAR COVARIANTIE KOVARIANSSI COVARIANZA KOVAR
+ 309 3 2 0 FORECAST SCHÄTZER PREVISION PRONOSTICO PREVISÃO VOORSPELLEN ENNUSTE PREVISIONE PREDIKTION
+ 310 2 2 0 FTEST FTEST TEST.F PRUEBA.F TESTEF F.TOETS FTESTI TEST.F FTEST
+ 311 2 2 0 INTERCEPT ACHSENABSCHNITT ORDONNEE.ORIGINE INTERSECCION INTERCEPÇÃO SNIJPUNT LEIKKAUSPISTE INTERCETTA SKÄRNINGSPUNKT
+ 312 2 2 0 PEARSON PEARSON PEARSON PEARSON PEARSON PEARSON PEARSON PEARSON PEARSON
+ 313 2 2 0 RSQ BESTIMMTHEITSMASS COEFFICIENT.DETERMINATION COEFICIENTE.R2 RQUAD R.KWADRAAT PEARSON.NELIÖ RQ RKV
+ 314 2 2 0 STEYX STFEHLERYX ERREUR.TYPE.XY ERROR.TIPICO.XY EPADYX STAND.FOUT.YX KESKIVIRHE ERR.STD.YX STDFELYX
+ 315 2 2 0 SLOPE STEIGUNG PENTE PENDIENTE INCLINAÇÃO RICHTING KULMAKERROIN PENDENZA LUTNING
+ 316 4 2 0 TTEST TTEST TEST.STUDENT PRUEBA.T TESTET T.TOETS TTESTI TEST.T TTEST
+ 317 -1 2 0 PROB WAHRSCHBEREICH PROBABILITE PROBABILIDAD PROB KANS TODENNÄKÖISYYS PROBABILITÀ SANNOLIKHET
+ 318 -1 0 0 DEVSQ SUMQUADABW SOMME.CARRES.ECARTS DESVIA2 DESVQ DEV.KWAD OIKAISTU.NELIÖSUMMA DEV.Q KVADAVV
+ 319 -1 0 0 GEOMEAN GEOMITTEL MOYENNE.GEOMETRIQUE MEDIA.GEOM MÉDIA.GEOMÉTRICA MEETK.GEM KESKIARVO.GEOM MEDIA.GEOMETRICA GEOMEDEL
+ 320 -1 0 0 HARMEAN HARMITTEL MOYENNE.HARMONIQUE MEDIA.ARMO MÉDIA.HARMÔNICA HARM.GEM KESKIARVO.HARM MEDIA.ARMONICA HARMMEDEL
+ 321 -1 0 0 SUMSQ QUADRATESUMME SOMME.CARRES SUMA.CUADRADOS SOMAQUAD KWADRATENSOM NELIÖSUMMA SOMMA.Q KVADRATSUMMA
+ 322 -1 0 0 KURT KURT KURTOSIS CURTOSIS CURT KURTOSIS KURT CURTOSI TOPPIGHET
+ 323 -1 0 0 SKEW SCHIEFE COEFFICIENT.ASYMETRIE COEFICIENTE.ASIMETRIA DISTORÇÃO SCHEEFHEID JAKAUMAN.VINOUS ASIMMETRIA SNEDHET
+ 324 -1 0 0 ZTEST GTEST TEST.Z PRUEBA.Z TESTEZ Z.TOETS ZTESTI TEST.Z ZTEST
+ 325 2 0 0 LARGE KGRÖSSTE GRANDE.VALEUR K.ESIMO.MAYOR MAIOR GROOTSTE SUURI GRANDE STÖRSTA
+ 326 2 0 0 SMALL KKLEINSTE PETITE.VALEUR K.ESIMO.MENOR MENOR KLEINSTE PIENI PICCOLO MINSTA
+ 327 2 0 0 QUARTILE QUARTILE QUARTILE CUARTIL QUARTIL KWARTIEL NELJÄNNES QUARTILE KVARTIL
+ 328 2 0 0 PERCENTILE QUANTIL CENTILE PERCENTIL PERCENTIL PERCENTIEL PROSENTTIPISTE PERCENTILE PERCENTIL
+ 329 -1 0 0 PERCENTRANK QUANTILSRANG RANG.POURCENTAGE RANGO.PERCENTIL ORDEM.PORCENTUAL PERCENT.RANG PROSENTTIJÄRJESTYS PERCENT.RANGO PROCENTRANG
+ 330 -1 2 0 MODE MODALWERT MODE MODA MODO MODUS MOODI MODA TYPVÄRDE
+ 331 2 0 0 TRIMMEAN GESTUTZTMITTEL MOYENNE.REDUITE MEDIA.ACOTADA MÉDIA.INTERNA GETRIMD.GEM KESKIARVO.TASATTU MEDIA.TRONCATA TRIMMEDEL
+ 332 2 1 0 TINV TINV LOI.STUDENT.INVERSE DISTR.T.INV INVT T.INV TJAKAUMA.KÄÄNT INV.T TINV
+ 336 -1 1 0 CONCATENATE VERKETTEN CONCATENER CONCATENAR CONCATENAR TEKST.SAMENVOEGEN KETJUTA CONCATENA SAMMANFOGA
+ 337 2 1 0 POWER POTENZ PUISSANCE POTENCIA POTÊNCIA MACHT POTENSSI POTENZA UPPHÖJT.TILL
+ 342 1 1 0 RADIANS RADIANT RADIANS RADIANES RADIANOS RADIALEN RADIAANIT RADIANTI RADIANER
+ 343 1 1 0 DEGREES GRAD DEGRES GRADOS GRAUS GRADEN ASTEET GRADI GRADER
+ 344 -1 0 0 SUBTOTAL TEILERGEBNIS SOUS.TOTAL SUBTOTALES SUBTOTAL SUBTOTAAL VÄLISUMMA SUBTOTALE DELSUMMA
+ 345 -1 0 0 SUMIF SUMMEWENN SOMME.SI SUMAR.SI SOMASE SOM.ALS SUMMA.JOS SOMMA.SE SUMMA.OM
+ 346 2 0 0 COUNTIF ZÄHLENWENN NB.SI CONTAR.SI CONT.SE AANTAL.ALS LASKE.JOS CONTA.SE ANTAL.OM
+ 347 1 0 0 COUNTBLANK ANZAHLLEEREZELLEN NB.VIDE CONTAR.BLANCO CONTAR.VAZIO AANTAL.LEGE.CELLEN LASKE.TYHJÄT CONTA.VUOTE ANTAL.TOMMA
+ 354 -1 1 0 ROMAN RÖMISCH ROMAIN NUMERO.ROMANO ROMANO ROMEINS ROMAN ROMANO ROMERSK
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/function_locale.pl>
+
+=head2 Example: writeA1.pl
+
+
+
+This is an example of how to extend the Spreadsheet::WriteExcel module.
+
+Code is appended to the Spreadsheet::WriteExcel::Worksheet module by reusing
+the package name. The new code provides a write() method that allows you to
+use Excels A1 style cell references. This is not particularly useful but it
+serves as an example of how the module can be extended without modifying the
+code directly.
+
+
+
+ #!/usr/bin/perl -w
+
+ ###############################################################################
+ #
+ # This is an example of how to extend the Spreadsheet::WriteExcel module.
+ #
+ # Code is appended to the Spreadsheet::WriteExcel::Worksheet module by reusing
+ # the package name. The new code provides a write() method that allows you to
+ # use Excels A1 style cell references. This is not particularly useful but it
+ # serves as an example of how the module can be extended without modifying the
+ # code directly.
+ #
+ # reverse('©'), March 2001, John McNamara, jmcnamara@cpan.org
+ #
+
+ use strict;
+ use Spreadsheet::WriteExcel;
+
+ # Create a new workbook called simple.xls and add a worksheet
+ my $workbook = Spreadsheet::WriteExcel->new("writeA1.xls");
+ my $worksheet = $workbook->add_worksheet();
+
+ # Write numbers or text
+ $worksheet->write (0, 0, "Hello");
+ $worksheet->writeA1("A3", "A3" );
+ $worksheet->writeA1("A5", 1.2345 );
+
+
+ ###############################################################################
+ #
+ # The following will be appended to the Spreadsheet::WriteExcel::Worksheet
+ # package.
+ #
+
+ package Spreadsheet::WriteExcel::Worksheet;
+
+ ###############################################################################
+ #
+ # writeA1($cell, $token, $format)
+ #
+ # Convert $cell from Excel A1 notation to $row, $col notation and
+ # call write() on $token.
+ #
+ # Returns: return value of called subroutine or -4 for invalid cell
+ # reference.
+ #
+ sub writeA1 {
+ my $self = shift;
+ my $cell = shift;
+ my $col;
+ my $row;
+
+ if ($cell =~ /([A-z]+)(\d+)/) {
+ ($row, $col) = _convertA1($2, $1);
+ $self->write($row, $col, @_);
+ } else {
+ return -4;
+ }
+ }
+
+ ###############################################################################
+ #
+ # _convertA1($row, $col)
+ #
+ # Convert Excel A1 notation to $row, $col notation. Convert base26 column
+ # string to a number.
+ #
+ sub _convertA1 {
+ my $row = $_[0];
+ my $col = $_[1]; # String in AA notation
+
+ my @chars = split //, $col;
+ my $expn = 0;
+ $col = 0;
+
+ while (@chars) {
+ my $char = uc(pop(@chars)); # LS char first
+ $col += (ord($char) -ord('A') +1) * (26**$expn);
+ $expn++;
+ }
+
+ # Convert 1 index to 0 index
+ $row--;
+ $col--;
+
+ return($row, $col);
+ }
+
+
+Download this example: L<http://cpansearch.perl.org/src/JMCNAMARA/Spreadsheet-WriteExcel-2.37/examples/writeA1.pl>
+
+=head1 AUTHOR
+
+John McNamara jmcnamara@cpan.org
+
+Contributed examples contain the original author's name.
+
+=head1 COPYRIGHT
+
+Copyright MM-MMX, John McNamara.
+
+All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself.
+
+=cut
diff --git a/mcu/tools/perl/Spreadsheet/WriteExcel/Format.pm b/mcu/tools/perl/Spreadsheet/WriteExcel/Format.pm
new file mode 100644
index 0000000..9f15ff2
--- /dev/null
+++ b/mcu/tools/perl/Spreadsheet/WriteExcel/Format.pm
@@ -0,0 +1,813 @@
+package Spreadsheet::WriteExcel::Format;
+
+###############################################################################
+#
+# Format - A class for defining Excel formatting.
+#
+#
+# Used in conjunction with Spreadsheet::WriteExcel
+#
+# Copyright 2000-2010, John McNamara, jmcnamara@cpan.org
+#
+# Documentation after __END__
+#
+
+use Exporter;
+use strict;
+use Carp;
+
+
+
+
+
+
+use vars qw($AUTOLOAD $VERSION @ISA);
+@ISA = qw(Exporter);
+
+$VERSION = '2.37';
+
+###############################################################################
+#
+# new()
+#
+# Constructor
+#
+sub new {
+
+ my $class = shift;
+
+ my $self = {
+ _xf_index => shift || 0,
+
+ _type => 0,
+ _font_index => 0,
+ _font => 'Arial',
+ _size => 10,
+ _bold => 0x0190,
+ _italic => 0,
+ _color => 0x7FFF,
+ _underline => 0,
+ _font_strikeout => 0,
+ _font_outline => 0,
+ _font_shadow => 0,
+ _font_script => 0,
+ _font_family => 0,
+ _font_charset => 0,
+ _font_encoding => 0,
+
+ _num_format => 0,
+ _num_format_enc => 0,
+
+ _hidden => 0,
+ _locked => 1,
+
+ _text_h_align => 0,
+ _text_wrap => 0,
+ _text_v_align => 2,
+ _text_justlast => 0,
+ _rotation => 0,
+
+ _fg_color => 0x40,
+ _bg_color => 0x41,
+
+ _pattern => 0,
+
+ _bottom => 0,
+ _top => 0,
+ _left => 0,
+ _right => 0,
+
+ _bottom_color => 0x40,
+ _top_color => 0x40,
+ _left_color => 0x40,
+ _right_color => 0x40,
+
+ _indent => 0,
+ _shrink => 0,
+ _merge_range => 0,
+ _reading_order => 0,
+
+ _diag_type => 0,
+ _diag_color => 0x40,
+ _diag_border => 0,
+
+ _font_only => 0,
+
+ # Temp code to prevent merged formats in non-merged cells.
+ _used_merge => 0,
+
+ };
+
+ bless $self, $class;
+
+ # Set properties passed to Workbook::add_format()
+ $self->set_format_properties(@_) if @_;
+
+ return $self;
+}
+
+
+###############################################################################
+#
+# copy($format)
+#
+# Copy the attributes of another Spreadsheet::WriteExcel::Format object.
+#
+sub copy {
+ my $self = shift;
+ my $other = $_[0];
+
+ return unless defined $other;
+ return unless (ref($self) eq ref($other));
+
+ # Store the properties that we don't want overwritten.
+ my $xf = $self->{_xf_index};
+ my $merge_range = $self->{_merge_range};
+ my $used_merge = $self->{_used_merge};
+
+ %$self = %$other; # Copy properties
+
+ # Restore saved properties.
+ $self->{_xf_index} = $xf;
+ $self->{_merge_range} = $merge_range;
+ $self->{_used_merge} = $used_merge;
+}
+
+
+###############################################################################
+#
+# get_xf($style)
+#
+# Generate an Excel BIFF XF record.
+#
+sub get_xf {
+
+ use integer; # Avoid << shift bug in Perl 5.6.0 on HP-UX
+
+ my $self = shift;
+
+ my $record; # Record identifier
+ my $length; # Number of bytes to follow
+
+ my $ifnt; # Index to FONT record
+ my $ifmt; # Index to FORMAT record
+ my $style; # Style and other options
+ my $align; # Alignment
+ my $indent; #
+ my $icv; # fg and bg pattern colors
+ my $border1; # Border line options
+ my $border2; # Border line options
+ my $border3; # Border line options
+
+
+ # Set the type of the XF record and some of the attributes.
+ if ($self->{_type} == 0xFFF5) {
+ $style = 0xFFF5;
+ }
+ else {
+ $style = $self->{_locked};
+ $style |= $self->{_hidden} << 1;
+ }
+
+
+ # Flags to indicate if attributes have been set.
+ my $atr_num = ($self->{_num_format} != 0);
+
+ my $atr_fnt = ($self->{_font_index} != 0);
+
+ my $atr_alc = ($self->{_text_h_align} != 0 ||
+ $self->{_text_v_align} != 2 ||
+ $self->{_shrink} != 0 ||
+ $self->{_merge_range} != 0 ||
+ $self->{_text_wrap} != 0 ||
+ $self->{_indent} != 0) ? 1 : 0;
+
+ my $atr_bdr = ($self->{_bottom} != 0 ||
+ $self->{_top} != 0 ||
+ $self->{_left} != 0 ||
+ $self->{_right} != 0 ||
+ $self->{_diag_type} != 0) ? 1: 0;
+
+ my $atr_pat = ($self->{_fg_color} != 0x40 ||
+ $self->{_bg_color} != 0x41 ||
+ $self->{_pattern} != 0x00) ? 1 : 0;
+
+ my $atr_prot = ($self->{_hidden} != 0 ||
+ $self->{_locked} != 1) ? 1 : 0;
+
+
+ # Set attribute changed flags for the style formats.
+ if ($self->{_xf_index} != 0 and $self->{_type} == 0xFFF5) {
+
+ if ($self->{_xf_index} >= 16) {
+ $atr_num = 0;
+ $atr_fnt = 1;
+ }
+ else {
+ $atr_num = 1;
+ $atr_fnt = 0;
+ }
+
+ $atr_alc = 1;
+ $atr_bdr = 1;
+ $atr_pat = 1;
+ $atr_prot = 1;
+ }
+
+
+ # Set a default diagonal border style if none was specified.
+ $self->{_diag_border} = 1 if !$self->{_diag_border} and $self->{_diag_type};
+
+
+ # Reset the default colours for the non-font properties
+ $self->{_fg_color} = 0x40 if $self->{_fg_color} == 0x7FFF;
+ $self->{_bg_color} = 0x41 if $self->{_bg_color} == 0x7FFF;
+ $self->{_bottom_color} = 0x40 if $self->{_bottom_color} == 0x7FFF;
+ $self->{_top_color} = 0x40 if $self->{_top_color} == 0x7FFF;
+ $self->{_left_color} = 0x40 if $self->{_left_color} == 0x7FFF;
+ $self->{_right_color} = 0x40 if $self->{_right_color} == 0x7FFF;
+ $self->{_diag_color} = 0x40 if $self->{_diag_color} == 0x7FFF;
+
+
+ # Zero the default border colour if the border has not been set.
+ $self->{_bottom_color} = 0 if $self->{_bottom} == 0;
+ $self->{_top_color} = 0 if $self->{_top} == 0;
+ $self->{_right_color} = 0 if $self->{_right} == 0;
+ $self->{_left_color} = 0 if $self->{_left} == 0;
+ $self->{_diag_color} = 0 if $self->{_diag_type} == 0;
+
+
+ # The following 2 logical statements take care of special cases in relation
+ # to cell colours and patterns:
+ # 1. For a solid fill (_pattern == 1) Excel reverses the role of foreground
+ # and background colours.
+ # 2. If the user specifies a foreground or background colour without a
+ # pattern they probably wanted a solid fill, so we fill in the defaults.
+ #
+ if ($self->{_pattern} <= 0x01 and
+ $self->{_bg_color} != 0x41 and
+ $self->{_fg_color} == 0x40 )
+ {
+ $self->{_fg_color} = $self->{_bg_color};
+ $self->{_bg_color} = 0x40;
+ $self->{_pattern} = 1;
+ }
+
+ if ($self->{_pattern} <= 0x01 and
+ $self->{_bg_color} == 0x41 and
+ $self->{_fg_color} != 0x40 )
+ {
+ $self->{_bg_color} = 0x40;
+ $self->{_pattern} = 1;
+ }
+
+
+ # Set default alignment if indent is set.
+ $self->{_text_h_align} = 1 if $self->{_indent} and
+ $self->{_text_h_align} == 0;
+
+
+ $record = 0x00E0;
+ $length = 0x0014;
+
+ $ifnt = $self->{_font_index};
+ $ifmt = $self->{_num_format};
+
+
+ $align = $self->{_text_h_align};
+ $align |= $self->{_text_wrap} << 3;
+ $align |= $self->{_text_v_align} << 4;
+ $align |= $self->{_text_justlast} << 7;
+ $align |= $self->{_rotation} << 8;
+
+
+
+ $indent = $self->{_indent};
+ $indent |= $self->{_shrink} << 4;
+ $indent |= $self->{_merge_range} << 5;
+ $indent |= $self->{_reading_order} << 6;
+ $indent |= $atr_num << 10;
+ $indent |= $atr_fnt << 11;
+ $indent |= $atr_alc << 12;
+ $indent |= $atr_bdr << 13;
+ $indent |= $atr_pat << 14;
+ $indent |= $atr_prot << 15;
+
+
+ $border1 = $self->{_left};
+ $border1 |= $self->{_right} << 4;
+ $border1 |= $self->{_top} << 8;
+ $border1 |= $self->{_bottom} << 12;
+
+ $border2 = $self->{_left_color};
+ $border2 |= $self->{_right_color} << 7;
+ $border2 |= $self->{_diag_type} << 14;
+
+
+ $border3 = $self->{_top_color};
+ $border3 |= $self->{_bottom_color} << 7;
+ $border3 |= $self->{_diag_color} << 14;
+ $border3 |= $self->{_diag_border} << 21;
+ $border3 |= $self->{_pattern} << 26;
+
+ $icv = $self->{_fg_color};
+ $icv |= $self->{_bg_color} << 7;
+
+
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("vvvvvvvVv", $ifnt, $ifmt, $style,
+ $align, $indent,
+ $border1, $border2, $border3,
+ $icv);
+
+ return($header . $data);
+}
+
+
+###############################################################################
+#
+# Note to porters. The majority of the set_property() methods are created
+# dynamically via Perl' AUTOLOAD sub, see below. You may prefer/have to specify
+# them explicitly in other implementation languages.
+#
+
+
+###############################################################################
+#
+# get_font()
+#
+# Generate an Excel BIFF FONT record.
+#
+sub get_font {
+
+ my $self = shift;
+
+ my $record; # Record identifier
+ my $length; # Record length
+
+ my $dyHeight; # Height of font (1/20 of a point)
+ my $grbit; # Font attributes
+ my $icv; # Index to color palette
+ my $bls; # Bold style
+ my $sss; # Superscript/subscript
+ my $uls; # Underline
+ my $bFamily; # Font family
+ my $bCharSet; # Character set
+ my $reserved; # Reserved
+ my $cch; # Length of font name
+ my $rgch; # Font name
+ my $encoding; # Font name character encoding
+
+
+ $dyHeight = $self->{_size} * 20;
+ $icv = $self->{_color};
+ $bls = $self->{_bold};
+ $sss = $self->{_font_script};
+ $uls = $self->{_underline};
+ $bFamily = $self->{_font_family};
+ $bCharSet = $self->{_font_charset};
+ $rgch = $self->{_font};
+ $encoding = $self->{_font_encoding};
+
+ # Handle utf8 strings in perl 5.8.
+ if ($] >= 5.008) {
+ require Encode;
+
+ if (Encode::is_utf8($rgch)) {
+ $rgch = Encode::encode("UTF-16BE", $rgch);
+ $encoding = 1;
+ }
+ }
+
+ $cch = length $rgch;
+
+ # Handle Unicode font names.
+ if ($encoding == 1) {
+ croak "Uneven number of bytes in Unicode font name" if $cch % 2;
+ $cch /= 2 if $encoding;
+ $rgch = pack 'v*', unpack 'n*', $rgch;
+ }
+
+ $record = 0x31;
+ $length = 0x10 + length $rgch;
+ $reserved = 0x00;
+
+ $grbit = 0x00;
+ $grbit |= 0x02 if $self->{_italic};
+ $grbit |= 0x08 if $self->{_font_strikeout};
+ $grbit |= 0x10 if $self->{_font_outline};
+ $grbit |= 0x20 if $self->{_font_shadow};
+
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("vvvvvCCCCCC", $dyHeight, $grbit, $icv, $bls,
+ $sss, $uls, $bFamily,
+ $bCharSet, $reserved, $cch, $encoding);
+
+ return($header . $data . $rgch);
+}
+
+###############################################################################
+#
+# get_font_key()
+#
+# Returns a unique hash key for a font. Used by Workbook->_store_all_fonts()
+#
+sub get_font_key {
+
+ my $self = shift;
+
+ # The following elements are arranged to increase the probability of
+ # generating a unique key. Elements that hold a large range of numbers
+ # e.g. _color are placed between two binary elements such as _italic
+ #
+ my $key = "$self->{_font}$self->{_size}";
+ $key .= "$self->{_font_script}$self->{_underline}";
+ $key .= "$self->{_font_strikeout}$self->{_bold}$self->{_font_outline}";
+ $key .= "$self->{_font_family}$self->{_font_charset}";
+ $key .= "$self->{_font_shadow}$self->{_color}$self->{_italic}";
+ $key .= "$self->{_font_encoding}";
+ $key =~ s/ /_/g; # Convert the key to a single word
+
+ return $key;
+}
+
+
+###############################################################################
+#
+# get_xf_index()
+#
+# Returns the used by Worksheet->_XF()
+#
+sub get_xf_index {
+ my $self = shift;
+
+ return $self->{_xf_index};
+}
+
+
+###############################################################################
+#
+# _get_color()
+#
+# Used in conjunction with the set_xxx_color methods to convert a color
+# string into a number. Color range is 0..63 but we will restrict it
+# to 8..63 to comply with Gnumeric. Colors 0..7 are repeated in 8..15.
+#
+sub _get_color {
+
+ my %colors = (
+ aqua => 0x0F,
+ cyan => 0x0F,
+ black => 0x08,
+ blue => 0x0C,
+ brown => 0x10,
+ magenta => 0x0E,
+ fuchsia => 0x0E,
+ gray => 0x17,
+ grey => 0x17,
+ green => 0x11,
+ lime => 0x0B,
+ navy => 0x12,
+ orange => 0x35,
+ pink => 0x21,
+ purple => 0x14,
+ red => 0x0A,
+ silver => 0x16,
+ white => 0x09,
+ yellow => 0x0D,
+ );
+
+ # Return the default color, 0x7FFF, if undef,
+ return 0x7FFF unless defined $_[0];
+
+ # or the color string converted to an integer,
+ return $colors{lc($_[0])} if exists $colors{lc($_[0])};
+
+ # or the default color if string is unrecognised,
+ return 0x7FFF if ($_[0] =~ m/\D/);
+
+ # or an index < 8 mapped into the correct range,
+ return $_[0] + 8 if $_[0] < 8;
+
+ # or the default color if arg is outside range,
+ return 0x7FFF if $_[0] > 63;
+
+ # or an integer in the valid range
+ return $_[0];
+}
+
+
+###############################################################################
+#
+# set_type()
+#
+# Set the XF object type as 0 = cell XF or 0xFFF5 = style XF.
+#
+sub set_type {
+
+ my $self = shift;
+ my $type = $_[0];
+
+ if (defined $_[0] and $_[0] eq 0) {
+ $self->{_type} = 0x0000;
+ }
+ else {
+ $self->{_type} = 0xFFF5;
+ }
+}
+
+
+###############################################################################
+#
+# set_align()
+#
+# Set cell alignment.
+#
+sub set_align {
+
+ my $self = shift;
+ my $location = $_[0];
+
+ return if not defined $location; # No default
+ return if $location =~ m/\d/; # Ignore numbers
+
+ $location = lc($location);
+
+ $self->set_text_h_align(1) if ($location eq 'left');
+ $self->set_text_h_align(2) if ($location eq 'centre');
+ $self->set_text_h_align(2) if ($location eq 'center');
+ $self->set_text_h_align(3) if ($location eq 'right');
+ $self->set_text_h_align(4) if ($location eq 'fill');
+ $self->set_text_h_align(5) if ($location eq 'justify');
+ $self->set_text_h_align(6) if ($location eq 'center_across');
+ $self->set_text_h_align(6) if ($location eq 'centre_across');
+ $self->set_text_h_align(6) if ($location eq 'merge'); # S:WE name
+ $self->set_text_h_align(7) if ($location eq 'distributed');
+ $self->set_text_h_align(7) if ($location eq 'equal_space'); # ParseExcel
+
+
+ $self->set_text_v_align(0) if ($location eq 'top');
+ $self->set_text_v_align(1) if ($location eq 'vcentre');
+ $self->set_text_v_align(1) if ($location eq 'vcenter');
+ $self->set_text_v_align(2) if ($location eq 'bottom');
+ $self->set_text_v_align(3) if ($location eq 'vjustify');
+ $self->set_text_v_align(4) if ($location eq 'vdistributed');
+ $self->set_text_v_align(4) if ($location eq 'vequal_space'); # ParseExcel
+}
+
+
+###############################################################################
+#
+# set_valign()
+#
+# Set vertical cell alignment. This is required by the set_format_properties()
+# method to differentiate between the vertical and horizontal properties.
+#
+sub set_valign {
+
+ my $self = shift;
+ $self->set_align(@_);
+}
+
+
+###############################################################################
+#
+# set_center_across()
+#
+# Implements the Excel5 style "merge".
+#
+sub set_center_across {
+
+ my $self = shift;
+
+ $self->set_text_h_align(6);
+}
+
+
+###############################################################################
+#
+# set_merge()
+#
+# This was the way to implement a merge in Excel5. However it should have been
+# called "center_across" and not "merge".
+# This is now deprecated. Use set_center_across() or better merge_range().
+#
+#
+sub set_merge {
+
+ my $self = shift;
+
+ $self->set_text_h_align(6);
+}
+
+
+###############################################################################
+#
+# set_bold()
+#
+# Bold has a range 0x64..0x3E8.
+# 0x190 is normal. 0x2BC is bold. So is an excessive use of AUTOLOAD.
+#
+sub set_bold {
+
+ my $self = shift;
+ my $weight = $_[0];
+
+ $weight = 0x2BC if not defined $weight; # Bold text
+ $weight = 0x2BC if $weight == 1; # Bold text
+ $weight = 0x190 if $weight == 0; # Normal text
+ $weight = 0x190 if $weight < 0x064; # Lower bound
+ $weight = 0x190 if $weight > 0x3E8; # Upper bound
+
+ $self->{_bold} = $weight;
+}
+
+
+###############################################################################
+#
+# set_border($style)
+#
+# Set cells borders to the same style
+#
+sub set_border {
+
+ my $self = shift;
+ my $style = $_[0];
+
+ $self->set_bottom($style);
+ $self->set_top($style);
+ $self->set_left($style);
+ $self->set_right($style);
+}
+
+
+###############################################################################
+#
+# set_border_color($color)
+#
+# Set cells border to the same color
+#
+sub set_border_color {
+
+ my $self = shift;
+ my $color = $_[0];
+
+ $self->set_bottom_color($color);
+ $self->set_top_color($color);
+ $self->set_left_color($color);
+ $self->set_right_color($color);
+}
+
+
+###############################################################################
+#
+# set_rotation($angle)
+#
+# Set the rotation angle of the text. An alignment property.
+#
+sub set_rotation {
+
+ my $self = shift;
+ my $rotation = $_[0];
+
+ # Argument should be a number
+ return if $rotation !~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/;
+
+ # The arg type can be a double but the Excel dialog only allows integers.
+ $rotation = int $rotation;
+
+ if ($rotation == 270) {
+ $rotation = 255;
+ }
+ elsif ($rotation >= -90 or $rotation <= 90) {
+ $rotation = -$rotation +90 if $rotation < 0;
+ }
+ else {
+ carp "Rotation $rotation outside range: -90 <= angle <= 90";
+ $rotation = 0;
+ }
+
+ $self->{_rotation} = $rotation;
+}
+
+
+###############################################################################
+#
+# set_format_properties()
+#
+# Convert hashes of properties to method calls.
+#
+sub set_format_properties {
+
+ my $self = shift;
+
+ my %properties = @_; # Merge multiple hashes into one
+
+ while (my($key, $value) = each(%properties)) {
+
+ # Strip leading "-" from Tk style properties e.g. -color => 'red'.
+ $key =~ s/^-//;
+
+ # Create a sub to set the property.
+ my $sub = \&{"set_$key"};
+ $sub->($self, $value);
+ }
+}
+
+# Renamed rarely used set_properties() to set_format_properties() to avoid
+# confusion with Workbook method of the same name. The following acts as an
+# alias for any code that uses the old name.
+*set_properties = *set_format_properties;
+
+
+###############################################################################
+#
+# AUTOLOAD. Deus ex machina.
+#
+# Dynamically create set methods that aren't already defined.
+#
+sub AUTOLOAD {
+
+ my $self = shift;
+
+ # Ignore calls to DESTROY
+ return if $AUTOLOAD =~ /::DESTROY$/;
+
+ # Check for a valid method names, i.e. "set_xxx_yyy".
+ $AUTOLOAD =~ /.*::set(\w+)/ or die "Unknown method: $AUTOLOAD\n";
+
+ # Match the attribute, i.e. "_xxx_yyy".
+ my $attribute = $1;
+
+ # Check that the attribute exists
+ exists $self->{$attribute} or die "Unknown method: $AUTOLOAD\n";
+
+ # The attribute value
+ my $value;
+
+
+ # There are two types of set methods: set_property() and
+ # set_property_color(). When a method is AUTOLOADED we store a new anonymous
+ # sub in the appropriate slot in the symbol table. The speeds up subsequent
+ # calls to the same method.
+ #
+ no strict 'refs'; # To allow symbol table hackery
+
+ if ($AUTOLOAD =~ /.*::set\w+color$/) {
+ # For "set_property_color" methods
+ $value = _get_color($_[0]);
+
+ *{$AUTOLOAD} = sub {
+ my $self = shift;
+
+ $self->{$attribute} = _get_color($_[0]);
+ };
+ }
+ else {
+
+ $value = $_[0];
+ $value = 1 if not defined $value; # The default value is always 1
+
+ *{$AUTOLOAD} = sub {
+ my $self = shift;
+ my $value = shift;
+
+ $value = 1 if not defined $value;
+ $self->{$attribute} = $value;
+ };
+ }
+
+
+ $self->{$attribute} = $value;
+}
+
+
+1;
+
+
+__END__
+
+
+=head1 NAME
+
+Format - A class for defining Excel formatting.
+
+=head1 SYNOPSIS
+
+See the documentation for Spreadsheet::WriteExcel
+
+=head1 DESCRIPTION
+
+This module is used in conjunction with Spreadsheet::WriteExcel.
+
+=head1 AUTHOR
+
+John McNamara jmcnamara@cpan.org
+
+=head1 COPYRIGHT
+
+© MM-MMX, John McNamara.
+
+All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself.
diff --git a/mcu/tools/perl/Spreadsheet/WriteExcel/Formula.pm b/mcu/tools/perl/Spreadsheet/WriteExcel/Formula.pm
new file mode 100644
index 0000000..6098357
--- /dev/null
+++ b/mcu/tools/perl/Spreadsheet/WriteExcel/Formula.pm
@@ -0,0 +1,1485 @@
+package Spreadsheet::WriteExcel::Formula;
+
+###############################################################################
+#
+# Formula - A class for generating Excel formulas.
+#
+#
+# Used in conjunction with Spreadsheet::WriteExcel
+#
+# Copyright 2000-2010, John McNamara, jmcnamara@cpan.org
+#
+# Documentation after __END__
+#
+
+use Exporter;
+use strict;
+use Carp;
+
+
+
+
+
+
+use vars qw($VERSION @ISA);
+@ISA = qw(Exporter);
+
+$VERSION = '2.37';
+
+###############################################################################
+#
+# Class data.
+#
+my $parser;
+my %ptg;
+my %functions;
+
+
+###############################################################################
+#
+# For debugging.
+#
+my $_debug = 0;
+
+
+###############################################################################
+#
+# new()
+#
+# Constructor
+#
+sub new {
+
+ my $class = $_[0];
+
+ my $self = {
+ _byte_order => $_[1],
+ _workbook => "",
+ _ext_sheets => {},
+ _ext_refs => {},
+ _ext_ref_count => 0,
+ _ext_names => {},
+ };
+
+ bless $self, $class;
+ return $self;
+}
+
+
+###############################################################################
+#
+# _init_parser()
+#
+# There is a small overhead involved in generating the parser. Therefore, the
+# initialisation is delayed until a formula is required.
+# TODO: use a pre-compiled grammar.
+#
+# Porters take note, a recursive descent parser isn't mandatory. A future
+# version of this module may use a YACC based parser instead.
+#
+sub _init_parser {
+
+ my $self = shift;
+
+ # Delay loading Parse::RecDescent to reduce the module dependencies.
+ eval { require Parse::RecDescent };
+ die "The Parse::RecDescent module must be installed in order ".
+ "to write an Excel formula\n" if $@;
+
+ $self->_initialize_hashes();
+
+ # The parsing grammar.
+ #
+ # TODO: Add support for international versions of Excel
+ #
+ $parser = Parse::RecDescent->new(<<'EndGrammar');
+
+ expr: list
+
+ # Match arg lists such as SUM(1,2, 3)
+ list: <leftop: addition ',' addition>
+ { [ $item[1], '_arg', scalar @{$item[1]} ] }
+
+ addition: <leftop: multiplication add_op multiplication>
+
+ # TODO: The add_op operators don't have equal precedence.
+ add_op: add | sub | concat
+ | eq | ne | le | ge | lt | gt # Order is important
+
+ add: '+' { 'ptgAdd' }
+ sub: '-' { 'ptgSub' }
+ concat: '&' { 'ptgConcat' }
+ eq: '=' { 'ptgEQ' }
+ ne: '<>' { 'ptgNE' }
+ le: '<=' { 'ptgLE' }
+ ge: '>=' { 'ptgGE' }
+ lt: '<' { 'ptgLT' }
+ gt: '>' { 'ptgGT' }
+
+
+ multiplication: <leftop: exponention mult_op exponention>
+
+ mult_op: mult | div
+ mult: '*' { 'ptgMul' }
+ div: '/' { 'ptgDiv' }
+
+ # Left associative (apparently)
+ exponention: <leftop: factor exp_op factor>
+
+ exp_op: '^' { 'ptgPower' }
+
+ factor: number # Order is important
+ | string
+ | range2d
+ | range3d
+ | true
+ | false
+ | ref2d
+ | ref3d
+ | function
+ | name
+ | '(' expr ')' { [$item[2], 'ptgParen'] }
+
+ # Match a string.
+ # Regex by merlyn. See http://www.perlmonks.org/index.pl?node_id=330280
+ #
+ string: /"([^"]|"")*"/ #" For editors
+ { [ '_str', $item[1]] }
+
+ # Match float or integer
+ number: /([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?/
+ { ['_num', $item[1]] }
+
+ # Note: The highest column values is IV. The following regexes match
+ # up to IZ. Out of range values are caught in the code.
+ #
+ # Note: sheetnames with whitespace, commas, or parentheses must be in
+ # single quotes. Applies to ref3d and range3d
+ #
+
+ # Match A1, $A1, A$1 or $A$1.
+ ref2d: /\$?[A-I]?[A-Z]\$?\d+/
+ { ['_ref2d', $item[1]] }
+
+ # Match an external sheet reference: Sheet1!A1 or 'Sheet (1)'!A1
+ ref3d: /[^!(,]+!\$?[A-I]?[A-Z]\$?\d+/
+ { ['_ref3d', $item[1]] }
+ | /'[^']+'!\$?[A-I]?[A-Z]\$?\d+/
+ { ['_ref3d', $item[1]] }
+
+ # Match A1:C5, $A1:$C5 or A:C etc.
+ range2d: /\$?[A-I]?[A-Z]\$?(\d+)?:\$?[A-I]?[A-Z]\$?(\d+)?/
+ { ['_range2d', $item[1]] }
+
+ # Match an external sheet range. 'Sheet 1:Sheet 2'!B2:C5
+ range3d: /[^!(,]+!\$?[A-I]?[A-Z]\$?(\d+)?:\$?[A-I]?[A-Z]\$?(\d+)?/
+ { ['_range3d', $item[1]] }
+ | /'[^']+'!\$?[A-I]?[A-Z]\$?(\d+)?:\$?[A-I]?[A-Z]\$?(\d+)?/
+ { ['_range3d', $item[1]] }
+
+ # Match a function name.
+ function: /[A-Z0-9À-Ü_.]+/ '()'
+ { ['_func', $item[1]] }
+ | /[A-Z0-9À-Ü_.]+/ '(' expr ')'
+ { ['_class', $item[1], $item[3], '_func', $item[1]] }
+ | /[A-Z0-9À-Ü_.]+/ '(' list ')'
+ { ['_class', $item[1], $item[3], '_func', $item[1]] }
+
+ # Match a defined name.
+ name: /[A-Za-z_]\w+/
+ { ['_name', $item[1]] }
+
+ # Boolean values.
+ true: 'TRUE' { [ 'ptgBool', 1 ] }
+
+ false: 'FALSE' { [ 'ptgBool', 0 ] }
+
+EndGrammar
+
+print "Init_parser.\n\n" if $_debug;
+}
+
+
+
+###############################################################################
+#
+# parse_formula()
+#
+# Takes a textual description of a formula and returns a RPN encoded byte
+# string.
+#
+sub parse_formula {
+
+ my $self= shift;
+
+ # Initialise the parser if this is the first call
+ $self->_init_parser() if not defined $parser;
+
+ my $formula = shift @_;
+ my $tokens;
+
+ print $formula, "\n" if $_debug;
+
+ # Build the parse tree for the formula
+ my $parsetree =$parser->expr($formula);
+
+ # Check if parsing worked.
+ if (defined $parsetree) {
+ my @tokens = $self->_reverse_tree(@$parsetree);
+
+ # Add a volatile token if the formula contains a volatile function.
+ # This must be the first token in the list
+ #
+ unshift @tokens, '_vol' if $self->_check_volatile(@tokens);
+
+ # The return value depends on which Worksheet.pm method is the caller
+ if (wantarray) {
+ # Parse formula to see if it throws any errors and then
+ # return raw tokens to Worksheet::store_formula()
+ #
+ $self->parse_tokens(@tokens);
+ return @tokens;
+ }
+ else{
+ # Return byte stream to Worksheet::write_formula()
+ return $self->parse_tokens(@tokens);
+ }
+ }
+ else {
+ die "Couldn't parse formula: =$formula\n";
+ }
+}
+
+
+###############################################################################
+#
+# parse_tokens()
+#
+# Convert each token or token pair to its Excel 'ptg' equivalent.
+#
+sub parse_tokens {
+
+ my $self = shift;
+ my $parse_str = '';
+ my $last_type = '';
+ my $modifier = '';
+ my $num_args = 0;
+ my $class = 0;
+ my @class = 1;
+ my @tokens = @_;
+
+
+ # A note about the class modifiers used below. In general the class,
+ # "reference" or "value", of a function is applied to all of its operands.
+ # However, in certain circumstances the operands can have mixed classes,
+ # e.g. =VLOOKUP with external references. These will eventually be dealt
+ # with by the parser. However, as a workaround the class type of a token
+ # can be changed via the repeat_formula interface. Thus, a _ref2d token can
+ # be changed by the user to _ref2dA or _ref2dR to change its token class.
+ #
+ while (@_) {
+ my $token = shift @_;
+
+ if ($token eq '_arg') {
+ $num_args = shift @_;
+ }
+ elsif ($token eq '_class') {
+ $token = shift @_;
+ $class = $functions{$token}[2];
+ # If $class is undef then it means that the function isn't valid.
+ die "Unknown function $token() in formula\n" unless defined $class;
+ push @class, $class;
+ }
+ elsif ($token eq '_vol') {
+ $parse_str .= $self->_convert_volatile();
+ }
+ elsif ($token eq 'ptgBool') {
+ $token = shift @_;
+ $parse_str .= $self->_convert_bool($token);
+ }
+ elsif ($token eq '_num') {
+ $token = shift @_;
+ $parse_str .= $self->_convert_number($token);
+ }
+ elsif ($token eq '_str') {
+ $token = shift @_;
+ $parse_str .= $self->_convert_string($token);
+ }
+ elsif ($token =~ /^_ref2d/) {
+ ($modifier = $token) =~ s/_ref2d//;
+ $class = $class[-1];
+ $class = 0 if $modifier eq 'R';
+ $class = 1 if $modifier eq 'V';
+ $token = shift @_;
+ $parse_str .= $self->_convert_ref2d($token, $class);
+ }
+ elsif ($token =~ /^_ref3d/) {
+ ($modifier = $token) =~ s/_ref3d//;
+ $class = $class[-1];
+ $class = 0 if $modifier eq 'R';
+ $class = 1 if $modifier eq 'V';
+ $token = shift @_;
+ $parse_str .= $self->_convert_ref3d($token, $class);
+ }
+ elsif ($token =~ /^_range2d/) {
+ ($modifier = $token) =~ s/_range2d//;
+ $class = $class[-1];
+ $class = 0 if $modifier eq 'R';
+ $class = 1 if $modifier eq 'V';
+ $token = shift @_;
+ $parse_str .= $self->_convert_range2d($token, $class);
+ }
+ elsif ($token =~ /^_range3d/) {
+ ($modifier = $token) =~ s/_range3d//;
+ $class = $class[-1];
+ $class = 0 if $modifier eq 'R';
+ $class = 1 if $modifier eq 'V';
+ $token = shift @_;
+ $parse_str .= $self->_convert_range3d($token, $class);
+ }
+ elsif ($token =~ /^_name/) {
+ ($modifier = $token) =~ s/_name//;
+ $class = $class[-1];
+ $class = 0 if $modifier eq 'R';
+ $class = 1 if $modifier eq 'V';
+ $token = shift @_;
+ $parse_str .= $self->_convert_name($token, $class);
+ }
+ elsif ($token eq '_func') {
+ $token = shift @_;
+ $parse_str .= $self->_convert_function($token, $num_args);
+ pop @class;
+ $num_args = 0; # Reset after use
+ }
+ elsif (exists $ptg{$token}) {
+ $parse_str .= pack("C", $ptg{$token});
+ }
+ else {
+ # Unrecognised token
+ return undef;
+ }
+ }
+
+
+ if ($_debug) {
+ print join(" ", map { sprintf "%02X", $_ } unpack("C*",$parse_str));
+ print "\n\n";
+ print join(" ", @tokens), "\n\n";
+ }
+
+ return $parse_str;
+}
+
+
+###############################################################################
+#
+# _reverse_tree()
+#
+# This function descends recursively through the parse tree. At each level it
+# swaps the order of an operator followed by an operand.
+# For example, 1+2*3 would be converted in the following sequence:
+# 1 + 2 * 3
+# 1 + (2 * 3)
+# 1 + (2 3 *)
+# 1 (2 3 *) +
+# 1 2 3 * +
+#
+sub _reverse_tree
+{
+ my $self = shift;
+
+ my @tokens;
+ my @expression = @_;
+ my @stack;
+
+ while (@expression) {
+ my $token = shift @expression;
+
+ # If the token is an operator swap it with the following operand
+ if ( $token eq 'ptgAdd' ||
+ $token eq 'ptgSub' ||
+ $token eq 'ptgConcat' ||
+ $token eq 'ptgMul' ||
+ $token eq 'ptgDiv' ||
+ $token eq 'ptgPower' ||
+ $token eq 'ptgEQ' ||
+ $token eq 'ptgNE' ||
+ $token eq 'ptgLE' ||
+ $token eq 'ptgGE' ||
+ $token eq 'ptgLT' ||
+ $token eq 'ptgGT')
+ {
+ my $operand = shift @expression;
+ push @stack, $operand;
+ }
+
+ push @stack, $token;
+ }
+
+ # Recurse through the parse tree
+ foreach my $token (@stack) {
+ if (ref($token)) {
+ push @tokens, $self->_reverse_tree(@$token);
+ }
+ else {
+ push @tokens, $token;
+ }
+ }
+
+ return @tokens;
+}
+
+
+###############################################################################
+#
+# _check_volatile()
+#
+# Check if the formula contains a volatile function, i.e. a function that must
+# be recalculated each time a cell is updated. These formulas require a ptgAttr
+# with the volatile flag set as the first token in the parsed expression.
+#
+# Examples of volatile functions: RAND(), NOW(), TODAY()
+#
+sub _check_volatile {
+
+ my $self = shift;
+ my @tokens = @_;
+ my $volatile = 0;
+
+ for my $i (0..@tokens-1) {
+ # If the next token is a function check if it is volatile.
+ if ($tokens[$i] eq '_func' and $functions{$tokens[$i+1]}[3]) {
+ $volatile = 1;
+ last;
+ }
+ }
+
+ return $volatile;
+}
+
+
+###############################################################################
+#
+# _convert_volatile()
+#
+# Convert _vol to a ptgAttr tag formatted to indicate that the formula contains
+# a volatile function. See _check_volatile()
+#
+sub _convert_volatile {
+
+ my $self = shift;
+
+ # Set bitFattrSemi flag to indicate volatile function, "w" is set to zero.
+ return pack("CCv", $ptg{ptgAttr}, 0x1, 0x0);
+}
+
+
+###############################################################################
+#
+# _convert_bool()
+#
+# Convert a boolean token to ptgBool
+#
+sub _convert_bool {
+
+ my $self = shift;
+ my $bool = shift;
+
+ return pack("CC", $ptg{ptgBool}, $bool);
+}
+
+
+###############################################################################
+#
+# _convert_number()
+#
+# Convert a number token to ptgInt or ptgNum
+#
+sub _convert_number {
+
+ my $self = shift;
+ my $num = shift;
+
+ # Integer in the range 0..2**16-1
+ if (($num =~ /^\d+$/) && ($num <= 65535)) {
+ return pack("Cv", $ptg{ptgInt}, $num);
+ }
+ else { # A float
+ $num = pack("d", $num);
+ $num = reverse $num if $self->{_byte_order};
+ return pack("C", $ptg{ptgNum}) . $num;
+ }
+}
+
+
+###############################################################################
+#
+# _convert_string()
+#
+# Convert a string to a ptg Str.
+#
+sub _convert_string {
+
+ my $self = shift;
+ my $str = shift;
+ my $encoding = 0;
+
+ $str =~ s/^"//; # Remove leading "
+ $str =~ s/"$//; # Remove trailing "
+ $str =~ s/""/"/g; # Substitute Excel's escaped double quote "" for "
+
+ my $length = length($str);
+
+ # Handle utf8 strings in perl 5.8.
+ if ($] >= 5.008) {
+ require Encode;
+
+ if (Encode::is_utf8($str)) {
+ $str = Encode::encode("UTF-16LE", $str);
+ $encoding = 1;
+ }
+ }
+
+ die "String in formula has more than 255 chars\n" if $length > 255;
+
+ return pack("CCC", $ptg{ptgStr}, $length, $encoding) . $str;
+}
+
+
+###############################################################################
+#
+# _convert_ref2d()
+#
+# Convert an Excel reference such as A1, $B2, C$3 or $D$4 to a ptgRefV.
+#
+sub _convert_ref2d {
+
+ my $self = shift;
+ my $cell = shift;
+ my $class = shift;
+ my $ptgRef;
+
+ # Convert the cell reference
+ my ($row, $col) = $self->_cell_to_packed_rowcol($cell);
+
+ # The ptg value depends on the class of the ptg.
+ if ($class == 0) {
+ $ptgRef = pack("C", $ptg{ptgRef});
+ }
+ elsif ($class == 1) {
+ $ptgRef = pack("C", $ptg{ptgRefV});
+ }
+ elsif ($class == 2) {
+ $ptgRef = pack("C", $ptg{ptgRefA});
+ }
+ else{
+ die "Unknown function class in formula\n";
+ }
+
+ return $ptgRef . $row . $col;
+}
+
+
+###############################################################################
+#
+# _convert_ref3d
+#
+# Convert an Excel 3d reference such as "Sheet1!A1" or "Sheet1:Sheet2!A1" to a
+# ptgRef3dV.
+#
+sub _convert_ref3d {
+
+ my $self = shift;
+ my $token = shift;
+ my $class = shift;
+ my $ptgRef;
+
+ # Split the ref at the ! symbol
+ my ($ext_ref, $cell) = split '!', $token;
+
+ # Convert the external reference part
+ $ext_ref = $self->_pack_ext_ref($ext_ref);
+
+ # Convert the cell reference part
+ my ($row, $col) = $self->_cell_to_packed_rowcol($cell);
+
+ # The ptg value depends on the class of the ptg.
+ if ($class == 0) {
+ $ptgRef = pack("C", $ptg{ptgRef3d});
+ }
+ elsif ($class == 1) {
+ $ptgRef = pack("C", $ptg{ptgRef3dV});
+ }
+ elsif ($class == 2) {
+ $ptgRef = pack("C", $ptg{ptgRef3dA});
+ }
+ else{
+ die "Unknown function class in formula\n";
+ }
+
+ return $ptgRef . $ext_ref. $row . $col;
+}
+
+
+###############################################################################
+#
+# _convert_range2d()
+#
+# Convert an Excel range such as A1:D4 or A:D to a ptgRefV.
+#
+sub _convert_range2d {
+
+ my $self = shift;
+ my $range = shift;
+ my $class = shift;
+ my $ptgArea;
+
+ # Split the range into 2 cell refs
+ my ($cell1, $cell2) = split ':', $range;
+
+ # A range such as A:D is equivalent to A1:D65536, so add rows as required
+ $cell1 .= '1' if $cell1 !~ /\d/;
+ $cell2 .= '65536' if $cell2 !~ /\d/;
+
+ # Convert the cell references
+ my ($row1, $col1) = $self->_cell_to_packed_rowcol($cell1);
+ my ($row2, $col2) = $self->_cell_to_packed_rowcol($cell2);
+
+ # The ptg value depends on the class of the ptg.
+ if ($class == 0) {
+ $ptgArea = pack("C", $ptg{ptgArea});
+ }
+ elsif ($class == 1) {
+ $ptgArea = pack("C", $ptg{ptgAreaV});
+ }
+ elsif ($class == 2) {
+ $ptgArea = pack("C", $ptg{ptgAreaA});
+ }
+ else{
+ die "Unknown function class in formula\n";
+ }
+
+ return $ptgArea . $row1 . $row2 . $col1. $col2;
+}
+
+
+###############################################################################
+#
+# _convert_range3d
+#
+# Convert an Excel 3d range such as "Sheet1!A1:D4" or "Sheet1:Sheet2!A1:D4" to
+# a ptgArea3dV.
+#
+sub _convert_range3d {
+
+ my $self = shift;
+ my $token = shift;
+ my $class = shift;
+ my $ptgArea;
+
+ # Split the ref at the ! symbol
+ my ($ext_ref, $range) = split '!', $token;
+
+ # Convert the external reference part
+ $ext_ref = $self->_pack_ext_ref($ext_ref);
+
+ # Split the range into 2 cell refs
+ my ($cell1, $cell2) = split ':', $range;
+
+ # A range such as A:D is equivalent to A1:D65536, so add rows as required
+ $cell1 .= '1' if $cell1 !~ /\d/;
+ $cell2 .= '65536' if $cell2 !~ /\d/;
+
+ # Convert the cell references
+ my ($row1, $col1) = $self->_cell_to_packed_rowcol($cell1);
+ my ($row2, $col2) = $self->_cell_to_packed_rowcol($cell2);
+
+ # The ptg value depends on the class of the ptg.
+ if ($class == 0) {
+ $ptgArea = pack("C", $ptg{ptgArea3d});
+ }
+ elsif ($class == 1) {
+ $ptgArea = pack("C", $ptg{ptgArea3dV});
+ }
+ elsif ($class == 2) {
+ $ptgArea = pack("C", $ptg{ptgArea3dA});
+ }
+ else{
+ die "Unknown function class in formula\n";
+ }
+
+ return $ptgArea . $ext_ref . $row1 . $row2 . $col1. $col2;
+}
+
+
+###############################################################################
+#
+# _pack_ext_ref()
+#
+# Convert the sheet name part of an external reference, for example "Sheet1" or
+# "Sheet1:Sheet2", to a packed structure.
+#
+sub _pack_ext_ref {
+
+ my $self = shift;
+ my $ext_ref = shift;
+ my $sheet1;
+ my $sheet2;
+
+ $ext_ref =~ s/^'//; # Remove leading ' if any.
+ $ext_ref =~ s/'$//; # Remove trailing ' if any.
+
+ # Check if there is a sheet range eg., Sheet1:Sheet2.
+ if ($ext_ref =~ /:/) {
+ ($sheet1, $sheet2) = split ':', $ext_ref;
+
+ $sheet1 = $self->_get_sheet_index($sheet1);
+ $sheet2 = $self->_get_sheet_index($sheet2);
+
+ # Reverse max and min sheet numbers if necessary
+ if ($sheet1 > $sheet2) {
+ ($sheet1, $sheet2) = ($sheet2, $sheet1);
+ }
+ }
+ else {
+ # Single sheet name only.
+ ($sheet1, $sheet2) = ($ext_ref, $ext_ref);
+
+ $sheet1 = $self->_get_sheet_index($sheet1);
+ $sheet2 = $sheet1;
+ }
+
+ my $key = "$sheet1:$sheet2";
+ my $index;
+
+ if (exists $self->{_ext_refs}->{$key}) {
+ $index = $self->{_ext_refs}->{$key};
+ }
+ else {
+ $index = $self->{_ext_ref_count};
+ $self->{_ext_refs}->{$key} = $index;
+ $self->{_ext_ref_count}++;
+ }
+
+ return pack("v",$index);
+}
+
+
+###############################################################################
+#
+# _get_sheet_index()
+#
+# Look up the index that corresponds to an external sheet name. The hash of
+# sheet names is updated by the add_worksheet() method of the Workbook class.
+#
+sub _get_sheet_index {
+
+ my $self = shift;
+ my $sheet_name = shift;
+
+ # Handle utf8 sheetnames in perl 5.8.
+ if ($] >= 5.008) {
+ require Encode;
+
+ if (Encode::is_utf8($sheet_name)) {
+ $sheet_name = Encode::encode("UTF-16BE", $sheet_name);
+ }
+ }
+
+
+ if (not exists $self->{_ext_sheets}->{$sheet_name}) {
+ die "Unknown sheet name $sheet_name in formula\n";
+ }
+ else {
+ return $self->{_ext_sheets}->{$sheet_name};
+ }
+}
+
+
+###############################################################################
+#
+# set_ext_sheets()
+#
+# This semi-public method is used to update the hash of sheet names. It is
+# updated by the add_worksheet() method of the Workbook class.
+#
+sub set_ext_sheets {
+
+ my $self = shift;
+ my $worksheet = shift;
+ my $index = shift;
+
+ # The _ext_sheets hash is used to translate between worksheet names
+ # and their index
+ $self->{_ext_sheets}->{$worksheet} = $index;
+
+}
+
+
+###############################################################################
+#
+# get_ext_sheets()
+#
+# This semi-public method is used to get the worksheet references that were
+# used in formulas for inclusion in the EXTERNSHEET Workbook record.
+#
+sub get_ext_sheets {
+
+ my $self = shift;
+
+ return %{$self->{_ext_refs}};
+}
+
+
+###############################################################################
+#
+# get_ext_ref_count()
+#
+# This semi-public method is used to update the hash of sheet names. It is
+# updated by the add_worksheet() method of the Workbook class.
+#
+sub get_ext_ref_count {
+
+ my $self = shift;
+
+ return $self->{_ext_ref_count};
+}
+
+
+###############################################################################
+#
+# _get_name_index()
+#
+# Look up the index that corresponds to an external defined name. The hash of
+# defined names is updated by the define_name() method in the Workbook class.
+#
+sub _get_name_index {
+
+ my $self = shift;
+ my $name = shift;
+
+ if (not exists $self->{_ext_names}->{$name}) {
+ die "Unknown defined name $name in formula\n";
+ }
+ else {
+ return $self->{_ext_names}->{$name};
+ }
+}
+
+
+###############################################################################
+#
+# set_ext_name()
+#
+# This semi-public method is used to update the hash of defined names.
+#
+sub set_ext_name {
+
+ my $self = shift;
+ my $name = shift;
+ my $index = shift;
+
+ $self->{_ext_names}->{$name} = $index;
+}
+
+
+###############################################################################
+#
+# _convert_function()
+#
+# Convert a function to a ptgFunc or ptgFuncVarV depending on the number of
+# args that it takes.
+#
+sub _convert_function {
+
+ my $self = shift;
+ my $token = shift;
+ my $num_args = shift;
+
+ die "Unknown function $token() in formula\n"
+ unless defined $functions{$token}[0];
+
+ my $args = $functions{$token}[1];
+
+ # Fixed number of args eg. TIME($i,$j,$k).
+ if ($args >= 0) {
+ # Check that the number of args is valid.
+ if ($args != $num_args) {
+ die "Incorrect number of arguments for $token() in formula\n";
+ }
+ else {
+ return pack("Cv", $ptg{ptgFuncV}, $functions{$token}[0]);
+ }
+ }
+
+ # Variable number of args eg. SUM($i,$j,$k, ..).
+ if ($args == -1) {
+ return pack "CCv", $ptg{ptgFuncVarV}, $num_args, $functions{$token}[0];
+ }
+}
+
+
+###############################################################################
+#
+# _convert_name()
+#
+# Convert a symbolic name into a name reference.
+#
+sub _convert_name {
+
+ my $self = shift;
+ my $name = shift;
+ my $class = shift;
+
+ my $ptgName;
+
+ my $name_index = $self->_get_name_index($name);
+
+ # The ptg value depends on the class of the ptg.
+ if ($class == 0) {
+ $ptgName = $ptg{ptgName};
+ }
+ elsif ($class == 1) {
+ $ptgName = $ptg{ptgNameV};
+ }
+ elsif ($class == 2) {
+ $ptgName = $ptg{ptgNameA};
+ }
+
+
+ return pack 'CV', $ptgName, $name_index;
+}
+
+
+###############################################################################
+#
+# _cell_to_rowcol($cell_ref)
+#
+# Convert an Excel cell reference such as A1 or $B2 or C$3 or $D$4 to a zero
+# indexed row and column number. Also returns two boolean values to indicate
+# whether the row or column are relative references.
+# TODO use function in Utility.pm
+#
+sub _cell_to_rowcol {
+
+ my $self = shift;
+ my $cell = shift;
+
+ $cell =~ /(\$?)([A-I]?[A-Z])(\$?)(\d+)/;
+
+ my $col_rel = $1 eq "" ? 1 : 0;
+ my $col = $2;
+ my $row_rel = $3 eq "" ? 1 : 0;
+ my $row = $4;
+
+ # Convert base26 column string to a number.
+ # All your Base are belong to us.
+ my @chars = split //, $col;
+ my $expn = 0;
+ $col = 0;
+
+ while (@chars) {
+ my $char = pop(@chars); # LS char first
+ $col += (ord($char) - ord('A') + 1) * (26**$expn);
+ $expn++;
+ }
+
+ # Convert 1-index to zero-index
+ $row--;
+ $col--;
+
+ return $row, $col, $row_rel, $col_rel;
+}
+
+
+###############################################################################
+#
+# _cell_to_packed_rowcol($row, $col, $row_rel, $col_rel)
+#
+# pack() row and column into the required 3 byte format.
+#
+sub _cell_to_packed_rowcol {
+
+ use integer; # Avoid << shift bug in Perl 5.6.0 on HP-UX
+
+ my $self = shift;
+ my $cell = shift;
+
+ my ($row, $col, $row_rel, $col_rel) = $self->_cell_to_rowcol($cell);
+
+ die "Column $cell greater than IV in formula\n" if $col >= 256;
+ die "Row $cell greater than 65536 in formula\n" if $row >= 65536;
+
+ # Set the high bits to indicate if row or col are relative.
+ $col |= $col_rel << 14;
+ $col |= $row_rel << 15;
+
+ $row = pack('v', $row);
+ $col = pack('v', $col);
+
+ return ($row, $col);
+}
+
+
+###############################################################################
+#
+# _initialize_hashes()
+#
+sub _initialize_hashes {
+
+ # The Excel ptg indices
+ %ptg = (
+ 'ptgExp' => 0x01,
+ 'ptgTbl' => 0x02,
+ 'ptgAdd' => 0x03,
+ 'ptgSub' => 0x04,
+ 'ptgMul' => 0x05,
+ 'ptgDiv' => 0x06,
+ 'ptgPower' => 0x07,
+ 'ptgConcat' => 0x08,
+ 'ptgLT' => 0x09,
+ 'ptgLE' => 0x0A,
+ 'ptgEQ' => 0x0B,
+ 'ptgGE' => 0x0C,
+ 'ptgGT' => 0x0D,
+ 'ptgNE' => 0x0E,
+ 'ptgIsect' => 0x0F,
+ 'ptgUnion' => 0x10,
+ 'ptgRange' => 0x11,
+ 'ptgUplus' => 0x12,
+ 'ptgUminus' => 0x13,
+ 'ptgPercent' => 0x14,
+ 'ptgParen' => 0x15,
+ 'ptgMissArg' => 0x16,
+ 'ptgStr' => 0x17,
+ 'ptgAttr' => 0x19,
+ 'ptgSheet' => 0x1A,
+ 'ptgEndSheet' => 0x1B,
+ 'ptgErr' => 0x1C,
+ 'ptgBool' => 0x1D,
+ 'ptgInt' => 0x1E,
+ 'ptgNum' => 0x1F,
+ 'ptgArray' => 0x20,
+ 'ptgFunc' => 0x21,
+ 'ptgFuncVar' => 0x22,
+ 'ptgName' => 0x23,
+ 'ptgRef' => 0x24,
+ 'ptgArea' => 0x25,
+ 'ptgMemArea' => 0x26,
+ 'ptgMemErr' => 0x27,
+ 'ptgMemNoMem' => 0x28,
+ 'ptgMemFunc' => 0x29,
+ 'ptgRefErr' => 0x2A,
+ 'ptgAreaErr' => 0x2B,
+ 'ptgRefN' => 0x2C,
+ 'ptgAreaN' => 0x2D,
+ 'ptgMemAreaN' => 0x2E,
+ 'ptgMemNoMemN' => 0x2F,
+ 'ptgNameX' => 0x39,
+ 'ptgRef3d' => 0x3A,
+ 'ptgArea3d' => 0x3B,
+ 'ptgRefErr3d' => 0x3C,
+ 'ptgAreaErr3d' => 0x3D,
+ 'ptgArrayV' => 0x40,
+ 'ptgFuncV' => 0x41,
+ 'ptgFuncVarV' => 0x42,
+ 'ptgNameV' => 0x43,
+ 'ptgRefV' => 0x44,
+ 'ptgAreaV' => 0x45,
+ 'ptgMemAreaV' => 0x46,
+ 'ptgMemErrV' => 0x47,
+ 'ptgMemNoMemV' => 0x48,
+ 'ptgMemFuncV' => 0x49,
+ 'ptgRefErrV' => 0x4A,
+ 'ptgAreaErrV' => 0x4B,
+ 'ptgRefNV' => 0x4C,
+ 'ptgAreaNV' => 0x4D,
+ 'ptgMemAreaNV' => 0x4E,
+ 'ptgMemNoMemN' => 0x4F,
+ 'ptgFuncCEV' => 0x58,
+ 'ptgNameXV' => 0x59,
+ 'ptgRef3dV' => 0x5A,
+ 'ptgArea3dV' => 0x5B,
+ 'ptgRefErr3dV' => 0x5C,
+ 'ptgAreaErr3d' => 0x5D,
+ 'ptgArrayA' => 0x60,
+ 'ptgFuncA' => 0x61,
+ 'ptgFuncVarA' => 0x62,
+ 'ptgNameA' => 0x63,
+ 'ptgRefA' => 0x64,
+ 'ptgAreaA' => 0x65,
+ 'ptgMemAreaA' => 0x66,
+ 'ptgMemErrA' => 0x67,
+ 'ptgMemNoMemA' => 0x68,
+ 'ptgMemFuncA' => 0x69,
+ 'ptgRefErrA' => 0x6A,
+ 'ptgAreaErrA' => 0x6B,
+ 'ptgRefNA' => 0x6C,
+ 'ptgAreaNA' => 0x6D,
+ 'ptgMemAreaNA' => 0x6E,
+ 'ptgMemNoMemN' => 0x6F,
+ 'ptgFuncCEA' => 0x78,
+ 'ptgNameXA' => 0x79,
+ 'ptgRef3dA' => 0x7A,
+ 'ptgArea3dA' => 0x7B,
+ 'ptgRefErr3dA' => 0x7C,
+ 'ptgAreaErr3d' => 0x7D,
+ );
+
+ # Thanks to Michael Meeks and Gnumeric for the initial arg values.
+ #
+ # The following hash was generated by "function_locale.pl" in the distro.
+ # Refer to function_locale.pl for non-English function names.
+ #
+ # The array elements are as follow:
+ # ptg: The Excel function ptg code.
+ # args: The number of arguments that the function takes:
+ # >=0 is a fixed number of arguments.
+ # -1 is a variable number of arguments.
+ # class: The reference, value or array class of the function args.
+ # vol: The function is volatile.
+ #
+ %functions = (
+ # ptg args class vol
+ 'COUNT' => [ 0, -1, 0, 0 ],
+ 'IF' => [ 1, -1, 1, 0 ],
+ 'ISNA' => [ 2, 1, 1, 0 ],
+ 'ISERROR' => [ 3, 1, 1, 0 ],
+ 'SUM' => [ 4, -1, 0, 0 ],
+ 'AVERAGE' => [ 5, -1, 0, 0 ],
+ 'MIN' => [ 6, -1, 0, 0 ],
+ 'MAX' => [ 7, -1, 0, 0 ],
+ 'ROW' => [ 8, -1, 0, 0 ],
+ 'COLUMN' => [ 9, -1, 0, 0 ],
+ 'NA' => [ 10, 0, 0, 0 ],
+ 'NPV' => [ 11, -1, 1, 0 ],
+ 'STDEV' => [ 12, -1, 0, 0 ],
+ 'DOLLAR' => [ 13, -1, 1, 0 ],
+ 'FIXED' => [ 14, -1, 1, 0 ],
+ 'SIN' => [ 15, 1, 1, 0 ],
+ 'COS' => [ 16, 1, 1, 0 ],
+ 'TAN' => [ 17, 1, 1, 0 ],
+ 'ATAN' => [ 18, 1, 1, 0 ],
+ 'PI' => [ 19, 0, 1, 0 ],
+ 'SQRT' => [ 20, 1, 1, 0 ],
+ 'EXP' => [ 21, 1, 1, 0 ],
+ 'LN' => [ 22, 1, 1, 0 ],
+ 'LOG10' => [ 23, 1, 1, 0 ],
+ 'ABS' => [ 24, 1, 1, 0 ],
+ 'INT' => [ 25, 1, 1, 0 ],
+ 'SIGN' => [ 26, 1, 1, 0 ],
+ 'ROUND' => [ 27, 2, 1, 0 ],
+ 'LOOKUP' => [ 28, -1, 0, 0 ],
+ 'INDEX' => [ 29, -1, 0, 1 ],
+ 'REPT' => [ 30, 2, 1, 0 ],
+ 'MID' => [ 31, 3, 1, 0 ],
+ 'LEN' => [ 32, 1, 1, 0 ],
+ 'VALUE' => [ 33, 1, 1, 0 ],
+ 'TRUE' => [ 34, 0, 1, 0 ],
+ 'FALSE' => [ 35, 0, 1, 0 ],
+ 'AND' => [ 36, -1, 1, 0 ],
+ 'OR' => [ 37, -1, 1, 0 ],
+ 'NOT' => [ 38, 1, 1, 0 ],
+ 'MOD' => [ 39, 2, 1, 0 ],
+ 'DCOUNT' => [ 40, 3, 0, 0 ],
+ 'DSUM' => [ 41, 3, 0, 0 ],
+ 'DAVERAGE' => [ 42, 3, 0, 0 ],
+ 'DMIN' => [ 43, 3, 0, 0 ],
+ 'DMAX' => [ 44, 3, 0, 0 ],
+ 'DSTDEV' => [ 45, 3, 0, 0 ],
+ 'VAR' => [ 46, -1, 0, 0 ],
+ 'DVAR' => [ 47, 3, 0, 0 ],
+ 'TEXT' => [ 48, 2, 1, 0 ],
+ 'LINEST' => [ 49, -1, 0, 0 ],
+ 'TREND' => [ 50, -1, 0, 0 ],
+ 'LOGEST' => [ 51, -1, 0, 0 ],
+ 'GROWTH' => [ 52, -1, 0, 0 ],
+ 'PV' => [ 56, -1, 1, 0 ],
+ 'FV' => [ 57, -1, 1, 0 ],
+ 'NPER' => [ 58, -1, 1, 0 ],
+ 'PMT' => [ 59, -1, 1, 0 ],
+ 'RATE' => [ 60, -1, 1, 0 ],
+ 'MIRR' => [ 61, 3, 0, 0 ],
+ 'IRR' => [ 62, -1, 0, 0 ],
+ 'RAND' => [ 63, 0, 1, 1 ],
+ 'MATCH' => [ 64, -1, 0, 0 ],
+ 'DATE' => [ 65, 3, 1, 0 ],
+ 'TIME' => [ 66, 3, 1, 0 ],
+ 'DAY' => [ 67, 1, 1, 0 ],
+ 'MONTH' => [ 68, 1, 1, 0 ],
+ 'YEAR' => [ 69, 1, 1, 0 ],
+ 'WEEKDAY' => [ 70, -1, 1, 0 ],
+ 'HOUR' => [ 71, 1, 1, 0 ],
+ 'MINUTE' => [ 72, 1, 1, 0 ],
+ 'SECOND' => [ 73, 1, 1, 0 ],
+ 'NOW' => [ 74, 0, 1, 1 ],
+ 'AREAS' => [ 75, 1, 0, 1 ],
+ 'ROWS' => [ 76, 1, 0, 1 ],
+ 'COLUMNS' => [ 77, 1, 0, 1 ],
+ 'OFFSET' => [ 78, -1, 0, 1 ],
+ 'SEARCH' => [ 82, -1, 1, 0 ],
+ 'TRANSPOSE' => [ 83, 1, 1, 0 ],
+ 'TYPE' => [ 86, 1, 1, 0 ],
+ 'ATAN2' => [ 97, 2, 1, 0 ],
+ 'ASIN' => [ 98, 1, 1, 0 ],
+ 'ACOS' => [ 99, 1, 1, 0 ],
+ 'CHOOSE' => [ 100, -1, 1, 0 ],
+ 'HLOOKUP' => [ 101, -1, 0, 0 ],
+ 'VLOOKUP' => [ 102, -1, 0, 0 ],
+ 'ISREF' => [ 105, 1, 0, 0 ],
+ 'LOG' => [ 109, -1, 1, 0 ],
+ 'CHAR' => [ 111, 1, 1, 0 ],
+ 'LOWER' => [ 112, 1, 1, 0 ],
+ 'UPPER' => [ 113, 1, 1, 0 ],
+ 'PROPER' => [ 114, 1, 1, 0 ],
+ 'LEFT' => [ 115, -1, 1, 0 ],
+ 'RIGHT' => [ 116, -1, 1, 0 ],
+ 'EXACT' => [ 117, 2, 1, 0 ],
+ 'TRIM' => [ 118, 1, 1, 0 ],
+ 'REPLACE' => [ 119, 4, 1, 0 ],
+ 'SUBSTITUTE' => [ 120, -1, 1, 0 ],
+ 'CODE' => [ 121, 1, 1, 0 ],
+ 'FIND' => [ 124, -1, 1, 0 ],
+ 'CELL' => [ 125, -1, 0, 1 ],
+ 'ISERR' => [ 126, 1, 1, 0 ],
+ 'ISTEXT' => [ 127, 1, 1, 0 ],
+ 'ISNUMBER' => [ 128, 1, 1, 0 ],
+ 'ISBLANK' => [ 129, 1, 1, 0 ],
+ 'T' => [ 130, 1, 0, 0 ],
+ 'N' => [ 131, 1, 0, 0 ],
+ 'DATEVALUE' => [ 140, 1, 1, 0 ],
+ 'TIMEVALUE' => [ 141, 1, 1, 0 ],
+ 'SLN' => [ 142, 3, 1, 0 ],
+ 'SYD' => [ 143, 4, 1, 0 ],
+ 'DDB' => [ 144, -1, 1, 0 ],
+ 'INDIRECT' => [ 148, -1, 1, 1 ],
+ 'CALL' => [ 150, -1, 1, 0 ],
+ 'CLEAN' => [ 162, 1, 1, 0 ],
+ 'MDETERM' => [ 163, 1, 2, 0 ],
+ 'MINVERSE' => [ 164, 1, 2, 0 ],
+ 'MMULT' => [ 165, 2, 2, 0 ],
+ 'IPMT' => [ 167, -1, 1, 0 ],
+ 'PPMT' => [ 168, -1, 1, 0 ],
+ 'COUNTA' => [ 169, -1, 0, 0 ],
+ 'PRODUCT' => [ 183, -1, 0, 0 ],
+ 'FACT' => [ 184, 1, 1, 0 ],
+ 'DPRODUCT' => [ 189, 3, 0, 0 ],
+ 'ISNONTEXT' => [ 190, 1, 1, 0 ],
+ 'STDEVP' => [ 193, -1, 0, 0 ],
+ 'VARP' => [ 194, -1, 0, 0 ],
+ 'DSTDEVP' => [ 195, 3, 0, 0 ],
+ 'DVARP' => [ 196, 3, 0, 0 ],
+ 'TRUNC' => [ 197, -1, 1, 0 ],
+ 'ISLOGICAL' => [ 198, 1, 1, 0 ],
+ 'DCOUNTA' => [ 199, 3, 0, 0 ],
+ 'ROUNDUP' => [ 212, 2, 1, 0 ],
+ 'ROUNDDOWN' => [ 213, 2, 1, 0 ],
+ 'RANK' => [ 216, -1, 0, 0 ],
+ 'ADDRESS' => [ 219, -1, 1, 0 ],
+ 'DAYS360' => [ 220, -1, 1, 0 ],
+ 'TODAY' => [ 221, 0, 1, 1 ],
+ 'VDB' => [ 222, -1, 1, 0 ],
+ 'MEDIAN' => [ 227, -1, 0, 0 ],
+ 'SUMPRODUCT' => [ 228, -1, 2, 0 ],
+ 'SINH' => [ 229, 1, 1, 0 ],
+ 'COSH' => [ 230, 1, 1, 0 ],
+ 'TANH' => [ 231, 1, 1, 0 ],
+ 'ASINH' => [ 232, 1, 1, 0 ],
+ 'ACOSH' => [ 233, 1, 1, 0 ],
+ 'ATANH' => [ 234, 1, 1, 0 ],
+ 'DGET' => [ 235, 3, 0, 0 ],
+ 'INFO' => [ 244, 1, 1, 1 ],
+ 'DB' => [ 247, -1, 1, 0 ],
+ 'FREQUENCY' => [ 252, 2, 0, 0 ],
+ 'ERROR.TYPE' => [ 261, 1, 1, 0 ],
+ 'REGISTER.ID' => [ 267, -1, 1, 0 ],
+ 'AVEDEV' => [ 269, -1, 0, 0 ],
+ 'BETADIST' => [ 270, -1, 1, 0 ],
+ 'GAMMALN' => [ 271, 1, 1, 0 ],
+ 'BETAINV' => [ 272, -1, 1, 0 ],
+ 'BINOMDIST' => [ 273, 4, 1, 0 ],
+ 'CHIDIST' => [ 274, 2, 1, 0 ],
+ 'CHIINV' => [ 275, 2, 1, 0 ],
+ 'COMBIN' => [ 276, 2, 1, 0 ],
+ 'CONFIDENCE' => [ 277, 3, 1, 0 ],
+ 'CRITBINOM' => [ 278, 3, 1, 0 ],
+ 'EVEN' => [ 279, 1, 1, 0 ],
+ 'EXPONDIST' => [ 280, 3, 1, 0 ],
+ 'FDIST' => [ 281, 3, 1, 0 ],
+ 'FINV' => [ 282, 3, 1, 0 ],
+ 'FISHER' => [ 283, 1, 1, 0 ],
+ 'FISHERINV' => [ 284, 1, 1, 0 ],
+ 'FLOOR' => [ 285, 2, 1, 0 ],
+ 'GAMMADIST' => [ 286, 4, 1, 0 ],
+ 'GAMMAINV' => [ 287, 3, 1, 0 ],
+ 'CEILING' => [ 288, 2, 1, 0 ],
+ 'HYPGEOMDIST' => [ 289, 4, 1, 0 ],
+ 'LOGNORMDIST' => [ 290, 3, 1, 0 ],
+ 'LOGINV' => [ 291, 3, 1, 0 ],
+ 'NEGBINOMDIST' => [ 292, 3, 1, 0 ],
+ 'NORMDIST' => [ 293, 4, 1, 0 ],
+ 'NORMSDIST' => [ 294, 1, 1, 0 ],
+ 'NORMINV' => [ 295, 3, 1, 0 ],
+ 'NORMSINV' => [ 296, 1, 1, 0 ],
+ 'STANDARDIZE' => [ 297, 3, 1, 0 ],
+ 'ODD' => [ 298, 1, 1, 0 ],
+ 'PERMUT' => [ 299, 2, 1, 0 ],
+ 'POISSON' => [ 300, 3, 1, 0 ],
+ 'TDIST' => [ 301, 3, 1, 0 ],
+ 'WEIBULL' => [ 302, 4, 1, 0 ],
+ 'SUMXMY2' => [ 303, 2, 2, 0 ],
+ 'SUMX2MY2' => [ 304, 2, 2, 0 ],
+ 'SUMX2PY2' => [ 305, 2, 2, 0 ],
+ 'CHITEST' => [ 306, 2, 2, 0 ],
+ 'CORREL' => [ 307, 2, 2, 0 ],
+ 'COVAR' => [ 308, 2, 2, 0 ],
+ 'FORECAST' => [ 309, 3, 2, 0 ],
+ 'FTEST' => [ 310, 2, 2, 0 ],
+ 'INTERCEPT' => [ 311, 2, 2, 0 ],
+ 'PEARSON' => [ 312, 2, 2, 0 ],
+ 'RSQ' => [ 313, 2, 2, 0 ],
+ 'STEYX' => [ 314, 2, 2, 0 ],
+ 'SLOPE' => [ 315, 2, 2, 0 ],
+ 'TTEST' => [ 316, 4, 2, 0 ],
+ 'PROB' => [ 317, -1, 2, 0 ],
+ 'DEVSQ' => [ 318, -1, 0, 0 ],
+ 'GEOMEAN' => [ 319, -1, 0, 0 ],
+ 'HARMEAN' => [ 320, -1, 0, 0 ],
+ 'SUMSQ' => [ 321, -1, 0, 0 ],
+ 'KURT' => [ 322, -1, 0, 0 ],
+ 'SKEW' => [ 323, -1, 0, 0 ],
+ 'ZTEST' => [ 324, -1, 0, 0 ],
+ 'LARGE' => [ 325, 2, 0, 0 ],
+ 'SMALL' => [ 326, 2, 0, 0 ],
+ 'QUARTILE' => [ 327, 2, 0, 0 ],
+ 'PERCENTILE' => [ 328, 2, 0, 0 ],
+ 'PERCENTRANK' => [ 329, -1, 0, 0 ],
+ 'MODE' => [ 330, -1, 2, 0 ],
+ 'TRIMMEAN' => [ 331, 2, 0, 0 ],
+ 'TINV' => [ 332, 2, 1, 0 ],
+ 'CONCATENATE' => [ 336, -1, 1, 0 ],
+ 'POWER' => [ 337, 2, 1, 0 ],
+ 'RADIANS' => [ 342, 1, 1, 0 ],
+ 'DEGREES' => [ 343, 1, 1, 0 ],
+ 'SUBTOTAL' => [ 344, -1, 0, 0 ],
+ 'SUMIF' => [ 345, -1, 0, 0 ],
+ 'COUNTIF' => [ 346, 2, 0, 0 ],
+ 'COUNTBLANK' => [ 347, 1, 0, 0 ],
+ 'ROMAN' => [ 354, -1, 1, 0 ],
+ );
+
+}
+
+
+
+
+1;
+
+
+__END__
+
+
+=head1 NAME
+
+Formula - A class for generating Excel formulas
+
+=head1 SYNOPSIS
+
+See the documentation for Spreadsheet::WriteExcel
+
+=head1 DESCRIPTION
+
+This module is used by Spreadsheet::WriteExcel. You do not need to use it directly.
+
+
+=head1 NOTES
+
+The following notes are to help developers and maintainers understand the sequence of operation. They are also intended as a pro-memoria for the author. ;-)
+
+Spreadsheet::WriteExcel::Formula converts a textual representation of a formula into the pre-parsed binary format that Excel uses to store formulas. For example C<1+2*3> is stored as follows: C<1E 01 00 1E 02 00 1E 03 00 05 03>.
+
+This string is comprised of operators and operands arranged in a reverse-Polish format. The meaning of the tokens in the above example is shown in the following table:
+
+ Token Name Value
+ 1E ptgInt 0001 (stored as 01 00)
+ 1E ptgInt 0002 (stored as 02 00)
+ 1E ptgInt 0003 (stored as 03 00)
+ 05 ptgMul
+ 03 ptgAdd
+
+The tokens and token names are defined in the "Excel Developer's Kit" from Microsoft Press. C<ptg> stands for Parse ThinG (as in "That lexer can't grok it, it's a parse thang.")
+
+In general the tokens fall into two categories: operators such as C<ptgMul> and operands such as C<ptgInt>. When the formula is evaluated by Excel the operand tokens push values onto a stack. The operator tokens then pop the required number of operands off of the stack, perform an operation and push the resulting value back onto the stack. This methodology is similar to the basic operation of a reverse-Polish (RPN) calculator.
+
+Spreadsheet::WriteExcel::Formula parses a formula using a C<Parse::RecDescent> parser (at a later stage it may use a C<Parse::Yapp> parser or C<Parse::FastDescent>).
+
+The parser converts the textual representation of a formula into a parse tree. Thus, C<1+2*3> is converted into something like the following, C<e> stands for expression:
+
+ e
+ / | \
+ 1 + e
+ / | \
+ 2 * 3
+
+
+The function C<_reverse_tree()> recurses down through this structure swapping the order of operators followed by operands to produce a reverse-Polish tree. In other words the formula is converted from in-fix notation to post-fix. Following the above example the resulting tree would look like this:
+
+
+ e
+ / | \
+ 1 e +
+ / | \
+ 2 3 *
+
+The result of the recursion is a single array of tokens. In our example the simplified form would look like the following:
+
+ (1, 2, 3, *, +)
+
+The actual return value contains some additional information to help in the secondary parsing stage:
+
+ (_num, 1, _num, 2, _num, 3, ptgMul, ptgAdd, _arg, 1)
+
+The additional tokens are:
+
+ Token Meaning
+ _num The next token is a number
+ _str The next token is a string
+ _ref2d The next token is a 2d cell reference
+ _ref3d The next token is a 3d cell reference
+ _range2d The next token is a 2d range
+ _range3d The next token is a 3d range
+ _func The next token is a function
+ _arg The next token is the number of args for a function
+ _class The next token is a function name
+ _vol The formula contains a voltile function
+
+The C<_arg> token is generated for all lists but is only used for functions that take a variable number of arguments.
+
+The C<_class> token indicates the start of the arguments to a function. This allows the post-processor to decide the "class" of the ref and range arguments that the function takes. The class can be reference, value or array. Since function calls can be nested, the class variable is stored on a stack in the C<@class> array. The class of the ref or range is then read as the top element of the stack C<$class[-1]>. When a C<_func> is read it pops the class value.
+
+Certain Excel functions such as RAND() and NOW() are designated as volatile and must be recalculated by Excel every time that a cell is updated. Any formulas that contain one of these functions has a specially formatted C<ptgAttr> tag prepended to it to indicate that it is volatile.
+
+A secondary parsing stage is carried out by C<parse_tokens()> which converts these tokens into a binary string. For the C<1+2*3> example this would give:
+
+ 1E 01 00 1E 02 00 1E 03 00 05 03
+
+This two-pass method could probably have been reduced to a single pass through the C<Parse::RecDescent> parser. However, it was easier to develop and debug this way.
+
+The token values and formula values are stored in the C<%ptg> and C<%functions> hashes. These hashes and the parser object C<$parser> are exposed as global data. This breaks the OO encapsulation, but means that they can be shared by several instances of Spreadsheet::WriteExcel called from the same program.
+
+Non-English function names can be added to the C<%functions> hash using the C<function_locale.pl> program in the C<examples> directory of the distro. The supported languages are: German, French, Spanish, Portuguese, Dutch, Finnish, Italian and Swedish. These languages are not added by default because there are conflicts between functions names in different languages.
+
+The parser is initialised by C<_init_parser()>. The initialisation is delayed until the first formula is parsed. This eliminates the overhead of generating the parser in programs that are not processing formulas. (The parser should really be pre-compiled, this is to-do when the grammar stabilises).
+
+
+
+
+=head1 AUTHOR
+
+John McNamara jmcnamara@cpan.org
+
+=head1 COPYRIGHT
+
+© MM-MMX, John McNamara.
+
+All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself.
diff --git a/mcu/tools/perl/Spreadsheet/WriteExcel/OLEwriter.pm b/mcu/tools/perl/Spreadsheet/WriteExcel/OLEwriter.pm
new file mode 100644
index 0000000..7cbb49e
--- /dev/null
+++ b/mcu/tools/perl/Spreadsheet/WriteExcel/OLEwriter.pm
@@ -0,0 +1,449 @@
+package Spreadsheet::WriteExcel::OLEwriter;
+
+###############################################################################
+#
+# OLEwriter - A writer class to store BIFF data in a OLE compound storage file.
+#
+#
+# Used in conjunction with Spreadsheet::WriteExcel
+#
+# Copyright 2000-2010, John McNamara, jmcnamara@cpan.org
+#
+# Documentation after __END__
+#
+
+use Exporter;
+use strict;
+use Carp;
+use FileHandle;
+
+
+
+
+
+use vars qw($VERSION @ISA);
+@ISA = qw(Exporter);
+
+$VERSION = '2.37';
+
+###############################################################################
+#
+# new()
+#
+# Constructor
+#
+sub new {
+
+ my $class = shift;
+ my $self = {
+ _olefilename => $_[0],
+ _filehandle => "",
+ _fileclosed => 0,
+ _internal_fh => 0,
+ _biff_only => 0,
+ _size_allowed => 0,
+ _biffsize => 0,
+ _booksize => 0,
+ _big_blocks => 0,
+ _list_blocks => 0,
+ _root_start => 0,
+ _block_count => 4,
+ };
+
+ bless $self, $class;
+ $self->_initialize();
+ return $self;
+}
+
+
+###############################################################################
+#
+# _initialize()
+#
+# Create a new filehandle or use the provided filehandle.
+#
+sub _initialize {
+
+ my $self = shift;
+ my $olefile = $self->{_olefilename};
+ my $fh;
+
+ # If the filename is a reference it is assumed that it is a valid
+ # filehandle, if not we create a filehandle.
+ #
+ if (ref($olefile)) {
+ $fh = $olefile;
+ }
+ else{
+
+ # Create a new file, open for writing
+ $fh = FileHandle->new("> $olefile");
+
+ # Workbook.pm also checks this but something may have happened since
+ # then.
+ if (not defined $fh) {
+ croak "Can't open $olefile. It may be in use or protected.\n";
+ }
+
+ # binmode file whether platform requires it or not
+ binmode($fh);
+
+ $self->{_internal_fh} = 1;
+ }
+
+ # Store filehandle
+ $self->{_filehandle} = $fh;
+}
+
+
+###############################################################################
+#
+# set_size($biffsize)
+#
+# Set the size of the data to be written to the OLE stream
+#
+# $big_blocks = (109 depot block x (128 -1 marker word)
+# - (1 x end words)) = 13842
+# $maxsize = $big_blocks * 512 bytes = 7087104
+#
+sub set_size {
+
+ my $self = shift;
+ my $maxsize = 7_087_104; # Use Spreadsheet::WriteExcel::Big to exceed this
+
+ if ($_[0] > $maxsize) {
+ return $self->{_size_allowed} = 0;
+ }
+
+ $self->{_biffsize} = $_[0];
+
+ # Set the min file size to 4k to avoid having to use small blocks
+ if ($_[0] > 4096) {
+ $self->{_booksize} = $_[0];
+ }
+ else {
+ $self->{_booksize} = 4096;
+ }
+
+ return $self->{_size_allowed} = 1;
+
+}
+
+
+###############################################################################
+#
+# _calculate_sizes()
+#
+# Calculate various sizes needed for the OLE stream
+#
+sub _calculate_sizes {
+
+ my $self = shift;
+ my $datasize = $self->{_booksize};
+
+ if ($datasize % 512 == 0) {
+ $self->{_big_blocks} = $datasize/512;
+ }
+ else {
+ $self->{_big_blocks} = int($datasize/512) +1;
+ }
+ # There are 127 list blocks and 1 marker blocks for each big block
+ # depot + 1 end of chain block
+ $self->{_list_blocks} = int(($self->{_big_blocks})/127) +1;
+ $self->{_root_start} = $self->{_big_blocks};
+}
+
+
+###############################################################################
+#
+# close()
+#
+# Write root entry, big block list and close the filehandle.
+# This routine is used to explicitly close the open filehandle without
+# having to wait for DESTROY.
+#
+sub close {
+
+ my $self = shift;
+
+ return if not $self->{_size_allowed};
+
+ $self->_write_padding() if not $self->{_biff_only};
+ $self->_write_property_storage() if not $self->{_biff_only};
+ $self->_write_big_block_depot() if not $self->{_biff_only};
+
+ my $close = 1; # Default to no error for external filehandles.
+
+ # Close the filehandle if it was created internally.
+ $close = CORE::close($self->{_filehandle}) if $self->{_internal_fh};
+
+ $self->{_fileclosed} = 1;
+
+ return $close;
+}
+
+
+###############################################################################
+#
+# DESTROY()
+#
+# Close the filehandle if it hasn't already been explicitly closed.
+#
+sub DESTROY {
+
+ my $self = shift;
+
+ local ($@, $!, $^E, $?);
+
+ $self->close() unless $self->{_fileclosed};
+}
+
+
+###############################################################################
+#
+# write($data)
+#
+# Write BIFF data to OLE file.
+#
+sub write {
+
+ my $self = shift;
+
+ # Protect print() from -l on the command line.
+ local $\ = undef;
+ print {$self->{_filehandle}} $_[0];
+}
+
+
+###############################################################################
+#
+# write_header()
+#
+# Write OLE header block.
+#
+sub write_header {
+
+ my $self = shift;
+
+ return if $self->{_biff_only};
+ $self->_calculate_sizes();
+
+ my $root_start = $self->{_root_start};
+ my $num_lists = $self->{_list_blocks};
+
+ my $id = pack("NN", 0xD0CF11E0, 0xA1B11AE1);
+ my $unknown1 = pack("VVVV", 0x00, 0x00, 0x00, 0x00);
+ my $unknown2 = pack("vv", 0x3E, 0x03);
+ my $unknown3 = pack("v", -2);
+ my $unknown4 = pack("v", 0x09);
+ my $unknown5 = pack("VVV", 0x06, 0x00, 0x00);
+ my $num_bbd_blocks = pack("V", $num_lists);
+ my $root_startblock = pack("V", $root_start);
+ my $unknown6 = pack("VV", 0x00, 0x1000);
+ my $sbd_startblock = pack("V", -2);
+ my $unknown7 = pack("VVV", 0x00, -2 ,0x00);
+ my $unused = pack("V", -1);
+
+ # Protect print() from -l on the command line.
+ local $\ = undef;
+
+ print {$self->{_filehandle}} $id;
+ print {$self->{_filehandle}} $unknown1;
+ print {$self->{_filehandle}} $unknown2;
+ print {$self->{_filehandle}} $unknown3;
+ print {$self->{_filehandle}} $unknown4;
+ print {$self->{_filehandle}} $unknown5;
+ print {$self->{_filehandle}} $num_bbd_blocks;
+ print {$self->{_filehandle}} $root_startblock;
+ print {$self->{_filehandle}} $unknown6;
+ print {$self->{_filehandle}} $sbd_startblock;
+ print {$self->{_filehandle}} $unknown7;
+
+ for (1..$num_lists) {
+ $root_start++;
+ print {$self->{_filehandle}} pack("V", $root_start);
+ }
+
+ for ($num_lists..108) {
+ print {$self->{_filehandle}} $unused;
+ }
+}
+
+
+###############################################################################
+#
+# _write_big_block_depot()
+#
+# Write big block depot.
+#
+sub _write_big_block_depot {
+
+ my $self = shift;
+ my $num_blocks = $self->{_big_blocks};
+ my $num_lists = $self->{_list_blocks};
+ my $total_blocks = $num_lists *128;
+ my $used_blocks = $num_blocks + $num_lists +2;
+
+ my $marker = pack("V", -3);
+ my $end_of_chain = pack("V", -2);
+ my $unused = pack("V", -1);
+
+
+ # Protect print() from -l on the command line.
+ local $\ = undef;
+
+ for my $i (1..$num_blocks-1) {
+ print {$self->{_filehandle}} pack("V",$i);
+ }
+
+ print {$self->{_filehandle}} $end_of_chain;
+ print {$self->{_filehandle}} $end_of_chain;
+
+ for (1..$num_lists) {
+ print {$self->{_filehandle}} $marker;
+ }
+
+ for ($used_blocks..$total_blocks) {
+ print {$self->{_filehandle}} $unused;
+ }
+}
+
+
+###############################################################################
+#
+# _write_property_storage()
+#
+# Write property storage. TODO: add summary sheets
+#
+sub _write_property_storage {
+
+ my $self = shift;
+
+ my $rootsize = -2;
+ my $booksize = $self->{_booksize};
+
+ ################# name type dir start size
+ $self->_write_pps('Root Entry', 0x05, 1, -2, 0x00);
+ $self->_write_pps('Workbook', 0x02, -1, 0x00, $booksize);
+ $self->_write_pps('', 0x00, -1, 0x00, 0x0000);
+ $self->_write_pps('', 0x00, -1, 0x00, 0x0000);
+}
+
+
+###############################################################################
+#
+# _write_pps()
+#
+# Write property sheet in property storage
+#
+sub _write_pps {
+
+ my $self = shift;
+
+ my $name = $_[0];
+ my @name = ();
+ my $length = 0;
+
+ if ($name ne '') {
+ $name = $_[0] . "\0";
+ # Simulate a Unicode string
+ @name = map(ord, split('', $name));
+ $length = length($name) * 2;
+ }
+
+ my $rawname = pack("v*", @name);
+ my $zero = pack("C", 0);
+
+ my $pps_sizeofname = pack("v", $length); #0x40
+ my $pps_type = pack("v", $_[1]); #0x42
+ my $pps_prev = pack("V", -1); #0x44
+ my $pps_next = pack("V", -1); #0x48
+ my $pps_dir = pack("V", $_[2]); #0x4c
+
+ my $unknown1 = pack("V", 0);
+
+ my $pps_ts1s = pack("V", 0); #0x64
+ my $pps_ts1d = pack("V", 0); #0x68
+ my $pps_ts2s = pack("V", 0); #0x6c
+ my $pps_ts2d = pack("V", 0); #0x70
+ my $pps_sb = pack("V", $_[3]); #0x74
+ my $pps_size = pack("V", $_[4]); #0x78
+
+
+ # Protect print() from -l on the command line.
+ local $\ = undef;
+
+ print {$self->{_filehandle}} $rawname;
+ print {$self->{_filehandle}} $zero x (64 -$length);
+ print {$self->{_filehandle}} $pps_sizeofname;
+ print {$self->{_filehandle}} $pps_type;
+ print {$self->{_filehandle}} $pps_prev;
+ print {$self->{_filehandle}} $pps_next;
+ print {$self->{_filehandle}} $pps_dir;
+ print {$self->{_filehandle}} $unknown1 x 5;
+ print {$self->{_filehandle}} $pps_ts1s;
+ print {$self->{_filehandle}} $pps_ts1d;
+ print {$self->{_filehandle}} $pps_ts2d;
+ print {$self->{_filehandle}} $pps_ts2d;
+ print {$self->{_filehandle}} $pps_sb;
+ print {$self->{_filehandle}} $pps_size;
+ print {$self->{_filehandle}} $unknown1;
+}
+
+
+###############################################################################
+#
+# _write_padding()
+#
+# Pad the end of the file
+#
+sub _write_padding {
+
+ my $self = shift;
+ my $biffsize = $self->{_biffsize};
+ my $min_size;
+
+ if ($biffsize < 4096) {
+ $min_size = 4096;
+ }
+ else {
+ $min_size = 512;
+ }
+
+ # Protect print() from -l on the command line.
+ local $\ = undef;
+
+ if ($biffsize % $min_size != 0) {
+ my $padding = $min_size - ($biffsize % $min_size);
+ print {$self->{_filehandle}} "\0" x $padding;
+ }
+}
+
+
+1;
+
+
+__END__
+
+
+=head1 NAME
+
+OLEwriter - A writer class to store BIFF data in a OLE compound storage file.
+
+=head1 SYNOPSIS
+
+See the documentation for Spreadsheet::WriteExcel
+
+=head1 DESCRIPTION
+
+This module is used in conjunction with Spreadsheet::WriteExcel.
+
+=head1 AUTHOR
+
+John McNamara jmcnamara@cpan.org
+
+=head1 COPYRIGHT
+
+© MM-MMX, John McNamara.
+
+All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself.
diff --git a/mcu/tools/perl/Spreadsheet/WriteExcel/Properties.pm b/mcu/tools/perl/Spreadsheet/WriteExcel/Properties.pm
new file mode 100644
index 0000000..62c933a
--- /dev/null
+++ b/mcu/tools/perl/Spreadsheet/WriteExcel/Properties.pm
@@ -0,0 +1,352 @@
+package Spreadsheet::WriteExcel::Properties;
+
+###############################################################################
+#
+# Properties - A module for creating Excel property sets.
+#
+#
+# Used in conjunction with Spreadsheet::WriteExcel
+#
+# Copyright 2000-2010, John McNamara.
+#
+# Documentation after __END__
+#
+
+use Exporter;
+use strict;
+use Carp;
+use POSIX 'fmod';
+use Time::Local 'timelocal';
+
+
+
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+@ISA = qw(Exporter);
+
+$VERSION = '2.37';
+
+# Set up the exports.
+my @all_functions = qw(
+ create_summary_property_set
+ create_doc_summary_property_set
+ _pack_property_data
+ _pack_VT_I2
+ _pack_VT_LPSTR
+ _pack_VT_FILETIME
+);
+
+my @pps_summaries = qw(
+ create_summary_property_set
+ create_doc_summary_property_set
+);
+
+@EXPORT = ();
+@EXPORT_OK = (@all_functions);
+%EXPORT_TAGS = (testing => \@all_functions,
+ property_sets => \@pps_summaries,
+ );
+
+
+###############################################################################
+#
+# create_summary_property_set().
+#
+# Create the SummaryInformation property set. This is mainly used for the
+# Title, Subject, Author, Keywords, Comments, Last author keywords and the
+# creation date.
+#
+sub create_summary_property_set {
+
+ my @properties = @{$_[0]};
+
+ my $byte_order = pack 'v', 0xFFFE;
+ my $version = pack 'v', 0x0000;
+ my $system_id = pack 'V', 0x00020105;
+ my $class_id = pack 'H*', '00000000000000000000000000000000';
+ my $num_property_sets = pack 'V', 0x0001;
+ my $format_id = pack 'H*', 'E0859FF2F94F6810AB9108002B27B3D9';
+ my $offset = pack 'V', 0x0030;
+ my $num_property = pack 'V', scalar @properties;
+ my $property_offsets = '';
+
+ # Create the property set data block and calculate the offsets into it.
+ my ($property_data, $offsets) = _pack_property_data(\@properties);
+
+ # Create the property type and offsets based on the previous calculation.
+ for my $i (0 .. @properties -1) {
+ $property_offsets .= pack('VV', $properties[$i]->[0], $offsets->[$i]);
+ }
+
+ # Size of $size (4 bytes) + $num_property (4 bytes) + the data structures.
+ my $size = 8 + length($property_offsets) + length($property_data);
+ $size = pack 'V', $size;
+
+
+ return $byte_order .
+ $version .
+ $system_id .
+ $class_id .
+ $num_property_sets .
+ $format_id .
+ $offset .
+ $size .
+ $num_property .
+ $property_offsets .
+ $property_data;
+}
+
+
+###############################################################################
+#
+# Create the DocSummaryInformation property set. This is mainly used for the
+# Manager, Company and Category keywords.
+#
+# The DocSummary also contains a stream for user defined properties. However
+# this is a little arcane and probably not worth the implementation effort.
+#
+sub create_doc_summary_property_set {
+
+ my @properties = @{$_[0]};
+
+ my $byte_order = pack 'v', 0xFFFE;
+ my $version = pack 'v', 0x0000;
+ my $system_id = pack 'V', 0x00020105;
+ my $class_id = pack 'H*', '00000000000000000000000000000000';
+ my $num_property_sets = pack 'V', 0x0002;
+
+ my $format_id_0 = pack 'H*', '02D5CDD59C2E1B10939708002B2CF9AE';
+ my $format_id_1 = pack 'H*', '05D5CDD59C2E1B10939708002B2CF9AE';
+ my $offset_0 = pack 'V', 0x0044;
+ my $num_property_0 = pack 'V', scalar @properties;
+ my $property_offsets_0 = '';
+
+ # Create the property set data block and calculate the offsets into it.
+ my ($property_data_0, $offsets) = _pack_property_data(\@properties);
+
+ # Create the property type and offsets based on the previous calculation.
+ for my $i (0 .. @properties -1) {
+ $property_offsets_0 .= pack('VV', $properties[$i]->[0], $offsets->[$i]);
+ }
+
+ # Size of $size (4 bytes) + $num_property (4 bytes) + the data structures.
+ my $data_len = 8 + length($property_offsets_0) + length($property_data_0);
+ my $size_0 = pack 'V', $data_len;
+
+
+ # The second property set offset is at the end of the first property set.
+ my $offset_1 = pack 'V', 0x0044 + $data_len;
+
+ # We will use a static property set stream rather than try to generate it.
+ my $property_data_1 = pack 'H*', join '', qw (
+ 98 00 00 00 03 00 00 00 00 00 00 00 20 00 00 00
+ 01 00 00 00 36 00 00 00 02 00 00 00 3E 00 00 00
+ 01 00 00 00 02 00 00 00 0A 00 00 00 5F 50 49 44
+ 5F 47 55 49 44 00 02 00 00 00 E4 04 00 00 41 00
+ 00 00 4E 00 00 00 7B 00 31 00 36 00 43 00 34 00
+ 42 00 38 00 33 00 42 00 2D 00 39 00 36 00 35 00
+ 46 00 2D 00 34 00 42 00 32 00 31 00 2D 00 39 00
+ 30 00 33 00 44 00 2D 00 39 00 31 00 30 00 46 00
+ 41 00 44 00 46 00 41 00 37 00 30 00 31 00 42 00
+ 7D 00 00 00 00 00 00 00 2D 00 39 00 30 00 33 00
+ );
+
+
+ return $byte_order .
+ $version .
+ $system_id .
+ $class_id .
+ $num_property_sets .
+ $format_id_0 .
+ $offset_0 .
+ $format_id_1 .
+ $offset_1 .
+
+ $size_0 .
+ $num_property_0 .
+ $property_offsets_0 .
+ $property_data_0 .
+
+ $property_data_1;
+}
+
+
+###############################################################################
+#
+# _pack_property_data().
+#
+# Create a packed property set structure. Strings are null terminated and
+# padded to a 4 byte boundary. We also use this function to keep track of the
+# property offsets within the data structure. These offsets are used by the
+# calling functions. Currently we only need to handle 4 property types:
+# VT_I2, VT_LPSTR, VT_FILETIME.
+#
+sub _pack_property_data {
+
+ my @properties = @{$_[0]};
+ my $offset = $_[1] || 0;
+ my $packed_property = '';
+ my $data = '';
+ my @offsets;
+
+ # Get the strings codepage from the first property.
+ my $codepage = $properties[0]->[2];
+
+ # The properties start after 8 bytes for size + num_properties + 8 bytes
+ # for each propety type/offset pair.
+ $offset += 8 * (@properties + 1);
+
+ for my $property (@properties) {
+ push @offsets, $offset;
+
+ my $property_type = $property->[1];
+
+ if ($property_type eq 'VT_I2') {
+ $packed_property = _pack_VT_I2($property->[2]);
+ }
+ elsif ($property_type eq 'VT_LPSTR') {
+ $packed_property = _pack_VT_LPSTR($property->[2], $codepage);
+ }
+ elsif ($property_type eq 'VT_FILETIME') {
+ $packed_property = _pack_VT_FILETIME($property->[2]);
+ }
+ else {
+ croak "Unknown property type: $property_type\n";
+ }
+
+ $offset += length $packed_property;
+ $data .= $packed_property;
+ }
+
+ return $data, \@offsets;
+}
+
+
+###############################################################################
+#
+# _pack_VT_I2().
+#
+# Pack an OLE property type: VT_I2, 16-bit signed integer.
+#
+sub _pack_VT_I2 {
+
+ my $type = 0x0002;
+ my $value = $_[0];
+
+ my $data = pack 'VV', $type, $value;
+
+ return $data;
+}
+
+
+###############################################################################
+#
+# _pack_VT_LPSTR().
+#
+# Pack an OLE property type: VT_LPSTR, String in the Codepage encoding.
+# The strings are null terminated and padded to a 4 byte boundary.
+#
+sub _pack_VT_LPSTR {
+
+ my $type = 0x001E;
+ my $string = $_[0] . "\0";
+ my $codepage = $_[1];
+ my $length;
+ my $byte_string;
+
+ if ($codepage == 0x04E4) {
+ # Latin1
+ $byte_string = $string;
+ $length = length $byte_string;
+ }
+ elsif ($codepage == 0xFDE9) {
+ # UTF-8
+ if ( $] > 5.008 ) {
+ require Encode;
+ if (Encode::is_utf8($string)) {
+ $byte_string = Encode::encode_utf8($string);
+ }
+ else {
+ $byte_string = $string;
+ }
+ }
+ else {
+ $byte_string = $string;
+ }
+
+ $length = length $byte_string;
+ }
+ else {
+ croak "Unknown codepage: $codepage\n";
+ }
+
+ # Pack the data.
+ my $data = pack 'VV', $type, $length;
+ $data .= $byte_string;
+
+ # The packed data has to null padded to a 4 byte boundary.
+ if (my $extra = $length % 4) {
+ $data .= "\0" x (4 - $extra);
+ }
+
+ return $data;
+}
+
+
+###############################################################################
+#
+# _pack_VT_FILETIME().
+#
+# Pack an OLE property type: VT_FILETIME.
+#
+sub _pack_VT_FILETIME {
+
+ my $type = 0x0040;
+ my $localtime = $_[0];
+
+ # Convert from localtime to seconds.
+ my $seconds = Time::Local::timelocal(@{$localtime});
+
+ # Add the number of seconds between the 1601 and 1970 epochs.
+ $seconds += 11644473600;
+
+ # The FILETIME seconds are in units of 100 nanoseconds.
+ my $nanoseconds = $seconds * 1E7;
+
+ # Pack the total nanoseconds into 64 bits.
+ my $time_hi = int($nanoseconds / 2**32);
+ my $time_lo = POSIX::fmod($nanoseconds, 2**32);
+
+ my $data = pack 'VVV', $type, $time_lo, $time_hi;
+
+ return $data;
+}
+
+
+1;
+
+
+__END__
+
+
+=head1 NAME
+
+Properties - A module for creating Excel property sets.
+
+=head1 SYNOPSIS
+
+See the C<set_properties()> method in the Spreadsheet::WriteExcel documentation.
+
+=head1 DESCRIPTION
+
+This module is used in conjunction with Spreadsheet::WriteExcel.
+
+=head1 AUTHOR
+
+John McNamara jmcnamara@cpan.org
+
+=head1 COPYRIGHT
+
+© MM-MMX, John McNamara.
+
+All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself.
diff --git a/mcu/tools/perl/Spreadsheet/WriteExcel/Utility.pm b/mcu/tools/perl/Spreadsheet/WriteExcel/Utility.pm
new file mode 100644
index 0000000..b6617e7
--- /dev/null
+++ b/mcu/tools/perl/Spreadsheet/WriteExcel/Utility.pm
@@ -0,0 +1,938 @@
+package Spreadsheet::WriteExcel::Utility;
+
+###############################################################################
+#
+# Utility - Helper functions for Spreadsheet::WriteExcel.
+#
+# Copyright 2000-2010, John McNamara, jmcnamara@cpan.org
+#
+#
+
+use Exporter;
+use strict;
+use autouse 'Date::Calc' => qw(Delta_DHMS Decode_Date_EU Decode_Date_US);
+use autouse 'Date::Manip' => qw(ParseDate Date_Init);
+
+
+# Do all of the export preparation
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+
+# Row and column functions
+my @rowcol = qw(
+ xl_rowcol_to_cell
+ xl_cell_to_rowcol
+ xl_range_formula
+ xl_inc_row
+ xl_dec_row
+ xl_inc_col
+ xl_dec_col
+ );
+
+# Date and Time functions
+my @dates = qw(
+ xl_date_list
+ xl_date_1904
+ xl_parse_time
+ xl_parse_date
+ xl_parse_date_init
+ xl_decode_date_EU
+ xl_decode_date_US
+ );
+
+
+@ISA = qw(Exporter);
+@EXPORT_OK = ();
+@EXPORT = (@rowcol, @dates);
+%EXPORT_TAGS = (
+ rowcol => \@rowcol,
+ dates => \@dates
+ );
+
+$VERSION = '2.37';
+
+
+
+
+=head1 NAME
+
+Utility - Helper functions for Spreadsheet::WriteExcel.
+
+
+
+=head1 SYNOPSIS
+
+Functions to help with some common tasks when using Spreadsheet::WriteExcel.
+
+These functions mainly relate to dealing with rows and columns in A1 notation and to handling dates and times.
+
+ use Spreadsheet::WriteExcel::Utility; # Import everything
+
+ ($row, $col) = xl_cell_to_rowcol('C2'); # (1, 2)
+ $str = xl_rowcol_to_cell(1, 2); # C2
+ $str = xl_inc_col('Z1' ); # AA1
+ $str = xl_dec_col('AA1' ); # Z1
+
+ $date = xl_date_list(2002, 1, 1); # 37257
+ $date = xl_parse_date("11 July 1997"); # 35622
+ $time = xl_parse_time('3:21:36 PM'); # 0.64
+ $date = xl_decode_date_EU("13 May 2002"); # 37389
+
+
+
+
+=head1 DESCRIPTION
+
+This module provides a set of functions to help with some common tasks encountered when using the Spreadsheet::WriteExcel module. The two main categories of function are:
+
+Row and column functions: these are used to deal with Excel's A1 representation of cells. The functions in this category are:
+
+ xl_rowcol_to_cell
+ xl_cell_to_rowcol
+ xl_range_formula
+ xl_inc_row
+ xl_dec_row
+ xl_inc_col
+ xl_dec_col
+
+Date and Time functions: these are used to convert dates and times to the numeric format used by Excel. The functions in this category are:
+
+ xl_date_list
+ xl_date_1904
+ xl_parse_time
+ xl_parse_date
+ xl_parse_date_init
+ xl_decode_date_EU
+ xl_decode_date_US
+
+All of these functions are exported by default. However, you can use import lists if you wish to limit the functions that are imported:
+
+ use Spreadsheet::WriteExcel::Utility; # Import everything
+ use Spreadsheet::WriteExcel::Utility qw(xl_date_list); # xl_date_list only
+ use Spreadsheet::WriteExcel::Utility qw(:rowcol); # Row/col functions
+ use Spreadsheet::WriteExcel::Utility qw(:dates); # Date functions
+
+
+
+=head1 ROW AND COLUMN FUNCTIONS
+
+
+Spreadsheet::WriteExcel supports two forms of notation to designate the position of cells: Row-column notation and A1 notation.
+
+Row-column notation uses a zero based index for both row and column while A1 notation uses the standard Excel alphanumeric sequence of column letter and 1-based row. Columns range from A to IV i.e. 0 to 255, rows range from 1 to 16384 in Excel 5 and 65536 in Excel 97. For example:
+
+ (0, 0) # The top left cell in row-column notation.
+ ('A1') # The top left cell in A1 notation.
+
+ (1999, 29) # Row-column notation.
+ ('AD2000') # The same cell in A1 notation.
+
+Row-column notation is useful if you are referring to cells programmatically:
+
+ for my $i (0 .. 9) {
+ $worksheet->write($i, 0, 'Hello'); # Cells A1 to A10
+ }
+
+A1 notation is useful for setting up a worksheet manually and for working with formulas:
+
+ $worksheet->write('H1', 200);
+ $worksheet->write('H2', '=H7+1');
+
+The functions in the following sections can be used for dealing with A1 notation, for example:
+
+ ($row, $col) = xl_cell_to_rowcol('C2'); # (1, 2)
+ $str = xl_rowcol_to_cell(1, 2); # C2
+
+
+Cell references in Excel can be either relative or absolute. Absolute references are prefixed by the dollar symbol as shown below:
+
+ A1 # Column and row are relative
+ $A1 # Column is absolute and row is relative
+ A$1 # Column is relative and row is absolute
+ $A$1 # Column and row are absolute
+
+An absolute reference only has an effect if the cell is copied. Refer to the Excel documentation for further details. All of the following functions support absolute references.
+
+=cut
+
+
+
+
+###############################################################################
+###############################################################################
+
+=head2 xl_rowcol_to_cell($row, $col, $row_absolute, $col_absolute)
+
+ Parameters: $row: Integer
+ $col: Integer
+ $row_absolute: Boolean (1/0) [optional, default is 0]
+ $col_absolute: Boolean (1/0) [optional, default is 0]
+
+ Returns: A string in A1 cell notation
+
+
+This function converts a zero based row and column cell reference to a A1 style string:
+
+ $str = xl_rowcol_to_cell(0, 0); # A1
+ $str = xl_rowcol_to_cell(0, 1); # B1
+ $str = xl_rowcol_to_cell(1, 0); # A2
+
+
+The optional parameters C<$row_absolute> and C<$col_absolute> can be used to indicate if the row or column is absolute:
+
+ $str = xl_rowcol_to_cell(0, 0, 0, 1); # $A1
+ $str = xl_rowcol_to_cell(0, 0, 1, 0); # A$1
+ $str = xl_rowcol_to_cell(0, 0, 1, 1); # $A$1
+
+See L<ROW AND COLUMN FUNCTIONS> for an explanation of absolute cell references.
+
+
+=cut
+###############################################################################
+#
+# xl_rowcol_to_cell($row, $col, $row_absolute, $col_absolute)
+#
+sub xl_rowcol_to_cell {
+
+ my $row = $_[0];
+ my $col = $_[1];
+ my $row_abs = $_[2] ? '$' : '';
+ my $col_abs = $_[3] ? '$' : '';
+
+
+ my $int = int ($col / 26);
+ my $frac = $col % 26;
+
+ my $chr1 =''; # Most significant character in AA1
+
+ if ($int > 0) {
+ $chr1 = chr( ord('A') + $int -1 );
+ }
+
+ my $chr2 = chr( ord('A') + $frac );
+
+ # Zero index to 1-index
+ $row++;
+
+ return $col_abs . $chr1 . $chr2 . $row_abs. $row;
+}
+
+
+
+
+###############################################################################
+###############################################################################
+
+=head2 xl_cell_to_rowcol($string)
+
+
+ Parameters: $string String in A1 format
+
+ Returns: List ($row, $col)
+
+This function converts an Excel cell reference in A1 notation to a zero based row and column. The function will also handle Excel's absolute, C<$>, cell notation.
+
+ my ($row, $col) = xl_cell_to_rowcol('A1'); # (0, 0)
+ my ($row, $col) = xl_cell_to_rowcol('B1'); # (0, 1)
+ my ($row, $col) = xl_cell_to_rowcol('C2'); # (1, 2)
+ my ($row, $col) = xl_cell_to_rowcol('$C2' ); # (1, 2)
+ my ($row, $col) = xl_cell_to_rowcol('C$2' ); # (1, 2)
+ my ($row, $col) = xl_cell_to_rowcol('$C$2'); # (1, 2)
+
+=cut
+###############################################################################
+#
+# xl_cell_to_rowcol($string)
+#
+# Returns: ($row, $col, $row_absolute, $col_absolute)
+#
+# The $row_absolute and $col_absolute parameters aren't documented because they
+# mainly used internally and aren't very useful to the user.
+#
+sub xl_cell_to_rowcol {
+
+ my $cell = shift;
+
+ $cell =~ /(\$?)([A-I]?[A-Z])(\$?)(\d+)/;
+
+ my $col_abs = $1 eq "" ? 0 : 1;
+ my $col = $2;
+ my $row_abs = $3 eq "" ? 0 : 1;
+ my $row = $4;
+
+ # Convert base26 column string to number
+ # All your Base are belong to us.
+ my @chars = split //, $col;
+ my $expn = 0;
+ $col = 0;
+
+ while (@chars) {
+ my $char = pop(@chars); # LS char first
+ $col += (ord($char) -ord('A') +1) * (26**$expn);
+ $expn++;
+ }
+
+ # Convert 1-index to zero-index
+ $row--;
+ $col--;
+
+ return $row, $col, $row_abs, $col_abs;
+}
+
+
+
+
+###############################################################################
+###############################################################################
+
+=head2 xl_range_formula($sheetname, $row_1, $row_2, $col_1, $col_2)
+
+ Parameters: $sheetname String
+ $row_1: Integer
+ $row_2: Integer
+ $col_1: Integer
+ $col_2: Integer
+
+ Returns: A worksheet range formula as a string.
+
+This function converts zero based row and column cell references to an A1 style formula string:
+
+ my $str = xl_range_formula('Sheet1', 0, 9, 0, 0); # =Sheet1!$A$1:$A$10
+ my $str = xl_range_formula('Sheet2', 6, 65, 1, 1); # =Sheet2!$B$7:$B$66
+ my $str = xl_range_formula('New data', 1, 8, 2, 2); # ='New data'!$C$2:$C$9
+
+
+This is useful for setting ranges in Chart objects:
+
+
+ $chart->add_series(
+ categories => xl_range_formula('Sheet1', 1, 9, 0, 0),
+ values => xl_range_formula('Sheet1', 1, 9, 1, 1);,
+ );
+
+ # Which is the same as:
+
+ $chart->add_series(
+ categories => '=Sheet1!$A$2:$A$10',
+ values => '=Sheet1!$B$2:$B$10',
+ );
+
+
+=cut
+###############################################################################
+#
+# xl_range_formula($sheetname, $row_1, $row_2, $col_1, $col_2)
+#
+sub xl_range_formula {
+
+ my ($sheetname, $row_1, $row_2, $col_1, $col_2) = @_;
+
+ # Use Excel's conventions and quote the sheet name if it contains any
+ # non-word character or if it isn't already quoted.
+ if ($sheetname =~ /\W/ && $sheetname !~ /^'/) {
+ $sheetname = q(') . $sheetname . q(');
+ }
+
+ my $range1 = xl_rowcol_to_cell($row_1, $col_1, 1, 1);
+ my $range2 = xl_rowcol_to_cell($row_2, $col_2, 1, 1);
+
+ return '=' . $sheetname . '!' . $range1 . ':' . $range2;
+}
+
+
+
+
+###############################################################################
+###############################################################################
+
+=head2 xl_inc_row($string)
+
+
+ Parameters: $string, a string in A1 format
+
+ Returns: Incremented string in A1 format
+
+This functions takes a cell reference string in A1 notation and increments the row. The function will also handle Excel's absolute, C<$>, cell notation:
+
+ my $str = xl_inc_row('A1' ); # A2
+ my $str = xl_inc_row('B$2' ); # B$3
+ my $str = xl_inc_row('$C3' ); # $C4
+ my $str = xl_inc_row('$D$4'); # $D$5
+
+
+=cut
+###############################################################################
+#
+# xl_inc_row($string)
+#
+sub xl_inc_row {
+
+ my $cell = shift;
+ my ($row, $col, $row_abs, $col_abs) = xl_cell_to_rowcol($cell);
+
+ return xl_rowcol_to_cell(++$row, $col, $row_abs, $col_abs);
+}
+
+
+
+
+###############################################################################
+###############################################################################
+
+=head2 xl_dec_row($string)
+
+
+ Parameters: $string, a string in A1 format
+
+ Returns: Decremented string in A1 format
+
+This functions takes a cell reference string in A1 notation and decrements the row. The function will also handle Excel's absolute, C<$>, cell notation:
+
+ my $str = xl_dec_row('A2' ); # A1
+ my $str = xl_dec_row('B$3' ); # B$2
+ my $str = xl_dec_row('$C4' ); # $C3
+ my $str = xl_dec_row('$D$5'); # $D$4
+
+
+=cut
+###############################################################################
+#
+# xl_dec_row($string)
+#
+# Decrements the row number of an Excel cell reference in A1 notation.
+# For example C4 to C3
+#
+# Returns: a cell reference string.
+#
+sub xl_dec_row {
+
+ my $cell = shift;
+ my ($row, $col, $row_abs, $col_abs) = xl_cell_to_rowcol($cell);
+
+ return xl_rowcol_to_cell(--$row, $col, $row_abs, $col_abs);
+}
+
+
+
+
+###############################################################################
+###############################################################################
+
+=head2 xl_inc_col($string)
+
+
+ Parameters: $string, a string in A1 format
+
+ Returns: Incremented string in A1 format
+
+This functions takes a cell reference string in A1 notation and increments the column. The function will also handle Excel's absolute, C<$>, cell notation:
+
+ my $str = xl_inc_col('A1' ); # B1
+ my $str = xl_inc_col('Z1' ); # AA1
+ my $str = xl_inc_col('$B1' ); # $C1
+ my $str = xl_inc_col('$D$5'); # $E$5
+
+
+=cut
+###############################################################################
+#
+# xl_inc_col($string)
+#
+# Increments the column number of an Excel cell reference in A1 notation.
+# For example C3 to D3
+#
+# Returns: a cell reference string.
+#
+sub xl_inc_col {
+
+ my $cell = shift;
+ my ($row, $col, $row_abs, $col_abs) = xl_cell_to_rowcol($cell);
+
+ return xl_rowcol_to_cell($row, ++$col, $row_abs, $col_abs);
+}
+
+
+
+
+###############################################################################
+###############################################################################
+
+=head2 xl_dec_col($string)
+
+ Parameters: $string, a string in A1 format
+
+ Returns: Decremented string in A1 format
+
+This functions takes a cell reference string in A1 notation and decrements the column. The function will also handle Excel's absolute, C<$>, cell notation:
+
+ my $str = xl_dec_col('B1' ); # A1
+ my $str = xl_dec_col('AA1' ); # Z1
+ my $str = xl_dec_col('$C1' ); # $B1
+ my $str = xl_dec_col('$E$5'); # $D$5
+
+
+=cut
+###############################################################################
+#
+# xl_dec_col($string)
+#
+sub xl_dec_col {
+
+ my $cell = shift;
+ my ($row, $col, $row_abs, $col_abs) = xl_cell_to_rowcol($cell);
+
+ return xl_rowcol_to_cell($row, --$col, $row_abs, $col_abs);
+}
+
+
+
+
+=head1 TIME AND DATE FUNCTIONS
+
+
+Dates and times in Excel are represented by real numbers, for example "Jan 1 2001 12:30 AM" 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 in seconds.
+
+The epoch can be either 1900 or 1904. Excel for Windows uses 1900 and Excel for Macintosh uses 1904. The epochs are:
+
+ 1900: 0 January 1900 i.e. 31 December 1899
+ 1904: 1 January 1904
+
+Excel on Windows and the Macintosh will convert automatically between one system and the other. By default Spreadsheet::WriteExcel uses the 1900 format. To use the 1904 epoch you must use the C<set_1904()> workbook method, see the Spreadsheet::WriteExcel documentation.
+
+There are two things to note about the 1900 date format. The first is that the epoch starts on 0 January 1900. The second is that the year 1900 is erroneously but deliberately treated as a leap year. Therefore you must add an extra day to dates after 28 February 1900. The functions in the following section will deal with these issues automatically. The reason for this anomaly is explained at http://support.microsoft.com/support/kb/articles/Q181/3/70.asp
+
+Note, a date or time in Excel is like any other number. To display the number as a date you must apply a number format to it: Refer to the C<set_num_format()> method in the Spreadsheet::WriteExcel documentation:
+
+ $date = xl_date_list(2001, 1, 1, 12, 30);
+ $format->set_num_format('mmm d yyyy hh:mm AM/PM');
+ $worksheet->write('A1', $date , $format); # Jan 1 2001 12:30 AM
+
+To use these functions you must install the C<Date::Manip> and C<Date::Calc> modules. See L<REQUIREMENTS> and the individual requirements of each functions.
+
+See also the DateTime::Format::Excel module,http://search.cpan.org/search?dist=DateTime-Format-Excel which is part of the DateTime project and which deals specifically with converting dates and times to and from Excel's format.
+
+
+=cut
+
+
+###############################################################################
+###############################################################################
+
+=head2 xl_date_list($years, $months, $days, $hours, $minutes, $seconds)
+
+
+ Parameters: $years: Integer
+ $months: Integer [optional, default is 1]
+ $days: Integer [optional, default is 1]
+ $hours: Integer [optional, default is 0]
+ $minutes: Integer [optional, default is 0]
+ $seconds: Float [optional, default is 0]
+
+ Returns: A number that represents an Excel date
+ or undef for an invalid date.
+
+ Requires: Date::Calc
+
+This function converts an array of data into a number that represents an Excel date. All of the parameters are optional except for C<$years>.
+
+ $date1 = xl_date_list(2002, 1, 2); # 2 Jan 2002
+ $date2 = xl_date_list(2002, 1, 2, 12); # 2 Jan 2002 12:00 pm
+ $date3 = xl_date_list(2002, 1, 2, 12, 30); # 2 Jan 2002 12:30 pm
+ $date4 = xl_date_list(2002, 1, 2, 12, 30, 45); # 2 Jan 2002 12:30:45 pm
+
+This function can be used in conjunction with functions that parse date and time strings. In fact it is used in most of the following functions.
+
+
+=cut
+###############################################################################
+#
+# xl_date_list($years, $months, $days, $hours, $minutes, $seconds)
+#
+sub xl_date_list {
+
+ return undef unless @_;
+
+ my $years = $_[0];
+ my $months = $_[1] || 1;
+ my $days = $_[2] || 1;
+ my $hours = $_[3] || 0;
+ my $minutes = $_[4] || 0;
+ my $seconds = $_[5] || 0;
+
+ my @date = ($years, $months, $days, $hours, $minutes, $seconds);
+ my @epoch = (1899, 12, 31, 0, 0, 0);
+
+ ($days, $hours, $minutes, $seconds) = Delta_DHMS(@epoch, @date);
+
+ my $date = $days + ($hours*3600 +$minutes*60 +$seconds)/(24*60*60);
+
+ # Add a day for Excel's missing leap day in 1900
+ $date++ if ($date > 59);
+
+ return $date;
+}
+
+
+###############################################################################
+###############################################################################
+
+=head2 xl_parse_time($string)
+
+
+ Parameters: $string, a textual representation of a time
+
+ Returns: A number that represents an Excel time
+ or undef for an invalid time.
+
+This function converts a time string into a number that represents an Excel time. The following time formats are valid:
+
+ hh:mm [AM|PM]
+ hh:mm [AM|PM]
+ hh:mm:ss [AM|PM]
+ hh:mm:ss.ss [AM|PM]
+
+
+The meridian, AM or PM, is optional and case insensitive. A 24 hour time is assumed if the meridian is omitted
+
+ $time1 = xl_parse_time('12:18');
+ $time2 = xl_parse_time('12:18:14');
+ $time3 = xl_parse_time('12:18:14 AM');
+ $time4 = xl_parse_time('1:18:14 AM');
+
+Time in Excel is expressed as a fraction of the day in seconds. Therefore you can calculate an Excel time as follows:
+
+ $time = ($hours*3600 +$minutes*60 +$seconds)/(24*60*60);
+
+
+=cut
+###############################################################################
+#
+# xl_parse_time($string)
+#
+sub xl_parse_time {
+
+ my $time = shift;
+
+ if ($time =~ /(\d{1,2}):(\d\d):?((?:\d\d)(?:\.\d+)?)?(?:\s+)?(am|pm)?/i) {
+
+ my $hours = $1;
+ my $minutes = $2;
+ my $seconds = $3 || 0;
+ my $meridian = lc($4) || '';
+
+ # Normalise midnight and midday
+ $hours = 0 if ($hours == 12 && $meridian ne '');
+
+ # Add 12 hours to the pm times. Note: 12.00 pm has been set to 0.00.
+ $hours += 12 if $meridian eq 'pm';
+
+ # Calculate the time as a fraction of 24 hours in seconds
+ return ($hours*3600 +$minutes*60 +$seconds)/(24*60*60);
+
+ }
+ else {
+ return undef; # Not a valid time string
+ }
+}
+
+
+###############################################################################
+###############################################################################
+
+=head2 xl_parse_date($string)
+
+
+ Parameters: $string, a textual representation of a date and time
+
+ Returns: A number that represents an Excel date
+ or undef for an invalid date.
+
+ Requires: Date::Manip and Date::Calc
+
+This function converts a date and time string into a number that represents an Excel date.
+
+The parsing is performed using the C<ParseDate()> function of the Date::Manip module. Refer to the Date::Manip documentation for further information about the date and time formats that can be parsed. In order to use this function you will probably have to initialise some Date::Manip variables via the C<xl_parse_date_init()> function, see below.
+
+ xl_parse_date_init("TZ=GMT","DateFormat=non-US");
+
+ $date1 = xl_parse_date("11/7/97");
+ $date2 = xl_parse_date("Friday 11 July 1997");
+ $date3 = xl_parse_date("10:30 AM Friday 11 July 1997");
+ $date4 = xl_parse_date("Today");
+ $date5 = xl_parse_date("Yesterday");
+
+Note, if you parse a string that represents a time but not a date this function will add the current date. If you want the time without the date you can do something like the following:
+
+ $time = xl_parse_date("10:30 AM");
+ $time -= int($time);
+
+
+=cut
+###############################################################################
+#
+# xl_parse_date($string)
+#
+sub xl_parse_date {
+
+ my $date = ParseDate($_[0]);
+
+ return undef unless defined $date;
+
+ # Unpack the return value from ParseDate()
+ my ($years, $months, $days, $hours, undef, $minutes, undef, $seconds) =
+ unpack("A4 A2 A2 A2 C A2 C A2", $date);
+
+ # Convert to Excel date
+ return xl_date_list($years, $months, $days, $hours, $minutes, $seconds);
+}
+
+
+
+
+###############################################################################
+###############################################################################
+
+=head2 xl_parse_date_init("variable=value", ...)
+
+
+ Parameters: A list of Date::Manip variable strings
+
+ Returns: A list of all the Date::Manip strings
+
+ Requires: Date::Manip
+
+This function is used to initialise variables required by the Date::Manip module. You should call this function before calling C<xl_parse_date()>. It need only be called once.
+
+This function is a thin wrapper for the C<Date::Manip::Date_Init()> function. You can use C<Date_Init()> directly if you wish. Refer to the Date::Manip documentation for further information.
+
+ xl_parse_date_init("TZ=MST","DateFormat=US");
+ $date1 = xl_parse_date("11/7/97"); # November 7th 1997
+
+ xl_parse_date_init("TZ=GMT","DateFormat=non-US");
+ $date1 = xl_parse_date("11/7/97"); # July 11th 1997
+
+
+=cut
+###############################################################################
+#
+# xl_parse_date_init("variable=value", ...)
+#
+sub xl_parse_date_init {
+
+ Date_Init(@_); # How lazy is that.
+}
+
+
+
+
+###############################################################################
+###############################################################################
+
+=head2 xl_decode_date_EU($string)
+
+
+ Parameters: $string, a textual representation of a date and time
+
+ Returns: A number that represents an Excel date
+ or undef for an invalid date.
+
+ Requires: Date::Calc
+
+This function converts a date and time string into a number that represents an Excel date.
+
+The date parsing is performed using the C<Decode_Date_EU()> function of the Date::Calc module. Refer to the Date::Calc for further information about the date formats that can be parsed. Also note the following from the Date::Calc documentation:
+
+"If the year is given as one or two digits only (i.e., if the year is less than 100), it is mapped to the window 1970 -2069 as follows":
+
+ 0 E<lt>= $year E<lt> 70 ==> $year += 2000;
+ 70 E<lt>= $year E<lt> 100 ==> $year += 1900;
+
+The time portion of the string is parsed using the C<xl_parse_time()> function described above.
+
+Note: the EU in the function name means that a European date format is assumed if it is not clear from the string. See the first example below.
+
+ $date1 = xl_decode_date_EU("11/7/97"); #11 July 1997
+ $date2 = xl_decode_date_EU("Sat 12 Sept 1998");
+ $date3 = xl_decode_date_EU("4:30 AM Sat 12 Sept 1998");
+
+
+=cut
+###############################################################################
+#
+# xl_decode_date_EU($string)
+#
+sub xl_decode_date_EU {
+
+ return undef unless @_;
+
+ my $date = shift;
+ my @date;
+ my $time = 0;
+
+ # Remove and decode the time portion of the string
+ if ($date =~ s/(\d{1,2}:\d\d:?(\d\d(\.\d+)?)?(\s+)?(am|pm)?)//i) {
+ $time = xl_parse_time($1);
+ return undef unless defined $time;
+ }
+
+ # Return if the string is now blank, i.e. it contained a time only.
+ return $time if $date =~ /^\s*$/;
+
+ # Decode the date portion of the string
+ @date = Decode_Date_EU($date);
+ return undef unless @date;
+
+ return xl_date_list(@date) + $time;
+}
+
+
+
+###############################################################################
+###############################################################################
+
+=head2 xl_decode_date_US($string)
+
+
+ Parameters: $string, a textual representation of a date and time
+
+ Returns: A number that represents an Excel date
+ or undef for an invalid date.
+
+ Requires: Date::Calc
+
+This function converts a date and time string into a number that represents an Excel date.
+
+The date parsing is performed using the C<Decode_Date_US()> function of the Date::Calc module. Refer to the Date::Calc for further information about the date formats that can be parsed. Also note the following from the Date::Calc documentation:
+
+"If the year is given as one or two digits only (i.e., if the year is less than 100), it is mapped to the window 1970 -2069 as follows":
+
+ 0 <= $year < 70 ==> $year += 2000;
+ 70 <= $year < 100 ==> $year += 1900;
+
+The time portion of the string is parsed using the C<xl_parse_time()> function described above.
+
+Note: the US in the function name means that an American date format is assumed if it is not clear from the string. See the first example below.
+
+ $date1 = xl_decode_date_US("11/7/97"); # 7 November 1997
+ $date2 = xl_decode_date_US("12 Sept Saturday 1998");
+ $date3 = xl_decode_date_US("4:30 AM 12 Sept Sat 1998");
+
+
+=cut
+###############################################################################
+#
+# xl_decode_date_US($string)
+#
+sub xl_decode_date_US {
+
+ return undef unless @_;
+
+ my $date = shift;
+ my @date;
+ my $time = 0;
+
+ # Remove and decode the time portion of the string
+ if ($date =~ s/(\d{1,2}:\d\d:?(\d\d(\.\d+)?)?(\s+)?(am|pm)?)//i) {
+ $time = xl_parse_time($1);
+ return undef unless defined $time;
+ }
+
+ # Return if the string is now blank, i.e. it contained a time only.
+ return $time if $date =~ /^\s*$/;
+
+ # Decode the date portion of the string
+ @date = Decode_Date_US($date);
+ return undef unless @date;
+
+ return xl_date_list(@date) + $time;
+}
+
+
+
+
+###############################################################################
+###############################################################################
+
+=head2 xl_date_1904($date)
+
+
+ Parameters: $date, an Excel date with a 1900 epoch
+
+ Returns: an Excel date with a 1904 epoch or zero if
+ the $date is before 1904
+
+
+This function converts an Excel date based on the 1900 epoch into a date based on the 1904 epoch.
+
+
+ $date1 = xl_date_list(2002, 1, 13); # 13 Jan 2002, 1900 epoch
+ $date2 = xl_date_1904($date1); # 13 Jan 2002, 1904 epoch
+
+
+See also the C<set_1904()> workbook method in the Spreadsheet::WriteExcel documentation.
+
+=cut
+###############################################################################
+#
+# xl_decode_date_US($string)
+#
+sub xl_date_1904 {
+
+ my $date = $_[0] || 0;
+
+ if ($date < 1462) {
+ # before 1904
+ $date = 0;
+ }
+ else {
+ $date -= 1462;
+ }
+
+ return $date;
+}
+
+
+
+
+
+=head1 REQUIREMENTS
+
+The date and time functions require functions from the C<Date::Manip> and C<Date::Calc> modules. The required functions are "autoused" from these modules so that you do not have to install them unless you wish to use the date and time routines. Therefore it is possible to use the row and column functions without having C<Date::Manip> and C<Date::Calc> installed.
+
+For more information about "autousing" refer to the documentation on the C<autouse> pragma.
+
+
+
+=head1 BUGS
+
+When using the autoused functions from C<Date::Manip> and C<Date::Calc> on Perl 5.6.0 with C<-w> you will get a warning like this:
+
+ "Subroutine xxx redefined ..."
+
+The current workaround for this is to put C<use warnings;> near the beginning of your program.
+
+
+
+=head1 AUTHOR
+
+John McNamara jmcnamara@cpan.org
+
+
+
+
+=head1 COPYRIGHT
+
+© MM-MMX, John McNamara.
+
+All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself.
+
+=cut
+
+
+
+1;
+
+
+__END__
+
diff --git a/mcu/tools/perl/Spreadsheet/WriteExcel/Workbook.pm b/mcu/tools/perl/Spreadsheet/WriteExcel/Workbook.pm
new file mode 100644
index 0000000..0276bb2
--- /dev/null
+++ b/mcu/tools/perl/Spreadsheet/WriteExcel/Workbook.pm
@@ -0,0 +1,3638 @@
+package Spreadsheet::WriteExcel::Workbook;
+
+###############################################################################
+#
+# Workbook - A writer class for Excel Workbooks.
+#
+#
+# Used in conjunction with Spreadsheet::WriteExcel
+#
+# Copyright 2000-2010, John McNamara, jmcnamara@cpan.org
+#
+# Documentation after __END__
+#
+use Exporter;
+use strict;
+use Carp;
+use Spreadsheet::WriteExcel::BIFFwriter;
+use Spreadsheet::WriteExcel::OLEwriter;
+use Spreadsheet::WriteExcel::Worksheet;
+use Spreadsheet::WriteExcel::Format;
+use Spreadsheet::WriteExcel::Chart;
+use Spreadsheet::WriteExcel::Properties ':property_sets';
+
+use vars qw($VERSION @ISA);
+@ISA = qw(Spreadsheet::WriteExcel::BIFFwriter Exporter);
+
+$VERSION = '2.37';
+
+###############################################################################
+#
+# new()
+#
+# Constructor. Creates a new Workbook object from a BIFFwriter object.
+#
+sub new {
+
+ my $class = shift;
+ my $self = Spreadsheet::WriteExcel::BIFFwriter->new();
+ my $byte_order = $self->{_byte_order};
+ my $parser = Spreadsheet::WriteExcel::Formula->new($byte_order);
+
+ $self->{_filename} = $_[0] || '';
+ $self->{_parser} = $parser;
+ $self->{_tempdir} = undef;
+ $self->{_1904} = 0;
+ $self->{_activesheet} = 0;
+ $self->{_firstsheet} = 0;
+ $self->{_selected} = 0;
+ $self->{_xf_index} = 0;
+ $self->{_fileclosed} = 0;
+ $self->{_biffsize} = 0;
+ $self->{_sheet_name} = 'Sheet';
+ $self->{_chart_name} = 'Chart';
+ $self->{_sheet_count} = 0;
+ $self->{_chart_count} = 0;
+ $self->{_url_format} = '';
+ $self->{_codepage} = 0x04E4;
+ $self->{_country} = 1;
+ $self->{_worksheets} = [];
+ $self->{_sheetnames} = [];
+ $self->{_formats} = [];
+ $self->{_palette} = [];
+
+ $self->{_using_tmpfile} = 1;
+ $self->{_filehandle} = "";
+ $self->{_temp_file} = "";
+ $self->{_internal_fh} = 0;
+ $self->{_fh_out} = "";
+
+ $self->{_str_total} = 0;
+ $self->{_str_unique} = 0;
+ $self->{_str_table} = {};
+ $self->{_str_array} = [];
+ $self->{_str_block_sizes} = [];
+ $self->{_extsst_offsets} = [];
+ $self->{_extsst_buckets} = 0;
+ $self->{_extsst_bucket_size} = 0;
+
+ $self->{_ext_ref_count} = 0;
+ $self->{_ext_refs} = {};
+
+ $self->{_mso_clusters} = [];
+ $self->{_mso_size} = 0;
+
+ $self->{_hideobj} = 0;
+ $self->{_compatibility} = 0;
+
+ $self->{_add_doc_properties} = 0;
+ $self->{_localtime} = [localtime()];
+
+ $self->{_defined_names} = [];
+
+ bless $self, $class;
+
+
+ # Add the in-built style formats and the default cell format.
+ $self->add_format(type => 1); # 0 Normal
+ $self->add_format(type => 1); # 1 RowLevel 1
+ $self->add_format(type => 1); # 2 RowLevel 2
+ $self->add_format(type => 1); # 3 RowLevel 3
+ $self->add_format(type => 1); # 4 RowLevel 4
+ $self->add_format(type => 1); # 5 RowLevel 5
+ $self->add_format(type => 1); # 6 RowLevel 6
+ $self->add_format(type => 1); # 7 RowLevel 7
+ $self->add_format(type => 1); # 8 ColLevel 1
+ $self->add_format(type => 1); # 9 ColLevel 2
+ $self->add_format(type => 1); # 10 ColLevel 3
+ $self->add_format(type => 1); # 11 ColLevel 4
+ $self->add_format(type => 1); # 12 ColLevel 5
+ $self->add_format(type => 1); # 13 ColLevel 6
+ $self->add_format(type => 1); # 14 ColLevel 7
+ $self->add_format(); # 15 Cell XF
+ $self->add_format(type => 1, num_format => 0x2B); # 16 Comma
+ $self->add_format(type => 1, num_format => 0x29); # 17 Comma[0]
+ $self->add_format(type => 1, num_format => 0x2C); # 18 Currency
+ $self->add_format(type => 1, num_format => 0x2A); # 19 Currency[0]
+ $self->add_format(type => 1, num_format => 0x09); # 20 Percent
+
+
+ # Add the default format for hyperlinks
+ $self->{_url_format} = $self->add_format(color => 'blue', underline => 1);
+
+
+ # Check for a filename unless it is an existing filehandle
+ if (not ref $self->{_filename} and $self->{_filename} eq '') {
+ carp 'Filename required by Spreadsheet::WriteExcel->new()';
+ return undef;
+ }
+
+
+ # Convert the filename to a filehandle to pass to the OLE writer when the
+ # file is closed. If the filename is a reference it is assumed that it is
+ # a valid filehandle.
+ #
+ if (not ref $self->{_filename}) {
+
+ my $fh = FileHandle->new('>'. $self->{_filename});
+
+ if (not defined $fh) {
+ carp "Can't open " .
+ $self->{_filename} .
+ ". It may be in use or protected";
+ return undef;
+ }
+
+ # binmode file whether platform requires it or not
+ binmode($fh);
+ $self->{_internal_fh} = 1;
+ $self->{_fh_out} = $fh;
+ }
+ else {
+ $self->{_internal_fh} = 0;
+ $self->{_fh_out} = $self->{_filename};
+
+ }
+
+
+ # Set colour palette.
+ $self->set_palette_xl97();
+
+ # Load Encode if we can.
+ require Encode if $] >= 5.008;
+
+ $self->_initialize();
+ $self->_get_checksum_method();
+ return $self;
+}
+
+
+###############################################################################
+#
+# _initialize()
+#
+# Open a tmp file to store the majority of the Worksheet data. If this fails,
+# for example due to write permissions, store the data in memory. This can be
+# slow for large files.
+#
+# TODO: Move this and other methods shared with Worksheet up into BIFFwriter.
+#
+sub _initialize {
+
+ my $self = shift;
+ my $fh;
+ my $tmp_dir;
+
+ # The following code is complicated by Windows limitations. Porters can
+ # choose a more direct method.
+
+
+
+ # In the default case we use IO::File->new_tmpfile(). This may fail, in
+ # particular with IIS on Windows, so we allow the user to specify a temp
+ # directory via File::Temp.
+ #
+ if (defined $self->{_tempdir}) {
+
+ # Delay loading File:Temp to reduce the module dependencies.
+ eval { require File::Temp };
+ die "The File::Temp module must be installed in order ".
+ "to call set_tempdir().\n" if $@;
+
+
+ # Trap but ignore File::Temp errors.
+ eval { $fh = File::Temp::tempfile(DIR => $self->{_tempdir}) };
+
+ # Store the failed tmp dir in case of errors.
+ $tmp_dir = $self->{_tempdir} || File::Spec->tmpdir if not $fh;
+ }
+ else {
+
+ $fh = IO::File->new_tmpfile();
+
+ # Store the failed tmp dir in case of errors.
+ $tmp_dir = "POSIX::tmpnam() directory" if not $fh;
+ }
+
+
+ # Check if the temp file creation was successful. Else store data in memory.
+ if ($fh) {
+
+ # binmode file whether platform requires it or not.
+ binmode($fh);
+
+ # Store filehandle
+ $self->{_filehandle} = $fh;
+ }
+ else {
+
+ # Set flag to store data in memory if XX::tempfile() failed.
+ $self->{_using_tmpfile} = 0;
+
+ if ($^W) {
+ my $dir = $self->{_tempdir} || File::Spec->tmpdir();
+
+ warn "Unable to create temp files in $tmp_dir. Data will be ".
+ "stored in memory. Refer to set_tempdir() in the ".
+ "Spreadsheet::WriteExcel documentation.\n" ;
+ }
+ }
+}
+
+
+###############################################################################
+#
+# _get_checksum_method.
+#
+# Check for modules available to calculate image checksum. Excel uses MD4 but
+# MD5 will also work.
+#
+sub _get_checksum_method {
+
+ my $self = shift;
+
+ eval { require Digest::MD4};
+ if (not $@) {
+ $self->{_checksum_method} = 1;
+ return;
+ }
+
+
+ eval { require Digest::Perl::MD4};
+ if (not $@) {
+ $self->{_checksum_method} = 2;
+ return;
+ }
+
+
+ eval { require Digest::MD5};
+ if (not $@) {
+ $self->{_checksum_method} = 3;
+ return;
+ }
+
+ # Default.
+ $self->{_checksum_method} = 0;
+}
+
+
+###############################################################################
+#
+# _append(), overridden.
+#
+# Store Worksheet data in memory using the base class _append() or to a
+# temporary file, the default.
+#
+sub _append {
+
+ my $self = shift;
+ my $data = '';
+
+ if ($self->{_using_tmpfile}) {
+ $data = join('', @_);
+
+ # Add CONTINUE records if necessary
+ $data = $self->_add_continue($data) if length($data) > $self->{_limit};
+
+ # Protect print() from -l on the command line.
+ local $\ = undef;
+
+ print {$self->{_filehandle}} $data;
+ $self->{_datasize} += length($data);
+ }
+ else {
+ $data = $self->SUPER::_append(@_);
+ }
+
+ return $data;
+}
+
+
+###############################################################################
+#
+# get_data().
+#
+# Retrieves data from memory in one chunk, or from disk in $buffer
+# sized chunks.
+#
+sub get_data {
+
+ my $self = shift;
+ my $buffer = 4096;
+ my $tmp;
+
+ # Return data stored in memory
+ if (defined $self->{_data}) {
+ $tmp = $self->{_data};
+ $self->{_data} = undef;
+ my $fh = $self->{_filehandle};
+ seek($fh, 0, 0) if $self->{_using_tmpfile};
+ return $tmp;
+ }
+
+ # Return data stored on disk
+ if ($self->{_using_tmpfile}) {
+ return $tmp if read($self->{_filehandle}, $tmp, $buffer);
+ }
+
+ # No data to return
+ return undef;
+}
+
+
+###############################################################################
+#
+# close()
+#
+# Calls finalization methods and explicitly close the OLEwriter file
+# handle.
+#
+sub close {
+
+ my $self = shift;
+
+ return if $self->{_fileclosed}; # Prevent close() from being called twice.
+
+ $self->{_fileclosed} = 1;
+
+ return $self->_store_workbook();
+}
+
+
+###############################################################################
+#
+# DESTROY()
+#
+# Close the workbook if it hasn't already been explicitly closed.
+#
+sub DESTROY {
+
+ my $self = shift;
+
+ local ($@, $!, $^E, $?);
+
+ $self->close() if not $self->{_fileclosed};
+}
+
+
+###############################################################################
+#
+# sheets(slice,...)
+#
+# An accessor for the _worksheets[] array
+#
+# Returns: an optionally sliced list of the worksheet objects in a workbook.
+#
+sub sheets {
+
+ my $self = shift;
+
+ if (@_) {
+ # Return a slice of the array
+ return @{$self->{_worksheets}}[@_];
+ }
+ else {
+ # Return the entire list
+ return @{$self->{_worksheets}};
+ }
+}
+
+
+###############################################################################
+#
+# worksheets()
+#
+# An accessor for the _worksheets[] array.
+# This method is now deprecated. Use the sheets() method instead.
+#
+# Returns: an array reference
+#
+sub worksheets {
+
+ my $self = shift;
+
+ return $self->{_worksheets};
+}
+
+
+###############################################################################
+#
+# add_worksheet($name, $encoding)
+#
+# Add a new worksheet to the Excel workbook.
+#
+# Returns: reference to a worksheet object
+#
+sub add_worksheet {
+
+ my $self = shift;
+ my $index = @{$self->{_worksheets}};
+
+ my ($name, $encoding) = $self->_check_sheetname($_[0], $_[1]);
+
+
+ # Porters take note, the following scheme of passing references to Workbook
+ # data (in the \$self->{_foo} cases) instead of a reference to the Workbook
+ # itself is a workaround to avoid circular references between Workbook and
+ # Worksheet objects. Feel free to implement this in any way the suits your
+ # language.
+ #
+ my @init_data = (
+ $name,
+ $index,
+ $encoding,
+ \$self->{_activesheet},
+ \$self->{_firstsheet},
+ $self->{_url_format},
+ $self->{_parser},
+ $self->{_tempdir},
+ \$self->{_str_total},
+ \$self->{_str_unique},
+ \$self->{_str_table},
+ $self->{_1904},
+ $self->{_compatibility},
+ undef, # Palette. Not used yet. See add_chart().
+ );
+
+ my $worksheet = Spreadsheet::WriteExcel::Worksheet->new(@init_data);
+ $self->{_worksheets}->[$index] = $worksheet; # Store ref for iterator
+ $self->{_sheetnames}->[$index] = $name; # Store EXTERNSHEET names
+ $self->{_parser}->set_ext_sheets($name, $index); # Store names in Formula.pm
+ return $worksheet;
+}
+
+# Older method name for backwards compatibility.
+*addworksheet = *add_worksheet;
+
+
+###############################################################################
+#
+# add_chart(%args)
+#
+# Create a chart for embedding or as as new sheet.
+#
+#
+sub add_chart {
+
+ my $self = shift;
+ my %arg = @_;
+ my $name = '';
+ my $encoding = 0;
+ my $index = @{ $self->{_worksheets} };
+
+ # Type must be specified so we can create the required chart instance.
+ my $type = $arg{type};
+ if ( !defined $type ) {
+ croak "Must define chart type in add_chart()";
+ }
+
+ # Ensure that the chart defaults to non embedded.
+ my $embedded = $arg{embedded} ||= 0;
+
+ # Check the worksheet name for non-embedded charts.
+ if ( !$embedded ) {
+ ( $name, $encoding ) =
+ $self->_check_sheetname( $arg{name}, $arg{name_encoding}, 1 );
+ }
+
+ my @init_data = (
+ $name,
+ $index,
+ $encoding,
+ \$self->{_activesheet},
+ \$self->{_firstsheet},
+ $self->{_url_format},
+ $self->{_parser},
+ $self->{_tempdir},
+ \$self->{_str_total},
+ \$self->{_str_unique},
+ \$self->{_str_table},
+ $self->{_1904},
+ $self->{_compatibility},
+ $self->{_palette},
+ );
+
+ my $chart = Spreadsheet::WriteExcel::Chart->factory( $type, @init_data );
+
+ # If the chart isn't embedded let the workbook control it.
+ if ( !$embedded ) {
+ $self->{_worksheets}->[$index] = $chart; # Store ref for iterator
+ $self->{_sheetnames}->[$index] = $name; # Store EXTERNSHEET names
+ }
+ else {
+ # Set index to 0 so that the activate() and set_first_sheet() methods
+ # point back to the first worksheet if used for embedded charts.
+ $chart->{_index} = 0;
+
+ $chart->_set_embedded_config_data();
+ }
+
+ return $chart;
+}
+
+
+###############################################################################
+#
+# add_chart_ext($filename, $name)
+#
+# Add an externally created chart.
+#
+#
+sub add_chart_ext {
+
+ my $self = shift;
+ my $filename = $_[0];
+ my $index = @{$self->{_worksheets}};
+ my $type = 'external';
+
+ my ($name, $encoding) = $self->_check_sheetname($_[1], $_[2]);
+
+
+ my @init_data = (
+ $filename,
+ $name,
+ $index,
+ $encoding,
+ \$self->{_activesheet},
+ \$self->{_firstsheet},
+ );
+
+ my $chart = Spreadsheet::WriteExcel::Chart->factory($type, @init_data);
+ $self->{_worksheets}->[$index] = $chart; # Store ref for iterator
+ $self->{_sheetnames}->[$index] = $name; # Store EXTERNSHEET names
+
+ return $chart;
+}
+
+
+###############################################################################
+#
+# _check_sheetname($name, $encoding)
+#
+# Check for valid worksheet names. We check the length, if it contains any
+# invalid characters and if the name is unique in the workbook.
+#
+sub _check_sheetname {
+
+ my $self = shift;
+ my $name = $_[0] || "";
+ my $encoding = $_[1] || 0;
+ my $chart = $_[2] || 0;
+ my $limit = $encoding ? 62 : 31;
+ my $invalid_char = qr([\[\]:*?/\\]);
+
+ # Increment the Sheet/Chart number used for default sheet names below.
+ if ( $chart ) {
+ $self->{_chart_count}++;
+ }
+ else {
+ $self->{_sheet_count}++;
+ }
+
+ # Supply default Sheet/Chart name if none has been defined.
+ if ( $name eq "" ) {
+ $encoding = 0;
+
+ if ( $chart ) {
+ $name = $self->{_chart_name} . $self->{_chart_count};
+ }
+ else {
+ $name = $self->{_sheet_name} . $self->{_sheet_count};
+ }
+ }
+
+
+ # Check that sheetname is <= 31 (1 or 2 byte chars). Excel limit.
+ croak "Sheetname $name must be <= 31 chars" if length $name > $limit;
+
+ # Check that Unicode sheetname has an even number of bytes
+ croak 'Odd number of bytes in Unicode worksheet name:' . $name
+ if $encoding == 1 and length($name) % 2;
+
+
+ # Check that sheetname doesn't contain any invalid characters
+ if ($encoding != 1 and $name =~ $invalid_char) {
+ # Check ASCII names
+ croak 'Invalid character []:*?/\\ in worksheet name: ' . $name;
+ }
+ else {
+ # Extract any 8bit clean chars from the UTF16 name and validate them.
+ for my $wchar ($name =~ /../sg) {
+ my ($hi, $lo) = unpack "aa", $wchar;
+ if ($hi eq "\0" and $lo =~ $invalid_char) {
+ croak 'Invalid character []:*?/\\ in worksheet name: ' . $name;
+ }
+ }
+ }
+
+
+ # Handle utf8 strings in perl 5.8.
+ if ($] >= 5.008) {
+ require Encode;
+
+ if (Encode::is_utf8($name)) {
+ $name = Encode::encode("UTF-16BE", $name);
+ $encoding = 1;
+ }
+ }
+
+
+ # Check that the worksheet name doesn't already exist since this is a fatal
+ # error in Excel 97. The check must also exclude case insensitive matches
+ # since the names 'Sheet1' and 'sheet1' are equivalent. The tests also have
+ # to take the encoding into account.
+ #
+ foreach my $worksheet (@{$self->{_worksheets}}) {
+ my $name_a = $name;
+ my $encd_a = $encoding;
+ my $name_b = $worksheet->{_name};
+ my $encd_b = $worksheet->{_encoding};
+ my $error = 0;
+
+ if ($encd_a == 0 and $encd_b == 0) {
+ $error = 1 if lc($name_a) eq lc($name_b);
+ }
+ elsif ($encd_a == 0 and $encd_b == 1) {
+ $name_a = pack "n*", unpack "C*", $name_a;
+ $error = 1 if lc($name_a) eq lc($name_b);
+ }
+ elsif ($encd_a == 1 and $encd_b == 0) {
+ $name_b = pack "n*", unpack "C*", $name_b;
+ $error = 1 if lc($name_a) eq lc($name_b);
+ }
+ elsif ($encd_a == 1 and $encd_b == 1) {
+ # We can do a true case insensitive test with Perl 5.8 and utf8.
+ if ($] >= 5.008) {
+ $name_a = Encode::decode("UTF-16BE", $name_a);
+ $name_b = Encode::decode("UTF-16BE", $name_b);
+ $error = 1 if lc($name_a) eq lc($name_b);
+ }
+ else {
+ # We can't easily do a case insensitive test of the UTF16 names.
+ # As a special case we check if all of the high bytes are nulls and
+ # then do an ASCII style case insensitive test.
+
+ # Strip out the high bytes (funkily).
+ my $hi_a = grep {ord} $name_a =~ /(.)./sg;
+ my $hi_b = grep {ord} $name_b =~ /(.)./sg;
+
+ if ($hi_a or $hi_b) {
+ $error = 1 if $name_a eq $name_b;
+ }
+ else {
+ $error = 1 if lc($name_a) eq lc($name_b);
+ }
+ }
+ }
+
+ # If any of the cases failed we throw the error here.
+ if ($error) {
+ croak "Worksheet name '$name', with case ignored, " .
+ "is already in use";
+ }
+ }
+
+ return ($name, $encoding);
+}
+
+
+###############################################################################
+#
+# add_format(%properties)
+#
+# Add a new format to the Excel workbook. This adds an XF record and
+# a FONT record. Also, pass any properties to the Format::new().
+#
+sub add_format {
+
+ my $self = shift;
+
+ my $format = Spreadsheet::WriteExcel::Format->new($self->{_xf_index}, @_);
+
+ $self->{_xf_index} += 1;
+ push @{$self->{_formats}}, $format; # Store format reference
+
+ return $format;
+}
+
+# Older method name for backwards compatibility.
+*addformat = *add_format;
+
+
+###############################################################################
+#
+# compatibility_mode()
+#
+# Set the compatibility mode.
+#
+# Excel doesn't require every possible Biff record to be present in a file.
+# In particular if the indexing records INDEX, ROW and DBCELL aren't present
+# it just ignores the fact and reads the cells anyway. This is also true of
+# the EXTSST record. Gnumeric and OOo also take this approach. This allows
+# WriteExcel to ignore these records in order to minimise the amount of data
+# stored in memory. However, other third party applications that read Excel
+# files often expect these records to be present. In "compatibility mode"
+# WriteExcel writes these records and tries to be as close to an Excel
+# generated file as possible.
+#
+# This requires additional data to be stored in memory until the file is
+# about to be written. This incurs a memory and speed penalty and may not be
+# suitable for very large files.
+#
+sub compatibility_mode {
+
+ my $self = shift;
+
+ croak "compatibility_mode() must be called before add_worksheet()"
+ if $self->sheets();
+
+ if (defined($_[0])) {
+ $self->{_compatibility} = $_[0];
+ }
+ else {
+ $self->{_compatibility} = 1;
+ }
+}
+
+
+###############################################################################
+#
+# set_1904()
+#
+# Set the date system: 0 = 1900 (the default), 1 = 1904
+#
+sub set_1904 {
+
+ my $self = shift;
+
+ croak "set_1904() must be called before add_worksheet()"
+ if $self->sheets();
+
+
+ if (defined($_[0])) {
+ $self->{_1904} = $_[0];
+ }
+ else {
+ $self->{_1904} = 1;
+ }
+}
+
+
+###############################################################################
+#
+# get_1904()
+#
+# Return the date system: 0 = 1900, 1 = 1904
+#
+sub get_1904 {
+
+ my $self = shift;
+
+ return $self->{_1904};
+}
+
+
+###############################################################################
+#
+# set_custom_color()
+#
+# Change the RGB components of the elements in the colour palette.
+#
+sub set_custom_color {
+
+ my $self = shift;
+
+
+ # Match a HTML #xxyyzz style parameter
+ if (defined $_[1] and $_[1] =~ /^#(\w\w)(\w\w)(\w\w)/ ) {
+ @_ = ($_[0], hex $1, hex $2, hex $3);
+ }
+
+
+ my $index = $_[0] || 0;
+ my $red = $_[1] || 0;
+ my $green = $_[2] || 0;
+ my $blue = $_[3] || 0;
+
+ my $aref = $self->{_palette};
+
+ # Check that the colour index is the right range
+ if ($index < 8 or $index > 64) {
+ carp "Color index $index outside range: 8 <= index <= 64";
+ return 0;
+ }
+
+ # Check that the colour components are in the right range
+ if ( ($red < 0 or $red > 255) ||
+ ($green < 0 or $green > 255) ||
+ ($blue < 0 or $blue > 255) )
+ {
+ carp "Color component outside range: 0 <= color <= 255";
+ return 0;
+ }
+
+ $index -=8; # Adjust colour index (wingless dragonfly)
+
+ # Set the RGB value
+ $aref->[$index] = [$red, $green, $blue, 0];
+
+ return $index +8;
+}
+
+
+###############################################################################
+#
+# set_palette_xl97()
+#
+# Sets the colour palette to the Excel 97+ default.
+#
+sub set_palette_xl97 {
+
+ my $self = shift;
+
+ $self->{_palette} = [
+ [0x00, 0x00, 0x00, 0x00], # 8
+ [0xff, 0xff, 0xff, 0x00], # 9
+ [0xff, 0x00, 0x00, 0x00], # 10
+ [0x00, 0xff, 0x00, 0x00], # 11
+ [0x00, 0x00, 0xff, 0x00], # 12
+ [0xff, 0xff, 0x00, 0x00], # 13
+ [0xff, 0x00, 0xff, 0x00], # 14
+ [0x00, 0xff, 0xff, 0x00], # 15
+ [0x80, 0x00, 0x00, 0x00], # 16
+ [0x00, 0x80, 0x00, 0x00], # 17
+ [0x00, 0x00, 0x80, 0x00], # 18
+ [0x80, 0x80, 0x00, 0x00], # 19
+ [0x80, 0x00, 0x80, 0x00], # 20
+ [0x00, 0x80, 0x80, 0x00], # 21
+ [0xc0, 0xc0, 0xc0, 0x00], # 22
+ [0x80, 0x80, 0x80, 0x00], # 23
+ [0x99, 0x99, 0xff, 0x00], # 24
+ [0x99, 0x33, 0x66, 0x00], # 25
+ [0xff, 0xff, 0xcc, 0x00], # 26
+ [0xcc, 0xff, 0xff, 0x00], # 27
+ [0x66, 0x00, 0x66, 0x00], # 28
+ [0xff, 0x80, 0x80, 0x00], # 29
+ [0x00, 0x66, 0xcc, 0x00], # 30
+ [0xcc, 0xcc, 0xff, 0x00], # 31
+ [0x00, 0x00, 0x80, 0x00], # 32
+ [0xff, 0x00, 0xff, 0x00], # 33
+ [0xff, 0xff, 0x00, 0x00], # 34
+ [0x00, 0xff, 0xff, 0x00], # 35
+ [0x80, 0x00, 0x80, 0x00], # 36
+ [0x80, 0x00, 0x00, 0x00], # 37
+ [0x00, 0x80, 0x80, 0x00], # 38
+ [0x00, 0x00, 0xff, 0x00], # 39
+ [0x00, 0xcc, 0xff, 0x00], # 40
+ [0xcc, 0xff, 0xff, 0x00], # 41
+ [0xcc, 0xff, 0xcc, 0x00], # 42
+ [0xff, 0xff, 0x99, 0x00], # 43
+ [0x99, 0xcc, 0xff, 0x00], # 44
+ [0xff, 0x99, 0xcc, 0x00], # 45
+ [0xcc, 0x99, 0xff, 0x00], # 46
+ [0xff, 0xcc, 0x99, 0x00], # 47
+ [0x33, 0x66, 0xff, 0x00], # 48
+ [0x33, 0xcc, 0xcc, 0x00], # 49
+ [0x99, 0xcc, 0x00, 0x00], # 50
+ [0xff, 0xcc, 0x00, 0x00], # 51
+ [0xff, 0x99, 0x00, 0x00], # 52
+ [0xff, 0x66, 0x00, 0x00], # 53
+ [0x66, 0x66, 0x99, 0x00], # 54
+ [0x96, 0x96, 0x96, 0x00], # 55
+ [0x00, 0x33, 0x66, 0x00], # 56
+ [0x33, 0x99, 0x66, 0x00], # 57
+ [0x00, 0x33, 0x00, 0x00], # 58
+ [0x33, 0x33, 0x00, 0x00], # 59
+ [0x99, 0x33, 0x00, 0x00], # 60
+ [0x99, 0x33, 0x66, 0x00], # 61
+ [0x33, 0x33, 0x99, 0x00], # 62
+ [0x33, 0x33, 0x33, 0x00], # 63
+ ];
+
+ return 0;
+}
+
+
+###############################################################################
+#
+# set_tempdir()
+#
+# Change the default temp directory used by _initialize() in Worksheet.pm.
+#
+sub set_tempdir {
+
+ my $self = shift;
+
+ # Windows workaround. See Worksheet::_initialize()
+ my $dir = shift || '';
+
+ croak "$dir is not a valid directory" if $dir ne '' and not -d $dir;
+ croak "set_tempdir must be called before add_worksheet" if $self->sheets();
+
+ $self->{_tempdir} = $dir ;
+}
+
+
+###############################################################################
+#
+# set_codepage()
+#
+# See also the _store_codepage method. This is used to store the code page, i.e.
+# the character set used in the workbook.
+#
+sub set_codepage {
+
+ my $self = shift;
+
+ my $codepage = $_[0] || 1;
+ $codepage = 0x04E4 if $codepage == 1;
+ $codepage = 0x8000 if $codepage == 2;
+
+ $self->{_codepage} = $codepage;
+}
+
+
+###############################################################################
+#
+# set_country()
+#
+# See also the _store_country method. This is used to store the country code.
+# Some non-english versions of Excel may need this set to some value other
+# than 1 = "United States". In general the country code is equal to the
+# international dialling code.
+#
+sub set_country {
+
+ my $self = shift;
+
+ $self->{_country} = $_[0] || 1;
+}
+
+
+
+
+
+
+
+###############################################################################
+#
+# define_name()
+#
+# TODO.
+#
+sub define_name {
+
+ my $self = shift;
+ my $name = shift;
+ my $formula = shift;
+ my $encoding = shift || 0;
+ my $sheet_index = 0;
+ my @tokens;
+
+ my $full_name = $name;
+
+ if ($name =~ /^(.*)!(.*)$/) {
+ my $sheetname = $1;
+ $name = $2;
+ $sheet_index = 1 + $self->{_parser}->_get_sheet_index($sheetname);
+ }
+
+
+
+ # Strip the = sign at the beginning of the formula string
+ $formula =~ s(^=)();
+
+ # Parse the formula using the parser in Formula.pm
+ my $parser = $self->{_parser};
+
+ # In order to raise formula errors from the point of view of the calling
+ # program we use an eval block and re-raise the error from here.
+ #
+ eval { @tokens = $parser->parse_formula($formula) };
+
+ if ($@) {
+ $@ =~ s/\n$//; # Strip the \n used in the Formula.pm die()
+ croak $@; # Re-raise the error
+ }
+
+ # Force 2d ranges to be a reference class.
+ s/_ref3d/_ref3dR/ for @tokens;
+ s/_range3d/_range3dR/ for @tokens;
+
+
+ # Parse the tokens into a formula string.
+ $formula = $parser->parse_tokens(@tokens);
+
+
+
+ $full_name = lc $full_name;
+
+ push @{$self->{_defined_names}}, {
+ name => $name,
+ encoding => $encoding,
+ sheet_index => $sheet_index,
+ formula => $formula,
+ };
+
+ my $index = scalar @{$self->{_defined_names}};
+
+ $parser->set_ext_name($name, $index);
+}
+
+
+
+
+
+
+
+
+
+###############################################################################
+#
+# set_properties()
+#
+# Set the document properties such as Title, Author etc. These are written to
+# property sets in the OLE container.
+#
+sub set_properties {
+
+ my $self = shift;
+ my %param;
+
+ # Ignore if no args were passed.
+ return -1 unless @_;
+
+
+ # Allow the parameters to be passed as a hash or hash ref.
+ if (ref $_[0] eq 'HASH') {
+ %param = %{$_[0]};
+ }
+ else {
+ %param = @_;
+ }
+
+
+ # List of valid input parameters.
+ my %properties = (
+ codepage => [0x0001, 'VT_I2' ],
+ title => [0x0002, 'VT_LPSTR' ],
+ subject => [0x0003, 'VT_LPSTR' ],
+ author => [0x0004, 'VT_LPSTR' ],
+ keywords => [0x0005, 'VT_LPSTR' ],
+ comments => [0x0006, 'VT_LPSTR' ],
+ last_author => [0x0008, 'VT_LPSTR' ],
+ created => [0x000C, 'VT_FILETIME'],
+ category => [0x0002, 'VT_LPSTR' ],
+ manager => [0x000E, 'VT_LPSTR' ],
+ company => [0x000F, 'VT_LPSTR' ],
+ utf8 => 1,
+ );
+
+ # Check for valid input parameters.
+ for my $parameter (keys %param) {
+ if (not exists $properties{$parameter}) {
+ carp "Unknown parameter '$parameter' in set_properties()";
+ return -1;
+ }
+ }
+
+
+ # Set the creation time unless specified by the user.
+ if (!exists $param{created}){
+ $param{created} = $self->{_localtime};
+ }
+
+
+ #
+ # Create the SummaryInformation property set.
+ #
+
+ # Get the codepage of the strings in the property set.
+ my @strings = qw(title subject author keywords comments last_author);
+ $param{codepage} = $self->_get_property_set_codepage(\%param,
+ \@strings);
+
+ # Create an array of property set values.
+ my @property_sets;
+
+ for my $property (qw(codepage title subject author
+ keywords comments last_author created))
+ {
+ if (exists $param{$property} && defined $param{$property}) {
+ push @property_sets, [
+ $properties{$property}->[0],
+ $properties{$property}->[1],
+ $param{$property}
+ ];
+ }
+ }
+
+ # Pack the property sets.
+ $self->{summary} = create_summary_property_set(\@property_sets);
+
+
+ #
+ # Create the DocSummaryInformation property set.
+ #
+
+ # Get the codepage of the strings in the property set.
+ @strings = qw(category manager company);
+ $param{codepage} = $self->_get_property_set_codepage(\%param,
+ \@strings);
+
+ # Create an array of property set values.
+ @property_sets = ();
+
+ for my $property (qw(codepage category manager company))
+ {
+ if (exists $param{$property} && defined $param{$property}) {
+ push @property_sets, [
+ $properties{$property}->[0],
+ $properties{$property}->[1],
+ $param{$property}
+ ];
+ }
+ }
+
+ # Pack the property sets.
+ $self->{doc_summary} = create_doc_summary_property_set(\@property_sets);
+
+ # Set a flag for when the files is written.
+ $self->{_add_doc_properties} = 1;
+}
+
+
+###############################################################################
+#
+# _get_property_set_codepage()
+#
+# Get the character codepage used by the strings in a property set. If one of
+# the strings used is utf8 then the codepage is marked as utf8. Otherwise
+# Latin 1 is used (although in our case this is limited to 7bit ASCII).
+#
+sub _get_property_set_codepage {
+
+ my $self = shift;
+
+ my $params = $_[0];
+ my $strings = $_[1];
+
+ # Allow for manually marked utf8 strings.
+ return 0xFDE9 if defined $params->{utf8};
+
+ # Check for utf8 strings in perl 5.8.
+ if ($] >= 5.008) {
+ require Encode;
+ for my $string (@{$strings }) {
+ next unless exists $params->{$string};
+ return 0xFDE9 if Encode::is_utf8($params->{$string});
+ }
+ }
+
+ return 0x04E4; # Default codepage, Latin 1.
+}
+
+
+###############################################################################
+#
+# _store_workbook()
+#
+# Assemble worksheets into a workbook and send the BIFF data to an OLE
+# storage.
+#
+sub _store_workbook {
+
+ my $self = shift;
+
+ # Add a default worksheet if non have been added.
+ $self->add_worksheet() if not @{$self->{_worksheets}};
+
+ # Calculate size required for MSO records and update worksheets.
+ $self->_calc_mso_sizes();
+
+ # Ensure that at least one worksheet has been selected.
+ if ($self->{_activesheet} == 0) {
+ @{$self->{_worksheets}}[0]->{_selected} = 1;
+ @{$self->{_worksheets}}[0]->{_hidden} = 0;
+ }
+
+ # Calculate the number of selected sheet tabs and set the active sheet.
+ foreach my $sheet (@{$self->{_worksheets}}) {
+ $self->{_selected}++ if $sheet->{_selected};
+ $sheet->{_active} = 1 if $sheet->{_index} == $self->{_activesheet};
+ }
+
+ # Add Workbook globals
+ $self->_store_bof(0x0005);
+ $self->_store_codepage();
+ $self->_store_window1();
+ $self->_store_hideobj();
+ $self->_store_1904();
+ $self->_store_all_fonts();
+ $self->_store_all_num_formats();
+ $self->_store_all_xfs();
+ $self->_store_all_styles();
+ $self->_store_palette();
+
+ # Calculate the offsets required by the BOUNDSHEET records
+ $self->_calc_sheet_offsets();
+
+ # Add BOUNDSHEET records.
+ foreach my $sheet (@{$self->{_worksheets}}) {
+ $self->_store_boundsheet($sheet->{_name},
+ $sheet->{_offset},
+ $sheet->{_sheet_type},
+ $sheet->{_hidden},
+ $sheet->{_encoding});
+ }
+
+ # NOTE: If any records are added between here and EOF the
+ # _calc_sheet_offsets() should be updated to include the new length.
+ $self->_store_country();
+ if ($self->{_ext_ref_count}) {
+ $self->_store_supbook();
+ $self->_store_externsheet();
+ $self->_store_names();
+ }
+ $self->_add_mso_drawing_group();
+ $self->_store_shared_strings();
+ $self->_store_extsst();
+
+ # End Workbook globals
+ $self->_store_eof();
+
+ # Store the workbook in an OLE container
+ return $self->_store_OLE_file();
+}
+
+
+###############################################################################
+#
+# _store_OLE_file()
+#
+# Store the workbook in an OLE container using the default handler or using
+# OLE::Storage_Lite if the workbook data is > ~ 7MB.
+#
+sub _store_OLE_file {
+
+ my $self = shift;
+ my $maxsize = 7_087_104;
+
+ if (!$self->{_add_doc_properties} && $self->{_biffsize} <= $maxsize) {
+ # Write the OLE file using OLEwriter if data <= 7MB
+ my $OLE = Spreadsheet::WriteExcel::OLEwriter->new($self->{_fh_out});
+
+ # Write the BIFF data without the OLE container for testing.
+ $OLE->{_biff_only} = $self->{_biff_only};
+
+ # Indicate that we created the filehandle and want to close it.
+ $OLE->{_internal_fh} = $self->{_internal_fh};
+
+ $OLE->set_size($self->{_biffsize});
+ $OLE->write_header();
+
+ while (my $tmp = $self->get_data()) {
+ $OLE->write($tmp);
+ }
+
+ foreach my $worksheet (@{$self->{_worksheets}}) {
+ while (my $tmp = $worksheet->get_data()) {
+ $OLE->write($tmp);
+ }
+ }
+
+ return $OLE->close();
+ }
+ else {
+ # Write the OLE file using OLE::Storage_Lite if data > 7MB
+ eval { require OLE::Storage_Lite };
+
+ if (not $@) {
+
+ # Protect print() from -l on the command line.
+ local $\ = undef;
+
+ my @streams;
+
+ # Create the Workbook stream.
+ my $stream = pack 'v*', unpack 'C*', 'Workbook';
+ my $workbook = OLE::Storage_Lite::PPS::File->newFile($stream);
+
+ while (my $tmp = $self->get_data()) {
+ $workbook->append($tmp);
+ }
+
+ foreach my $worksheet (@{$self->{_worksheets}}) {
+ while (my $tmp = $worksheet->get_data()) {
+ $workbook->append($tmp);
+ }
+ }
+
+ push @streams, $workbook;
+
+
+ # Create the properties streams, if any.
+ if ($self->{_add_doc_properties}) {
+ my $stream;
+ my $summary;
+
+ $stream = pack 'v*', unpack 'C*', "\5SummaryInformation";
+ $summary = $self->{summary};
+ $summary = OLE::Storage_Lite::PPS::File->new($stream, $summary);
+ push @streams, $summary;
+
+ $stream = pack 'v*', unpack 'C*', "\5DocumentSummaryInformation";
+ $summary = $self->{doc_summary};
+ $summary = OLE::Storage_Lite::PPS::File->new($stream, $summary);
+ push @streams, $summary;
+ }
+
+ # Create the OLE root document and add the substreams.
+ my @localtime = @{ $self->{_localtime} };
+ splice(@localtime, 6);
+
+ my $ole_root = OLE::Storage_Lite::PPS::Root->new(\@localtime,
+ \@localtime,
+ \@streams);
+ $ole_root->save($self->{_filename});
+
+
+ # Close the filehandle if it was created internally.
+ return CORE::close($self->{_fh_out}) if $self->{_internal_fh};
+ }
+ else {
+ # File in greater than limit, set $! to "File too large"
+ $! = 27; # Perl error code "File too large"
+
+ croak "Maximum Spreadsheet::WriteExcel filesize, $maxsize bytes, ".
+ "exceeded. To create files bigger than this limit please " .
+ "install OLE::Storage_Lite\n";
+
+ # return 0;
+ }
+ }
+}
+
+
+###############################################################################
+#
+# _calc_sheet_offsets()
+#
+# Calculate Worksheet BOF offsets records for use in the BOUNDSHEET records.
+#
+sub _calc_sheet_offsets {
+
+ my $self = shift;
+ my $BOF = 12;
+ my $EOF = 4;
+ my $offset = $self->{_datasize};
+
+ # Add the length of the COUNTRY record
+ $offset += 8;
+
+ # Add the length of the SST and associated CONTINUEs
+ $offset += $self->_calculate_shared_string_sizes();
+
+ # Add the length of the EXTSST record.
+ $offset += $self->_calculate_extsst_size();
+
+ # Add the length of the SUPBOOK, EXTERNSHEET and NAME records
+ $offset += $self->_calculate_extern_sizes();
+
+ # Add the length of the MSODRAWINGGROUP records including an extra 4 bytes
+ # for any CONTINUE headers. See _add_mso_drawing_group_continue().
+ my $mso_size = $self->{_mso_size};
+ $mso_size += 4 * int(($mso_size -1) / $self->{_limit});
+ $offset += $mso_size ;
+
+ foreach my $sheet (@{$self->{_worksheets}}) {
+ $offset += $BOF + length($sheet->{_name});
+ }
+
+ $offset += $EOF;
+
+ foreach my $sheet (@{$self->{_worksheets}}) {
+ $sheet->{_offset} = $offset;
+ $sheet->_close();
+ $offset += $sheet->{_datasize};
+ }
+
+ $self->{_biffsize} = $offset;
+}
+
+
+###############################################################################
+#
+# _calc_mso_sizes()
+#
+# Calculate the MSODRAWINGGROUP sizes and the indexes of the Worksheet
+# MSODRAWING records.
+#
+# In the following SPID is shape id, according to Escher nomenclature.
+#
+sub _calc_mso_sizes {
+
+ my $self = shift;
+
+ my $mso_size = 0; # Size of the MSODRAWINGGROUP record
+ my $start_spid = 1024; # Initial spid for each sheet
+ my $max_spid = 1024; # spidMax
+ my $num_clusters = 1; # cidcl
+ my $shapes_saved = 0; # cspSaved
+ my $drawings_saved = 0; # cdgSaved
+ my @clusters = ();
+
+
+ $self->_process_images();
+
+ # Add Bstore container size if there are images.
+ $mso_size += 8 if @{$self->{_images_data}};
+
+
+ # Iterate through the worksheets, calculate the MSODRAWINGGROUP parameters
+ # and space required to store the record and the MSODRAWING parameters
+ # required by each worksheet.
+ #
+ foreach my $sheet (@{$self->{_worksheets}}) {
+ next unless $sheet->{_sheet_type} == 0x0000; # Ignore charts.
+
+ my $num_images = $sheet->{_num_images} || 0;
+ my $image_mso_size = $sheet->{_image_mso_size} || 0;
+ my $num_comments = $sheet->_prepare_comments();
+ my $num_charts = $sheet->_prepare_charts();
+ my $num_filters = $sheet->{_filter_count};
+
+ next unless $num_images + $num_comments + $num_charts +$num_filters;
+
+
+ # Include 1 parent MSODRAWING shape, per sheet, in the shape count.
+ my $num_shapes += 1 + $num_images
+ + $num_comments
+ + $num_charts
+ + $num_filters;
+ $shapes_saved += $num_shapes;
+ $mso_size += $image_mso_size;
+
+
+ # Add a drawing object for each sheet with comments.
+ $drawings_saved++;
+
+
+ # For each sheet start the spids at the next 1024 interval.
+ $max_spid = 1024 * (1 + int(($max_spid -1)/1024));
+ $start_spid = $max_spid;
+
+
+ # Max spid for each sheet and eventually for the workbook.
+ $max_spid += $num_shapes;
+
+
+ # Store the cluster ids
+ for (my $i = $num_shapes; $i > 0; $i -= 1024) {
+ $num_clusters += 1;
+ $mso_size += 8;
+ my $size = $i > 1024 ? 1024 : $i;
+
+ push @clusters, [$drawings_saved, $size];
+ }
+
+
+ # Pass calculated values back to the worksheet
+ $sheet->{_object_ids} = [$start_spid, $drawings_saved,
+ $num_shapes, $max_spid -1];
+ }
+
+
+ # Calculate the MSODRAWINGGROUP size if we have stored some shapes.
+ $mso_size += 86 if $mso_size; # Smallest size is 86+8=94
+
+
+ $self->{_mso_size} = $mso_size;
+ $self->{_mso_clusters} = [
+ $max_spid, $num_clusters, $shapes_saved,
+ $drawings_saved, [@clusters]
+ ];
+}
+
+
+
+###############################################################################
+#
+# _process_images()
+#
+# We need to process each image in each worksheet and extract information.
+# Some of this information is stored and used in the Workbook and some is
+# passed back into each Worksheet. The overall size for the image related
+# BIFF structures in the Workbook is calculated here.
+#
+# MSO size = 8 bytes for bstore_container +
+# 44 bytes for blip_store_entry +
+# 25 bytes for blip
+# = 77 + image size.
+#
+sub _process_images {
+
+ my $self = shift;
+
+ my %images_seen;
+ my @image_data;
+ my @previous_images;
+ my $image_id = 1;
+ my $images_size = 0;
+
+
+ foreach my $sheet (@{$self->{_worksheets}}) {
+ next unless $sheet->{_sheet_type} == 0x0000; # Ignore charts.
+ next unless $sheet->_prepare_images();
+
+ my $num_images = 0;
+ my $image_mso_size = 0;
+
+
+ for my $image_ref (@{$sheet->{_images_array}}) {
+ my $filename = $image_ref->[2];
+ $num_images++;
+
+ #
+ # For each Worksheet image we get a structure like this
+ # [
+ # $row,
+ # $col,
+ # $name,
+ # $x_offset,
+ # $y_offset,
+ # $scale_x,
+ # $scale_y,
+ # ]
+ #
+ # And we add additional information:
+ #
+ # $image_id,
+ # $type,
+ # $width,
+ # $height;
+
+ if (not exists $images_seen{$filename}) {
+ # TODO should also match seen images based on checksum.
+
+ # Open the image file and import the data.
+ my $fh = FileHandle->new($filename);
+ croak "Couldn't import $filename: $!" unless defined $fh;
+ binmode $fh;
+
+ # Slurp the file into a string and do some size calcs.
+ my $data = do {local $/; <$fh>};
+ my $size = length $data;
+ my $checksum1 = $self->_image_checksum($data, $image_id);
+ my $checksum2 = $checksum1;
+ my $ref_count = 1;
+
+
+ # Process the image and extract dimensions.
+ my ($type, $width, $height);
+
+ # Test for PNGs...
+ if (unpack('x A3', $data) eq 'PNG') {
+ ($type, $width, $height) = $self->_process_png($data);
+ }
+ # Test for JFIF and Exif JPEGs...
+ elsif ( (unpack('n', $data) == 0xFFD8) &&
+ ( (unpack('x6 A4', $data) eq 'JFIF') ||
+ (unpack('x6 A4', $data) eq 'Exif')
+ )
+ )
+ {
+ ($type, $width, $height) = $self->_process_jpg($data, $filename);
+ }
+ # Test for BMPs...
+ elsif (unpack('A2', $data) eq 'BM') {
+ ($type, $width, $height) = $self->_process_bmp($data,
+ $filename);
+ # The 14 byte header of the BMP is stripped off.
+ $data = substr $data, 14;
+
+ # A checksum of the new image data is also required.
+ $checksum2 = $self->_image_checksum($data,
+ $image_id,
+ $image_id
+ );
+
+ # Adjust size -14 (header) + 16 (extra checksum).
+ $size += 2;
+ }
+ else {
+ croak "Unsupported image format for file: $filename\n";
+ }
+
+
+ # Push the new data back into the Worksheet array;
+ push @$image_ref, $image_id, $type, $width, $height;
+
+ # Also store new data for use in duplicate images.
+ push @previous_images, [$image_id, $type, $width, $height];
+
+
+ # Store information required by the Workbook.
+ push @image_data, [$ref_count, $type, $data, $size,
+ $checksum1, $checksum2];
+
+ # Keep track of overall data size.
+ $images_size += $size +61; # Size for bstore container.
+ $image_mso_size += $size +69; # Size for dgg container.
+
+ $images_seen{$filename} = $image_id++;
+ $fh->close;
+ }
+ else {
+ # We've processed this file already.
+ my $index = $images_seen{$filename} -1;
+
+ # Increase image reference count.
+ $image_data[$index]->[0]++;
+
+ # Add previously calculated data back onto the Worksheet array.
+ # $image_id, $type, $width, $height
+ my $a_ref = $sheet->{_images_array}->[$index];
+ push @$image_ref, @{$previous_images[$index]};
+ }
+ }
+
+ # Store information required by the Worksheet.
+ $sheet->{_num_images} = $num_images;
+ $sheet->{_image_mso_size} = $image_mso_size;
+
+ }
+
+
+ # Store information required by the Workbook.
+ $self->{_images_size} = $images_size;
+ $self->{_images_data} = \@image_data; # Store the data for MSODRAWINGGROUP.
+
+}
+
+
+###############################################################################
+#
+# _image_checksum()
+#
+# Generate a checksum for the image using whichever module is available..The
+# available modules are checked in _get_checksum_method(). Excel uses an MD4
+# checksum but any other will do. In the event of no checksum module being
+# available we simulate a checksum using the image index.
+#
+sub _image_checksum {
+
+ my $self = shift;
+
+ my $data = $_[0];
+ my $index1 = $_[1];
+ my $index2 = $_[2] || 0;
+
+ if ($self->{_checksum_method} == 1) {
+ # Digest::MD4
+ return Digest::MD4::md4_hex($data);
+ }
+ elsif ($self->{_checksum_method} == 2) {
+ # Digest::Perl::MD4
+ return Digest::Perl::MD4::md4_hex($data);
+ }
+ elsif ($self->{_checksum_method} == 3) {
+ # Digest::MD5
+ return Digest::MD5::md5_hex($data);
+ }
+ else {
+ # Default
+ return sprintf '%016X%016X', $index2, $index1;
+ }
+}
+
+
+###############################################################################
+#
+# _process_png()
+#
+# Extract width and height information from a PNG file.
+#
+sub _process_png {
+
+ my $self = shift;
+
+ my $type = 6; # Excel Blip type (MSOBLIPTYPE).
+ my $width = unpack "N", substr $_[0], 16, 4;
+ my $height = unpack "N", substr $_[0], 20, 4;
+
+ return ($type, $width, $height);
+}
+
+
+###############################################################################
+#
+# _process_bmp()
+#
+# Extract width and height information from a BMP file.
+#
+# Most of these checks came from the old Worksheet::_process_bitmap() method.
+#
+sub _process_bmp {
+
+ my $self = shift;
+ my $data = $_[0];
+ my $filename = $_[1];
+ my $type = 7; # Excel Blip type (MSOBLIPTYPE).
+
+
+ # Check that the file is big enough to be a bitmap.
+ if (length $data <= 0x36) {
+ croak "$filename doesn't contain enough data.";
+ }
+
+
+ # Read the bitmap width and height. Verify the sizes.
+ my ($width, $height) = unpack "x18 V2", $data;
+
+ if ($width > 0xFFFF) {
+ croak "$filename: largest image width $width supported is 65k.";
+ }
+
+ if ($height > 0xFFFF) {
+ croak "$filename: largest image height supported is 65k.";
+ }
+
+ # Read the bitmap planes and bpp data. Verify them.
+ my ($planes, $bitcount) = unpack "x26 v2", $data;
+
+ if ($bitcount != 24) {
+ croak "$filename isn't a 24bit true color bitmap.";
+ }
+
+ if ($planes != 1) {
+ croak "$filename: only 1 plane supported in bitmap image.";
+ }
+
+
+ # Read the bitmap compression. Verify compression.
+ my $compression = unpack "x30 V", $data;
+
+ if ($compression != 0) {
+ croak "$filename: compression not supported in bitmap image.";
+ }
+
+ return ($type, $width, $height);
+}
+
+
+###############################################################################
+#
+# _process_jpg()
+#
+# Extract width and height information from a JPEG file.
+#
+sub _process_jpg {
+
+ my $self = shift;
+ my $data = $_[0];
+ my $filename = $_[1];
+ my $type = 5; # Excel Blip type (MSOBLIPTYPE).
+ my $width;
+ my $height;
+
+ my $offset = 2;
+ my $data_length = length $data;
+
+ # Search through the image data to find the 0xFFC0 marker. The height and
+ # width are contained in the data for that sub element.
+ while ($offset < $data_length) {
+
+ my $marker = unpack "n", substr $data, $offset, 2;
+ my $length = unpack "n", substr $data, $offset +2, 2;
+
+ if ($marker == 0xFFC0 || $marker == 0xFFC2) {
+ $height = unpack "n", substr $data, $offset +5, 2;
+ $width = unpack "n", substr $data, $offset +7, 2;
+ last;
+ }
+
+ $offset = $offset + $length + 2;
+ last if $marker == 0xFFDA;
+ }
+
+ if (not defined $height) {
+ croak "$filename: no size data found in jpeg image.\n";
+ }
+
+ return ($type, $width, $height);
+}
+
+
+###############################################################################
+#
+# _store_all_fonts()
+#
+# Store the Excel FONT records.
+#
+sub _store_all_fonts {
+
+ my $self = shift;
+
+ my $format = $self->{_formats}->[15]; # The default cell format.
+ my $font = $format->get_font();
+
+ # Fonts are 0-indexed. According to the SDK there is no index 4,
+ for (0..3) {
+ $self->_append($font);
+ }
+
+
+ # Add the default fonts for charts and comments. This aren't connected
+ # to XF formats. Note, the font size, and some other properties of
+ # chart fonts are set in the FBI record of the chart.
+ my $tmp_format;
+
+ # Index 5. Axis numbers.
+ $tmp_format = Spreadsheet::WriteExcel::Format->new(
+ undef,
+ font_only => 1,
+ );
+ $self->_append( $tmp_format->get_font() );
+
+ # Index 6. Series names.
+ $tmp_format = Spreadsheet::WriteExcel::Format->new(
+ undef,
+ font_only => 1,
+ );
+ $self->_append( $tmp_format->get_font() );
+
+ # Index 7. Title.
+ $tmp_format = Spreadsheet::WriteExcel::Format->new(
+ undef,
+ font_only => 1,
+ bold => 1,
+ );
+ $self->_append( $tmp_format->get_font() );
+
+ # Index 8. Axes.
+ $tmp_format = Spreadsheet::WriteExcel::Format->new(
+ undef,
+ font_only => 1,
+ bold => 1,
+ );
+ $self->_append( $tmp_format->get_font() );
+
+ # Index 9. Comments.
+ $tmp_format = Spreadsheet::WriteExcel::Format->new(
+ undef,
+ font_only => 1,
+ font => 'Tahoma',
+ size => 8,
+ );
+ $self->_append( $tmp_format->get_font() );
+
+
+ # Iterate through the XF objects and write a FONT record if it isn't the
+ # same as the default FONT and if it hasn't already been used.
+ #
+ my %fonts;
+ my $key;
+ my $index = 10; # The first user defined FONT
+
+ $key = $format->get_font_key(); # The default font for cell formats.
+ $fonts{$key} = 0; # Index of the default font
+
+ # Fonts that are marked as '_font_only' are always stored. These are used
+ # mainly for charts and may not have an associated XF record.
+
+ foreach $format (@{$self->{_formats}}) {
+ $key = $format->get_font_key();
+
+ if (not $format->{_font_only} and exists $fonts{$key}) {
+ # FONT has already been used
+ $format->{_font_index} = $fonts{$key};
+ }
+ else {
+ # Add a new FONT record
+
+ if (not $format->{_font_only}) {
+ $fonts{$key} = $index;
+ }
+
+ $format->{_font_index} = $index;
+ $index++;
+ $font = $format->get_font();
+ $self->_append($font);
+ }
+ }
+}
+
+
+###############################################################################
+#
+# _store_all_num_formats()
+#
+# Store user defined numerical formats i.e. FORMAT records
+#
+sub _store_all_num_formats {
+
+ my $self = shift;
+
+ my %num_formats;
+ my @num_formats;
+ my $num_format;
+ my $index = 164; # User defined FORMAT records start from 0xA4
+
+
+ # Iterate through the XF objects and write a FORMAT record if it isn't a
+ # built-in format type and if the FORMAT string hasn't already been used.
+ #
+ foreach my $format (@{$self->{_formats}}) {
+ my $num_format = $format->{_num_format};
+ my $encoding = $format->{_num_format_enc};
+
+ # Check if $num_format is an index to a built-in format.
+ # Also check for a string of zeros, which is a valid format string
+ # but would evaluate to zero.
+ #
+ if ($num_format !~ m/^0+\d/) {
+ next if $num_format =~ m/^\d+$/; # built-in
+ }
+
+ if (exists($num_formats{$num_format})) {
+ # FORMAT has already been used
+ $format->{_num_format} = $num_formats{$num_format};
+ }
+ else{
+ # Add a new FORMAT
+ $num_formats{$num_format} = $index;
+ $format->{_num_format} = $index;
+ $self->_store_num_format($num_format, $index, $encoding);
+ $index++;
+ }
+ }
+}
+
+
+###############################################################################
+#
+# _store_all_xfs()
+#
+# Write all XF records.
+#
+sub _store_all_xfs {
+
+ my $self = shift;
+
+ foreach my $format (@{$self->{_formats}}) {
+ my $xf = $format->get_xf();
+ $self->_append($xf);
+ }
+}
+
+
+###############################################################################
+#
+# _store_all_styles()
+#
+# Write all STYLE records.
+#
+sub _store_all_styles {
+
+ my $self = shift;
+
+ # Excel adds the built-in styles in alphabetical order.
+ my @built_ins = (
+ [0x03, 16], # Comma
+ [0x06, 17], # Comma[0]
+ [0x04, 18], # Currency
+ [0x07, 19], # Currency[0]
+ [0x00, 0], # Normal
+ [0x05, 20], # Percent
+
+ # We don't deal with these styles yet.
+ #[0x08, 21], # Hyperlink
+ #[0x02, 8], # ColLevel_n
+ #[0x01, 1], # RowLevel_n
+ );
+
+
+ for my $aref (@built_ins) {
+ my $type = $aref->[0];
+ my $xf_index = $aref->[1];
+
+ $self->_store_style($type, $xf_index);
+ }
+}
+
+
+###############################################################################
+#
+# _store_names()
+#
+# Write the NAME record to define the print area and the repeat rows and cols.
+#
+sub _store_names {
+
+ my $self = shift;
+ my $index;
+ my %ext_refs = %{$self->{_ext_refs}};
+
+
+ # Create the user defined names.
+ for my $defined_name (@{$self->{_defined_names}}) {
+
+ $self->_store_name(
+ $defined_name->{name},
+ $defined_name->{encoding},
+ $defined_name->{sheet_index},
+ $defined_name->{formula},
+ );
+ }
+
+ # Sort the worksheets into alphabetical order by name. This is a
+ # requirement for some non-English language Excel patch levels.
+ my @worksheets = @{$self->{_worksheets}};
+ @worksheets = sort { $a->{_name} cmp $b->{_name} } @worksheets;
+
+ # Create the autofilter NAME records
+ foreach my $worksheet (@worksheets) {
+ $index = $worksheet->{_index};
+ my $key = "$index:$index";
+ my $ref = $ext_refs{$key};
+
+ # Write a Name record if Autofilter has been defined
+ if ($worksheet->{_filter_count}) {
+ $self->_store_name_short(
+ $worksheet->{_index},
+ 0x0D, # NAME type = Filter Database
+ $ref,
+ $worksheet->{_filter_area}->[0],
+ $worksheet->{_filter_area}->[1],
+ $worksheet->{_filter_area}->[2],
+ $worksheet->{_filter_area}->[3],
+ 1, # Hidden
+ );
+ }
+ }
+
+ # Create the print area NAME records
+ foreach my $worksheet (@worksheets) {
+ $index = $worksheet->{_index};
+ my $key = "$index:$index";
+ my $ref = $ext_refs{$key};
+
+ # Write a Name record if the print area has been defined
+ if (defined $worksheet->{_print_rowmin}) {
+ $self->_store_name_short(
+ $worksheet->{_index},
+ 0x06, # NAME type = Print_Area
+ $ref,
+ $worksheet->{_print_rowmin},
+ $worksheet->{_print_rowmax},
+ $worksheet->{_print_colmin},
+ $worksheet->{_print_colmax}
+ );
+ }
+ }
+
+ # Create the print title NAME records
+ foreach my $worksheet (@worksheets) {
+ $index = $worksheet->{_index};
+
+ my $rowmin = $worksheet->{_title_rowmin};
+ my $rowmax = $worksheet->{_title_rowmax};
+ my $colmin = $worksheet->{_title_colmin};
+ my $colmax = $worksheet->{_title_colmax};
+ my $key = "$index:$index";
+ my $ref = $ext_refs{$key};
+
+ # Determine if row + col, row, col or nothing has been defined
+ # and write the appropriate record
+ #
+ if (defined $rowmin && defined $colmin) {
+ # Row and column titles have been defined.
+ # Row title has been defined.
+ $self->_store_name_long(
+ $worksheet->{_index},
+ 0x07, # NAME type = Print_Titles
+ $ref,
+ $rowmin,
+ $rowmax,
+ $colmin,
+ $colmax
+ );
+ }
+ elsif (defined $rowmin) {
+ # Row title has been defined.
+ $self->_store_name_short(
+ $worksheet->{_index},
+ 0x07, # NAME type = Print_Titles
+ $ref,
+ $rowmin,
+ $rowmax,
+ 0x00,
+ 0xff
+ );
+ }
+ elsif (defined $colmin) {
+ # Column title has been defined.
+ $self->_store_name_short(
+ $worksheet->{_index},
+ 0x07, # NAME type = Print_Titles
+ $ref,
+ 0x0000,
+ 0xffff,
+ $colmin,
+ $colmax
+ );
+ }
+ else {
+ # Nothing left to do
+ }
+ }
+}
+
+
+
+
+###############################################################################
+###############################################################################
+#
+# BIFF RECORDS
+#
+
+
+###############################################################################
+#
+# _store_window1()
+#
+# Write Excel BIFF WINDOW1 record.
+#
+sub _store_window1 {
+
+ my $self = shift;
+
+ my $record = 0x003D; # Record identifier
+ my $length = 0x0012; # Number of bytes to follow
+
+ my $xWn = 0x0000; # Horizontal position of window
+ my $yWn = 0x0000; # Vertical position of window
+ my $dxWn = 0x355C; # Width of window
+ my $dyWn = 0x30ED; # Height of window
+
+ my $grbit = 0x0038; # Option flags
+ my $ctabsel = $self->{_selected}; # Number of workbook tabs selected
+ my $wTabRatio = 0x0258; # Tab to scrollbar ratio
+
+ my $itabFirst = $self->{_firstsheet}; # 1st displayed worksheet
+ my $itabCur = $self->{_activesheet}; # Active worksheet
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("vvvvvvvvv", $xWn, $yWn, $dxWn, $dyWn,
+ $grbit,
+ $itabCur, $itabFirst,
+ $ctabsel, $wTabRatio);
+
+ $self->_append($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_boundsheet()
+#
+# Writes Excel BIFF BOUNDSHEET record.
+#
+sub _store_boundsheet {
+
+ my $self = shift;
+
+ my $record = 0x0085; # Record identifier
+ my $length = 0x08 + length($_[0]); # Number of bytes to follow
+
+ my $sheetname = $_[0]; # Worksheet name
+ my $offset = $_[1]; # Location of worksheet BOF
+ my $type = $_[2]; # Worksheet type
+ my $hidden = $_[3]; # Worksheet hidden flag
+ my $encoding = $_[4]; # Sheet name encoding
+ my $cch = length($sheetname); # Length of sheet name
+
+ my $grbit = $type | $hidden;
+
+ # Character length is num of chars not num of bytes
+ $cch /= 2 if $encoding;
+
+ # Change the UTF-16 name from BE to LE
+ $sheetname = pack 'n*', unpack 'v*', $sheetname if $encoding;
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("VvCC", $offset, $grbit, $cch, $encoding);
+
+ $self->_append($header, $data, $sheetname);
+}
+
+
+###############################################################################
+#
+# _store_style()
+#
+# Write Excel BIFF STYLE records.
+#
+sub _store_style {
+
+ my $self = shift;
+
+ my $record = 0x0293; # Record identifier
+ my $length = 0x0004; # Bytes to follow
+
+ my $type = $_[0]; # Built-in style
+ my $xf_index = $_[1]; # Index to style XF
+ my $level = 0xff; # Outline style level
+
+ $xf_index |= 0x8000; # Add flag to indicate built-in style.
+
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("vCC", $xf_index, $type, $level);
+
+ $self->_append($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_num_format()
+#
+# Writes Excel FORMAT record for non "built-in" numerical formats.
+#
+sub _store_num_format {
+
+ my $self = shift;
+
+ my $record = 0x041E; # Record identifier
+ my $length; # Number of bytes to follow
+
+ my $format = $_[0]; # Custom format string
+ my $ifmt = $_[1]; # Format index code
+ my $encoding = $_[2]; # Char encoding for format string
+
+
+ # Handle utf8 strings in perl 5.8.
+ if ($] >= 5.008) {
+ require Encode;
+
+ if (Encode::is_utf8($format)) {
+ $format = Encode::encode("UTF-16BE", $format);
+ $encoding = 1;
+ }
+ }
+
+
+ # Char length of format string
+ my $cch = length $format;
+
+
+ # Handle Unicode format strings.
+ if ($encoding == 1) {
+ croak "Uneven number of bytes in Unicode font name" if $cch % 2;
+ $cch /= 2 if $encoding;
+ $format = pack 'v*', unpack 'n*', $format;
+ }
+
+
+ # Special case to handle Euro symbol, 0x80, in non-Unicode strings.
+ if ($encoding == 0 and $format =~ /\x80/) {
+ $format = pack 'v*', unpack 'C*', $format;
+ $format =~ s/\x80\x00/\xAC\x20/g;
+ $encoding = 1;
+ }
+
+ $length = 0x05 + length $format;
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("vvC", $ifmt, $cch, $encoding);
+
+ $self->_append($header, $data, $format);
+}
+
+
+###############################################################################
+#
+# _store_1904()
+#
+# Write Excel 1904 record to indicate the date system in use.
+#
+sub _store_1904 {
+
+ my $self = shift;
+
+ my $record = 0x0022; # Record identifier
+ my $length = 0x0002; # Bytes to follow
+
+ my $f1904 = $self->{_1904}; # Flag for 1904 date system
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("v", $f1904);
+
+ $self->_append($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_supbook()
+#
+# Write BIFF record SUPBOOK to indicate that the workbook contains external
+# references, in our case, formula, print area and print title refs.
+#
+sub _store_supbook {
+
+ my $self = shift;
+
+ my $record = 0x01AE; # Record identifier
+ my $length = 0x0004; # Number of bytes to follow
+
+ my $ctabs = @{$self->{_worksheets}}; # Number of worksheets
+ my $StVirtPath = 0x0401; # Encoded workbook filename
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("vv", $ctabs, $StVirtPath);
+
+ $self->_append($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_externsheet()
+#
+# Writes the Excel BIFF EXTERNSHEET record. These references are used by
+# formulas. TODO NAME record is required to define the print area and the
+# repeat rows and columns.
+#
+sub _store_externsheet {
+
+ my $self = shift;
+
+ my $record = 0x0017; # Record identifier
+ my $length; # Number of bytes to follow
+
+
+ # Get the external refs
+ my %ext_refs = %{$self->{_ext_refs}};
+ my @ext_refs = sort {$ext_refs{$a} <=> $ext_refs{$b}} keys %ext_refs;
+
+ # Change the external refs from stringified "1:1" to [1, 1]
+ foreach my $ref (@ext_refs) {
+ $ref = [split /:/, $ref];
+ }
+
+
+ my $cxti = scalar @ext_refs; # Number of Excel XTI structures
+ my $rgxti = ''; # Array of XTI structures
+
+ # Write the XTI structs
+ foreach my $ext_ref (@ext_refs) {
+ $rgxti .= pack("vvv", 0, $ext_ref->[0], $ext_ref->[1])
+ }
+
+
+ my $data = pack("v", $cxti) . $rgxti;
+ my $header = pack("vv", $record, length $data);
+
+ $self->_append($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_name()
+#
+#
+# Store the NAME record used for storing the print area, repeat rows, repeat
+# columns, autofilters and defined names.
+#
+# TODO. This is a more generic version that will replace _store_name_short()
+# and _store_name_long().
+#
+sub _store_name {
+
+ my $self = shift;
+
+ my $record = 0x0018; # Record identifier
+ my $length; # Number of bytes to follow
+
+ my $name = shift;
+ my $encoding = shift;
+ my $sheet_index = shift;
+ my $formula = shift;
+
+ my $text_length = length $name;
+ my $formula_length = length $formula;
+
+ # UTF-16 string length is in characters not bytes.
+ $text_length /= 2 if $encoding;
+
+
+ my $grbit = 0x0000; # Option flags
+ my $shortcut = 0x00; # Keyboard shortcut
+ my $ixals = 0x0000; # Unused index.
+ my $menu_length = 0x00; # Length of cust menu text
+ my $desc_length = 0x00; # Length of description text
+ my $help_length = 0x00; # Length of help topic text
+ my $status_length = 0x00; # Length of status bar text
+
+ # Set grbit built-in flag and the hidden flag for autofilters.
+ if ($text_length == 1) {
+ $grbit = 0x0020 if ord $name == 0x06; # Print area
+ $grbit = 0x0020 if ord $name == 0x07; # Print titles
+ $grbit = 0x0021 if ord $name == 0x0D; # Autofilter
+ }
+
+ my $data = pack "v", $grbit;
+ $data .= pack "C", $shortcut;
+ $data .= pack "C", $text_length;
+ $data .= pack "v", $formula_length;
+ $data .= pack "v", $ixals;
+ $data .= pack "v", $sheet_index;
+ $data .= pack "C", $menu_length;
+ $data .= pack "C", $desc_length;
+ $data .= pack "C", $help_length;
+ $data .= pack "C", $status_length;
+ $data .= pack "C", $encoding;
+ $data .= $name;
+ $data .= $formula;
+
+ my $header = pack "vv", $record, length $data;
+
+ $self->_append($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_name_short()
+#
+#
+# Store the NAME record in the short format that is used for storing the print
+# area, repeat rows only and repeat columns only.
+#
+sub _store_name_short {
+
+ my $self = shift;
+
+ my $record = 0x0018; # Record identifier
+ my $length = 0x001b; # Number of bytes to follow
+
+ my $index = shift; # Sheet index
+ my $type = shift;
+ my $ext_ref = shift; # TODO
+
+ my $grbit = 0x0020; # Option flags
+ my $chKey = 0x00; # Keyboard shortcut
+ my $cch = 0x01; # Length of text name
+ my $cce = 0x000b; # Length of text definition
+ my $unknown01 = 0x0000; #
+ my $ixals = $index +1; # Sheet index
+ my $unknown02 = 0x00; #
+ my $cchCustMenu = 0x00; # Length of cust menu text
+ my $cchDescription = 0x00; # Length of description text
+ my $cchHelptopic = 0x00; # Length of help topic text
+ my $cchStatustext = 0x00; # Length of status bar text
+ my $rgch = $type; # Built-in name type
+ my $unknown03 = 0x3b; #
+
+ my $rowmin = $_[0]; # Start row
+ my $rowmax = $_[1]; # End row
+ my $colmin = $_[2]; # Start column
+ my $colmax = $_[3]; # end column
+
+ my $hidden = $_[4]; # Name is hidden
+ $grbit = 0x0021 if $hidden;
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("v", $grbit);
+ $data .= pack("C", $chKey);
+ $data .= pack("C", $cch);
+ $data .= pack("v", $cce);
+ $data .= pack("v", $unknown01);
+ $data .= pack("v", $ixals);
+ $data .= pack("C", $unknown02);
+ $data .= pack("C", $cchCustMenu);
+ $data .= pack("C", $cchDescription);
+ $data .= pack("C", $cchHelptopic);
+ $data .= pack("C", $cchStatustext);
+ $data .= pack("C", $rgch);
+ $data .= pack("C", $unknown03);
+ $data .= pack("v", $ext_ref);
+
+ $data .= pack("v", $rowmin);
+ $data .= pack("v", $rowmax);
+ $data .= pack("v", $colmin);
+ $data .= pack("v", $colmax);
+
+ $self->_append($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_name_long()
+#
+#
+# Store the NAME record in the long format that is used for storing the repeat
+# rows and columns when both are specified. This share a lot of code with
+# _store_name_short() but we use a separate method to keep the code clean.
+# Code abstraction for reuse can be carried too far, and I should know. ;-)
+#
+sub _store_name_long {
+
+ my $self = shift;
+
+ my $record = 0x0018; # Record identifier
+ my $length = 0x002a; # Number of bytes to follow
+
+ my $index = shift; # Sheet index
+ my $type = shift;
+ my $ext_ref = shift; # TODO
+
+ my $grbit = 0x0020; # Option flags
+ my $chKey = 0x00; # Keyboard shortcut
+ my $cch = 0x01; # Length of text name
+ my $cce = 0x001a; # Length of text definition
+ my $unknown01 = 0x0000; #
+ my $ixals = $index +1; # Sheet index
+ my $unknown02 = 0x00; #
+ my $cchCustMenu = 0x00; # Length of cust menu text
+ my $cchDescription = 0x00; # Length of description text
+ my $cchHelptopic = 0x00; # Length of help topic text
+ my $cchStatustext = 0x00; # Length of status bar text
+ my $rgch = $type; # Built-in name type
+
+ my $unknown03 = 0x29;
+ my $unknown04 = 0x0017;
+ my $unknown05 = 0x3b;
+
+ my $rowmin = $_[0]; # Start row
+ my $rowmax = $_[1]; # End row
+ my $colmin = $_[2]; # Start column
+ my $colmax = $_[3]; # end column
+
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("v", $grbit);
+ $data .= pack("C", $chKey);
+ $data .= pack("C", $cch);
+ $data .= pack("v", $cce);
+ $data .= pack("v", $unknown01);
+ $data .= pack("v", $ixals);
+ $data .= pack("C", $unknown02);
+ $data .= pack("C", $cchCustMenu);
+ $data .= pack("C", $cchDescription);
+ $data .= pack("C", $cchHelptopic);
+ $data .= pack("C", $cchStatustext);
+ $data .= pack("C", $rgch);
+
+ # Column definition
+ $data .= pack("C", $unknown03);
+ $data .= pack("v", $unknown04);
+ $data .= pack("C", $unknown05);
+ $data .= pack("v", $ext_ref);
+ $data .= pack("v", 0x0000);
+ $data .= pack("v", 0xffff);
+ $data .= pack("v", $colmin);
+ $data .= pack("v", $colmax);
+
+ # Row definition
+ $data .= pack("C", $unknown05);
+ $data .= pack("v", $ext_ref);
+ $data .= pack("v", $rowmin);
+ $data .= pack("v", $rowmax);
+ $data .= pack("v", 0x00);
+ $data .= pack("v", 0xff);
+ # End of data
+ $data .= pack("C", 0x10);
+
+ $self->_append($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_palette()
+#
+# Stores the PALETTE biff record.
+#
+sub _store_palette {
+
+ my $self = shift;
+
+ my $aref = $self->{_palette};
+
+ my $record = 0x0092; # Record identifier
+ my $length = 2 + 4 * @$aref; # Number of bytes to follow
+ my $ccv = @$aref; # Number of RGB values to follow
+ my $data; # The RGB data
+
+ # Pack the RGB data
+ $data .= pack "CCCC", @$_ for @$aref;
+
+ my $header = pack("vvv", $record, $length, $ccv);
+
+ $self->_append($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_codepage()
+#
+# Stores the CODEPAGE biff record.
+#
+sub _store_codepage {
+
+ my $self = shift;
+
+ my $record = 0x0042; # Record identifier
+ my $length = 0x0002; # Number of bytes to follow
+ my $cv = $self->{_codepage}; # The code page
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("v", $cv);
+
+ $self->_append($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_country()
+#
+# Stores the COUNTRY biff record.
+#
+sub _store_country {
+
+ my $self = shift;
+
+ my $record = 0x008C; # Record identifier
+ my $length = 0x0004; # Number of bytes to follow
+ my $country_default = $self->{_country};
+ my $country_win_ini = $self->{_country};
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("vv", $country_default, $country_win_ini);
+
+ $self->_append($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_hideobj()
+#
+# Stores the HIDEOBJ biff record.
+#
+sub _store_hideobj {
+
+ my $self = shift;
+
+ my $record = 0x008D; # Record identifier
+ my $length = 0x0002; # Number of bytes to follow
+ my $hide = $self->{_hideobj}; # Option to hide objects
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("v", $hide);
+
+ $self->_append($header, $data);
+}
+
+
+###############################################################################
+###############################################################################
+###############################################################################
+
+
+
+###############################################################################
+#
+# _calculate_extern_sizes()
+#
+# We need to calculate the space required by the SUPBOOK, EXTERNSHEET and NAME
+# records so that it can be added to the BOUNDSHEET offsets.
+#
+sub _calculate_extern_sizes {
+
+ my $self = shift;
+
+
+ my %ext_refs = $self->{_parser}->get_ext_sheets();
+ my $ext_ref_count = scalar keys %ext_refs;
+ my $length = 0;
+ my $index = 0;
+
+
+ if (@{$self->{_defined_names}}) {
+ my $index = 0;
+ my $key = "$index:$index";
+
+ if (not exists $ext_refs{$key}) {
+ $ext_refs{$key} = $ext_ref_count++;
+ }
+ }
+
+ for my $defined_name (@{$self->{_defined_names}}) {
+ $length += 19
+ + length($defined_name->{name})
+ + length($defined_name->{formula});
+ }
+
+
+ foreach my $worksheet (@{$self->{_worksheets}}) {
+
+ my $rowmin = $worksheet->{_title_rowmin};
+ my $colmin = $worksheet->{_title_colmin};
+ my $filter = $worksheet->{_filter_count};
+ my $key = "$index:$index";
+ $index++;
+
+
+ # Add area NAME records
+ #
+ if (defined $worksheet->{_print_rowmin}) {
+ $ext_refs{$key} = $ext_ref_count++ if not exists $ext_refs{$key};
+
+ $length += 31 ;
+ }
+
+
+ # Add title NAME records
+ #
+ if (defined $rowmin and defined $colmin) {
+ $ext_refs{$key} = $ext_ref_count++ if not exists $ext_refs{$key};
+
+ $length += 46;
+ }
+ elsif (defined $rowmin or defined $colmin) {
+ $ext_refs{$key} = $ext_ref_count++ if not exists $ext_refs{$key};
+
+ $length += 31;
+ }
+ else {
+ # TODO, may need this later.
+ }
+
+
+ # Add Autofilter NAME records
+ #
+ if ($filter) {
+ $ext_refs{$key} = $ext_ref_count++ if not exists $ext_refs{$key};
+
+ $length += 31;
+ }
+ }
+
+
+ # Update the ref counts.
+ $self->{_ext_ref_count} = $ext_ref_count;
+ $self->{_ext_refs} = {%ext_refs};
+
+
+ # If there are no external refs then we don't write, SUPBOOK, EXTERNSHEET
+ # and NAME. Therefore the length is 0.
+
+ return $length = 0 if $ext_ref_count == 0;
+
+
+ # The SUPBOOK record is 8 bytes
+ $length += 8;
+
+ # The EXTERNSHEET record is 6 bytes + 6 bytes for each external ref
+ $length += 6 * (1 + $ext_ref_count);
+
+ return $length;
+}
+
+
+###############################################################################
+#
+# _calculate_shared_string_sizes()
+#
+# Handling of the SST continue blocks is complicated by the need to include an
+# additional continuation byte depending on whether the string is split between
+# blocks or whether it starts at the beginning of the block. (There are also
+# additional complications that will arise later when/if Rich Strings are
+# supported). As such we cannot use the simple CONTINUE mechanism provided by
+# the _add_continue() method in BIFFwriter.pm. Thus we have to make two passes
+# through the strings data. The first is to calculate the required block sizes
+# and the second, in _store_shared_strings(), is to write the actual strings.
+# The first pass through the data is also used to calculate the size of the SST
+# and CONTINUE records for use in setting the BOUNDSHEET record offsets. The
+# downside of this is that the same algorithm repeated in _store_shared_strings.
+#
+sub _calculate_shared_string_sizes {
+
+ my $self = shift;
+
+ my @strings;
+ $#strings = $self->{_str_unique} -1; # Pre-extend array
+
+ while (my $key = each %{$self->{_str_table}}) {
+ $strings[$self->{_str_table}->{$key}] = $key;
+ }
+
+ # The SST data could be very large, free some memory (maybe).
+ $self->{_str_table} = undef;
+ $self->{_str_array} = [@strings];
+
+
+ # Iterate through the strings to calculate the CONTINUE block sizes.
+ #
+ # The SST blocks requires a specialised CONTINUE block, so we have to
+ # ensure that the maximum data block size is less than the limit used by
+ # _add_continue() in BIFFwriter.pm. For simplicity we use the same size
+ # for the SST and CONTINUE records:
+ # 8228 : Maximum Excel97 block size
+ # -4 : Length of block header
+ # -8 : Length of additional SST header information
+ # -8 : Arbitrary number to keep within _add_continue() limit
+ # = 8208
+ #
+ my $continue_limit = 8208;
+ my $block_length = 0;
+ my $written = 0;
+ my @block_sizes;
+ my $continue = 0;
+
+ for my $string (@strings) {
+
+ my $string_length = length $string;
+ my $encoding = unpack "xx C", $string;
+ my $split_string = 0;
+
+
+ # Block length is the total length of the strings that will be
+ # written out in a single SST or CONTINUE block.
+ #
+ $block_length += $string_length;
+
+
+ # We can write the string if it doesn't cross a CONTINUE boundary
+ if ($block_length < $continue_limit) {
+ $written += $string_length;
+ next;
+ }
+
+
+ # Deal with the cases where the next string to be written will exceed
+ # the CONTINUE boundary. If the string is very long it may need to be
+ # written in more than one CONTINUE record.
+ #
+ while ($block_length >= $continue_limit) {
+
+ # We need to avoid the case where a string is continued in the first
+ # n bytes that contain the string header information.
+ #
+ my $header_length = 3; # Min string + header size -1
+ my $space_remaining = $continue_limit -$written -$continue;
+
+
+ # Unicode data should only be split on char (2 byte) boundaries.
+ # Therefore, in some cases we need to reduce the amount of available
+ # space by 1 byte to ensure the correct alignment.
+ my $align = 0;
+
+ # Only applies to Unicode strings
+ if ($encoding == 1) {
+ # Min string + header size -1
+ $header_length = 4;
+
+ if ($space_remaining > $header_length) {
+ # String contains 3 byte header => split on odd boundary
+ if (not $split_string and $space_remaining % 2 != 1) {
+ $space_remaining--;
+ $align = 1;
+ }
+ # Split section without header => split on even boundary
+ elsif ($split_string and $space_remaining % 2 == 1) {
+ $space_remaining--;
+ $align = 1;
+ }
+
+ $split_string = 1;
+ }
+ }
+
+
+ if ($space_remaining > $header_length) {
+ # Write as much as possible of the string in the current block
+ $written += $space_remaining;
+
+ # Reduce the current block length by the amount written
+ $block_length -= $continue_limit -$continue -$align;
+
+ # Store the max size for this block
+ push @block_sizes, $continue_limit -$align;
+
+ # If the current string was split then the next CONTINUE block
+ # should have the string continue flag (grbit) set unless the
+ # split string fits exactly into the remaining space.
+ #
+ if ($block_length > 0) {
+ $continue = 1;
+ }
+ else {
+ $continue = 0;
+ }
+
+ }
+ else {
+ # Store the max size for this block
+ push @block_sizes, $written +$continue;
+
+ # Not enough space to start the string in the current block
+ $block_length -= $continue_limit -$space_remaining -$continue;
+ $continue = 0;
+
+ }
+
+ # If the string (or substr) is small enough we can write it in the
+ # new CONTINUE block. Else, go through the loop again to write it in
+ # one or more CONTINUE blocks
+ #
+ if ($block_length < $continue_limit) {
+ $written = $block_length;
+ }
+ else {
+ $written = 0;
+ }
+ }
+ }
+
+ # Store the max size for the last block unless it is empty
+ push @block_sizes, $written +$continue if $written +$continue;
+
+
+ $self->{_str_block_sizes} = [@block_sizes];
+
+
+ # Calculate the total length of the SST and associated CONTINUEs (if any).
+ # The SST record will have a length even if it contains no strings.
+ # This length is required to set the offsets in the BOUNDSHEET records since
+ # they must be written before the SST records
+ #
+ my $length = 12;
+ $length += shift @block_sizes if @block_sizes; # SST
+ $length += 4 + shift @block_sizes while @block_sizes; # CONTINUEs
+
+ return $length;
+}
+
+
+###############################################################################
+#
+# _store_shared_strings()
+#
+# Write all of the workbooks strings into an indexed array.
+#
+# See the comments in _calculate_shared_string_sizes() for more information.
+#
+# We also use this routine to record the offsets required by the EXTSST table.
+# In order to do this we first identify the first string in an EXTSST bucket
+# and then store its global and local offset within the SST table. The offset
+# occurs wherever the start of the bucket string is written out via append().
+#
+sub _store_shared_strings {
+
+ my $self = shift;
+
+ my @strings = @{$self->{_str_array}};
+
+
+ my $record = 0x00FC; # Record identifier
+ my $length = 0x0008; # Number of bytes to follow
+ my $total = 0x0000;
+
+ # Iterate through the strings to calculate the CONTINUE block sizes
+ my $continue_limit = 8208;
+ my $block_length = 0;
+ my $written = 0;
+ my $continue = 0;
+
+ # The SST and CONTINUE block sizes have been pre-calculated by
+ # _calculate_shared_string_sizes()
+ my @block_sizes = @{$self->{_str_block_sizes}};
+
+
+ # The SST record is required even if it contains no strings. Thus we will
+ # always have a length
+ #
+ if (@block_sizes) {
+ $length = 8 + shift @block_sizes;
+ }
+ else {
+ # No strings
+ $length = 8;
+ }
+
+
+ # Initialise variables used to track EXTSST bucket offsets.
+ my $extsst_str_num = -1;
+ my $sst_block_start = $self->{_datasize};
+
+
+ # Write the SST block header information
+ my $header = pack("vv", $record, $length);
+ my $data = pack("VV", $self->{_str_total}, $self->{_str_unique});
+ $self->_append($header, $data);
+
+
+ # Iterate through the strings and write them out
+ for my $string (@strings) {
+
+ my $string_length = length $string;
+ my $encoding = unpack "xx C", $string;
+ my $split_string = 0;
+ my $bucket_string = 0; # Used to track EXTSST bucket offsets.
+
+
+ # Check if the string is at the start of a EXTSST bucket.
+ if (++$extsst_str_num % $self->{_extsst_bucket_size} == 0) {
+ $bucket_string = 1;
+ }
+
+
+ # Block length is the total length of the strings that will be
+ # written out in a single SST or CONTINUE block.
+ #
+ $block_length += $string_length;
+
+
+ # We can write the string if it doesn't cross a CONTINUE boundary
+ if ($block_length < $continue_limit) {
+
+ # Store location of EXTSST bucket string.
+ if ($bucket_string) {
+ my $global_offset = $self->{_datasize};
+ my $local_offset = $self->{_datasize} - $sst_block_start;
+
+ push @{$self->{_extsst_offsets}}, [$global_offset, $local_offset];
+ $bucket_string = 0;
+ }
+
+ $self->_append($string);
+ $written += $string_length;
+ next;
+ }
+
+
+ # Deal with the cases where the next string to be written will exceed
+ # the CONTINUE boundary. If the string is very long it may need to be
+ # written in more than one CONTINUE record.
+ #
+ while ($block_length >= $continue_limit) {
+
+ # We need to avoid the case where a string is continued in the first
+ # n bytes that contain the string header information.
+ #
+ my $header_length = 3; # Min string + header size -1
+ my $space_remaining = $continue_limit -$written -$continue;
+
+
+ # Unicode data should only be split on char (2 byte) boundaries.
+ # Therefore, in some cases we need to reduce the amount of available
+ # space by 1 byte to ensure the correct alignment.
+ my $align = 0;
+
+ # Only applies to Unicode strings
+ if ($encoding == 1) {
+ # Min string + header size -1
+ $header_length = 4;
+
+ if ($space_remaining > $header_length) {
+ # String contains 3 byte header => split on odd boundary
+ if (not $split_string and $space_remaining % 2 != 1) {
+ $space_remaining--;
+ $align = 1;
+ }
+ # Split section without header => split on even boundary
+ elsif ($split_string and $space_remaining % 2 == 1) {
+ $space_remaining--;
+ $align = 1;
+ }
+
+ $split_string = 1;
+ }
+ }
+
+
+ if ($space_remaining > $header_length) {
+ # Write as much as possible of the string in the current block
+ my $tmp = substr $string, 0, $space_remaining;
+
+ # Store location of EXTSST bucket string.
+ if ($bucket_string) {
+ my $global_offset = $self->{_datasize};
+ my $local_offset = $self->{_datasize} - $sst_block_start;
+
+ push @{$self->{_extsst_offsets}}, [$global_offset, $local_offset];
+ $bucket_string = 0;
+ }
+
+ $self->_append($tmp);
+
+
+ # The remainder will be written in the next block(s)
+ $string = substr $string, $space_remaining;
+
+ # Reduce the current block length by the amount written
+ $block_length -= $continue_limit -$continue -$align;
+
+ # If the current string was split then the next CONTINUE block
+ # should have the string continue flag (grbit) set unless the
+ # split string fits exactly into the remaining space.
+ #
+ if ($block_length > 0) {
+ $continue = 1;
+ }
+ else {
+ $continue = 0;
+ }
+ }
+ else {
+ # Not enough space to start the string in the current block
+ $block_length -= $continue_limit -$space_remaining -$continue;
+ $continue = 0;
+ }
+
+ # Write the CONTINUE block header
+ if (@block_sizes) {
+ $sst_block_start= $self->{_datasize}; # Reset EXTSST offset.
+
+ $record = 0x003C;
+ $length = shift @block_sizes;
+
+ $header = pack("vv", $record, $length);
+ $header .= pack("C", $encoding) if $continue;
+
+ $self->_append($header);
+ }
+
+ # If the string (or substr) is small enough we can write it in the
+ # new CONTINUE block. Else, go through the loop again to write it in
+ # one or more CONTINUE blocks
+ #
+ if ($block_length < $continue_limit) {
+
+ # Store location of EXTSST bucket string.
+ if ($bucket_string) {
+ my $global_offset = $self->{_datasize};
+ my $local_offset = $self->{_datasize} - $sst_block_start;
+
+ push @{$self->{_extsst_offsets}}, [$global_offset, $local_offset];
+
+ $bucket_string = 0;
+ }
+ $self->_append($string);
+
+ $written = $block_length;
+ }
+ else {
+ $written = 0;
+ }
+ }
+ }
+}
+
+
+###############################################################################
+#
+# _calculate_extsst_size
+#
+# The number of buckets used in the EXTSST is between 0 and 128. The number of
+# strings per bucket (bucket size) has a minimum value of 8 and a theoretical
+# maximum of 2^16. For "number of strings" < 1024 there is a constant bucket
+# size of 8. The following algorithm generates the same size/bucket ratio
+# as Excel.
+#
+sub _calculate_extsst_size {
+
+ my $self = shift;
+
+ my $unique_strings = $self->{_str_unique};
+
+ my $bucket_size;
+ my $buckets;
+
+ if ($unique_strings < 1024) {
+ $bucket_size = 8;
+ }
+ else {
+ $bucket_size = 1 + int($unique_strings / 128);
+ }
+
+ $buckets = int(($unique_strings + $bucket_size -1) / $bucket_size);
+
+
+ $self->{_extsst_buckets} = $buckets ;
+ $self->{_extsst_bucket_size} = $bucket_size;
+
+
+ return 6 + 8 * $buckets;
+}
+
+
+###############################################################################
+#
+# _store_extsst
+#
+# Write EXTSST table using the offsets calculated in _store_shared_strings().
+#
+sub _store_extsst {
+
+ my $self = shift;
+
+ my @offsets = @{$self->{_extsst_offsets}};
+ my $bucket_size = $self->{_extsst_bucket_size};
+
+ my $record = 0x00FF; # Record identifier
+ my $length = 2 + 8 * @offsets; # Bytes to follow
+
+ my $header = pack 'vv', $record, $length;
+ my $data = pack 'v', $bucket_size,;
+
+ for my $offset (@offsets) {
+ $data .= pack 'Vvv', $offset->[0], $offset->[1], 0;
+ }
+
+ $self->_append($header, $data);
+
+}
+
+
+
+
+#
+# Methods related to comments and MSO objects.
+#
+
+###############################################################################
+#
+# _add_mso_drawing_group()
+#
+# Write the MSODRAWINGGROUP record that keeps track of the Escher drawing
+# objects in the file such as images, comments and filters.
+#
+sub _add_mso_drawing_group {
+
+ my $self = shift;
+
+ return unless $self->{_mso_size};
+
+ my $record = 0x00EB; # Record identifier
+ my $length = 0x0000; # Number of bytes to follow
+
+ my $data = $self->_store_mso_dgg_container();
+ $data .= $self->_store_mso_dgg(@{$self->{_mso_clusters}});
+ $data .= $self->_store_mso_bstore_container();
+ $data .= $self->_store_mso_images(@$_) for @{$self->{_images_data}};
+ $data .= $self->_store_mso_opt();
+ $data .= $self->_store_mso_split_menu_colors();
+
+ $length = length $data;
+ my $header = pack("vv", $record, $length);
+
+ $self->_add_mso_drawing_group_continue($header . $data);
+
+ return $header . $data; # For testing only.
+}
+
+
+###############################################################################
+#
+# _add_mso_drawing_group_continue()
+#
+# See first the Spreadsheet::WriteExcel::BIFFwriter::_add_continue() method.
+#
+# Add specialised CONTINUE headers to large MSODRAWINGGROUP data block.
+# We use the Excel 97 max block size of 8228 - 4 bytes for the header = 8224.
+#
+# The structure depends on the size of the data block:
+#
+# Case 1: <= 8224 bytes 1 MSODRAWINGGROUP
+# Case 2: <= 2*8224 bytes 1 MSODRAWINGGROUP + 1 CONTINUE
+# Case 3: > 2*8224 bytes 2 MSODRAWINGGROUP + n CONTINUE
+#
+sub _add_mso_drawing_group_continue {
+
+ my $self = shift;
+
+ my $data = $_[0];
+ my $limit = 8228 -4;
+ my $mso_group = 0x00EB; # Record identifier
+ my $continue = 0x003C; # Record identifier
+ my $block_count = 1;
+ my $header;
+ my $tmp;
+
+ # Ignore the base class _add_continue() method.
+ $self->{_ignore_continue} = 1;
+
+ # Case 1 above. Just return the data as it is.
+ if (length $data <= $limit) {
+ $self->_append($data);
+ return;
+ }
+
+ # Change length field of the first MSODRAWINGGROUP block. Case 2 and 3.
+ $tmp = substr($data, 0, $limit +4, "");
+ substr($tmp, 2, 2, pack("v", $limit));
+ $self->_append($tmp);
+
+
+ # Add MSODRAWINGGROUP and CONTINUE blocks for Case 3 above.
+ while (length($data) > $limit) {
+ if ($block_count == 1) {
+ # Add extra MSODRAWINGGROUP block header.
+ $header = pack("vv", $mso_group, $limit);
+ $block_count++;
+ }
+ else {
+ # Add normal CONTINUE header.
+ $header = pack("vv", $continue, $limit);
+ }
+
+ $tmp = substr($data, 0, $limit, "");
+ $self->_append($header, $tmp);
+ }
+
+
+ # Last CONTINUE block for remaining data. Case 2 and 3 above.
+ $header = pack("vv", $continue, length($data));
+ $self->_append($header, $data);
+
+
+ # Turn the base class _add_continue() method back on.
+ $self->{_ignore_continue} = 0;
+}
+
+
+###############################################################################
+#
+# _store_mso_dgg_container()
+#
+# Write the Escher DggContainer record that is part of MSODRAWINGGROUP.
+#
+sub _store_mso_dgg_container {
+
+ my $self = shift;
+
+ my $type = 0xF000;
+ my $version = 15;
+ my $instance = 0;
+ my $data = '';
+ my $length = $self->{_mso_size} -12; # -4 (biff header) -8 (for this).
+
+
+ return $self->_add_mso_generic($type, $version, $instance, $data, $length);
+}
+
+
+###############################################################################
+#
+# _store_mso_dgg()
+#
+# Write the Escher Dgg record that is part of MSODRAWINGGROUP.
+#
+sub _store_mso_dgg {
+
+ my $self = shift;
+
+ my $type = 0xF006;
+ my $version = 0;
+ my $instance = 0;
+ my $data = '';
+ my $length = undef; # Calculate automatically.
+
+ my $max_spid = $_[0];
+ my $num_clusters = $_[1];
+ my $shapes_saved = $_[2];
+ my $drawings_saved = $_[3];
+ my $clusters = $_[4];
+
+ $data = pack "VVVV", $max_spid, $num_clusters,
+ $shapes_saved, $drawings_saved;
+
+ for my $aref (@$clusters) {
+ my $drawing_id = $aref->[0];
+ my $shape_ids_used = $aref->[1];
+
+ $data .= pack "VV", $drawing_id, $shape_ids_used;
+ }
+
+
+ return $self->_add_mso_generic($type, $version, $instance, $data, $length);
+}
+
+
+###############################################################################
+#
+# _store_mso_bstore_container()
+#
+# Write the Escher BstoreContainer record that is part of MSODRAWINGGROUP.
+#
+sub _store_mso_bstore_container {
+
+ my $self = shift;
+
+ return '' unless $self->{_images_size};
+
+ my $type = 0xF001;
+ my $version = 15;
+ my $instance = @{$self->{_images_data}}; # Number of images.
+ my $data = '';
+ my $length = $self->{_images_size} +8 *$instance;
+
+ return $self->_add_mso_generic($type, $version, $instance, $data, $length);
+}
+
+
+
+###############################################################################
+#
+# _store_mso_images()
+#
+# Write the Escher BstoreContainer record that is part of MSODRAWINGGROUP.
+#
+sub _store_mso_images {
+
+ my $self = shift;
+
+ my $ref_count = $_[0];
+ my $image_type = $_[1];
+ my $image = $_[2];
+ my $size = $_[3];
+ my $checksum1 = $_[4];
+ my $checksum2 = $_[5];
+
+ my $blip_store_entry = $self->_store_mso_blip_store_entry($ref_count,
+ $image_type,
+ $size,
+ $checksum1);
+
+ my $blip = $self->_store_mso_blip($image_type,
+ $image,
+ $size,
+ $checksum1,
+ $checksum2);
+
+ return $blip_store_entry . $blip;
+}
+
+
+
+###############################################################################
+#
+# _store_mso_blip_store_entry()
+#
+# Write the Escher BlipStoreEntry record that is part of MSODRAWINGGROUP.
+#
+sub _store_mso_blip_store_entry {
+
+ my $self = shift;
+
+ my $ref_count = $_[0];
+ my $image_type = $_[1];
+ my $size = $_[2];
+ my $checksum1 = $_[3];
+
+
+ my $type = 0xF007;
+ my $version = 2;
+ my $instance = $image_type;
+ my $length = $size +61;
+ my $data = pack('C', $image_type) # Win32
+ . pack('C', $image_type) # Mac
+ . pack('H*', $checksum1) # Uid checksum
+ . pack('v', 0xFF) # Tag
+ . pack('V', $size +25) # Next Blip size
+ . pack('V', $ref_count) # Image ref count
+ . pack('V', 0x00000000) # File offset
+ . pack('C', 0x00) # Usage
+ . pack('C', 0x00) # Name length
+ . pack('C', 0x00) # Unused
+ . pack('C', 0x00) # Unused
+ ;
+
+ return $self->_add_mso_generic($type, $version, $instance, $data, $length);
+}
+
+
+###############################################################################
+#
+# _store_mso_blip()
+#
+# Write the Escher Blip record that is part of MSODRAWINGGROUP.
+#
+sub _store_mso_blip {
+
+ my $self = shift;
+
+ my $image_type = $_[0];
+ my $image_data = $_[1];
+ my $size = $_[2];
+ my $checksum1 = $_[3];
+ my $checksum2 = $_[4];
+ my $instance;
+
+ $instance = 0x046A if $image_type == 5; # JPG
+ $instance = 0x06E0 if $image_type == 6; # PNG
+ $instance = 0x07A9 if $image_type == 7; # BMP
+
+ # BMPs contain an extra checksum for the stripped data.
+ if ( $image_type == 7) {
+ $checksum1 = $checksum2 . $checksum1;
+ }
+
+ my $type = 0xF018 + $image_type;
+ my $version = 0x0000;
+ my $length = $size +17;
+ my $data = pack('H*', $checksum1) # Uid checksum
+ . pack('C', 0xFF) # Tag
+ . $image_data # Image
+ ;
+
+ return $self->_add_mso_generic($type, $version, $instance, $data, $length);
+}
+
+
+
+###############################################################################
+#
+# _store_mso_opt()
+#
+# Write the Escher Opt record that is part of MSODRAWINGGROUP.
+#
+sub _store_mso_opt {
+
+ my $self = shift;
+
+ my $type = 0xF00B;
+ my $version = 3;
+ my $instance = 3;
+ my $data = '';
+ my $length = 18;
+
+ $data = pack "H*", 'BF0008000800810109000008C0014000' .
+ '0008';
+
+
+ return $self->_add_mso_generic($type, $version, $instance, $data, $length);
+}
+
+
+###############################################################################
+#
+# _store_mso_split_menu_colors()
+#
+# Write the Escher SplitMenuColors record that is part of MSODRAWINGGROUP.
+#
+sub _store_mso_split_menu_colors {
+
+ my $self = shift;
+
+ my $type = 0xF11E;
+ my $version = 0;
+ my $instance = 4;
+ my $data = '';
+ my $length = 16;
+
+ $data = pack "H*", '0D0000080C00000817000008F7000010';
+
+ return $self->_add_mso_generic($type, $version, $instance, $data, $length);
+}
+
+
+1;
+
+
+__END__
+
+
+=head1 NAME
+
+Workbook - A writer class for Excel Workbooks.
+
+=head1 SYNOPSIS
+
+See the documentation for Spreadsheet::WriteExcel
+
+=head1 DESCRIPTION
+
+This module is used in conjunction with Spreadsheet::WriteExcel.
+
+=head1 AUTHOR
+
+John McNamara jmcnamara@cpan.org
+
+=head1 COPYRIGHT
+
+© MM-MMX, John McNamara.
+
+All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself.
diff --git a/mcu/tools/perl/Spreadsheet/WriteExcel/Worksheet.pm b/mcu/tools/perl/Spreadsheet/WriteExcel/Worksheet.pm
new file mode 100644
index 0000000..95142f6
--- /dev/null
+++ b/mcu/tools/perl/Spreadsheet/WriteExcel/Worksheet.pm
@@ -0,0 +1,7634 @@
+package Spreadsheet::WriteExcel::Worksheet;
+
+###############################################################################
+#
+# Worksheet - A writer class for Excel Worksheets.
+#
+#
+# Used in conjunction with Spreadsheet::WriteExcel
+#
+# Copyright 2000-2010, John McNamara, jmcnamara@cpan.org
+#
+# Documentation after __END__
+#
+
+use Exporter;
+use strict;
+use Carp;
+use Spreadsheet::WriteExcel::BIFFwriter;
+use Spreadsheet::WriteExcel::Format;
+use Spreadsheet::WriteExcel::Formula;
+
+
+
+use vars qw($VERSION @ISA);
+@ISA = qw(Spreadsheet::WriteExcel::BIFFwriter);
+
+$VERSION = '2.37';
+
+###############################################################################
+#
+# new()
+#
+# Constructor. Creates a new Worksheet object from a BIFFwriter object
+#
+sub new {
+
+ my $class = shift;
+ my $self = Spreadsheet::WriteExcel::BIFFwriter->new();
+ my $rowmax = 65536;
+ my $colmax = 256;
+ my $strmax = 0;
+
+ $self->{_name} = $_[0];
+ $self->{_index} = $_[1];
+ $self->{_encoding} = $_[2];
+ $self->{_activesheet} = $_[3];
+ $self->{_firstsheet} = $_[4];
+ $self->{_url_format} = $_[5];
+ $self->{_parser} = $_[6];
+ $self->{_tempdir} = $_[7];
+
+ $self->{_str_total} = $_[8];
+ $self->{_str_unique} = $_[9];
+ $self->{_str_table} = $_[10];
+ $self->{_1904} = $_[11];
+ $self->{_compatibility} = $_[12];
+ $self->{_palette} = $_[13];
+
+ $self->{_sheet_type} = 0x0000;
+ $self->{_ext_sheets} = [];
+ $self->{_using_tmpfile} = 1;
+ $self->{_filehandle} = "";
+ $self->{_fileclosed} = 0;
+ $self->{_offset} = 0;
+ $self->{_xls_rowmax} = $rowmax;
+ $self->{_xls_colmax} = $colmax;
+ $self->{_xls_strmax} = $strmax;
+ $self->{_dim_rowmin} = undef;
+ $self->{_dim_rowmax} = undef;
+ $self->{_dim_colmin} = undef;
+ $self->{_dim_colmax} = undef;
+ $self->{_colinfo} = [];
+ $self->{_selection} = [0, 0];
+ $self->{_panes} = [];
+ $self->{_active_pane} = 3;
+ $self->{_frozen} = 0;
+ $self->{_frozen_no_split} = 1;
+ $self->{_selected} = 0;
+ $self->{_hidden} = 0;
+ $self->{_active} = 0;
+ $self->{_tab_color} = 0;
+
+ $self->{_first_row} = 0;
+ $self->{_first_col} = 0;
+ $self->{_display_formulas} = 0;
+ $self->{_display_headers} = 1;
+ $self->{_display_zeros} = 1;
+ $self->{_display_arabic} = 0;
+
+ $self->{_paper_size} = 0x0;
+ $self->{_orientation} = 0x1;
+ $self->{_header} = '';
+ $self->{_footer} = '';
+ $self->{_header_encoding} = 0;
+ $self->{_footer_encoding} = 0;
+ $self->{_hcenter} = 0;
+ $self->{_vcenter} = 0;
+ $self->{_margin_header} = 0.50;
+ $self->{_margin_footer} = 0.50;
+ $self->{_margin_left} = 0.75;
+ $self->{_margin_right} = 0.75;
+ $self->{_margin_top} = 1.00;
+ $self->{_margin_bottom} = 1.00;
+
+ $self->{_title_rowmin} = undef;
+ $self->{_title_rowmax} = undef;
+ $self->{_title_colmin} = undef;
+ $self->{_title_colmax} = undef;
+ $self->{_print_rowmin} = undef;
+ $self->{_print_rowmax} = undef;
+ $self->{_print_colmin} = undef;
+ $self->{_print_colmax} = undef;
+
+ $self->{_print_gridlines} = 1;
+ $self->{_screen_gridlines} = 1;
+ $self->{_print_headers} = 0;
+
+ $self->{_page_order} = 0;
+ $self->{_black_white} = 0;
+ $self->{_draft_quality} = 0;
+ $self->{_print_comments} = 0;
+ $self->{_page_start} = 1;
+ $self->{_custom_start} = 0;
+
+ $self->{_fit_page} = 0;
+ $self->{_fit_width} = 0;
+ $self->{_fit_height} = 0;
+
+ $self->{_hbreaks} = [];
+ $self->{_vbreaks} = [];
+
+ $self->{_protect} = 0;
+ $self->{_password} = undef;
+
+ $self->{_col_sizes} = {};
+ $self->{_row_sizes} = {};
+
+ $self->{_col_formats} = {};
+ $self->{_row_formats} = {};
+
+ $self->{_zoom} = 100;
+ $self->{_print_scale} = 100;
+ $self->{_page_view} = 0;
+
+ $self->{_leading_zeros} = 0;
+
+ $self->{_outline_row_level} = 0;
+ $self->{_outline_style} = 0;
+ $self->{_outline_below} = 1;
+ $self->{_outline_right} = 1;
+ $self->{_outline_on} = 1;
+
+ $self->{_write_match} = [];
+
+ $self->{_object_ids} = [];
+ $self->{_images} = {};
+ $self->{_images_array} = [];
+ $self->{_charts} = {};
+ $self->{_charts_array} = [];
+ $self->{_comments} = {};
+ $self->{_comments_array} = [];
+ $self->{_comments_author} = '';
+ $self->{_comments_author_enc} = 0;
+ $self->{_comments_visible} = 0;
+
+ $self->{_filter_area} = [];
+ $self->{_filter_count} = 0;
+ $self->{_filter_on} = 0;
+
+ $self->{_writing_url} = 0;
+
+ $self->{_db_indices} = [];
+
+ $self->{_validations} = [];
+
+ bless $self, $class;
+ $self->_initialize();
+ return $self;
+}
+
+
+###############################################################################
+#
+# _initialize()
+#
+# Open a tmp file to store the majority of the Worksheet data. If this fails,
+# for example due to write permissions, store the data in memory. This can be
+# slow for large files.
+#
+sub _initialize {
+
+ my $self = shift;
+ my $fh;
+ my $tmp_dir;
+
+ # The following code is complicated by Windows limitations. Porters can
+ # choose a more direct method.
+
+
+
+ # In the default case we use IO::File->new_tmpfile(). This may fail, in
+ # particular with IIS on Windows, so we allow the user to specify a temp
+ # directory via File::Temp.
+ #
+ if (defined $self->{_tempdir}) {
+
+ # Delay loading File:Temp to reduce the module dependencies.
+ eval { require File::Temp };
+ die "The File::Temp module must be installed in order ".
+ "to call set_tempdir().\n" if $@;
+
+
+ # Trap but ignore File::Temp errors.
+ eval { $fh = File::Temp::tempfile(DIR => $self->{_tempdir}) };
+
+ # Store the failed tmp dir in case of errors.
+ $tmp_dir = $self->{_tempdir} || File::Spec->tmpdir if not $fh;
+ }
+ else {
+
+ $fh = IO::File->new_tmpfile();
+
+ # Store the failed tmp dir in case of errors.
+ $tmp_dir = "POSIX::tmpnam() directory" if not $fh;
+ }
+
+
+ # Check if the temp file creation was successful. Else store data in memory.
+ if ($fh) {
+
+ # binmode file whether platform requires it or not.
+ binmode($fh);
+
+ # Store filehandle
+ $self->{_filehandle} = $fh;
+ }
+ else {
+
+ # Set flag to store data in memory if XX::tempfile() failed.
+ $self->{_using_tmpfile} = 0;
+
+ if ($self->{_index} == 0 && $^W) {
+ my $dir = $self->{_tempdir} || File::Spec->tmpdir();
+
+ warn "Unable to create temp files in $tmp_dir. Data will be ".
+ "stored in memory. Refer to set_tempdir() in the ".
+ "Spreadsheet::WriteExcel documentation.\n" ;
+ }
+ }
+}
+
+
+###############################################################################
+#
+# _close()
+#
+# Add data to the beginning of the workbook (note the reverse order)
+# and to the end of the workbook.
+#
+sub _close {
+
+ my $self = shift;
+
+ ################################################
+ # Prepend in reverse order!!
+ #
+
+ # Prepend the sheet dimensions
+ $self->_store_dimensions();
+
+ # Prepend the autofilter filters.
+ $self->_store_autofilters;
+
+ # Prepend the sheet autofilter info.
+ $self->_store_autofilterinfo();
+
+ # Prepend the sheet filtermode record.
+ $self->_store_filtermode();
+
+ # Prepend the COLINFO records if they exist
+ if (@{$self->{_colinfo}}){
+ my @colinfo = @{$self->{_colinfo}};
+ while (@colinfo) {
+ my $arrayref = pop @colinfo;
+ $self->_store_colinfo(@$arrayref);
+ }
+ }
+
+ # Prepend the DEFCOLWIDTH record
+ $self->_store_defcol();
+
+ # Prepend the sheet password
+ $self->_store_password();
+
+ # Prepend the sheet protection
+ $self->_store_protect();
+ $self->_store_obj_protect();
+
+ # Prepend the page setup
+ $self->_store_setup();
+
+ # Prepend the bottom margin
+ $self->_store_margin_bottom();
+
+ # Prepend the top margin
+ $self->_store_margin_top();
+
+ # Prepend the right margin
+ $self->_store_margin_right();
+
+ # Prepend the left margin
+ $self->_store_margin_left();
+
+ # Prepend the page vertical centering
+ $self->_store_vcenter();
+
+ # Prepend the page horizontal centering
+ $self->_store_hcenter();
+
+ # Prepend the page footer
+ $self->_store_footer();
+
+ # Prepend the page header
+ $self->_store_header();
+
+ # Prepend the vertical page breaks
+ $self->_store_vbreak();
+
+ # Prepend the horizontal page breaks
+ $self->_store_hbreak();
+
+ # Prepend WSBOOL
+ $self->_store_wsbool();
+
+ # Prepend the default row height.
+ $self->_store_defrow();
+
+ # Prepend GUTS
+ $self->_store_guts();
+
+ # Prepend GRIDSET
+ $self->_store_gridset();
+
+ # Prepend PRINTGRIDLINES
+ $self->_store_print_gridlines();
+
+ # Prepend PRINTHEADERS
+ $self->_store_print_headers();
+
+ #
+ # End of prepend. Read upwards from here.
+ ################################################
+
+ # Append
+ $self->_store_table();
+ $self->_store_images();
+ $self->_store_charts();
+ $self->_store_filters();
+ $self->_store_comments();
+ $self->_store_window2();
+ $self->_store_page_view();
+ $self->_store_zoom();
+ $self->_store_panes(@{$self->{_panes}}) if @{$self->{_panes}};
+ $self->_store_selection(@{$self->{_selection}});
+ $self->_store_validation_count();
+ $self->_store_validations();
+ $self->_store_tab_color();
+ $self->_store_eof();
+
+ # Prepend the BOF and INDEX records
+ $self->_store_index();
+ $self->_store_bof(0x0010);
+}
+
+
+###############################################################################
+#
+# _compatibility_mode()
+#
+# Set the compatibility mode.
+#
+# See the explanation in Workbook::compatibility_mode(). This private method
+# is mainly used for test purposes.
+#
+sub _compatibility_mode {
+
+ my $self = shift;
+
+ if (defined($_[0])) {
+ $self->{_compatibility} = $_[0];
+ }
+ else {
+ $self->{_compatibility} = 1;
+ }
+}
+
+
+###############################################################################
+#
+# get_name().
+#
+# Retrieve the worksheet name.
+#
+# Note, there is no set_name() method because names are used in formulas and
+# converted to internal indices. Allowing the user to change sheet names
+# after they have been set in add_worksheet() is asking for trouble.
+#
+sub get_name {
+
+ my $self = shift;
+
+ return $self->{_name};
+}
+
+
+###############################################################################
+#
+# get_data().
+#
+# Retrieves data from memory in one chunk, or from disk in $buffer
+# sized chunks.
+#
+sub get_data {
+
+ my $self = shift;
+ my $buffer = 4096;
+ my $tmp;
+
+ # Return data stored in memory
+ if (defined $self->{_data}) {
+ $tmp = $self->{_data};
+ $self->{_data} = undef;
+ my $fh = $self->{_filehandle};
+ seek($fh, 0, 0) if $self->{_using_tmpfile};
+ return $tmp;
+ }
+
+ # Return data stored on disk
+ if ($self->{_using_tmpfile}) {
+ return $tmp if read($self->{_filehandle}, $tmp, $buffer);
+ }
+
+ # No data to return
+ return undef;
+}
+
+
+###############################################################################
+#
+# select()
+#
+# Set this worksheet as a selected worksheet, i.e. the worksheet has its tab
+# highlighted.
+#
+sub select {
+
+ my $self = shift;
+
+ $self->{_hidden} = 0; # Selected worksheet can't be hidden.
+ $self->{_selected} = 1;
+}
+
+
+###############################################################################
+#
+# activate()
+#
+# Set this worksheet as the active worksheet, i.e. the worksheet that is
+# displayed when the workbook is opened. Also set it as selected.
+#
+sub activate {
+
+ my $self = shift;
+
+ $self->{_hidden} = 0; # Active worksheet can't be hidden.
+ $self->{_selected} = 1;
+ ${$self->{_activesheet}} = $self->{_index};
+}
+
+
+###############################################################################
+#
+# hide()
+#
+# Hide this worksheet.
+#
+sub hide {
+
+ my $self = shift;
+
+ $self->{_hidden} = 1;
+
+ # A hidden worksheet shouldn't be active or selected.
+ $self->{_selected} = 0;
+ ${$self->{_activesheet}} = 0;
+ ${$self->{_firstsheet}} = 0;
+}
+
+
+###############################################################################
+#
+# set_first_sheet()
+#
+# Set this worksheet as the first visible sheet. This is necessary
+# when there are a large number of worksheets and the activated
+# worksheet is not visible on the screen.
+#
+sub set_first_sheet {
+
+ my $self = shift;
+
+ $self->{_hidden} = 0; # Active worksheet can't be hidden.
+ ${$self->{_firstsheet}} = $self->{_index};
+}
+
+
+###############################################################################
+#
+# protect($password)
+#
+# Set the worksheet protection flag to prevent accidental modification and to
+# hide formulas if the locked and hidden format properties have been set.
+#
+sub protect {
+
+ my $self = shift;
+
+ $self->{_protect} = 1;
+ $self->{_password} = $self->_encode_password($_[0]) if defined $_[0];
+
+}
+
+
+###############################################################################
+#
+# set_column($firstcol, $lastcol, $width, $format, $hidden, $level)
+#
+# Set the width of a single column or a range of columns.
+# See also: _store_colinfo
+#
+sub set_column {
+
+ my $self = shift;
+ my @data = @_;
+ my $cell = $data[0];
+
+ # Check for a cell reference in A1 notation and substitute row and column
+ if ($cell =~ /^\D/) {
+ @data = $self->_substitute_cellref(@_);
+
+ # Returned values $row1 and $row2 aren't required here. Remove them.
+ shift @data; # $row1
+ splice @data, 1, 1; # $row2
+ }
+
+ return if @data < 3; # Ensure at least $firstcol, $lastcol and $width
+ return if not defined $data[0]; # Columns must be defined.
+ return if not defined $data[1];
+
+ # Assume second column is the same as first if 0. Avoids KB918419 bug.
+ $data[1] = $data[0] if $data[1] == 0;
+
+ # Ensure 2nd col is larger than first. Also for KB918419 bug.
+ ($data[0], $data[1]) = ($data[1], $data[0]) if $data[0] > $data[1];
+
+ # Limit columns to Excel max of 255.
+ $data[0] = 255 if $data[0] > 255;
+ $data[1] = 255 if $data[1] > 255;
+
+ push @{$self->{_colinfo}}, [ @data ];
+
+
+ # Store the col sizes for use when calculating image vertices taking
+ # hidden columns into account. Also store the column formats.
+ #
+ my $width = $data[4] ? 0 : $data[2]; # Set width to zero if col is hidden
+ $width ||= 0; # Ensure width isn't undef.
+ my $format = $data[3];
+
+ my ($firstcol, $lastcol) = @data;
+
+ foreach my $col ($firstcol .. $lastcol) {
+ $self->{_col_sizes}->{$col} = $width;
+ $self->{_col_formats}->{$col} = $format if defined $format;
+ }
+}
+
+
+###############################################################################
+#
+# set_selection()
+#
+# Set which cell or cells are selected in a worksheet: see also the
+# sub _store_selection
+#
+sub set_selection {
+
+ my $self = shift;
+
+ # Check for a cell reference in A1 notation and substitute row and column
+ if ($_[0] =~ /^\D/) {
+ @_ = $self->_substitute_cellref(@_);
+ }
+
+ $self->{_selection} = [ @_ ];
+}
+
+
+###############################################################################
+#
+# freeze_panes()
+#
+# Set panes and mark them as frozen. See also _store_panes().
+#
+sub freeze_panes {
+
+ my $self = shift;
+
+ # Check for a cell reference in A1 notation and substitute row and column
+ if ($_[0] =~ /^\D/) {
+ @_ = $self->_substitute_cellref(@_);
+ }
+
+ # Extra flag indicated a split and freeze.
+ $self->{_frozen_no_split} = 0 if $_[4];
+
+ $self->{_frozen} = 1;
+ $self->{_panes} = [ @_ ];
+}
+
+
+###############################################################################
+#
+# split_panes()
+#
+# Set panes and mark them as split. See also _store_panes().
+#
+sub split_panes {
+
+ my $self = shift;
+
+ $self->{_frozen} = 0;
+ $self->{_frozen_no_split} = 0;
+ $self->{_panes} = [ @_ ];
+}
+
+# Older method name for backwards compatibility.
+*thaw_panes = *split_panes;
+
+
+###############################################################################
+#
+# set_portrait()
+#
+# Set the page orientation as portrait.
+#
+sub set_portrait {
+
+ my $self = shift;
+
+ $self->{_orientation} = 1;
+}
+
+
+###############################################################################
+#
+# set_landscape()
+#
+# Set the page orientation as landscape.
+#
+sub set_landscape {
+
+ my $self = shift;
+
+ $self->{_orientation} = 0;
+}
+
+
+###############################################################################
+#
+# set_page_view()
+#
+# Set the page view mode for Mac Excel.
+#
+sub set_page_view {
+
+ my $self = shift;
+
+ $self->{_page_view} = defined $_[0] ? $_[0] : 1;
+}
+
+
+###############################################################################
+#
+# set_tab_color()
+#
+# Set the colour of the worksheet colour.
+#
+sub set_tab_color {
+
+ my $self = shift;
+
+ my $color = &Spreadsheet::WriteExcel::Format::_get_color($_[0]);
+ $color = 0 if $color == 0x7FFF; # Default color.
+
+ $self->{_tab_color} = $color;
+}
+
+
+###############################################################################
+#
+# set_paper()
+#
+# Set the paper type. Ex. 1 = US Letter, 9 = A4
+#
+sub set_paper {
+
+ my $self = shift;
+
+ $self->{_paper_size} = $_[0] || 0;
+}
+
+
+###############################################################################
+#
+# set_header()
+#
+# Set the page header caption and optional margin.
+#
+sub set_header {
+
+ my $self = shift;
+ my $string = $_[0] || '';
+ my $margin = $_[1] || 0.50;
+ my $encoding = $_[2] || 0;
+
+ # Handle utf8 strings in perl 5.8.
+ if ($] >= 5.008) {
+ require Encode;
+
+ if (Encode::is_utf8($string)) {
+ $string = Encode::encode("UTF-16BE", $string);
+ $encoding = 1;
+ }
+ }
+
+ my $limit = $encoding ? 255 *2 : 255;
+
+ if (length $string >= $limit) {
+ carp 'Header string must be less than 255 characters';
+ return;
+ }
+
+ $self->{_header} = $string;
+ $self->{_margin_header} = $margin;
+ $self->{_header_encoding} = $encoding;
+}
+
+
+###############################################################################
+#
+# set_footer()
+#
+# Set the page footer caption and optional margin.
+#
+sub set_footer {
+
+ my $self = shift;
+ my $string = $_[0] || '';
+ my $margin = $_[1] || 0.50;
+ my $encoding = $_[2] || 0;
+
+ # Handle utf8 strings in perl 5.8.
+ if ($] >= 5.008) {
+ require Encode;
+
+ if (Encode::is_utf8($string)) {
+ $string = Encode::encode("UTF-16BE", $string);
+ $encoding = 1;
+ }
+ }
+
+ my $limit = $encoding ? 255 *2 : 255;
+
+
+ if (length $string >= $limit) {
+ carp 'Footer string must be less than 255 characters';
+ return;
+ }
+
+ $self->{_footer} = $string;
+ $self->{_margin_footer} = $margin;
+ $self->{_footer_encoding} = $encoding;
+}
+
+
+###############################################################################
+#
+# center_horizontally()
+#
+# Center the page horizontally.
+#
+sub center_horizontally {
+
+ my $self = shift;
+
+ if (defined $_[0]) {
+ $self->{_hcenter} = $_[0];
+ }
+ else {
+ $self->{_hcenter} = 1;
+ }
+}
+
+
+###############################################################################
+#
+# center_vertically()
+#
+# Center the page horizontally.
+#
+sub center_vertically {
+
+ my $self = shift;
+
+ if (defined $_[0]) {
+ $self->{_vcenter} = $_[0];
+ }
+ else {
+ $self->{_vcenter} = 1;
+ }
+}
+
+
+###############################################################################
+#
+# set_margins()
+#
+# Set all the page margins to the same value in inches.
+#
+sub set_margins {
+
+ my $self = shift;
+
+ $self->set_margin_left($_[0]);
+ $self->set_margin_right($_[0]);
+ $self->set_margin_top($_[0]);
+ $self->set_margin_bottom($_[0]);
+}
+
+
+###############################################################################
+#
+# set_margins_LR()
+#
+# Set the left and right margins to the same value in inches.
+#
+sub set_margins_LR {
+
+ my $self = shift;
+
+ $self->set_margin_left($_[0]);
+ $self->set_margin_right($_[0]);
+}
+
+
+###############################################################################
+#
+# set_margins_TB()
+#
+# Set the top and bottom margins to the same value in inches.
+#
+sub set_margins_TB {
+
+ my $self = shift;
+
+ $self->set_margin_top($_[0]);
+ $self->set_margin_bottom($_[0]);
+}
+
+
+###############################################################################
+#
+# set_margin_left()
+#
+# Set the left margin in inches.
+#
+sub set_margin_left {
+
+ my $self = shift;
+
+ $self->{_margin_left} = defined $_[0] ? $_[0] : 0.75;
+}
+
+
+###############################################################################
+#
+# set_margin_right()
+#
+# Set the right margin in inches.
+#
+sub set_margin_right {
+
+ my $self = shift;
+
+ $self->{_margin_right} = defined $_[0] ? $_[0] : 0.75;
+}
+
+
+###############################################################################
+#
+# set_margin_top()
+#
+# Set the top margin in inches.
+#
+sub set_margin_top {
+
+ my $self = shift;
+
+ $self->{_margin_top} = defined $_[0] ? $_[0] : 1.00;
+}
+
+
+###############################################################################
+#
+# set_margin_bottom()
+#
+# Set the bottom margin in inches.
+#
+sub set_margin_bottom {
+
+ my $self = shift;
+
+ $self->{_margin_bottom} = defined $_[0] ? $_[0] : 1.00;
+}
+
+
+###############################################################################
+#
+# repeat_rows($first_row, $last_row)
+#
+# Set the rows to repeat at the top of each printed page. See also the
+# _store_name_xxxx() methods in Workbook.pm.
+#
+sub repeat_rows {
+
+ my $self = shift;
+
+ $self->{_title_rowmin} = $_[0];
+ $self->{_title_rowmax} = $_[1] || $_[0]; # Second row is optional
+}
+
+
+###############################################################################
+#
+# repeat_columns($first_col, $last_col)
+#
+# Set the columns to repeat at the left hand side of each printed page.
+# See also the _store_names() methods in Workbook.pm.
+#
+sub repeat_columns {
+
+ my $self = shift;
+
+ # Check for a cell reference in A1 notation and substitute row and column
+ if ($_[0] =~ /^\D/) {
+ @_ = $self->_substitute_cellref(@_);
+
+ # Returned values $row1 and $row2 aren't required here. Remove them.
+ shift @_; # $row1
+ splice @_, 1, 1; # $row2
+ }
+
+ $self->{_title_colmin} = $_[0];
+ $self->{_title_colmax} = $_[1] || $_[0]; # Second col is optional
+}
+
+
+###############################################################################
+#
+# print_area($first_row, $first_col, $last_row, $last_col)
+#
+# Set the area of each worksheet that will be printed. See also the
+# _store_names() methods in Workbook.pm.
+#
+sub print_area {
+
+ my $self = shift;
+
+ # Check for a cell reference in A1 notation and substitute row and column
+ if ($_[0] =~ /^\D/) {
+ @_ = $self->_substitute_cellref(@_);
+ }
+
+ return if @_ != 4; # Require 4 parameters
+
+ $self->{_print_rowmin} = $_[0];
+ $self->{_print_colmin} = $_[1];
+ $self->{_print_rowmax} = $_[2];
+ $self->{_print_colmax} = $_[3];
+}
+
+
+###############################################################################
+#
+# autofilter($first_row, $first_col, $last_row, $last_col)
+#
+# Set the autofilter area in the worksheet.
+#
+sub autofilter {
+
+ my $self = shift;
+
+ # Check for a cell reference in A1 notation and substitute row and column
+ if ($_[0] =~ /^\D/) {
+ @_ = $self->_substitute_cellref(@_);
+ }
+
+ return if @_ != 4; # Require 4 parameters
+
+ my ($row1, $col1, $row2, $col2) = @_;
+
+ # Reverse max and min values if necessary.
+ ($row1, $row2) = ($row2, $row1) if $row2 < $row1;
+ ($col1, $col2) = ($col2, $col1) if $col2 < $col1;
+
+ # Store the Autofilter information
+ $self->{_filter_area} = [$row1, $row2, $col1, $col2];
+ $self->{_filter_count} = 1+ $col2 -$col1;
+}
+
+
+###############################################################################
+#
+# filter_column($column, $criteria, ...)
+#
+# Set the column filter criteria.
+#
+sub filter_column {
+
+ my $self = shift;
+ my $col = $_[0];
+ my $expression = $_[1];
+
+
+ croak "Must call autofilter() before filter_column()"
+ unless $self->{_filter_count};
+ croak "Incorrect number of arguments to filter_column()" unless @_ == 2;
+
+
+ # Check for a column reference in A1 notation and substitute.
+ if ($col =~ /^\D/) {
+ # Convert col ref to a cell ref and then to a col number.
+ (undef, $col) = $self->_substitute_cellref($col . '1');
+ }
+
+ my (undef, undef, $col_first, $col_last) = @{$self->{_filter_area}};
+
+ # Reject column if it is outside filter range.
+ if ($col < $col_first or $col > $col_last) {
+ croak "Column '$col' outside autofilter() column range " .
+ "($col_first .. $col_last)";
+ }
+
+
+ my @tokens = $self->_extract_filter_tokens($expression);
+
+ croak "Incorrect number of tokens in expression '$expression'"
+ unless (@tokens == 3 or @tokens == 7);
+
+
+ @tokens = $self->_parse_filter_expression($expression, @tokens);
+
+ $self->{_filter_cols}->{$col} = [@tokens];
+ $self->{_filter_on} = 1;
+}
+
+
+###############################################################################
+#
+# _extract_filter_tokens($expression)
+#
+# Extract the tokens from the filter expression. The tokens are mainly non-
+# whitespace groups. The only tricky part is to extract string tokens that
+# contain whitespace and/or quoted double quotes (Excel's escaped quotes).
+#
+# Examples: 'x < 2000'
+# 'x > 2000 and x < 5000'
+# 'x = "foo"'
+# 'x = "foo bar"'
+# 'x = "foo "" bar"'
+#
+sub _extract_filter_tokens {
+
+ my $self = shift;
+ my $expression = $_[0];
+
+ return unless $expression;
+
+ my @tokens = ($expression =~ /"(?:[^"]|"")*"|\S+/g); #"
+
+ # Remove leading and trailing quotes and unescape other quotes
+ for (@tokens) {
+ s/^"//; #"
+ s/"$//; #"
+ s/""/"/g; #"
+ }
+
+ return @tokens;
+}
+
+
+###############################################################################
+#
+# _parse_filter_expression(@token)
+#
+# Converts the tokens of a possibly conditional expression into 1 or 2
+# sub expressions for further parsing.
+#
+# Examples:
+# ('x', '==', 2000) -> exp1
+# ('x', '>', 2000, 'and', 'x', '<', 5000) -> exp1 and exp2
+#
+sub _parse_filter_expression {
+
+ my $self = shift;
+ my $expression = shift;
+ my @tokens = @_;
+
+ # The number of tokens will be either 3 (for 1 expression)
+ # or 7 (for 2 expressions).
+ #
+ if (@tokens == 7) {
+
+ my $conditional = $tokens[3];
+
+ if ($conditional =~ /^(and|&&)$/) {
+ $conditional = 0;
+ }
+ elsif ($conditional =~ /^(or|\|\|)$/) {
+ $conditional = 1;
+ }
+ else {
+ croak "Token '$conditional' is not a valid conditional " .
+ "in filter expression '$expression'";
+ }
+
+ my @expression_1 = $self->_parse_filter_tokens($expression,
+ @tokens[0, 1, 2]);
+ my @expression_2 = $self->_parse_filter_tokens($expression,
+ @tokens[4, 5, 6]);
+
+ return (@expression_1, $conditional, @expression_2);
+ }
+ else {
+ return $self->_parse_filter_tokens($expression, @tokens);
+ }
+}
+
+
+###############################################################################
+#
+# _parse_filter_tokens(@token)
+#
+# Parse the 3 tokens of a filter expression and return the operator and token.
+#
+sub _parse_filter_tokens {
+
+ my $self = shift;
+ my $expression = shift;
+ my @tokens = @_;
+
+ my %operators = (
+ '==' => 2,
+ '=' => 2,
+ '=~' => 2,
+ 'eq' => 2,
+
+ '!=' => 5,
+ '!~' => 5,
+ 'ne' => 5,
+ '<>' => 5,
+
+ '<' => 1,
+ '<=' => 3,
+ '>' => 4,
+ '>=' => 6,
+ );
+
+ my $operator = $operators{$tokens[1]};
+ my $token = $tokens[2];
+
+
+ # Special handling of "Top" filter expressions.
+ if ($tokens[0] =~ /^top|bottom$/i) {
+
+ my $value = $tokens[1];
+
+ if ($value =~ /\D/ or
+ $value < 1 or
+ $value > 500)
+ {
+ croak "The value '$value' in expression '$expression' " .
+ "must be in the range 1 to 500";
+ }
+
+ $token = lc $token;
+
+ if ($token ne 'items' and $token ne '%') {
+ croak "The type '$token' in expression '$expression' " .
+ "must be either 'items' or '%'";
+ }
+
+ if ($tokens[0] =~ /^top$/i) {
+ $operator = 30;
+ }
+ else {
+ $operator = 32;
+ }
+
+ if ($tokens[2] eq '%') {
+ $operator++;
+ }
+
+ $token = $value;
+ }
+
+
+ if (not $operator and $tokens[0]) {
+ croak "Token '$tokens[1]' is not a valid operator " .
+ "in filter expression '$expression'";
+ }
+
+
+ # Special handling for Blanks/NonBlanks.
+ if ($token =~ /^blanks|nonblanks$/i) {
+
+ # Only allow Equals or NotEqual in this context.
+ if ($operator != 2 and $operator != 5) {
+ croak "The operator '$tokens[1]' in expression '$expression' " .
+ "is not valid in relation to Blanks/NonBlanks'";
+ }
+
+ $token = lc $token;
+
+ # The operator should always be 2 (=) to flag a "simple" equality in
+ # the binary record. Therefore we convert <> to =.
+ if ($token eq 'blanks') {
+ if ($operator == 5) {
+ $operator = 2;
+ $token = 'nonblanks';
+ }
+ }
+ else {
+ if ($operator == 5) {
+ $operator = 2;
+ $token = 'blanks';
+ }
+ }
+ }
+
+
+ # if the string token contains an Excel match character then change the
+ # operator type to indicate a non "simple" equality.
+ if ($operator == 2 and $token =~ /[*?]/) {
+ $operator = 22;
+ }
+
+
+ return ($operator, $token);
+}
+
+
+###############################################################################
+#
+# hide_gridlines()
+#
+# Set the option to hide gridlines on the screen and the printed page.
+# There are two ways of doing this in the Excel BIFF format: The first is by
+# setting the DspGrid field of the WINDOW2 record, this turns off the screen
+# and subsequently the print gridline. The second method is to via the
+# PRINTGRIDLINES and GRIDSET records, this turns off the printed gridlines
+# only. The first method is probably sufficient for most cases. The second
+# method is supported for backwards compatibility. Porters take note.
+#
+sub hide_gridlines {
+
+ my $self = shift;
+ my $option = $_[0];
+
+ $option = 1 unless defined $option; # Default to hiding printed gridlines
+
+ if ($option == 0) {
+ $self->{_print_gridlines} = 1; # 1 = display, 0 = hide
+ $self->{_screen_gridlines} = 1;
+ }
+ elsif ($option == 1) {
+ $self->{_print_gridlines} = 0;
+ $self->{_screen_gridlines} = 1;
+ }
+ else {
+ $self->{_print_gridlines} = 0;
+ $self->{_screen_gridlines} = 0;
+ }
+}
+
+
+###############################################################################
+#
+# print_row_col_headers()
+#
+# Set the option to print the row and column headers on the printed page.
+# See also the _store_print_headers() method below.
+#
+sub print_row_col_headers {
+
+ my $self = shift;
+
+ if (defined $_[0]) {
+ $self->{_print_headers} = $_[0];
+ }
+ else {
+ $self->{_print_headers} = 1;
+ }
+}
+
+
+###############################################################################
+#
+# fit_to_pages($width, $height)
+#
+# Store the vertical and horizontal number of pages that will define the
+# maximum area printed. See also _store_setup() and _store_wsbool() below.
+#
+sub fit_to_pages {
+
+ my $self = shift;
+
+ $self->{_fit_page} = 1;
+ $self->{_fit_width} = $_[0] || 0;
+ $self->{_fit_height} = $_[1] || 0;
+}
+
+
+###############################################################################
+#
+# set_h_pagebreaks(@breaks)
+#
+# Store the horizontal page breaks on a worksheet.
+#
+sub set_h_pagebreaks {
+
+ my $self = shift;
+
+ push @{$self->{_hbreaks}}, @_;
+}
+
+
+###############################################################################
+#
+# set_v_pagebreaks(@breaks)
+#
+# Store the vertical page breaks on a worksheet.
+#
+sub set_v_pagebreaks {
+
+ my $self = shift;
+
+ push @{$self->{_vbreaks}}, @_;
+}
+
+
+###############################################################################
+#
+# set_zoom($scale)
+#
+# Set the worksheet zoom factor.
+#
+sub set_zoom {
+
+ my $self = shift;
+ my $scale = $_[0] || 100;
+
+ # Confine the scale to Excel's range
+ if ($scale < 10 or $scale > 400) {
+ carp "Zoom factor $scale outside range: 10 <= zoom <= 400";
+ $scale = 100;
+ }
+
+ $self->{_zoom} = int $scale;
+}
+
+
+###############################################################################
+#
+# set_print_scale($scale)
+#
+# Set the scale factor for the printed page.
+#
+sub set_print_scale {
+
+ my $self = shift;
+ my $scale = $_[0] || 100;
+
+ # Confine the scale to Excel's range
+ if ($scale < 10 or $scale > 400) {
+ carp "Print scale $scale outside range: 10 <= zoom <= 400";
+ $scale = 100;
+ }
+
+ # Turn off "fit to page" option
+ $self->{_fit_page} = 0;
+
+ $self->{_print_scale} = int $scale;
+}
+
+
+###############################################################################
+#
+# keep_leading_zeros()
+#
+# Causes the write() method to treat integers with a leading zero as a string.
+# This ensures that any leading zeros such, as in zip codes, are maintained.
+#
+sub keep_leading_zeros {
+
+ my $self = shift;
+
+ if (defined $_[0]) {
+ $self->{_leading_zeros} = $_[0];
+ }
+ else {
+ $self->{_leading_zeros} = 1;
+ }
+}
+
+
+###############################################################################
+#
+# show_comments()
+#
+# Make any comments in the worksheet visible.
+#
+sub show_comments {
+
+ my $self = shift;
+
+ $self->{_comments_visible} = defined $_[0] ? $_[0] : 1;
+}
+
+
+###############################################################################
+#
+# set_comments_author()
+#
+# Set the default author of the cell comments.
+#
+sub set_comments_author {
+
+ my $self = shift;
+
+ $self->{_comments_author} = defined $_[0] ? $_[0] : '';
+ $self->{_comments_author_enc} = $_[1] ? 1 : 0;
+}
+
+
+###############################################################################
+#
+# right_to_left()
+#
+# Display the worksheet right to left for some eastern versions of Excel.
+#
+sub right_to_left {
+
+ my $self = shift;
+
+ $self->{_display_arabic} = defined $_[0] ? $_[0] : 1;
+}
+
+
+###############################################################################
+#
+# hide_zero()
+#
+# Hide cell zero values.
+#
+sub hide_zero {
+
+ my $self = shift;
+
+ $self->{_display_zeros} = defined $_[0] ? not $_[0] : 0;
+}
+
+
+###############################################################################
+#
+# print_across()
+#
+# Set the order in which pages are printed.
+#
+sub print_across {
+
+ my $self = shift;
+
+ $self->{_page_order} = defined $_[0] ? $_[0] : 1;
+}
+
+
+###############################################################################
+#
+# set_start_page()
+#
+# Set the start page number.
+#
+sub set_start_page {
+
+ my $self = shift;
+ return unless defined $_[0];
+
+ $self->{_page_start} = $_[0];
+ $self->{_custom_start} = 1;
+}
+
+
+###############################################################################
+#
+# set_first_row_column()
+#
+# Set the topmost and leftmost visible row and column.
+# TODO: Document this when tested fully for interaction with panes.
+#
+sub set_first_row_column {
+
+ my $self = shift;
+
+ my $row = $_[0] || 0;
+ my $col = $_[1] || 0;
+
+ $row = 65535 if $row > 65535;
+ $col = 255 if $col > 255;
+
+ $self->{_first_row} = $row;
+ $self->{_first_col} = $col;
+}
+
+
+###############################################################################
+#
+# add_write_handler($re, $code_ref)
+#
+# Allow the user to add their own matches and handlers to the write() method.
+#
+sub add_write_handler {
+
+ my $self = shift;
+
+ return unless @_ == 2;
+ return unless ref $_[1] eq 'CODE';
+
+ push @{$self->{_write_match}}, [ @_ ];
+}
+
+
+
+###############################################################################
+#
+# write($row, $col, $token, $format)
+#
+# Parse $token and call appropriate write method. $row and $column are zero
+# indexed. $format is optional.
+#
+# The write_url() methods have a flag to prevent recursion when writing a
+# string that looks like a url.
+#
+# Returns: return value of called subroutine
+#
+sub write {
+
+ my $self = shift;
+
+ # Check for a cell reference in A1 notation and substitute row and column
+ if ($_[0] =~ /^\D/) {
+ @_ = $self->_substitute_cellref(@_);
+ }
+
+ my $token = $_[2];
+
+ # Handle undefs as blanks
+ $token = '' unless defined $token;
+
+
+ # First try user defined matches.
+ for my $aref (@{$self->{_write_match}}) {
+ my $re = $aref->[0];
+ my $sub = $aref->[1];
+
+ if ($token =~ /$re/) {
+ my $match = &$sub($self, @_);
+ return $match if defined $match;
+ }
+ }
+
+
+ # Match an array ref.
+ if (ref $token eq "ARRAY") {
+ return $self->write_row(@_);
+ }
+ # Match integer with leading zero(s)
+ elsif ($self->{_leading_zeros} and $token =~ /^0\d+$/) {
+ return $self->write_string(@_);
+ }
+ # Match number
+ elsif ($token =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/) {
+ return $self->write_number(@_);
+ }
+ # Match http, https or ftp URL
+ elsif ($token =~ m|^[fh]tt?ps?://| and not $self->{_writing_url}) {
+ return $self->write_url(@_);
+ }
+ # Match mailto:
+ elsif ($token =~ m/^mailto:/ and not $self->{_writing_url}) {
+ return $self->write_url(@_);
+ }
+ # Match internal or external sheet link
+ elsif ($token =~ m[^(?:in|ex)ternal:] and not $self->{_writing_url}) {
+ return $self->write_url(@_);
+ }
+ # Match formula
+ elsif ($token =~ /^=/) {
+ return $self->write_formula(@_);
+ }
+ # Match blank
+ elsif ($token eq '') {
+ splice @_, 2, 1; # remove the empty string from the parameter list
+ return $self->write_blank(@_);
+ }
+ else {
+ return $self->write_string(@_);
+ }
+}
+
+
+###############################################################################
+#
+# write_row($row, $col, $array_ref, $format)
+#
+# Write a row of data starting from ($row, $col). Call write_col() if any of
+# the elements of the array ref are in turn array refs. This allows the writing
+# of 1D or 2D arrays of data in one go.
+#
+# Returns: the first encountered error value or zero for no errors
+#
+sub write_row {
+
+ my $self = shift;
+
+
+ # Check for a cell reference in A1 notation and substitute row and column
+ if ($_[0] =~ /^\D/) {
+ @_ = $self->_substitute_cellref(@_);
+ }
+
+ # Catch non array refs passed by user.
+ if (ref $_[2] ne 'ARRAY') {
+ croak "Not an array ref in call to write_row()$!";
+ }
+
+ my $row = shift;
+ my $col = shift;
+ my $tokens = shift;
+ my @options = @_;
+ my $error = 0;
+ my $ret;
+
+ foreach my $token (@$tokens) {
+
+ # Check for nested arrays
+ if (ref $token eq "ARRAY") {
+ $ret = $self->write_col($row, $col, $token, @options);
+ } else {
+ $ret = $self->write ($row, $col, $token, @options);
+ }
+
+ # Return only the first error encountered, if any.
+ $error ||= $ret;
+ $col++;
+ }
+
+ return $error;
+}
+
+
+###############################################################################
+#
+# write_col($row, $col, $array_ref, $format)
+#
+# Write a column of data starting from ($row, $col). Call write_row() if any of
+# the elements of the array ref are in turn array refs. This allows the writing
+# of 1D or 2D arrays of data in one go.
+#
+# Returns: the first encountered error value or zero for no errors
+#
+sub write_col {
+
+ my $self = shift;
+
+
+ # Check for a cell reference in A1 notation and substitute row and column
+ if ($_[0] =~ /^\D/) {
+ @_ = $self->_substitute_cellref(@_);
+ }
+
+ # Catch non array refs passed by user.
+ if (ref $_[2] ne 'ARRAY') {
+ croak "Not an array ref in call to write_row()$!";
+ }
+
+ my $row = shift;
+ my $col = shift;
+ my $tokens = shift;
+ my @options = @_;
+ my $error = 0;
+ my $ret;
+
+ foreach my $token (@$tokens) {
+
+ # write() will deal with any nested arrays
+ $ret = $self->write($row, $col, $token, @options);
+
+ # Return only the first error encountered, if any.
+ $error ||= $ret;
+ $row++;
+ }
+
+ return $error;
+}
+
+
+###############################################################################
+#
+# write_comment($row, $col, $comment)
+#
+# Write a comment to the specified row and column (zero indexed).
+#
+# Returns 0 : normal termination
+# -1 : insufficient number of arguments
+# -2 : row or column out of range
+#
+sub write_comment {
+
+ my $self = shift;
+
+
+ # Check for a cell reference in A1 notation and substitute row and column
+ if ($_[0] =~ /^\D/) {
+ @_ = $self->_substitute_cellref(@_);
+ }
+
+ if (@_ < 3) { return -1 } # Check the number of args
+
+
+ my $row = $_[0];
+ my $col = $_[1];
+
+ # Check for pairs of optional arguments, i.e. an odd number of args.
+ croak "Uneven number of additional arguments" unless @_ % 2;
+
+
+ # Check that row and col are valid and store max and min values
+ return -2 if $self->_check_dimensions($row, $col);
+
+
+ # We have to avoid duplicate comments in cells or else Excel will complain.
+ $self->{_comments}->{$row}->{$col} = [ $self->_comment_params(@_) ];
+
+}
+
+
+###############################################################################
+#
+# _XF()
+#
+# Returns an index to the XF record in the workbook.
+#
+# Note: this is a function, not a method.
+#
+sub _XF {
+
+ my $self = $_[0];
+ my $row = $_[1];
+ my $col = $_[2];
+ my $format = $_[3];
+
+ my $error = "Error: refer to merge_range() in the documentation. " .
+ "Can't use previously merged format in non-merged cell";
+
+ if (ref($format)) {
+ # Temp code to prevent merged formats in non-merged cells.
+ croak $error if $format->{_used_merge} == 1;
+ $format->{_used_merge} = -1;
+
+ return $format->get_xf_index();
+ }
+ elsif (exists $self->{_row_formats}->{$row}) {
+ # Temp code to prevent merged formats in non-merged cells.
+ croak $error if $self->{_row_formats}->{$row}->{_used_merge} == 1;
+ $self->{_row_formats}->{$row}->{_used_merge} = -1;
+
+ return $self->{_row_formats}->{$row}->get_xf_index();
+ }
+ elsif (exists $self->{_col_formats}->{$col}) {
+ # Temp code to prevent merged formats in non-merged cells.
+ croak $error if $self->{_col_formats}->{$col}->{_used_merge} == 1;
+ $self->{_col_formats}->{$col}->{_used_merge} = -1;
+
+ return $self->{_col_formats}->{$col}->get_xf_index();
+ }
+ else {
+ return 0x0F;
+ }
+}
+
+
+###############################################################################
+###############################################################################
+#
+# Internal methods
+#
+
+
+###############################################################################
+#
+# _append(), overridden.
+#
+# Store Worksheet data in memory using the base class _append() or to a
+# temporary file, the default.
+#
+sub _append {
+
+ my $self = shift;
+ my $data = '';
+
+ if ($self->{_using_tmpfile}) {
+ $data = join('', @_);
+
+ # Add CONTINUE records if necessary
+ $data = $self->_add_continue($data) if length($data) > $self->{_limit};
+
+ # Protect print() from -l on the command line.
+ local $\ = undef;
+
+ print {$self->{_filehandle}} $data;
+ $self->{_datasize} += length($data);
+ }
+ else {
+ $data = $self->SUPER::_append(@_);
+ }
+
+ return $data;
+}
+
+
+###############################################################################
+#
+# _substitute_cellref()
+#
+# Substitute an Excel cell reference in A1 notation for zero based row and
+# column values in an argument list.
+#
+# Ex: ("A4", "Hello") is converted to (3, 0, "Hello").
+#
+sub _substitute_cellref {
+
+ my $self = shift;
+ my $cell = uc(shift);
+
+ # Convert a column range: 'A:A' or 'B:G'.
+ # A range such as A:A is equivalent to A1:65536, so add rows as required
+ if ($cell =~ /\$?([A-I]?[A-Z]):\$?([A-I]?[A-Z])/) {
+ my ($row1, $col1) = $self->_cell_to_rowcol($1 .'1');
+ my ($row2, $col2) = $self->_cell_to_rowcol($2 .'65536');
+ return $row1, $col1, $row2, $col2, @_;
+ }
+
+ # Convert a cell range: 'A1:B7'
+ if ($cell =~ /\$?([A-I]?[A-Z]\$?\d+):\$?([A-I]?[A-Z]\$?\d+)/) {
+ my ($row1, $col1) = $self->_cell_to_rowcol($1);
+ my ($row2, $col2) = $self->_cell_to_rowcol($2);
+ return $row1, $col1, $row2, $col2, @_;
+ }
+
+ # Convert a cell reference: 'A1' or 'AD2000'
+ if ($cell =~ /\$?([A-I]?[A-Z]\$?\d+)/) {
+ my ($row1, $col1) = $self->_cell_to_rowcol($1);
+ return $row1, $col1, @_;
+
+ }
+
+ croak("Unknown cell reference $cell");
+}
+
+
+###############################################################################
+#
+# _cell_to_rowcol($cell_ref)
+#
+# Convert an Excel cell reference in A1 notation to a zero based row and column
+# reference; converts C1 to (0, 2).
+#
+# Returns: row, column
+#
+sub _cell_to_rowcol {
+
+ my $self = shift;
+ my $cell = shift;
+
+ $cell =~ /\$?([A-I]?[A-Z])\$?(\d+)/;
+
+ my $col = $1;
+ my $row = $2;
+
+ # Convert base26 column string to number
+ # All your Base are belong to us.
+ my @chars = split //, $col;
+ my $expn = 0;
+ $col = 0;
+
+ while (@chars) {
+ my $char = pop(@chars); # LS char first
+ $col += (ord($char) -ord('A') +1) * (26**$expn);
+ $expn++;
+ }
+
+ # Convert 1-index to zero-index
+ $row--;
+ $col--;
+
+ return $row, $col;
+}
+
+
+###############################################################################
+#
+# _sort_pagebreaks()
+#
+#
+# This is an internal method that is used to filter elements of the array of
+# pagebreaks used in the _store_hbreak() and _store_vbreak() methods. It:
+# 1. Removes duplicate entries from the list.
+# 2. Sorts the list.
+# 3. Removes 0 from the list if present.
+#
+sub _sort_pagebreaks {
+
+ my $self= shift;
+
+ my %hash;
+ my @array;
+
+ @hash{@_} = undef; # Hash slice to remove duplicates
+ @array = sort {$a <=> $b} keys %hash; # Numerical sort
+ shift @array if $array[0] == 0; # Remove zero
+
+ # 1000 vertical pagebreaks appears to be an internal Excel 5 limit.
+ # It is slightly higher in Excel 97/200, approx. 1026
+ splice(@array, 1000) if (@array > 1000);
+
+ return @array
+}
+
+
+###############################################################################
+#
+# _encode_password($password)
+#
+# Based on the algorithm provided by Daniel Rentz of OpenOffice.
+#
+#
+sub _encode_password {
+
+ use integer;
+
+ my $self = shift;
+ my $plaintext = $_[0];
+ my $password;
+ my $count;
+ my @chars;
+ my $i = 0;
+
+ $count = @chars = split //, $plaintext;
+
+ foreach my $char (@chars) {
+ my $low_15;
+ my $high_15;
+ $char = ord($char) << ++$i;
+ $low_15 = $char & 0x7fff;
+ $high_15 = $char & 0x7fff << 15;
+ $high_15 = $high_15 >> 15;
+ $char = $low_15 | $high_15;
+ }
+
+ $password = 0x0000;
+ $password ^= $_ for @chars;
+ $password ^= $count;
+ $password ^= 0xCE4B;
+
+ return $password;
+}
+
+
+###############################################################################
+#
+# outline_settings($visible, $symbols_below, $symbols_right, $auto_style)
+#
+# This method sets the properties for outlining and grouping. The defaults
+# correspond to Excel's defaults.
+#
+sub outline_settings {
+
+ my $self = shift;
+
+ $self->{_outline_on} = defined $_[0] ? $_[0] : 1;
+ $self->{_outline_below} = defined $_[1] ? $_[1] : 1;
+ $self->{_outline_right} = defined $_[2] ? $_[2] : 1;
+ $self->{_outline_style} = $_[3] || 0;
+
+ # Ensure this is a boolean vale for Window2
+ $self->{_outline_on} = 1 if $self->{_outline_on};
+}
+
+
+
+
+###############################################################################
+###############################################################################
+#
+# BIFF RECORDS
+#
+
+
+###############################################################################
+#
+# write_number($row, $col, $num, $format)
+#
+# Write a double to the specified row and column (zero indexed).
+# An integer can be written as a double. Excel will display an
+# integer. $format is optional.
+#
+# Returns 0 : normal termination
+# -1 : insufficient number of arguments
+# -2 : row or column out of range
+#
+sub write_number {
+
+ my $self = shift;
+
+ # Check for a cell reference in A1 notation and substitute row and column
+ if ($_[0] =~ /^\D/) {
+ @_ = $self->_substitute_cellref(@_);
+ }
+
+ if (@_ < 3) { return -1 } # Check the number of args
+
+ my $record = 0x0203; # Record identifier
+ my $length = 0x000E; # Number of bytes to follow
+
+ my $row = $_[0]; # Zero indexed row
+ my $col = $_[1]; # Zero indexed column
+ my $num = $_[2];
+ my $xf = _XF($self, $row, $col, $_[3]); # The cell format
+
+ # Check that row and col are valid and store max and min values
+ return -2 if $self->_check_dimensions($row, $col);
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("vvv", $row, $col, $xf);
+ my $xl_double = pack("d", $num);
+
+ if ($self->{_byte_order}) { $xl_double = reverse $xl_double }
+
+ # Store the data or write immediately depending on the compatibility mode.
+ if ($self->{_compatibility}) {
+ $self->{_table}->[$row]->[$col] = $header . $data . $xl_double;
+ }
+ else {
+ $self->_append($header, $data, $xl_double);
+ }
+
+ return 0;
+}
+
+
+###############################################################################
+#
+# write_string ($row, $col, $string, $format)
+#
+# Write a string to the specified row and column (zero indexed).
+# NOTE: there is an Excel 5 defined limit of 255 characters.
+# $format is optional.
+# Returns 0 : normal termination
+# -1 : insufficient number of arguments
+# -2 : row or column out of range
+# -3 : long string truncated to 255 chars
+#
+sub write_string {
+
+ my $self = shift;
+
+ # Check for a cell reference in A1 notation and substitute row and column
+ if ($_[0] =~ /^\D/) {
+ @_ = $self->_substitute_cellref(@_);
+ }
+
+ if (@_ < 3) { return -1 } # Check the number of args
+
+ my $record = 0x00FD; # Record identifier
+ my $length = 0x000A; # Bytes to follow
+
+ my $row = $_[0]; # Zero indexed row
+ my $col = $_[1]; # Zero indexed column
+ my $strlen = length($_[2]);
+ my $str = $_[2];
+ my $xf = _XF($self, $row, $col, $_[3]); # The cell format
+ my $encoding = 0x0;
+ my $str_error = 0;
+
+
+ # Handle utf8 strings in perl 5.8.
+ if ($] >= 5.008) {
+ require Encode;
+
+ if (Encode::is_utf8($str)) {
+ my $tmp = Encode::encode("UTF-16LE", $str);
+ return $self->write_utf16le_string($row, $col, $tmp, $_[3]);
+ }
+ }
+
+
+ # Check that row and col are valid and store max and min values
+ return -2 if $self->_check_dimensions($row, $col);
+
+ # Limit the string to the max number of chars.
+ if ($strlen > 32767) {
+ $str = substr($str, 0, 32767);
+ $str_error = -3;
+ }
+
+
+ # Prepend the string with the type.
+ my $str_header = pack("vC", length($str), $encoding);
+ $str = $str_header . $str;
+
+
+ if (not exists ${$self->{_str_table}}->{$str}) {
+ ${$self->{_str_table}}->{$str} = ${$self->{_str_unique}}++;
+ }
+
+
+ ${$self->{_str_total}}++;
+
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("vvvV", $row, $col, $xf, ${$self->{_str_table}}->{$str});
+
+
+ # Store the data or write immediately depending on the compatibility mode.
+ if ($self->{_compatibility}) {
+ $self->{_table}->[$row]->[$col] = $header . $data;
+ }
+ else {
+ $self->_append($header, $data);
+ }
+
+ return $str_error;
+}
+
+
+###############################################################################
+#
+# write_blank($row, $col, $format)
+#
+# Write a blank cell to the specified row and column (zero indexed).
+# A blank cell is used to specify formatting without adding a string
+# or a number.
+#
+# A blank cell without a format serves no purpose. Therefore, we don't write
+# a BLANK record unless a format is specified. This is mainly an optimisation
+# for the write_row() and write_col() methods.
+#
+# Returns 0 : normal termination (including no format)
+# -1 : insufficient number of arguments
+# -2 : row or column out of range
+#
+sub write_blank {
+
+ my $self = shift;
+
+ # Check for a cell reference in A1 notation and substitute row and column
+ if ($_[0] =~ /^\D/) {
+ @_ = $self->_substitute_cellref(@_);
+ }
+
+ # Check the number of args
+ return -1 if @_ < 2;
+
+ # Don't write a blank cell unless it has a format
+ return 0 if not defined $_[2];
+
+
+ my $record = 0x0201; # Record identifier
+ my $length = 0x0006; # Number of bytes to follow
+
+ my $row = $_[0]; # Zero indexed row
+ my $col = $_[1]; # Zero indexed column
+ my $xf = _XF($self, $row, $col, $_[2]); # The cell format
+
+ # Check that row and col are valid and store max and min values
+ return -2 if $self->_check_dimensions($row, $col);
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("vvv", $row, $col, $xf);
+
+ # Store the data or write immediately depending on the compatibility mode.
+ if ($self->{_compatibility}) {
+ $self->{_table}->[$row]->[$col] = $header . $data;
+ }
+ else {
+ $self->_append($header, $data);
+ }
+
+ return 0;
+}
+
+
+###############################################################################
+#
+# write_formula($row, $col, $formula, $format, $value)
+#
+# Write a formula to the specified row and column (zero indexed).
+# The textual representation of the formula is passed to the parser in
+# Formula.pm which returns a packed binary string.
+#
+# $format is optional.
+#
+# $value is an optional result of the formula that can be supplied by the user.
+#
+# Returns 0 : normal termination
+# -1 : insufficient number of arguments
+# -2 : row or column out of range
+#
+sub write_formula {
+
+ my $self = shift;
+
+ # Check for a cell reference in A1 notation and substitute row and column
+ if ($_[0] =~ /^\D/) {
+ @_ = $self->_substitute_cellref(@_);
+ }
+
+ if (@_ < 3) { return -1 } # Check the number of args
+
+ my $record = 0x0006; # Record identifier
+ my $length; # Bytes to follow
+
+ my $row = $_[0]; # Zero indexed row
+ my $col = $_[1]; # Zero indexed column
+ my $formula = $_[2]; # The formula text string
+ my $value = $_[4]; # The formula text string
+
+
+ my $xf = _XF($self, $row, $col, $_[3]); # The cell format
+ my $chn = 0x0000; # Must be zero
+ my $is_string = 0; # Formula evaluates to str
+ my $num; # Current value of formula
+ my $grbit; # Option flags
+
+
+ # Excel normally stores the last calculated value of the formula in $num.
+ # Clearly we are not in a position to calculate this "a priori". Instead
+ # we set $num to zero and set the option flags in $grbit to ensure
+ # automatic calculation of the formula when the file is opened.
+ # As a workaround for some non-Excel apps we also allow the user to
+ # specify the result of the formula.
+ #
+ ($num, $grbit, $is_string) = $self->_encode_formula_result($value);
+
+
+ # Check that row and col are valid and store max and min values
+ return -2 if $self->_check_dimensions($row, $col);
+
+ # Strip the = sign at the beginning of the formula string
+ $formula =~ s(^=)();
+
+ my $tmp = $formula;
+
+ # Parse the formula using the parser in Formula.pm
+ my $parser = $self->{_parser};
+
+ # In order to raise formula errors from the point of view of the calling
+ # program we use an eval block and re-raise the error from here.
+ #
+ eval { $formula = $parser->parse_formula($formula) };
+
+ if ($@) {
+ $@ =~ s/\n$//; # Strip the \n used in the Formula.pm die()
+ croak $@; # Re-raise the error
+ }
+
+
+ my $formlen = length($formula); # Length of the binary string
+ $length = 0x16 + $formlen; # Length of the record data
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("vvv", $row, $col, $xf);
+ $data .= $num;
+ $data .= pack("vVv", $grbit, $chn, $formlen);
+
+ # The STRING record if the formula evaluates to a string.
+ my $string = '';
+ $string = $self->_get_formula_string($value) if $is_string;
+
+
+ # Store the data or write immediately depending on the compatibility mode.
+ if ($self->{_compatibility}) {
+ $self->{_table}->[$row]->[$col] = $header . $data . $formula . $string;
+ }
+ else {
+ $self->_append($header, $data, $formula, $string);
+ }
+
+ return 0;
+}
+
+
+###############################################################################
+#
+# _encode_formula_result()
+#
+# Encode the user supplied result for a formula.
+#
+sub _encode_formula_result {
+
+ my $self = shift;
+
+ my $value = $_[0]; # Result to be encoded.
+ my $is_string = 0; # Formula evaluates to str.
+ my $num; # Current value of formula.
+ my $grbit; # Option flags.
+
+ if (not defined $value) {
+ $grbit = 0x03;
+ $num = pack "d", 0;
+ }
+ else {
+ # The user specified the result of the formula. We turn off the recalc
+ # flag and check the result type.
+ $grbit = 0x00;
+
+ if ($value =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/) {
+ # Value is a number.
+ $num = pack "d", $value;
+ }
+ else {
+
+ my %bools = (
+ 'TRUE' => [1, 1],
+ 'FALSE' => [1, 0],
+ '#NULL!' => [2, 0],
+ '#DIV/0!' => [2, 7],
+ '#VALUE!' => [2, 15],
+ '#REF!' => [2, 23],
+ '#NAME?' => [2, 29],
+ '#NUM!' => [2, 36],
+ '#N/A' => [2, 42],
+ );
+
+ if (exists $bools{$value}) {
+ # Value is a boolean.
+ $num = pack "vvvv", $bools{$value}->[0],
+ $bools{$value}->[1],
+ 0,
+ 0xFFFF;
+ }
+ else {
+ # Value is a string.
+ $num = pack "vvvv", 0,
+ 0,
+ 0,
+ 0xFFFF;
+ $is_string = 1;
+ }
+ }
+ }
+
+ return ($num, $grbit, $is_string);
+}
+
+
+###############################################################################
+#
+# _get_formula_string()
+#
+# Pack the string value when a formula evaluates to a string. The value cannot
+# be calculated by the module and thus must be supplied by the user.
+#
+sub _get_formula_string {
+
+ my $self = shift;
+
+ my $record = 0x0207; # Record identifier
+ my $length = 0x00; # Bytes to follow
+ my $string = $_[0]; # Formula string.
+ my $strlen = length $_[0]; # Length of the formula string (chars).
+ my $encoding = 0; # String encoding.
+
+
+ # Handle utf8 strings in perl 5.8.
+ if ($] >= 5.008) {
+ require Encode;
+
+ if (Encode::is_utf8($string)) {
+ $string = Encode::encode("UTF-16BE", $string);
+ $encoding = 1;
+ }
+ }
+
+
+ $length = 0x03 + length $string; # Length of the record data
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("vC", $strlen, $encoding);
+
+ return $header . $data . $string;
+}
+
+
+###############################################################################
+#
+# store_formula($formula)
+#
+# Pre-parse a formula. This is used in conjunction with repeat_formula()
+# to repetitively rewrite a formula without re-parsing it.
+#
+sub store_formula {
+
+ my $self = shift;
+ my $formula = $_[0]; # The formula text string
+
+ # Strip the = sign at the beginning of the formula string
+ $formula =~ s(^=)();
+
+ # Parse the formula using the parser in Formula.pm
+ my $parser = $self->{_parser};
+
+ # In order to raise formula errors from the point of view of the calling
+ # program we use an eval block and re-raise the error from here.
+ #
+ my @tokens;
+ eval { @tokens = $parser->parse_formula($formula) };
+
+ if ($@) {
+ $@ =~ s/\n$//; # Strip the \n used in the Formula.pm die()
+ croak $@; # Re-raise the error
+ }
+
+
+ # Return the parsed tokens in an anonymous array
+ return [@tokens];
+}
+
+
+###############################################################################
+#
+# repeat_formula($row, $col, $formula, $format, ($pattern => $replacement,...))
+#
+# Write a formula to the specified row and column (zero indexed) by
+# substituting $pattern $replacement pairs in the $formula created via
+# store_formula(). This allows the user to repetitively rewrite a formula
+# without the significant overhead of parsing.
+#
+# Returns 0 : normal termination
+# -1 : insufficient number of arguments
+# -2 : row or column out of range
+#
+sub repeat_formula {
+
+ my $self = shift;
+
+ # Check for a cell reference in A1 notation and substitute row and column
+ if ($_[0] =~ /^\D/) {
+ @_ = $self->_substitute_cellref(@_);
+ }
+
+ if (@_ < 2) { return -1 } # Check the number of args
+
+ my $record = 0x0006; # Record identifier
+ my $length; # Bytes to follow
+
+ my $row = shift; # Zero indexed row
+ my $col = shift; # Zero indexed column
+ my $formula_ref = shift; # Array ref with formula tokens
+ my $format = shift; # XF format
+ my @pairs = @_; # Pattern/replacement pairs
+
+
+ # Enforce an even number of arguments in the pattern/replacement list
+ croak "Odd number of elements in pattern/replacement list" if @pairs %2;
+
+ # Check that $formula is an array ref
+ croak "Not a valid formula" if ref $formula_ref ne 'ARRAY';
+
+ my @tokens = @$formula_ref;
+
+ # Ensure that there are tokens to substitute
+ croak "No tokens in formula" unless @tokens;
+
+
+ # As a temporary and undocumented measure we allow the user to specify the
+ # result of the formula by appending a result => $value pair to the end
+ # of the arguments.
+ my $value = undef;
+ if ($pairs[-2] eq 'result') {
+ $value = pop @pairs;
+ pop @pairs;
+ }
+
+
+ while (@pairs) {
+ my $pattern = shift @pairs;
+ my $replace = shift @pairs;
+
+ foreach my $token (@tokens) {
+ last if $token =~ s/$pattern/$replace/;
+ }
+ }
+
+
+ # Change the parameters in the formula cached by the Formula.pm object
+ my $parser = $self->{_parser};
+ my $formula = $parser->parse_tokens(@tokens);
+
+ croak "Unrecognised token in formula" unless defined $formula;
+
+
+ my $xf = _XF($self, $row, $col, $format); # The cell format
+ my $chn = 0x0000; # Must be zero
+ my $is_string = 0; # Formula evaluates to str
+ my $num; # Current value of formula
+ my $grbit; # Option flags
+
+ # Excel normally stores the last calculated value of the formula in $num.
+ # Clearly we are not in a position to calculate this "a priori". Instead
+ # we set $num to zero and set the option flags in $grbit to ensure
+ # automatic calculation of the formula when the file is opened.
+ # As a workaround for some non-Excel apps we also allow the user to
+ # specify the result of the formula.
+ #
+ ($num, $grbit, $is_string) = $self->_encode_formula_result($value);
+
+ # Check that row and col are valid and store max and min values
+ return -2 if $self->_check_dimensions($row, $col);
+
+
+ my $formlen = length($formula); # Length of the binary string
+ $length = 0x16 + $formlen; # Length of the record data
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("vvv", $row, $col, $xf);
+ $data .= $num;
+ $data .= pack("vVv", $grbit, $chn, $formlen);
+
+
+ # The STRING record if the formula evaluates to a string.
+ my $string = '';
+ $string = $self->_get_formula_string($value) if $is_string;
+
+
+ # Store the data or write immediately depending on the compatibility mode.
+ if ($self->{_compatibility}) {
+ $self->{_table}->[$row]->[$col] = $header . $data . $formula . $string;
+ }
+ else {
+ $self->_append($header, $data, $formula, $string);
+ }
+
+ return 0;
+}
+
+
+###############################################################################
+#
+# write_url($row, $col, $url, $string, $format)
+#
+# Write a hyperlink. This is comprised of two elements: the visible label and
+# the invisible link. The visible label is the same as the link unless an
+# alternative string is specified.
+#
+# The parameters $string and $format are optional and their order is
+# interchangeable for backward compatibility reasons.
+#
+# The hyperlink can be to a http, ftp, mail, internal sheet, or external
+# directory url.
+#
+# Returns 0 : normal termination
+# -1 : insufficient number of arguments
+# -2 : row or column out of range
+# -3 : long string truncated to 255 chars
+#
+sub write_url {
+
+ my $self = shift;
+
+ # Check for a cell reference in A1 notation and substitute row and column
+ if ($_[0] =~ /^\D/) {
+ @_ = $self->_substitute_cellref(@_);
+ }
+
+ # Check the number of args
+ return -1 if @_ < 3;
+
+ # Add start row and col to arg list
+ return $self->write_url_range($_[0], $_[1], @_);
+}
+
+
+###############################################################################
+#
+# write_url_range($row1, $col1, $row2, $col2, $url, $string, $format)
+#
+# This is the more general form of write_url(). It allows a hyperlink to be
+# written to a range of cells. This function also decides the type of hyperlink
+# to be written. These are either, Web (http, ftp, mailto), Internal
+# (Sheet1!A1) or external ('c:\temp\foo.xls#Sheet1!A1').
+#
+# See also write_url() above for a general description and return values.
+#
+sub write_url_range {
+
+ my $self = shift;
+
+ # Check for a cell reference in A1 notation and substitute row and column
+ if ($_[0] =~ /^\D/) {
+ @_ = $self->_substitute_cellref(@_);
+ }
+
+ # Check the number of args
+ return -1 if @_ < 5;
+
+
+ # Reverse the order of $string and $format if necessary. We work on a copy
+ # in order to protect the callers args. We don't use "local @_" in case of
+ # perl50005 threads.
+ #
+ my @args = @_;
+
+ ($args[5], $args[6]) = ($args[6], $args[5]) if ref $args[5];
+
+ my $url = $args[4];
+
+
+ # Check for internal/external sheet links or default to web link
+ return $self->_write_url_internal(@args) if $url =~ m[^internal:];
+ return $self->_write_url_external(@args) if $url =~ m[^external:];
+ return $self->_write_url_web(@args);
+}
+
+
+###############################################################################
+#
+# _write_url_web($row1, $col1, $row2, $col2, $url, $string, $format)
+#
+# Used to write http, ftp and mailto hyperlinks.
+# The link type ($options) is 0x03 is the same as absolute dir ref without
+# sheet. However it is differentiated by the $unknown2 data stream.
+#
+# See also write_url() above for a general description and return values.
+#
+sub _write_url_web {
+
+ my $self = shift;
+
+ my $record = 0x01B8; # Record identifier
+ my $length = 0x00000; # Bytes to follow
+
+ my $row1 = $_[0]; # Start row
+ my $col1 = $_[1]; # Start column
+ my $row2 = $_[2]; # End row
+ my $col2 = $_[3]; # End column
+ my $url = $_[4]; # URL string
+ my $str = $_[5]; # Alternative label
+ my $xf = $_[6] || $self->{_url_format};# The cell format
+
+
+ # Write the visible label but protect against url recursion in write().
+ $str = $url unless defined $str;
+ $self->{_writing_url} = 1;
+ my $error = $self->write($row1, $col1, $str, $xf);
+ $self->{_writing_url} = 0;
+ return $error if $error == -2;
+
+
+ # Pack the undocumented parts of the hyperlink stream
+ my $unknown1 = pack("H*", "D0C9EA79F9BACE118C8200AA004BA90B02000000");
+ my $unknown2 = pack("H*", "E0C9EA79F9BACE118C8200AA004BA90B");
+
+
+ # Pack the option flags
+ my $options = pack("V", 0x03);
+
+
+ # URL encoding.
+ my $encoding = 0;
+
+ # Convert an Utf8 URL type and to a null terminated wchar string.
+ if ($] >= 5.008) {
+ require Encode;
+
+ if (Encode::is_utf8($url)) {
+ $url = Encode::encode("UTF-16LE", $url);
+ $url .= "\0\0"; # URL is null terminated.
+ $encoding = 1;
+ }
+ }
+
+ # Convert an Ascii URL type and to a null terminated wchar string.
+ if ($encoding == 0) {
+ $url .= "\0";
+ $url = pack 'v*', unpack 'c*', $url;
+ }
+
+
+ # Pack the length of the URL
+ my $url_len = pack("V", length($url));
+
+
+ # Calculate the data length
+ $length = 0x34 + length($url);
+
+
+ # Pack the header data
+ my $header = pack("vv", $record, $length);
+ my $data = pack("vvvv", $row1, $row2, $col1, $col2);
+
+
+ # Write the packed data
+ $self->_append( $header,
+ $data,
+ $unknown1,
+ $options,
+ $unknown2,
+ $url_len,
+ $url);
+
+ return $error;
+}
+
+
+###############################################################################
+#
+# _write_url_internal($row1, $col1, $row2, $col2, $url, $string, $format)
+#
+# Used to write internal reference hyperlinks such as "Sheet1!A1".
+#
+# See also write_url() above for a general description and return values.
+#
+sub _write_url_internal {
+
+ my $self = shift;
+
+ my $record = 0x01B8; # Record identifier
+ my $length = 0x00000; # Bytes to follow
+
+ my $row1 = $_[0]; # Start row
+ my $col1 = $_[1]; # Start column
+ my $row2 = $_[2]; # End row
+ my $col2 = $_[3]; # End column
+ my $url = $_[4]; # URL string
+ my $str = $_[5]; # Alternative label
+ my $xf = $_[6] || $self->{_url_format};# The cell format
+
+ # Strip URL type
+ $url =~ s[^internal:][];
+
+
+ # Write the visible label but protect against url recursion in write().
+ $str = $url unless defined $str;
+ $self->{_writing_url} = 1;
+ my $error = $self->write($row1, $col1, $str, $xf);
+ $self->{_writing_url} = 0;
+ return $error if $error == -2;
+
+
+ # Pack the undocumented parts of the hyperlink stream
+ my $unknown1 = pack("H*", "D0C9EA79F9BACE118C8200AA004BA90B02000000");
+
+
+ # Pack the option flags
+ my $options = pack("V", 0x08);
+
+
+ # URL encoding.
+ my $encoding = 0;
+
+
+ # Convert an Utf8 URL type and to a null terminated wchar string.
+ if ($] >= 5.008) {
+ require Encode;
+
+ if (Encode::is_utf8($url)) {
+ # Quote sheet name if not already, i.e., Sheet!A1 to 'Sheet!A1'.
+ $url =~ s/^(.+)!/'$1'!/ if not $url =~ /^'/;
+
+ $url = Encode::encode("UTF-16LE", $url);
+ $url .= "\0\0"; # URL is null terminated.
+ $encoding = 1;
+ }
+ }
+
+
+ # Convert an Ascii URL type and to a null terminated wchar string.
+ if ($encoding == 0) {
+ $url .= "\0";
+ $url = pack 'v*', unpack 'c*', $url;
+ }
+
+
+ # Pack the length of the URL as chars (not wchars)
+ my $url_len = pack("V", int(length($url)/2));
+
+
+ # Calculate the data length
+ $length = 0x24 + length($url);
+
+
+ # Pack the header data
+ my $header = pack("vv", $record, $length);
+ my $data = pack("vvvv", $row1, $row2, $col1, $col2);
+
+
+ # Write the packed data
+ $self->_append( $header,
+ $data,
+ $unknown1,
+ $options,
+ $url_len,
+ $url);
+
+ return $error;
+}
+
+
+###############################################################################
+#
+# _write_url_external($row1, $col1, $row2, $col2, $url, $string, $format)
+#
+# Write links to external directory names such as 'c:\foo.xls',
+# c:\foo.xls#Sheet1!A1', '../../foo.xls'. and '../../foo.xls#Sheet1!A1'.
+#
+# Note: Excel writes some relative links with the $dir_long string. We ignore
+# these cases for the sake of simpler code.
+#
+# See also write_url() above for a general description and return values.
+#
+sub _write_url_external {
+
+ my $self = shift;
+
+ # Network drives are different. We will handle them separately
+ # MS/Novell network drives and shares start with \\
+ return $self->_write_url_external_net(@_) if $_[4] =~ m[^external:\\\\];
+
+
+ my $record = 0x01B8; # Record identifier
+ my $length = 0x00000; # Bytes to follow
+
+ my $row1 = $_[0]; # Start row
+ my $col1 = $_[1]; # Start column
+ my $row2 = $_[2]; # End row
+ my $col2 = $_[3]; # End column
+ my $url = $_[4]; # URL string
+ my $str = $_[5]; # Alternative label
+ my $xf = $_[6] || $self->{_url_format};# The cell format
+
+
+ # Strip URL type and change Unix dir separator to Dos style (if needed)
+ #
+ $url =~ s[^external:][];
+ $url =~ s[/][\\]g;
+
+
+ # Write the visible label but protect against url recursion in write().
+ ($str = $url) =~ s[\#][ - ] unless defined $str;
+ $self->{_writing_url} = 1;
+ my $error = $self->write($row1, $col1, $str, $xf);
+ $self->{_writing_url} = 0;
+ return $error if $error == -2;
+
+
+ # Determine if the link is relative or absolute:
+ # Absolute if link starts with DOS drive specifier like C:
+ # Otherwise default to 0x00 for relative link.
+ #
+ my $absolute = 0x00;
+ $absolute = 0x02 if $url =~ m/^[A-Za-z]:/;
+
+
+ # Determine if the link contains a sheet reference and change some of the
+ # parameters accordingly.
+ # Split the dir name and sheet name (if it exists)
+ #
+ my ($dir_long , $sheet) = split /\#/, $url;
+ my $link_type = 0x01 | $absolute;
+ my $sheet_len;
+
+ if (defined $sheet) {
+ $link_type |= 0x08;
+ $sheet_len = pack("V", length($sheet) + 0x01);
+ $sheet = join("\0", split('', $sheet));
+ $sheet .= "\0\0\0";
+ }
+ else {
+ $sheet_len = '';
+ $sheet = '';
+ }
+
+
+ # Pack the link type
+ $link_type = pack("V", $link_type);
+
+
+ # Calculate the up-level dir count e.g. (..\..\..\ == 3)
+ my $up_count = 0;
+ $up_count++ while $dir_long =~ s[^\.\.\\][];
+ $up_count = pack("v", $up_count);
+
+
+ # Store the short dos dir name (null terminated)
+ my $dir_short = $dir_long . "\0";
+
+
+ # Store the long dir name as a wchar string (non-null terminated)
+ $dir_long = join("\0", split('', $dir_long));
+ $dir_long = $dir_long . "\0";
+
+
+ # Pack the lengths of the dir strings
+ my $dir_short_len = pack("V", length $dir_short );
+ my $dir_long_len = pack("V", length $dir_long );
+ my $stream_len = pack("V", length($dir_long) + 0x06);
+
+
+ # Pack the undocumented parts of the hyperlink stream
+ my $unknown1 =pack("H*",'D0C9EA79F9BACE118C8200AA004BA90B02000000' );
+ my $unknown2 =pack("H*",'0303000000000000C000000000000046' );
+ my $unknown3 =pack("H*",'FFFFADDE000000000000000000000000000000000000000');
+ my $unknown4 =pack("v", 0x03 );
+
+
+ # Pack the main data stream
+ my $data = pack("vvvv", $row1, $row2, $col1, $col2) .
+ $unknown1 .
+ $link_type .
+ $unknown2 .
+ $up_count .
+ $dir_short_len.
+ $dir_short .
+ $unknown3 .
+ $stream_len .
+ $dir_long_len .
+ $unknown4 .
+ $dir_long .
+ $sheet_len .
+ $sheet ;
+
+
+ # Pack the header data
+ $length = length $data;
+ my $header = pack("vv", $record, $length);
+
+
+ # Write the packed data
+ $self->_append($header, $data);
+
+ return $error;
+}
+
+
+
+
+###############################################################################
+#
+# _write_url_external_net($row1, $col1, $row2, $col2, $url, $string, $format)
+#
+# Write links to external MS/Novell network drives and shares such as
+# '//NETWORK/share/foo.xls' and '//NETWORK/share/foo.xls#Sheet1!A1'.
+#
+# See also write_url() above for a general description and return values.
+#
+sub _write_url_external_net {
+
+ my $self = shift;
+
+ my $record = 0x01B8; # Record identifier
+ my $length = 0x00000; # Bytes to follow
+
+ my $row1 = $_[0]; # Start row
+ my $col1 = $_[1]; # Start column
+ my $row2 = $_[2]; # End row
+ my $col2 = $_[3]; # End column
+ my $url = $_[4]; # URL string
+ my $str = $_[5]; # Alternative label
+ my $xf = $_[6] || $self->{_url_format};# The cell format
+
+
+ # Strip URL type and change Unix dir separator to Dos style (if needed)
+ #
+ $url =~ s[^external:][];
+ $url =~ s[/][\\]g;
+
+
+ # Write the visible label but protect against url recursion in write().
+ ($str = $url) =~ s[\#][ - ] unless defined $str;
+ $self->{_writing_url} = 1;
+ my $error = $self->write($row1, $col1, $str, $xf);
+ $self->{_writing_url} = 0;
+ return $error if $error == -2;
+
+
+ # Determine if the link contains a sheet reference and change some of the
+ # parameters accordingly.
+ # Split the dir name and sheet name (if it exists)
+ #
+ my ($dir_long , $sheet) = split /\#/, $url;
+ my $link_type = 0x0103; # Always absolute
+ my $sheet_len;
+
+ if (defined $sheet) {
+ $link_type |= 0x08;
+ $sheet_len = pack("V", length($sheet) + 0x01);
+ $sheet = join("\0", split('', $sheet));
+ $sheet .= "\0\0\0";
+ }
+ else {
+ $sheet_len = '';
+ $sheet = '';
+ }
+
+ # Pack the link type
+ $link_type = pack("V", $link_type);
+
+
+ # Make the string null terminated
+ $dir_long = $dir_long . "\0";
+
+
+ # Pack the lengths of the dir string
+ my $dir_long_len = pack("V", length $dir_long);
+
+
+ # Store the long dir name as a wchar string (non-null terminated)
+ $dir_long = join("\0", split('', $dir_long));
+ $dir_long = $dir_long . "\0";
+
+
+ # Pack the undocumented part of the hyperlink stream
+ my $unknown1 = pack("H*",'D0C9EA79F9BACE118C8200AA004BA90B02000000');
+
+
+ # Pack the main data stream
+ my $data = pack("vvvv", $row1, $row2, $col1, $col2) .
+ $unknown1 .
+ $link_type .
+ $dir_long_len .
+ $dir_long .
+ $sheet_len .
+ $sheet ;
+
+
+ # Pack the header data
+ $length = length $data;
+ my $header = pack("vv", $record, $length);
+
+
+ # Write the packed data
+ $self->_append($header, $data);
+
+ return $error;
+}
+
+
+###############################################################################
+#
+# write_date_time ($row, $col, $string, $format)
+#
+# Write a datetime string in ISO8601 "yyyy-mm-ddThh:mm:ss.ss" format as a
+# number representing an Excel date. $format is optional.
+#
+# Returns 0 : normal termination
+# -1 : insufficient number of arguments
+# -2 : row or column out of range
+# -3 : Invalid date_time, written as string
+#
+sub write_date_time {
+
+ my $self = shift;
+
+ # Check for a cell reference in A1 notation and substitute row and column
+ if ($_[0] =~ /^\D/) {
+ @_ = $self->_substitute_cellref(@_);
+ }
+
+ if (@_ < 3) { return -1 } # Check the number of args
+
+ my $row = $_[0]; # Zero indexed row
+ my $col = $_[1]; # Zero indexed column
+ my $str = $_[2];
+
+
+ # Check that row and col are valid and store max and min values
+ return -2 if $self->_check_dimensions($row, $col);
+
+ my $error = 0;
+ my $date_time = $self->convert_date_time($str);
+
+ if (defined $date_time) {
+ $error = $self->write_number($row, $col, $date_time, $_[3]);
+ }
+ else {
+ # The date isn't valid so write it as a string.
+ $self->write_string($row, $col, $str, $_[3]);
+ $error = -3;
+ }
+ return $error;
+}
+
+
+
+###############################################################################
+#
+# convert_date_time($date_time_string)
+#
+# The function takes a date and time in ISO8601 "yyyy-mm-ddThh:mm:ss.ss" format
+# and converts it to a decimal number representing a valid Excel date.
+#
+# Dates and times in Excel are represented by real numbers. The integer part of
+# the number stores the number of days since the epoch and the fractional part
+# stores the percentage of the day in seconds. The epoch can be either 1900 or
+# 1904.
+#
+# Parameter: Date and time string in one of the following formats:
+# yyyy-mm-ddThh:mm:ss.ss # Standard
+# yyyy-mm-ddT # Date only
+# Thh:mm:ss.ss # Time only
+#
+# Returns:
+# A decimal number representing a valid Excel date, or
+# undef if the date is invalid.
+#
+sub convert_date_time {
+
+ my $self = shift;
+ my $date_time = $_[0];
+
+ my $days = 0; # Number of days since epoch
+ my $seconds = 0; # Time expressed as fraction of 24h hours in seconds
+
+ my ($year, $month, $day);
+ my ($hour, $min, $sec);
+
+
+ # Strip leading and trailing whitespace.
+ $date_time =~ s/^\s+//;
+ $date_time =~ s/\s+$//;
+
+ # Check for invalid date char.
+ return if $date_time =~ /[^0-9T:\-\.Z]/;
+
+ # Check for "T" after date or before time.
+ return unless $date_time =~ /\dT|T\d/;
+
+ # Strip trailing Z in ISO8601 date.
+ $date_time =~ s/Z$//;
+
+
+ # Split into date and time.
+ my ($date, $time) = split /T/, $date_time;
+
+
+ # We allow the time portion of the input DateTime to be optional.
+ if ($time ne '') {
+ # Match hh:mm:ss.sss+ where the seconds are optional
+ if ($time =~ /^(\d\d):(\d\d)(:(\d\d(\.\d+)?))?/) {
+ $hour = $1;
+ $min = $2;
+ $sec = $4 || 0;
+ }
+ else {
+ return undef; # Not a valid time format.
+ }
+
+ # Some boundary checks
+ return if $hour >= 24;
+ return if $min >= 60;
+ return if $sec >= 60;
+
+ # Excel expresses seconds as a fraction of the number in 24 hours.
+ $seconds = ($hour *60*60 + $min *60 + $sec) / (24 *60 *60);
+ }
+
+
+ # We allow the date portion of the input DateTime to be optional.
+ return $seconds if $date eq '';
+
+
+ # Match date as yyyy-mm-dd.
+ if ($date =~ /^(\d\d\d\d)-(\d\d)-(\d\d)$/) {
+ $year = $1;
+ $month = $2;
+ $day = $3;
+ }
+ else {
+ return undef; # Not a valid date format.
+ }
+
+ # Set the epoch as 1900 or 1904. Defaults to 1900.
+ my $date_1904 = $self->{_1904};
+
+
+ # Special cases for Excel.
+ if (not $date_1904) {
+ return $seconds if $date eq '1899-12-31'; # Excel 1900 epoch
+ return $seconds if $date eq '1900-01-00'; # Excel 1900 epoch
+ return 60 + $seconds if $date eq '1900-02-29'; # Excel false leapday
+ }
+
+
+ # We calculate the date by calculating the number of days since the epoch
+ # and adjust for the number of leap days. We calculate the number of leap
+ # days by normalising the year in relation to the epoch. Thus the year 2000
+ # becomes 100 for 4 and 100 year leapdays and 400 for 400 year leapdays.
+ #
+ my $epoch = $date_1904 ? 1904 : 1900;
+ my $offset = $date_1904 ? 4 : 0;
+ my $norm = 300;
+ my $range = $year -$epoch;
+
+
+ # Set month days and check for leap year.
+ my @mdays = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
+ my $leap = 0;
+ $leap = 1 if $year % 4 == 0 and $year % 100 or $year % 400 == 0;
+ $mdays[1] = 29 if $leap;
+
+
+ # Some boundary checks
+ return if $year < $epoch or $year > 9999;
+ return if $month < 1 or $month > 12;
+ return if $day < 1 or $day > $mdays[$month -1];
+
+ # Accumulate the number of days since the epoch.
+ $days = $day; # Add days for current month
+ $days += $mdays[$_] for 0 .. $month -2; # Add days for past months
+ $days += $range *365; # Add days for past years
+ $days += int(($range) / 4); # Add leapdays
+ $days -= int(($range +$offset) /100); # Subtract 100 year leapdays
+ $days += int(($range +$offset +$norm)/400); # Add 400 year leapdays
+ $days -= $leap; # Already counted above
+
+
+ # Adjust for Excel erroneously treating 1900 as a leap year.
+ $days++ if $date_1904 == 0 and $days > 59;
+
+ return $days + $seconds;
+}
+
+
+
+
+
+###############################################################################
+#
+# set_row($row, $height, $XF, $hidden, $level)
+#
+# This method is used to set the height and XF format for a row.
+# Writes the BIFF record ROW.
+#
+sub set_row {
+
+ my $self = shift;
+ my $record = 0x0208; # Record identifier
+ my $length = 0x0010; # Number of bytes to follow
+
+ my $row = $_[0]; # Row Number
+ my $colMic = 0x0000; # First defined column
+ my $colMac = 0x0000; # Last defined column
+ my $miyRw; # Row height
+ my $irwMac = 0x0000; # Used by Excel to optimise loading
+ my $reserved = 0x0000; # Reserved
+ my $grbit = 0x0000; # Option flags
+ my $ixfe; # XF index
+ my $height = $_[1]; # Format object
+ my $format = $_[2]; # Format object
+ my $hidden = $_[3] || 0; # Hidden flag
+ my $level = $_[4] || 0; # Outline level
+ my $collapsed = $_[5] || 0; # Collapsed row
+
+
+ return unless defined $row; # Ensure at least $row is specified.
+
+ # Check that row and col are valid and store max and min values
+ return -2 if $self->_check_dimensions($row, 0, 0, 1);
+
+ # Check for a format object
+ if (ref $format) {
+ $ixfe = $format->get_xf_index();
+ }
+ else {
+ $ixfe = 0x0F;
+ }
+
+
+ # Set the row height in units of 1/20 of a point. Note, some heights may
+ # not be obtained exactly due to rounding in Excel.
+ #
+ if (defined $height) {
+ $miyRw = $height *20;
+ }
+ else {
+ $miyRw = 0xff; # The default row height
+ $height = 0;
+ }
+
+
+ # Set the limits for the outline levels (0 <= x <= 7).
+ $level = 0 if $level < 0;
+ $level = 7 if $level > 7;
+
+ $self->{_outline_row_level} = $level if $level >$self->{_outline_row_level};
+
+
+ # Set the options flags.
+ # 0x10: The fCollapsed flag indicates that the row contains the "+"
+ # when an outline group is collapsed.
+ # 0x20: The fDyZero height flag indicates a collapsed or hidden row.
+ # 0x40: The fUnsynced flag is used to show that the font and row heights
+ # are not compatible. This is usually the case for WriteExcel.
+ # 0x80: The fGhostDirty flag indicates that the row has been formatted.
+ #
+ $grbit |= $level;
+ $grbit |= 0x0010 if $collapsed;
+ $grbit |= 0x0020 if $hidden;
+ $grbit |= 0x0040;
+ $grbit |= 0x0080 if $format;
+ $grbit |= 0x0100;
+
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("vvvvvvvv", $row, $colMic, $colMac, $miyRw,
+ $irwMac,$reserved, $grbit, $ixfe);
+
+
+ # Store the data or write immediately depending on the compatibility mode.
+ if ($self->{_compatibility}) {
+ $self->{_row_data}->{$_[0]} = $header . $data;
+ }
+ else {
+ $self->_append($header, $data);
+ }
+
+
+ # Store the row sizes for use when calculating image vertices.
+ # Also store the column formats.
+ $self->{_row_sizes}->{$_[0]} = $height;
+ $self->{_row_formats}->{$_[0]} = $format if defined $format;
+}
+
+
+
+###############################################################################
+#
+# _write_row_default()
+#
+# Write a default row record, in compatibility mode, for rows that don't have
+# user specified values..
+#
+sub _write_row_default {
+
+ my $self = shift;
+ my $record = 0x0208; # Record identifier
+ my $length = 0x0010; # Number of bytes to follow
+
+ my $row = $_[0]; # Row Number
+ my $colMic = $_[1]; # First defined column
+ my $colMac = $_[2]; # Last defined column
+ my $miyRw = 0xFF; # Row height
+ my $irwMac = 0x0000; # Used by Excel to optimise loading
+ my $reserved = 0x0000; # Reserved
+ my $grbit = 0x0100; # Option flags
+ my $ixfe = 0x0F; # XF index
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("vvvvvvvv", $row, $colMic, $colMac, $miyRw,
+ $irwMac,$reserved, $grbit, $ixfe);
+
+ $self->_append($header, $data);
+}
+
+
+###############################################################################
+#
+# _check_dimensions($row, $col, $ignore_row, $ignore_col)
+#
+# Check that $row and $col are valid and store max and min values for use in
+# DIMENSIONS record. See, _store_dimensions().
+#
+# The $ignore_row/$ignore_col flags is used to indicate that we wish to
+# perform the dimension check without storing the value.
+#
+# The ignore flags are use by set_row() and data_validate.
+#
+sub _check_dimensions {
+
+ my $self = shift;
+ my $row = $_[0];
+ my $col = $_[1];
+ my $ignore_row = $_[2];
+ my $ignore_col = $_[3];
+
+
+ return -2 if not defined $row;
+ return -2 if $row >= $self->{_xls_rowmax};
+
+ return -2 if not defined $col;
+ return -2 if $col >= $self->{_xls_colmax};
+
+
+ if (not $ignore_row) {
+
+ if (not defined $self->{_dim_rowmin} or $row < $self->{_dim_rowmin}) {
+ $self->{_dim_rowmin} = $row;
+ }
+
+ if (not defined $self->{_dim_rowmax} or $row > $self->{_dim_rowmax}) {
+ $self->{_dim_rowmax} = $row;
+ }
+ }
+
+ if (not $ignore_col) {
+
+ if (not defined $self->{_dim_colmin} or $col < $self->{_dim_colmin}) {
+ $self->{_dim_colmin} = $col;
+ }
+
+ if (not defined $self->{_dim_colmax} or $col > $self->{_dim_colmax}) {
+ $self->{_dim_colmax} = $col;
+ }
+ }
+
+ return 0;
+}
+
+
+###############################################################################
+#
+# _store_dimensions()
+#
+# Writes Excel DIMENSIONS to define the area in which there is cell data.
+#
+# Notes:
+# Excel stores the max row/col as row/col +1.
+# Max and min values of 0 are used to indicate that no cell data.
+# We set the undef member data to 0 since it is used by _store_table().
+# Inserting images or charts doesn't change the DIMENSION data.
+#
+sub _store_dimensions {
+
+ my $self = shift;
+ my $record = 0x0200; # Record identifier
+ my $length = 0x000E; # Number of bytes to follow
+ my $row_min; # First row
+ my $row_max; # Last row plus 1
+ my $col_min; # First column
+ my $col_max; # Last column plus 1
+ my $reserved = 0x0000; # Reserved by Excel
+
+ if (defined $self->{_dim_rowmin}) {$row_min = $self->{_dim_rowmin} }
+ else {$row_min = 0 }
+
+ if (defined $self->{_dim_rowmax}) {$row_max = $self->{_dim_rowmax} + 1}
+ else {$row_max = 0 }
+
+ if (defined $self->{_dim_colmin}) {$col_min = $self->{_dim_colmin} }
+ else {$col_min = 0 }
+
+ if (defined $self->{_dim_colmax}) {$col_max = $self->{_dim_colmax} + 1}
+ else {$col_max = 0 }
+
+
+ # Set member data to the new max/min value for use by _store_table().
+ $self->{_dim_rowmin} = $row_min;
+ $self->{_dim_rowmax} = $row_max;
+ $self->{_dim_colmin} = $col_min;
+ $self->{_dim_colmax} = $col_max;
+
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("VVvvv", $row_min, $row_max,
+ $col_min, $col_max, $reserved);
+ $self->_prepend($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_window2()
+#
+# Write BIFF record Window2.
+#
+sub _store_window2 {
+
+ use integer; # Avoid << shift bug in Perl 5.6.0 on HP-UX
+
+ my $self = shift;
+ my $record = 0x023E; # Record identifier
+ my $length = 0x0012; # Number of bytes to follow
+
+ my $grbit = 0x00B6; # Option flags
+ my $rwTop = $self->{_first_row}; # Top visible row
+ my $colLeft = $self->{_first_col}; # Leftmost visible column
+ my $rgbHdr = 0x00000040; # Row/col heading, grid color
+
+ my $wScaleSLV = 0x0000; # Zoom in page break preview
+ my $wScaleNormal = 0x0000; # Zoom in normal view
+ my $reserved = 0x00000000;
+
+
+ # The options flags that comprise $grbit
+ my $fDspFmla = $self->{_display_formulas}; # 0 - bit
+ my $fDspGrid = $self->{_screen_gridlines}; # 1
+ my $fDspRwCol = $self->{_display_headers}; # 2
+ my $fFrozen = $self->{_frozen}; # 3
+ my $fDspZeros = $self->{_display_zeros}; # 4
+ my $fDefaultHdr = 1; # 5
+ my $fArabic = $self->{_display_arabic}; # 6
+ my $fDspGuts = $self->{_outline_on}; # 7
+ my $fFrozenNoSplit = $self->{_frozen_no_split}; # 0 - bit
+ my $fSelected = $self->{_selected}; # 1
+ my $fPaged = $self->{_active}; # 2
+ my $fBreakPreview = 0; # 3
+
+ $grbit = $fDspFmla;
+ $grbit |= $fDspGrid << 1;
+ $grbit |= $fDspRwCol << 2;
+ $grbit |= $fFrozen << 3;
+ $grbit |= $fDspZeros << 4;
+ $grbit |= $fDefaultHdr << 5;
+ $grbit |= $fArabic << 6;
+ $grbit |= $fDspGuts << 7;
+ $grbit |= $fFrozenNoSplit << 8;
+ $grbit |= $fSelected << 9;
+ $grbit |= $fPaged << 10;
+ $grbit |= $fBreakPreview << 11;
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("vvvVvvV", $grbit, $rwTop, $colLeft, $rgbHdr,
+ $wScaleSLV, $wScaleNormal, $reserved );
+
+ $self->_append($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_page_view()
+#
+# Set page view mode. Only applicable to Mac Excel.
+#
+sub _store_page_view {
+
+ my $self = shift;
+
+ return unless $self->{_page_view};
+
+ my $data = pack "H*", 'C8081100C808000000000040000000000900000000';
+
+ $self->_append($data);
+}
+
+
+###############################################################################
+#
+# _store_tab_color()
+#
+# Write the Tab Color BIFF record.
+#
+sub _store_tab_color {
+
+ my $self = shift;
+ my $color = $self->{_tab_color};
+
+ return unless $color;
+
+ my $record = 0x0862; # Record identifier
+ my $length = 0x0014; # Number of bytes to follow
+
+ my $zero = 0x0000;
+ my $unknown = 0x0014;
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("vvvvvvvvvv", $record, $zero, $zero, $zero, $zero,
+ $zero, $unknown, $zero, $color, $zero);
+
+ $self->_append($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_defrow()
+#
+# Write BIFF record DEFROWHEIGHT.
+#
+sub _store_defrow {
+
+ my $self = shift;
+ my $record = 0x0225; # Record identifier
+ my $length = 0x0004; # Number of bytes to follow
+
+ my $grbit = 0x0000; # Options.
+ my $height = 0x00FF; # Default row height
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("vv", $grbit, $height);
+
+ $self->_prepend($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_defcol()
+#
+# Write BIFF record DEFCOLWIDTH.
+#
+sub _store_defcol {
+
+ my $self = shift;
+ my $record = 0x0055; # Record identifier
+ my $length = 0x0002; # Number of bytes to follow
+
+ my $colwidth = 0x0008; # Default column width
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("v", $colwidth);
+
+ $self->_prepend($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_colinfo($firstcol, $lastcol, $width, $format, $hidden)
+#
+# Write BIFF record COLINFO to define column widths
+#
+# Note: The SDK says the record length is 0x0B but Excel writes a 0x0C
+# length record.
+#
+sub _store_colinfo {
+
+ my $self = shift;
+ my $record = 0x007D; # Record identifier
+ my $length = 0x000B; # Number of bytes to follow
+
+ my $colFirst = $_[0] || 0; # First formatted column
+ my $colLast = $_[1] || 0; # Last formatted column
+ my $width = $_[2] || 8.43; # Col width in user units, 8.43 is default
+ my $coldx; # Col width in internal units
+ my $pixels; # Col width in pixels
+
+ # Excel rounds the column width to the nearest pixel. Therefore we first
+ # convert to pixels and then to the internal units. The pixel to users-units
+ # relationship is different for values less than 1.
+ #
+ if ($width < 1) {
+ $pixels = int($width *12);
+ }
+ else {
+ $pixels = int($width *7 ) +5;
+ }
+
+ $coldx = int($pixels *256/7);
+
+
+ my $ixfe; # XF index
+ my $grbit = 0x0000; # Option flags
+ my $reserved = 0x00; # Reserved
+ my $format = $_[3]; # Format object
+ my $hidden = $_[4] || 0; # Hidden flag
+ my $level = $_[5] || 0; # Outline level
+ my $collapsed = $_[6] || 0; # Outline level
+
+
+ # Check for a format object
+ if (ref $format) {
+ $ixfe = $format->get_xf_index();
+ }
+ else {
+ $ixfe = 0x0F;
+ }
+
+
+ # Set the limits for the outline levels (0 <= x <= 7).
+ $level = 0 if $level < 0;
+ $level = 7 if $level > 7;
+
+
+ # Set the options flags. (See set_row() for more details).
+ $grbit |= 0x0001 if $hidden;
+ $grbit |= $level << 8;
+ $grbit |= 0x1000 if $collapsed;
+
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("vvvvvC", $colFirst, $colLast, $coldx,
+ $ixfe, $grbit, $reserved);
+
+ $self->_prepend($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_filtermode()
+#
+# Write BIFF record FILTERMODE to indicate that the worksheet contains
+# AUTOFILTER record, ie. autofilters with a filter set.
+#
+sub _store_filtermode {
+
+ my $self = shift;
+
+ my $record = 0x009B; # Record identifier
+ my $length = 0x0000; # Number of bytes to follow
+
+ # Only write the record if the worksheet contains a filtered autofilter.
+ return unless $self->{_filter_on};
+
+ my $header = pack("vv", $record, $length);
+
+ $self->_prepend($header);
+}
+
+
+###############################################################################
+#
+# _store_autofilterinfo()
+#
+# Write BIFF record AUTOFILTERINFO.
+#
+sub _store_autofilterinfo {
+
+ my $self = shift;
+
+ my $record = 0x009D; # Record identifier
+ my $length = 0x0002; # Number of bytes to follow
+ my $num_filters = $self->{_filter_count};
+
+ # Only write the record if the worksheet contains an autofilter.
+ return unless $self->{_filter_count};
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("v", $num_filters);
+
+ $self->_prepend($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_selection($first_row, $first_col, $last_row, $last_col)
+#
+# Write BIFF record SELECTION.
+#
+sub _store_selection {
+
+ my $self = shift;
+ my $record = 0x001D; # Record identifier
+ my $length = 0x000F; # Number of bytes to follow
+
+ my $pnn = $self->{_active_pane}; # Pane position
+ my $rwAct = $_[0]; # Active row
+ my $colAct = $_[1]; # Active column
+ my $irefAct = 0; # Active cell ref
+ my $cref = 1; # Number of refs
+
+ my $rwFirst = $_[0]; # First row in reference
+ my $colFirst = $_[1]; # First col in reference
+ my $rwLast = $_[2] || $rwFirst; # Last row in reference
+ my $colLast = $_[3] || $colFirst; # Last col in reference
+
+ # Swap last row/col for first row/col as necessary
+ if ($rwFirst > $rwLast) {
+ ($rwFirst, $rwLast) = ($rwLast, $rwFirst);
+ }
+
+ if ($colFirst > $colLast) {
+ ($colFirst, $colLast) = ($colLast, $colFirst);
+ }
+
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("CvvvvvvCC", $pnn, $rwAct, $colAct,
+ $irefAct, $cref,
+ $rwFirst, $rwLast,
+ $colFirst, $colLast);
+
+ $self->_append($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_externcount($count)
+#
+# Write BIFF record EXTERNCOUNT to indicate the number of external sheet
+# references in a worksheet.
+#
+# Excel only stores references to external sheets that are used in formulas.
+# For simplicity we store references to all the sheets in the workbook
+# regardless of whether they are used or not. This reduces the overall
+# complexity and eliminates the need for a two way dialogue between the formula
+# parser the worksheet objects.
+#
+sub _store_externcount {
+
+ my $self = shift;
+ my $record = 0x0016; # Record identifier
+ my $length = 0x0002; # Number of bytes to follow
+
+ my $cxals = $_[0]; # Number of external references
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("v", $cxals);
+
+ $self->_prepend($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_externsheet($sheetname)
+#
+#
+# Writes the Excel BIFF EXTERNSHEET record. These references are used by
+# formulas. A formula references a sheet name via an index. Since we store a
+# reference to all of the external worksheets the EXTERNSHEET index is the same
+# as the worksheet index.
+#
+sub _store_externsheet {
+
+ my $self = shift;
+
+ my $record = 0x0017; # Record identifier
+ my $length; # Number of bytes to follow
+
+ my $sheetname = $_[0]; # Worksheet name
+ my $cch; # Length of sheet name
+ my $rgch; # Filename encoding
+
+ # References to the current sheet are encoded differently to references to
+ # external sheets.
+ #
+ if ($self->{_name} eq $sheetname) {
+ $sheetname = '';
+ $length = 0x02; # The following 2 bytes
+ $cch = 1; # The following byte
+ $rgch = 0x02; # Self reference
+ }
+ else {
+ $length = 0x02 + length($_[0]);
+ $cch = length($sheetname);
+ $rgch = 0x03; # Reference to a sheet in the current workbook
+ }
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("CC", $cch, $rgch);
+
+ $self->_prepend($header, $data, $sheetname);
+}
+
+
+###############################################################################
+#
+# _store_panes()
+#
+#
+# Writes the Excel BIFF PANE record.
+# The panes can either be frozen or thawed (unfrozen).
+# Frozen panes are specified in terms of a integer number of rows and columns.
+# Thawed panes are specified in terms of Excel's units for rows and columns.
+#
+sub _store_panes {
+
+ my $self = shift;
+ my $record = 0x0041; # Record identifier
+ my $length = 0x000A; # Number of bytes to follow
+
+ my $y = $_[0] || 0; # Vertical split position
+ my $x = $_[1] || 0; # Horizontal split position
+ my $rwTop = $_[2]; # Top row visible
+ my $colLeft = $_[3]; # Leftmost column visible
+ my $no_split = $_[4]; # No used here.
+ my $pnnAct = $_[5]; # Active pane
+
+
+ # Code specific to frozen or thawed panes.
+ if ($self->{_frozen}) {
+ # Set default values for $rwTop and $colLeft
+ $rwTop = $y unless defined $rwTop;
+ $colLeft = $x unless defined $colLeft;
+ }
+ else {
+ # Set default values for $rwTop and $colLeft
+ $rwTop = 0 unless defined $rwTop;
+ $colLeft = 0 unless defined $colLeft;
+
+ # Convert Excel's row and column units to the internal units.
+ # The default row height is 12.75
+ # The default column width is 8.43
+ # The following slope and intersection values were interpolated.
+ #
+ $y = 20*$y + 255;
+ $x = 113.879*$x + 390;
+ }
+
+
+ # Determine which pane should be active. There is also the undocumented
+ # option to override this should it be necessary: may be removed later.
+ #
+ if (not defined $pnnAct) {
+ $pnnAct = 0 if ($x != 0 && $y != 0); # Bottom right
+ $pnnAct = 1 if ($x != 0 && $y == 0); # Top right
+ $pnnAct = 2 if ($x == 0 && $y != 0); # Bottom left
+ $pnnAct = 3 if ($x == 0 && $y == 0); # Top left
+ }
+
+ $self->{_active_pane} = $pnnAct; # Used in _store_selection
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("vvvvv", $x, $y, $rwTop, $colLeft, $pnnAct);
+
+ $self->_append($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_setup()
+#
+# Store the page setup SETUP BIFF record.
+#
+sub _store_setup {
+
+ use integer; # Avoid << shift bug in Perl 5.6.0 on HP-UX
+
+ my $self = shift;
+ my $record = 0x00A1; # Record identifier
+ my $length = 0x0022; # Number of bytes to follow
+
+
+ my $iPaperSize = $self->{_paper_size}; # Paper size
+ my $iScale = $self->{_print_scale}; # Print scaling factor
+ my $iPageStart = $self->{_page_start}; # Starting page number
+ my $iFitWidth = $self->{_fit_width}; # Fit to number of pages wide
+ my $iFitHeight = $self->{_fit_height}; # Fit to number of pages high
+ my $grbit = 0x00; # Option flags
+ my $iRes = 0x0258; # Print resolution
+ my $iVRes = 0x0258; # Vertical print resolution
+ my $numHdr = $self->{_margin_header}; # Header Margin
+ my $numFtr = $self->{_margin_footer}; # Footer Margin
+ my $iCopies = 0x01; # Number of copies
+
+
+ my $fLeftToRight = $self->{_page_order}; # Print over then down
+ my $fLandscape = $self->{_orientation}; # Page orientation
+ my $fNoPls = 0x0; # Setup not read from printer
+ my $fNoColor = $self->{_black_white}; # Print black and white
+ my $fDraft = $self->{_draft_quality}; # Print draft quality
+ my $fNotes = $self->{_print_comments};# Print notes
+ my $fNoOrient = 0x0; # Orientation not set
+ my $fUsePage = $self->{_custom_start}; # Use custom starting page
+
+
+ $grbit = $fLeftToRight;
+ $grbit |= $fLandscape << 1;
+ $grbit |= $fNoPls << 2;
+ $grbit |= $fNoColor << 3;
+ $grbit |= $fDraft << 4;
+ $grbit |= $fNotes << 5;
+ $grbit |= $fNoOrient << 6;
+ $grbit |= $fUsePage << 7;
+
+
+ $numHdr = pack("d", $numHdr);
+ $numFtr = pack("d", $numFtr);
+
+ if ($self->{_byte_order}) {
+ $numHdr = reverse $numHdr;
+ $numFtr = reverse $numFtr;
+ }
+
+ my $header = pack("vv", $record, $length);
+ my $data1 = pack("vvvvvvvv", $iPaperSize,
+ $iScale,
+ $iPageStart,
+ $iFitWidth,
+ $iFitHeight,
+ $grbit,
+ $iRes,
+ $iVRes);
+ my $data2 = $numHdr .$numFtr;
+ my $data3 = pack("v", $iCopies);
+
+ $self->_prepend($header, $data1, $data2, $data3);
+
+}
+
+###############################################################################
+#
+# _store_header()
+#
+# Store the header caption BIFF record.
+#
+sub _store_header {
+
+ my $self = shift;
+
+ my $record = 0x0014; # Record identifier
+ my $length; # Bytes to follow
+
+ my $str = $self->{_header}; # header string
+ my $cch = length($str); # Length of header string
+ my $encoding = $self->{_header_encoding}; # Character encoding
+
+
+ # Character length is num of chars not num of bytes
+ $cch /= 2 if $encoding;
+
+ # Change the UTF-16 name from BE to LE
+ $str = pack 'n*', unpack 'v*', $str if $encoding;
+
+ $length = 3 + length($str);
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("vC", $cch, $encoding);
+
+ $self->_prepend($header, $data, $str);
+}
+
+
+###############################################################################
+#
+# _store_footer()
+#
+# Store the footer caption BIFF record.
+#
+sub _store_footer {
+
+ my $self = shift;
+
+ my $record = 0x0015; # Record identifier
+ my $length; # Bytes to follow
+
+ my $str = $self->{_footer}; # footer string
+ my $cch = length($str); # Length of footer string
+ my $encoding = $self->{_footer_encoding}; # Character encoding
+
+
+ # Character length is num of chars not num of bytes
+ $cch /= 2 if $encoding;
+
+ # Change the UTF-16 name from BE to LE
+ $str = pack 'n*', unpack 'v*', $str if $encoding;
+
+ $length = 3 + length($str);
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("vC", $cch, $encoding);
+
+ $self->_prepend($header, $data, $str);
+}
+
+
+###############################################################################
+#
+# _store_hcenter()
+#
+# Store the horizontal centering HCENTER BIFF record.
+#
+sub _store_hcenter {
+
+ my $self = shift;
+
+ my $record = 0x0083; # Record identifier
+ my $length = 0x0002; # Bytes to follow
+
+ my $fHCenter = $self->{_hcenter}; # Horizontal centering
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("v", $fHCenter);
+
+ $self->_prepend($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_vcenter()
+#
+# Store the vertical centering VCENTER BIFF record.
+#
+sub _store_vcenter {
+
+ my $self = shift;
+
+ my $record = 0x0084; # Record identifier
+ my $length = 0x0002; # Bytes to follow
+
+ my $fVCenter = $self->{_vcenter}; # Horizontal centering
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("v", $fVCenter);
+
+ $self->_prepend($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_margin_left()
+#
+# Store the LEFTMARGIN BIFF record.
+#
+sub _store_margin_left {
+
+ my $self = shift;
+
+ my $record = 0x0026; # Record identifier
+ my $length = 0x0008; # Bytes to follow
+
+ my $margin = $self->{_margin_left}; # Margin in inches
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("d", $margin);
+
+ if ($self->{_byte_order}) { $data = reverse $data }
+
+ $self->_prepend($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_margin_right()
+#
+# Store the RIGHTMARGIN BIFF record.
+#
+sub _store_margin_right {
+
+ my $self = shift;
+
+ my $record = 0x0027; # Record identifier
+ my $length = 0x0008; # Bytes to follow
+
+ my $margin = $self->{_margin_right}; # Margin in inches
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("d", $margin);
+
+ if ($self->{_byte_order}) { $data = reverse $data }
+
+ $self->_prepend($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_margin_top()
+#
+# Store the TOPMARGIN BIFF record.
+#
+sub _store_margin_top {
+
+ my $self = shift;
+
+ my $record = 0x0028; # Record identifier
+ my $length = 0x0008; # Bytes to follow
+
+ my $margin = $self->{_margin_top}; # Margin in inches
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("d", $margin);
+
+ if ($self->{_byte_order}) { $data = reverse $data }
+
+ $self->_prepend($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_margin_bottom()
+#
+# Store the BOTTOMMARGIN BIFF record.
+#
+sub _store_margin_bottom {
+
+ my $self = shift;
+
+ my $record = 0x0029; # Record identifier
+ my $length = 0x0008; # Bytes to follow
+
+ my $margin = $self->{_margin_bottom}; # Margin in inches
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("d", $margin);
+
+ if ($self->{_byte_order}) { $data = reverse $data }
+
+ $self->_prepend($header, $data);
+}
+
+
+###############################################################################
+#
+# merge_cells($first_row, $first_col, $last_row, $last_col)
+#
+# This is an Excel97/2000 method. It is required to perform more complicated
+# merging than the normal align merge in Format.pm
+#
+sub merge_cells {
+
+ my $self = shift;
+
+ # Check for a cell reference in A1 notation and substitute row and column
+ if ($_[0] =~ /^\D/) {
+ @_ = $self->_substitute_cellref(@_);
+ }
+
+ my $record = 0x00E5; # Record identifier
+ my $length = 0x000A; # Bytes to follow
+
+ my $cref = 1; # Number of refs
+ my $rwFirst = $_[0]; # First row in reference
+ my $colFirst = $_[1]; # First col in reference
+ my $rwLast = $_[2] || $rwFirst; # Last row in reference
+ my $colLast = $_[3] || $colFirst; # Last col in reference
+
+
+ # Excel doesn't allow a single cell to be merged
+ return if $rwFirst == $rwLast and $colFirst == $colLast;
+
+ # Swap last row/col with first row/col as necessary
+ ($rwFirst, $rwLast ) = ($rwLast, $rwFirst ) if $rwFirst > $rwLast;
+ ($colFirst, $colLast) = ($colLast, $colFirst) if $colFirst > $colLast;
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("vvvvv", $cref,
+ $rwFirst, $rwLast,
+ $colFirst, $colLast);
+
+ $self->_append($header, $data);
+}
+
+
+###############################################################################
+#
+# merge_range($row1, $col1, $row2, $col2, $string, $format, $encoding)
+#
+# This is a wrapper to ensure correct use of the merge_cells method, i.e., write
+# the first cell of the range, write the formatted blank cells in the range and
+# then call the merge_cells record. Failing to do the steps in this order will
+# cause Excel 97 to crash.
+#
+sub merge_range {
+
+ my $self = shift;
+
+ # Check for a cell reference in A1 notation and substitute row and column
+ if ($_[0] =~ /^\D/) {
+ @_ = $self->_substitute_cellref(@_);
+ }
+ croak "Incorrect number of arguments" if @_ != 6 and @_ != 7;
+ croak "Format argument is not a format object" unless ref $_[5];
+
+ my $rwFirst = $_[0];
+ my $colFirst = $_[1];
+ my $rwLast = $_[2];
+ my $colLast = $_[3];
+ my $string = $_[4];
+ my $format = $_[5];
+ my $encoding = $_[6] ? 1 : 0;
+
+
+ # Temp code to prevent merged formats in non-merged cells.
+ my $error = "Error: refer to merge_range() in the documentation. " .
+ "Can't use previously non-merged format in merged cells";
+
+ croak $error if $format->{_used_merge} == -1;
+ $format->{_used_merge} = 0; # Until the end of this function.
+
+
+ # Set the merge_range property of the format object. For BIFF8+.
+ $format->set_merge_range();
+
+ # Excel doesn't allow a single cell to be merged
+ croak "Can't merge single cell" if $rwFirst == $rwLast and
+ $colFirst == $colLast;
+
+ # Swap last row/col with first row/col as necessary
+ ($rwFirst, $rwLast ) = ($rwLast, $rwFirst ) if $rwFirst > $rwLast;
+ ($colFirst, $colLast) = ($colLast, $colFirst) if $colFirst > $colLast;
+
+ # Write the first cell
+ if ($encoding) {
+ $self->write_utf16be_string($rwFirst, $colFirst, $string, $format);
+ }
+ else {
+ $self->write ($rwFirst, $colFirst, $string, $format);
+ }
+
+ # Pad out the rest of the area with formatted blank cells.
+ for my $row ($rwFirst .. $rwLast) {
+ for my $col ($colFirst .. $colLast) {
+ next if $row == $rwFirst and $col == $colFirst;
+ $self->write_blank($row, $col, $format);
+ }
+ }
+
+ $self->merge_cells($rwFirst, $colFirst, $rwLast, $colLast);
+
+ # Temp code to prevent merged formats in non-merged cells.
+ $format->{_used_merge} = 1;
+
+}
+
+
+###############################################################################
+#
+# _store_print_headers()
+#
+# Write the PRINTHEADERS BIFF record.
+#
+sub _store_print_headers {
+
+ my $self = shift;
+
+ my $record = 0x002a; # Record identifier
+ my $length = 0x0002; # Bytes to follow
+
+ my $fPrintRwCol = $self->{_print_headers}; # Boolean flag
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("v", $fPrintRwCol);
+
+ $self->_prepend($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_print_gridlines()
+#
+# Write the PRINTGRIDLINES BIFF record. Must be used in conjunction with the
+# GRIDSET record.
+#
+sub _store_print_gridlines {
+
+ my $self = shift;
+
+ my $record = 0x002b; # Record identifier
+ my $length = 0x0002; # Bytes to follow
+
+ my $fPrintGrid = $self->{_print_gridlines}; # Boolean flag
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("v", $fPrintGrid);
+
+ $self->_prepend($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_gridset()
+#
+# Write the GRIDSET BIFF record. Must be used in conjunction with the
+# PRINTGRIDLINES record.
+#
+sub _store_gridset {
+
+ my $self = shift;
+
+ my $record = 0x0082; # Record identifier
+ my $length = 0x0002; # Bytes to follow
+
+ my $fGridSet = not $self->{_print_gridlines}; # Boolean flag
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("v", $fGridSet);
+
+ $self->_prepend($header, $data);
+
+}
+
+
+###############################################################################
+#
+# _store_guts()
+#
+# Write the GUTS BIFF record. This is used to configure the gutter margins
+# where Excel outline symbols are displayed. The visibility of the gutters is
+# controlled by a flag in WSBOOL. See also _store_wsbool().
+#
+# We are all in the gutter but some of us are looking at the stars.
+#
+sub _store_guts {
+
+ my $self = shift;
+
+ my $record = 0x0080; # Record identifier
+ my $length = 0x0008; # Bytes to follow
+
+ my $dxRwGut = 0x0000; # Size of row gutter
+ my $dxColGut = 0x0000; # Size of col gutter
+
+ my $row_level = $self->{_outline_row_level};
+ my $col_level = 0;
+
+
+ # Calculate the maximum column outline level. The equivalent calculation
+ # for the row outline level is carried out in set_row().
+ #
+ foreach my $colinfo (@{$self->{_colinfo}}) {
+ # Skip cols without outline level info.
+ next if @{$colinfo} < 6;
+ $col_level = @{$colinfo}[5] if @{$colinfo}[5] > $col_level;
+ }
+
+
+ # Set the limits for the outline levels (0 <= x <= 7).
+ $col_level = 0 if $col_level < 0;
+ $col_level = 7 if $col_level > 7;
+
+
+ # The displayed level is one greater than the max outline levels
+ $row_level++ if $row_level > 0;
+ $col_level++ if $col_level > 0;
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("vvvv", $dxRwGut, $dxColGut, $row_level, $col_level);
+
+ $self->_prepend($header, $data);
+
+}
+
+
+###############################################################################
+#
+# _store_wsbool()
+#
+# Write the WSBOOL BIFF record, mainly for fit-to-page. Used in conjunction
+# with the SETUP record.
+#
+sub _store_wsbool {
+
+ my $self = shift;
+
+ my $record = 0x0081; # Record identifier
+ my $length = 0x0002; # Bytes to follow
+
+ my $grbit = 0x0000; # Option flags
+
+ # Set the option flags
+ $grbit |= 0x0001; # Auto page breaks visible
+ $grbit |= 0x0020 if $self->{_outline_style}; # Auto outline styles
+ $grbit |= 0x0040 if $self->{_outline_below}; # Outline summary below
+ $grbit |= 0x0080 if $self->{_outline_right}; # Outline summary right
+ $grbit |= 0x0100 if $self->{_fit_page}; # Page setup fit to page
+ $grbit |= 0x0400 if $self->{_outline_on}; # Outline symbols displayed
+
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("v", $grbit);
+
+ $self->_prepend($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_hbreak()
+#
+# Write the HORIZONTALPAGEBREAKS BIFF record.
+#
+sub _store_hbreak {
+
+ my $self = shift;
+
+ # Return if the user hasn't specified pagebreaks
+ return unless @{$self->{_hbreaks}};
+
+ # Sort and filter array of page breaks
+ my @breaks = $self->_sort_pagebreaks(@{$self->{_hbreaks}});
+
+ my $record = 0x001b; # Record identifier
+ my $cbrk = scalar @breaks; # Number of page breaks
+ my $length = 2 + 6*$cbrk; # Bytes to follow
+
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("v", $cbrk);
+
+ # Append each page break
+ foreach my $break (@breaks) {
+ $data .= pack("vvv", $break, 0x0000, 0x00ff);
+ }
+
+ $self->_prepend($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_vbreak()
+#
+# Write the VERTICALPAGEBREAKS BIFF record.
+#
+sub _store_vbreak {
+
+ my $self = shift;
+
+ # Return if the user hasn't specified pagebreaks
+ return unless @{$self->{_vbreaks}};
+
+ # Sort and filter array of page breaks
+ my @breaks = $self->_sort_pagebreaks(@{$self->{_vbreaks}});
+
+ my $record = 0x001a; # Record identifier
+ my $cbrk = scalar @breaks; # Number of page breaks
+ my $length = 2 + 6*$cbrk; # Bytes to follow
+
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("v", $cbrk);
+
+ # Append each page break
+ foreach my $break (@breaks) {
+ $data .= pack("vvv", $break, 0x0000, 0xffff);
+ }
+
+ $self->_prepend($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_protect()
+#
+# Set the Biff PROTECT record to indicate that the worksheet is protected.
+#
+sub _store_protect {
+
+ my $self = shift;
+
+ # Exit unless sheet protection has been specified
+ return unless $self->{_protect};
+
+ my $record = 0x0012; # Record identifier
+ my $length = 0x0002; # Bytes to follow
+
+ my $fLock = $self->{_protect}; # Worksheet is protected
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("v", $fLock);
+
+ $self->_prepend($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_obj_protect()
+#
+# Set the Biff OBJPROTECT record to indicate that objects are protected.
+#
+sub _store_obj_protect {
+
+ my $self = shift;
+
+ # Exit unless sheet protection has been specified
+ return unless $self->{_protect};
+
+ my $record = 0x0063; # Record identifier
+ my $length = 0x0002; # Bytes to follow
+
+ my $fLock = $self->{_protect}; # Worksheet is protected
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("v", $fLock);
+
+ $self->_prepend($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_password()
+#
+# Write the worksheet PASSWORD record.
+#
+sub _store_password {
+
+ my $self = shift;
+
+ # Exit unless sheet protection and password have been specified
+ return unless $self->{_protect} and defined $self->{_password};
+
+ my $record = 0x0013; # Record identifier
+ my $length = 0x0002; # Bytes to follow
+
+ my $wPassword = $self->{_password}; # Encoded password
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("v", $wPassword);
+
+ $self->_prepend($header, $data);
+}
+
+
+#
+# Note about compatibility mode.
+#
+# Excel doesn't require every possible Biff record to be present in a file.
+# In particular if the indexing records INDEX, ROW and DBCELL aren't present
+# it just ignores the fact and reads the cells anyway. This is also true of
+# the EXTSST record. Gnumeric and OOo also take this approach. This allows
+# WriteExcel to ignore these records in order to minimise the amount of data
+# stored in memory. However, other third party applications that read Excel
+# files often expect these records to be present. In "compatibility mode"
+# WriteExcel writes these records and tries to be as close to an Excel
+# generated file as possible.
+#
+# This requires additional data to be stored in memory until the file is
+# about to be written. This incurs a memory and speed penalty and may not be
+# suitable for very large files.
+#
+
+
+
+###############################################################################
+#
+# _store_table()
+#
+# Write cell data stored in the worksheet row/col table.
+#
+# This is only used when compatibity_mode() is in operation.
+#
+# This method writes ROW data, then cell data (NUMBER, LABELSST, etc) and then
+# DBCELL records in blocks of 32 rows. This is explained in detail (for a
+# change) in the Excel SDK and in the OOo Excel file format doc.
+#
+sub _store_table {
+
+ my $self = shift;
+
+ return unless $self->{_compatibility};
+
+ # Offset from the DBCELL record back to the first ROW of the 32 row block.
+ my $row_offset = 0;
+
+ # Track rows that have cell data or modified by set_row().
+ my @written_rows;
+
+
+ # Write the ROW records with updated max/min col fields.
+ #
+ for my $row (0 .. $self->{_dim_rowmax} -1) {
+ # Skip unless there is cell data in row or the row has been modified.
+ next unless $self->{_table}->[$row] or $self->{_row_data}->{$row};
+
+ # Store the rows with data.
+ push @written_rows, $row;
+
+ # Increase the row offset by the length of a ROW record;
+ $row_offset += 20;
+
+ # The max/min cols in the ROW records are the same as in DIMENSIONS.
+ my $col_min = $self->{_dim_colmin};
+ my $col_max = $self->{_dim_colmax};
+
+ # Write a user specified ROW record (modified by set_row()).
+ if ($self->{_row_data}->{$row}) {
+ # Rewrite the min and max cols for user defined row record.
+ my $packed_row = $self->{_row_data}->{$row};
+ substr $packed_row, 6, 4, pack('vv', $col_min, $col_max);
+ $self->_append($packed_row);
+ }
+ else {
+ # Write a default Row record if there isn't a user defined ROW.
+ $self->_write_row_default($row, $col_min, $col_max);
+ }
+
+
+
+ # If 32 rows have been written or we are at the last row in the
+ # worksheet then write the cell data and the DBCELL record.
+ #
+ if (@written_rows == 32 or $row == $self->{_dim_rowmax} -1) {
+
+ # Offsets to the first cell of each row.
+ my @cell_offsets;
+ push @cell_offsets, $row_offset - 20;
+
+ # Write the cell data in each row and sum their lengths for the
+ # cell offsets.
+ #
+ for my $row (@written_rows) {
+ my $cell_offset = 0;
+
+ for my $col (@{$self->{_table}->[$row]}) {
+ next unless $col;
+ $self->_append($col);
+ my $length = length $col;
+ $row_offset += $length;
+ $cell_offset += $length;
+ }
+ push @cell_offsets, $cell_offset;
+ }
+
+ # The last offset isn't required.
+ pop @cell_offsets;
+
+ # Stores the DBCELL offset for use in the INDEX record.
+ push @{$self->{_db_indices}}, $self->{_datasize};
+
+ # Write the DBCELL record.
+ $self->_store_dbcell($row_offset, @cell_offsets);
+
+ # Clear the variable for the next block of rows.
+ @written_rows = ();
+ @cell_offsets = ();
+ $row_offset = 0;
+ }
+ }
+}
+
+
+###############################################################################
+#
+# _store_dbcell()
+#
+# Store the DBCELL record using the offset calculated in _store_table().
+#
+# This is only used when compatibity_mode() is in operation.
+#
+sub _store_dbcell {
+
+ my $self = shift;
+ my $row_offset = shift;
+ my @cell_offsets = @_;
+
+
+ my $record = 0x00D7; # Record identifier
+ my $length = 4 + 2 * @cell_offsets; # Bytes to follow
+
+
+ my $header = pack 'vv', $record, $length;
+ my $data = pack 'V', $row_offset;
+ $data .= pack 'v', $_ for @cell_offsets;
+
+ $self->_append($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_index()
+#
+# Store the INDEX record using the DBCELL offsets calculated in _store_table().
+#
+# This is only used when compatibity_mode() is in operation.
+#
+sub _store_index {
+
+ my $self = shift;
+
+ return unless $self->{_compatibility};
+
+ my @indices = @{$self->{_db_indices}};
+ my $reserved = 0x00000000;
+ my $row_min = $self->{_dim_rowmin};
+ my $row_max = $self->{_dim_rowmax};
+
+ my $record = 0x020B; # Record identifier
+ my $length = 16 + 4 * @indices; # Bytes to follow
+
+ my $header = pack 'vv', $record, $length;
+ my $data = pack 'VVVV', $reserved,
+ $row_min,
+ $row_max,
+ $reserved;
+
+ for my $index (@indices) {
+ $data .= pack 'V', $index + $self->{_offset} + 20 + $length +4;
+ }
+
+ $self->_prepend($header, $data);
+
+}
+
+
+###############################################################################
+#
+# insert_chart($row, $col, $chart, $x, $y, $scale_x, $scale_y)
+#
+# Insert a chart into a worksheet. The $chart argument should be a Chart
+# object or else it is assumed to be a filename of an external binary file.
+# The latter is for backwards compatibility.
+#
+sub insert_chart {
+
+ my $self = shift;
+
+ # Check for a cell reference in A1 notation and substitute row and column
+ if ($_[0] =~ /^\D/) {
+ @_ = $self->_substitute_cellref(@_);
+ }
+
+ my $row = $_[0];
+ my $col = $_[1];
+ my $chart = $_[2];
+ my $x_offset = $_[3] || 0;
+ my $y_offset = $_[4] || 0;
+ my $scale_x = $_[5] || 1;
+ my $scale_y = $_[6] || 1;
+
+ croak "Insufficient arguments in insert_chart()" unless @_ >= 3;
+
+ if ( ref $chart ) {
+ # Check for a Chart object.
+ croak "Not a Chart object in insert_chart()"
+ unless $chart->isa( 'Spreadsheet::WriteExcel::Chart' );
+
+ # Check that the chart is an embedded style chart.
+ croak "Not a embedded style Chart object in insert_chart()"
+ unless $chart->{_embedded};
+
+ }
+ else {
+
+ # Assume an external bin filename.
+ croak "Couldn't locate $chart in insert_chart(): $!" unless -e $chart;
+ }
+
+ $self->{_charts}->{$row}->{$col} = [
+ $row,
+ $col,
+ $chart,
+ $x_offset,
+ $y_offset,
+ $scale_x,
+ $scale_y,
+ ];
+
+}
+
+# Older method name for backwards compatibility.
+*embed_chart = *insert_chart;
+
+###############################################################################
+#
+# insert_image($row, $col, $filename, $x, $y, $scale_x, $scale_y)
+#
+# Insert an image into the worksheet.
+#
+sub insert_image {
+
+ my $self = shift;
+
+ # Check for a cell reference in A1 notation and substitute row and column
+ if ($_[0] =~ /^\D/) {
+ @_ = $self->_substitute_cellref(@_);
+ }
+
+ my $row = $_[0];
+ my $col = $_[1];
+ my $image = $_[2];
+ my $x_offset = $_[3] || 0;
+ my $y_offset = $_[4] || 0;
+ my $scale_x = $_[5] || 1;
+ my $scale_y = $_[6] || 1;
+
+ croak "Insufficient arguments in insert_image()" unless @_ >= 3;
+ croak "Couldn't locate $image: $!" unless -e $image;
+
+ $self->{_images}->{$row}->{$col} = [
+ $row,
+ $col,
+ $image,
+ $x_offset,
+ $y_offset,
+ $scale_x,
+ $scale_y,
+ ];
+
+}
+
+# Older method name for backwards compatibility.
+*insert_bitmap = *insert_image;
+
+
+###############################################################################
+#
+# _position_object()
+#
+# Calculate the vertices that define the position of a graphical object within
+# the worksheet.
+#
+# +------------+------------+
+# | A | B |
+# +-----+------------+------------+
+# | |(x1,y1) | |
+# | 1 |(A1)._______|______ |
+# | | | | |
+# | | | | |
+# +-----+----| BITMAP |-----+
+# | | | | |
+# | 2 | |______________. |
+# | | | (B2)|
+# | | | (x2,y2)|
+# +---- +------------+------------+
+#
+# Example of a bitmap that covers some of the area from cell A1 to cell B2.
+#
+# Based on the width and height of the bitmap we need to calculate 8 vars:
+# $col_start, $row_start, $col_end, $row_end, $x1, $y1, $x2, $y2.
+# The width and height of the cells are also variable and have to be taken into
+# account.
+# The values of $col_start and $row_start are passed in from the calling
+# function. The values of $col_end and $row_end are calculated by subtracting
+# the width and height of the bitmap from the width and height of the
+# underlying cells.
+# The vertices are expressed as a percentage of the underlying cell width as
+# follows (rhs values are in pixels):
+#
+# x1 = X / W *1024
+# y1 = Y / H *256
+# x2 = (X-1) / W *1024
+# y2 = (Y-1) / H *256
+#
+# Where: X is distance from the left side of the underlying cell
+# Y is distance from the top of the underlying cell
+# W is the width of the cell
+# H is the height of the cell
+#
+# Note: the SDK incorrectly states that the height should be expressed as a
+# percentage of 1024.
+#
+sub _position_object {
+
+ my $self = shift;
+
+ my $col_start; # Col containing upper left corner of object
+ my $x1; # Distance to left side of object
+
+ my $row_start; # Row containing top left corner of object
+ my $y1; # Distance to top of object
+
+ my $col_end; # Col containing lower right corner of object
+ my $x2; # Distance to right side of object
+
+ my $row_end; # Row containing bottom right corner of object
+ my $y2; # Distance to bottom of object
+
+ my $width; # Width of image frame
+ my $height; # Height of image frame
+
+ ($col_start, $row_start, $x1, $y1, $width, $height) = @_;
+
+
+ # Adjust start column for offsets that are greater than the col width
+ while ($x1 >= $self->_size_col($col_start)) {
+ $x1 -= $self->_size_col($col_start);
+ $col_start++;
+ }
+
+ # Adjust start row for offsets that are greater than the row height
+ while ($y1 >= $self->_size_row($row_start)) {
+ $y1 -= $self->_size_row($row_start);
+ $row_start++;
+ }
+
+
+ # Initialise end cell to the same as the start cell
+ $col_end = $col_start;
+ $row_end = $row_start;
+
+ $width = $width + $x1;
+ $height = $height + $y1;
+
+
+ # Subtract the underlying cell widths to find the end cell of the image
+ while ($width >= $self->_size_col($col_end)) {
+ $width -= $self->_size_col($col_end);
+ $col_end++;
+ }
+
+ # Subtract the underlying cell heights to find the end cell of the image
+ while ($height >= $self->_size_row($row_end)) {
+ $height -= $self->_size_row($row_end);
+ $row_end++;
+ }
+
+ # Bitmap isn't allowed to start or finish in a hidden cell, i.e. a cell
+ # with zero eight or width.
+ #
+ return if $self->_size_col($col_start) == 0;
+ return if $self->_size_col($col_end) == 0;
+ return if $self->_size_row($row_start) == 0;
+ return if $self->_size_row($row_end) == 0;
+
+ # Convert the pixel values to the percentage value expected by Excel
+ $x1 = $x1 / $self->_size_col($col_start) * 1024;
+ $y1 = $y1 / $self->_size_row($row_start) * 256;
+ $x2 = $width / $self->_size_col($col_end) * 1024;
+ $y2 = $height / $self->_size_row($row_end) * 256;
+
+ # Simulate ceil() without calling POSIX::ceil().
+ $x1 = int($x1 +0.5);
+ $y1 = int($y1 +0.5);
+ $x2 = int($x2 +0.5);
+ $y2 = int($y2 +0.5);
+
+ return( $col_start, $x1,
+ $row_start, $y1,
+ $col_end, $x2,
+ $row_end, $y2
+ );
+}
+
+
+###############################################################################
+#
+# _size_col($col)
+#
+# Convert the width of a cell from user's units to pixels. Excel rounds the
+# column width to the nearest pixel. If the width hasn't been set by the user
+# we use the default value. If the column is hidden we use a value of zero.
+#
+sub _size_col {
+
+ my $self = shift;
+ my $col = $_[0];
+
+ # Look up the cell value to see if it has been changed
+ if (exists $self->{_col_sizes}->{$col}) {
+ my $width = $self->{_col_sizes}->{$col};
+
+ # The relationship is different for user units less than 1.
+ if ($width < 1) {
+ return int($width *12);
+ }
+ else {
+ return int($width *7 ) +5;
+ }
+ }
+ else {
+ return 64;
+ }
+}
+
+
+###############################################################################
+#
+# _size_row($row)
+#
+# Convert the height of a cell from user's units to pixels. By interpolation
+# the relationship is: y = 4/3x. If the height hasn't been set by the user we
+# use the default value. If the row is hidden we use a value of zero. (Not
+# possible to hide row yet).
+#
+sub _size_row {
+
+ my $self = shift;
+ my $row = $_[0];
+
+ # Look up the cell value to see if it has been changed
+ if (exists $self->{_row_sizes}->{$row}) {
+ if ($self->{_row_sizes}->{$row} == 0) {
+ return 0;
+ }
+ else {
+ return int (4/3 * $self->{_row_sizes}->{$row});
+ }
+ }
+ else {
+ return 17;
+ }
+}
+
+
+###############################################################################
+#
+# _store_zoom($zoom)
+#
+#
+# Store the window zoom factor. This should be a reduced fraction but for
+# simplicity we will store all fractions with a numerator of 100.
+#
+sub _store_zoom {
+
+ my $self = shift;
+
+ # If scale is 100 we don't need to write a record
+ return if $self->{_zoom} == 100;
+
+ my $record = 0x00A0; # Record identifier
+ my $length = 0x0004; # Bytes to follow
+
+ my $header = pack("vv", $record, $length );
+ my $data = pack("vv", $self->{_zoom}, 100);
+
+ $self->_append($header, $data);
+}
+
+
+###############################################################################
+#
+# write_utf16be_string($row, $col, $string, $format)
+#
+# Write a Unicode string to the specified row and column (zero indexed).
+# $format is optional.
+# Returns 0 : normal termination
+# -1 : insufficient number of arguments
+# -2 : row or column out of range
+# -3 : long string truncated to 255 chars
+#
+sub write_utf16be_string {
+
+ my $self = shift;
+
+ # Check for a cell reference in A1 notation and substitute row and column
+ if ($_[0] =~ /^\D/) {
+ @_ = $self->_substitute_cellref(@_);
+ }
+
+ if (@_ < 3) { return -1 } # Check the number of args
+
+ my $record = 0x00FD; # Record identifier
+ my $length = 0x000A; # Bytes to follow
+
+ my $row = $_[0]; # Zero indexed row
+ my $col = $_[1]; # Zero indexed column
+ my $strlen = length($_[2]);
+ my $str = $_[2];
+ my $xf = _XF($self, $row, $col, $_[3]); # The cell format
+ my $encoding = 0x1;
+ my $str_error = 0;
+
+ # Check that row and col are valid and store max and min values
+ return -2 if $self->_check_dimensions($row, $col);
+
+ # Limit the utf16 string to the max number of chars (not bytes).
+ if ($strlen > 32767* 2) {
+ $str = substr($str, 0, 32767*2);
+ $str_error = -3;
+ }
+
+
+ my $num_bytes = length $str;
+ my $num_chars = int($num_bytes / 2);
+
+
+ # Check for a valid 2-byte char string.
+ croak "Uneven number of bytes in Unicode string" if $num_bytes % 2;
+
+
+ # Change from UTF16 big-endian to little endian
+ $str = pack "v*", unpack "n*", $str;
+
+
+ # Add the encoding and length header to the string.
+ my $str_header = pack("vC", $num_chars, $encoding);
+ $str = $str_header . $str;
+
+
+ if (not exists ${$self->{_str_table}}->{$str}) {
+ ${$self->{_str_table}}->{$str} = ${$self->{_str_unique}}++;
+ }
+
+
+ ${$self->{_str_total}}++;
+
+
+ my $header = pack("vv", $record, $length);
+ my $data = pack("vvvV", $row, $col, $xf, ${$self->{_str_table}}->{$str});
+
+ # Store the data or write immediately depending on the compatibility mode.
+ if ($self->{_compatibility}) {
+ $self->{_table}->[$row]->[$col] = $header . $data;
+ }
+ else {
+ $self->_append($header, $data);
+ }
+
+ return $str_error;
+}
+
+
+###############################################################################
+#
+# write_utf16le_string($row, $col, $string, $format)
+#
+# Write a UTF-16LE string to the specified row and column (zero indexed).
+# $format is optional.
+# Returns 0 : normal termination
+# -1 : insufficient number of arguments
+# -2 : row or column out of range
+# -3 : long string truncated to 255 chars
+#
+sub write_utf16le_string {
+
+ my $self = shift;
+
+ # Check for a cell reference in A1 notation and substitute row and column
+ if ($_[0] =~ /^\D/) {
+ @_ = $self->_substitute_cellref(@_);
+ }
+
+ if (@_ < 3) { return -1 } # Check the number of args
+
+ my $record = 0x00FD; # Record identifier
+ my $length = 0x000A; # Bytes to follow
+
+ my $row = $_[0]; # Zero indexed row
+ my $col = $_[1]; # Zero indexed column
+ my $str = $_[2];
+ my $format = $_[3]; # The cell format
+
+
+ # Change from UTF16 big-endian to little endian
+ $str = pack "v*", unpack "n*", $str;
+
+
+ return $self->write_utf16be_string($row, $col, $str, $format);
+}
+
+
+# Older method name for backwards compatibility.
+*write_unicode = *write_utf16be_string;
+*write_unicode_le = *write_utf16le_string;
+
+
+
+###############################################################################
+#
+# _store_autofilters()
+#
+# Function to iterate through the columns that form part of an autofilter
+# range and write Biff AUTOFILTER records if a filter expression has been set.
+#
+sub _store_autofilters {
+
+ my $self = shift;
+
+ # Skip all columns if no filter have been set.
+ return unless $self->{_filter_on};
+
+ my (undef, undef, $col1, $col2) = @{$self->{_filter_area}};
+
+ for my $i ($col1 .. $col2) {
+ # Reverse order since records are being pre-pended.
+ my $col = $col2 -$i;
+
+ # Skip if column doesn't have an active filter.
+ next unless $self->{_filter_cols}->{$col};
+
+ # Retrieve the filter tokens and write the autofilter records.
+ my @tokens = @{$self->{_filter_cols}->{$col}};
+ $self->_store_autofilter($col, @tokens);
+ }
+}
+
+
+###############################################################################
+#
+# _store_autofilter()
+#
+# Function to write worksheet AUTOFILTER records. These contain 2 Biff Doper
+# structures to represent the 2 possible filter conditions.
+#
+sub _store_autofilter {
+
+ my $self = shift;
+
+ my $record = 0x009E;
+ my $length = 0x0000;
+
+ my $index = $_[0];
+ my $operator_1 = $_[1];
+ my $token_1 = $_[2];
+ my $join = $_[3]; # And/Or
+ my $operator_2 = $_[4];
+ my $token_2 = $_[5];
+
+ my $top10_active = 0;
+ my $top10_direction = 0;
+ my $top10_percent = 0;
+ my $top10_value = 101;
+
+ my $grbit = $join;
+ my $optimised_1 = 0;
+ my $optimised_2 = 0;
+ my $doper_1 = '';
+ my $doper_2 = '';
+ my $string_1 = '';
+ my $string_2 = '';
+
+ # Excel used an optimisation in the case of a simple equality.
+ $optimised_1 = 1 if $operator_1 == 2;
+ $optimised_2 = 1 if defined $operator_2 and $operator_2 == 2;
+
+
+ # Convert non-simple equalities back to type 2. See _parse_filter_tokens().
+ $operator_1 = 2 if $operator_1 == 22;
+ $operator_2 = 2 if defined $operator_2 and $operator_2 == 22;
+
+
+ # Handle a "Top" style expression.
+ if ($operator_1 >= 30) {
+ # Remove the second expression if present.
+ $operator_2 = undef;
+ $token_2 = undef;
+
+ # Set the active flag.
+ $top10_active = 1;
+
+ if ($operator_1 == 30 or $operator_1 == 31) {
+ $top10_direction = 1;
+ }
+
+ if ($operator_1 == 31 or $operator_1 == 33) {
+ $top10_percent = 1;
+ }
+
+ if ($top10_direction == 1) {
+ $operator_1 = 6
+ }
+ else {
+ $operator_1 = 3
+ }
+
+ $top10_value = $token_1;
+ $token_1 = 0;
+ }
+
+
+ $grbit |= $optimised_1 << 2;
+ $grbit |= $optimised_2 << 3;
+ $grbit |= $top10_active << 4;
+ $grbit |= $top10_direction << 5;
+ $grbit |= $top10_percent << 6;
+ $grbit |= $top10_value << 7;
+
+ ($doper_1, $string_1) = $self->_pack_doper($operator_1, $token_1);
+ ($doper_2, $string_2) = $self->_pack_doper($operator_2, $token_2);
+
+ my $data = pack 'v', $index;
+ $data .= pack 'v', $grbit;
+ $data .= $doper_1;
+ $data .= $doper_2;
+ $data .= $string_1;
+ $data .= $string_2;
+
+ $length = length $data;
+ my $header = pack('vv', $record, $length);
+
+ $self->_prepend($header, $data);
+}
+
+
+###############################################################################
+#
+# _pack_doper()
+#
+# Create a Biff Doper structure that represents a filter expression. Depending
+# on the type of the token we pack an Empty, String or Number doper.
+#
+sub _pack_doper {
+
+ my $self = shift;
+
+ my $operator = $_[0];
+ my $token = $_[1];
+
+ my $doper = '';
+ my $string = '';
+
+
+ # Return default doper for non-defined filters.
+ if (not defined $operator) {
+ return ($self->_pack_unused_doper, $string);
+ }
+
+
+ if ($token =~ /^blanks|nonblanks$/i) {
+ $doper = $self->_pack_blanks_doper($operator, $token);
+ }
+ elsif ($operator == 2 or
+ $token !~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/)
+ {
+ # Excel treats all tokens as strings if the operator is equality, =.
+
+ $string = $token;
+
+ my $encoding = 0;
+ my $length = length $string;
+
+ # Handle utf8 strings in perl 5.8.
+ if ($] >= 5.008) {
+ require Encode;
+
+ if (Encode::is_utf8($string)) {
+ $string = Encode::encode("UTF-16BE", $string);
+ $encoding = 1;
+ }
+ }
+
+ $string = pack('C', $encoding) . $string;
+ $doper = $self->_pack_string_doper($operator, $length);
+ }
+ else {
+ $string = '';
+ $doper = $self->_pack_number_doper($operator, $token);
+ }
+
+ return ($doper, $string);
+}
+
+
+###############################################################################
+#
+# _pack_unused_doper()
+#
+# Pack an empty Doper structure.
+#
+sub _pack_unused_doper {
+
+ my $self = shift;
+
+ return pack 'C10', (0x0) x 10;
+}
+
+
+###############################################################################
+#
+# _pack_blanks_doper()
+#
+# Pack an Blanks/NonBlanks Doper structure.
+#
+sub _pack_blanks_doper {
+
+ my $self = shift;
+
+ my $operator = $_[0];
+ my $token = $_[1];
+ my $type;
+
+ if ($token eq 'blanks') {
+ $type = 0x0C;
+ $operator = 2;
+
+ }
+ else {
+ $type = 0x0E;
+ $operator = 5;
+ }
+
+
+ my $doper = pack 'CCVV', $type, # Data type
+ $operator, #
+ 0x0000, # Reserved
+ 0x0000; # Reserved
+ return $doper;
+}
+
+
+###############################################################################
+#
+# _pack_string_doper()
+#
+# Pack an string Doper structure.
+#
+sub _pack_string_doper {
+
+ my $self = shift;
+
+ my $operator = $_[0];
+ my $length = $_[1];
+ my $doper = pack 'CCVCCCC', 0x06, # Data type
+ $operator, #
+ 0x0000, # Reserved
+ $length, # String char length.
+ 0x0, 0x0, 0x0; # Reserved
+ return $doper;
+}
+
+
+###############################################################################
+#
+# _pack_number_doper()
+#
+# Pack an IEEE double number Doper structure.
+#
+sub _pack_number_doper {
+
+ my $self = shift;
+
+ my $operator = $_[0];
+ my $number = $_[1];
+ $number = pack 'd', $number;
+ $number = reverse $number if $self->{_byte_order};
+
+ my $doper = pack 'CC', 0x04, $operator;
+ $doper .= $number;
+
+ return $doper;
+}
+
+
+#
+# Methods related to comments and MSO objects.
+#
+
+
+###############################################################################
+#
+# _prepare_images()
+#
+# Turn the HoH that stores the images into an array for easier handling.
+#
+sub _prepare_images {
+
+ my $self = shift;
+
+ my $count = 0;
+ my @images;
+
+
+ # We sort the images by row and column but that isn't strictly required.
+ #
+ my @rows = sort {$a <=> $b} keys %{$self->{_images}};
+
+ for my $row (@rows) {
+ my @cols = sort {$a <=> $b} keys %{$self->{_images}->{$row}};
+
+ for my $col (@cols) {
+ push @images, $self->{_images}->{$row}->{$col};
+ $count++;
+ }
+ }
+
+ $self->{_images} = {};
+ $self->{_images_array} = \@images;
+
+ return $count;
+}
+
+
+###############################################################################
+#
+# _prepare_comments()
+#
+# Turn the HoH that stores the comments into an array for easier handling.
+#
+sub _prepare_comments {
+
+ my $self = shift;
+
+ my $count = 0;
+ my @comments;
+
+
+ # We sort the comments by row and column but that isn't strictly required.
+ #
+ my @rows = sort {$a <=> $b} keys %{$self->{_comments}};
+
+ for my $row (@rows) {
+ my @cols = sort {$a <=> $b} keys %{$self->{_comments}->{$row}};
+
+ for my $col (@cols) {
+ push @comments, $self->{_comments}->{$row}->{$col};
+ $count++;
+ }
+ }
+
+ $self->{_comments} = {};
+ $self->{_comments_array} = \@comments;
+
+ return $count;
+}
+
+
+###############################################################################
+#
+# _prepare_charts()
+#
+# Turn the HoH that stores the charts into an array for easier handling.
+#
+sub _prepare_charts {
+
+ my $self = shift;
+
+ my $count = 0;
+ my @charts;
+
+
+ # We sort the charts by row and column but that isn't strictly required.
+ #
+ my @rows = sort {$a <=> $b} keys %{$self->{_charts}};
+
+ for my $row (@rows) {
+ my @cols = sort {$a <=> $b} keys %{$self->{_charts}->{$row}};
+
+ for my $col (@cols) {
+ push @charts, $self->{_charts}->{$row}->{$col};
+ $count++;
+ }
+ }
+
+ $self->{_charts} = {};
+ $self->{_charts_array} = \@charts;
+
+ return $count;
+}
+
+
+###############################################################################
+#
+# _store_images()
+#
+# Store the collections of records that make up images.
+#
+sub _store_images {
+
+ my $self = shift;
+
+ my $record = 0x00EC; # Record identifier
+ my $length = 0x0000; # Bytes to follow
+
+ my @ids = @{$self->{_object_ids }};
+ my $spid = shift @ids;
+
+ my @images = @{$self->{_images_array}};
+ my $num_images = scalar @images;
+
+ my $num_filters = $self->{_filter_count};
+ my $num_comments = @{$self->{_comments_array}};
+ my $num_charts = @{$self->{_charts_array }};
+
+ # Skip this if there aren't any images.
+ return unless $num_images;
+
+ for my $i (0 .. $num_images-1) {
+ my $row = $images[$i]->[0];
+ my $col = $images[$i]->[1];
+ my $name = $images[$i]->[2];
+ my $x_offset = $images[$i]->[3];
+ my $y_offset = $images[$i]->[4];
+ my $scale_x = $images[$i]->[5];
+ my $scale_y = $images[$i]->[6];
+ my $image_id = $images[$i]->[7];
+ my $type = $images[$i]->[8];
+ my $width = $images[$i]->[9];
+ my $height = $images[$i]->[10];
+
+ $width *= $scale_x if $scale_x;
+ $height *= $scale_y if $scale_y;
+
+
+ # Calculate the positions of image object.
+ my @vertices = $self->_position_object( $col,
+ $row,
+ $x_offset,
+ $y_offset,
+ $width,
+ $height
+ );
+
+ if ($i == 0) {
+ # Write the parent MSODRAWIING record.
+ my $dg_length = 156 + 84*($num_images -1);
+ my $spgr_length = 132 + 84*($num_images -1);
+
+ $dg_length += 120 *$num_charts;
+ $spgr_length += 120 *$num_charts;
+
+ $dg_length += 96 *$num_filters;
+ $spgr_length += 96 *$num_filters;
+
+ $dg_length += 128 *$num_comments;
+ $spgr_length += 128 *$num_comments;
+
+
+
+ my $data = $self->_store_mso_dg_container($dg_length);
+ $data .= $self->_store_mso_dg(@ids);
+ $data .= $self->_store_mso_spgr_container($spgr_length);
+ $data .= $self->_store_mso_sp_container(40);
+ $data .= $self->_store_mso_spgr();
+ $data .= $self->_store_mso_sp(0x0, $spid++, 0x0005);
+ $data .= $self->_store_mso_sp_container(76);
+ $data .= $self->_store_mso_sp(75, $spid++, 0x0A00);
+ $data .= $self->_store_mso_opt_image($image_id);
+ $data .= $self->_store_mso_client_anchor(2, @vertices);
+ $data .= $self->_store_mso_client_data();
+
+ $length = length $data;
+ my $header = pack("vv", $record, $length);
+ $self->_append($header, $data);
+
+ }
+ else {
+ # Write the child MSODRAWIING record.
+ my $data = $self->_store_mso_sp_container(76);
+ $data .= $self->_store_mso_sp(75, $spid++, 0x0A00);
+ $data .= $self->_store_mso_opt_image($image_id);
+ $data .= $self->_store_mso_client_anchor(2, @vertices);
+ $data .= $self->_store_mso_client_data();
+
+ $length = length $data;
+ my $header = pack("vv", $record, $length);
+ $self->_append($header, $data);
+
+
+ }
+
+ $self->_store_obj_image($i+1);
+ }
+
+ $self->{_object_ids}->[0] = $spid;
+}
+
+
+
+###############################################################################
+#
+# _store_charts()
+#
+# Store the collections of records that make up charts.
+#
+sub _store_charts {
+
+ my $self = shift;
+
+ my $record = 0x00EC; # Record identifier
+ my $length = 0x0000; # Bytes to follow
+
+ my @ids = @{$self->{_object_ids}};
+ my $spid = shift @ids;
+
+ my @charts = @{$self->{_charts_array}};
+ my $num_charts = scalar @charts;
+
+ my $num_filters = $self->{_filter_count};
+ my $num_comments = @{$self->{_comments_array}};
+
+ # Number of objects written so far.
+ my $num_objects = @{$self->{_images_array}};
+
+ # Skip this if there aren't any charts.
+ return unless $num_charts;
+
+ for my $i (0 .. $num_charts-1 ) {
+ my $row = $charts[$i]->[0];
+ my $col = $charts[$i]->[1];
+ my $chart = $charts[$i]->[2];
+ my $x_offset = $charts[$i]->[3];
+ my $y_offset = $charts[$i]->[4];
+ my $scale_x = $charts[$i]->[5];
+ my $scale_y = $charts[$i]->[6];
+ my $width = 526;
+ my $height = 319;
+
+ $width *= $scale_x if $scale_x;
+ $height *= $scale_y if $scale_y;
+
+ # Calculate the positions of chart object.
+ my @vertices = $self->_position_object( $col,
+ $row,
+ $x_offset,
+ $y_offset,
+ $width,
+ $height
+ );
+
+
+ if ($i == 0 and not $num_objects) {
+ # Write the parent MSODRAWIING record.
+ my $dg_length = 192 + 120*($num_charts -1);
+ my $spgr_length = 168 + 120*($num_charts -1);
+
+ $dg_length += 96 *$num_filters;
+ $spgr_length += 96 *$num_filters;
+
+ $dg_length += 128 *$num_comments;
+ $spgr_length += 128 *$num_comments;
+
+
+ my $data = $self->_store_mso_dg_container($dg_length);
+ $data .= $self->_store_mso_dg(@ids);
+ $data .= $self->_store_mso_spgr_container($spgr_length);
+ $data .= $self->_store_mso_sp_container(40);
+ $data .= $self->_store_mso_spgr();
+ $data .= $self->_store_mso_sp(0x0, $spid++, 0x0005);
+ $data .= $self->_store_mso_sp_container(112);
+ $data .= $self->_store_mso_sp(201, $spid++, 0x0A00);
+ $data .= $self->_store_mso_opt_chart();
+ $data .= $self->_store_mso_client_anchor(0, @vertices);
+ $data .= $self->_store_mso_client_data();
+
+ $length = length $data;
+ my $header = pack("vv", $record, $length);
+ $self->_append($header, $data);
+
+ }
+ else {
+ # Write the child MSODRAWIING record.
+ my $data = $self->_store_mso_sp_container(112);
+ $data .= $self->_store_mso_sp(201, $spid++, 0x0A00);
+ $data .= $self->_store_mso_opt_chart();
+ $data .= $self->_store_mso_client_anchor(0, @vertices);
+ $data .= $self->_store_mso_client_data();
+
+ $length = length $data;
+ my $header = pack("vv", $record, $length);
+ $self->_append($header, $data);
+
+
+ }
+
+ $self->_store_obj_chart($num_objects+$i+1);
+ $self->_store_chart_binary($chart);
+ }
+
+
+ # Simulate the EXTERNSHEET link between the chart and data using a formula
+ # such as '=Sheet1!A1'.
+ # TODO. Won't work for external data refs. Also should use a more direct
+ # method.
+ #
+ my $formula = "='$self->{_name}'!A1";
+ $self->store_formula($formula);
+
+ $self->{_object_ids}->[0] = $spid;
+}
+
+
+###############################################################################
+#
+# _store_chart_binary
+#
+# Add the binary data for a chart. This could either be from a Chart object
+# or from an external binary file (for backwards compatibility).
+#
+sub _store_chart_binary {
+
+ my $self = shift;
+ my $chart = $_[0];
+ my $tmp;
+
+
+ if ( ref $chart ) {
+ $chart->_close();
+ my $tmp = $chart->get_data();
+ $self->_append( $tmp );
+ }
+ else {
+
+ my $filehandle = FileHandle->new( $chart )
+ or die "Couldn't open $chart in insert_chart(): $!.\n";
+
+ binmode( $filehandle );
+
+ while ( read( $filehandle, $tmp, 4096 ) ) {
+ $self->_append( $tmp );
+ }
+ }
+}
+
+
+###############################################################################
+#
+# _store_filters()
+#
+# Store the collections of records that make up filters.
+#
+sub _store_filters {
+
+ my $self = shift;
+
+ my $record = 0x00EC; # Record identifier
+ my $length = 0x0000; # Bytes to follow
+
+ my @ids = @{$self->{_object_ids}};
+ my $spid = shift @ids;
+
+ my $filter_area = $self->{_filter_area};
+ my $num_filters = $self->{_filter_count};
+
+ my $num_comments = @{$self->{_comments_array}};
+
+ # Number of objects written so far.
+ my $num_objects = @{$self->{_images_array}}
+ + @{$self->{_charts_array}};
+
+ # Skip this if there aren't any filters.
+ return unless $num_filters;
+
+
+ my ($row1, $row2, $col1, $col2) = @$filter_area;
+
+ for my $i (0 .. $num_filters-1 ) {
+
+ my @vertices = ( $col1 +$i,
+ 0,
+ $row1,
+ 0,
+ $col1 +$i +1,
+ 0,
+ $row1 +1,
+ 0);
+
+ if ($i == 0 and not $num_objects) {
+ # Write the parent MSODRAWIING record.
+ my $dg_length = 168 + 96*($num_filters -1);
+ my $spgr_length = 144 + 96*($num_filters -1);
+
+ $dg_length += 128 *$num_comments;
+ $spgr_length += 128 *$num_comments;
+
+
+ my $data = $self->_store_mso_dg_container($dg_length);
+ $data .= $self->_store_mso_dg(@ids);
+ $data .= $self->_store_mso_spgr_container($spgr_length);
+ $data .= $self->_store_mso_sp_container(40);
+ $data .= $self->_store_mso_spgr();
+ $data .= $self->_store_mso_sp(0x0, $spid++, 0x0005);
+ $data .= $self->_store_mso_sp_container(88);
+ $data .= $self->_store_mso_sp(201, $spid++, 0x0A00);
+ $data .= $self->_store_mso_opt_filter();
+ $data .= $self->_store_mso_client_anchor(1, @vertices);
+ $data .= $self->_store_mso_client_data();
+
+ $length = length $data;
+ my $header = pack("vv", $record, $length);
+ $self->_append($header, $data);
+
+ }
+ else {
+ # Write the child MSODRAWIING record.
+ my $data = $self->_store_mso_sp_container(88);
+ $data .= $self->_store_mso_sp(201, $spid++, 0x0A00);
+ $data .= $self->_store_mso_opt_filter();
+ $data .= $self->_store_mso_client_anchor(1, @vertices);
+ $data .= $self->_store_mso_client_data();
+
+ $length = length $data;
+ my $header = pack("vv", $record, $length);
+ $self->_append($header, $data);
+
+
+ }
+
+ $self->_store_obj_filter($num_objects+$i+1, $col1 +$i);
+ }
+
+
+ # Simulate the EXTERNSHEET link between the filter and data using a formula
+ # such as '=Sheet1!A1'.
+ # TODO. Won't work for external data refs. Also should use a more direct
+ # method.
+ #
+ my $formula = "='$self->{_name}'!A1";
+ $self->store_formula($formula);
+
+ $self->{_object_ids}->[0] = $spid;
+}
+
+
+###############################################################################
+#
+# _store_comments()
+#
+# Store the collections of records that make up cell comments.
+#
+# NOTE: We write the comment objects last since that makes it a little easier
+# to write the NOTE records directly after the MSODRAWIING records.
+#
+sub _store_comments {
+
+ my $self = shift;
+
+ my $record = 0x00EC; # Record identifier
+ my $length = 0x0000; # Bytes to follow
+
+ my @ids = @{$self->{_object_ids}};
+ my $spid = shift @ids;
+
+ my @comments = @{$self->{_comments_array}};
+ my $num_comments = scalar @comments;
+
+ # Number of objects written so far.
+ my $num_objects = @{$self->{_images_array}}
+ + $self->{_filter_count}
+ + @{$self->{_charts_array}};
+
+ # Skip this if there aren't any comments.
+ return unless $num_comments;
+
+ for my $i (0 .. $num_comments-1) {
+
+ my $row = $comments[$i]->[0];
+ my $col = $comments[$i]->[1];
+ my $str = $comments[$i]->[2];
+ my $encoding = $comments[$i]->[3];
+ my $visible = $comments[$i]->[6];
+ my $color = $comments[$i]->[7];
+ my @vertices = @{$comments[$i]->[8]};
+ my $str_len = length $str;
+ $str_len /= 2 if $encoding; # Num of chars not bytes.
+ my $formats = [[0, 9], [$str_len, 0]];
+
+
+ if ($i == 0 and not $num_objects) {
+ # Write the parent MSODRAWIING record.
+ my $dg_length = 200 + 128*($num_comments -1);
+ my $spgr_length = 176 + 128*($num_comments -1);
+
+ my $data = $self->_store_mso_dg_container($dg_length);
+ $data .= $self->_store_mso_dg(@ids);
+ $data .= $self->_store_mso_spgr_container($spgr_length);
+ $data .= $self->_store_mso_sp_container(40);
+ $data .= $self->_store_mso_spgr();
+ $data .= $self->_store_mso_sp(0x0, $spid++, 0x0005);
+ $data .= $self->_store_mso_sp_container(120);
+ $data .= $self->_store_mso_sp(202, $spid++, 0x0A00);
+ $data .= $self->_store_mso_opt_comment(0x80, $visible, $color);
+ $data .= $self->_store_mso_client_anchor(3, @vertices);
+ $data .= $self->_store_mso_client_data();
+
+ $length = length $data;
+ my $header = pack("vv", $record, $length);
+ $self->_append($header, $data);
+
+ }
+ else {
+ # Write the child MSODRAWIING record.
+ my $data = $self->_store_mso_sp_container(120);
+ $data .= $self->_store_mso_sp(202, $spid++, 0x0A00);
+ $data .= $self->_store_mso_opt_comment(0x80, $visible, $color);
+ $data .= $self->_store_mso_client_anchor(3, @vertices);
+ $data .= $self->_store_mso_client_data();
+
+ $length = length $data;
+ my $header = pack("vv", $record, $length);
+ $self->_append($header, $data);
+
+
+ }
+
+ $self->_store_obj_comment($num_objects+$i+1);
+ $self->_store_mso_drawing_text_box();
+ $self->_store_txo($str_len);
+ $self->_store_txo_continue_1($str, $encoding);
+ $self->_store_txo_continue_2($formats);
+ }
+
+
+ # Write the NOTE records after MSODRAWIING records.
+ for my $i (0 .. $num_comments-1) {
+
+ my $row = $comments[$i]->[0];
+ my $col = $comments[$i]->[1];
+ my $author = $comments[$i]->[4];
+ my $author_enc = $comments[$i]->[5];
+ my $visible = $comments[$i]->[6];
+
+ $self->_store_note($row, $col, $num_objects+$i+1,
+ $author, $author_enc, $visible);
+ }
+}
+
+
+###############################################################################
+#
+# _store_mso_dg_container()
+#
+# Write the Escher DgContainer record that is part of MSODRAWING.
+#
+sub _store_mso_dg_container {
+
+ my $self = shift;
+
+ my $type = 0xF002;
+ my $version = 15;
+ my $instance = 0;
+ my $data = '';
+ my $length = $_[0];
+
+
+ return $self->_add_mso_generic($type, $version, $instance, $data, $length);
+}
+
+
+###############################################################################
+#
+# _store_mso_dg()
+#
+# Write the Escher Dg record that is part of MSODRAWING.
+#
+sub _store_mso_dg {
+
+ my $self = shift;
+
+ my $type = 0xF008;
+ my $version = 0;
+ my $instance = $_[0];
+ my $data = '';
+ my $length = 8;
+
+ my $num_shapes = $_[1];
+ my $max_spid = $_[2];
+
+ $data = pack "VV", $num_shapes, $max_spid;
+
+ return $self->_add_mso_generic($type, $version, $instance, $data, $length);
+}
+
+
+###############################################################################
+#
+# _store_mso_spgr_container()
+#
+# Write the Escher SpgrContainer record that is part of MSODRAWING.
+#
+sub _store_mso_spgr_container {
+
+ my $self = shift;
+
+ my $type = 0xF003;
+ my $version = 15;
+ my $instance = 0;
+ my $data = '';
+ my $length = $_[0];
+
+
+ return $self->_add_mso_generic($type, $version, $instance, $data, $length);
+}
+
+
+###############################################################################
+#
+# _store_mso_sp_container()
+#
+# Write the Escher SpContainer record that is part of MSODRAWING.
+#
+sub _store_mso_sp_container {
+
+ my $self = shift;
+
+ my $type = 0xF004;
+ my $version = 15;
+ my $instance = 0;
+ my $data = '';
+ my $length = $_[0];
+
+
+ return $self->_add_mso_generic($type, $version, $instance, $data, $length);
+}
+
+
+###############################################################################
+#
+# _store_mso_spgr()
+#
+# Write the Escher Spgr record that is part of MSODRAWING.
+#
+sub _store_mso_spgr {
+
+ my $self = shift;
+
+ my $type = 0xF009;
+ my $version = 1;
+ my $instance = 0;
+ my $data = pack "VVVV", 0, 0, 0, 0;
+ my $length = 16;
+
+
+ return $self->_add_mso_generic($type, $version, $instance, $data, $length);
+}
+
+
+###############################################################################
+#
+# _store_mso_sp()
+#
+# Write the Escher Sp record that is part of MSODRAWING.
+#
+sub _store_mso_sp {
+
+ my $self = shift;
+
+ my $type = 0xF00A;
+ my $version = 2;
+ my $instance = $_[0];
+ my $data = '';
+ my $length = 8;
+
+ my $spid = $_[1];
+ my $options = $_[2];
+
+ $data = pack "VV", $spid, $options;
+
+ return $self->_add_mso_generic($type, $version, $instance, $data, $length);
+}
+
+
+###############################################################################
+#
+# _store_mso_opt_comment()
+#
+# Write the Escher Opt record that is part of MSODRAWING.
+#
+sub _store_mso_opt_comment {
+
+ my $self = shift;
+
+ my $type = 0xF00B;
+ my $version = 3;
+ my $instance = 9;
+ my $data = '';
+ my $length = 54;
+
+ my $spid = $_[0];
+ my $visible = $_[1];
+ my $colour = $_[2] || 0x50;
+
+
+ # Use the visible flag if set by the user or else use the worksheet value.
+ # Note that the value used is the opposite of _store_note().
+ #
+ if (defined $visible) {
+ $visible = $visible ? 0x0000 : 0x0002;
+ }
+ else {
+ $visible = $self->{_comments_visible} ? 0x0000 : 0x0002;
+ }
+
+
+ $data = pack "V", $spid;
+ $data .= pack "H*", '0000BF00080008005801000000008101' ;
+ $data .= pack "C", $colour;
+ $data .= pack "H*", '000008830150000008BF011000110001' .
+ '02000000003F0203000300BF03';
+ $data .= pack "v", $visible;
+ $data .= pack "H*", '0A00';
+
+
+ return $self->_add_mso_generic($type, $version, $instance, $data, $length);
+}
+
+
+###############################################################################
+#
+# _store_mso_opt_image()
+#
+# Write the Escher Opt record that is part of MSODRAWING.
+#
+sub _store_mso_opt_image {
+
+ my $self = shift;
+
+ my $type = 0xF00B;
+ my $version = 3;
+ my $instance = 3;
+ my $data = '';
+ my $length = undef;
+ my $spid = $_[0];
+
+ $data = pack 'v', 0x4104; # Blip -> pib
+ $data .= pack 'V', $spid;
+ $data .= pack 'v', 0x01BF; # Fill Style -> fNoFillHitTest
+ $data .= pack 'V', 0x00010000;
+ $data .= pack 'v', 0x03BF; # Group Shape -> fPrint
+ $data .= pack 'V', 0x00080000;
+
+
+ return $self->_add_mso_generic($type, $version, $instance, $data, $length);
+}
+
+
+###############################################################################
+#
+# _store_mso_opt_chart()
+#
+# Write the Escher Opt record that is part of MSODRAWING.
+#
+sub _store_mso_opt_chart {
+
+ my $self = shift;
+
+ my $type = 0xF00B;
+ my $version = 3;
+ my $instance = 9;
+ my $data = '';
+ my $length = undef;
+
+ $data = pack 'v', 0x007F; # Protection -> fLockAgainstGrouping
+ $data .= pack 'V', 0x01040104;
+
+ $data .= pack 'v', 0x00BF; # Text -> fFitTextToShape
+ $data .= pack 'V', 0x00080008;
+
+ $data .= pack 'v', 0x0181; # Fill Style -> fillColor
+ $data .= pack 'V', 0x0800004E ;
+
+ $data .= pack 'v', 0x0183; # Fill Style -> fillBackColor
+ $data .= pack 'V', 0x0800004D;
+
+ $data .= pack 'v', 0x01BF; # Fill Style -> fNoFillHitTest
+ $data .= pack 'V', 0x00110010;
+
+ $data .= pack 'v', 0x01C0; # Line Style -> lineColor
+ $data .= pack 'V', 0x0800004D;
+
+ $data .= pack 'v', 0x01FF; # Line Style -> fNoLineDrawDash
+ $data .= pack 'V', 0x00080008;
+
+ $data .= pack 'v', 0x023F; # Shadow Style -> fshadowObscured
+ $data .= pack 'V', 0x00020000;
+
+ $data .= pack 'v', 0x03BF; # Group Shape -> fPrint
+ $data .= pack 'V', 0x00080000;
+
+
+ return $self->_add_mso_generic($type, $version, $instance, $data, $length);
+}
+
+
+###############################################################################
+#
+# _store_mso_opt_filter()
+#
+# Write the Escher Opt record that is part of MSODRAWING.
+#
+sub _store_mso_opt_filter {
+
+ my $self = shift;
+
+ my $type = 0xF00B;
+ my $version = 3;
+ my $instance = 5;
+ my $data = '';
+ my $length = undef;
+
+
+
+ $data = pack 'v', 0x007F; # Protection -> fLockAgainstGrouping
+ $data .= pack 'V', 0x01040104;
+
+ $data .= pack 'v', 0x00BF; # Text -> fFitTextToShape
+ $data .= pack 'V', 0x00080008;
+
+ $data .= pack 'v', 0x01BF; # Fill Style -> fNoFillHitTest
+ $data .= pack 'V', 0x00010000;
+
+ $data .= pack 'v', 0x01FF; # Line Style -> fNoLineDrawDash
+ $data .= pack 'V', 0x00080000;
+
+ $data .= pack 'v', 0x03BF; # Group Shape -> fPrint
+ $data .= pack 'V', 0x000A0000;
+
+
+ return $self->_add_mso_generic($type, $version, $instance, $data, $length);
+}
+
+
+###############################################################################
+#
+# _store_mso_client_anchor()
+#
+# Write the Escher ClientAnchor record that is part of MSODRAWING.
+#
+sub _store_mso_client_anchor {
+
+ my $self = shift;
+
+ my $type = 0xF010;
+ my $version = 0;
+ my $instance = 0;
+ my $data = '';
+ my $length = 18;
+
+ my $flag = shift;
+
+ my $col_start = $_[0]; # Col containing upper left corner of object
+ my $x1 = $_[1]; # Distance to left side of object
+
+ my $row_start = $_[2]; # Row containing top left corner of object
+ my $y1 = $_[3]; # Distance to top of object
+
+ my $col_end = $_[4]; # Col containing lower right corner of object
+ my $x2 = $_[5]; # Distance to right side of object
+
+ my $row_end = $_[6]; # Row containing bottom right corner of object
+ my $y2 = $_[7]; # Distance to bottom of object
+
+ $data = pack "v9", $flag,
+ $col_start, $x1,
+ $row_start, $y1,
+ $col_end, $x2,
+ $row_end, $y2;
+
+
+
+ return $self->_add_mso_generic($type, $version, $instance, $data, $length);
+}
+
+
+###############################################################################
+#
+# _store_mso_client_data()
+#
+# Write the Escher ClientData record that is part of MSODRAWING.
+#
+sub _store_mso_client_data {
+
+ my $self = shift;
+
+ my $type = 0xF011;
+ my $version = 0;
+ my $instance = 0;
+ my $data = '';
+ my $length = 0;
+
+
+ return $self->_add_mso_generic($type, $version, $instance, $data, $length);
+}
+
+
+###############################################################################
+#
+# _store_obj_comment()
+#
+# Write the OBJ record that is part of cell comments.
+#
+sub _store_obj_comment {
+
+ my $self = shift;
+
+ my $record = 0x005D; # Record identifier
+ my $length = 0x0034; # Bytes to follow
+
+ my $obj_id = $_[0]; # Object ID number.
+ my $obj_type = 0x0019; # Object type (comment).
+ my $data = ''; # Record data.
+
+ my $sub_record = 0x0000; # Sub-record identifier.
+ my $sub_length = 0x0000; # Length of sub-record.
+ my $sub_data = ''; # Data of sub-record.
+ my $options = 0x4011;
+ my $reserved = 0x0000;
+
+ # Add ftCmo (common object data) subobject
+ $sub_record = 0x0015; # ftCmo
+ $sub_length = 0x0012;
+ $sub_data = pack "vvvVVV", $obj_type, $obj_id, $options,
+ $reserved, $reserved, $reserved;
+ $data = pack("vv", $sub_record, $sub_length);
+ $data .= $sub_data;
+
+
+ # Add ftNts (note structure) subobject
+ $sub_record = 0x000D; # ftNts
+ $sub_length = 0x0016;
+ $sub_data = pack "VVVVVv", ($reserved) x 6;
+ $data .= pack("vv", $sub_record, $sub_length);
+ $data .= $sub_data;
+
+
+ # Add ftEnd (end of object) subobject
+ $sub_record = 0x0000; # ftNts
+ $sub_length = 0x0000;
+ $data .= pack("vv", $sub_record, $sub_length);
+
+
+ # Pack the record.
+ my $header = pack("vv", $record, $length);
+
+ $self->_append($header, $data);
+
+}
+
+
+###############################################################################
+#
+# _store_obj_image()
+#
+# Write the OBJ record that is part of image records.
+#
+sub _store_obj_image {
+
+ my $self = shift;
+
+ my $record = 0x005D; # Record identifier
+ my $length = 0x0026; # Bytes to follow
+
+ my $obj_id = $_[0]; # Object ID number.
+ my $obj_type = 0x0008; # Object type (Picture).
+ my $data = ''; # Record data.
+
+ my $sub_record = 0x0000; # Sub-record identifier.
+ my $sub_length = 0x0000; # Length of sub-record.
+ my $sub_data = ''; # Data of sub-record.
+ my $options = 0x6011;
+ my $reserved = 0x0000;
+
+ # Add ftCmo (common object data) subobject
+ $sub_record = 0x0015; # ftCmo
+ $sub_length = 0x0012;
+ $sub_data = pack 'vvvVVV', $obj_type, $obj_id, $options,
+ $reserved, $reserved, $reserved;
+ $data = pack 'vv', $sub_record, $sub_length;
+ $data .= $sub_data;
+
+
+ # Add ftCf (Clipboard format) subobject
+ $sub_record = 0x0007; # ftCf
+ $sub_length = 0x0002;
+ $sub_data = pack 'v', 0xFFFF;
+ $data .= pack 'vv', $sub_record, $sub_length;
+ $data .= $sub_data;
+
+ # Add ftPioGrbit (Picture option flags) subobject
+ $sub_record = 0x0008; # ftPioGrbit
+ $sub_length = 0x0002;
+ $sub_data = pack 'v', 0x0001;
+ $data .= pack 'vv', $sub_record, $sub_length;
+ $data .= $sub_data;
+
+
+ # Add ftEnd (end of object) subobject
+ $sub_record = 0x0000; # ftNts
+ $sub_length = 0x0000;
+ $data .= pack 'vv', $sub_record, $sub_length;
+
+
+ # Pack the record.
+ my $header = pack('vv', $record, $length);
+
+ $self->_append($header, $data);
+
+}
+
+
+###############################################################################
+#
+# _store_obj_chart()
+#
+# Write the OBJ record that is part of chart records.
+#
+sub _store_obj_chart {
+
+ my $self = shift;
+
+ my $record = 0x005D; # Record identifier
+ my $length = 0x001A; # Bytes to follow
+
+ my $obj_id = $_[0]; # Object ID number.
+ my $obj_type = 0x0005; # Object type (chart).
+ my $data = ''; # Record data.
+
+ my $sub_record = 0x0000; # Sub-record identifier.
+ my $sub_length = 0x0000; # Length of sub-record.
+ my $sub_data = ''; # Data of sub-record.
+ my $options = 0x6011;
+ my $reserved = 0x0000;
+
+ # Add ftCmo (common object data) subobject
+ $sub_record = 0x0015; # ftCmo
+ $sub_length = 0x0012;
+ $sub_data = pack 'vvvVVV', $obj_type, $obj_id, $options,
+ $reserved, $reserved, $reserved;
+ $data = pack 'vv', $sub_record, $sub_length;
+ $data .= $sub_data;
+
+ # Add ftEnd (end of object) subobject
+ $sub_record = 0x0000; # ftNts
+ $sub_length = 0x0000;
+ $data .= pack 'vv', $sub_record, $sub_length;
+
+
+ # Pack the record.
+ my $header = pack('vv', $record, $length);
+
+ $self->_append($header, $data);
+
+}
+
+
+
+
+###############################################################################
+#
+# _store_obj_filter()
+#
+# Write the OBJ record that is part of filter records.
+#
+sub _store_obj_filter {
+
+ my $self = shift;
+
+ my $record = 0x005D; # Record identifier
+ my $length = 0x0046; # Bytes to follow
+
+ my $obj_id = $_[0]; # Object ID number.
+ my $obj_type = 0x0014; # Object type (combo box).
+ my $data = ''; # Record data.
+
+ my $sub_record = 0x0000; # Sub-record identifier.
+ my $sub_length = 0x0000; # Length of sub-record.
+ my $sub_data = ''; # Data of sub-record.
+ my $options = 0x2101;
+ my $reserved = 0x0000;
+
+ # Add ftCmo (common object data) subobject
+ $sub_record = 0x0015; # ftCmo
+ $sub_length = 0x0012;
+ $sub_data = pack 'vvvVVV', $obj_type, $obj_id, $options,
+ $reserved, $reserved, $reserved;
+ $data = pack 'vv', $sub_record, $sub_length;
+ $data .= $sub_data;
+
+ # Add ftSbs Scroll bar subobject
+ $sub_record = 0x000C; # ftSbs
+ $sub_length = 0x0014;
+ $sub_data = pack 'H*', '0000000000000000640001000A00000010000100';
+ $data .= pack 'vv', $sub_record, $sub_length;
+ $data .= $sub_data;
+
+
+ # Add ftLbsData (List box data) subobject
+ $sub_record = 0x0013; # ftLbsData
+ $sub_length = 0x1FEE; # Special case (undocumented).
+
+
+ # If the filter is active we set one of the undocumented flags.
+ my $col = $_[1];
+
+ if ($self->{_filter_cols}->{$col}) {
+ $sub_data = pack 'H*', '000000000100010300000A0008005700';
+ }
+ else {
+ $sub_data = pack 'H*', '00000000010001030000020008005700';
+ }
+
+ $data .= pack 'vv', $sub_record, $sub_length;
+ $data .= $sub_data;
+
+
+ # Add ftEnd (end of object) subobject
+ $sub_record = 0x0000; # ftNts
+ $sub_length = 0x0000;
+ $data .= pack 'vv', $sub_record, $sub_length;
+
+ # Pack the record.
+ my $header = pack('vv', $record, $length);
+
+ $self->_append($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_mso_drawing_text_box()
+#
+# Write the MSODRAWING ClientTextbox record that is part of comments.
+#
+sub _store_mso_drawing_text_box {
+
+ my $self = shift;
+
+ my $record = 0x00EC; # Record identifier
+ my $length = 0x0008; # Bytes to follow
+
+
+ my $data = $self->_store_mso_client_text_box();
+ my $header = pack("vv", $record, $length);
+
+ $self->_append($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_mso_client_text_box()
+#
+# Write the Escher ClientTextbox record that is part of MSODRAWING.
+#
+sub _store_mso_client_text_box {
+
+ my $self = shift;
+
+ my $type = 0xF00D;
+ my $version = 0;
+ my $instance = 0;
+ my $data = '';
+ my $length = 0;
+
+
+ return $self->_add_mso_generic($type, $version, $instance, $data, $length);
+}
+
+
+###############################################################################
+#
+# _store_txo()
+#
+# Write the worksheet TXO record that is part of cell comments.
+#
+sub _store_txo {
+
+ my $self = shift;
+
+ my $record = 0x01B6; # Record identifier
+ my $length = 0x0012; # Bytes to follow
+
+ my $string_len = $_[0]; # Length of the note text.
+ my $format_len = $_[1] || 16; # Length of the format runs.
+ my $rotation = $_[2] || 0; # Options
+ my $grbit = 0x0212; # Options
+ my $reserved = 0x0000; # Options
+
+ # Pack the record.
+ my $header = pack("vv", $record, $length);
+ my $data = pack("vvVvvvV", $grbit, $rotation, $reserved, $reserved,
+ $string_len, $format_len, $reserved);
+
+ $self->_append($header, $data);
+
+}
+
+
+###############################################################################
+#
+# _store_txo_continue_1()
+#
+# Write the first CONTINUE record to follow the TXO record. It contains the
+# text data.
+#
+sub _store_txo_continue_1 {
+
+ my $self = shift;
+
+ my $record = 0x003C; # Record identifier
+ my $string = $_[0]; # Comment string.
+ my $encoding = $_[1] || 0; # Encoding of the string.
+
+
+ # Split long comment strings into smaller continue blocks if necessary.
+ # We can't let BIFFwriter::_add_continue() handled this since an extra
+ # encoding byte has to be added similar to the SST block.
+ #
+ # We make the limit size smaller than the _add_continue() size and even
+ # so that UTF16 chars occur in the same block.
+ #
+ my $limit = 8218;
+ while (length($string) > $limit) {
+ my $tmp_str = substr($string, 0, $limit, "");
+
+ my $data = pack("C", $encoding) . $tmp_str;
+ my $length = length $data;
+ my $header = pack("vv", $record, $length);
+
+ $self->_append($header, $data);
+ }
+
+ # Pack the record.
+ my $data = pack("C", $encoding) . $string;
+ my $length = length $data;
+ my $header = pack("vv", $record, $length);
+
+ $self->_append($header, $data);
+
+}
+
+
+###############################################################################
+#
+# _store_txo_continue_2()
+#
+# Write the second CONTINUE record to follow the TXO record. It contains the
+# formatting information for the string.
+#
+sub _store_txo_continue_2 {
+
+ my $self = shift;
+
+ my $record = 0x003C; # Record identifier
+ my $length = 0x0000; # Bytes to follow
+ my $formats = $_[0]; # Formatting information
+
+
+ # Pack the record.
+ my $data = '';
+
+ for my $a_ref (@$formats) {
+ $data .= pack "vvV", $a_ref->[0], $a_ref->[1], 0x0;
+ }
+
+ $length = length $data;
+ my $header = pack("vv", $record, $length);
+
+
+ $self->_append($header, $data);
+
+}
+
+
+###############################################################################
+#
+# _store_note()
+#
+# Write the worksheet NOTE record that is part of cell comments.
+#
+sub _store_note {
+
+ my $self = shift;
+
+ my $record = 0x001C; # Record identifier
+ my $length = 0x000C; # Bytes to follow
+
+ my $row = $_[0];
+ my $col = $_[1];
+ my $obj_id = $_[2];
+ my $author = $_[3] || $self->{_comments_author};
+ my $author_enc = $_[4] || $self->{_comments_author_enc};
+ my $visible = $_[5];
+
+
+ # Use the visible flag if set by the user or else use the worksheet value.
+ # The flag is also set in _store_mso_opt_comment() but with the opposite
+ # value.
+ if (defined $visible) {
+ $visible = $visible ? 0x0002 : 0x0000;
+ }
+ else {
+ $visible = $self->{_comments_visible} ? 0x0002 : 0x0000;
+ }
+
+
+ # Get the number of chars in the author string (not bytes).
+ my $num_chars = length $author;
+ $num_chars /= 2 if $author_enc;
+
+
+ # Null terminate the author string.
+ $author .= "\0";
+
+
+ # Pack the record.
+ my $data = pack("vvvvvC", $row, $col, $visible, $obj_id,
+ $num_chars, $author_enc);
+
+ $length = length($data) + length($author);
+ my $header = pack("vv", $record, $length);
+
+ $self->_append($header, $data, $author);
+}
+
+
+###############################################################################
+#
+# _comment_params()
+#
+# This method handles the additional optional parameters to write_comment() as
+# well as calculating the comment object position and vertices.
+#
+sub _comment_params {
+
+ my $self = shift;
+
+ my $row = shift;
+ my $col = shift;
+ my $string = shift;
+
+ my $default_width = 128;
+ my $default_height = 74;
+
+ my %params = (
+ author => '',
+ author_encoding => 0,
+ encoding => 0,
+ color => undef,
+ start_cell => undef,
+ start_col => undef,
+ start_row => undef,
+ visible => undef,
+ width => $default_width,
+ height => $default_height,
+ x_offset => undef,
+ x_scale => 1,
+ y_offset => undef,
+ y_scale => 1,
+ );
+
+
+ # Overwrite the defaults with any user supplied values. Incorrect or
+ # misspelled parameters are silently ignored.
+ %params = (%params, @_);
+
+
+ # Ensure that a width and height have been set.
+ $params{width} = $default_width if not $params{width};
+ $params{height} = $default_height if not $params{height};
+
+
+ # Check that utf16 strings have an even number of bytes.
+ if ($params{encoding}) {
+ croak "Uneven number of bytes in comment string"
+ if length($string) % 2;
+
+ # Change from UTF-16BE to UTF-16LE
+ $string = pack 'v*', unpack 'n*', $string;
+ }
+
+ if ($params{author_encoding}) {
+ croak "Uneven number of bytes in author string"
+ if length($params{author}) % 2;
+
+ # Change from UTF-16BE to UTF-16LE
+ $params{author} = pack 'v*', unpack 'n*', $params{author};
+ }
+
+
+ # Handle utf8 strings in perl 5.8.
+ if ($] >= 5.008) {
+ require Encode;
+
+ if (Encode::is_utf8($string)) {
+ $string = Encode::encode("UTF-16LE", $string);
+ $params{encoding} = 1;
+ }
+
+ if (Encode::is_utf8($params{author})) {
+ $params{author} = Encode::encode("UTF-16LE", $params{author});
+ $params{author_encoding} = 1;
+ }
+ }
+
+
+ # Limit the string to the max number of chars (not bytes).
+ my $max_len = 32767;
+ $max_len *= 2 if $params{encoding};
+
+ if (length($string) > $max_len) {
+ $string = substr($string, 0, $max_len);
+ }
+
+
+ # Set the comment background colour.
+ my $color = $params{color};
+ $color = &Spreadsheet::WriteExcel::Format::_get_color($color);
+ $color = 0x50 if $color == 0x7FFF; # Default color.
+ $params{color} = $color;
+
+
+ # Convert a cell reference to a row and column.
+ if (defined $params{start_cell}) {
+ my ($row, $col) = $self->_substitute_cellref($params{start_cell});
+ $params{start_row} = $row;
+ $params{start_col} = $col;
+ }
+
+
+ # Set the default start cell and offsets for the comment. These are
+ # generally fixed in relation to the parent cell. However there are
+ # some edge cases for cells at the, er, edges.
+ #
+ if (not defined $params{start_row}) {
+
+ if ($row == 0 ) {$params{start_row} = 0 }
+ elsif ($row == 65533) {$params{start_row} = 65529 }
+ elsif ($row == 65534) {$params{start_row} = 65530 }
+ elsif ($row == 65535) {$params{start_row} = 65531 }
+ else {$params{start_row} = $row -1}
+ }
+
+ if (not defined $params{y_offset}) {
+
+ if ($row == 0 ) {$params{y_offset} = 2 }
+ elsif ($row == 65533) {$params{y_offset} = 4 }
+ elsif ($row == 65534) {$params{y_offset} = 4 }
+ elsif ($row == 65535) {$params{y_offset} = 2 }
+ else {$params{y_offset} = 7 }
+ }
+
+ if (not defined $params{start_col}) {
+
+ if ($col == 253 ) {$params{start_col} = 250 }
+ elsif ($col == 254 ) {$params{start_col} = 251 }
+ elsif ($col == 255 ) {$params{start_col} = 252 }
+ else {$params{start_col} = $col +1}
+ }
+
+ if (not defined $params{x_offset}) {
+
+ if ($col == 253 ) {$params{x_offset} = 49 }
+ elsif ($col == 254 ) {$params{x_offset} = 49 }
+ elsif ($col == 255 ) {$params{x_offset} = 49 }
+ else {$params{x_offset} = 15 }
+ }
+
+
+ # Scale the size of the comment box if required.
+ if ($params{x_scale}) {
+ $params{width} = $params{width} * $params{x_scale};
+ }
+
+ if ($params{y_scale}) {
+ $params{height} = $params{height} * $params{y_scale};
+ }
+
+
+ # Calculate the positions of comment object.
+ my @vertices = $self->_position_object( $params{start_col},
+ $params{start_row},
+ $params{x_offset},
+ $params{y_offset},
+ $params{width},
+ $params{height}
+ );
+
+ return(
+ $row,
+ $col,
+ $string,
+ $params{encoding},
+ $params{author},
+ $params{author_encoding},
+ $params{visible},
+ $params{color},
+ [@vertices]
+ );
+}
+
+
+
+#
+# DATA VALIDATION
+#
+
+###############################################################################
+#
+# data_validation($row, $col, {...})
+#
+# This method handles the interface to Excel data validation.
+# Somewhat ironically the this requires a lot of validation code since the
+# interface is flexible and covers a several types of data validation.
+#
+# We allow data validation to be called on one cell or a range of cells. The
+# hashref contains the validation parameters and must be the last param:
+# data_validation($row, $col, {...})
+# data_validation($first_row, $first_col, $last_row, $last_col, {...})
+#
+# Returns 0 : normal termination
+# -1 : insufficient number of arguments
+# -2 : row or column out of range
+# -3 : incorrect parameter.
+#
+sub data_validation {
+
+ my $self = shift;
+
+ # Check for a cell reference in A1 notation and substitute row and column
+ if ($_[0] =~ /^\D/) {
+ @_ = $self->_substitute_cellref(@_);
+ }
+
+ # Check for a valid number of args.
+ if (@_ != 5 && @_ != 3) { return -1 }
+
+ # The final hashref contains the validation parameters.
+ my $param = pop;
+
+ # Make the last row/col the same as the first if not defined.
+ my ($row1, $col1, $row2, $col2) = @_;
+ if (!defined $row2) {
+ $row2 = $row1;
+ $col2 = $col1;
+ }
+
+ # Check that row and col are valid without storing the values.
+ return -2 if $self->_check_dimensions($row1, $col1, 1, 1);
+ return -2 if $self->_check_dimensions($row2, $col2, 1, 1);
+
+
+ # Check that the last parameter is a hash list.
+ if (ref $param ne 'HASH') {
+ carp "Last parameter '$param' in data_validation() must be a hash ref";
+ return -3;
+ }
+
+ # List of valid input parameters.
+ my %valid_parameter = (
+ validate => 1,
+ criteria => 1,
+ value => 1,
+ source => 1,
+ minimum => 1,
+ maximum => 1,
+ ignore_blank => 1,
+ dropdown => 1,
+ show_input => 1,
+ input_title => 1,
+ input_message => 1,
+ show_error => 1,
+ error_title => 1,
+ error_message => 1,
+ error_type => 1,
+ other_cells => 1,
+ );
+
+ # Check for valid input parameters.
+ for my $param_key (keys %$param) {
+ if (not exists $valid_parameter{$param_key}) {
+ carp "Unknown parameter '$param_key' in data_validation()";
+ return -3;
+ }
+ }
+
+ # Map alternative parameter names 'source' or 'minimum' to 'value'.
+ $param->{value} = $param->{source} if defined $param->{source};
+ $param->{value} = $param->{minimum} if defined $param->{minimum};
+
+ # 'validate' is a required parameter.
+ if (not exists $param->{validate}) {
+ carp "Parameter 'validate' is required in data_validation()";
+ return -3;
+ }
+
+
+ # List of valid validation types.
+ my %valid_type = (
+ 'any' => 0,
+ 'any value' => 0,
+ 'whole number' => 1,
+ 'whole' => 1,
+ 'integer' => 1,
+ 'decimal' => 2,
+ 'list' => 3,
+ 'date' => 4,
+ 'time' => 5,
+ 'text length' => 6,
+ 'length' => 6,
+ 'custom' => 7,
+ );
+
+
+ # Check for valid validation types.
+ if (not exists $valid_type{lc($param->{validate})}) {
+ carp "Unknown validation type '$param->{validate}' for parameter " .
+ "'validate' in data_validation()";
+ return -3;
+ }
+ else {
+ $param->{validate} = $valid_type{lc($param->{validate})};
+ }
+
+
+ # No action is required for validation type 'any'.
+ # TODO: we should perhaps store 'any' for message only validations.
+ return 0 if $param->{validate} == 0;
+
+
+ # The list and custom validations don't have a criteria so we use a default
+ # of 'between'.
+ if ($param->{validate} == 3 || $param->{validate} == 7) {
+ $param->{criteria} = 'between';
+ $param->{maximum} = undef;
+ }
+
+ # 'criteria' is a required parameter.
+ if (not exists $param->{criteria}) {
+ carp "Parameter 'criteria' is required in data_validation()";
+ return -3;
+ }
+
+
+ # List of valid criteria types.
+ my %criteria_type = (
+ 'between' => 0,
+ 'not between' => 1,
+ 'equal to' => 2,
+ '=' => 2,
+ '==' => 2,
+ 'not equal to' => 3,
+ '!=' => 3,
+ '<>' => 3,
+ 'greater than' => 4,
+ '>' => 4,
+ 'less than' => 5,
+ '<' => 5,
+ 'greater than or equal to' => 6,
+ '>=' => 6,
+ 'less than or equal to' => 7,
+ '<=' => 7,
+ );
+
+ # Check for valid criteria types.
+ if (not exists $criteria_type{lc($param->{criteria})}) {
+ carp "Unknown criteria type '$param->{criteria}' for parameter " .
+ "'criteria' in data_validation()";
+ return -3;
+ }
+ else {
+ $param->{criteria} = $criteria_type{lc($param->{criteria})};
+ }
+
+
+ # 'Between' and 'Not between' criteria require 2 values.
+ if ($param->{criteria} == 0 || $param->{criteria} == 1) {
+ if (not exists $param->{maximum}) {
+ carp "Parameter 'maximum' is required in data_validation() " .
+ "when using 'between' or 'not between' criteria";
+ return -3;
+ }
+ }
+ else {
+ $param->{maximum} = undef;
+ }
+
+
+
+ # List of valid error dialog types.
+ my %error_type = (
+ 'stop' => 0,
+ 'warning' => 1,
+ 'information' => 2,
+ );
+
+ # Check for valid error dialog types.
+ if (not exists $param->{error_type}) {
+ $param->{error_type} = 0;
+ }
+ elsif (not exists $error_type{lc($param->{error_type})}) {
+ carp "Unknown criteria type '$param->{error_type}' for parameter " .
+ "'error_type' in data_validation()";
+ return -3;
+ }
+ else {
+ $param->{error_type} = $error_type{lc($param->{error_type})};
+ }
+
+
+ # Convert date/times value if required.
+ if ($param->{validate} == 4 || $param->{validate} == 5) {
+ if ($param->{value} =~ /T/) {
+ my $date_time = $self->convert_date_time($param->{value});
+
+ if (!defined $date_time) {
+ carp "Invalid date/time value '$param->{value}' " .
+ "in data_validation()";
+ return -3;
+ }
+ else {
+ $param->{value} = $date_time;
+ }
+ }
+ if (defined $param->{maximum} && $param->{maximum} =~ /T/) {
+ my $date_time = $self->convert_date_time($param->{maximum});
+
+ if (!defined $date_time) {
+ carp "Invalid date/time value '$param->{maximum}' " .
+ "in data_validation()";
+ return -3;
+ }
+ else {
+ $param->{maximum} = $date_time;
+ }
+ }
+ }
+
+
+ # Set some defaults if they haven't been defined by the user.
+ $param->{ignore_blank} = 1 if !defined $param->{ignore_blank};
+ $param->{dropdown} = 1 if !defined $param->{dropdown};
+ $param->{show_input} = 1 if !defined $param->{show_input};
+ $param->{show_error} = 1 if !defined $param->{show_error};
+
+
+ # These are the cells to which the validation is applied.
+ $param->{cells} = [[$row1, $col1, $row2, $col2]];
+
+ # A (for now) undocumented parameter to pass additional cell ranges.
+ if (exists $param->{other_cells}) {
+
+ push @{$param->{cells}}, @{$param->{other_cells}};
+ }
+
+ # Store the validation information until we close the worksheet.
+ push @{$self->{_validations}}, $param;
+}
+
+
+###############################################################################
+#
+# _store_validation_count()
+#
+# Store the count of the DV records to follow.
+#
+# Note, this could be wrapped into _store_dv() but we may require separate
+# handling of the object id at a later stage.
+#
+sub _store_validation_count {
+
+ my $self = shift;
+
+ my $dv_count = @{$self->{_validations}};
+ my $obj_id = -1;
+
+ return unless $dv_count;
+
+ $self->_store_dval($obj_id , $dv_count);
+}
+
+
+###############################################################################
+#
+# _store_validations()
+#
+# Store the data_validation records.
+#
+sub _store_validations {
+
+ my $self = shift;
+
+ return unless scalar @{$self->{_validations}};
+
+ for my $param (@{$self->{_validations}}) {
+ $self->_store_dv( $param->{cells},
+ $param->{validate},
+ $param->{criteria},
+ $param->{value},
+ $param->{maximum},
+ $param->{input_title},
+ $param->{input_message},
+ $param->{error_title},
+ $param->{error_message},
+ $param->{error_type},
+ $param->{ignore_blank},
+ $param->{dropdown},
+ $param->{show_input},
+ $param->{show_error},
+ );
+ }
+}
+
+
+###############################################################################
+#
+# _store_dval()
+#
+# Store the DV record which contains the number of and information common to
+# all DV structures.
+#
+sub _store_dval {
+
+ my $self = shift;
+
+ my $record = 0x01B2; # Record identifier
+ my $length = 0x0012; # Bytes to follow
+
+ my $obj_id = $_[0]; # Object ID number.
+ my $dv_count = $_[1]; # Count of DV structs to follow.
+
+ my $flags = 0x0004; # Option flags.
+ my $x_coord = 0x00000000; # X coord of input box.
+ my $y_coord = 0x00000000; # Y coord of input box.
+
+
+ # Pack the record.
+ my $header = pack('vv', $record, $length);
+ my $data = pack('vVVVV', $flags, $x_coord, $y_coord, $obj_id, $dv_count);
+
+ $self->_append($header, $data);
+}
+
+
+###############################################################################
+#
+# _store_dv()
+#
+# Store the DV record that specifies the data validation criteria and options
+# for a range of cells..
+#
+sub _store_dv {
+
+ my $self = shift;
+
+ my $record = 0x01BE; # Record identifier
+ my $length = 0x0000; # Bytes to follow
+
+ my $flags = 0x00000000; # DV option flags.
+
+ my $cells = $_[0]; # Aref of cells to which DV applies.
+ my $validation_type = $_[1]; # Type of data validation.
+ my $criteria_type = $_[2]; # Validation criteria.
+ my $formula_1 = $_[3]; # Value/Source/Minimum formula.
+ my $formula_2 = $_[4]; # Maximum formula.
+ my $input_title = $_[5]; # Title of input message.
+ my $input_message = $_[6]; # Text of input message.
+ my $error_title = $_[7]; # Title of error message.
+ my $error_message = $_[8]; # Text of input message.
+ my $error_type = $_[9]; # Error dialog type.
+ my $ignore_blank = $_[10]; # Ignore blank cells.
+ my $dropdown = $_[11]; # Display dropdown with list.
+ my $input_box = $_[12]; # Display input box.
+ my $error_box = $_[13]; # Display error box.
+ my $ime_mode = 0; # IME input mode for far east fonts.
+ my $str_lookup = 0; # See below.
+
+ # Set the string lookup flag for 'list' validations with a string array.
+ if ($validation_type == 3 && ref $formula_1 eq 'ARRAY') {
+ $str_lookup = 1;
+ }
+
+ # The dropdown flag is stored as a negated value.
+ my $no_dropdown = not $dropdown;
+
+ # Set the required flags.
+ $flags |= $validation_type;
+ $flags |= $error_type << 4;
+ $flags |= $str_lookup << 7;
+ $flags |= $ignore_blank << 8;
+ $flags |= $no_dropdown << 9;
+ $flags |= $ime_mode << 10;
+ $flags |= $input_box << 18;
+ $flags |= $error_box << 19;
+ $flags |= $criteria_type << 20;
+
+ # Pack the validation formulas.
+ $formula_1 = $self->_pack_dv_formula($formula_1);
+ $formula_2 = $self->_pack_dv_formula($formula_2);
+
+ # Pack the input and error dialog strings.
+ $input_title = $self->_pack_dv_string($input_title, 32 );
+ $error_title = $self->_pack_dv_string($error_title, 32 );
+ $input_message = $self->_pack_dv_string($input_message, 255);
+ $error_message = $self->_pack_dv_string($error_message, 255);
+
+ # Pack the DV cell data.
+ my $dv_count = scalar @$cells;
+ my $dv_data = pack 'v', $dv_count;
+ for my $range (@$cells) {
+ $dv_data .= pack 'vvvv', $range->[0],
+ $range->[2],
+ $range->[1],
+ $range->[3];
+ }
+
+ # Pack the record.
+ my $data = pack 'V', $flags;
+ $data .= $input_title;
+ $data .= $error_title;
+ $data .= $input_message;
+ $data .= $error_message;
+ $data .= $formula_1;
+ $data .= $formula_2;
+ $data .= $dv_data;
+
+ my $header = pack('vv', $record, length $data);
+
+ $self->_append($header, $data);
+}
+
+
+###############################################################################
+#
+# _pack_dv_string()
+#
+# Pack the strings used in the input and error dialog captions and messages.
+# Captions are limited to 32 characters. Messages are limited to 255 chars.
+#
+sub _pack_dv_string {
+
+ my $self = shift;
+
+ my $string = $_[0];
+ my $max_length = $_[1];
+
+ my $str_length = 0;
+ my $encoding = 0;
+
+ # The default empty string is "\0".
+ if (!defined $string || $string eq '') {
+ $string = "\0";
+ }
+
+ # Excel limits DV captions to 32 chars and messages to 255.
+ if (length $string > $max_length) {
+ $string = substr($string, 0, $max_length);
+ }
+
+ $str_length = length $string;
+
+ # Handle utf8 strings in perl 5.8.
+ if ($] >= 5.008) {
+ require Encode;
+
+ if (Encode::is_utf8($string)) {
+ $string = Encode::encode("UTF-16LE", $string);
+ $encoding = 1;
+ }
+ }
+
+ return pack('vC', $str_length, $encoding) . $string;
+}
+
+
+###############################################################################
+#
+# _pack_dv_formula()
+#
+# Pack the formula used in the DV record. This is the same as an cell formula
+# with some additional header information. Note, DV formulas in Excel use
+# relative addressing (R1C1 and ptgXxxN) however we use the Formula.pm's
+# default absolute addressing (A1 and ptgXxx).
+#
+sub _pack_dv_formula {
+
+ my $self = shift;
+
+ my $formula = $_[0];
+ my $encoding = 0;
+ my $length = 0;
+ my $unused = 0x0000;
+ my @tokens;
+
+ # Return a default structure for unused formulas.
+ if (!defined $formula || $formula eq '') {
+ return pack('vv', 0, $unused);
+ }
+
+ # Pack a list array ref as a null separated string.
+ if (ref $formula eq 'ARRAY') {
+ $formula = join "\0", @$formula;
+ $formula = qq("$formula");
+ }
+
+ # Strip the = sign at the beginning of the formula string
+ $formula =~ s(^=)();
+
+ # Parse the formula using the parser in Formula.pm
+ my $parser = $self->{_parser};
+
+ # In order to raise formula errors from the point of view of the calling
+ # program we use an eval block and re-raise the error from here.
+ #
+ eval { @tokens = $parser->parse_formula($formula) };
+
+ if ($@) {
+ $@ =~ s/\n$//; # Strip the \n used in the Formula.pm die()
+ croak $@; # Re-raise the error
+ }
+ else {
+ # TODO test for non valid ptgs such as Sheet2!A1
+ }
+ # Force 2d ranges to be a reference class.
+ s/_range2d/_range2dR/ for @tokens;
+ s/_name/_nameR/ for @tokens;
+
+ # Parse the tokens into a formula string.
+ $formula = $parser->parse_tokens(@tokens);
+
+
+ return pack('vv', length $formula, $unused) . $formula;
+}
+
+
+
+
+
+1;
+
+
+__END__
+
+
+=head1 NAME
+
+Worksheet - A writer class for Excel Worksheets.
+
+=head1 SYNOPSIS
+
+See the documentation for Spreadsheet::WriteExcel
+
+=head1 DESCRIPTION
+
+This module is used in conjunction with Spreadsheet::WriteExcel.
+
+=head1 AUTHOR
+
+John McNamara jmcnamara@cpan.org
+
+=head1 COPYRIGHT
+
+© MM-MMX, John McNamara.
+
+All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself.
+
diff --git a/mcu/tools/perl/Text/CSV.pm b/mcu/tools/perl/Text/CSV.pm
new file mode 100644
index 0000000..5dd7226
--- /dev/null
+++ b/mcu/tools/perl/Text/CSV.pm
@@ -0,0 +1,2467 @@
+package Text::CSV;
+
+
+use strict;
+use Exporter;
+use Carp ();
+use vars qw( $VERSION $DEBUG @ISA @EXPORT_OK );
+@ISA = qw( Exporter );
+@EXPORT_OK = qw( csv );
+
+BEGIN {
+ $VERSION = '1.95';
+ $DEBUG = 0;
+}
+
+# if use CSV_XS, requires version
+my $Module_XS = 'Text::CSV_XS';
+my $Module_PP = 'Text::CSV_PP';
+my $XS_Version = '1.02';
+
+my $Is_Dynamic = 0;
+
+my @PublicMethods = qw/
+ version new error_diag error_input
+ known_attributes csv
+ PV IV NV
+/;
+#
+
+# Check the environment variable to decide worker module.
+
+unless ($Text::CSV::Worker) {
+ $Text::CSV::DEBUG and Carp::carp("Check used worker module...");
+
+ if ( exists $ENV{PERL_TEXT_CSV} ) {
+ if ($ENV{PERL_TEXT_CSV} eq '0' or $ENV{PERL_TEXT_CSV} eq 'Text::CSV_PP') {
+ _load_pp() or Carp::croak $@;
+ }
+ elsif ($ENV{PERL_TEXT_CSV} eq '1' or $ENV{PERL_TEXT_CSV} =~ /Text::CSV_XS\s*,\s*Text::CSV_PP/) {
+ _load_xs() or _load_pp() or Carp::croak $@;
+ }
+ elsif ($ENV{PERL_TEXT_CSV} eq '2' or $ENV{PERL_TEXT_CSV} eq 'Text::CSV_XS') {
+ _load_xs() or Carp::croak $@;
+ }
+ else {
+ Carp::croak "The value of environmental variable 'PERL_TEXT_CSV' is invalid.";
+ }
+ }
+ else {
+ _load_xs() or _load_pp() or Carp::croak $@;
+ }
+
+}
+
+sub new { # normal mode
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+
+ unless ( $proto ) { # for Text::CSV_XS/PP::new(0);
+ return eval qq| $Text::CSV::Worker\::new( \$proto ) |;
+ }
+
+ #if (ref $_[0] and $_[0]->{module}) {
+ # Carp::croak("Can't set 'module' in non dynamic mode.");
+ #}
+
+ if ( my $obj = $Text::CSV::Worker->new(@_) ) {
+ $obj->{_MODULE} = $Text::CSV::Worker;
+ bless $obj, $class;
+ return $obj;
+ }
+ else {
+ return;
+ }
+
+
+}
+
+
+sub require_xs_version { $XS_Version; }
+
+
+sub module {
+ my $proto = shift;
+ return !ref($proto) ? $Text::CSV::Worker
+ : ref($proto->{_MODULE}) ? ref($proto->{_MODULE}) : $proto->{_MODULE};
+}
+
+*backend = *module;
+
+
+sub is_xs {
+ return $_[0]->module eq $Module_XS;
+}
+
+
+sub is_pp {
+ return $_[0]->module eq $Module_PP;
+}
+
+
+sub is_dynamic { $Is_Dynamic; }
+
+sub _load_xs { _load($Module_XS, $XS_Version) }
+
+sub _load_pp { _load($Module_PP) }
+
+sub _load {
+ my ($module, $version) = @_;
+ $version ||= '';
+
+ $Text::CSV::DEBUG and Carp::carp "Load $module.";
+
+ eval qq| use $module $version |;
+
+ return if $@;
+
+ push @Text::CSV::ISA, $module;
+ $Text::CSV::Worker = $module;
+
+ local $^W;
+ no strict qw(refs);
+
+ for my $method (@PublicMethods) {
+ *{"Text::CSV::$method"} = \&{"$module\::$method"};
+ }
+ return 1;
+}
+
+
+
+1;
+__END__
+
+=pod
+
+=head1 NAME
+
+Text::CSV - comma-separated values manipulator (using XS or PurePerl)
+
+
+=head1 SYNOPSIS
+
+ use Text::CSV;
+
+ my @rows;
+ my $csv = Text::CSV->new ( { binary => 1 } ) # should set binary attribute.
+ or die "Cannot use CSV: ".Text::CSV->error_diag ();
+
+ open my $fh, "<:encoding(utf8)", "test.csv" or die "test.csv: $!";
+ while ( my $row = $csv->getline( $fh ) ) {
+ $row->[2] =~ m/pattern/ or next; # 3rd field should match
+ push @rows, $row;
+ }
+ $csv->eof or $csv->error_diag();
+ close $fh;
+
+ $csv->eol ("\r\n");
+
+ open $fh, ">:encoding(utf8)", "new.csv" or die "new.csv: $!";
+ $csv->print ($fh, $_) for @rows;
+ close $fh or die "new.csv: $!";
+
+ #
+ # parse and combine style
+ #
+
+ $status = $csv->combine(@columns); # combine columns into a string
+ $line = $csv->string(); # get the combined string
+
+ $status = $csv->parse($line); # parse a CSV string into fields
+ @columns = $csv->fields(); # get the parsed fields
+
+ $status = $csv->status (); # get the most recent status
+ $bad_argument = $csv->error_input (); # get the most recent bad argument
+ $diag = $csv->error_diag (); # if an error occurred, explains WHY
+
+ $status = $csv->print ($io, $colref); # Write an array of fields
+ # immediately to a file $io
+ $colref = $csv->getline ($io); # Read a line from file $io,
+ # parse it and return an array
+ # ref of fields
+ $csv->column_names (@names); # Set column names for getline_hr ()
+ $ref = $csv->getline_hr ($io); # getline (), but returns a hashref
+ $eof = $csv->eof (); # Indicate if last parse or
+ # getline () hit End Of File
+
+ $csv->types(\@t_array); # Set column types
+
+=head1 DESCRIPTION
+
+Text::CSV is a thin wrapper for L<Text::CSV_XS>-compatible modules now.
+All the backend modules provide facilities for the composition and
+decomposition of comma-separated values. Text::CSV uses Text::CSV_XS
+by default, and when Text::CSV_XS is not available, falls back on
+L<Text::CSV_PP>, which is bundled in the same distribution as this module.
+
+=head1 CHOOSING BACKEND
+
+This module respects an environmental variable called C<PERL_TEXT_CSV>
+when it decides a backend module to use. If this environmental variable
+is not set, it tries to load Text::CSV_XS, and if Text::CSV_XS is not
+available, falls back on Text::CSV_PP;
+
+If you always don't want it to fall back on Text::CSV_PP, set the variable
+like this (C<export> may be C<setenv>, C<set> and the likes, depending
+on your environment):
+
+ > export PERL_TEXT_CSV=Text::CSV_XS
+
+If you prefer Text::CSV_XS to Text::CSV_PP (default), then:
+
+ > export PERL_TEXT_CSV=Text::CSV_XS,Text::CSV_PP
+
+You may also want to set this variable at the top of your test files, in order
+not to be bothered with incompatibilities between backends (you need to wrap
+this in C<BEGIN>, and set before actually C<use>-ing Text::CSV module, as it
+decides its backend as soon as it's loaded):
+
+ BEGIN { $ENV{PERL_TEXT_CSV}='Text::CSV_PP'; }
+ use Text::CSV;
+
+=head1 NOTES
+
+This section is taken from Text::CSV_XS.
+
+=head2 Embedded newlines
+
+B<Important Note>: The default behavior is to accept only ASCII characters
+in the range from C<0x20> (space) to C<0x7E> (tilde). This means that the
+fields can not contain newlines. If your data contains newlines embedded in
+fields, or characters above C<0x7E> (tilde), or binary data, you B<I<must>>
+set C<< binary => 1 >> in the call to L</new>. To cover the widest range of
+parsing options, you will always want to set binary.
+
+But you still have the problem that you have to pass a correct line to the
+L</parse> method, which is more complicated from the usual point of usage:
+
+ my $csv = Text::CSV->new ({ binary => 1, eol => $/ });
+ while (<>) { # WRONG!
+ $csv->parse ($_);
+ my @fields = $csv->fields ();
+ }
+
+this will break, as the C<while> might read broken lines: it does not care
+about the quoting. If you need to support embedded newlines, the way to go
+is to B<not> pass L<C<eol>|/eol> in the parser (it accepts C<\n>, C<\r>,
+B<and> C<\r\n> by default) and then
+
+ my $csv = Text::CSV->new ({ binary => 1 });
+ open my $io, "<", $file or die "$file: $!";
+ while (my $row = $csv->getline ($io)) {
+ my @fields = @$row;
+ }
+
+The old(er) way of using global file handles is still supported
+
+ while (my $row = $csv->getline (*ARGV)) { ... }
+
+=head2 Unicode
+
+Unicode is only tested to work with perl-5.8.2 and up.
+
+The simplest way to ensure the correct encoding is used for in- and output
+is by either setting layers on the filehandles, or setting the L</encoding>
+argument for L</csv>.
+
+ open my $fh, "<:encoding(UTF-8)", "in.csv" or die "in.csv: $!";
+or
+ my $aoa = csv (in => "in.csv", encoding => "UTF-8");
+
+ open my $fh, ">:encoding(UTF-8)", "out.csv" or die "out.csv: $!";
+or
+ csv (in => $aoa, out => "out.csv", encoding => "UTF-8");
+
+On parsing (both for L</getline> and L</parse>), if the source is marked
+being UTF8, then all fields that are marked binary will also be marked UTF8.
+
+On combining (L</print> and L</combine>): if any of the combining fields
+was marked UTF8, the resulting string will be marked as UTF8. Note however
+that all fields I<before> the first field marked UTF8 and contained 8-bit
+characters that were not upgraded to UTF8, these will be C<bytes> in the
+resulting string too, possibly causing unexpected errors. If you pass data
+of different encoding, or you don't know if there is different encoding,
+force it to be upgraded before you pass them on:
+
+ $csv->print ($fh, [ map { utf8::upgrade (my $x = $_); $x } @data ]);
+
+For complete control over encoding, please use L<Text::CSV::Encoded>:
+
+ use Text::CSV::Encoded;
+ my $csv = Text::CSV::Encoded->new ({
+ encoding_in => "iso-8859-1", # the encoding comes into Perl
+ encoding_out => "cp1252", # the encoding comes out of Perl
+ });
+
+ $csv = Text::CSV::Encoded->new ({ encoding => "utf8" });
+ # combine () and print () accept *literally* utf8 encoded data
+ # parse () and getline () return *literally* utf8 encoded data
+
+ $csv = Text::CSV::Encoded->new ({ encoding => undef }); # default
+ # combine () and print () accept UTF8 marked data
+ # parse () and getline () return UTF8 marked data
+
+=head1 METHODS
+
+This whole section is also taken from Text::CSV_XS.
+
+=head2 version ()
+
+(Class method) Returns the current backend module version.
+
+=head2 new (\%attr)
+
+(Class method) Returns a new instance of Text::CSV backend. The attributes
+are described by the (optional) hash ref C<\%attr>.
+
+ my $csv = Text::CSV->new ({ attributes ... });
+
+The following attributes are available:
+
+=head3 eol
+
+ my $csv = Text::CSV->new ({ eol => $/ });
+ $csv->eol (undef);
+ my $eol = $csv->eol;
+
+The end-of-line string to add to rows for L</print> or the record separator
+for L</getline>.
+
+When not passed in a B<parser> instance, the default behavior is to accept
+C<\n>, C<\r>, and C<\r\n>, so it is probably safer to not specify C<eol> at
+all. Passing C<undef> or the empty string behave the same.
+
+When not passed in a B<generating> instance, records are not terminated at
+all, so it is probably wise to pass something you expect. A safe choice for
+C<eol> on output is either C<$/> or C<\r\n>.
+
+Common values for C<eol> are C<"\012"> (C<\n> or Line Feed), C<"\015\012">
+(C<\r\n> or Carriage Return, Line Feed), and C<"\015"> (C<\r> or Carriage
+Return). The L<C<eol>|/eol> attribute cannot exceed 7 (ASCII) characters.
+
+If both C<$/> and L<C<eol>|/eol> equal C<"\015">, parsing lines that end on
+only a Carriage Return without Line Feed, will be L</parse>d correct.
+
+=head3 sep_char
+
+ my $csv = Text::CSV->new ({ sep_char => ";" });
+ $csv->sep_char (";");
+ my $c = $csv->sep_char;
+
+The char used to separate fields, by default a comma. (C<,>). Limited to a
+single-byte character, usually in the range from C<0x20> (space) to C<0x7E>
+(tilde). When longer sequences are required, use L<C<sep>|/sep>.
+
+The separation character can not be equal to the quote character or to the
+escape character.
+
+=head3 sep
+
+ my $csv = Text::CSV->new ({ sep => "\N{FULLWIDTH COMMA}" });
+ $csv->sep (";");
+ my $sep = $csv->sep;
+
+The chars used to separate fields, by default undefined. Limited to 8 bytes.
+
+When set, overrules L<C<sep_char>|/sep_char>. If its length is one byte it
+acts as an alias to L<C<sep_char>|/sep_char>.
+
+=head3 quote_char
+
+ my $csv = Text::CSV->new ({ quote_char => "'" });
+ $csv->quote_char (undef);
+ my $c = $csv->quote_char;
+
+The character to quote fields containing blanks or binary data, by default
+the double quote character (C<">). A value of undef suppresses quote chars
+(for simple cases only). Limited to a single-byte character, usually in the
+range from C<0x20> (space) to C<0x7E> (tilde). When longer sequences are
+required, use L<C<quote>|/quote>.
+
+C<quote_char> can not be equal to L<C<sep_char>|/sep_char>.
+
+=head3 quote
+
+ my $csv = Text::CSV->new ({ quote => "\N{FULLWIDTH QUOTATION MARK}" });
+ $csv->quote ("'");
+ my $quote = $csv->quote;
+
+The chars used to quote fields, by default undefined. Limited to 8 bytes.
+
+When set, overrules L<C<quote_char>|/quote_char>. If its length is one byte
+it acts as an alias to L<C<quote_char>|/quote_char>.
+
+=head3 escape_char
+
+ my $csv = Text::CSV->new ({ escape_char => "\\" });
+ $csv->escape_char (undef);
+ my $c = $csv->escape_char;
+
+The character to escape certain characters inside quoted fields. This is
+limited to a single-byte character, usually in the range from C<0x20>
+(space) to C<0x7E> (tilde).
+
+The C<escape_char> defaults to being the double-quote mark (C<">). In other
+words the same as the default L<C<quote_char>|/quote_char>. This means that
+doubling the quote mark in a field escapes it:
+
+ "foo","bar","Escape ""quote mark"" with two ""quote marks""","baz"
+
+If you change the L<C<quote_char>|/quote_char> without changing the
+C<escape_char>, the C<escape_char> will still be the double-quote (C<">).
+If instead you want to escape the L<C<quote_char>|/quote_char> by doubling
+it you will need to also change the C<escape_char> to be the same as what
+you have changed the L<C<quote_char>|/quote_char> to.
+
+The escape character can not be equal to the separation character.
+
+=head3 binary
+
+ my $csv = Text::CSV->new ({ binary => 1 });
+ $csv->binary (0);
+ my $f = $csv->binary;
+
+If this attribute is C<1>, you may use binary characters in quoted fields,
+including line feeds, carriage returns and C<NULL> bytes. (The latter could
+be escaped as C<"0>.) By default this feature is off.
+
+If a string is marked UTF8, C<binary> will be turned on automatically when
+binary characters other than C<CR> and C<NL> are encountered. Note that a
+simple string like C<"\x{00a0}"> might still be binary, but not marked UTF8,
+so setting C<< { binary => 1 } >> is still a wise option.
+
+=head3 decode_utf8
+
+ my $csv = Text::CSV->new ({ decode_utf8 => 1 });
+ $csv->decode_utf8 (0);
+ my $f = $csv->decode_utf8;
+
+This attributes defaults to TRUE.
+
+While I<parsing>, fields that are valid UTF-8, are automatically set to be
+UTF-8, so that
+
+ $csv->parse ("\xC4\xA8\n");
+
+results in
+
+ PV("\304\250"\0) [UTF8 "\x{128}"]
+
+Sometimes it might not be a desired action. To prevent those upgrades, set
+this attribute to false, and the result will be
+
+ PV("\304\250"\0)
+
+=head3 auto_diag
+
+ my $csv = Text::CSV->new ({ auto_diag => 1 });
+ $csv->auto_diag (2);
+ my $l = $csv->auto_diag;
+
+Set this attribute to a number between C<1> and C<9> causes L</error_diag>
+to be automatically called in void context upon errors.
+
+In case of error C<2012 - EOF>, this call will be void.
+
+If C<auto_diag> is set to a numeric value greater than C<1>, it will C<die>
+on errors instead of C<warn>. If set to anything unrecognized, it will be
+silently ignored.
+
+Future extensions to this feature will include more reliable auto-detection
+of C<autodie> being active in the scope of which the error occurred which
+will increment the value of C<auto_diag> with C<1> the moment the error is
+detected.
+
+=head3 diag_verbose
+
+ my $csv = Text::CSV->new ({ diag_verbose => 1 });
+ $csv->diag_verbose (2);
+ my $l = $csv->diag_verbose;
+
+Set the verbosity of the output triggered by C<auto_diag>. Currently only
+adds the current input-record-number (if known) to the diagnostic output
+with an indication of the position of the error.
+
+=head3 blank_is_undef
+
+ my $csv = Text::CSV->new ({ blank_is_undef => 1 });
+ $csv->blank_is_undef (0);
+ my $f = $csv->blank_is_undef;
+
+Under normal circumstances, C<CSV> data makes no distinction between quoted-
+and unquoted empty fields. These both end up in an empty string field once
+read, thus
+
+ 1,"",," ",2
+
+is read as
+
+ ("1", "", "", " ", "2")
+
+When I<writing> C<CSV> files with either L<C<always_quote>|/always_quote>
+or L<C<quote_empty>|/quote_empty> set, the unquoted I<empty> field is the
+result of an undefined value. To enable this distinction when I<reading>
+C<CSV> data, the C<blank_is_undef> attribute will cause unquoted empty
+fields to be set to C<undef>, causing the above to be parsed as
+
+ ("1", "", undef, " ", "2")
+
+note that this is specifically important when loading C<CSV> fields into a
+database that allows C<NULL> values, as the perl equivalent for C<NULL> is
+C<undef> in L<DBI> land.
+
+=head3 empty_is_undef
+
+ my $csv = Text::CSV->new ({ empty_is_undef => 1 });
+ $csv->empty_is_undef (0);
+ my $f = $csv->empty_is_undef;
+
+Going one step further than L<C<blank_is_undef>|/blank_is_undef>, this
+attribute converts all empty fields to C<undef>, so
+
+ 1,"",," ",2
+
+is read as
+
+ (1, undef, undef, " ", 2)
+
+Note that this effects only fields that are originally empty, not fields
+that are empty after stripping allowed whitespace. YMMV.
+
+=head3 allow_whitespace
+
+ my $csv = Text::CSV->new ({ allow_whitespace => 1 });
+ $csv->allow_whitespace (0);
+ my $f = $csv->allow_whitespace;
+
+When this option is set to true, the whitespace (C<TAB>'s and C<SPACE>'s)
+surrounding the separation character is removed when parsing. If either
+C<TAB> or C<SPACE> is one of the three characters L<C<sep_char>|/sep_char>,
+L<C<quote_char>|/quote_char>, or L<C<escape_char>|/escape_char> it will not
+be considered whitespace.
+
+Now lines like:
+
+ 1 , "foo" , bar , 3 , zapp
+
+are parsed as valid C<CSV>, even though it violates the C<CSV> specs.
+
+Note that B<all> whitespace is stripped from both start and end of each
+field. That would make it I<more> than a I<feature> to enable parsing bad
+C<CSV> lines, as
+
+ 1, 2.0, 3, ape , monkey
+
+will now be parsed as
+
+ ("1", "2.0", "3", "ape", "monkey")
+
+even if the original line was perfectly acceptable C<CSV>.
+
+=head3 allow_loose_quotes
+
+ my $csv = Text::CSV->new ({ allow_loose_quotes => 1 });
+ $csv->allow_loose_quotes (0);
+ my $f = $csv->allow_loose_quotes;
+
+By default, parsing unquoted fields containing L<C<quote_char>|/quote_char>
+characters like
+
+ 1,foo "bar" baz,42
+
+would result in parse error 2034. Though it is still bad practice to allow
+this format, we cannot help the fact that some vendors make their
+applications spit out lines styled this way.
+
+If there is B<really> bad C<CSV> data, like
+
+ 1,"foo "bar" baz",42
+
+or
+
+ 1,""foo bar baz"",42
+
+there is a way to get this data-line parsed and leave the quotes inside the
+quoted field as-is. This can be achieved by setting C<allow_loose_quotes>
+B<AND> making sure that the L<C<escape_char>|/escape_char> is I<not> equal
+to L<C<quote_char>|/quote_char>.
+
+=head3 allow_loose_escapes
+
+ my $csv = Text::CSV->new ({ allow_loose_escapes => 1 });
+ $csv->allow_loose_escapes (0);
+ my $f = $csv->allow_loose_escapes;
+
+Parsing fields that have L<C<escape_char>|/escape_char> characters that
+escape characters that do not need to be escaped, like:
+
+ my $csv = Text::CSV->new ({ escape_char => "\\" });
+ $csv->parse (qq{1,"my bar\'s",baz,42});
+
+would result in parse error 2025. Though it is bad practice to allow this
+format, this attribute enables you to treat all escape character sequences
+equal.
+
+=head3 allow_unquoted_escape
+
+ my $csv = Text::CSV->new ({ allow_unquoted_escape => 1 });
+ $csv->allow_unquoted_escape (0);
+ my $f = $csv->allow_unquoted_escape;
+
+A backward compatibility issue where L<C<escape_char>|/escape_char> differs
+from L<C<quote_char>|/quote_char> prevents L<C<escape_char>|/escape_char>
+to be in the first position of a field. If L<C<quote_char>|/quote_char> is
+equal to the default C<"> and L<C<escape_char>|/escape_char> is set to C<\>,
+this would be illegal:
+
+ 1,\0,2
+
+Setting this attribute to C<1> might help to overcome issues with backward
+compatibility and allow this style.
+
+=head3 always_quote
+
+ my $csv = Text::CSV->new ({ always_quote => 1 });
+ $csv->always_quote (0);
+ my $f = $csv->always_quote;
+
+By default the generated fields are quoted only if they I<need> to be. For
+example, if they contain the separator character. If you set this attribute
+to C<1> then I<all> defined fields will be quoted. (C<undef> fields are not
+quoted, see L</blank_is_undef>). This makes it quite often easier to handle
+exported data in external applications.
+
+=head3 quote_space
+
+ my $csv = Text::CSV->new ({ quote_space => 1 });
+ $csv->quote_space (0);
+ my $f = $csv->quote_space;
+
+By default, a space in a field would trigger quotation. As no rule exists
+this to be forced in C<CSV>, nor any for the opposite, the default is true
+for safety. You can exclude the space from this trigger by setting this
+attribute to 0.
+
+=head3 quote_empty
+
+ my $csv = Text::CSV->new ({ quote_empty => 1 });
+ $csv->quote_empty (0);
+ my $f = $csv->quote_empty;
+
+By default the generated fields are quoted only if they I<need> to be. An
+empty (defined) field does not need quotation. If you set this attribute to
+C<1> then I<empty> defined fields will be quoted. (C<undef> fields are not
+quoted, see L</blank_is_undef>). See also L<C<always_quote>|/always_quote>.
+
+=head3 quote_binary
+
+ my $csv = Text::CSV->new ({ quote_binary => 1 });
+ $csv->quote_binary (0);
+ my $f = $csv->quote_binary;
+
+By default, all "unsafe" bytes inside a string cause the combined field to
+be quoted. By setting this attribute to C<0>, you can disable that trigger
+for bytes >= C<0x7F>.
+
+=head3 escape_null or quote_null (deprecated)
+
+ my $csv = Text::CSV->new ({ escape_null => 1 });
+ $csv->escape_null (0);
+ my $f = $csv->escape_null;
+
+By default, a C<NULL> byte in a field would be escaped. This option enables
+you to treat the C<NULL> byte as a simple binary character in binary mode
+(the C<< { binary => 1 } >> is set). The default is true. You can prevent
+C<NULL> escapes by setting this attribute to C<0>.
+
+The default when using the C<csv> function is C<false>.
+
+=head3 keep_meta_info
+
+ my $csv = Text::CSV->new ({ keep_meta_info => 1 });
+ $csv->keep_meta_info (0);
+ my $f = $csv->keep_meta_info;
+
+By default, the parsing of input records is as simple and fast as possible.
+However, some parsing information - like quotation of the original field -
+is lost in that process. Setting this flag to true enables retrieving that
+information after parsing with the methods L</meta_info>, L</is_quoted>,
+and L</is_binary> described below. Default is false for performance.
+
+If you set this attribute to a value greater than 9, than you can control
+output quotation style like it was used in the input of the the last parsed
+record (unless quotation was added because of other reasons).
+
+ my $csv = Text::CSV->new ({
+ binary => 1,
+ keep_meta_info => 1,
+ quote_space => 0,
+ });
+
+ my $row = $csv->parse (q{1,,"", ," ",f,"g","h""h",help,"help"});
+
+ $csv->print (*STDOUT, \@row);
+ # 1,,, , ,f,g,"h""h",help,help
+ $csv->keep_meta_info (11);
+ $csv->print (*STDOUT, \@row);
+ # 1,,"", ," ",f,"g","h""h",help,"help"
+
+=head3 verbatim
+
+ my $csv = Text::CSV->new ({ verbatim => 1 });
+ $csv->verbatim (0);
+ my $f = $csv->verbatim;
+
+This is a quite controversial attribute to set, but makes some hard things
+possible.
+
+The rationale behind this attribute is to tell the parser that the normally
+special characters newline (C<NL>) and Carriage Return (C<CR>) will not be
+special when this flag is set, and be dealt with as being ordinary binary
+characters. This will ease working with data with embedded newlines.
+
+When C<verbatim> is used with L</getline>, L</getline> auto-C<chomp>'s
+every line.
+
+Imagine a file format like
+
+ M^^Hans^Janssen^Klas 2\n2A^Ja^11-06-2007#\r\n
+
+where, the line ending is a very specific C<"#\r\n">, and the sep_char is a
+C<^> (caret). None of the fields is quoted, but embedded binary data is
+likely to be present. With the specific line ending, this should not be too
+hard to detect.
+
+By default, Text::CSV' parse function is instructed to only know about
+C<"\n"> and C<"\r"> to be legal line endings, and so has to deal with the
+embedded newline as a real C<end-of-line>, so it can scan the next line if
+binary is true, and the newline is inside a quoted field. With this option,
+we tell L</parse> to parse the line as if C<"\n"> is just nothing more than
+a binary character.
+
+For L</parse> this means that the parser has no more idea about line ending
+and L</getline> C<chomp>s line endings on reading.
+
+=head3 types
+
+A set of column types; the attribute is immediately passed to the L</types>
+method.
+
+=head3 callbacks
+
+See the L</Callbacks> section below.
+
+=head3 accessors
+
+To sum it up,
+
+ $csv = Text::CSV->new ();
+
+is equivalent to
+
+ $csv = Text::CSV->new ({
+ eol => undef, # \r, \n, or \r\n
+ sep_char => ',',
+ sep => undef,
+ quote_char => '"',
+ quote => undef,
+ escape_char => '"',
+ binary => 0,
+ decode_utf8 => 1,
+ auto_diag => 0,
+ diag_verbose => 0,
+ blank_is_undef => 0,
+ empty_is_undef => 0,
+ allow_whitespace => 0,
+ allow_loose_quotes => 0,
+ allow_loose_escapes => 0,
+ allow_unquoted_escape => 0,
+ always_quote => 0,
+ quote_empty => 0,
+ quote_space => 1,
+ escape_null => 1,
+ quote_binary => 1,
+ keep_meta_info => 0,
+ verbatim => 0,
+ types => undef,
+ callbacks => undef,
+ });
+
+For all of the above mentioned flags, an accessor method is available where
+you can inquire the current value, or change the value
+
+ my $quote = $csv->quote_char;
+ $csv->binary (1);
+
+It is not wise to change these settings halfway through writing C<CSV> data
+to a stream. If however you want to create a new stream using the available
+C<CSV> object, there is no harm in changing them.
+
+If the L</new> constructor call fails, it returns C<undef>, and makes the
+fail reason available through the L</error_diag> method.
+
+ $csv = Text::CSV->new ({ ecs_char => 1 }) or
+ die "".Text::CSV->error_diag ();
+
+L</error_diag> will return a string like
+
+ "INI - Unknown attribute 'ecs_char'"
+
+=head2 known_attributes
+
+ @attr = Text::CSV->known_attributes;
+ @attr = Text::CSV::known_attributes;
+ @attr = $csv->known_attributes;
+
+This method will return an ordered list of all the supported attributes as
+described above. This can be useful for knowing what attributes are valid
+in classes that use or extend Text::CSV.
+
+=head2 print
+
+ $status = $csv->print ($io, $colref);
+
+Similar to L</combine> + L</string> + L</print>, but much more efficient.
+It expects an array ref as input (not an array!) and the resulting string
+is not really created, but immediately written to the C<$io> object,
+typically an IO handle or any other object that offers a L</print> method.
+
+For performance reasons C<print> does not create a result string, so all
+L</string>, L</status>, L</fields>, and L</error_input> methods will return
+undefined information after executing this method.
+
+If C<$colref> is C<undef> (explicit, not through a variable argument) and
+L</bind_columns> was used to specify fields to be printed, it is possible
+to make performance improvements, as otherwise data would have to be copied
+as arguments to the method call:
+
+ $csv->bind_columns (\($foo, $bar));
+ $status = $csv->print ($fh, undef);
+
+=head2 say
+
+ $status = $csv->say ($io, $colref);
+
+Like L<C<print>|/print>, but L<C<eol>|/eol> defaults to C<$\>.
+
+=head2 print_hr
+
+ $csv->print_hr ($io, $ref);
+
+Provides an easy way to print a C<$ref> (as fetched with L</getline_hr>)
+provided the column names are set with L</column_names>.
+
+It is just a wrapper method with basic parameter checks over
+
+ $csv->print ($io, [ map { $ref->{$_} } $csv->column_names ]);
+
+=head2 combine
+
+ $status = $csv->combine (@fields);
+
+This method constructs a C<CSV> record from C<@fields>, returning success
+or failure. Failure can result from lack of arguments or an argument that
+contains an invalid character. Upon success, L</string> can be called to
+retrieve the resultant C<CSV> string. Upon failure, the value returned by
+L</string> is undefined and L</error_input> could be called to retrieve the
+invalid argument.
+
+=head2 string
+
+ $line = $csv->string ();
+
+This method returns the input to L</parse> or the resultant C<CSV> string
+of L</combine>, whichever was called more recently.
+
+=head2 getline
+
+ $colref = $csv->getline ($io);
+
+This is the counterpart to L</print>, as L</parse> is the counterpart to
+L</combine>: it parses a row from the C<$io> handle using the L</getline>
+method associated with C<$io> and parses this row into an array ref. This
+array ref is returned by the function or C<undef> for failure. When C<$io>
+does not support C<getline>, you are likely to hit errors.
+
+When fields are bound with L</bind_columns> the return value is a reference
+to an empty list.
+
+The L</string>, L</fields>, and L</status> methods are meaningless again.
+
+=head2 getline_all
+
+ $arrayref = $csv->getline_all ($io);
+ $arrayref = $csv->getline_all ($io, $offset);
+ $arrayref = $csv->getline_all ($io, $offset, $length);
+
+This will return a reference to a list of L<getline ($io)|/getline> results.
+In this call, C<keep_meta_info> is disabled. If C<$offset> is negative, as
+with C<splice>, only the last C<abs ($offset)> records of C<$io> are taken
+into consideration.
+
+Given a CSV file with 10 lines:
+
+ lines call
+ ----- ---------------------------------------------------------
+ 0..9 $csv->getline_all ($io) # all
+ 0..9 $csv->getline_all ($io, 0) # all
+ 8..9 $csv->getline_all ($io, 8) # start at 8
+ - $csv->getline_all ($io, 0, 0) # start at 0 first 0 rows
+ 0..4 $csv->getline_all ($io, 0, 5) # start at 0 first 5 rows
+ 4..5 $csv->getline_all ($io, 4, 2) # start at 4 first 2 rows
+ 8..9 $csv->getline_all ($io, -2) # last 2 rows
+ 6..7 $csv->getline_all ($io, -4, 2) # first 2 of last 4 rows
+
+=head2 getline_hr
+
+The L</getline_hr> and L</column_names> methods work together to allow you
+to have rows returned as hashrefs. You must call L</column_names> first to
+declare your column names.
+
+ $csv->column_names (qw( code name price description ));
+ $hr = $csv->getline_hr ($io);
+ print "Price for $hr->{name} is $hr->{price} EUR\n";
+
+L</getline_hr> will croak if called before L</column_names>.
+
+Note that L</getline_hr> creates a hashref for every row and will be much
+slower than the combined use of L</bind_columns> and L</getline> but still
+offering the same ease of use hashref inside the loop:
+
+ my @cols = @{$csv->getline ($io)};
+ $csv->column_names (@cols);
+ while (my $row = $csv->getline_hr ($io)) {
+ print $row->{price};
+ }
+
+Could easily be rewritten to the much faster:
+
+ my @cols = @{$csv->getline ($io)};
+ my $row = {};
+ $csv->bind_columns (\@{$row}{@cols});
+ while ($csv->getline ($io)) {
+ print $row->{price};
+ }
+
+Your mileage may vary for the size of the data and the number of rows.
+
+=head2 getline_hr_all
+
+ $arrayref = $csv->getline_hr_all ($io);
+ $arrayref = $csv->getline_hr_all ($io, $offset);
+ $arrayref = $csv->getline_hr_all ($io, $offset, $length);
+
+This will return a reference to a list of L<getline_hr ($io)|/getline_hr>
+results. In this call, L<C<keep_meta_info>|/keep_meta_info> is disabled.
+
+=head2 parse
+
+ $status = $csv->parse ($line);
+
+This method decomposes a C<CSV> string into fields, returning success or
+failure. Failure can result from a lack of argument or the given C<CSV>
+string is improperly formatted. Upon success, L</fields> can be called to
+retrieve the decomposed fields. Upon failure calling L</fields> will return
+undefined data and L</error_input> can be called to retrieve the invalid
+argument.
+
+You may use the L</types> method for setting column types. See L</types>'
+description below.
+
+The C<$line> argument is supposed to be a simple scalar. Everything else is
+supposed to croak and set error 1500.
+
+=head2 fragment
+
+This function tries to implement RFC7111 (URI Fragment Identifiers for the
+text/csv Media Type) - http://tools.ietf.org/html/rfc7111
+
+ my $AoA = $csv->fragment ($io, $spec);
+
+In specifications, C<*> is used to specify the I<last> item, a dash (C<->)
+to indicate a range. All indices are C<1>-based: the first row or column
+has index C<1>. Selections can be combined with the semi-colon (C<;>).
+
+When using this method in combination with L</column_names>, the returned
+reference will point to a list of hashes instead of a list of lists. A
+disjointed cell-based combined selection might return rows with different
+number of columns making the use of hashes unpredictable.
+
+ $csv->column_names ("Name", "Age");
+ my $AoH = $csv->fragment ($io, "col=3;8");
+
+If the L</after_parse> callback is active, it is also called on every line
+parsed and skipped before the fragment.
+
+=over 2
+
+=item row
+
+ row=4
+ row=5-7
+ row=6-*
+ row=1-2;4;6-*
+
+=item col
+
+ col=2
+ col=1-3
+ col=4-*
+ col=1-2;4;7-*
+
+=item cell
+
+In cell-based selection, the comma (C<,>) is used to pair row and column
+
+ cell=4,1
+
+The range operator (C<->) using C<cell>s can be used to define top-left and
+bottom-right C<cell> location
+
+ cell=3,1-4,6
+
+The C<*> is only allowed in the second part of a pair
+
+ cell=3,2-*,2 # row 3 till end, only column 2
+ cell=3,2-3,* # column 2 till end, only row 3
+ cell=3,2-*,* # strip row 1 and 2, and column 1
+
+Cells and cell ranges may be combined with C<;>, possibly resulting in rows
+with different number of columns
+
+ cell=1,1-2,2;3,3-4,4;1,4;4,1
+
+Disjointed selections will only return selected cells. The cells that are
+not specified will not be included in the returned set, not even as
+C<undef>. As an example given a C<CSV> like
+
+ 11,12,13,...19
+ 21,22,...28,29
+ : :
+ 91,...97,98,99
+
+with C<cell=1,1-2,2;3,3-4,4;1,4;4,1> will return:
+
+ 11,12,14
+ 21,22
+ 33,34
+ 41,43,44
+
+Overlapping cell-specs will return those cells only once, So
+C<cell=1,1-3,3;2,2-4,4;2,3;4,2> will return:
+
+ 11,12,13
+ 21,22,23,24
+ 31,32,33,34
+ 42,43,44
+
+=back
+
+L<RFC7111|http://tools.ietf.org/html/rfc7111> does B<not> allow different
+types of specs to be combined (either C<row> I<or> C<col> I<or> C<cell>).
+Passing an invalid fragment specification will croak and set error 2013.
+
+=head2 column_names
+
+Set the "keys" that will be used in the L</getline_hr> calls. If no keys
+(column names) are passed, it will return the current setting as a list.
+
+L</column_names> accepts a list of scalars (the column names) or a single
+array_ref, so you can pass the return value from L</getline> too:
+
+ $csv->column_names ($csv->getline ($io));
+
+L</column_names> does B<no> checking on duplicates at all, which might lead
+to unexpected results. Undefined entries will be replaced with the string
+C<"\cAUNDEF\cA">, so
+
+ $csv->column_names (undef, "", "name", "name");
+ $hr = $csv->getline_hr ($io);
+
+Will set C<< $hr->{"\cAUNDEF\cA"} >> to the 1st field, C<< $hr->{""} >> to
+the 2nd field, and C<< $hr->{name} >> to the 4th field, discarding the 3rd
+field.
+
+L</column_names> croaks on invalid arguments.
+
+=head2 header
+
+This method does NOT work in perl-5.6.x
+
+Parse the CSV header and set L<C<sep>|/sep>, column_names and encoding.
+
+ my @hdr = $csv->header ($fh);
+ $csv->header ($fh, { sep_set => [ ";", ",", "|", "\t" ] });
+ $csv->header ($fh, { detect_bom => 1, munge_column_names => "lc" });
+
+The first argument should be a file handle.
+
+Assuming that the file opened for parsing has a header, and the header does
+not contain problematic characters like embedded newlines, read the first
+line from the open handle then auto-detect whether the header separates the
+column names with a character from the allowed separator list.
+
+If any of the allowed separators matches, and none of the I<other> allowed
+separators match, set L<C<sep>|/sep> to that separator for the current
+CSV_PP instance and use it to parse the first line, map those to lowercase,
+and use that to set the instance L</column_names>:
+
+ my $csv = Text::CSV->new ({ binary => 1, auto_diag => 1 });
+ open my $fh, "<", "file.csv";
+ binmode $fh; # for Windows
+ $csv->header ($fh);
+ while (my $row = $csv->getline_hr ($fh)) {
+ ...
+ }
+
+If the header is empty, contains more than one unique separator out of the
+allowed set, contains empty fields, or contains identical fields (after
+folding), it will croak with error 1010, 1011, 1012, or 1013 respectively.
+
+If the header contains embedded newlines or is not valid CSV in any other
+way, this method will croak and leave the parse error untouched.
+
+A successful call to C<header> will always set the L<C<sep>|/sep> of the
+C<$csv> object. This behavior can not be disabled.
+
+=head3 return value
+
+On error this method will croak.
+
+In list context, the headers will be returned whether they are used to set
+L</column_names> or not.
+
+In scalar context, the instance itself is returned. B<Note>: the values as
+found in the header will effectively be B<lost> if C<set_column_names> is
+false.
+
+=head3 Options
+
+=over 2
+
+=item sep_set
+
+ $csv->header ($fh, { sep_set => [ ";", ",", "|", "\t" ] });
+
+The list of legal separators defaults to C<[ ";", "," ]> and can be changed
+by this option. As this is probably the most often used option, it can be
+passed on its own as an unnamed argument:
+
+ $csv->header ($fh, [ ";", ",", "|", "\t", "::", "\x{2063}" ]);
+
+Multi-byte sequences are allowed, both multi-character and Unicode. See
+L<C<sep>|/sep>.
+
+=item detect_bom
+
+ $csv->header ($fh, { detect_bom => 1 });
+
+The default behavior is to detect if the header line starts with a BOM. If
+the header has a BOM, use that to set the encoding of C<$fh>. This default
+behavior can be disabled by passing a false value to C<detect_bom>.
+
+Supported encodings from BOM are: UTF-8, UTF-16BE, UTF-16LE, UTF-32BE, and
+UTF-32LE. BOM's also support UTF-1, UTF-EBCDIC, SCSU, BOCU-1, and GB-18030
+but L<Encode> does not (yet). UTF-7 is not supported.
+
+The encoding is set using C<binmode> on C<$fh>.
+
+If the handle was opened in a (correct) encoding, this method will B<not>
+alter the encoding, as it checks the leading B<bytes> of the first line.
+
+=item munge_column_names
+
+This option offers the means to modify the column names into something that
+is most useful to the application. The default is to map all column names
+to lower case.
+
+ $csv->header ($fh, { munge_column_names => "lc" });
+
+The following values are available:
+
+ lc - lower case
+ uc - upper case
+ none - do not change
+ \&cb - supply a callback
+
+ $csv->header ($fh, { munge_column_names => sub { fc } });
+ $csv->header ($fh, { munge_column_names => sub { "column_".$col++ } });
+ $csv->header ($fh, { munge_column_names => sub { lc (s/\W+/_/gr) } });
+
+As this callback is called in a C<map>, you can use C<$_> directly.
+
+=item set_column_names
+
+ $csv->header ($fh, { set_column_names => 1 });
+
+The default is to set the instances column names using L</column_names> if
+the method is successful, so subsequent calls to L</getline_hr> can return
+a hash. Disable setting the header can be forced by using a false value for
+this option.
+
+=back
+
+=head3 Validation
+
+When receiving CSV files from external sources, this method can be used to
+protect against changes in the layout by restricting to known headers (and
+typos in the header fields).
+
+ my %known = (
+ "record key" => "c_rec",
+ "rec id" => "c_rec",
+ "id_rec" => "c_rec",
+ "kode" => "code",
+ "code" => "code",
+ "vaule" => "value",
+ "value" => "value",
+ );
+ my $csv = Text::CSV->new ({ binary => 1, auto_diag => 1 });
+ open my $fh, "<", $source or die "$source: $!";
+ $csv->header ($fh, { munge_column_names => sub {
+ s/\s+$//;
+ s/^\s+//;
+ $known{lc $_} or die "Unknown column '$_' in $source";
+ }});
+ while (my $row = $csv->getline_hr ($fh)) {
+ say join "\t", $row->{c_rec}, $row->{code}, $row->{value};
+ }
+
+=head2 bind_columns
+
+Takes a list of scalar references to be used for output with L</print> or
+to store in the fields fetched by L</getline>. When you do not pass enough
+references to store the fetched fields in, L</getline> will fail with error
+C<3006>. If you pass more than there are fields to return, the content of
+the remaining references is left untouched.
+
+ $csv->bind_columns (\$code, \$name, \$price, \$description);
+ while ($csv->getline ($io)) {
+ print "The price of a $name is \x{20ac} $price\n";
+ }
+
+To reset or clear all column binding, call L</bind_columns> with the single
+argument C<undef>. This will also clear column names.
+
+ $csv->bind_columns (undef);
+
+If no arguments are passed at all, L</bind_columns> will return the list of
+current bindings or C<undef> if no binds are active.
+
+Note that in parsing with C<bind_columns>, the fields are set on the fly.
+That implies that if the third field of a row causes an error, the first
+two fields already have been assigned the values of the current row, while
+the rest will still hold the values of the previous row.
+
+=head2 eof
+
+ $eof = $csv->eof ();
+
+If L</parse> or L</getline> was used with an IO stream, this method will
+return true (1) if the last call hit end of file, otherwise it will return
+false (''). This is useful to see the difference between a failure and end
+of file.
+
+Note that if the parsing of the last line caused an error, C<eof> is still
+true. That means that if you are I<not> using L</auto_diag>, an idiom like
+
+ while (my $row = $csv->getline ($fh)) {
+ # ...
+ }
+ $csv->eof or $csv->error_diag;
+
+will I<not> report the error. You would have to change that to
+
+ while (my $row = $csv->getline ($fh)) {
+ # ...
+ }
+ +$csv->error_diag and $csv->error_diag;
+
+=head2 types
+
+ $csv->types (\@tref);
+
+This method is used to force that (all) columns are of a given type. For
+example, if you have an integer column, two columns with doubles and a
+string column, then you might do a
+
+ $csv->types ([Text::CSV::IV (),
+ Text::CSV::NV (),
+ Text::CSV::NV (),
+ Text::CSV::PV ()]);
+
+Column types are used only for I<decoding> columns while parsing, in other
+words by the L</parse> and L</getline> methods.
+
+You can unset column types by doing a
+
+ $csv->types (undef);
+
+or fetch the current type settings with
+
+ $types = $csv->types ();
+
+=over 4
+
+=item IV
+
+Set field type to integer.
+
+=item NV
+
+Set field type to numeric/float.
+
+=item PV
+
+Set field type to string.
+
+=back
+
+=head2 fields
+
+ @columns = $csv->fields ();
+
+This method returns the input to L</combine> or the resultant decomposed
+fields of a successful L</parse>, whichever was called more recently.
+
+Note that the return value is undefined after using L</getline>, which does
+not fill the data structures returned by L</parse>.
+
+=head2 meta_info
+
+ @flags = $csv->meta_info ();
+
+This method returns the "flags" of the input to L</combine> or the flags of
+the resultant decomposed fields of L</parse>, whichever was called more
+recently.
+
+For each field, a meta_info field will hold flags that inform something
+about the field returned by the L</fields> method or passed to the
+L</combine> method. The flags are bit-wise-C<or>'d like:
+
+=over 2
+
+=item C< >0x0001
+
+The field was quoted.
+
+=item C< >0x0002
+
+The field was binary.
+
+=back
+
+See the C<is_***> methods below.
+
+=head2 is_quoted
+
+ my $quoted = $csv->is_quoted ($column_idx);
+
+Where C<$column_idx> is the (zero-based) index of the column in the last
+result of L</parse>.
+
+This returns a true value if the data in the indicated column was enclosed
+in L<C<quote_char>|/quote_char> quotes. This might be important for fields
+where content C<,20070108,> is to be treated as a numeric value, and where
+C<,"20070108",> is explicitly marked as character string data.
+
+This method is only valid when L</keep_meta_info> is set to a true value.
+
+=head2 is_binary
+
+ my $binary = $csv->is_binary ($column_idx);
+
+Where C<$column_idx> is the (zero-based) index of the column in the last
+result of L</parse>.
+
+This returns a true value if the data in the indicated column contained any
+byte in the range C<[\x00-\x08,\x10-\x1F,\x7F-\xFF]>.
+
+This method is only valid when L</keep_meta_info> is set to a true value.
+
+=head2 is_missing
+
+ my $missing = $csv->is_missing ($column_idx);
+
+Where C<$column_idx> is the (zero-based) index of the column in the last
+result of L</getline_hr>.
+
+ $csv->keep_meta_info (1);
+ while (my $hr = $csv->getline_hr ($fh)) {
+ $csv->is_missing (0) and next; # This was an empty line
+ }
+
+When using L</getline_hr>, it is impossible to tell if the parsed fields
+are C<undef> because they where not filled in the C<CSV> stream or because
+they were not read at all, as B<all> the fields defined by L</column_names>
+are set in the hash-ref. If you still need to know if all fields in each
+row are provided, you should enable L<C<keep_meta_info>|/keep_meta_info> so
+you can check the flags.
+
+If L<C<keep_meta_info>|/keep_meta_info> is C<false>, C<is_missing> will
+always return C<undef>, regardless of C<$column_idx> being valid or not. If
+this attribute is C<true> it will return either C<0> (the field is present)
+or C<1> (the field is missing).
+
+A special case is the empty line. If the line is completely empty - after
+dealing with the flags - this is still a valid CSV line: it is a record of
+just one single empty field. However, if C<keep_meta_info> is set, invoking
+C<is_missing> with index C<0> will now return true.
+
+=head2 status
+
+ $status = $csv->status ();
+
+This method returns the status of the last invoked L</combine> or L</parse>
+call. Status is success (true: C<1>) or failure (false: C<undef> or C<0>).
+
+=head2 error_input
+
+ $bad_argument = $csv->error_input ();
+
+This method returns the erroneous argument (if it exists) of L</combine> or
+L</parse>, whichever was called more recently. If the last invocation was
+successful, C<error_input> will return C<undef>.
+
+=head2 error_diag
+
+ Text::CSV->error_diag ();
+ $csv->error_diag ();
+ $error_code = 0 + $csv->error_diag ();
+ $error_str = "" . $csv->error_diag ();
+ ($cde, $str, $pos, $rec, $fld) = $csv->error_diag ();
+
+If (and only if) an error occurred, this function returns the diagnostics
+of that error.
+
+If called in void context, this will print the internal error code and the
+associated error message to STDERR.
+
+If called in list context, this will return the error code and the error
+message in that order. If the last error was from parsing, the rest of the
+values returned are a best guess at the location within the line that was
+being parsed. Their values are 1-based. The position currently is index of
+the byte at which the parsing failed in the current record. It might change
+to be the index of the current character in a later release. The records is
+the index of the record parsed by the csv instance. The field number is the
+index of the field the parser thinks it is currently trying to parse. See
+F<examples/csv-check> for how this can be used.
+
+If called in scalar context, it will return the diagnostics in a single
+scalar, a-la C<$!>. It will contain the error code in numeric context, and
+the diagnostics message in string context.
+
+When called as a class method or a direct function call, the diagnostics
+are that of the last L</new> call.
+
+=head2 record_number
+
+ $recno = $csv->record_number ();
+
+Returns the records parsed by this csv instance. This value should be more
+accurate than C<$.> when embedded newlines come in play. Records written by
+this instance are not counted.
+
+=head2 SetDiag
+
+ $csv->SetDiag (0);
+
+Use to reset the diagnostics if you are dealing with errors.
+
+=head1 ADDITIONAL METHODS
+
+=over
+
+=item backend
+
+Returns the backend module name called by Text::CSV.
+C<module> is an alias.
+
+=item is_xs
+
+Returns true value if Text::CSV uses an XS backend.
+
+=item is_pp
+
+Returns true value if Text::CSV uses a pure-Perl backend.
+
+=back
+
+=head1 FUNCTIONS
+
+This whole section is also taken from Text::CSV_XS.
+
+=head2 csv
+
+This function is not exported by default and should be explicitly requested:
+
+ use Text::CSV qw( csv );
+
+This is an high-level function that aims at simple (user) interfaces. This
+can be used to read/parse a C<CSV> file or stream (the default behavior) or
+to produce a file or write to a stream (define the C<out> attribute). It
+returns an array- or hash-reference on parsing (or C<undef> on fail) or the
+numeric value of L</error_diag> on writing. When this function fails you
+can get to the error using the class call to L</error_diag>
+
+ my $aoa = csv (in => "test.csv") or
+ die Text::CSV->error_diag;
+
+This function takes the arguments as key-value pairs. This can be passed as
+a list or as an anonymous hash:
+
+ my $aoa = csv ( in => "test.csv", sep_char => ";");
+ my $aoh = csv ({ in => $fh, headers => "auto" });
+
+The arguments passed consist of two parts: the arguments to L</csv> itself
+and the optional attributes to the C<CSV> object used inside the function
+as enumerated and explained in L</new>.
+
+If not overridden, the default option used for CSV is
+
+ auto_diag => 1
+ escape_null => 0
+
+The option that is always set and cannot be altered is
+
+ binary => 1
+
+As this function will likely be used in one-liners, it allows C<quote> to
+be abbreviated as C<quo>, and C<escape_char> to be abbreviated as C<esc>
+or C<escape>.
+
+Alternative invocations:
+
+ my $aoa = Text::CSV::csv (in => "file.csv");
+
+ my $csv = Text::CSV->new ();
+ my $aoa = $csv->csv (in => "file.csv");
+
+In the latter case, the object attributes are used from the existing object
+and the attribute arguments in the function call are ignored:
+
+ my $csv = Text::CSV->new ({ sep_char => ";" });
+ my $aoh = $csv->csv (in => "file.csv", bom => 1);
+
+will parse using C<;> as C<sep_char>, not C<,>.
+
+=head3 in
+
+Used to specify the source. C<in> can be a file name (e.g. C<"file.csv">),
+which will be opened for reading and closed when finished, a file handle
+(e.g. C<$fh> or C<FH>), a reference to a glob (e.g. C<\*ARGV>), the glob
+itself (e.g. C<*STDIN>), or a reference to a scalar (e.g. C<\q{1,2,"csv"}>).
+
+When used with L</out>, C<in> should be a reference to a CSV structure (AoA
+or AoH) or a CODE-ref that returns an array-reference or a hash-reference.
+The code-ref will be invoked with no arguments.
+
+ my $aoa = csv (in => "file.csv");
+
+ open my $fh, "<", "file.csv";
+ my $aoa = csv (in => $fh);
+
+ my $csv = [ [qw( Foo Bar )], [ 1, 2 ], [ 2, 3 ]];
+ my $err = csv (in => $csv, out => "file.csv");
+
+If called in void context without the L</out> attribute, the resulting ref
+will be used as input to a subsequent call to csv:
+
+ csv (in => "file.csv", filter => { 2 => sub { length > 2 }})
+
+will be a shortcut to
+
+ csv (in => csv (in => "file.csv", filter => { 2 => sub { length > 2 }}))
+
+where, in the absence of the C<out> attribute, this is a shortcut to
+
+ csv (in => csv (in => "file.csv", filter => { 2 => sub { length > 2 }}),
+ out => *STDOUT)
+
+=head3 out
+
+In output mode, the default CSV options when producing CSV are
+
+ eol => "\r\n"
+
+The L</fragment> attribute is ignored in output mode.
+
+C<out> can be a file name (e.g. C<"file.csv">), which will be opened for
+writing and closed when finished, a file handle (e.g. C<$fh> or C<FH>), a
+reference to a glob (e.g. C<\*STDOUT>), or the glob itself (e.g. C<*STDOUT>).
+
+ csv (in => sub { $sth->fetch }, out => "dump.csv");
+ csv (in => sub { $sth->fetchrow_hashref }, out => "dump.csv",
+ headers => $sth->{NAME_lc});
+
+When a code-ref is used for C<in>, the output is generated per invocation,
+so no buffering is involved. This implies that there is no size restriction
+on the number of records. The C<csv> function ends when the coderef returns
+a false value.
+
+=head3 encoding
+
+If passed, it should be an encoding accepted by the C<:encoding()> option
+to C<open>. There is no default value. This attribute does not work in perl
+5.6.x. C<encoding> can be abbreviated to C<enc> for ease of use in command
+line invocations.
+
+If C<encoding> is set to the literal value C<"auto">, the method L</header>
+will be invoked on the opened stream to check if there is a BOM and set the
+encoding accordingly. This is equal to passing a true value in the option
+L<C<detect_bom>|/detect_bom>.
+
+=head3 detect_bom
+
+If C<detect_bom> is given, the method L</header> will be invoked on the
+opened stream to check if there is a BOM and set the encoding accordingly.
+
+C<detect_bom> can be abbreviated to C<bom>.
+
+This is the same as setting L<C<encoding>|/encoding> to C<"auto">.
+
+Note that as L</header> is invoked, its default is to also set the headers.
+
+=head3 headers
+
+If this attribute is not given, the default behavior is to produce an array
+of arrays.
+
+If C<headers> is supplied, it should be an anonymous list of column names,
+an anonymous hashref, a coderef, or a literal flag: C<auto>, C<lc>, C<uc>,
+or C<skip>.
+
+=over 2
+
+=item skip
+
+When C<skip> is used, the header will not be included in the output.
+
+ my $aoa = csv (in => $fh, headers => "skip");
+
+=item auto
+
+If C<auto> is used, the first line of the C<CSV> source will be read as the
+list of field headers and used to produce an array of hashes.
+
+ my $aoh = csv (in => $fh, headers => "auto");
+
+=item lc
+
+If C<lc> is used, the first line of the C<CSV> source will be read as the
+list of field headers mapped to lower case and used to produce an array of
+hashes. This is a variation of C<auto>.
+
+ my $aoh = csv (in => $fh, headers => "lc");
+
+=item uc
+
+If C<uc> is used, the first line of the C<CSV> source will be read as the
+list of field headers mapped to upper case and used to produce an array of
+hashes. This is a variation of C<auto>.
+
+ my $aoh = csv (in => $fh, headers => "uc");
+
+=item CODE
+
+If a coderef is used, the first line of the C<CSV> source will be read as
+the list of mangled field headers in which each field is passed as the only
+argument to the coderef. This list is used to produce an array of hashes.
+
+ my $aoh = csv (in => $fh,
+ headers => sub { lc ($_[0]) =~ s/kode/code/gr });
+
+this example is a variation of using C<lc> where all occurrences of C<kode>
+are replaced with C<code>.
+
+=item ARRAY
+
+If C<headers> is an anonymous list, the entries in the list will be used
+as field names. The first line is considered data instead of headers.
+
+ my $aoh = csv (in => $fh, headers => [qw( Foo Bar )]);
+ csv (in => $aoa, out => $fh, headers => [qw( code description price )]);
+
+=item HASH
+
+If C<headers> is an hash reference, this implies C<auto>, but header fields
+for that exist as key in the hashref will be replaced by the value for that
+key. Given a CSV file like
+
+ post-kode,city,name,id number,fubble
+ 1234AA,Duckstad,Donald,13,"X313DF"
+
+using
+
+ csv (headers => { "post-kode" => "pc", "id number" => "ID" }, ...
+
+will return an entry like
+
+ { pc => "1234AA",
+ city => "Duckstad",
+ name => "Donald",
+ ID => "13",
+ fubble => "X313DF",
+ }
+
+=back
+
+See also L<C<munge_column_names>|/munge_column_names> and
+L<C<set_column_names>|/set_column_names>.
+
+=head3 munge_column_names
+
+If C<munge_column_names> is set, the method L</header> is invoked on the
+opened stream with all matching arguments to detect and set the headers.
+
+C<munge_column_names> can be abbreviated to C<munge>.
+
+=head3 key
+
+If passed, will default L<C<headers>|/headers> to C<"auto"> and return a
+hashref instead of an array of hashes.
+
+ my $ref = csv (in => "test.csv", key => "code");
+
+with test.csv like
+
+ code,product,price,color
+ 1,pc,850,gray
+ 2,keyboard,12,white
+ 3,mouse,5,black
+
+will return
+
+ { 1 => {
+ code => 1,
+ color => 'gray',
+ price => 850,
+ product => 'pc'
+ },
+ 2 => {
+ code => 2,
+ color => 'white',
+ price => 12,
+ product => 'keyboard'
+ },
+ 3 => {
+ code => 3,
+ color => 'black',
+ price => 5,
+ product => 'mouse'
+ }
+ }
+
+=head3 fragment
+
+Only output the fragment as defined in the L</fragment> method. This option
+is ignored when I<generating> C<CSV>. See L</out>.
+
+Combining all of them could give something like
+
+ use Text::CSV qw( csv );
+ my $aoh = csv (
+ in => "test.txt",
+ encoding => "utf-8",
+ headers => "auto",
+ sep_char => "|",
+ fragment => "row=3;6-9;15-*",
+ );
+ say $aoh->[15]{Foo};
+
+=head3 sep_set
+
+If C<sep_set> is set, the method L</header> is invoked on the opened stream
+to detect and set L<C<sep_char>|/sep_char> with the given set.
+
+C<sep_set> can be abbreviated to C<seps>.
+
+Note that as L</header> is invoked, its default is to also set the headers.
+
+=head3 set_column_names
+
+If C<set_column_names> is passed, the method L</header> is invoked on the
+opened stream with all arguments meant for L</header>.
+
+=head2 Callbacks
+
+Callbacks enable actions triggered from the I<inside> of Text::CSV.
+
+While most of what this enables can easily be done in an unrolled loop as
+described in the L</SYNOPSIS> callbacks can be used to meet special demands
+or enhance the L</csv> function.
+
+=over 2
+
+=item error
+
+ $csv->callbacks (error => sub { $csv->SetDiag (0) });
+
+the C<error> callback is invoked when an error occurs, but I<only> when
+L</auto_diag> is set to a true value. A callback is invoked with the values
+returned by L</error_diag>:
+
+ my ($c, $s);
+
+ sub ignore3006
+ {
+ my ($err, $msg, $pos, $recno, $fldno) = @_;
+ if ($err == 3006) {
+ # ignore this error
+ ($c, $s) = (undef, undef);
+ Text::CSV->SetDiag (0);
+ }
+ # Any other error
+ return;
+ } # ignore3006
+
+ $csv->callbacks (error => \&ignore3006);
+ $csv->bind_columns (\$c, \$s);
+ while ($csv->getline ($fh)) {
+ # Error 3006 will not stop the loop
+ }
+
+=item after_parse
+
+ $csv->callbacks (after_parse => sub { push @{$_[1]}, "NEW" });
+ while (my $row = $csv->getline ($fh)) {
+ $row->[-1] eq "NEW";
+ }
+
+This callback is invoked after parsing with L</getline> only if no error
+occurred. The callback is invoked with two arguments: the current C<CSV>
+parser object and an array reference to the fields parsed.
+
+The return code of the callback is ignored unless it is a reference to the
+string "skip", in which case the record will be skipped in L</getline_all>.
+
+ sub add_from_db
+ {
+ my ($csv, $row) = @_;
+ $sth->execute ($row->[4]);
+ push @$row, $sth->fetchrow_array;
+ } # add_from_db
+
+ my $aoa = csv (in => "file.csv", callbacks => {
+ after_parse => \&add_from_db });
+
+This hook can be used for validation:
+
+=over 2
+
+=item FAIL
+
+Die if any of the records does not validate a rule:
+
+ after_parse => sub {
+ $_[1][4] =~ m/^[0-9]{4}\s?[A-Z]{2}$/ or
+ die "5th field does not have a valid Dutch zipcode";
+ }
+
+=item DEFAULT
+
+Replace invalid fields with a default value:
+
+ after_parse => sub { $_[1][2] =~ m/^\d+$/ or $_[1][2] = 0 }
+
+=item SKIP
+
+Skip records that have invalid fields (only applies to L</getline_all>):
+
+ after_parse => sub { $_[1][0] =~ m/^\d+$/ or return \"skip"; }
+
+=back
+
+=item before_print
+
+ my $idx = 1;
+ $csv->callbacks (before_print => sub { $_[1][0] = $idx++ });
+ $csv->print (*STDOUT, [ 0, $_ ]) for @members;
+
+This callback is invoked before printing with L</print> only if no error
+occurred. The callback is invoked with two arguments: the current C<CSV>
+parser object and an array reference to the fields passed.
+
+The return code of the callback is ignored.
+
+ sub max_4_fields
+ {
+ my ($csv, $row) = @_;
+ @$row > 4 and splice @$row, 4;
+ } # max_4_fields
+
+ csv (in => csv (in => "file.csv"), out => *STDOUT,
+ callbacks => { before print => \&max_4_fields });
+
+This callback is not active for L</combine>.
+
+=back
+
+=head3 Callbacks for csv ()
+
+The L</csv> allows for some callbacks that do not integrate in XS internals
+but only feature the L</csv> function.
+
+ csv (in => "file.csv",
+ callbacks => {
+ filter => { 6 => sub { $_ > 15 } }, # first
+ after_parse => sub { say "AFTER PARSE"; }, # first
+ after_in => sub { say "AFTER IN"; }, # second
+ on_in => sub { say "ON IN"; }, # third
+ },
+ );
+
+ csv (in => $aoh,
+ out => "file.csv",
+ callbacks => {
+ on_in => sub { say "ON IN"; }, # first
+ before_out => sub { say "BEFORE OUT"; }, # second
+ before_print => sub { say "BEFORE PRINT"; }, # third
+ },
+ );
+
+=over 2
+
+=item filter
+
+This callback can be used to filter records. It is called just after a new
+record has been scanned. The callback accepts a hashref where the keys are
+the index to the row (the field number, 1-based) and the values are subs to
+return a true or false value.
+
+ csv (in => "file.csv", filter => {
+ 3 => sub { m/a/ }, # third field should contain an "a"
+ 5 => sub { length > 4 }, # length of the 5th field minimal 5
+ });
+
+ csv (in => "file.csv", filter => "not_blank");
+ csv (in => "file.csv", filter => "not_empty");
+ csv (in => "file.csv", filter => "filled");
+
+If the keys to the filter hash contain any character that is not a digit it
+will also implicitly set L</headers> to C<"auto"> unless L</headers> was
+already passed as argument. When headers are active, returning an array of
+hashes, the filter is not applicable to the header itself.
+
+ csv (in => "file.csv", filter => { foo => sub { $_ > 4 }});
+
+All sub results should match, as in AND.
+
+The context of the callback sets C<$_> localized to the field indicated by
+the filter. The two arguments are as with all other callbacks, so the other
+fields in the current row can be seen:
+
+ filter => { 3 => sub { $_ > 100 ? $_[1][1] =~ m/A/ : $_[1][6] =~ m/B/ }}
+
+If the context is set to return a list of hashes (L</headers> is defined),
+the current record will also be available in the localized C<%_>:
+
+ filter => { 3 => sub { $_ > 100 && $_{foo} =~ m/A/ && $_{bar} < 1000 }}
+
+If the filter is used to I<alter> the content by changing C<$_>, make sure
+that the sub returns true in order not to have that record skipped:
+
+ filter => { 2 => sub { $_ = uc }}
+
+will upper-case the second field, and then skip it if the resulting content
+evaluates to false. To always accept, end with truth:
+
+ filter => { 2 => sub { $_ = uc; 1 }}
+
+B<Predefined filters>
+
+Given a file like (line numbers prefixed for doc purpose only):
+
+ 1:1,2,3
+ 2:
+ 3:,
+ 4:""
+ 5:,,
+ 6:, ,
+ 7:"",
+ 8:" "
+ 9:4,5,6
+
+=over 2
+
+=item not_blank
+
+Filter out the blank lines
+
+This filter is a shortcut for
+
+ filter => { 0 => sub { @{$_[1]} > 1 or
+ defined $_[1][0] && $_[1][0] ne "" } }
+
+Due to the implementation, it is currently impossible to also filter lines
+that consists only of a quoted empty field. These lines are also considered
+blank lines.
+
+With the given example, lines 2 and 4 will be skipped.
+
+=item not_empty
+
+Filter out lines where all the fields are empty.
+
+This filter is a shortcut for
+
+ filter => { 0 => sub { grep { defined && $_ ne "" } @{$_[1]} } }
+
+A space is not regarded being empty, so given the example data, lines 2, 3,
+4, 5, and 7 are skipped.
+
+=item filled
+
+Filter out lines that have no visible data
+
+This filter is a shortcut for
+
+ filter => { 0 => sub { grep { defined && m/\S/ } @{$_[1]} } }
+
+This filter rejects all lines that I<not> have at least one field that does
+not evaluate to the empty string.
+
+With the given example data, this filter would skip lines 2 through 8.
+
+=back
+
+=item after_in
+
+This callback is invoked for each record after all records have been parsed
+but before returning the reference to the caller. The hook is invoked with
+two arguments: the current C<CSV> parser object and a reference to the
+record. The reference can be a reference to a HASH or a reference to an
+ARRAY as determined by the arguments.
+
+This callback can also be passed as an attribute without the C<callbacks>
+wrapper.
+
+=item before_out
+
+This callback is invoked for each record before the record is printed. The
+hook is invoked with two arguments: the current C<CSV> parser object and a
+reference to the record. The reference can be a reference to a HASH or a
+reference to an ARRAY as determined by the arguments.
+
+This callback can also be passed as an attribute without the C<callbacks>
+wrapper.
+
+This callback makes the row available in C<%_> if the row is a hashref. In
+this case C<%_> is writable and will change the original row.
+
+=item on_in
+
+This callback acts exactly as the L</after_in> or the L</before_out> hooks.
+
+This callback can also be passed as an attribute without the C<callbacks>
+wrapper.
+
+This callback makes the row available in C<%_> if the row is a hashref. In
+this case C<%_> is writable and will change the original row. So e.g. with
+
+ my $aoh = csv (
+ in => \"foo\n1\n2\n",
+ headers => "auto",
+ on_in => sub { $_{bar} = 2; },
+ );
+
+C<$aoh> will be:
+
+ [ { foo => 1,
+ bar => 2,
+ }
+ { foo => 2,
+ bar => 2,
+ }
+ ]
+
+=item csv
+
+The I<function> L</csv> can also be called as a method or with an existing
+Text::CSV object. This could help if the function is to be invoked a lot
+of times and the overhead of creating the object internally over and over
+again would be prevented by passing an existing instance.
+
+ my $csv = Text::CSV->new ({ binary => 1, auto_diag => 1 });
+
+ my $aoa = $csv->csv (in => $fh);
+ my $aoa = csv (in => $fh, csv => $csv);
+
+both act the same. Running this 20000 times on a 20 lines CSV file, showed
+a 53% speedup.
+
+=back
+
+=head1 DIAGNOSTICS
+
+This section is also taken from Text::CSV_XS.
+
+If an error occurs, C<< $csv->error_diag >> can be used to get information
+on the cause of the failure. Note that for speed reasons the internal value
+is never cleared on success, so using the value returned by L</error_diag>
+in normal cases - when no error occurred - may cause unexpected results.
+
+If the constructor failed, the cause can be found using L</error_diag> as a
+class method, like C<< Text::CSV_PP->error_diag >>.
+
+The C<< $csv->error_diag >> method is automatically invoked upon error when
+the contractor was called with L<C<auto_diag>|/auto_diag> set to C<1> or
+C<2>, or when L<autodie> is in effect. When set to C<1>, this will cause a
+C<warn> with the error message, when set to C<2>, it will C<die>. C<2012 -
+EOF> is excluded from L<C<auto_diag>|/auto_diag> reports.
+
+Errors can be (individually) caught using the L</error> callback.
+
+The errors as described below are available. I have tried to make the error
+itself explanatory enough, but more descriptions will be added. For most of
+these errors, the first three capitals describe the error category:
+
+=over 2
+
+=item *
+INI
+
+Initialization error or option conflict.
+
+=item *
+ECR
+
+Carriage-Return related parse error.
+
+=item *
+EOF
+
+End-Of-File related parse error.
+
+=item *
+EIQ
+
+Parse error inside quotation.
+
+=item *
+EIF
+
+Parse error inside field.
+
+=item *
+ECB
+
+Combine error.
+
+=item *
+EHR
+
+HashRef parse related error.
+
+=back
+
+And below should be the complete list of error codes that can be returned:
+
+=over 2
+
+=item *
+1001 "INI - sep_char is equal to quote_char or escape_char"
+X<1001>
+
+The L<separation character|/sep_char> cannot be equal to L<the quotation
+character|/quote_char> or to L<the escape character|/escape_char>, as this
+would invalidate all parsing rules.
+
+=item *
+1002 "INI - allow_whitespace with escape_char or quote_char SP or TAB"
+X<1002>
+
+Using the L<C<allow_whitespace>|/allow_whitespace> attribute when either
+L<C<quote_char>|/quote_char> or L<C<escape_char>|/escape_char> is equal to
+C<SPACE> or C<TAB> is too ambiguous to allow.
+
+=item *
+1003 "INI - \r or \n in main attr not allowed"
+X<1003>
+
+Using default L<C<eol>|/eol> characters in either L<C<sep_char>|/sep_char>,
+L<C<quote_char>|/quote_char>, or L<C<escape_char>|/escape_char> is not
+allowed.
+
+=item *
+1004 "INI - callbacks should be undef or a hashref"
+X<1004>
+
+The L<C<callbacks>|/Callbacks> attribute only allows one to be C<undef> or
+a hash reference.
+
+=item *
+1005 "INI - EOL too long"
+X<1005>
+
+The value passed for EOL is exceeding its maximum length (16).
+
+=item *
+1006 "INI - SEP too long"
+X<1006>
+
+The value passed for SEP is exceeding its maximum length (16).
+
+=item *
+1007 "INI - QUOTE too long"
+X<1007>
+
+The value passed for QUOTE is exceeding its maximum length (16).
+
+=item *
+1008 "INI - SEP undefined"
+X<1008>
+
+The value passed for SEP should be defined and not empty.
+
+=item *
+1010 "INI - the header is empty"
+X<1010>
+
+The header line parsed in the L</header> is empty.
+
+=item *
+1011 "INI - the header contains more than one valid separator"
+X<1011>
+
+The header line parsed in the L</header> contains more than one (unique)
+separator character out of the allowed set of separators.
+
+=item *
+1012 "INI - the header contains an empty field"
+X<1012>
+
+The header line parsed in the L</header> is contains an empty field.
+
+=item *
+1013 "INI - the header contains nun-unique fields"
+X<1013>
+
+The header line parsed in the L</header> contains at least two identical
+fields.
+
+=item *
+1014 "INI - header called on undefined stream"
+X<1014>
+
+The header line cannot be parsed from an undefined sources.
+
+=item *
+1500 "PRM - Invalid/unsupported argument(s)"
+X<1500>
+
+Function or method called with invalid argument(s) or parameter(s).
+
+=item *
+2010 "ECR - QUO char inside quotes followed by CR not part of EOL"
+X<2010>
+
+When L<C<eol>|/eol> has been set to anything but the default, like
+C<"\r\t\n">, and the C<"\r"> is following the B<second> (closing)
+L<C<quote_char>|/quote_char>, where the characters following the C<"\r"> do
+not make up the L<C<eol>|/eol> sequence, this is an error.
+
+=item *
+2011 "ECR - Characters after end of quoted field"
+X<2011>
+
+Sequences like C<1,foo,"bar"baz,22,1> are not allowed. C<"bar"> is a quoted
+field and after the closing double-quote, there should be either a new-line
+sequence or a separation character.
+
+=item *
+2012 "EOF - End of data in parsing input stream"
+X<2012>
+
+Self-explaining. End-of-file while inside parsing a stream. Can happen only
+when reading from streams with L</getline>, as using L</parse> is done on
+strings that are not required to have a trailing L<C<eol>|/eol>.
+
+=item *
+2013 "INI - Specification error for fragments RFC7111"
+X<2013>
+
+Invalid specification for URI L</fragment> specification.
+
+=item *
+2021 "EIQ - NL char inside quotes, binary off"
+X<2021>
+
+Sequences like C<1,"foo\nbar",22,1> are allowed only when the binary option
+has been selected with the constructor.
+
+=item *
+2022 "EIQ - CR char inside quotes, binary off"
+X<2022>
+
+Sequences like C<1,"foo\rbar",22,1> are allowed only when the binary option
+has been selected with the constructor.
+
+=item *
+2023 "EIQ - QUO character not allowed"
+X<2023>
+
+Sequences like C<"foo "bar" baz",qu> and C<2023,",2008-04-05,"Foo, Bar",\n>
+will cause this error.
+
+=item *
+2024 "EIQ - EOF cannot be escaped, not even inside quotes"
+X<2024>
+
+The escape character is not allowed as last character in an input stream.
+
+=item *
+2025 "EIQ - Loose unescaped escape"
+X<2025>
+
+An escape character should escape only characters that need escaping.
+
+Allowing the escape for other characters is possible with the attribute
+L</allow_loose_escape>.
+
+=item *
+2026 "EIQ - Binary character inside quoted field, binary off"
+X<2026>
+
+Binary characters are not allowed by default. Exceptions are fields that
+contain valid UTF-8, that will automatically be upgraded if the content is
+valid UTF-8. Set L<C<binary>|/binary> to C<1> to accept binary data.
+
+=item *
+2027 "EIQ - Quoted field not terminated"
+X<2027>
+
+When parsing a field that started with a quotation character, the field is
+expected to be closed with a quotation character. When the parsed line is
+exhausted before the quote is found, that field is not terminated.
+
+=item *
+2030 "EIF - NL char inside unquoted verbatim, binary off"
+X<2030>
+
+=item *
+2031 "EIF - CR char is first char of field, not part of EOL"
+X<2031>
+
+=item *
+2032 "EIF - CR char inside unquoted, not part of EOL"
+X<2032>
+
+=item *
+2034 "EIF - Loose unescaped quote"
+X<2034>
+
+=item *
+2035 "EIF - Escaped EOF in unquoted field"
+X<2035>
+
+=item *
+2036 "EIF - ESC error"
+X<2036>
+
+=item *
+2037 "EIF - Binary character in unquoted field, binary off"
+X<2037>
+
+=item *
+2110 "ECB - Binary character in Combine, binary off"
+X<2110>
+
+=item *
+2200 "EIO - print to IO failed. See errno"
+X<2200>
+
+=item *
+3001 "EHR - Unsupported syntax for column_names ()"
+X<3001>
+
+=item *
+3002 "EHR - getline_hr () called before column_names ()"
+X<3002>
+
+=item *
+3003 "EHR - bind_columns () and column_names () fields count mismatch"
+X<3003>
+
+=item *
+3004 "EHR - bind_columns () only accepts refs to scalars"
+X<3004>
+
+=item *
+3006 "EHR - bind_columns () did not pass enough refs for parsed fields"
+X<3006>
+
+=item *
+3007 "EHR - bind_columns needs refs to writable scalars"
+X<3007>
+
+=item *
+3008 "EHR - unexpected error in bound fields"
+X<3008>
+
+=item *
+3009 "EHR - print_hr () called before column_names ()"
+X<3009>
+
+=item *
+3010 "EHR - print_hr () called with invalid arguments"
+X<3010>
+
+=back
+
+=head1 SEE ALSO
+
+L<Text::CSV_PP>, L<Text::CSV_XS> and L<Text::CSV::Encoded>.
+
+
+=head1 AUTHORS and MAINTAINERS
+
+Alan Citterman F<E<lt>alan[at]mfgrtl.comE<gt>> wrote the original Perl
+module. Please don't send mail concerning Text::CSV to Alan, as
+he's not a present maintainer.
+
+Jochen Wiedmann F<E<lt>joe[at]ispsoft.deE<gt>> rewrote the encoding and
+decoding in C by implementing a simple finite-state machine and added
+the variable quote, escape and separator characters, the binary mode
+and the print and getline methods. See ChangeLog releases 0.10 through
+0.23.
+
+H.Merijn Brand F<E<lt>h.m.brand[at]xs4all.nlE<gt>> cleaned up the code,
+added the field flags methods, wrote the major part of the test suite,
+completed the documentation, fixed some RT bugs. See ChangeLog releases
+0.25 and on.
+
+Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt> wrote Text::CSV_PP
+which is the pure-Perl version of Text::CSV_XS.
+
+New Text::CSV (since 0.99) is maintained by Makamaka, and Kenichi Ishigaki
+since 1.91.
+
+
+=head1 COPYRIGHT AND LICENSE
+
+Text::CSV
+
+Copyright (C) 1997 Alan Citterman. All rights reserved.
+Copyright (C) 2007-2015 Makamaka Hannyaharamitu.
+Copyright (C) 2017- Kenichi Ishigaki
+A large portion of the doc is taken from Text::CSV_XS. See below.
+
+Text::CSV_PP:
+
+Copyright (C) 2005-2015 Makamaka Hannyaharamitu.
+Copyright (C) 2017- Kenichi Ishigaki
+A large portion of the code/doc are also taken from Text::CSV_XS. See below.
+
+Text:CSV_XS:
+
+Copyright (C) 2007-2016 H.Merijn Brand for PROCURA B.V.
+Copyright (C) 1998-2001 Jochen Wiedmann. All rights reserved.
+Portions Copyright (C) 1997 Alan Citterman. All rights reserved.
+
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
diff --git a/mcu/tools/perl/Text/CSV_PP.pm b/mcu/tools/perl/Text/CSV_PP.pm
new file mode 100644
index 0000000..46430d4
--- /dev/null
+++ b/mcu/tools/perl/Text/CSV_PP.pm
@@ -0,0 +1,4916 @@
+package Text::CSV_PP;
+
+################################################################################
+#
+# Text::CSV_PP - Text::CSV_XS compatible pure-Perl module
+#
+################################################################################
+require 5.005;
+
+use strict;
+use Exporter ();
+use vars qw($VERSION @ISA @EXPORT_OK);
+use Carp;
+
+$VERSION = '1.95';
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(csv);
+
+sub PV { 0 }
+sub IV { 1 }
+sub NV { 2 }
+
+sub IS_QUOTED () { 0x0001; }
+sub IS_BINARY () { 0x0002; }
+sub IS_ERROR () { 0x0004; }
+sub IS_MISSING () { 0x0010; }
+
+sub HOOK_ERROR () { 0x0001; }
+sub HOOK_AFTER_PARSE () { 0x0002; }
+sub HOOK_BEFORE_PRINT () { 0x0004; }
+
+sub useIO_EOF () { 0x0010; }
+
+my $ERRORS = {
+ # Generic errors
+ 1000 => "INI - constructor failed",
+ 1001 => "INI - sep_char is equal to quote_char or escape_char",
+ 1002 => "INI - allow_whitespace with escape_char or quote_char SP or TAB",
+ 1003 => "INI - \\r or \\n in main attr not allowed",
+ 1004 => "INI - callbacks should be undef or a hashref",
+ 1005 => "INI - EOL too long",
+ 1006 => "INI - SEP too long",
+ 1007 => "INI - QUOTE too long",
+ 1008 => "INI - SEP undefined",
+
+ 1010 => "INI - the header is empty",
+ 1011 => "INI - the header contains more than one valid separator",
+ 1012 => "INI - the header contains an empty field",
+ 1013 => "INI - the header contains nun-unique fields",
+ 1014 => "INI - header called on undefined stream",
+
+ # Syntax errors
+ 1500 => "PRM - Invalid/unsupported arguments(s)",
+
+ # Parse errors
+ 2010 => "ECR - QUO char inside quotes followed by CR not part of EOL",
+ 2011 => "ECR - Characters after end of quoted field",
+ 2012 => "EOF - End of data in parsing input stream",
+ 2013 => "ESP - Specification error for fragments RFC7111",
+ 2014 => "ENF - Inconsistent number of fields",
+
+ # EIQ - Error Inside Quotes
+ 2021 => "EIQ - NL char inside quotes, binary off",
+ 2022 => "EIQ - CR char inside quotes, binary off",
+ 2023 => "EIQ - QUO character not allowed",
+ 2024 => "EIQ - EOF cannot be escaped, not even inside quotes",
+ 2025 => "EIQ - Loose unescaped escape",
+ 2026 => "EIQ - Binary character inside quoted field, binary off",
+ 2027 => "EIQ - Quoted field not terminated",
+
+ # EIF - Error Inside Field
+ 2030 => "EIF - NL char inside unquoted verbatim, binary off",
+ 2031 => "EIF - CR char is first char of field, not part of EOL",
+ 2032 => "EIF - CR char inside unquoted, not part of EOL",
+ 2034 => "EIF - Loose unescaped quote",
+ 2035 => "EIF - Escaped EOF in unquoted field",
+ 2036 => "EIF - ESC error",
+ 2037 => "EIF - Binary character in unquoted field, binary off",
+
+ # Combine errors
+ 2110 => "ECB - Binary character in Combine, binary off",
+
+ # IO errors
+ 2200 => "EIO - print to IO failed. See errno",
+
+ # Hash-Ref errors
+ 3001 => "EHR - Unsupported syntax for column_names ()",
+ 3002 => "EHR - getline_hr () called before column_names ()",
+ 3003 => "EHR - bind_columns () and column_names () fields count mismatch",
+ 3004 => "EHR - bind_columns () only accepts refs to scalars",
+ 3006 => "EHR - bind_columns () did not pass enough refs for parsed fields",
+ 3007 => "EHR - bind_columns needs refs to writable scalars",
+ 3008 => "EHR - unexpected error in bound fields",
+ 3009 => "EHR - print_hr () called before column_names ()",
+ 3010 => "EHR - print_hr () called with invalid arguments",
+
+ # PP Only Error
+ 4002 => "EIQ - Unescaped ESC in quoted field",
+ 4003 => "EIF - ESC CR",
+ 4004 => "EUF - Field is terminated by the escape character (escape_char)",
+
+ 0 => "",
+};
+
+BEGIN {
+ if ( $] < 5.006 ) {
+ $INC{'bytes.pm'} = 1 unless $INC{'bytes.pm'}; # dummy
+ no strict 'refs';
+ *{"utf8::is_utf8"} = sub { 0; };
+ *{"utf8::decode"} = sub { };
+ }
+ elsif ( $] < 5.008 ) {
+ no strict 'refs';
+ *{"utf8::is_utf8"} = sub { 0; };
+ *{"utf8::decode"} = sub { };
+ *{"utf8::encode"} = sub { };
+ }
+ elsif ( !defined &utf8::is_utf8 ) {
+ require Encode;
+ *utf8::is_utf8 = *Encode::is_utf8;
+ }
+
+ eval q| require Scalar::Util |;
+ if ( $@ ) {
+ eval q| require B |;
+ if ( $@ ) {
+ Carp::croak $@;
+ }
+ else {
+ my %tmap = qw(
+ B::NULL SCALAR
+ B::HV HASH
+ B::AV ARRAY
+ B::CV CODE
+ B::IO IO
+ B::GV GLOB
+ B::REGEXP REGEXP
+ );
+ *Scalar::Util::reftype = sub (\$) {
+ my $r = shift;
+ return undef unless length(ref($r));
+ my $t = ref(B::svref_2object($r));
+ return
+ exists $tmap{$t} ? $tmap{$t}
+ : length(ref($$r)) ? 'REF'
+ : 'SCALAR';
+ };
+ *Scalar::Util::readonly = sub (\$) {
+ my $b = B::svref_2object( $_[0] );
+ $b->FLAGS & 0x00800000; # SVf_READONLY?
+ };
+ }
+ }
+}
+
+################################################################################
+#
+# Common pure perl methods, taken almost directly from Text::CSV_XS.
+# (These should be moved into a common class eventually, so that
+# both XS and PP don't need to apply the same changes.)
+#
+################################################################################
+
+################################################################################
+# version
+################################################################################
+
+sub version {
+ return $VERSION;
+}
+
+################################################################################
+# new
+################################################################################
+
+my %def_attr = (
+ eol => '',
+ sep_char => ',',
+ quote_char => '"',
+ escape_char => '"',
+ binary => 0,
+ decode_utf8 => 1,
+ auto_diag => 0,
+ diag_verbose => 0,
+ strict => 0,
+ blank_is_undef => 0,
+ empty_is_undef => 0,
+ allow_whitespace => 0,
+ allow_loose_quotes => 0,
+ allow_loose_escapes => 0,
+ allow_unquoted_escape => 0,
+ always_quote => 0,
+ quote_empty => 0,
+ quote_space => 1,
+ quote_binary => 1,
+ escape_null => 1,
+ keep_meta_info => 0,
+ verbatim => 0,
+ types => undef,
+ callbacks => undef,
+
+ _EOF => 0,
+ _RECNO => 0,
+ _STATUS => undef,
+ _FIELDS => undef,
+ _FFLAGS => undef,
+ _STRING => undef,
+ _ERROR_INPUT => undef,
+ _COLUMN_NAMES => undef,
+ _BOUND_COLUMNS => undef,
+ _AHEAD => undef,
+);
+
+my %attr_alias = (
+ quote_always => "always_quote",
+ verbose_diag => "diag_verbose",
+ quote_null => "escape_null",
+ );
+
+my $last_new_error = Text::CSV_PP->SetDiag(0);
+my $last_error;
+
+# NOT a method: is also used before bless
+sub _unhealthy_whitespace {
+ my $self = shift;
+ $_[0] or return 0; # no checks needed without allow_whitespace
+
+ my $quo = $self->{quote};
+ defined $quo && length ($quo) or $quo = $self->{quote_char};
+ my $esc = $self->{escape_char};
+
+ (defined $quo && $quo =~ m/^[ \t]/) || (defined $esc && $esc =~ m/^[ \t]/) and
+ return 1002;
+
+ return 0;
+ }
+
+sub _check_sanity {
+ my $self = shift;
+
+ my $eol = $self->{eol};
+ my $sep = $self->{sep};
+ defined $sep && length ($sep) or $sep = $self->{sep_char};
+ my $quo = $self->{quote};
+ defined $quo && length ($quo) or $quo = $self->{quote_char};
+ my $esc = $self->{escape_char};
+
+# use DP;::diag ("SEP: '", DPeek ($sep),
+# "', QUO: '", DPeek ($quo),
+# "', ESC: '", DPeek ($esc),"'");
+
+ # sep_char should not be undefined
+ if (defined $sep && $sep ne "") {
+ length ($sep) > 16 and return 1006;
+ $sep =~ m/[\r\n]/ and return 1003;
+ }
+ else {
+ return 1008;
+ }
+ if (defined $quo) {
+ defined $sep && $quo eq $sep and return 1001;
+ length ($quo) > 16 and return 1007;
+ $quo =~ m/[\r\n]/ and return 1003;
+ }
+ if (defined $esc) {
+ defined $sep && $esc eq $sep and return 1001;
+ $esc =~ m/[\r\n]/ and return 1003;
+ }
+ if (defined $eol) {
+ length ($eol) > 16 and return 1005;
+ }
+
+ return _unhealthy_whitespace ($self, $self->{allow_whitespace});
+ }
+
+sub known_attributes {
+ sort grep !m/^_/ => "sep", "quote", keys %def_attr;
+ }
+
+sub new {
+ $last_new_error = Text::CSV_PP->SetDiag(1000,
+ 'usage: my $csv = Text::CSV_PP->new ([{ option => value, ... }]);');
+
+ my $proto = shift;
+ my $class = ref ($proto) || $proto or return;
+ @_ > 0 && ref $_[0] ne "HASH" and return;
+ my $attr = shift || {};
+ my %attr = map {
+ my $k = m/^[a-zA-Z]\w+$/ ? lc $_ : $_;
+ exists $attr_alias{$k} and $k = $attr_alias{$k};
+ $k => $attr->{$_};
+ } keys %$attr;
+
+ my $sep_aliased = 0;
+ if (exists $attr{sep}) {
+ $attr{sep_char} = delete $attr{sep};
+ $sep_aliased = 1;
+ }
+ my $quote_aliased = 0;
+ if (exists $attr{quote}) {
+ $attr{quote_char} = delete $attr{quote};
+ $quote_aliased = 1;
+ }
+ for (keys %attr) {
+ if (m/^[a-z]/ && exists $def_attr{$_}) {
+ # uncoverable condition false
+ defined $attr{$_} && m/_char$/ and utf8::decode ($attr{$_});
+ next;
+ }
+# croak?
+ $last_new_error = Text::CSV_PP->SetDiag(1000, "INI - Unknown attribute '$_'");
+ $attr{auto_diag} and error_diag ();
+ return;
+ }
+ if ($sep_aliased and defined $attr{sep_char}) {
+ my @b = unpack "U0C*", $attr{sep_char};
+ if (@b > 1) {
+ $attr{sep} = $attr{sep_char};
+ $attr{sep_char} = "\0";
+ }
+ else {
+ $attr{sep} = undef;
+ }
+ }
+ if ($quote_aliased and defined $attr{quote_char}) {
+ my @b = unpack "U0C*", $attr{quote_char};
+ if (@b > 1) {
+ $attr{quote} = $attr{quote_char};
+ $attr{quote_char} = "\0";
+ }
+ else {
+ $attr{quote} = undef;
+ }
+ }
+
+ my $self = { %def_attr, %attr };
+ if (my $ec = _check_sanity ($self)) {
+ $last_new_error = Text::CSV_PP->SetDiag($ec);
+ $attr{auto_diag} and error_diag ();
+ return;
+ }
+ if (defined $self->{callbacks} && ref $self->{callbacks} ne "HASH") {
+ Carp::carp "The 'callbacks' attribute is set but is not a hash: ignored\n";
+ $self->{callbacks} = undef;
+ }
+
+ $last_new_error = Text::CSV_PP->SetDiag(0);
+ defined $\ && !exists $attr{eol} and $self->{eol} = $\;
+ bless $self, $class;
+ defined $self->{types} and $self->types ($self->{types});
+ $self;
+}
+
+# Keep in sync with XS!
+my %_cache_id = ( # Only expose what is accessed from within PM
+ quote_char => 0,
+ escape_char => 1,
+ sep_char => 2,
+ sep => 39, # 39 .. 55
+ binary => 3,
+ keep_meta_info => 4,
+ always_quote => 5,
+ allow_loose_quotes => 6,
+ allow_loose_escapes => 7,
+ allow_unquoted_escape => 8,
+ allow_whitespace => 9,
+ blank_is_undef => 10,
+ eol => 11,
+ quote => 15,
+ verbatim => 22,
+ empty_is_undef => 23,
+ auto_diag => 24,
+ diag_verbose => 33,
+ quote_space => 25,
+ quote_empty => 37,
+ quote_binary => 32,
+ escape_null => 31,
+ decode_utf8 => 35,
+ _has_hooks => 36,
+ _is_bound => 26, # 26 .. 29
+ strict => 58,
+ );
+
+my %_hidden_cache_id = qw(
+ sep_len 38
+ eol_len 12
+ eol_is_cr 13
+ quo_len 16
+ _has_ahead 30
+ has_error_input 34
+);
+
+my %_reverse_cache_id = (
+ map({$_cache_id{$_} => $_} keys %_cache_id),
+ map({$_hidden_cache_id{$_} => $_} keys %_hidden_cache_id),
+);
+
+# A `character'
+sub _set_attr_C {
+ my ($self, $name, $val, $ec) = @_;
+ defined $val or $val = 0;
+ utf8::decode ($val);
+ $self->{$name} = $val;
+ $ec = _check_sanity ($self) and
+ croak ($self->SetDiag ($ec));
+ $self->_cache_set ($_cache_id{$name}, $val);
+ }
+
+# A flag
+sub _set_attr_X {
+ my ($self, $name, $val) = @_;
+ defined $val or $val = 0;
+ $self->{$name} = $val;
+ $self->_cache_set ($_cache_id{$name}, 0 + $val);
+ }
+
+# A number
+sub _set_attr_N {
+ my ($self, $name, $val) = @_;
+ $self->{$name} = $val;
+ $self->_cache_set ($_cache_id{$name}, 0 + $val);
+ }
+
+# Accessor methods.
+# It is unwise to change them halfway through a single file!
+sub quote_char {
+ my $self = shift;
+ if (@_) {
+ $self->_set_attr_C ("quote_char", shift);
+ $self->_cache_set ($_cache_id{quote}, "");
+ }
+ $self->{quote_char};
+ }
+
+sub quote {
+ my $self = shift;
+ if (@_) {
+ my $quote = shift;
+ defined $quote or $quote = "";
+ utf8::decode ($quote);
+ my @b = unpack "U0C*", $quote;
+ if (@b > 1) {
+ @b > 16 and croak ($self->SetDiag (1007));
+ $self->quote_char ("\0");
+ }
+ else {
+ $self->quote_char ($quote);
+ $quote = "";
+ }
+ $self->{quote} = $quote;
+
+ my $ec = _check_sanity ($self);
+ $ec and croak ($self->SetDiag ($ec));
+
+ $self->_cache_set ($_cache_id{quote}, $quote);
+ }
+ my $quote = $self->{quote};
+ defined $quote && length ($quote) ? $quote : $self->{quote_char};
+ }
+
+sub escape_char {
+ my $self = shift;
+ @_ and $self->_set_attr_C ("escape_char", shift);
+ $self->{escape_char};
+ }
+
+sub sep_char {
+ my $self = shift;
+ if (@_) {
+ $self->_set_attr_C ("sep_char", shift);
+ $self->_cache_set ($_cache_id{sep}, "");
+ }
+ $self->{sep_char};
+}
+
+sub sep {
+ my $self = shift;
+ if (@_) {
+ my $sep = shift;
+ defined $sep or $sep = "";
+ utf8::decode ($sep);
+ my @b = unpack "U0C*", $sep;
+ if (@b > 1) {
+ @b > 16 and croak ($self->SetDiag (1006));
+ $self->sep_char ("\0");
+ }
+ else {
+ $self->sep_char ($sep);
+ $sep = "";
+ }
+ $self->{sep} = $sep;
+
+ my $ec = _check_sanity ($self);
+ $ec and croak ($self->SetDiag ($ec));
+
+ $self->_cache_set ($_cache_id{sep}, $sep);
+ }
+ my $sep = $self->{sep};
+ defined $sep && length ($sep) ? $sep : $self->{sep_char};
+ }
+
+sub eol {
+ my $self = shift;
+ if (@_) {
+ my $eol = shift;
+ defined $eol or $eol = "";
+ length ($eol) > 16 and croak ($self->SetDiag (1005));
+ $self->{eol} = $eol;
+ $self->_cache_set ($_cache_id{eol}, $eol);
+ }
+ $self->{eol};
+ }
+
+sub always_quote {
+ my $self = shift;
+ @_ and $self->_set_attr_X ("always_quote", shift);
+ $self->{always_quote};
+ }
+
+sub quote_space {
+ my $self = shift;
+ @_ and $self->_set_attr_X ("quote_space", shift);
+ $self->{quote_space};
+ }
+
+sub quote_empty {
+ my $self = shift;
+ @_ and $self->_set_attr_X ("quote_empty", shift);
+ $self->{quote_empty};
+ }
+
+sub escape_null {
+ my $self = shift;
+ @_ and $self->_set_attr_X ("escape_null", shift);
+ $self->{escape_null};
+ }
+
+sub quote_null { goto &escape_null; }
+
+sub quote_binary {
+ my $self = shift;
+ @_ and $self->_set_attr_X ("quote_binary", shift);
+ $self->{quote_binary};
+ }
+
+sub binary {
+ my $self = shift;
+ @_ and $self->_set_attr_X ("binary", shift);
+ $self->{binary};
+ }
+
+sub strict {
+ my $self = shift;
+ @_ and $self->_set_attr_X ("strict", shift);
+ $self->{strict};
+ }
+
+sub decode_utf8 {
+ my $self = shift;
+ @_ and $self->_set_attr_X ("decode_utf8", shift);
+ $self->{decode_utf8};
+}
+
+sub keep_meta_info {
+ my $self = shift;
+ if (@_) {
+ my $v = shift;
+ !defined $v || $v eq "" and $v = 0;
+ $v =~ m/^[0-9]/ or $v = lc $v eq "false" ? 0 : 1; # true/truth = 1
+ $self->_set_attr_X ("keep_meta_info", $v);
+ }
+ $self->{keep_meta_info};
+ }
+
+sub allow_loose_quotes {
+ my $self = shift;
+ @_ and $self->_set_attr_X ("allow_loose_quotes", shift);
+ $self->{allow_loose_quotes};
+ }
+
+sub allow_loose_escapes {
+ my $self = shift;
+ @_ and $self->_set_attr_X ("allow_loose_escapes", shift);
+ $self->{allow_loose_escapes};
+ }
+
+sub allow_whitespace {
+ my $self = shift;
+ if (@_) {
+ my $aw = shift;
+ _unhealthy_whitespace ($self, $aw) and
+ croak ($self->SetDiag (1002));
+ $self->_set_attr_X ("allow_whitespace", $aw);
+ }
+ $self->{allow_whitespace};
+ }
+
+sub allow_unquoted_escape {
+ my $self = shift;
+ @_ and $self->_set_attr_X ("allow_unquoted_escape", shift);
+ $self->{allow_unquoted_escape};
+ }
+
+sub blank_is_undef {
+ my $self = shift;
+ @_ and $self->_set_attr_X ("blank_is_undef", shift);
+ $self->{blank_is_undef};
+ }
+
+sub empty_is_undef {
+ my $self = shift;
+ @_ and $self->_set_attr_X ("empty_is_undef", shift);
+ $self->{empty_is_undef};
+ }
+
+sub verbatim {
+ my $self = shift;
+ @_ and $self->_set_attr_X ("verbatim", shift);
+ $self->{verbatim};
+ }
+
+sub auto_diag {
+ my $self = shift;
+ if (@_) {
+ my $v = shift;
+ !defined $v || $v eq "" and $v = 0;
+ $v =~ m/^[0-9]/ or $v = lc $v eq "false" ? 0 : 1; # true/truth = 1
+ $self->_set_attr_X ("auto_diag", $v);
+ }
+ $self->{auto_diag};
+ }
+
+sub diag_verbose {
+ my $self = shift;
+ if (@_) {
+ my $v = shift;
+ !defined $v || $v eq "" and $v = 0;
+ $v =~ m/^[0-9]/ or $v = lc $v eq "false" ? 0 : 1; # true/truth = 1
+ $self->_set_attr_X ("diag_verbose", $v);
+ }
+ $self->{diag_verbose};
+ }
+
+################################################################################
+# status
+################################################################################
+
+sub status {
+ $_[0]->{_STATUS};
+}
+
+sub eof {
+ $_[0]->{_EOF};
+}
+
+sub types {
+ my $self = shift;
+
+ if (@_) {
+ if (my $types = shift) {
+ $self->{'_types'} = join("", map{ chr($_) } @$types);
+ $self->{'types'} = $types;
+ }
+ else {
+ delete $self->{'types'};
+ delete $self->{'_types'};
+ undef;
+ }
+ }
+ else {
+ $self->{'types'};
+ }
+}
+
+sub callbacks {
+ my $self = shift;
+ if (@_) {
+ my $cb;
+ my $hf = 0x00;
+ if (defined $_[0]) {
+ grep { !defined } @_ and croak ($self->SetDiag (1004));
+ $cb = @_ == 1 && ref $_[0] eq "HASH" ? shift
+ : @_ % 2 == 0 ? { @_ }
+ : croak ($self->SetDiag (1004));
+ foreach my $cbk (keys %$cb) {
+ (!ref $cbk && $cbk =~ m/^[\w.]+$/) && ref $cb->{$cbk} eq "CODE" or
+ croak ($self->SetDiag (1004));
+ }
+ exists $cb->{error} and $hf |= 0x01;
+ exists $cb->{after_parse} and $hf |= 0x02;
+ exists $cb->{before_print} and $hf |= 0x04;
+ }
+ elsif (@_ > 1) {
+ # (undef, whatever)
+ croak ($self->SetDiag (1004));
+ }
+ $self->_set_attr_X ("_has_hooks", $hf);
+ $self->{callbacks} = $cb;
+ }
+ $self->{callbacks};
+ }
+
+################################################################################
+# error_diag
+################################################################################
+
+sub error_diag {
+ my $self = shift;
+ my @diag = (0 + $last_new_error, $last_new_error, 0, 0, 0);
+
+ if ($self && ref $self && # Not a class method or direct call
+ $self->isa (__PACKAGE__) && defined $self->{_ERROR_DIAG}) {
+ $diag[0] = 0 + $self->{_ERROR_DIAG};
+ $diag[1] = $self->{_ERROR_DIAG};
+ $diag[2] = 1 + $self->{_ERROR_POS} if exists $self->{_ERROR_POS};
+ $diag[3] = $self->{_RECNO};
+ $diag[4] = $self->{_ERROR_FLD} if exists $self->{_ERROR_FLD};
+
+ $diag[0] && $self && $self->{callbacks} && $self->{callbacks}{error} and
+ return $self->{callbacks}{error}->(@diag);
+ }
+
+ my $context = wantarray;
+
+ unless (defined $context) { # Void context, auto-diag
+ if ($diag[0] && $diag[0] != 2012) {
+ my $msg = "# CSV_PP ERROR: $diag[0] - $diag[1] \@ rec $diag[3] pos $diag[2]\n";
+ $diag[4] and $msg =~ s/$/ field $diag[4]/;
+
+ unless ($self && ref $self) { # auto_diag
+ # called without args in void context
+ warn $msg;
+ return;
+ }
+
+ if ($self->{diag_verbose} and $self->{_ERROR_INPUT}) {
+ $msg .= "$self->{_ERROR_INPUT}'\n";
+ $msg .= " " x ($diag[2] - 1);
+ $msg .= "^\n";
+ }
+
+ my $lvl = $self->{auto_diag};
+ if ($lvl < 2) {
+ my @c = caller (2);
+ if (@c >= 11 && $c[10] && ref $c[10] eq "HASH") {
+ my $hints = $c[10];
+ (exists $hints->{autodie} && $hints->{autodie} or
+ exists $hints->{"guard Fatal"} &&
+ !exists $hints->{"no Fatal"}) and
+ $lvl++;
+ # Future releases of autodie will probably set $^H{autodie}
+ # to "autodie @args", like "autodie :all" or "autodie open"
+ # so we can/should check for "open" or "new"
+ }
+ }
+ $lvl > 1 ? die $msg : warn $msg;
+ }
+ return;
+ }
+
+ return $context ? @diag : $diag[1];
+}
+
+sub record_number {
+ return shift->{_RECNO};
+}
+
+################################################################################
+# string
+################################################################################
+
+*string = \&_string;
+sub _string {
+ defined $_[0]->{_STRING} ? ${ $_[0]->{_STRING} } : undef;
+}
+
+################################################################################
+# fields
+################################################################################
+
+*fields = \&_fields;
+sub _fields {
+ ref($_[0]->{_FIELDS}) ? @{$_[0]->{_FIELDS}} : undef;
+}
+
+################################################################################
+# meta_info
+################################################################################
+
+sub meta_info {
+ $_[0]->{_FFLAGS} ? @{ $_[0]->{_FFLAGS} } : undef;
+}
+
+sub is_quoted {
+ return unless (defined $_[0]->{_FFLAGS});
+ return if( $_[1] =~ /\D/ or $_[1] < 0 or $_[1] > $#{ $_[0]->{_FFLAGS} } );
+
+ $_[0]->{_FFLAGS}->[$_[1]] & IS_QUOTED ? 1 : 0;
+}
+
+sub is_binary {
+ return unless (defined $_[0]->{_FFLAGS});
+ return if( $_[1] =~ /\D/ or $_[1] < 0 or $_[1] > $#{ $_[0]->{_FFLAGS} } );
+ $_[0]->{_FFLAGS}->[$_[1]] & IS_BINARY ? 1 : 0;
+}
+
+sub is_missing {
+ my ($self, $idx, $val) = @_;
+ return unless $self->{keep_meta_info}; # FIXME
+ $idx < 0 || !ref $self->{_FFLAGS} and return;
+ $idx >= @{$self->{_FFLAGS}} and return 1;
+ $self->{_FFLAGS}[$idx] & IS_MISSING ? 1 : 0;
+}
+
+################################################################################
+# combine
+################################################################################
+*combine = \&_combine;
+sub _combine {
+ my ($self, @fields) = @_;
+ my $str = "";
+ $self->{_FIELDS} = \@fields;
+ $self->{_STATUS} = (@fields > 0) && $self->__combine(\$str, \@fields, 0);
+ $self->{_STRING} = \$str;
+ $self->{_STATUS};
+ }
+
+################################################################################
+# parse
+################################################################################
+*parse = \&_parse;
+sub _parse {
+ my ($self, $str) = @_;
+
+ ref $str and croak ($self->SetDiag (1500));
+
+ my $fields = [];
+ my $fflags = [];
+ $self->{_STRING} = \$str;
+ if (defined $str && $self->__parse ($fields, $fflags, $str, 0)) {
+ $self->{_FIELDS} = $fields;
+ $self->{_FFLAGS} = $fflags;
+ $self->{_STATUS} = 1;
+ }
+ else {
+ $self->{_FIELDS} = undef;
+ $self->{_FFLAGS} = undef;
+ $self->{_STATUS} = 0;
+ }
+ $self->{_STATUS};
+ }
+
+sub column_names {
+ my ( $self, @columns ) = @_;
+
+ @columns or return defined $self->{_COLUMN_NAMES} ? @{$self->{_COLUMN_NAMES}} : ();
+ @columns == 1 && ! defined $columns[0] and return $self->{_COLUMN_NAMES} = undef;
+
+ if ( @columns == 1 && ref $columns[0] eq "ARRAY" ) {
+ @columns = @{ $columns[0] };
+ }
+ elsif ( join "", map { defined $_ ? ref $_ : "" } @columns ) {
+ croak $self->SetDiag( 3001 );
+ }
+
+ if ( $self->{_BOUND_COLUMNS} && @columns != @{$self->{_BOUND_COLUMNS}} ) {
+ croak $self->SetDiag( 3003 );
+ }
+
+ $self->{_COLUMN_NAMES} = [ map { defined $_ ? $_ : "\cAUNDEF\cA" } @columns ];
+ @{ $self->{_COLUMN_NAMES} };
+}
+
+sub header {
+ my ($self, $fh, @args) = @_;
+
+ $fh or croak ($self->SetDiag (1014));
+
+ my (@seps, %args);
+ for (@args) {
+ if (ref $_ eq "ARRAY") {
+ push @seps, @$_;
+ next;
+ }
+ if (ref $_ eq "HASH") {
+ %args = %$_;
+ next;
+ }
+ croak (q{usage: $csv->header ($fh, [ seps ], { options })});
+ }
+
+ defined $args{detect_bom} or $args{detect_bom} = 1;
+ defined $args{munge_column_names} or $args{munge_column_names} = "lc";
+ defined $args{set_column_names} or $args{set_column_names} = 1;
+
+ defined $args{sep_set} && ref $args{sep_set} eq "ARRAY" and
+ @seps = @{$args{sep_set}};
+
+ my $hdr = <$fh>;
+ defined $hdr && $hdr ne "" or croak ($self->SetDiag (1010));
+
+ my %sep;
+ @seps or @seps = (",", ";");
+ foreach my $sep (@seps) {
+ index ($hdr, $sep) >= 0 and $sep{$sep}++;
+ }
+
+ keys %sep >= 2 and croak ($self->SetDiag (1011));
+
+ $self->sep (keys %sep);
+ my $enc = "";
+ if ($args{detect_bom}) { # UTF-7 is not supported
+ if ($hdr =~ s/^\x00\x00\xfe\xff//) { $enc = "utf-32be" }
+ elsif ($hdr =~ s/^\xff\xfe\x00\x00//) { $enc = "utf-32le" }
+ elsif ($hdr =~ s/^\xfe\xff//) { $enc = "utf-16be" }
+ elsif ($hdr =~ s/^\xff\xfe//) { $enc = "utf-16le" }
+ elsif ($hdr =~ s/^\xef\xbb\xbf//) { $enc = "utf-8" }
+ elsif ($hdr =~ s/^\xf7\x64\x4c//) { $enc = "utf-1" }
+ elsif ($hdr =~ s/^\xdd\x73\x66\x73//) { $enc = "utf-ebcdic" }
+ elsif ($hdr =~ s/^\x0e\xfe\xff//) { $enc = "scsu" }
+ elsif ($hdr =~ s/^\xfb\xee\x28//) { $enc = "bocu-1" }
+ elsif ($hdr =~ s/^\x84\x31\x95\x33//) { $enc = "gb-18030" }
+
+ if ($enc) {
+ if ($enc =~ m/([13]).le$/) {
+ my $l = 0 + $1;
+ my $x;
+ $hdr .= "\0" x $l;
+ read $fh, $x, $l;
+ }
+ $enc = ":encoding($enc)";
+ binmode $fh, $enc;
+ }
+ }
+
+ $args{munge_column_names} eq "lc" and $hdr = lc $hdr;
+ $args{munge_column_names} eq "uc" and $hdr = uc $hdr;
+
+ my $hr = \$hdr; # Will cause croak on perl-5.6.x
+ open my $h, "<$enc", $hr;
+ my $row = $self->getline ($h) or croak;
+ close $h;
+
+ my @hdr = @$row or croak ($self->SetDiag (1010));
+ ref $args{munge_column_names} eq "CODE" and
+ @hdr = map { $args{munge_column_names}->($_) } @hdr;
+ my %hdr = map { $_ => 1 } @hdr;
+ exists $hdr{""} and croak ($self->SetDiag (1012));
+ keys %hdr == @hdr or croak ($self->SetDiag (1013));
+ $args{set_column_names} and $self->column_names (@hdr);
+ wantarray ? @hdr : $self;
+ }
+
+sub bind_columns {
+ my ( $self, @refs ) = @_;
+
+ @refs or return defined $self->{_BOUND_COLUMNS} ? @{$self->{_BOUND_COLUMNS}} : undef;
+ @refs == 1 && ! defined $refs[0] and return $self->{_BOUND_COLUMNS} = undef;
+
+ if ( $self->{_COLUMN_NAMES} && @refs != @{$self->{_COLUMN_NAMES}} ) {
+ croak $self->SetDiag( 3003 );
+ }
+
+ if ( grep { ref $_ ne "SCALAR" } @refs ) { # why don't use grep?
+ croak $self->SetDiag( 3004 );
+ }
+
+ $self->_set_attr_N("_is_bound", scalar @refs);
+ $self->{_BOUND_COLUMNS} = [ @refs ];
+ @refs;
+}
+
+sub getline_hr {
+ my ($self, @args, %hr) = @_;
+ $self->{_COLUMN_NAMES} or croak ($self->SetDiag (3002));
+ my $fr = $self->getline (@args) or return;
+ if (ref $self->{_FFLAGS}) { # missing
+ $self->{_FFLAGS}[$_] = IS_MISSING
+ for (@$fr ? $#{$fr} + 1 : 0) .. $#{$self->{_COLUMN_NAMES}};
+ @$fr == 1 && (!defined $fr->[0] || $fr->[0] eq "") and
+ $self->{_FFLAGS}[0] ||= IS_MISSING;
+ }
+ @hr{@{$self->{_COLUMN_NAMES}}} = @$fr;
+ \%hr;
+}
+
+sub getline_hr_all {
+ my ( $self, $io, @args ) = @_;
+ my %hr;
+
+ unless ( $self->{_COLUMN_NAMES} ) {
+ croak $self->SetDiag( 3002 );
+ }
+
+ my @cn = @{$self->{_COLUMN_NAMES}};
+
+ return [ map { my %h; @h{ @cn } = @$_; \%h } @{ $self->getline_all( $io, @args ) } ];
+}
+
+sub say {
+ my ($self, $io, @f) = @_;
+ my $eol = $self->eol;
+ defined $eol && $eol ne "" or $self->eol ($\ || $/);
+ my $state = $self->print ($io, @f);
+ $self->eol ($eol);
+ return $state;
+ }
+
+sub print_hr {
+ my ($self, $io, $hr) = @_;
+ $self->{_COLUMN_NAMES} or croak($self->SetDiag(3009));
+ ref $hr eq "HASH" or croak($self->SetDiag(3010));
+ $self->print ($io, [ map { $hr->{$_} } $self->column_names ]);
+}
+
+sub fragment {
+ my ($self, $io, $spec) = @_;
+
+ my $qd = qr{\s* [0-9]+ \s* }x; # digit
+ my $qs = qr{\s* (?: [0-9]+ | \* ) \s*}x; # digit or star
+ my $qr = qr{$qd (?: - $qs )?}x; # range
+ my $qc = qr{$qr (?: ; $qr )*}x; # list
+ defined $spec && $spec =~ m{^ \s*
+ \x23 ? \s* # optional leading #
+ ( row | col | cell ) \s* =
+ ( $qc # for row and col
+ | $qd , $qd (?: - $qs , $qs)? # for cell (ranges)
+ (?: ; $qd , $qd (?: - $qs , $qs)? )* # and cell (range) lists
+ ) \s* $}xi or croak ($self->SetDiag (2013));
+ my ($type, $range) = (lc $1, $2);
+
+ my @h = $self->column_names ();
+
+ my @c;
+ if ($type eq "cell") {
+ my @spec;
+ my $min_row;
+ my $max_row = 0;
+ for (split m/\s*;\s*/ => $range) {
+ my ($tlr, $tlc, $brr, $brc) = (m{
+ ^ \s* ([0-9]+ ) \s* , \s* ([0-9]+ ) \s*
+ (?: - \s* ([0-9]+ | \*) \s* , \s* ([0-9]+ | \*) \s* )?
+ $}x) or croak ($self->SetDiag (2013));
+ defined $brr or ($brr, $brc) = ($tlr, $tlc);
+ $tlr == 0 || $tlc == 0 ||
+ ($brr ne "*" && ($brr == 0 || $brr < $tlr)) ||
+ ($brc ne "*" && ($brc == 0 || $brc < $tlc))
+ and croak ($self->SetDiag (2013));
+ $tlc--;
+ $brc-- unless $brc eq "*";
+ defined $min_row or $min_row = $tlr;
+ $tlr < $min_row and $min_row = $tlr;
+ $brr eq "*" || $brr > $max_row and
+ $max_row = $brr;
+ push @spec, [ $tlr, $tlc, $brr, $brc ];
+ }
+ my $r = 0;
+ while (my $row = $self->getline ($io)) {
+ ++$r < $min_row and next;
+ my %row;
+ my $lc;
+ foreach my $s (@spec) {
+ my ($tlr, $tlc, $brr, $brc) = @$s;
+ $r < $tlr || ($brr ne "*" && $r > $brr) and next;
+ !defined $lc || $tlc < $lc and $lc = $tlc;
+ my $rr = $brc eq "*" ? $#$row : $brc;
+ $row{$_} = $row->[$_] for $tlc .. $rr;
+ }
+ push @c, [ @row{sort { $a <=> $b } keys %row } ];
+ if (@h) {
+ my %h; @h{@h} = @{$c[-1]};
+ $c[-1] = \%h;
+ }
+ $max_row ne "*" && $r == $max_row and last;
+ }
+ return \@c;
+ }
+
+ # row or col
+ my @r;
+ my $eod = 0;
+ for (split m/\s*;\s*/ => $range) {
+ my ($from, $to) = m/^\s* ([0-9]+) (?: \s* - \s* ([0-9]+ | \* ))? \s* $/x
+ or croak ($self->SetDiag (2013));
+ $to ||= $from;
+ $to eq "*" and ($to, $eod) = ($from, 1);
+ $from <= 0 || $to <= 0 || $to < $from and croak ($self->SetDiag (2013));
+ $r[$_] = 1 for $from .. $to;
+ }
+
+ my $r = 0;
+ $type eq "col" and shift @r;
+ $_ ||= 0 for @r;
+ while (my $row = $self->getline ($io)) {
+ $r++;
+ if ($type eq "row") {
+ if (($r > $#r && $eod) || $r[$r]) {
+ push @c, $row;
+ if (@h) {
+ my %h; @h{@h} = @{$c[-1]};
+ $c[-1] = \%h;
+ }
+ }
+ next;
+ }
+ push @c, [ map { ($_ > $#r && $eod) || $r[$_] ? $row->[$_] : () } 0..$#$row ];
+ if (@h) {
+ my %h; @h{@h} = @{$c[-1]};
+ $c[-1] = \%h;
+ }
+ }
+
+ return \@c;
+ }
+
+my $csv_usage = q{usage: my $aoa = csv (in => $file);};
+
+sub _csv_attr {
+ my %attr = (@_ == 1 && ref $_[0] eq "HASH" ? %{$_[0]} : @_) or croak;
+
+ $attr{binary} = 1;
+
+ my $enc = delete $attr{enc} || delete $attr{encoding} || "";
+ $enc eq "auto" and ($attr{detect_bom}, $enc) = (1, "");
+ $enc =~ m/^[-\w.]+$/ and $enc = ":encoding($enc)";
+
+ my $fh;
+ my $cls = 0; # If I open a file, I have to close it
+ my $in = delete $attr{in} || delete $attr{file} or croak $csv_usage;
+ my $out = delete $attr{out} || delete $attr{file};
+
+ ref $in eq "CODE" || ref $in eq "ARRAY" and $out ||= \*STDOUT;
+
+ if ($out) {
+ $in or croak $csv_usage; # No out without in
+ if ((ref $out and ref $out ne "SCALAR") or "GLOB" eq ref \$out) {
+ $fh = $out;
+ }
+ else {
+ open $fh, ">", $out or croak "$out: $!";
+ $cls = 1;
+ }
+ $enc and binmode $fh, $enc;
+ unless (defined $attr{eol}) {
+ my @layers = eval { PerlIO::get_layers ($fh) };
+ $attr{eol} = (grep m/crlf/ => @layers) ? "\n" : "\r\n";
+ }
+ }
+
+ if ( ref $in eq "CODE" or ref $in eq "ARRAY") {
+ # All done
+ }
+ elsif (ref $in eq "SCALAR") {
+ # Strings with code points over 0xFF may not be mapped into in-memory file handles
+ # "<$enc" does not change that :(
+ open $fh, "<", $in or croak "Cannot open from SCALAR using PerlIO";
+ $cls = 1;
+ }
+ elsif (ref $in or "GLOB" eq ref \$in) {
+ if (!ref $in && $] < 5.008005) {
+ $fh = \*$in; # uncoverable statement ancient perl version required
+ }
+ else {
+ $fh = $in;
+ }
+ }
+ else {
+ open $fh, "<$enc", $in or croak "$in: $!";
+ $cls = 1;
+ }
+ $fh or croak qq{No valid source passed. "in" is required};
+
+ my $hdrs = delete $attr{headers};
+ my $frag = delete $attr{fragment};
+ my $key = delete $attr{key};
+
+ my $cbai = delete $attr{callbacks}{after_in} ||
+ delete $attr{after_in} ||
+ delete $attr{callbacks}{after_parse} ||
+ delete $attr{after_parse};
+ my $cbbo = delete $attr{callbacks}{before_out} ||
+ delete $attr{before_out};
+ my $cboi = delete $attr{callbacks}{on_in} ||
+ delete $attr{on_in};
+
+ my $hd_s = delete $attr{sep_set} ||
+ delete $attr{seps};
+ my $hd_b = delete $attr{detect_bom} ||
+ delete $attr{bom};
+ my $hd_m = delete $attr{munge} ||
+ delete $attr{munge_column_names};
+ my $hd_c = delete $attr{set_column_names};
+
+ for ([ quo => "quote" ],
+ [ esc => "escape" ],
+ [ escape => "escape_char" ],
+ ) {
+ my ($f, $t) = @$_;
+ exists $attr{$f} and !exists $attr{$t} and $attr{$t} = delete $attr{$f};
+ }
+
+ my $fltr = delete $attr{filter};
+ my %fltr = (
+ not_blank => sub { @{$_[1]} > 1 or defined $_[1][0] && $_[1][0] ne "" },
+ not_empty => sub { grep { defined && $_ ne "" } @{$_[1]} },
+ filled => sub { grep { defined && m/\S/ } @{$_[1]} },
+ );
+ defined $fltr && !ref $fltr && exists $fltr{$fltr} and
+ $fltr = { 0 => $fltr{$fltr} };
+ ref $fltr eq "HASH" or $fltr = undef;
+
+ defined $attr{auto_diag} or $attr{auto_diag} = 1;
+ defined $attr{escape_null} or $attr{escape_null} = 0;
+ my $csv = delete $attr{csv} || Text::CSV_PP->new (\%attr)
+ or croak $last_new_error;
+
+ return {
+ csv => $csv,
+ attr => { %attr },
+ fh => $fh,
+ cls => $cls,
+ in => $in,
+ out => $out,
+ enc => $enc,
+ hdrs => $hdrs,
+ key => $key,
+ frag => $frag,
+ fltr => $fltr,
+ cbai => $cbai,
+ cbbo => $cbbo,
+ cboi => $cboi,
+ hd_s => $hd_s,
+ hd_b => $hd_b,
+ hd_m => $hd_m,
+ hd_c => $hd_c,
+ };
+ }
+
+sub csv {
+ @_ && (ref $_[0] eq __PACKAGE__ or ref $_[0] eq 'Text::CSV') and splice @_, 0, 0, "csv";
+ @_ or croak $csv_usage;
+
+ my $c = _csv_attr (@_);
+
+ my ($csv, $in, $fh, $hdrs) = @{$c}{"csv", "in", "fh", "hdrs"};
+ my %hdr;
+ if (ref $hdrs eq "HASH") {
+ %hdr = %$hdrs;
+ $hdrs = "auto";
+ }
+
+ if ($c->{out}) {
+ if (ref $in eq "CODE") {
+ my $hdr = 1;
+ while (my $row = $in->($csv)) {
+ if (ref $row eq "ARRAY") {
+ $csv->print ($fh, $row);
+ next;
+ }
+ if (ref $row eq "HASH") {
+ if ($hdr) {
+ $hdrs ||= [ map { $hdr{$_} || $_ } keys %$row ];
+ $csv->print ($fh, $hdrs);
+ $hdr = 0;
+ }
+ $csv->print ($fh, [ @{$row}{@$hdrs} ]);
+ }
+ }
+ }
+ elsif (ref $in->[0] eq "ARRAY") { # aoa
+ ref $hdrs and $csv->print ($fh, $hdrs);
+ for (@{$in}) {
+ $c->{cboi} and $c->{cboi}->($csv, $_);
+ $c->{cbbo} and $c->{cbbo}->($csv, $_);
+ $csv->print ($fh, $_);
+ }
+ }
+ else { # aoh
+ my @hdrs = ref $hdrs ? @{$hdrs} : keys %{$in->[0]};
+ defined $hdrs or $hdrs = "auto";
+ ref $hdrs || $hdrs eq "auto" and
+ $csv->print ($fh, [ map { $hdr{$_} || $_ } @hdrs ]);
+ for (@{$in}) {
+ local %_;
+ *_ = $_;
+ $c->{cboi} and $c->{cboi}->($csv, $_);
+ $c->{cbbo} and $c->{cbbo}->($csv, $_);
+ $csv->print ($fh, [ @{$_}{@hdrs} ]);
+ }
+ }
+
+ $c->{cls} and close $fh;
+ return 1;
+ }
+
+ if (defined $c->{hd_s} || defined $c->{hd_b} || defined $c->{hd_m} || defined $c->{hd_c}) {
+ my %harg;
+ defined $c->{hd_s} and $harg{set_set} = $c->{hd_s};
+ defined $c->{hd_d} and $harg{detect_bom} = $c->{hd_b};
+ defined $c->{hd_m} and $harg{munge_column_names} = $hdrs ? "none" : $c->{hd_m};
+ defined $c->{hd_c} and $harg{set_column_names} = $hdrs ? 0 : $c->{hd_c};
+ $csv->header ($fh, \%harg);
+ my @hdr = $csv->column_names;
+ @hdr and $hdrs ||= \@hdr;
+ }
+
+ my $key = $c->{key} and $hdrs ||= "auto";
+ $c->{fltr} && grep m/\D/ => keys %{$c->{fltr}} and $hdrs ||= "auto";
+ if (defined $hdrs) {
+ if (!ref $hdrs) {
+ if ($hdrs eq "skip") {
+ $csv->getline ($fh); # discard;
+ }
+ elsif ($hdrs eq "auto") {
+ my $h = $csv->getline ($fh) or return;
+ $hdrs = [ map { $hdr{$_} || $_ } @$h ];
+ }
+ elsif ($hdrs eq "lc") {
+ my $h = $csv->getline ($fh) or return;
+ $hdrs = [ map { lc ($hdr{$_} || $_) } @$h ];
+ }
+ elsif ($hdrs eq "uc") {
+ my $h = $csv->getline ($fh) or return;
+ $hdrs = [ map { uc ($hdr{$_} || $_) } @$h ];
+ }
+ }
+ elsif (ref $hdrs eq "CODE") {
+ my $h = $csv->getline ($fh) or return;
+ my $cr = $hdrs;
+ $hdrs = [ map { $cr->($hdr{$_} || $_) } @$h ];
+ }
+ }
+
+ if ($c->{fltr}) {
+ my %f = %{$c->{fltr}};
+ # convert headers to index
+ my @hdr;
+ if (ref $hdrs) {
+ @hdr = @{$hdrs};
+ for (0 .. $#hdr) {
+ exists $f{$hdr[$_]} and $f{$_ + 1} = delete $f{$hdr[$_]};
+ }
+ }
+ $csv->callbacks (after_parse => sub {
+ my ($CSV, $ROW) = @_; # lexical sub-variables in caps
+ foreach my $FLD (sort keys %f) {
+ local $_ = $ROW->[$FLD - 1];
+ local %_;
+ @hdr and @_{@hdr} = @$ROW;
+ $f{$FLD}->($CSV, $ROW) or return \"skip";
+ $ROW->[$FLD - 1] = $_;
+ }
+ });
+ }
+
+ my $frag = $c->{frag};
+ my $ref = ref $hdrs
+ ? # aoh
+ do {
+ $csv->column_names ($hdrs);
+ $frag ? $csv->fragment ($fh, $frag) :
+ $key ? { map { $_->{$key} => $_ } @{$csv->getline_hr_all ($fh)} }
+ : $csv->getline_hr_all ($fh);
+ }
+ : # aoa
+ $frag ? $csv->fragment ($fh, $frag)
+ : $csv->getline_all ($fh);
+ $ref or Text::CSV_PP->auto_diag;
+ $c->{cls} and close $fh;
+ if ($ref and $c->{cbai} || $c->{cboi}) {
+ foreach my $r (@{$ref}) {
+ local %_;
+ ref $r eq "HASH" and *_ = $r;
+ $c->{cbai} and $c->{cbai}->($csv, $r);
+ $c->{cboi} and $c->{cboi}->($csv, $r);
+ }
+ }
+
+ defined wantarray or
+ return csv (%{$c->{attr}}, in => $ref, headers => $hdrs, %{$c->{attr}});
+
+ return $ref;
+ }
+
+# The end of the common pure perl part.
+
+################################################################################
+#
+# The following are methods implemented in XS in Text::CSV_XS or
+# helper methods for Text::CSV_PP only
+#
+################################################################################
+
+sub _setup_ctx {
+ my $self = shift;
+
+ $last_error = undef;
+
+ my $ctx;
+ if ($self->{_CACHE}) {
+ $ctx = $self->{_CACHE};
+ } else {
+ $ctx ||= {};
+ # $ctx->{self} = $self;
+ $ctx->{pself} = ref $self || $self;
+
+ $ctx->{sep} = ',';
+ if (defined $self->{sep_char}) {
+ $ctx->{sep} = $self->{sep_char};
+ }
+ if (defined $self->{sep} and $self->{sep} ne '') {
+ use bytes;
+ $ctx->{sep} = $self->{sep};
+ my $sep_len = length($ctx->{sep});
+ $ctx->{sep_len} = $sep_len if $sep_len > 1;
+ }
+
+ $ctx->{quo} = '"';
+ if (exists $self->{quote_char}) {
+ my $quote_char = $self->{quote_char};
+ if (defined $quote_char and length $quote_char) {
+ $ctx->{quo} = $quote_char;
+ } else {
+ $ctx->{quo} = "\0";
+ }
+ }
+ if (defined $self->{quote} and $self->{quote} ne '') {
+ use bytes;
+ $ctx->{quo} = $self->{quote};
+ my $quote_len = length($ctx->{quo});
+ $ctx->{quo_len} = $quote_len if $quote_len > 1;
+ }
+
+ $ctx->{escape_char} = '"';
+ if (exists $self->{escape_char}) {
+ my $escape_char = $self->{escape_char};
+ if (defined $escape_char and length $escape_char) {
+ $ctx->{escape_char} = $escape_char;
+ } else {
+ $ctx->{escape_char} = "\0";
+ }
+ }
+
+ if (defined $self->{eol}) {
+ my $eol = $self->{eol};
+ my $eol_len = length($eol);
+ $ctx->{eol} = $eol;
+ $ctx->{eol_len} = $eol_len;
+ if ($eol_len == 1 and $eol eq "\015") {
+ $ctx->{eol_is_cr} = 1;
+ }
+ }
+
+ if (defined $self->{_types}) {
+ $ctx->{types} = $self->{_types};
+ $ctx->{types_len} = length($ctx->{types});
+ }
+
+ if (defined $self->{_is_bound}) {
+ $ctx->{is_bound} = $self->{_is_bound};
+ }
+
+ if (defined $self->{callbacks}) {
+ my $cb = $self->{callbacks};
+ $ctx->{has_hooks} = 0;
+ if (defined $cb->{after_parse} and ref $cb->{after_parse} eq 'CODE') {
+ $ctx->{has_hooks} |= HOOK_AFTER_PARSE;
+ }
+ if (defined $cb->{before_print} and ref $cb->{before_print} eq 'CODE') {
+ $ctx->{has_hooks} |= HOOK_BEFORE_PRINT;
+ }
+ }
+
+ for (qw/
+ binary decode_utf8 always_quote strict quote_empty
+ allow_loose_quotes allow_loose_escapes
+ allow_unquoted_escape allow_whitespace blank_is_undef
+ empty_is_undef verbatim auto_diag diag_verbose
+ keep_meta_info
+ /) {
+ $ctx->{$_} = defined $self->{$_} ? $self->{$_} : 0;
+ }
+ for (qw/quote_space escape_null quote_binary/) {
+ $ctx->{$_} = defined $self->{$_} ? $self->{$_} : 1;
+ }
+ # FIXME: readonly
+ $self->{_CACHE} = $ctx;
+ }
+
+ $ctx->{utf8} = 0;
+ $ctx->{size} = 0;
+ $ctx->{used} = 0;
+
+ if ($ctx->{is_bound}) {
+ my $bound = $self->{_BOUND_COLUMNS};
+ if ($bound and ref $bound eq 'ARRAY') {
+ $ctx->{bound} = $bound;
+ } else {
+ $ctx->{is_bound} = 0;
+ }
+ }
+
+ $ctx->{eol_pos} = -1;
+ $ctx->{eolx} = $ctx->{eol_len}
+ ? $ctx->{verbatim} || $ctx->{eol_len} >= 2
+ ? 1
+ : $ctx->{eol} =~ /\A[\015|\012]/ ? 0 : 1
+ : 0;
+
+ if ($ctx->{sep_len} and _is_valid_utf8($ctx->{sep})) {
+ $ctx->{utf8} = 1;
+ }
+ if ($ctx->{quo_len} and _is_valid_utf8($ctx->{quo})) {
+ $ctx->{utf8} = 1;
+ }
+
+ $ctx;
+}
+
+sub _cache_set {
+ my ($self, $idx, $value) = @_;
+ return unless exists $self->{_CACHE};
+ my $cache = $self->{_CACHE};
+
+ my $key = $_reverse_cache_id{$idx};
+ if (!defined $key) {
+ warn (sprintf "Unknown cache index %d ignored\n", $idx);
+ } elsif ($key eq 'sep_char') {
+ $cache->{sep} = $value;
+ $cache->{sep_len} = 0;
+ }
+ elsif ($key eq 'quote_char') {
+ $cache->{quo} = $value;
+ $cache->{quo_len} = 0;
+ }
+ elsif ($key eq '_has_hooks') {
+ $cache->{has_hooks} = $value;
+ }
+ elsif ($key eq '_is_bound') {
+ $cache->{is_bound} = $value;
+ }
+ elsif ($key eq 'sep') {
+ use bytes;
+ my $len = bytes::length($value);
+ $cache->{sep} = $value if $len;
+ $cache->{sep_len} = $len == 1 ? 0 : $len;
+ }
+ elsif ($key eq 'quote') {
+ use bytes;
+ my $len = bytes::length($value);
+ $cache->{quo} = $value if $len;
+ $cache->{quo_len} = $len == 1 ? 0 : $len;
+ }
+ elsif ($key eq 'eol') {
+ $cache->{eol} = $value if length($value);
+ $cache->{eol_is_cr} = $value eq "\015" ? 1 : 0;
+ }
+ else {
+ $cache->{$key} = $value;
+ }
+ return 1;
+}
+
+sub _cache_diag {
+ my $self = shift;
+ unless (exists $self->{_CACHE}) {
+ warn ("CACHE: invalid\n");
+ return;
+ }
+
+ my $cache = $self->{_CACHE};
+ warn ("CACHE:\n");
+ $self->__cache_show_char(quote_char => $cache->{quo});
+ $self->__cache_show_char(escape_char => $cache->{escape_char});
+ $self->__cache_show_char(sep_char => $cache->{sep});
+ for (qw/
+ binary decode_utf8 allow_loose_escapes allow_loose_quotes
+ allow_whitespace always_quote quote_empty quote_space
+ escape_null quote_binary auto_diag diag_verbose strict
+ has_error_input blank_is_undef empty_is_undef has_ahead
+ keep_meta_info verbatim has_hooks eol_is_cr eol_len
+ /) {
+ $self->__cache_show_byte($_ => $cache->{$_});
+ }
+ $self->__cache_show_str(eol => $cache->{eol_len}, $cache->{eol});
+ $self->__cache_show_byte(sep_len => $cache->{sep_len});
+ if ($cache->{sep_len} and $cache->{sep_len} > 1) {
+ $self->__cache_show_str(sep => $cache->{sep_len}, $cache->{sep});
+ }
+ $self->__cache_show_byte(quo_len => $cache->{quo_len});
+ if ($cache->{quo_len} and $cache->{quo_len} > 1) {
+ $self->__cache_show_str(quote => $cache->{quo_len}, $cache->{quo});
+ }
+}
+
+sub __cache_show_byte {
+ my ($self, $key, $value) = @_;
+ warn (sprintf " %-21s %02x:%3d\n", $key, defined $value ? ord($value) : 0, defined $value ? $value : 0);
+}
+
+sub __cache_show_char {
+ my ($self, $key, $value) = @_;
+ my $v = $value;
+ if (defined $value) {
+ my @b = unpack "U0C*", $value;
+ $v = pack "U*", $b[0];
+ }
+ warn (sprintf " %-21s %02x:%s\n", $key, defined $v ? ord($v) : 0, $self->__pretty_str($v, 1));
+}
+
+sub __cache_show_str {
+ my ($self, $key, $len, $value) = @_;
+ warn (sprintf " %-21s %02d:%s\n", $key, $len, $self->__pretty_str($value, $len));
+}
+
+sub __pretty_str { # FIXME
+ my ($self, $str, $len) = @_;
+ return '' unless defined $str;
+ $str = substr($str, 0, $len);
+ $str =~ s/"/\\"/g;
+ $str =~ s/([^\x09\x20-\x7e])/sprintf '\\x{%x}', ord($1)/eg;
+ qq{"$str"};
+}
+
+sub _hook {
+ my ($self, $name, $fields) = @_;
+ return 0 unless $self->{callbacks};
+
+ my $cb = $self->{callbacks}{$name};
+ return 0 unless $cb && ref $cb eq 'CODE';
+
+ my (@res) = $cb->($self, $fields);
+ if (@res) {
+ return 0 if ref $res[0] eq 'SCALAR' and ${$res[0]} eq "skip";
+ }
+ scalar @res;
+}
+
+################################################################################
+# methods for combine
+################################################################################
+
+sub __combine {
+ my ($self, $dst, $fields, $useIO) = @_;
+
+ my $ctx = $self->_setup_ctx;
+
+ my ($binary, $quot, $sep, $esc, $quote_space) = @{$ctx}{qw/binary quo sep escape_char quote_space/};
+
+ if(!defined $quot or $quot eq "\0"){ $quot = ''; }
+
+ my $re_esc;
+ if ($quot ne '') {
+ $re_esc = $self->{_re_comb_escape}->{$quot}->{$esc} ||= qr/(\Q$quot\E|\Q$esc\E)/;
+ } else {
+ $re_esc = $self->{_re_comb_escape}->{$quot}->{$esc} ||= qr/(\Q$esc\E)/;
+ }
+
+ my $re_sp = $self->{_re_comb_sp}->{$sep}->{$quote_space} ||= ( $quote_space ? qr/[\s\Q$sep\E]/ : qr/[\Q$sep\E]/ );
+
+ my $bound = 0;
+ my $n = @$fields - 1;
+ if ($n < 0 and $ctx->{is_bound}) {
+ $n = $ctx->{is_bound} - 1;
+ $bound = 1;
+ }
+
+ my $check_meta = ($ctx->{keep_meta_info} >= 10 and @{$self->{_FFLAGS} || []} >= $n) ? 1 : 0;
+
+ my $must_be_quoted;
+ my @results;
+ for(my $i = 0; $i <= $n; $i++) {
+ my $v_ref;
+ if ($bound) {
+ $v_ref = $self->__bound_field($ctx, $i, 1);
+ } else {
+ if (@$fields > $i) {
+ $v_ref = \($fields->[$i]);
+ }
+ }
+ next unless $v_ref;
+
+ my $value = $$v_ref;
+
+ unless (defined $value) {
+ push @results, '';
+ next;
+ }
+ elsif ( !$binary ) {
+ $binary = 1 if utf8::is_utf8 $value;
+ }
+
+ if (!$binary and $value =~ /[^\x09\x20-\x7E]/) {
+ # an argument contained an invalid character...
+ $self->{_ERROR_INPUT} = $value;
+ $self->SetDiag(2110);
+ return 0;
+ }
+
+ $must_be_quoted = 0;
+ if ($value eq '') {
+ $must_be_quoted++ if $ctx->{quote_empty} or ($check_meta && $self->is_quoted($i));
+ }
+ else {
+ if($value =~ s/$re_esc/$esc$1/g and $quot ne ''){
+ $must_be_quoted++;
+ }
+ if($value =~ /$re_sp/){
+ $must_be_quoted++;
+ }
+
+ if( $binary and $ctx->{escape_null} ){
+ use bytes;
+ $must_be_quoted++ if ( $value =~ s/\0/${esc}0/g || ($ctx->{quote_binary} && $value =~ /[\x00-\x1f\x7f-\xa0]/) );
+ }
+ }
+
+ if($ctx->{always_quote} or $must_be_quoted or ($check_meta && $self->is_quoted($i))){
+ $value = $quot . $value . $quot;
+ }
+ push @results, $value;
+ }
+
+ $$dst = join($sep, @results) . ( defined $ctx->{eol} ? $ctx->{eol} : '' );
+
+ return 1;
+}
+
+sub print {
+ my ($self, $io, $fields) = @_;
+
+ require IO::Handle;
+
+ if (!defined $fields) {
+ $fields = [];
+ } elsif(ref($fields) ne 'ARRAY'){
+ Carp::croak("Expected fields to be an array ref");
+ }
+
+ $self->_hook(before_print => $fields);
+
+ my $str = "";
+ $self->__combine(\$str, $fields, 1) or return '';
+
+ local $\ = '';
+
+ $io->print( $str ) or $self->_set_error_diag(2200);
+}
+
+################################################################################
+# methods for parse
+################################################################################
+
+
+sub __parse { # cx_xsParse
+ my ($self, $fields, $fflags, $src, $useIO) = @_;
+
+ my $ctx = $self->_setup_ctx;
+ my $state = $self->___parse($ctx, $fields, $fflags, $src, $useIO);
+ if ($state and ($ctx->{has_hooks} || 0) & HOOK_AFTER_PARSE) {
+ $self->_hook(after_parse => $fields);
+ }
+ return $state || !$last_error;
+}
+
+sub ___parse { # cx_c_xsParse
+ my ($self, $ctx, $fields, $fflags, $src, $useIO) = @_;
+
+ local $/ = $ctx->{eol} if $ctx->{eolx} or $ctx->{eol_is_cr};
+
+ if ($ctx->{useIO} = $useIO) {
+ require IO::Handle;
+
+ $ctx->{tmp} = undef;
+ if ($ctx->{has_ahead} and defined $self->{_AHEAD}) {
+ $ctx->{tmp} = $self->{_AHEAD};
+ $ctx->{size} = length $ctx->{tmp};
+ $ctx->{used} = 0;
+ }
+ } else {
+ $ctx->{tmp} = $src;
+ $ctx->{size} = length $src;
+ $ctx->{used} = 0;
+ $ctx->{utf8} = utf8::is_utf8($src);
+ }
+ if ($ctx->{has_error_input}) {
+ $self->{_ERROR_INPUT} = undef;
+ $ctx->{has_error_input} = 0;
+ }
+
+ my $result = $self->____parse($ctx, $src, $fields, $fflags);
+ $self->{_RECNO} = ++($ctx->{recno});
+ $self->{_EOF} = '';
+
+ if ($ctx->{strict}) {
+ $ctx->{strict_n} ||= $ctx->{fld_idx};
+ if ($ctx->{strict_n} != $ctx->{fld_idx}) {
+ $self->__parse_error($ctx, 2014, $ctx->{used});
+ return;
+ }
+ }
+
+ if ($ctx->{useIO}) {
+ if (defined $ctx->{tmp} and $ctx->{used} < $ctx->{size} and $ctx->{has_ahead}) {
+ $self->{_AHEAD} = substr($ctx->{tmp}, $ctx->{used}, $ctx->{size} - $ctx->{used});
+ } else {
+ $ctx->{has_ahead} = 0;
+ if ($ctx->{useIO} & useIO_EOF) {
+ $self->{_EOF} = 1;
+ }
+ }
+
+ if ($fflags) {
+ if ($ctx->{keep_meta_info}) {
+ $self->{_FFLAGS} = $fflags;
+ } else {
+ undef $fflags;
+ }
+ }
+ }
+
+ if ($result and $ctx->{types}) {
+ my $len = @$fields;
+ for(my $i = 0; $i <= $len && $i <= $ctx->{types_len}; $i++) {
+ my $value = $fields->[$i];
+ next unless defined $value;
+ my $type = ord(substr($ctx->{types}, $i, 1));
+ if ($type == IV) {
+ $fields->[$i] = int($value);
+ } elsif ($type == NV) {
+ $fields->[$i] = $value + 0.0;
+ }
+ }
+ }
+
+ $result;
+}
+
+sub ____parse { # cx_Parse
+ my ($self, $ctx, $src, $fields, $fflags) = @_;
+
+ my ($quot, $sep, $esc, $eol) = @{$ctx}{qw/quo sep escape_char eol/};
+
+ utf8::encode($sep) if !$ctx->{utf8} and $ctx->{sep_len};
+ utf8::encode($quot) if !$ctx->{utf8} and $ctx->{quo_len};
+ utf8::encode($eol) if !$ctx->{utf8} and $ctx->{eol_len};
+
+ my $seenSomething = 0;
+ my $waitingForField = 1;
+ my ($value, $v_ref);
+ $ctx->{fld_idx} = my $fnum = 0;
+ $ctx->{flag} = 0;
+
+ my $re_str = join '|', map({$_ eq "\0" ? '[\\0]' : quotemeta($_)} sort {length $b <=> length $a} grep {defined $_ and $_ ne ''} $sep, $quot, $esc, $eol), "\015", "\012", "\x09", " ";
+ $ctx->{_re} = qr/$re_str/;
+ my $re = qr/$re_str|[^\x09\x20-\x7E]|$/;
+
+LOOP:
+ while($self->__get_from_src($ctx, $src)) {
+ while($ctx->{tmp} =~ /\G(.*?)($re)/gs) {
+ my ($hit, $c) = ($1, $2);
+ $ctx->{used} = pos($ctx->{tmp});
+ if (!$waitingForField and $c eq '' and $hit ne '' and $ctx->{useIO} and !($ctx->{useIO} & useIO_EOF)) {
+ $self->{_AHEAD} = $hit;
+ $ctx->{has_ahead} = 1;
+ $ctx->{has_leftover} = 1;
+ last;
+ }
+ last if $seenSomething and $hit eq '' and $c eq ''; # EOF
+
+ # new field
+ if (!$v_ref) {
+ if ($ctx->{is_bound}) {
+ $v_ref = $self->__bound_field($ctx, $fnum++, 0);
+ } else {
+ $value = '';
+ $v_ref = \$value;
+ }
+ return unless $v_ref;
+ $ctx->{flag} = 0;
+ $ctx->{fld_idx}++;
+ }
+
+ $seenSomething = 1;
+
+ if (defined $hit and $hit ne '') {
+ if ($waitingForField) {
+ $waitingForField = 0;
+ }
+ if ($hit =~ /[^\x09\x20-\x7E]/) {
+ $ctx->{flag} |= IS_BINARY;
+ }
+ $$v_ref .= $hit;
+ }
+
+RESTART:
+ if (defined $c and defined $sep and $c eq $sep) {
+ if ($waitingForField) {
+ # ,1,"foo, 3",,bar,
+ # ^ ^
+ if ($ctx->{blank_is_undef} or $ctx->{empty_is_undef}) {
+ $$v_ref = undef;
+ } else {
+ $$v_ref = "";
+ }
+ unless ($ctx->{is_bound}) {
+ push @$fields, $$v_ref;
+ }
+ $v_ref = undef;
+ if ($ctx->{keep_meta_info} and $fflags) {
+ push @$fflags, $ctx->{flag};
+ }
+ } elsif ($ctx->{flag} & IS_QUOTED) {
+ # ,1,"foo, 3",,bar,
+ # ^
+ $$v_ref .= $c;
+ } else {
+ # ,1,"foo, 3",,bar,
+ # ^ ^ ^
+ $self->__push_value($ctx, $v_ref, $fields, $fflags, $ctx->{flag});
+ $v_ref = undef;
+ $waitingForField = 1;
+ }
+ }
+ elsif (defined $c and defined $quot and $quot ne "\0" and $c eq $quot) {
+ if ($waitingForField) {
+ # ,1,"foo, 3",,bar,\r\n
+ # ^
+ $ctx->{flag} |= IS_QUOTED;
+ $waitingForField = 0;
+ next;
+ }
+ if ($ctx->{flag} & IS_QUOTED) {
+ # ,1,"foo, 3",,bar,\r\n
+ # ^
+ my $quoesc = 0;
+ my $c2 = $self->__get($ctx);
+
+ if ($ctx->{allow_whitespace}) {
+ # , 1 , "foo, 3" , , bar , \r\n
+ # ^
+ while($self->__is_whitespace($ctx, $c2)) {
+ if ($ctx->{allow_loose_quotes} and !(defined $esc and $c2 eq $esc)) {
+ $$v_ref .= $c;
+ $c = $c2;
+ }
+ $c2 = $self->__get($ctx);
+ }
+ }
+
+ if (!defined $c2) { # EOF
+ # ,1,"foo, 3"
+ # ^
+ $self->__push_value($ctx, $v_ref, $fields, $fflags, $ctx->{flag});
+ return 1;
+ }
+
+ if (defined $c2 and defined $sep and $c2 eq $sep) {
+ # ,1,"foo, 3",,bar,\r\n
+ # ^
+ $self->__push_value($ctx, $v_ref, $fields, $fflags, $ctx->{flag});
+ $v_ref = undef;
+ $waitingForField = 1;
+ next;
+ }
+ if (defined $c2 and ($c2 eq "\012" or (defined $eol and $c2 eq $eol))) { # FIXME: EOLX
+ # ,1,"foo, 3",,"bar"\n
+ # ^
+ $self->__push_value($ctx, $v_ref, $fields, $fflags, $ctx->{flag});
+ return 1;
+ }
+
+ if (defined $esc and $c eq $esc) {
+ $quoesc = 1;
+ if (defined $c2 and $c2 eq '0') {
+ # ,1,"foo, 3"056",,bar,\r\n
+ # ^
+ $$v_ref .= "\0";
+ next;
+ }
+ if (defined $c2 and defined $quot and $c2 eq $quot) {
+ # ,1,"foo, 3""56",,bar,\r\n
+ # ^
+ if ($ctx->{utf8}) {
+ $ctx->{flag} |= IS_BINARY;
+ }
+ $$v_ref .= $c2;
+ next;
+ }
+ if ($ctx->{allow_loose_escapes} and defined $c2 and $c2 ne "\015") {
+ # ,1,"foo, 3"56",,bar,\r\n
+ # ^
+ $$v_ref .= $c;
+ $c = $c2;
+ goto RESTART;
+ }
+ }
+ if (defined $c2 and $c2 eq "\015") {
+ if ($ctx->{eol_is_cr}) {
+ # ,1,"foo, 3"\r
+ # ^
+ $self->__push_value($ctx, $v_ref, $fields, $fflags, $ctx->{flag});
+ return 1;
+ }
+
+ my $c3 = $self->__get($ctx);
+ if (defined $c3 and $c3 eq "\012") {
+ # ,1,"foo, 3"\r\n
+ # ^
+ $self->__push_value($ctx, $v_ref, $fields, $fflags, $ctx->{flag});
+ return 1;
+ }
+
+ if ($ctx->{useIO} and !$ctx->{eol_len} and $c3 !~ /[^\x09\x20-\x7E]/) {
+ # ,1,"foo\n 3",,"bar"\r
+ # baz,4
+ # ^
+ $self->__set_eol_is_cr($ctx);
+ $ctx->{used}--;
+ $ctx->{has_ahead} = 1;
+ $self->__push_value($ctx, $v_ref, $fields, $fflags, $ctx->{flag});
+ return 1;
+ }
+
+ $self->__parse_error($ctx, $quoesc ? 2023 : 2010, $ctx->{used} - 2);
+ return;
+ }
+
+ if ($ctx->{allow_loose_quotes} and !$quoesc) {
+ # ,1,"foo, 3"456",,bar,\r\n
+ # ^
+ $$v_ref .= $c;
+ $c = $c2;
+ goto RESTART;
+ }
+ # 1,"foo" ",3
+ # ^
+ if ($quoesc) {
+ $ctx->{used}--;
+ $self->__error_inside_quotes($ctx, 2023);
+ return;
+ }
+ $self->__error_inside_quotes($ctx, 2011);
+ return;
+ }
+ # !waitingForField, !InsideQuotes
+ if ($ctx->{allow_loose_quotes}) { # 1,foo "boo" d'uh,1
+ $ctx->{flag} |= IS_ERROR;
+ $$v_ref .= $c;
+ } else {
+ $self->__error_inside_field($ctx, 2034);
+ return;
+ }
+ }
+ elsif (defined $c and defined $esc and $esc ne "\0" and $c eq $esc) {
+ # This means quote_char != escape_char
+ if ($waitingForField) {
+ $waitingForField = 0;
+ if ($ctx->{allow_unquoted_escape}) {
+ # The escape character is the first character of an
+ # unquoted field
+ # ... get and store next character
+ my $c2 = $self->__get($ctx);
+ $$v_ref = "";
+
+ if (!defined $c2) { # EOF
+ $ctx->{used}--;
+ $self->__error_inside_field($ctx, 2035);
+ return;
+ }
+ if ($c2 eq '0') {
+ $$v_ref .= "\0";
+ }
+ elsif (
+ (defined $quot and $c2 eq $quot) or
+ (defined $sep and $c2 eq $sep) or
+ (defined $esc and $c2 eq $esc) or
+ $ctx->{allow_loose_escapes}
+ ) {
+ if ($ctx->{utf8}) {
+ $ctx->{flag} |= IS_BINARY;
+ }
+ $$v_ref .= $c2;
+ } else {
+ $self->__parse_inside_quotes($ctx, 2025);
+ return;
+ }
+ }
+ }
+ elsif ($ctx->{flag} & IS_QUOTED) {
+ my $c2 = $self->__get($ctx);
+ if (!defined $c2) { # EOF
+ $ctx->{used}--;
+ $self->__error_inside_quotes($ctx, 2024);
+ return;
+ }
+ if ($c2 eq '0') {
+ $$v_ref .= "\0";
+ }
+ elsif (
+ (defined $quot and $c2 eq $quot) or
+ (defined $sep and $c2 eq $sep) or
+ (defined $esc and $c2 eq $esc) or
+ $ctx->{allow_loose_escapes}
+ ) {
+ if ($ctx->{utf8}) {
+ $ctx->{flag} |= IS_BINARY;
+ }
+ $$v_ref .= $c2;
+ } else {
+ $ctx->{used}--;
+ $self->__error_inside_quotes($ctx, 2025);
+ return;
+ }
+ }
+ elsif ($v_ref) {
+ my $c2 = $self->__get($ctx);
+ if (!defined $c2) { # EOF
+ $ctx->{used}--;
+ $self->__error_inside_field($ctx, 2035);
+ return;
+ }
+ $$v_ref .= $c2;
+ }
+ else {
+ $self->__error_inside_field($ctx, 2036);
+ return;
+ }
+ }
+ elsif (defined $c and ($c eq "\012" or $c eq '' or (defined $eol and $c eq $eol and $eol ne "\015"))) { # EOL
+ EOLX:
+ if ($waitingForField) {
+ # ,1,"foo, 3",,bar,
+ # ^
+ if ($ctx->{blank_is_undef} or $ctx->{empty_is_undef}) {
+ $$v_ref = undef;
+ } else {
+ $$v_ref = "";
+ }
+ unless ($ctx->{is_bound}) {
+ push @$fields, $$v_ref;
+ }
+ if ($ctx->{keep_meta_info} and $fflags) {
+ push @$fflags, $ctx->{flag};
+ }
+ return 1;
+ }
+ if ($ctx->{flag} & IS_QUOTED) {
+ # ,1,"foo\n 3",,bar,
+ # ^
+ $ctx->{flag} |= IS_BINARY;
+ unless ($ctx->{binary}) {
+ $self->__error_inside_quotes($ctx, 2021);
+ return;
+ }
+ $$v_ref .= $c;
+ }
+ elsif ($ctx->{verbatim}) {
+ # ,1,foo\n 3,,bar,
+ # This feature should be deprecated
+ $ctx->{flag} |= IS_BINARY;
+ unless ($ctx->{binary}) {
+ $self->__error_inside_field($ctx, 2030);
+ return;
+ }
+ $$v_ref .= $c unless $ctx->{eol} eq $c and $ctx->{useIO};
+ }
+ else {
+ # sep=,
+ # ^
+ if (!$ctx->{recno} and $ctx->{fld_idx} == 1 and $ctx->{useIO} and $hit =~ /^sep=(.{1,16})$/i) {
+ $ctx->{sep} = $1;
+ use bytes;
+ my $len = length $ctx->{sep};
+ if ($len <= 16) {
+ $ctx->{sep_len} = $len == 1 ? 0 : $len;
+ return $self->____parse($ctx, $src, $fields, $fflags);
+ }
+ }
+
+ # ,1,"foo\n 3",,bar
+ # ^
+ $self->__push_value($ctx, $v_ref, $fields, $fflags, $ctx->{flag});
+ return 1;
+ }
+ }
+ elsif (defined $c and $c eq "\015" and !$ctx->{verbatim}) {
+ if ($waitingForField) {
+ $waitingForField = 0;
+ if ($ctx->{eol_is_cr}) {
+ # ,1,"foo\n 3",,bar,\r
+ # ^
+ $c = "\012";
+ goto RESTART;
+ }
+
+ my $c2 = $self->__get($ctx);
+ if (!defined $c2) { # EOF
+ # ,1,"foo\n 3",,bar,\r
+ # ^
+ $c = undef;
+ goto RESTART;
+ }
+ if ($c2 eq "\012") { # \r is not optional before EOLX!
+ # ,1,"foo\n 3",,bar,\r\n
+ # ^
+ $c = $c2;
+ goto RESTART;
+ }
+
+ if ($ctx->{useIO} and !$ctx->{eol_len} and $c2 !~ /[^\x09\x20-\x7E]/) {
+ # ,1,"foo\n 3",,bar,\r
+ # baz,4
+ # ^
+ $self->__set_eol_is_cr($ctx);
+ $ctx->{used}--;
+ $ctx->{has_ahead} = 1;
+ $self->__push_value($ctx, $v_ref, $fields, $fflags, $ctx->{flag});
+ return 1;
+ }
+
+ # ,1,"foo\n 3",,bar,\r\t
+ # ^
+ $ctx->{used}--;
+ $self->__error_inside_field($ctx, 2031);
+ return;
+ }
+ if ($ctx->{flag} & IS_QUOTED) {
+ # ,1,"foo\r 3",,bar,\r\t
+ # ^
+ $ctx->{flag} |= IS_BINARY;
+ unless ($ctx->{binary}) {
+ $self->__error_inside_quotes($ctx, 2022);
+ return;
+ }
+ $$v_ref .= $c;
+ }
+ else {
+ if ($ctx->{eol_is_cr}) {
+ # ,1,"foo\n 3",,bar\r
+ # ^
+ $self->__push_value($ctx, $v_ref, $fields, $fflags, $ctx->{flag});
+ return 1;
+ }
+
+ my $c2 = $self->__get($ctx);
+ if (defined $c2 and $c2 eq "\012") { # \r is not optional before EOLX!
+ # ,1,"foo\n 3",,bar\r\n
+ # ^
+ $self->__push_value($ctx, $v_ref, $fields, $fflags, $ctx->{flag});
+ return 1;
+ }
+
+ if ($ctx->{useIO} and !$ctx->{eol_len} and $c2 !~ /[^\x09\x20-\x7E]/) {
+ # ,1,"foo\n 3",,bar\r
+ # baz,4
+ # ^
+ $self->__set_eol_is_cr($ctx);
+ $ctx->{used}--;
+ $ctx->{has_ahead} = 1;
+ $self->__push_value($ctx, $v_ref, $fields, $fflags, $ctx->{flag});
+ return 1;
+ }
+
+ # ,1,"foo\n 3",,bar\r\t
+ # ^
+ $self->__error_inside_field($ctx, 2032);
+ return;
+ }
+ }
+ else {
+ if ($ctx->{eolx} and $c eq $eol) {
+ $c = '';
+ goto EOLX;
+ }
+
+ if ($waitingForField) {
+ if ($ctx->{allow_whitespace} and $self->__is_whitespace($ctx, $c)) {
+ do {
+ $c = $self->__get($ctx);
+ last if !defined $c;
+ } while $self->__is_whitespace($ctx, $c);
+ goto RESTART;
+ }
+ $waitingForField = 0;
+ goto RESTART;
+ }
+ if ($ctx->{flag} & IS_QUOTED) {
+ if (!defined $c or $c =~ /[^\x09\x20-\x7E]/) {
+ $ctx->{flag} |= IS_BINARY;
+ unless ($ctx->{binary} or $ctx->{utf8}) {
+ $self->__error_inside_quotes($ctx, 2026);
+ return;
+ }
+ }
+ $$v_ref .= $c;
+ } else {
+ if (!defined $c or $c =~ /[^\x09\x20-\x7E]/) {
+ $ctx->{flag} |= IS_BINARY;
+ unless ($ctx->{binary} or $ctx->{utf8}) {
+ $self->__error_inside_field($ctx, 2037);
+ return;
+ }
+ }
+ $$v_ref .= $c;
+ }
+ }
+ last LOOP if $ctx->{useIO} and $ctx->{verbatim} and $ctx->{used} == $ctx->{size};
+ }
+ }
+
+ if ($waitingForField) {
+ if ($seenSomething or !$ctx->{useIO}) {
+ # new field
+ if (!$v_ref) {
+ if ($ctx->{is_bound}) {
+ $v_ref = $self->__bound_field($ctx, $fnum++, 0);
+ } else {
+ $value = '';
+ $v_ref = \$value;
+ }
+ return unless $v_ref;
+ $ctx->{flag} = 0;
+ $ctx->{fld_idx}++;
+ }
+ if ($ctx->{blank_is_undef} or $ctx->{empty_is_undef}) {
+ $$v_ref = undef;
+ } else {
+ $$v_ref = "";
+ }
+ unless ($ctx->{is_bound}) {
+ push @$fields, $$v_ref;
+ }
+ if ($ctx->{keep_meta_info} and $fflags) {
+ push @$fflags, $ctx->{flag};
+ }
+ return 1;
+ }
+ $self->SetDiag(2012);
+ return;
+ }
+
+ if ($ctx->{flag} & IS_QUOTED) {
+ $self->__error_inside_quotes($ctx, 2027);
+ return;
+ }
+
+ if ($v_ref) {
+ $self->__push_value($ctx, $v_ref, $fields, $fflags, $ctx->{flag});
+ }
+ return 1;
+}
+
+sub __get_from_src {
+ my ($self, $ctx, $src) = @_;
+ return 1 if defined $ctx->{tmp} and $ctx->{used} <= 0;
+ return 1 if $ctx->{used} < $ctx->{size};
+ return unless $ctx->{useIO};
+ my $res = $src->getline;
+ if (defined $res) {
+ if ($ctx->{has_ahead}) {
+ $ctx->{tmp} = $self->{_AHEAD};
+ $ctx->{tmp} .= $ctx->{eol} if $ctx->{eol_len};
+ $ctx->{tmp} .= $res;
+ $ctx->{has_ahead} = 0;
+ } else {
+ $ctx->{tmp} = $res;
+ }
+ if ($ctx->{size} = length $ctx->{tmp}) {
+ $ctx->{used} = -1;
+ $ctx->{utf8} = 1 if utf8::is_utf8($ctx->{tmp});
+ pos($ctx->{tmp}) = 0;
+ return 1;
+ }
+ } elsif (delete $ctx->{has_leftover}) {
+ $ctx->{tmp} = $self->{_AHEAD};
+ $ctx->{has_ahead} = 0;
+ $ctx->{useIO} |= useIO_EOF;
+ if ($ctx->{size} = length $ctx->{tmp}) {
+ $ctx->{used} = -1;
+ $ctx->{utf8} = 1 if utf8::is_utf8($ctx->{tmp});
+ pos($ctx->{tmp}) = 0;
+ return 1;
+ }
+ }
+ $ctx->{tmp} = '' unless defined $ctx->{tmp};
+ $ctx->{useIO} |= useIO_EOF;
+ return;
+}
+
+sub __set_eol_is_cr {
+ my ($self, $ctx) = @_;
+ $ctx->{eol} = "\015";
+ $ctx->{eol_is_cr} = 1;
+ $ctx->{eol_len} = 1;
+
+ $self->{eol} = $ctx->{eol};
+}
+
+sub __bound_field {
+ my ($self, $ctx, $i, $keep) = @_;
+ if ($i >= $ctx->{is_bound}) {
+ $self->SetDiag(3006);
+ return;
+ }
+ if (ref $ctx->{bound} eq 'ARRAY') {
+ my $ref = $ctx->{bound}[$i];
+ if (ref $ref) {
+ if ($keep) {
+ return $ref;
+ }
+ unless (Scalar::Util::readonly($$ref)) {
+ $$ref = "";
+ return $ref;
+ }
+ }
+ }
+ $self->SetDiag(3008);
+ return;
+}
+
+sub __get {
+ my ($self, $ctx) = @_;
+ return unless defined $ctx->{used};
+ return if $ctx->{used} >= $ctx->{size};
+ my $pos = pos($ctx->{tmp});
+ if ($ctx->{tmp} =~ /\G($ctx->{_re}|.)/gs) {
+ my $c = $1;
+ if ($c =~ /[^\x09\x20-\x7e]/) {
+ $ctx->{flag} |= IS_BINARY;
+ }
+ $ctx->{used} = pos($ctx->{tmp});
+ return $c;
+ } else {
+ pos($ctx->{tmp}) = $pos;
+ return;
+ }
+}
+
+sub __error_inside_quotes {
+ my ($self, $ctx, $error) = @_;
+ $self->__parse_error($ctx, $error, $ctx->{used} - 1);
+}
+
+sub __error_inside_field {
+ my ($self, $ctx, $error) = @_;
+ $self->__parse_error($ctx, $error, $ctx->{used} - 1);
+}
+
+sub __parse_error {
+ my ($self, $ctx, $error, $pos) = @_;
+ $self->{_ERROR_POS} = $pos;
+ $self->{_ERROR_FLD} = $ctx->{fld_idx};
+ $self->{_ERROR_INPUT} = $ctx->{tmp} if $ctx->{tmp};
+ $self->SetDiag($error);
+ return;
+}
+
+sub __is_whitespace {
+ my ($self, $ctx, $c) = @_;
+ return unless defined $c;
+ return (
+ (!defined $ctx->{sep} or $c ne $ctx->{sep}) &&
+ (!defined $ctx->{quo} or $c ne $ctx->{quo}) &&
+ (!defined $ctx->{escape_char} or $c ne $ctx->{escape_char}) &&
+ ($c eq " " or $c eq "\t")
+ );
+}
+
+sub __push_value { # AV_PUSH (part of)
+ my ($self, $ctx, $v_ref, $fields, $fflags, $flag) = @_;
+ utf8::encode($$v_ref) if $ctx->{utf8};
+ if (
+ (!defined $$v_ref or $$v_ref eq '') and
+ ($ctx->{empty_is_undef} or (!($flag & IS_QUOTED) and $ctx->{blank_is_undef}))
+ ) {
+ $$v_ref = undef;
+ } else {
+ if ($ctx->{allow_whitespace} && !($flag & IS_QUOTED)) {
+ $$v_ref =~ s/[ \t]+$//;
+ }
+ if ($flag & IS_BINARY and $ctx->{decode_utf8} and ($ctx->{utf8} || _is_valid_utf8($$v_ref))) {
+ utf8::decode($$v_ref);
+ }
+ }
+ unless ($ctx->{is_bound}) {
+ push @$fields, $$v_ref;
+ }
+ if ($ctx->{keep_meta_info} and $fflags) {
+ push @$fflags, $flag;
+ }
+}
+
+sub getline {
+ my ($self, $io) = @_;
+
+ my (@fields, @fflags);
+ my $res = $self->__parse(\@fields, \@fflags, $io, 1);
+ $res ? \@fields : undef;
+}
+
+sub getline_all {
+ my ( $self, $io, $offset, $len ) = @_;
+
+ my $ctx = $self->_setup_ctx;
+
+ my $tail = 0;
+ my $n = 0;
+ $offset ||= 0;
+
+ if ( $offset < 0 ) {
+ $tail = -$offset;
+ $offset = -1;
+ }
+
+ my (@row, @list);
+ while ($self->___parse($ctx, \@row, undef, $io, 1)) {
+ $ctx = $self->_setup_ctx;
+
+ if ($offset > 0) {
+ $offset--;
+ @row = ();
+ next;
+ }
+ if ($n++ >= $tail and $tail) {
+ shift @list;
+ $n--;
+ }
+ if (($ctx->{has_hooks} || 0) & HOOK_AFTER_PARSE) {
+ unless ($self->_hook(after_parse => \@row)) {
+ @row = ();
+ next;
+ }
+ }
+ push @list, [@row];
+ @row = ();
+
+ last if defined $len && $n >= $len and $offset >= 0; # exceeds limit size
+ }
+
+ if ( defined $len && $n > $len ) {
+ @list = splice( @list, 0, $len);
+ }
+
+ return \@list;
+}
+
+sub _is_valid_utf8 {
+ return ( $_[0] =~ /^(?:
+ [\x00-\x7F]
+ |[\xC2-\xDF][\x80-\xBF]
+ |[\xE0][\xA0-\xBF][\x80-\xBF]
+ |[\xE1-\xEC][\x80-\xBF][\x80-\xBF]
+ |[\xED][\x80-\x9F][\x80-\xBF]
+ |[\xEE-\xEF][\x80-\xBF][\x80-\xBF]
+ |[\xF0][\x90-\xBF][\x80-\xBF][\x80-\xBF]
+ |[\xF1-\xF3][\x80-\xBF][\x80-\xBF][\x80-\xBF]
+ |[\xF4][\x80-\x8F][\x80-\xBF][\x80-\xBF]
+ )+$/x ) ? 1 : 0;
+}
+
+################################################################################
+# methods for errors
+################################################################################
+
+sub _set_error_diag {
+ my ( $self, $error, $pos ) = @_;
+
+ $self->SetDiag($error);
+
+ if (defined $pos) {
+ $_[0]->{_ERROR_POS} = $pos;
+ }
+
+ return;
+}
+
+sub error_input {
+ my $self = shift;
+ if ($self and ((Scalar::Util::reftype($self) || '') eq 'HASH' or (ref $self) =~ /^Text::CSV/)) {
+ return $self->{_ERROR_INPUT};
+ }
+ return;
+}
+
+sub _sv_diag {
+ my ($self, $error) = @_;
+ bless [$error, $ERRORS->{$error}], 'Text::CSV::ErrorDiag';
+}
+
+sub _set_diag {
+ my ($self, $ctx, $error) = @_;
+
+ $last_error = $self->_sv_diag($error);
+ $self->{_ERROR_DIAG} = $last_error;
+ if ($error == 0) {
+ $self->{_ERROR_POS} = 0;
+ $self->{_ERROR_FLD} = 0;
+ $self->{_ERROR_INPUT} = undef;
+ $ctx->{has_error_input} = 0;
+ }
+ if ($error == 2012) { # EOF
+ $self->{_EOF} = 1;
+ }
+ if ($ctx->{auto_diag}) {
+ $self->error_diag;
+ }
+ return $last_error;
+}
+
+sub SetDiag {
+ my ($self, $error, $errstr) = @_;
+ my $res;
+ if (ref $self) {
+ my $ctx = $self->_setup_ctx;
+ $res = $self->_set_diag($ctx, $error);
+
+ } else {
+ $res = $self->_sv_diag($error);
+ }
+ if (defined $errstr) {
+ $res->[1] = $errstr;
+ }
+ $res;
+}
+
+################################################################################
+package Text::CSV::ErrorDiag;
+
+use strict;
+use overload (
+ '""' => \&stringify,
+ '+' => \&numeric,
+ '-' => \&numeric,
+ '*' => \&numeric,
+ '/' => \&numeric,
+ fallback => 1,
+);
+
+
+sub numeric {
+ my ($left, $right) = @_;
+ return ref $left ? $left->[0] : $right->[0];
+}
+
+
+sub stringify {
+ $_[0]->[1];
+}
+################################################################################
+1;
+__END__
+
+=head1 NAME
+
+Text::CSV_PP - Text::CSV_XS compatible pure-Perl module
+
+
+=head1 SYNOPSIS
+
+ use Text::CSV_PP;
+
+ $csv = Text::CSV_PP->new(); # create a new object
+ # If you want to handle non-ascii char.
+ $csv = Text::CSV_PP->new({binary => 1});
+
+ $status = $csv->combine(@columns); # combine columns into a string
+ $line = $csv->string(); # get the combined string
+
+ $status = $csv->parse($line); # parse a CSV string into fields
+ @columns = $csv->fields(); # get the parsed fields
+
+ $status = $csv->status (); # get the most recent status
+ $bad_argument = $csv->error_input (); # get the most recent bad argument
+ $diag = $csv->error_diag (); # if an error occurred, explains WHY
+
+ $status = $csv->print ($io, $colref); # Write an array of fields
+ # immediately to a file $io
+ $colref = $csv->getline ($io); # Read a line from file $io,
+ # parse it and return an array
+ # ref of fields
+ $csv->column_names (@names); # Set column names for getline_hr ()
+ $ref = $csv->getline_hr ($io); # getline (), but returns a hashref
+ $eof = $csv->eof (); # Indicate if last parse or
+ # getline () hit End Of File
+
+ $csv->types(\@t_array); # Set column types
+
+=head1 DESCRIPTION
+
+Text::CSV_PP is a pure-perl module that provides facilities for the
+composition and decomposition of comma-separated values. This is
+(almost) compatible with much faster L<Text::CSV_XS>, and mainly
+used as its fallback module when you use L<Text::CSV> module without
+having installed Text::CSV_XS. If you don't have any reason to use
+this module directly, use Text::CSV for speed boost and portability
+(or maybe Text::CSV_XS when you write an one-off script and don't need
+to care about portability).
+
+The following caveats are taken from the doc of Text::CSV_XS.
+
+=head2 Embedded newlines
+
+B<Important Note>: The default behavior is to accept only ASCII characters
+in the range from C<0x20> (space) to C<0x7E> (tilde). This means that the
+fields can not contain newlines. If your data contains newlines embedded in
+fields, or characters above C<0x7E> (tilde), or binary data, you B<I<must>>
+set C<< binary => 1 >> in the call to L</new>. To cover the widest range of
+parsing options, you will always want to set binary.
+
+But you still have the problem that you have to pass a correct line to the
+L</parse> method, which is more complicated from the usual point of usage:
+
+ my $csv = Text::CSV_PP->new ({ binary => 1, eol => $/ });
+ while (<>) { # WRONG!
+ $csv->parse ($_);
+ my @fields = $csv->fields ();
+ }
+
+this will break, as the C<while> might read broken lines: it does not care
+about the quoting. If you need to support embedded newlines, the way to go
+is to B<not> pass L<C<eol>|/eol> in the parser (it accepts C<\n>, C<\r>,
+B<and> C<\r\n> by default) and then
+
+ my $csv = Text::CSV_PP->new ({ binary => 1 });
+ open my $io, "<", $file or die "$file: $!";
+ while (my $row = $csv->getline ($io)) {
+ my @fields = @$row;
+ }
+
+The old(er) way of using global file handles is still supported
+
+ while (my $row = $csv->getline (*ARGV)) { ... }
+
+=head2 Unicode
+
+Unicode is only tested to work with perl-5.8.2 and up.
+
+The simplest way to ensure the correct encoding is used for in- and output
+is by either setting layers on the filehandles, or setting the L</encoding>
+argument for L</csv>.
+
+ open my $fh, "<:encoding(UTF-8)", "in.csv" or die "in.csv: $!";
+or
+ my $aoa = csv (in => "in.csv", encoding => "UTF-8");
+
+ open my $fh, ">:encoding(UTF-8)", "out.csv" or die "out.csv: $!";
+or
+ csv (in => $aoa, out => "out.csv", encoding => "UTF-8");
+
+On parsing (both for L</getline> and L</parse>), if the source is marked
+being UTF8, then all fields that are marked binary will also be marked UTF8.
+
+On combining (L</print> and L</combine>): if any of the combining fields
+was marked UTF8, the resulting string will be marked as UTF8. Note however
+that all fields I<before> the first field marked UTF8 and contained 8-bit
+characters that were not upgraded to UTF8, these will be C<bytes> in the
+resulting string too, possibly causing unexpected errors. If you pass data
+of different encoding, or you don't know if there is different encoding,
+force it to be upgraded before you pass them on:
+
+ $csv->print ($fh, [ map { utf8::upgrade (my $x = $_); $x } @data ]);
+
+For complete control over encoding, please use L<Text::CSV::Encoded>:
+
+ use Text::CSV::Encoded;
+ my $csv = Text::CSV::Encoded->new ({
+ encoding_in => "iso-8859-1", # the encoding comes into Perl
+ encoding_out => "cp1252", # the encoding comes out of Perl
+ });
+
+ $csv = Text::CSV::Encoded->new ({ encoding => "utf8" });
+ # combine () and print () accept *literally* utf8 encoded data
+ # parse () and getline () return *literally* utf8 encoded data
+
+ $csv = Text::CSV::Encoded->new ({ encoding => undef }); # default
+ # combine () and print () accept UTF8 marked data
+ # parse () and getline () return UTF8 marked data
+
+=head1 METHODS
+
+This whole section is also taken from Text::CSV_XS.
+
+=head2 version ()
+
+(Class method) Returns the current module version.
+
+=head2 new (\%attr)
+
+(Class method) Returns a new instance of Text::CSV_PP. The attributes
+are described by the (optional) hash ref C<\%attr>.
+
+ my $csv = Text::CSV_PP->new ({ attributes ... });
+
+The following attributes are available:
+
+=head3 eol
+
+ my $csv = Text::CSV_PP->new ({ eol => $/ });
+ $csv->eol (undef);
+ my $eol = $csv->eol;
+
+The end-of-line string to add to rows for L</print> or the record separator
+for L</getline>.
+
+When not passed in a B<parser> instance, the default behavior is to accept
+C<\n>, C<\r>, and C<\r\n>, so it is probably safer to not specify C<eol> at
+all. Passing C<undef> or the empty string behave the same.
+
+When not passed in a B<generating> instance, records are not terminated at
+all, so it is probably wise to pass something you expect. A safe choice for
+C<eol> on output is either C<$/> or C<\r\n>.
+
+Common values for C<eol> are C<"\012"> (C<\n> or Line Feed), C<"\015\012">
+(C<\r\n> or Carriage Return, Line Feed), and C<"\015"> (C<\r> or Carriage
+Return). The L<C<eol>|/eol> attribute cannot exceed 7 (ASCII) characters.
+
+If both C<$/> and L<C<eol>|/eol> equal C<"\015">, parsing lines that end on
+only a Carriage Return without Line Feed, will be L</parse>d correct.
+
+=head3 sep_char
+
+ my $csv = Text::CSV_PP->new ({ sep_char => ";" });
+ $csv->sep_char (";");
+ my $c = $csv->sep_char;
+
+The char used to separate fields, by default a comma. (C<,>). Limited to a
+single-byte character, usually in the range from C<0x20> (space) to C<0x7E>
+(tilde). When longer sequences are required, use L<C<sep>|/sep>.
+
+The separation character can not be equal to the quote character or to the
+escape character.
+
+=head3 sep
+
+ my $csv = Text::CSV_PP->new ({ sep => "\N{FULLWIDTH COMMA}" });
+ $csv->sep (";");
+ my $sep = $csv->sep;
+
+The chars used to separate fields, by default undefined. Limited to 8 bytes.
+
+When set, overrules L<C<sep_char>|/sep_char>. If its length is one byte it
+acts as an alias to L<C<sep_char>|/sep_char>.
+
+=head3 quote_char
+
+ my $csv = Text::CSV_PP->new ({ quote_char => "'" });
+ $csv->quote_char (undef);
+ my $c = $csv->quote_char;
+
+The character to quote fields containing blanks or binary data, by default
+the double quote character (C<">). A value of undef suppresses quote chars
+(for simple cases only). Limited to a single-byte character, usually in the
+range from C<0x20> (space) to C<0x7E> (tilde). When longer sequences are
+required, use L<C<quote>|/quote>.
+
+C<quote_char> can not be equal to L<C<sep_char>|/sep_char>.
+
+=head3 quote
+
+ my $csv = Text::CSV_PP->new ({ quote => "\N{FULLWIDTH QUOTATION MARK}" });
+ $csv->quote ("'");
+ my $quote = $csv->quote;
+
+The chars used to quote fields, by default undefined. Limited to 8 bytes.
+
+When set, overrules L<C<quote_char>|/quote_char>. If its length is one byte
+it acts as an alias to L<C<quote_char>|/quote_char>.
+
+=head3 escape_char
+
+ my $csv = Text::CSV_PP->new ({ escape_char => "\\" });
+ $csv->escape_char (undef);
+ my $c = $csv->escape_char;
+
+The character to escape certain characters inside quoted fields. This is
+limited to a single-byte character, usually in the range from C<0x20>
+(space) to C<0x7E> (tilde).
+
+The C<escape_char> defaults to being the double-quote mark (C<">). In other
+words the same as the default L<C<quote_char>|/quote_char>. This means that
+doubling the quote mark in a field escapes it:
+
+ "foo","bar","Escape ""quote mark"" with two ""quote marks""","baz"
+
+If you change the L<C<quote_char>|/quote_char> without changing the
+C<escape_char>, the C<escape_char> will still be the double-quote (C<">).
+If instead you want to escape the L<C<quote_char>|/quote_char> by doubling
+it you will need to also change the C<escape_char> to be the same as what
+you have changed the L<C<quote_char>|/quote_char> to.
+
+The escape character can not be equal to the separation character.
+
+=head3 binary
+
+ my $csv = Text::CSV_PP->new ({ binary => 1 });
+ $csv->binary (0);
+ my $f = $csv->binary;
+
+If this attribute is C<1>, you may use binary characters in quoted fields,
+including line feeds, carriage returns and C<NULL> bytes. (The latter could
+be escaped as C<"0>.) By default this feature is off.
+
+If a string is marked UTF8, C<binary> will be turned on automatically when
+binary characters other than C<CR> and C<NL> are encountered. Note that a
+simple string like C<"\x{00a0}"> might still be binary, but not marked UTF8,
+so setting C<< { binary => 1 } >> is still a wise option.
+
+=head3 strict
+
+ my $csv = Text::CSV_PP->new ({ strict => 1 });
+ $csv->strict (0);
+ my $f = $csv->strict;
+
+If this attribute is set to C<1>, any row that parses to a different number
+of fields than the previous row will cause the parser to throw error 2014.
+
+=head3 decode_utf8
+
+ my $csv = Text::CSV_PP->new ({ decode_utf8 => 1 });
+ $csv->decode_utf8 (0);
+ my $f = $csv->decode_utf8;
+
+This attributes defaults to TRUE.
+
+While I<parsing>, fields that are valid UTF-8, are automatically set to be
+UTF-8, so that
+
+ $csv->parse ("\xC4\xA8\n");
+
+results in
+
+ PV("\304\250"\0) [UTF8 "\x{128}"]
+
+Sometimes it might not be a desired action. To prevent those upgrades, set
+this attribute to false, and the result will be
+
+ PV("\304\250"\0)
+
+=head3 auto_diag
+
+ my $csv = Text::CSV_PP->new ({ auto_diag => 1 });
+ $csv->auto_diag (2);
+ my $l = $csv->auto_diag;
+
+Set this attribute to a number between C<1> and C<9> causes L</error_diag>
+to be automatically called in void context upon errors.
+
+In case of error C<2012 - EOF>, this call will be void.
+
+If C<auto_diag> is set to a numeric value greater than C<1>, it will C<die>
+on errors instead of C<warn>. If set to anything unrecognized, it will be
+silently ignored.
+
+Future extensions to this feature will include more reliable auto-detection
+of C<autodie> being active in the scope of which the error occurred which
+will increment the value of C<auto_diag> with C<1> the moment the error is
+detected.
+
+=head3 diag_verbose
+
+ my $csv = Text::CSV_PP->new ({ diag_verbose => 1 });
+ $csv->diag_verbose (2);
+ my $l = $csv->diag_verbose;
+
+Set the verbosity of the output triggered by C<auto_diag>. Currently only
+adds the current input-record-number (if known) to the diagnostic output
+with an indication of the position of the error.
+
+=head3 blank_is_undef
+
+ my $csv = Text::CSV_PP->new ({ blank_is_undef => 1 });
+ $csv->blank_is_undef (0);
+ my $f = $csv->blank_is_undef;
+
+Under normal circumstances, C<CSV> data makes no distinction between quoted-
+and unquoted empty fields. These both end up in an empty string field once
+read, thus
+
+ 1,"",," ",2
+
+is read as
+
+ ("1", "", "", " ", "2")
+
+When I<writing> C<CSV> files with either L<C<always_quote>|/always_quote>
+or L<C<quote_empty>|/quote_empty> set, the unquoted I<empty> field is the
+result of an undefined value. To enable this distinction when I<reading>
+C<CSV> data, the C<blank_is_undef> attribute will cause unquoted empty
+fields to be set to C<undef>, causing the above to be parsed as
+
+ ("1", "", undef, " ", "2")
+
+note that this is specifically important when loading C<CSV> fields into a
+database that allows C<NULL> values, as the perl equivalent for C<NULL> is
+C<undef> in L<DBI> land.
+
+=head3 empty_is_undef
+
+ my $csv = Text::CSV_PP->new ({ empty_is_undef => 1 });
+ $csv->empty_is_undef (0);
+ my $f = $csv->empty_is_undef;
+
+Going one step further than L<C<blank_is_undef>|/blank_is_undef>, this
+attribute converts all empty fields to C<undef>, so
+
+ 1,"",," ",2
+
+is read as
+
+ (1, undef, undef, " ", 2)
+
+Note that this effects only fields that are originally empty, not fields
+that are empty after stripping allowed whitespace. YMMV.
+
+=head3 allow_whitespace
+
+ my $csv = Text::CSV_PP->new ({ allow_whitespace => 1 });
+ $csv->allow_whitespace (0);
+ my $f = $csv->allow_whitespace;
+
+When this option is set to true, the whitespace (C<TAB>'s and C<SPACE>'s)
+surrounding the separation character is removed when parsing. If either
+C<TAB> or C<SPACE> is one of the three characters L<C<sep_char>|/sep_char>,
+L<C<quote_char>|/quote_char>, or L<C<escape_char>|/escape_char> it will not
+be considered whitespace.
+
+Now lines like:
+
+ 1 , "foo" , bar , 3 , zapp
+
+are parsed as valid C<CSV>, even though it violates the C<CSV> specs.
+
+Note that B<all> whitespace is stripped from both start and end of each
+field. That would make it I<more> than a I<feature> to enable parsing bad
+C<CSV> lines, as
+
+ 1, 2.0, 3, ape , monkey
+
+will now be parsed as
+
+ ("1", "2.0", "3", "ape", "monkey")
+
+even if the original line was perfectly acceptable C<CSV>.
+
+=head3 allow_loose_quotes
+
+ my $csv = Text::CSV_PP->new ({ allow_loose_quotes => 1 });
+ $csv->allow_loose_quotes (0);
+ my $f = $csv->allow_loose_quotes;
+
+By default, parsing unquoted fields containing L<C<quote_char>|/quote_char>
+characters like
+
+ 1,foo "bar" baz,42
+
+would result in parse error 2034. Though it is still bad practice to allow
+this format, we cannot help the fact that some vendors make their
+applications spit out lines styled this way.
+
+If there is B<really> bad C<CSV> data, like
+
+ 1,"foo "bar" baz",42
+
+or
+
+ 1,""foo bar baz"",42
+
+there is a way to get this data-line parsed and leave the quotes inside the
+quoted field as-is. This can be achieved by setting C<allow_loose_quotes>
+B<AND> making sure that the L<C<escape_char>|/escape_char> is I<not> equal
+to L<C<quote_char>|/quote_char>.
+
+=head3 allow_loose_escapes
+
+ my $csv = Text::CSV_PP->new ({ allow_loose_escapes => 1 });
+ $csv->allow_loose_escapes (0);
+ my $f = $csv->allow_loose_escapes;
+
+Parsing fields that have L<C<escape_char>|/escape_char> characters that
+escape characters that do not need to be escaped, like:
+
+ my $csv = Text::CSV_PP->new ({ escape_char => "\\" });
+ $csv->parse (qq{1,"my bar\'s",baz,42});
+
+would result in parse error 2025. Though it is bad practice to allow this
+format, this attribute enables you to treat all escape character sequences
+equal.
+
+=head3 allow_unquoted_escape
+
+ my $csv = Text::CSV_PP->new ({ allow_unquoted_escape => 1 });
+ $csv->allow_unquoted_escape (0);
+ my $f = $csv->allow_unquoted_escape;
+
+A backward compatibility issue where L<C<escape_char>|/escape_char> differs
+from L<C<quote_char>|/quote_char> prevents L<C<escape_char>|/escape_char>
+to be in the first position of a field. If L<C<quote_char>|/quote_char> is
+equal to the default C<"> and L<C<escape_char>|/escape_char> is set to C<\>,
+this would be illegal:
+
+ 1,\0,2
+
+Setting this attribute to C<1> might help to overcome issues with backward
+compatibility and allow this style.
+
+=head3 always_quote
+
+ my $csv = Text::CSV_PP->new ({ always_quote => 1 });
+ $csv->always_quote (0);
+ my $f = $csv->always_quote;
+
+By default the generated fields are quoted only if they I<need> to be. For
+example, if they contain the separator character. If you set this attribute
+to C<1> then I<all> defined fields will be quoted. (C<undef> fields are not
+quoted, see L</blank_is_undef>). This makes it quite often easier to handle
+exported data in external applications.
+
+=head3 quote_space
+
+ my $csv = Text::CSV_PP->new ({ quote_space => 1 });
+ $csv->quote_space (0);
+ my $f = $csv->quote_space;
+
+By default, a space in a field would trigger quotation. As no rule exists
+this to be forced in C<CSV>, nor any for the opposite, the default is true
+for safety. You can exclude the space from this trigger by setting this
+attribute to 0.
+
+=head3 quote_empty
+
+ my $csv = Text::CSV_PP->new ({ quote_empty => 1 });
+ $csv->quote_empty (0);
+ my $f = $csv->quote_empty;
+
+By default the generated fields are quoted only if they I<need> to be. An
+empty (defined) field does not need quotation. If you set this attribute to
+C<1> then I<empty> defined fields will be quoted. (C<undef> fields are not
+quoted, see L</blank_is_undef>). See also L<C<always_quote>|/always_quote>.
+
+=head3 quote_binary
+
+ my $csv = Text::CSV_PP->new ({ quote_binary => 1 });
+ $csv->quote_binary (0);
+ my $f = $csv->quote_binary;
+
+By default, all "unsafe" bytes inside a string cause the combined field to
+be quoted. By setting this attribute to C<0>, you can disable that trigger
+for bytes >= C<0x7F>.
+
+=head3 escape_null or quote_null (deprecated)
+
+ my $csv = Text::CSV_PP->new ({ escape_null => 1 });
+ $csv->escape_null (0);
+ my $f = $csv->escape_null;
+
+By default, a C<NULL> byte in a field would be escaped. This option enables
+you to treat the C<NULL> byte as a simple binary character in binary mode
+(the C<< { binary => 1 } >> is set). The default is true. You can prevent
+C<NULL> escapes by setting this attribute to C<0>.
+
+The default when using the C<csv> function is C<false>.
+
+=head3 keep_meta_info
+
+ my $csv = Text::CSV_PP->new ({ keep_meta_info => 1 });
+ $csv->keep_meta_info (0);
+ my $f = $csv->keep_meta_info;
+
+By default, the parsing of input records is as simple and fast as possible.
+However, some parsing information - like quotation of the original field -
+is lost in that process. Setting this flag to true enables retrieving that
+information after parsing with the methods L</meta_info>, L</is_quoted>,
+and L</is_binary> described below. Default is false for performance.
+
+If you set this attribute to a value greater than 9, than you can control
+output quotation style like it was used in the input of the the last parsed
+record (unless quotation was added because of other reasons).
+
+ my $csv = Text::CSV_PP->new ({
+ binary => 1,
+ keep_meta_info => 1,
+ quote_space => 0,
+ });
+
+ my $row = $csv->parse (q{1,,"", ," ",f,"g","h""h",help,"help"});
+
+ $csv->print (*STDOUT, \@row);
+ # 1,,, , ,f,g,"h""h",help,help
+ $csv->keep_meta_info (11);
+ $csv->print (*STDOUT, \@row);
+ # 1,,"", ," ",f,"g","h""h",help,"help"
+
+=head3 verbatim
+
+ my $csv = Text::CSV_PP->new ({ verbatim => 1 });
+ $csv->verbatim (0);
+ my $f = $csv->verbatim;
+
+This is a quite controversial attribute to set, but makes some hard things
+possible.
+
+The rationale behind this attribute is to tell the parser that the normally
+special characters newline (C<NL>) and Carriage Return (C<CR>) will not be
+special when this flag is set, and be dealt with as being ordinary binary
+characters. This will ease working with data with embedded newlines.
+
+When C<verbatim> is used with L</getline>, L</getline> auto-C<chomp>'s
+every line.
+
+Imagine a file format like
+
+ M^^Hans^Janssen^Klas 2\n2A^Ja^11-06-2007#\r\n
+
+where, the line ending is a very specific C<"#\r\n">, and the sep_char is a
+C<^> (caret). None of the fields is quoted, but embedded binary data is
+likely to be present. With the specific line ending, this should not be too
+hard to detect.
+
+By default, Text::CSV_PP' parse function is instructed to only know about
+C<"\n"> and C<"\r"> to be legal line endings, and so has to deal with the
+embedded newline as a real C<end-of-line>, so it can scan the next line if
+binary is true, and the newline is inside a quoted field. With this option,
+we tell L</parse> to parse the line as if C<"\n"> is just nothing more than
+a binary character.
+
+For L</parse> this means that the parser has no more idea about line ending
+and L</getline> C<chomp>s line endings on reading.
+
+=head3 types
+
+A set of column types; the attribute is immediately passed to the L</types>
+method.
+
+=head3 callbacks
+
+See the L</Callbacks> section below.
+
+=head3 accessors
+
+To sum it up,
+
+ $csv = Text::CSV_PP->new ();
+
+is equivalent to
+
+ $csv = Text::CSV_PP->new ({
+ eol => undef, # \r, \n, or \r\n
+ sep_char => ',',
+ sep => undef,
+ quote_char => '"',
+ quote => undef,
+ escape_char => '"',
+ binary => 0,
+ decode_utf8 => 1,
+ auto_diag => 0,
+ diag_verbose => 0,
+ blank_is_undef => 0,
+ empty_is_undef => 0,
+ allow_whitespace => 0,
+ allow_loose_quotes => 0,
+ allow_loose_escapes => 0,
+ allow_unquoted_escape => 0,
+ always_quote => 0,
+ quote_empty => 0,
+ quote_space => 1,
+ escape_null => 1,
+ quote_binary => 1,
+ keep_meta_info => 0,
+ verbatim => 0,
+ types => undef,
+ callbacks => undef,
+ });
+
+For all of the above mentioned flags, an accessor method is available where
+you can inquire the current value, or change the value
+
+ my $quote = $csv->quote_char;
+ $csv->binary (1);
+
+It is not wise to change these settings halfway through writing C<CSV> data
+to a stream. If however you want to create a new stream using the available
+C<CSV> object, there is no harm in changing them.
+
+If the L</new> constructor call fails, it returns C<undef>, and makes the
+fail reason available through the L</error_diag> method.
+
+ $csv = Text::CSV_PP->new ({ ecs_char => 1 }) or
+ die "".Text::CSV_PP->error_diag ();
+
+L</error_diag> will return a string like
+
+ "INI - Unknown attribute 'ecs_char'"
+
+=head2 known_attributes
+
+ @attr = Text::CSV_PP->known_attributes;
+ @attr = Text::CSV_PP::known_attributes;
+ @attr = $csv->known_attributes;
+
+This method will return an ordered list of all the supported attributes as
+described above. This can be useful for knowing what attributes are valid
+in classes that use or extend Text::CSV_PP.
+
+=head2 print
+
+ $status = $csv->print ($io, $colref);
+
+Similar to L</combine> + L</string> + L</print>, but much more efficient.
+It expects an array ref as input (not an array!) and the resulting string
+is not really created, but immediately written to the C<$io> object,
+typically an IO handle or any other object that offers a L</print> method.
+
+For performance reasons C<print> does not create a result string, so all
+L</string>, L</status>, L</fields>, and L</error_input> methods will return
+undefined information after executing this method.
+
+If C<$colref> is C<undef> (explicit, not through a variable argument) and
+L</bind_columns> was used to specify fields to be printed, it is possible
+to make performance improvements, as otherwise data would have to be copied
+as arguments to the method call:
+
+ $csv->bind_columns (\($foo, $bar));
+ $status = $csv->print ($fh, undef);
+
+=head2 say
+
+ $status = $csv->say ($io, $colref);
+
+Like L<C<print>|/print>, but L<C<eol>|/eol> defaults to C<$\>.
+
+=head2 print_hr
+
+ $csv->print_hr ($io, $ref);
+
+Provides an easy way to print a C<$ref> (as fetched with L</getline_hr>)
+provided the column names are set with L</column_names>.
+
+It is just a wrapper method with basic parameter checks over
+
+ $csv->print ($io, [ map { $ref->{$_} } $csv->column_names ]);
+
+=head2 combine
+
+ $status = $csv->combine (@fields);
+
+This method constructs a C<CSV> record from C<@fields>, returning success
+or failure. Failure can result from lack of arguments or an argument that
+contains an invalid character. Upon success, L</string> can be called to
+retrieve the resultant C<CSV> string. Upon failure, the value returned by
+L</string> is undefined and L</error_input> could be called to retrieve the
+invalid argument.
+
+=head2 string
+
+ $line = $csv->string ();
+
+This method returns the input to L</parse> or the resultant C<CSV> string
+of L</combine>, whichever was called more recently.
+
+=head2 getline
+
+ $colref = $csv->getline ($io);
+
+This is the counterpart to L</print>, as L</parse> is the counterpart to
+L</combine>: it parses a row from the C<$io> handle using the L</getline>
+method associated with C<$io> and parses this row into an array ref. This
+array ref is returned by the function or C<undef> for failure. When C<$io>
+does not support C<getline>, you are likely to hit errors.
+
+When fields are bound with L</bind_columns> the return value is a reference
+to an empty list.
+
+The L</string>, L</fields>, and L</status> methods are meaningless again.
+
+=head2 getline_all
+
+ $arrayref = $csv->getline_all ($io);
+ $arrayref = $csv->getline_all ($io, $offset);
+ $arrayref = $csv->getline_all ($io, $offset, $length);
+
+This will return a reference to a list of L<getline ($io)|/getline> results.
+In this call, C<keep_meta_info> is disabled. If C<$offset> is negative, as
+with C<splice>, only the last C<abs ($offset)> records of C<$io> are taken
+into consideration.
+
+Given a CSV file with 10 lines:
+
+ lines call
+ ----- ---------------------------------------------------------
+ 0..9 $csv->getline_all ($io) # all
+ 0..9 $csv->getline_all ($io, 0) # all
+ 8..9 $csv->getline_all ($io, 8) # start at 8
+ - $csv->getline_all ($io, 0, 0) # start at 0 first 0 rows
+ 0..4 $csv->getline_all ($io, 0, 5) # start at 0 first 5 rows
+ 4..5 $csv->getline_all ($io, 4, 2) # start at 4 first 2 rows
+ 8..9 $csv->getline_all ($io, -2) # last 2 rows
+ 6..7 $csv->getline_all ($io, -4, 2) # first 2 of last 4 rows
+
+=head2 getline_hr
+
+The L</getline_hr> and L</column_names> methods work together to allow you
+to have rows returned as hashrefs. You must call L</column_names> first to
+declare your column names.
+
+ $csv->column_names (qw( code name price description ));
+ $hr = $csv->getline_hr ($io);
+ print "Price for $hr->{name} is $hr->{price} EUR\n";
+
+L</getline_hr> will croak if called before L</column_names>.
+
+Note that L</getline_hr> creates a hashref for every row and will be much
+slower than the combined use of L</bind_columns> and L</getline> but still
+offering the same ease of use hashref inside the loop:
+
+ my @cols = @{$csv->getline ($io)};
+ $csv->column_names (@cols);
+ while (my $row = $csv->getline_hr ($io)) {
+ print $row->{price};
+ }
+
+Could easily be rewritten to the much faster:
+
+ my @cols = @{$csv->getline ($io)};
+ my $row = {};
+ $csv->bind_columns (\@{$row}{@cols});
+ while ($csv->getline ($io)) {
+ print $row->{price};
+ }
+
+Your mileage may vary for the size of the data and the number of rows.
+
+=head2 getline_hr_all
+
+ $arrayref = $csv->getline_hr_all ($io);
+ $arrayref = $csv->getline_hr_all ($io, $offset);
+ $arrayref = $csv->getline_hr_all ($io, $offset, $length);
+
+This will return a reference to a list of L<getline_hr ($io)|/getline_hr>
+results. In this call, L<C<keep_meta_info>|/keep_meta_info> is disabled.
+
+=head2 parse
+
+ $status = $csv->parse ($line);
+
+This method decomposes a C<CSV> string into fields, returning success or
+failure. Failure can result from a lack of argument or the given C<CSV>
+string is improperly formatted. Upon success, L</fields> can be called to
+retrieve the decomposed fields. Upon failure calling L</fields> will return
+undefined data and L</error_input> can be called to retrieve the invalid
+argument.
+
+You may use the L</types> method for setting column types. See L</types>'
+description below.
+
+The C<$line> argument is supposed to be a simple scalar. Everything else is
+supposed to croak and set error 1500.
+
+=head2 fragment
+
+This function tries to implement RFC7111 (URI Fragment Identifiers for the
+text/csv Media Type) - http://tools.ietf.org/html/rfc7111
+
+ my $AoA = $csv->fragment ($io, $spec);
+
+In specifications, C<*> is used to specify the I<last> item, a dash (C<->)
+to indicate a range. All indices are C<1>-based: the first row or column
+has index C<1>. Selections can be combined with the semi-colon (C<;>).
+
+When using this method in combination with L</column_names>, the returned
+reference will point to a list of hashes instead of a list of lists. A
+disjointed cell-based combined selection might return rows with different
+number of columns making the use of hashes unpredictable.
+
+ $csv->column_names ("Name", "Age");
+ my $AoH = $csv->fragment ($io, "col=3;8");
+
+If the L</after_parse> callback is active, it is also called on every line
+parsed and skipped before the fragment.
+
+=over 2
+
+=item row
+
+ row=4
+ row=5-7
+ row=6-*
+ row=1-2;4;6-*
+
+=item col
+
+ col=2
+ col=1-3
+ col=4-*
+ col=1-2;4;7-*
+
+=item cell
+
+In cell-based selection, the comma (C<,>) is used to pair row and column
+
+ cell=4,1
+
+The range operator (C<->) using C<cell>s can be used to define top-left and
+bottom-right C<cell> location
+
+ cell=3,1-4,6
+
+The C<*> is only allowed in the second part of a pair
+
+ cell=3,2-*,2 # row 3 till end, only column 2
+ cell=3,2-3,* # column 2 till end, only row 3
+ cell=3,2-*,* # strip row 1 and 2, and column 1
+
+Cells and cell ranges may be combined with C<;>, possibly resulting in rows
+with different number of columns
+
+ cell=1,1-2,2;3,3-4,4;1,4;4,1
+
+Disjointed selections will only return selected cells. The cells that are
+not specified will not be included in the returned set, not even as
+C<undef>. As an example given a C<CSV> like
+
+ 11,12,13,...19
+ 21,22,...28,29
+ : :
+ 91,...97,98,99
+
+with C<cell=1,1-2,2;3,3-4,4;1,4;4,1> will return:
+
+ 11,12,14
+ 21,22
+ 33,34
+ 41,43,44
+
+Overlapping cell-specs will return those cells only once, So
+C<cell=1,1-3,3;2,2-4,4;2,3;4,2> will return:
+
+ 11,12,13
+ 21,22,23,24
+ 31,32,33,34
+ 42,43,44
+
+=back
+
+L<RFC7111|http://tools.ietf.org/html/rfc7111> does B<not> allow different
+types of specs to be combined (either C<row> I<or> C<col> I<or> C<cell>).
+Passing an invalid fragment specification will croak and set error 2013.
+
+=head2 column_names
+
+Set the "keys" that will be used in the L</getline_hr> calls. If no keys
+(column names) are passed, it will return the current setting as a list.
+
+L</column_names> accepts a list of scalars (the column names) or a single
+array_ref, so you can pass the return value from L</getline> too:
+
+ $csv->column_names ($csv->getline ($io));
+
+L</column_names> does B<no> checking on duplicates at all, which might lead
+to unexpected results. Undefined entries will be replaced with the string
+C<"\cAUNDEF\cA">, so
+
+ $csv->column_names (undef, "", "name", "name");
+ $hr = $csv->getline_hr ($io);
+
+Will set C<< $hr->{"\cAUNDEF\cA"} >> to the 1st field, C<< $hr->{""} >> to
+the 2nd field, and C<< $hr->{name} >> to the 4th field, discarding the 3rd
+field.
+
+L</column_names> croaks on invalid arguments.
+
+=head2 header
+
+This method does NOT work in perl-5.6.x
+
+Parse the CSV header and set L<C<sep>|/sep>, column_names and encoding.
+
+ my @hdr = $csv->header ($fh);
+ $csv->header ($fh, { sep_set => [ ";", ",", "|", "\t" ] });
+ $csv->header ($fh, { detect_bom => 1, munge_column_names => "lc" });
+
+The first argument should be a file handle.
+
+Assuming that the file opened for parsing has a header, and the header does
+not contain problematic characters like embedded newlines, read the first
+line from the open handle then auto-detect whether the header separates the
+column names with a character from the allowed separator list.
+
+If any of the allowed separators matches, and none of the I<other> allowed
+separators match, set L<C<sep>|/sep> to that separator for the current
+CSV_PP instance and use it to parse the first line, map those to lowercase,
+and use that to set the instance L</column_names>:
+
+ my $csv = Text::CSV_PP->new ({ binary => 1, auto_diag => 1 });
+ open my $fh, "<", "file.csv";
+ binmode $fh; # for Windows
+ $csv->header ($fh);
+ while (my $row = $csv->getline_hr ($fh)) {
+ ...
+ }
+
+If the header is empty, contains more than one unique separator out of the
+allowed set, contains empty fields, or contains identical fields (after
+folding), it will croak with error 1010, 1011, 1012, or 1013 respectively.
+
+If the header contains embedded newlines or is not valid CSV in any other
+way, this method will croak and leave the parse error untouched.
+
+A successful call to C<header> will always set the L<C<sep>|/sep> of the
+C<$csv> object. This behavior can not be disabled.
+
+=head3 return value
+
+On error this method will croak.
+
+In list context, the headers will be returned whether they are used to set
+L</column_names> or not.
+
+In scalar context, the instance itself is returned. B<Note>: the values as
+found in the header will effectively be B<lost> if C<set_column_names> is
+false.
+
+=head3 Options
+
+=over 2
+
+=item sep_set
+
+ $csv->header ($fh, { sep_set => [ ";", ",", "|", "\t" ] });
+
+The list of legal separators defaults to C<[ ";", "," ]> and can be changed
+by this option. As this is probably the most often used option, it can be
+passed on its own as an unnamed argument:
+
+ $csv->header ($fh, [ ";", ",", "|", "\t", "::", "\x{2063}" ]);
+
+Multi-byte sequences are allowed, both multi-character and Unicode. See
+L<C<sep>|/sep>.
+
+=item detect_bom
+
+ $csv->header ($fh, { detect_bom => 1 });
+
+The default behavior is to detect if the header line starts with a BOM. If
+the header has a BOM, use that to set the encoding of C<$fh>. This default
+behavior can be disabled by passing a false value to C<detect_bom>.
+
+Supported encodings from BOM are: UTF-8, UTF-16BE, UTF-16LE, UTF-32BE, and
+UTF-32LE. BOM's also support UTF-1, UTF-EBCDIC, SCSU, BOCU-1, and GB-18030
+but L<Encode> does not (yet). UTF-7 is not supported.
+
+The encoding is set using C<binmode> on C<$fh>.
+
+If the handle was opened in a (correct) encoding, this method will B<not>
+alter the encoding, as it checks the leading B<bytes> of the first line.
+
+=item munge_column_names
+
+This option offers the means to modify the column names into something that
+is most useful to the application. The default is to map all column names
+to lower case.
+
+ $csv->header ($fh, { munge_column_names => "lc" });
+
+The following values are available:
+
+ lc - lower case
+ uc - upper case
+ none - do not change
+ \&cb - supply a callback
+
+ $csv->header ($fh, { munge_column_names => sub { fc } });
+ $csv->header ($fh, { munge_column_names => sub { "column_".$col++ } });
+ $csv->header ($fh, { munge_column_names => sub { lc (s/\W+/_/gr) } });
+
+As this callback is called in a C<map>, you can use C<$_> directly.
+
+=item set_column_names
+
+ $csv->header ($fh, { set_column_names => 1 });
+
+The default is to set the instances column names using L</column_names> if
+the method is successful, so subsequent calls to L</getline_hr> can return
+a hash. Disable setting the header can be forced by using a false value for
+this option.
+
+=back
+
+=head3 Validation
+
+When receiving CSV files from external sources, this method can be used to
+protect against changes in the layout by restricting to known headers (and
+typos in the header fields).
+
+ my %known = (
+ "record key" => "c_rec",
+ "rec id" => "c_rec",
+ "id_rec" => "c_rec",
+ "kode" => "code",
+ "code" => "code",
+ "vaule" => "value",
+ "value" => "value",
+ );
+ my $csv = Text::CSV_PP->new ({ binary => 1, auto_diag => 1 });
+ open my $fh, "<", $source or die "$source: $!";
+ $csv->header ($fh, { munge_column_names => sub {
+ s/\s+$//;
+ s/^\s+//;
+ $known{lc $_} or die "Unknown column '$_' in $source";
+ }});
+ while (my $row = $csv->getline_hr ($fh)) {
+ say join "\t", $row->{c_rec}, $row->{code}, $row->{value};
+ }
+
+=head2 bind_columns
+
+Takes a list of scalar references to be used for output with L</print> or
+to store in the fields fetched by L</getline>. When you do not pass enough
+references to store the fetched fields in, L</getline> will fail with error
+C<3006>. If you pass more than there are fields to return, the content of
+the remaining references is left untouched.
+
+ $csv->bind_columns (\$code, \$name, \$price, \$description);
+ while ($csv->getline ($io)) {
+ print "The price of a $name is \x{20ac} $price\n";
+ }
+
+To reset or clear all column binding, call L</bind_columns> with the single
+argument C<undef>. This will also clear column names.
+
+ $csv->bind_columns (undef);
+
+If no arguments are passed at all, L</bind_columns> will return the list of
+current bindings or C<undef> if no binds are active.
+
+Note that in parsing with C<bind_columns>, the fields are set on the fly.
+That implies that if the third field of a row causes an error, the first
+two fields already have been assigned the values of the current row, while
+the rest of the fields will still hold the values of the previous row.
+If you want the parser to fail in these cases, use the L<C<strict>|/strict> attribute.
+
+=head2 eof
+
+ $eof = $csv->eof ();
+
+If L</parse> or L</getline> was used with an IO stream, this method will
+return true (1) if the last call hit end of file, otherwise it will return
+false (''). This is useful to see the difference between a failure and end
+of file.
+
+Note that if the parsing of the last line caused an error, C<eof> is still
+true. That means that if you are I<not> using L</auto_diag>, an idiom like
+
+ while (my $row = $csv->getline ($fh)) {
+ # ...
+ }
+ $csv->eof or $csv->error_diag;
+
+will I<not> report the error. You would have to change that to
+
+ while (my $row = $csv->getline ($fh)) {
+ # ...
+ }
+ +$csv->error_diag and $csv->error_diag;
+
+=head2 types
+
+ $csv->types (\@tref);
+
+This method is used to force that (all) columns are of a given type. For
+example, if you have an integer column, two columns with doubles and a
+string column, then you might do a
+
+ $csv->types ([Text::CSV_PP::IV (),
+ Text::CSV_PP::NV (),
+ Text::CSV_PP::NV (),
+ Text::CSV_PP::PV ()]);
+
+Column types are used only for I<decoding> columns while parsing, in other
+words by the L</parse> and L</getline> methods.
+
+You can unset column types by doing a
+
+ $csv->types (undef);
+
+or fetch the current type settings with
+
+ $types = $csv->types ();
+
+=over 4
+
+=item IV
+
+Set field type to integer.
+
+=item NV
+
+Set field type to numeric/float.
+
+=item PV
+
+Set field type to string.
+
+=back
+
+=head2 fields
+
+ @columns = $csv->fields ();
+
+This method returns the input to L</combine> or the resultant decomposed
+fields of a successful L</parse>, whichever was called more recently.
+
+Note that the return value is undefined after using L</getline>, which does
+not fill the data structures returned by L</parse>.
+
+=head2 meta_info
+
+ @flags = $csv->meta_info ();
+
+This method returns the "flags" of the input to L</combine> or the flags of
+the resultant decomposed fields of L</parse>, whichever was called more
+recently.
+
+For each field, a meta_info field will hold flags that inform something
+about the field returned by the L</fields> method or passed to the
+L</combine> method. The flags are bit-wise-C<or>'d like:
+
+=over 2
+
+=item C< >0x0001
+
+The field was quoted.
+
+=item C< >0x0002
+
+The field was binary.
+
+=back
+
+See the C<is_***> methods below.
+
+=head2 is_quoted
+
+ my $quoted = $csv->is_quoted ($column_idx);
+
+Where C<$column_idx> is the (zero-based) index of the column in the last
+result of L</parse>.
+
+This returns a true value if the data in the indicated column was enclosed
+in L<C<quote_char>|/quote_char> quotes. This might be important for fields
+where content C<,20070108,> is to be treated as a numeric value, and where
+C<,"20070108",> is explicitly marked as character string data.
+
+This method is only valid when L</keep_meta_info> is set to a true value.
+
+=head2 is_binary
+
+ my $binary = $csv->is_binary ($column_idx);
+
+Where C<$column_idx> is the (zero-based) index of the column in the last
+result of L</parse>.
+
+This returns a true value if the data in the indicated column contained any
+byte in the range C<[\x00-\x08,\x10-\x1F,\x7F-\xFF]>.
+
+This method is only valid when L</keep_meta_info> is set to a true value.
+
+=head2 is_missing
+
+ my $missing = $csv->is_missing ($column_idx);
+
+Where C<$column_idx> is the (zero-based) index of the column in the last
+result of L</getline_hr>.
+
+ $csv->keep_meta_info (1);
+ while (my $hr = $csv->getline_hr ($fh)) {
+ $csv->is_missing (0) and next; # This was an empty line
+ }
+
+When using L</getline_hr>, it is impossible to tell if the parsed fields
+are C<undef> because they where not filled in the C<CSV> stream or because
+they were not read at all, as B<all> the fields defined by L</column_names>
+are set in the hash-ref. If you still need to know if all fields in each
+row are provided, you should enable L<C<keep_meta_info>|/keep_meta_info> so
+you can check the flags.
+
+If L<C<keep_meta_info>|/keep_meta_info> is C<false>, C<is_missing> will
+always return C<undef>, regardless of C<$column_idx> being valid or not. If
+this attribute is C<true> it will return either C<0> (the field is present)
+or C<1> (the field is missing).
+
+A special case is the empty line. If the line is completely empty - after
+dealing with the flags - this is still a valid CSV line: it is a record of
+just one single empty field. However, if C<keep_meta_info> is set, invoking
+C<is_missing> with index C<0> will now return true.
+
+=head2 status
+
+ $status = $csv->status ();
+
+This method returns the status of the last invoked L</combine> or L</parse>
+call. Status is success (true: C<1>) or failure (false: C<undef> or C<0>).
+
+=head2 error_input
+
+ $bad_argument = $csv->error_input ();
+
+This method returns the erroneous argument (if it exists) of L</combine> or
+L</parse>, whichever was called more recently. If the last invocation was
+successful, C<error_input> will return C<undef>.
+
+=head2 error_diag
+
+ Text::CSV_PP->error_diag ();
+ $csv->error_diag ();
+ $error_code = 0 + $csv->error_diag ();
+ $error_str = "" . $csv->error_diag ();
+ ($cde, $str, $pos, $rec, $fld) = $csv->error_diag ();
+
+If (and only if) an error occurred, this function returns the diagnostics
+of that error.
+
+If called in void context, this will print the internal error code and the
+associated error message to STDERR.
+
+If called in list context, this will return the error code and the error
+message in that order. If the last error was from parsing, the rest of the
+values returned are a best guess at the location within the line that was
+being parsed. Their values are 1-based. The position currently is index of
+the byte at which the parsing failed in the current record. It might change
+to be the index of the current character in a later release. The records is
+the index of the record parsed by the csv instance. The field number is the
+index of the field the parser thinks it is currently trying to parse. See
+F<examples/csv-check> for how this can be used.
+
+If called in scalar context, it will return the diagnostics in a single
+scalar, a-la C<$!>. It will contain the error code in numeric context, and
+the diagnostics message in string context.
+
+When called as a class method or a direct function call, the diagnostics
+are that of the last L</new> call.
+
+=head2 record_number
+
+ $recno = $csv->record_number ();
+
+Returns the records parsed by this csv instance. This value should be more
+accurate than C<$.> when embedded newlines come in play. Records written by
+this instance are not counted.
+
+=head2 SetDiag
+
+ $csv->SetDiag (0);
+
+Use to reset the diagnostics if you are dealing with errors.
+
+=head1 FUNCTIONS
+
+This whole section is also taken from Text::CSV_XS.
+
+=head2 csv
+
+This function is not exported by default and should be explicitly requested:
+
+ use Text::CSV_PP qw( csv );
+
+This is an high-level function that aims at simple (user) interfaces. This
+can be used to read/parse a C<CSV> file or stream (the default behavior) or
+to produce a file or write to a stream (define the C<out> attribute). It
+returns an array- or hash-reference on parsing (or C<undef> on fail) or the
+numeric value of L</error_diag> on writing. When this function fails you
+can get to the error using the class call to L</error_diag>
+
+ my $aoa = csv (in => "test.csv") or
+ die Text::CSV_PP->error_diag;
+
+This function takes the arguments as key-value pairs. This can be passed as
+a list or as an anonymous hash:
+
+ my $aoa = csv ( in => "test.csv", sep_char => ";");
+ my $aoh = csv ({ in => $fh, headers => "auto" });
+
+The arguments passed consist of two parts: the arguments to L</csv> itself
+and the optional attributes to the C<CSV> object used inside the function
+as enumerated and explained in L</new>.
+
+If not overridden, the default option used for CSV is
+
+ auto_diag => 1
+ escape_null => 0
+
+The option that is always set and cannot be altered is
+
+ binary => 1
+
+As this function will likely be used in one-liners, it allows C<quote> to
+be abbreviated as C<quo>, and C<escape_char> to be abbreviated as C<esc>
+or C<escape>.
+
+Alternative invocations:
+
+ my $aoa = Text::CSV_PP::csv (in => "file.csv");
+
+ my $csv = Text::CSV_PP->new ();
+ my $aoa = $csv->csv (in => "file.csv");
+
+In the latter case, the object attributes are used from the existing object
+and the attribute arguments in the function call are ignored:
+
+ my $csv = Text::CSV_PP->new ({ sep_char => ";" });
+ my $aoh = $csv->csv (in => "file.csv", bom => 1);
+
+will parse using C<;> as C<sep_char>, not C<,>.
+
+=head3 in
+
+Used to specify the source. C<in> can be a file name (e.g. C<"file.csv">),
+which will be opened for reading and closed when finished, a file handle
+(e.g. C<$fh> or C<FH>), a reference to a glob (e.g. C<\*ARGV>), the glob
+itself (e.g. C<*STDIN>), or a reference to a scalar (e.g. C<\q{1,2,"csv"}>).
+
+When used with L</out>, C<in> should be a reference to a CSV structure (AoA
+or AoH) or a CODE-ref that returns an array-reference or a hash-reference.
+The code-ref will be invoked with no arguments.
+
+ my $aoa = csv (in => "file.csv");
+
+ open my $fh, "<", "file.csv";
+ my $aoa = csv (in => $fh);
+
+ my $csv = [ [qw( Foo Bar )], [ 1, 2 ], [ 2, 3 ]];
+ my $err = csv (in => $csv, out => "file.csv");
+
+If called in void context without the L</out> attribute, the resulting ref
+will be used as input to a subsequent call to csv:
+
+ csv (in => "file.csv", filter => { 2 => sub { length > 2 }})
+
+will be a shortcut to
+
+ csv (in => csv (in => "file.csv", filter => { 2 => sub { length > 2 }}))
+
+where, in the absence of the C<out> attribute, this is a shortcut to
+
+ csv (in => csv (in => "file.csv", filter => { 2 => sub { length > 2 }}),
+ out => *STDOUT)
+
+=head3 out
+
+In output mode, the default CSV options when producing CSV are
+
+ eol => "\r\n"
+
+The L</fragment> attribute is ignored in output mode.
+
+C<out> can be a file name (e.g. C<"file.csv">), which will be opened for
+writing and closed when finished, a file handle (e.g. C<$fh> or C<FH>), a
+reference to a glob (e.g. C<\*STDOUT>), or the glob itself (e.g. C<*STDOUT>).
+
+ csv (in => sub { $sth->fetch }, out => "dump.csv");
+ csv (in => sub { $sth->fetchrow_hashref }, out => "dump.csv",
+ headers => $sth->{NAME_lc});
+
+When a code-ref is used for C<in>, the output is generated per invocation,
+so no buffering is involved. This implies that there is no size restriction
+on the number of records. The C<csv> function ends when the coderef returns
+a false value.
+
+=head3 encoding
+
+If passed, it should be an encoding accepted by the C<:encoding()> option
+to C<open>. There is no default value. This attribute does not work in perl
+5.6.x. C<encoding> can be abbreviated to C<enc> for ease of use in command
+line invocations.
+
+If C<encoding> is set to the literal value C<"auto">, the method L</header>
+will be invoked on the opened stream to check if there is a BOM and set the
+encoding accordingly. This is equal to passing a true value in the option
+L<C<detect_bom>|/detect_bom>.
+
+=head3 detect_bom
+
+If C<detect_bom> is given, the method L</header> will be invoked on the
+opened stream to check if there is a BOM and set the encoding accordingly.
+
+C<detect_bom> can be abbreviated to C<bom>.
+
+This is the same as setting L<C<encoding>|/encoding> to C<"auto">.
+
+Note that as L</header> is invoked, its default is to also set the headers.
+
+=head3 headers
+
+If this attribute is not given, the default behavior is to produce an array
+of arrays.
+
+If C<headers> is supplied, it should be an anonymous list of column names,
+an anonymous hashref, a coderef, or a literal flag: C<auto>, C<lc>, C<uc>,
+or C<skip>.
+
+=over 2
+
+=item skip
+
+When C<skip> is used, the header will not be included in the output.
+
+ my $aoa = csv (in => $fh, headers => "skip");
+
+=item auto
+
+If C<auto> is used, the first line of the C<CSV> source will be read as the
+list of field headers and used to produce an array of hashes.
+
+ my $aoh = csv (in => $fh, headers => "auto");
+
+=item lc
+
+If C<lc> is used, the first line of the C<CSV> source will be read as the
+list of field headers mapped to lower case and used to produce an array of
+hashes. This is a variation of C<auto>.
+
+ my $aoh = csv (in => $fh, headers => "lc");
+
+=item uc
+
+If C<uc> is used, the first line of the C<CSV> source will be read as the
+list of field headers mapped to upper case and used to produce an array of
+hashes. This is a variation of C<auto>.
+
+ my $aoh = csv (in => $fh, headers => "uc");
+
+=item CODE
+
+If a coderef is used, the first line of the C<CSV> source will be read as
+the list of mangled field headers in which each field is passed as the only
+argument to the coderef. This list is used to produce an array of hashes.
+
+ my $aoh = csv (in => $fh,
+ headers => sub { lc ($_[0]) =~ s/kode/code/gr });
+
+this example is a variation of using C<lc> where all occurrences of C<kode>
+are replaced with C<code>.
+
+=item ARRAY
+
+If C<headers> is an anonymous list, the entries in the list will be used
+as field names. The first line is considered data instead of headers.
+
+ my $aoh = csv (in => $fh, headers => [qw( Foo Bar )]);
+ csv (in => $aoa, out => $fh, headers => [qw( code description price )]);
+
+=item HASH
+
+If C<headers> is an hash reference, this implies C<auto>, but header fields
+for that exist as key in the hashref will be replaced by the value for that
+key. Given a CSV file like
+
+ post-kode,city,name,id number,fubble
+ 1234AA,Duckstad,Donald,13,"X313DF"
+
+using
+
+ csv (headers => { "post-kode" => "pc", "id number" => "ID" }, ...
+
+will return an entry like
+
+ { pc => "1234AA",
+ city => "Duckstad",
+ name => "Donald",
+ ID => "13",
+ fubble => "X313DF",
+ }
+
+=back
+
+See also L<C<munge_column_names>|/munge_column_names> and
+L<C<set_column_names>|/set_column_names>.
+
+=head3 munge_column_names
+
+If C<munge_column_names> is set, the method L</header> is invoked on the
+opened stream with all matching arguments to detect and set the headers.
+
+C<munge_column_names> can be abbreviated to C<munge>.
+
+=head3 key
+
+If passed, will default L<C<headers>|/headers> to C<"auto"> and return a
+hashref instead of an array of hashes.
+
+ my $ref = csv (in => "test.csv", key => "code");
+
+with test.csv like
+
+ code,product,price,color
+ 1,pc,850,gray
+ 2,keyboard,12,white
+ 3,mouse,5,black
+
+will return
+
+ { 1 => {
+ code => 1,
+ color => 'gray',
+ price => 850,
+ product => 'pc'
+ },
+ 2 => {
+ code => 2,
+ color => 'white',
+ price => 12,
+ product => 'keyboard'
+ },
+ 3 => {
+ code => 3,
+ color => 'black',
+ price => 5,
+ product => 'mouse'
+ }
+ }
+
+=head3 fragment
+
+Only output the fragment as defined in the L</fragment> method. This option
+is ignored when I<generating> C<CSV>. See L</out>.
+
+Combining all of them could give something like
+
+ use Text::CSV_PP qw( csv );
+ my $aoh = csv (
+ in => "test.txt",
+ encoding => "utf-8",
+ headers => "auto",
+ sep_char => "|",
+ fragment => "row=3;6-9;15-*",
+ );
+ say $aoh->[15]{Foo};
+
+=head3 sep_set
+
+If C<sep_set> is set, the method L</header> is invoked on the opened stream
+to detect and set L<C<sep_char>|/sep_char> with the given set.
+
+C<sep_set> can be abbreviated to C<seps>.
+
+Note that as L</header> is invoked, its default is to also set the headers.
+
+=head3 set_column_names
+
+If C<set_column_names> is passed, the method L</header> is invoked on the
+opened stream with all arguments meant for L</header>.
+
+=head2 Callbacks
+
+Callbacks enable actions triggered from the I<inside> of Text::CSV_PP.
+
+While most of what this enables can easily be done in an unrolled loop as
+described in the L</SYNOPSIS> callbacks can be used to meet special demands
+or enhance the L</csv> function.
+
+=over 2
+
+=item error
+
+ $csv->callbacks (error => sub { $csv->SetDiag (0) });
+
+the C<error> callback is invoked when an error occurs, but I<only> when
+L</auto_diag> is set to a true value. A callback is invoked with the values
+returned by L</error_diag>:
+
+ my ($c, $s);
+
+ sub ignore3006
+ {
+ my ($err, $msg, $pos, $recno, $fldno) = @_;
+ if ($err == 3006) {
+ # ignore this error
+ ($c, $s) = (undef, undef);
+ Text::CSV_PP->SetDiag (0);
+ }
+ # Any other error
+ return;
+ } # ignore3006
+
+ $csv->callbacks (error => \&ignore3006);
+ $csv->bind_columns (\$c, \$s);
+ while ($csv->getline ($fh)) {
+ # Error 3006 will not stop the loop
+ }
+
+=item after_parse
+
+ $csv->callbacks (after_parse => sub { push @{$_[1]}, "NEW" });
+ while (my $row = $csv->getline ($fh)) {
+ $row->[-1] eq "NEW";
+ }
+
+This callback is invoked after parsing with L</getline> only if no error
+occurred. The callback is invoked with two arguments: the current C<CSV>
+parser object and an array reference to the fields parsed.
+
+The return code of the callback is ignored unless it is a reference to the
+string "skip", in which case the record will be skipped in L</getline_all>.
+
+ sub add_from_db
+ {
+ my ($csv, $row) = @_;
+ $sth->execute ($row->[4]);
+ push @$row, $sth->fetchrow_array;
+ } # add_from_db
+
+ my $aoa = csv (in => "file.csv", callbacks => {
+ after_parse => \&add_from_db });
+
+This hook can be used for validation:
+
+=over 2
+
+=item FAIL
+
+Die if any of the records does not validate a rule:
+
+ after_parse => sub {
+ $_[1][4] =~ m/^[0-9]{4}\s?[A-Z]{2}$/ or
+ die "5th field does not have a valid Dutch zipcode";
+ }
+
+=item DEFAULT
+
+Replace invalid fields with a default value:
+
+ after_parse => sub { $_[1][2] =~ m/^\d+$/ or $_[1][2] = 0 }
+
+=item SKIP
+
+Skip records that have invalid fields (only applies to L</getline_all>):
+
+ after_parse => sub { $_[1][0] =~ m/^\d+$/ or return \"skip"; }
+
+=back
+
+=item before_print
+
+ my $idx = 1;
+ $csv->callbacks (before_print => sub { $_[1][0] = $idx++ });
+ $csv->print (*STDOUT, [ 0, $_ ]) for @members;
+
+This callback is invoked before printing with L</print> only if no error
+occurred. The callback is invoked with two arguments: the current C<CSV>
+parser object and an array reference to the fields passed.
+
+The return code of the callback is ignored.
+
+ sub max_4_fields
+ {
+ my ($csv, $row) = @_;
+ @$row > 4 and splice @$row, 4;
+ } # max_4_fields
+
+ csv (in => csv (in => "file.csv"), out => *STDOUT,
+ callbacks => { before print => \&max_4_fields });
+
+This callback is not active for L</combine>.
+
+=back
+
+=head3 Callbacks for csv ()
+
+The L</csv> allows for some callbacks that do not integrate in XS internals
+but only feature the L</csv> function.
+
+ csv (in => "file.csv",
+ callbacks => {
+ filter => { 6 => sub { $_ > 15 } }, # first
+ after_parse => sub { say "AFTER PARSE"; }, # first
+ after_in => sub { say "AFTER IN"; }, # second
+ on_in => sub { say "ON IN"; }, # third
+ },
+ );
+
+ csv (in => $aoh,
+ out => "file.csv",
+ callbacks => {
+ on_in => sub { say "ON IN"; }, # first
+ before_out => sub { say "BEFORE OUT"; }, # second
+ before_print => sub { say "BEFORE PRINT"; }, # third
+ },
+ );
+
+=over 2
+
+=item filter
+
+This callback can be used to filter records. It is called just after a new
+record has been scanned. The callback accepts a hashref where the keys are
+the index to the row (the field number, 1-based) and the values are subs to
+return a true or false value.
+
+ csv (in => "file.csv", filter => {
+ 3 => sub { m/a/ }, # third field should contain an "a"
+ 5 => sub { length > 4 }, # length of the 5th field minimal 5
+ });
+
+ csv (in => "file.csv", filter => "not_blank");
+ csv (in => "file.csv", filter => "not_empty");
+ csv (in => "file.csv", filter => "filled");
+
+If the keys to the filter hash contain any character that is not a digit it
+will also implicitly set L</headers> to C<"auto"> unless L</headers> was
+already passed as argument. When headers are active, returning an array of
+hashes, the filter is not applicable to the header itself.
+
+ csv (in => "file.csv", filter => { foo => sub { $_ > 4 }});
+
+All sub results should match, as in AND.
+
+The context of the callback sets C<$_> localized to the field indicated by
+the filter. The two arguments are as with all other callbacks, so the other
+fields in the current row can be seen:
+
+ filter => { 3 => sub { $_ > 100 ? $_[1][1] =~ m/A/ : $_[1][6] =~ m/B/ }}
+
+If the context is set to return a list of hashes (L</headers> is defined),
+the current record will also be available in the localized C<%_>:
+
+ filter => { 3 => sub { $_ > 100 && $_{foo} =~ m/A/ && $_{bar} < 1000 }}
+
+If the filter is used to I<alter> the content by changing C<$_>, make sure
+that the sub returns true in order not to have that record skipped:
+
+ filter => { 2 => sub { $_ = uc }}
+
+will upper-case the second field, and then skip it if the resulting content
+evaluates to false. To always accept, end with truth:
+
+ filter => { 2 => sub { $_ = uc; 1 }}
+
+B<Predefined filters>
+
+Given a file like (line numbers prefixed for doc purpose only):
+
+ 1:1,2,3
+ 2:
+ 3:,
+ 4:""
+ 5:,,
+ 6:, ,
+ 7:"",
+ 8:" "
+ 9:4,5,6
+
+=over 2
+
+=item not_blank
+
+Filter out the blank lines
+
+This filter is a shortcut for
+
+ filter => { 0 => sub { @{$_[1]} > 1 or
+ defined $_[1][0] && $_[1][0] ne "" } }
+
+Due to the implementation, it is currently impossible to also filter lines
+that consists only of a quoted empty field. These lines are also considered
+blank lines.
+
+With the given example, lines 2 and 4 will be skipped.
+
+=item not_empty
+
+Filter out lines where all the fields are empty.
+
+This filter is a shortcut for
+
+ filter => { 0 => sub { grep { defined && $_ ne "" } @{$_[1]} } }
+
+A space is not regarded being empty, so given the example data, lines 2, 3,
+4, 5, and 7 are skipped.
+
+=item filled
+
+Filter out lines that have no visible data
+
+This filter is a shortcut for
+
+ filter => { 0 => sub { grep { defined && m/\S/ } @{$_[1]} } }
+
+This filter rejects all lines that I<not> have at least one field that does
+not evaluate to the empty string.
+
+With the given example data, this filter would skip lines 2 through 8.
+
+=back
+
+=item after_in
+
+This callback is invoked for each record after all records have been parsed
+but before returning the reference to the caller. The hook is invoked with
+two arguments: the current C<CSV> parser object and a reference to the
+record. The reference can be a reference to a HASH or a reference to an
+ARRAY as determined by the arguments.
+
+This callback can also be passed as an attribute without the C<callbacks>
+wrapper.
+
+=item before_out
+
+This callback is invoked for each record before the record is printed. The
+hook is invoked with two arguments: the current C<CSV> parser object and a
+reference to the record. The reference can be a reference to a HASH or a
+reference to an ARRAY as determined by the arguments.
+
+This callback can also be passed as an attribute without the C<callbacks>
+wrapper.
+
+This callback makes the row available in C<%_> if the row is a hashref. In
+this case C<%_> is writable and will change the original row.
+
+=item on_in
+
+This callback acts exactly as the L</after_in> or the L</before_out> hooks.
+
+This callback can also be passed as an attribute without the C<callbacks>
+wrapper.
+
+This callback makes the row available in C<%_> if the row is a hashref. In
+this case C<%_> is writable and will change the original row. So e.g. with
+
+ my $aoh = csv (
+ in => \"foo\n1\n2\n",
+ headers => "auto",
+ on_in => sub { $_{bar} = 2; },
+ );
+
+C<$aoh> will be:
+
+ [ { foo => 1,
+ bar => 2,
+ }
+ { foo => 2,
+ bar => 2,
+ }
+ ]
+
+=item csv
+
+The I<function> L</csv> can also be called as a method or with an existing
+Text::CSV_PP object. This could help if the function is to be invoked a lot
+of times and the overhead of creating the object internally over and over
+again would be prevented by passing an existing instance.
+
+ my $csv = Text::CSV_PP->new ({ binary => 1, auto_diag => 1 });
+
+ my $aoa = $csv->csv (in => $fh);
+ my $aoa = csv (in => $fh, csv => $csv);
+
+both act the same. Running this 20000 times on a 20 lines CSV file, showed
+a 53% speedup.
+
+=back
+
+=head1 DIAGNOSTICS
+
+This section is also taken from Text::CSV_XS.
+
+If an error occurs, C<< $csv->error_diag >> can be used to get information
+on the cause of the failure. Note that for speed reasons the internal value
+is never cleared on success, so using the value returned by L</error_diag>
+in normal cases - when no error occurred - may cause unexpected results.
+
+If the constructor failed, the cause can be found using L</error_diag> as a
+class method, like C<< Text::CSV_PP->error_diag >>.
+
+The C<< $csv->error_diag >> method is automatically invoked upon error when
+the contractor was called with L<C<auto_diag>|/auto_diag> set to C<1> or
+C<2>, or when L<autodie> is in effect. When set to C<1>, this will cause a
+C<warn> with the error message, when set to C<2>, it will C<die>. C<2012 -
+EOF> is excluded from L<C<auto_diag>|/auto_diag> reports.
+
+Errors can be (individually) caught using the L</error> callback.
+
+The errors as described below are available. I have tried to make the error
+itself explanatory enough, but more descriptions will be added. For most of
+these errors, the first three capitals describe the error category:
+
+=over 2
+
+=item *
+INI
+
+Initialization error or option conflict.
+
+=item *
+ECR
+
+Carriage-Return related parse error.
+
+=item *
+EOF
+
+End-Of-File related parse error.
+
+=item *
+EIQ
+
+Parse error inside quotation.
+
+=item *
+EIF
+
+Parse error inside field.
+
+=item *
+ECB
+
+Combine error.
+
+=item *
+EHR
+
+HashRef parse related error.
+
+=back
+
+And below should be the complete list of error codes that can be returned:
+
+=over 2
+
+=item *
+1001 "INI - sep_char is equal to quote_char or escape_char"
+X<1001>
+
+The L<separation character|/sep_char> cannot be equal to L<the quotation
+character|/quote_char> or to L<the escape character|/escape_char>, as this
+would invalidate all parsing rules.
+
+=item *
+1002 "INI - allow_whitespace with escape_char or quote_char SP or TAB"
+X<1002>
+
+Using the L<C<allow_whitespace>|/allow_whitespace> attribute when either
+L<C<quote_char>|/quote_char> or L<C<escape_char>|/escape_char> is equal to
+C<SPACE> or C<TAB> is too ambiguous to allow.
+
+=item *
+1003 "INI - \r or \n in main attr not allowed"
+X<1003>
+
+Using default L<C<eol>|/eol> characters in either L<C<sep_char>|/sep_char>,
+L<C<quote_char>|/quote_char>, or L<C<escape_char>|/escape_char> is not
+allowed.
+
+=item *
+1004 "INI - callbacks should be undef or a hashref"
+X<1004>
+
+The L<C<callbacks>|/Callbacks> attribute only allows one to be C<undef> or
+a hash reference.
+
+=item *
+1005 "INI - EOL too long"
+X<1005>
+
+The value passed for EOL is exceeding its maximum length (16).
+
+=item *
+1006 "INI - SEP too long"
+X<1006>
+
+The value passed for SEP is exceeding its maximum length (16).
+
+=item *
+1007 "INI - QUOTE too long"
+X<1007>
+
+The value passed for QUOTE is exceeding its maximum length (16).
+
+=item *
+1008 "INI - SEP undefined"
+X<1008>
+
+The value passed for SEP should be defined and not empty.
+
+=item *
+1010 "INI - the header is empty"
+X<1010>
+
+The header line parsed in the L</header> is empty.
+
+=item *
+1011 "INI - the header contains more than one valid separator"
+X<1011>
+
+The header line parsed in the L</header> contains more than one (unique)
+separator character out of the allowed set of separators.
+
+=item *
+1012 "INI - the header contains an empty field"
+X<1012>
+
+The header line parsed in the L</header> is contains an empty field.
+
+=item *
+1013 "INI - the header contains nun-unique fields"
+X<1013>
+
+The header line parsed in the L</header> contains at least two identical
+fields.
+
+=item *
+1014 "INI - header called on undefined stream"
+X<1014>
+
+The header line cannot be parsed from an undefined sources.
+
+=item *
+1500 "PRM - Invalid/unsupported argument(s)"
+X<1500>
+
+Function or method called with invalid argument(s) or parameter(s).
+
+=item *
+2010 "ECR - QUO char inside quotes followed by CR not part of EOL"
+X<2010>
+
+When L<C<eol>|/eol> has been set to anything but the default, like
+C<"\r\t\n">, and the C<"\r"> is following the B<second> (closing)
+L<C<quote_char>|/quote_char>, where the characters following the C<"\r"> do
+not make up the L<C<eol>|/eol> sequence, this is an error.
+
+=item *
+2011 "ECR - Characters after end of quoted field"
+X<2011>
+
+Sequences like C<1,foo,"bar"baz,22,1> are not allowed. C<"bar"> is a quoted
+field and after the closing double-quote, there should be either a new-line
+sequence or a separation character.
+
+=item *
+2012 "EOF - End of data in parsing input stream"
+X<2012>
+
+Self-explaining. End-of-file while inside parsing a stream. Can happen only
+when reading from streams with L</getline>, as using L</parse> is done on
+strings that are not required to have a trailing L<C<eol>|/eol>.
+
+=item *
+2013 "INI - Specification error for fragments RFC7111"
+X<2013>
+
+Invalid specification for URI L</fragment> specification.
+
+=item *
+2014 "ENF - Inconsistent number of fields"
+X<2014>
+
+Inconsistent number of fields under strict parsing.
+
+=item *
+2021 "EIQ - NL char inside quotes, binary off"
+X<2021>
+
+Sequences like C<1,"foo\nbar",22,1> are allowed only when the binary option
+has been selected with the constructor.
+
+=item *
+2022 "EIQ - CR char inside quotes, binary off"
+X<2022>
+
+Sequences like C<1,"foo\rbar",22,1> are allowed only when the binary option
+has been selected with the constructor.
+
+=item *
+2023 "EIQ - QUO character not allowed"
+X<2023>
+
+Sequences like C<"foo "bar" baz",qu> and C<2023,",2008-04-05,"Foo, Bar",\n>
+will cause this error.
+
+=item *
+2024 "EIQ - EOF cannot be escaped, not even inside quotes"
+X<2024>
+
+The escape character is not allowed as last character in an input stream.
+
+=item *
+2025 "EIQ - Loose unescaped escape"
+X<2025>
+
+An escape character should escape only characters that need escaping.
+
+Allowing the escape for other characters is possible with the attribute
+L</allow_loose_escape>.
+
+=item *
+2026 "EIQ - Binary character inside quoted field, binary off"
+X<2026>
+
+Binary characters are not allowed by default. Exceptions are fields that
+contain valid UTF-8, that will automatically be upgraded if the content is
+valid UTF-8. Set L<C<binary>|/binary> to C<1> to accept binary data.
+
+=item *
+2027 "EIQ - Quoted field not terminated"
+X<2027>
+
+When parsing a field that started with a quotation character, the field is
+expected to be closed with a quotation character. When the parsed line is
+exhausted before the quote is found, that field is not terminated.
+
+=item *
+2030 "EIF - NL char inside unquoted verbatim, binary off"
+X<2030>
+
+=item *
+2031 "EIF - CR char is first char of field, not part of EOL"
+X<2031>
+
+=item *
+2032 "EIF - CR char inside unquoted, not part of EOL"
+X<2032>
+
+=item *
+2034 "EIF - Loose unescaped quote"
+X<2034>
+
+=item *
+2035 "EIF - Escaped EOF in unquoted field"
+X<2035>
+
+=item *
+2036 "EIF - ESC error"
+X<2036>
+
+=item *
+2037 "EIF - Binary character in unquoted field, binary off"
+X<2037>
+
+=item *
+2110 "ECB - Binary character in Combine, binary off"
+X<2110>
+
+=item *
+2200 "EIO - print to IO failed. See errno"
+X<2200>
+
+=item *
+3001 "EHR - Unsupported syntax for column_names ()"
+X<3001>
+
+=item *
+3002 "EHR - getline_hr () called before column_names ()"
+X<3002>
+
+=item *
+3003 "EHR - bind_columns () and column_names () fields count mismatch"
+X<3003>
+
+=item *
+3004 "EHR - bind_columns () only accepts refs to scalars"
+X<3004>
+
+=item *
+3006 "EHR - bind_columns () did not pass enough refs for parsed fields"
+X<3006>
+
+=item *
+3007 "EHR - bind_columns needs refs to writable scalars"
+X<3007>
+
+=item *
+3008 "EHR - unexpected error in bound fields"
+X<3008>
+
+=item *
+3009 "EHR - print_hr () called before column_names ()"
+X<3009>
+
+=item *
+3010 "EHR - print_hr () called with invalid arguments"
+X<3010>
+
+=back
+
+=head1 SEE ALSO
+
+L<Text::CSV_XS>, L<Text::CSV>
+
+Older versions took many regexp from L<http://www.din.or.jp/~ohzaki/perl.htm>
+
+=head1 AUTHOR
+
+Kenichi Ishigaki, E<lt>ishigaki[at]cpan.orgE<gt>
+Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
+
+Text::CSV_XS was written by E<lt>joe[at]ispsoft.deE<gt>
+and maintained by E<lt>h.m.brand[at]xs4all.nlE<gt>.
+
+Text::CSV was written by E<lt>alan[at]mfgrtl.comE<gt>.
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2017- by Kenichi Ishigaki, E<lt>ishigaki[at]cpan.orgE<gt>
+Copyright 2005-2015 by Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
+
+Most of the code and doc is directly taken from the pure perl part of
+Text::CSV_XS.
+
+Copyright (C) 2007-2016 H.Merijn Brand. All rights reserved.
+Copyright (C) 1998-2001 Jochen Wiedmann. All rights reserved.
+Copyright (C) 1997 Alan Citterman. All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut