Gecko [ edgpens.lpkmn.gov.my ]

Name	Size	Permission
Chart	[ DIR ]	drwxrwxrwx
BIFFwriter.pm	7.18 KB	-rw-rw-rw-
Big.pm	1.79 KB	-rw-rw-rw-
Chart.pm	84.29 KB	-rw-rw-rw-
Examples.pm	314.85 KB	-rw-rw-rw-
Format.pm	22.5 KB	-rw-rw-rw-
Formula.pm	52.77 KB	-rw-rw-rw-
OLEwriter.pm	11.06 KB	-rw-rw-rw-
Properties.pm	9.84 KB	-rw-rw-rw-
Utility.pm	29.03 KB	-rw-rw-rw-
Workbook.pm	107.96 KB	-rw-rw-rw-
Worksheet.pm	216.3 KB	-rw-rw-rw-

Code Editor : OLEwriter.pm

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.40';

###############################################################################
#
# 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;
    }
}

__END__

=encoding latin1

=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

${this.title}

Code Editor : OLEwriter.pm