File Coverage

blib/lib/Spreadsheet/WriteExcel/WebPivot.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package Spreadsheet::WriteExcel::WebPivot;

use strict;
use warnings;
use DBI;		# DBI doesn't seem to be core in ActivePerl
use FileHandle;
use Switch;   # Switch is not core in ActivePerl
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 = 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">
 
341
 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 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__