File Coverage

blib/lib/Spreadsheet/WriteExcel/WebPivot.pm

Criterion	Covered	Total	%
statement	164	203	80.7
branch	19	42	45.2
condition	5	15	33.3
subroutine	19	21	90.4
pod	1	8	12.5
total	208	289	71.9

package Spreadsheet::WriteExcel::WebPivot;

use 5.006;
use strict;
use warnings;
use DBI;
use FileHandle;
use Switch;
use POSIX 'strftime';

our(@ISA, @EXPORT);
sub makewebpivot;

use Exporter 'import';
@EXPORT = qw(makewebpivot);

our $VERSION = '0.01';

#-----------------------------------------------------------------------
# not needed or even that useful anymore now that we are exporting the
# main function
#
sub new {
    my $class = shift;
    $class = ref($class) if (ref($class));

    my $self = {};
    bless($self, $class);
    return $self;
}


# these four variables are for storing large amounts of text for
# a home-brew template system. The Template Toolkit is much better
# but I wanted to reduce module dependencies

my ($pivotcachetext, $pivotcachefooter,$pivothdrtext,$filelisttmpl);

#-----------------------------------------------------------------------
# this function is an internal function that does the proper xml
# escaping for hash references containing
# data that needs to be output as xml

sub cleanhash4xml {
    my $self = shift; # get class thingy
    my $rhsh = shift;

    return 	unless(defined($rhsh));
    my @keys = keys %$rhsh;
    # the line below takes care of uninitialized data errors
    map {(!exists($rhsh->{$_}) or !defined($rhsh->{$_})) ? $rhsh->{$_} = ' ': 1} @keys;
    map ($rhsh->{$_} =~ s/\&/\&/g, @keys);
    map ($rhsh->{$_} =~ s/"/\"/g, @keys);
    map ($rhsh->{$_} =~ s/
    map ($rhsh->{$_} =~ s/>/\>/g, @keys);
    map ($rhsh->{$_} =~ s/[^[:alnum:][:punct:] ]//g, @keys);
    if (defined($self->{types})) {
        foreach my $key (@keys) {
            #die "dead #".$rhsh->{$key} . "#\n"	if( 'Tier' eq $key and !($rhsh->{$key} =~ /\w/));
            if (!defined($rhsh->{$key}) or !($rhsh->{$key} =~ /\w/)) {
                if ( $self->{types}->{$key} eq 'text' ) {
                    $rhsh->{$key} = 'none';
                }
                else {
                    $rhsh->{$key} = "0";
                }
            }
        }
    }
}


#-----------------------------------------------------------------------
sub cleanArray4xml {
    shift; # get class thingy
    my $rarr = shift;
    # the line below takes care of uninitialized data errors
    map {defined($_) ? $_ : ''} @$rarr;
    map (s/\&/\&/g, @$rarr);
    map (s/"/\"/g, @$rarr);
    map (s/
    map (s/>/\>/g, @$rarr);
    map (s/[^[:alnum:][:punct:] ]//g, @$rarr);
}



#-----------------------------------------------------------------------
sub getDataTypes {
    my $self = shift;
    my $href = shift;
    my $rkeys = shift;
    my @keys = @$rkeys;
    my $type; my $typename;
    my @pivotfields;
    my $i = 1;
    my @dkeys = keys %$href;
    my %keysh; @keysh{@keys} = @keys;
    map { push @keys, $_ unless(exists $keysh{$_}) }  @dkeys;
    foreach my $key (@keys) {
        die "$key not defined\n" unless(defined $href->{$key});
        switch ($href->{$key}) {
            case /^\d+$/ {
                $type = q(type="int");
                $typename = 'int';
            }
            case /^\d+\.\d+$/ {
                $type = q(type="float");
                $typename = 'float';
            }
            case qr/^\d{4}\-\d{2}\-\d{2}/ {
                $type = q(type="dateTime");
                $typename = 'dateTime';
            }
            else {
                $type = q(maxLength="255");
                $typename = 'text';
            }
        }
        push @pivotfields, {FIELDNAME=>$key, COLNUM=>$i++, DATATYPE=>$type};
        $self->{types}->{$key} = $typename;
    }
    return @pivotfields;
}

#-----------------------------------------------------------------------
# this function sets up the subdirectory required by Excel's web object
#
sub makepivotdir {
    my $file = shift;
    my $title = shift;
    my $rkeys = shift;
    my $summarytype = shift;

    mkdir $file . "_files"	unless( -d $file . "_files" );
    # if the summary flag was not set or the directory does not exist
    # generate table main page ( as opposed to the data page )
    # based on pivotfields
    my $fh = FileHandle->new(">$file".".htm")
        or die "Unable to open $file\n";

    printPivotHdr($fh, $title, $file, $rkeys, $summarytype);

    $fh->close;
    $fh->open(">$file".'_files/filelist.xml') or
            die "Unable to open $file _files/filelist.xml\n";
    $filelisttmpl =~ s/CACHENAME/$file/g;
    print $fh $filelisttmpl;
    $fh->close;
}

#-----------------------------------------------------------------------
# this is an internal function that takes each successive row of data
# and puts it in the required format
#
sub addPivotData {
    my $self = shift;
    my $fh = shift;
    my $href = shift;
    my $datarows = shift;
    my $rkeys = shift;
    my $i;

    $self->cleanhash4xml($href); # takes care of escaping characters.
    my @keys = @$rkeys;
    my $key1 = $keys[0];
    my $keyN = $keys[$#keys];
    my @dkeys = keys %$href;
    my %keysh; @keysh{@keys} = @keys;
    map { push @keys, $_ unless(exists $keysh{$_}) }  @dkeys;
    #print "keys: @keys\n";
    my @datacolumns;
    for ($i=1; my $key = shift @keys; $i++) {
        push @datacolumns, qq(Col$i="$href->{$key}");
    }
    print $fh "   \n";
    return $i; # return the column count
}


#-----------------------------------------------------------------------
# this is the top level function. The only one called directly by the
# user.
#
sub makewebpivot {
    #my $self = shift;
    my $self = bless({},'Spreadsheet::WriteExcel::WebPivot');
    my $dbh = shift; my $query = shift;
    my $rquerykeys = shift;
    my $summarytype = shift;
    my $file = shift;
    my $title = shift;

    # the line below allows us to pass in a reference to
    # an array of hash refs and the code will pretend it is a
    # DBI object and fetch each hashref in the array.
    $dbh = Spreadsheet::WriteExcel::WebPivot::FakeDBI->new($dbh) if( ref($dbh) eq 'ARRAY' );

    $self->{SummaryType} = $summarytype;

    my @datarows; my @queries = ();
    if( 'ARRAY' eq ref($query) ) {
        @queries = @$query;
        $query = shift @queries;
    }
    my $sth = $dbh->prepare($query);
    $sth->execute;

    makepivotdir($file,$title,$rquerykeys,$summarytype);

    my $fh = FileHandle->new(">$file"."_files/$file".'_1234_cachedata001.xml');
    die "Unable to open cache\n" unless($fh);

    my $href = $sth->fetchrow_hashref;
    my @pivotfields = $self->getDataTypes($href,$rquerykeys);
    {
        local $/ = undef;  # INPUT SEPARATOR
        local $" = "\n";   # OUTPUT SEPARATOR
        my @ncolumns = (map { qq(    ) }
                    (1..scalar(@pivotfields))
                );
        my @columns;
        map { push @columns,
        qq(   ),
        qq(    {DATATYPE}/>),
        qq(   ); } @pivotfields;
        my $outtext = eval $pivotcachetext;
        print $fh $outtext;
    }
    my $colcount = $self->addPivotData($fh,$href,\@datarows, $rquerykeys);

    # a bit of code gymnastics here to handle an array of query strings
    # if there are multiple query strings we run execute each new query
    # and run the loop again.
    do {
        while( $href = $sth->fetchrow_hashref ) {
            $colcount = $self->addPivotData($fh,$href, \@datarows, $rquerykeys);
        }
        $sth->finish;
    } while( ($query = shift @queries) && ($sth = $dbh->prepare($query)) && $sth->execute );

    print $fh $pivotcachefooter;
    $fh->close;

    #$sth->finish;

} # end makewebpivot


#-----------------------------------------------------------------------
# internal variable initialization
#

$pivotcachetext = q(qq(
 xmlns:dt="uuid:C2F41010-65B3-11d1-A29F-00AA00C14882"
 xmlns:s="uuid:BDC6E3F0-6DA3-11d1-A2A3-00AA00C14882"
 xmlns:rs="urn:schemas-microsoft-com:rowset" xmlns:z="#RowsetSchema">

  1


@ncolumns


@columns


));

$pivotcachefooter = q(



);

$filelisttmpl = q(



  PublicationID="CACHENAME"/>


);

# another "role your own template" function
# printPivotHdr creates the file that serves as the header file for Excel XML
# web objects

sub printPivotHdr {
    my ($fh,$TITLE,$CACHENAME,$rkeys,$SUMMARYTYPE,$NOSUBTOTAL) = @_;
    #print "Summary Type = $SUMMARYTYPE\n";
    if($NOSUBTOTAL) {
        $NOSUBTOTAL = q(<Subtotal>None</Subtotal>
);
    } else { $NOSUBTOTAL = ''; }

    my @pivotfields = @$rkeys;
    my $DATAFIELD = $pivotfields[$#pivotfields];
    my @pivotfieldsloop;
    my ($POS,$FIELDNAME);

    map { $POS++; $FIELDNAME = $_;
    push @pivotfieldsloop, qq(
     <PivotField>
     <Name>$FIELDNAME</Name>
     <Orientation>Row</Orientation>
     $NOSUBTOTAL
     <Position>$POS</Position>
     <PivotItem>
    <Name></Name>
     <Hidden/>
    <HideDetail/>
     </PivotItem>
  </PivotField>
    ); } @pivotfields[0..$#pivotfields-1];

    my $TODAY = strftime '%Y-%m-%d %H:%M:%S', localtime;
    $TODAY =~ s/ /T/;
    $pivothdrtext =~ s/CACHENAME/$CACHENAME/gm;
    $pivothdrtext =~ s/TITLE/$TITLE/gm;
    $pivothdrtext =~ s/TODAY/$TODAY/gm;
    $pivothdrtext =~ s/DATAFIELD/$DATAFIELD/gm;
    $pivothdrtext =~ s/SUMMARYTYPE/$SUMMARYTYPE/gm;
    $pivothdrtext =~ s/PIVOTFIELDSLOOP/@pivotfieldsloop/m;
    print $fh $pivothdrtext;
    #print $fh "@pivotfieldsloop\n";
}

# I appologize in advance for the big, ugly inlined document that follows
# I would have prefered to store this text after the END marker and use
# the  handle to access it but that doesn't work in this module file.

$pivothdrtext = q(
xmlns:x="urn:schemas-microsoft-com:office:excel"
xmlns="http://www.w3.org/TR/REC-html40">

TITLE













 id="CACHENAME_1234_PivotTable"
 classid="CLSID:0002E552-0000-0000-C000-000000000046">
 
352
 xmlns:o="urn:schemas-microsoft-com:office:office"
 xmlns:x="urn:schemas-microsoft-com:office:excel"
 xmlns:html="http://www.w3.org/TR/REC-html40">
 <WorksheetOptions
 xmlns="urn:schemas-microsoft-com:office:excel">
 <Zoom>0</Zoom>
  <Selected/>
 <TopRowVisible>2</TopRowVisible>
 <Panes>
   <Pane>
 <Number>3</Number>
 <RangeSelection>$D:$D</RangeSelection>
 </Pane>
  </Panes>
 <ProtectContents>False</ProtectContents>
 <ProtectObjects>False</ProtectObjects>
 <ProtectScenarios>False</ProtectScenarios>
 </WorksheetOptions>
 <PivotTable
 xmlns="urn:schemas-microsoft-com:office:excel">
 <PTSource>
 <DataMember>XLDataSource</DataMember>
 <CacheIndex>1</CacheIndex>
 <VersionLastRefresh>1</VersionLastRefresh>
 <RefreshName>perlpivot</RefreshName>
 <CacheFile HRef="CACHENAME_files/CACHENAME_1234_cachedata001.xml"/>
 <RefreshDate>TODAY</RefreshDate>
 <RefreshDateCopy>TODAY</RefreshDateCopy>
 </PTSource>
 <Name> TITLE </Name>
 <DataMember>XLDataSource</DataMember>
 <ImmediateItemsOnDrop/>
 <ShowPageMultipleItemLabel/>
 <Location>$A$1:$D$5</Location>
 <VersionLastUpdate>1</VersionLastUpdate>
 <DefaultVersion>1</DefaultVersion>
 <PivotField>
 <Name>DATAFIELD</Name>
 </PivotField>
PIVOTFIELDSLOOP
<PivotField>
   <DataField/>
 <Name>Data</Name>
 <Orientation>Row</Orientation>
 <Position>-1</Position>
 </PivotField>
<PivotField>
 <Name>SUMMARYTYPE of DATAFIELD</Name>
 <ParentField>DATAFIELD</ParentField>
 <NumberFormat>#,##0</NumberFormat>
 <Orientation>Data</Orientation>
 <Function>SUMMARYTYPE</Function>
 <Position>1</Position>
 </PivotField>
  <PTFormat
 Style='mso-number-format:"\#\,\#\#0"'>
 <PTRule>
 <RuleType>DataOnly</RuleType>
 </PTRule>
  </PTFormat>
  <PTFormat
 Style='mso-number-format:"\#\,\#\#0"'>
 <PTRule>
 <RuleType>Blanks</RuleType>
 </PTRule>
  </PTFormat>
 </PivotTable>
</xml><![endif]-->">
 style='margin-top:100;font-family:Arial;font-size:8.0pt'>To use this Web
 page interactively, you must have Microsoft Internet Explorer 4.01 Service
 Pack 1 (SP1) or later and the Microsoft Office XP Web Components.
 See the
 href="http://office.microsoft.com/office/redirect/10/MSOWCPub.asp?HelpLCID=1033">Microsoft
 Office Web site for more information.







);

package Spreadsheet::WriteExcel::WebPivot::FakeDBI;

# the constructor
sub new {
    my $class = shift;
    my $arg = shift;
    if( defined($arg) and ref($arg) eq 'ARRAY' ) {
        bless($arg); # I don't expect anyone to ever inherit from this
    } else {
        $arg = [];
        bless($arg);
    }
    return $arg;
}

sub prepare {
    my $self = shift;
    return $self;
}

sub execute {
}

sub finish {
}

sub fetchrow_hashref {
    my $self = shift;
    return shift @$self;
}

# Autoload methods go after =cut, and are processed by the autosplit program.

1;

__END__