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


line stmt bran cond sub pod time code
1             package Spreadsheet::WriteExcel::WebPivot;
2            
3 1     1   17406 use strict;
  1         1  
  1         33  
4 1     1   4 use warnings;
  1         0  
  1         22  
5 1     1   182 use DBI; # DBI doesn't seem to be core in ActivePerl
  0            
  0            
6             use FileHandle;
7             use Switch; # Switch is not core in ActivePerl
8             use POSIX 'strftime';
9            
10             our(@ISA, @EXPORT);
11             sub makewebpivot;
12            
13             use Exporter 'import';
14             @EXPORT = qw(makewebpivot);
15            
16             our $VERSION = '0.01';
17            
18             #-----------------------------------------------------------------------
19             # not needed or even that useful anymore now that we are exporting the
20             # main function
21             #
22             sub new {
23             my $class = shift;
24             $class = ref($class) if (ref($class));
25            
26             my $self = {
27             };
28             bless($self, $class);
29             return $self;
30             }
31            
32            
33             # these four variables are for storing large amounts of text for
34             # a home-brew template system. The Template Toolkit is much better
35             # but I wanted to reduce module dependencies
36            
37             my ($pivotcachetext, $pivotcachefooter,$pivothdrtext,$filelisttmpl);
38            
39             #-----------------------------------------------------------------------
40             # this function is an internal function that does the proper xml
41             # escaping for hash references containing
42             # data that needs to be output as xml
43            
44             sub cleanhash4xml {
45             my $self = shift; # get class thingy
46             my $rhsh = shift;
47             return unless(defined($rhsh));
48             my @keys = keys %$rhsh;
49             # the line below takes care of uninitialized data errors
50             map {(!exists($rhsh->{$_}) or !defined($rhsh->{$_})) ? $rhsh->{$_} = ' ': 1} @keys;
51             map ($rhsh->{$_} =~ s/\&/\&/g, @keys);
52             map ($rhsh->{$_} =~ s/"/\"/g, @keys);
53             map ($rhsh->{$_} =~ s/
54             map ($rhsh->{$_} =~ s/>/\>/g, @keys);
55             map ($rhsh->{$_} =~ s/[^[:alnum:][:punct:] ]//g, @keys);
56             if( defined($self->{types}) ) {
57             foreach my $key (@keys) {
58             #die "dead #".$rhsh->{$key} . "#\n" if( 'Tier' eq $key and !($rhsh->{$key} =~ /\w/));
59             if(!defined($rhsh->{$key}) or !($rhsh->{$key} =~ /\w/)) {
60             if( $self->{types}->{$key} eq 'text' ) {
61             $rhsh->{$key} = 'none';
62             } else {
63             $rhsh->{$key} = "0";
64             }
65             }
66             }
67             }
68             }
69            
70            
71             #-----------------------------------------------------------------------
72             sub cleanArray4xml {
73             shift; # get class thingy
74             my $rarr = shift;
75             # the line below takes care of uninitialized data errors
76             map {defined($_) ? $_ : ''} @$rarr;
77             map (s/\&/\&/g, @$rarr);
78             map (s/"/\"/g, @$rarr);
79             map (s/
80             map (s/>/\>/g, @$rarr);
81             map (s/[^[:alnum:][:punct:] ]//g, @$rarr);
82             }
83            
84            
85            
86             #-----------------------------------------------------------------------
87             sub getDataTypes {
88             my $self = shift;
89             my $href = shift;
90             my $rkeys = shift;
91             my @keys = @$rkeys;
92             my $type; my $typename;
93             my @pivotfields;
94             my $i = 1;
95             my @dkeys = keys %$href;
96             my %keysh; @keysh{@keys} = @keys;
97             map { push @keys, $_ unless(exists $keysh{$_}) } @dkeys;
98             foreach my $key (@keys) {
99             die "$key not defined\n" unless(defined $href->{$key});
100             switch ($href->{$key}) {
101             case /^\d+$/ { $type = q(type="int");
102             $typename = 'int'; }
103             case /^\d+\.\d+$/ { $type = q(type="float");
104             $typename = 'float'; }
105             case qr/^\d{4}\-\d{2}\-\d{2}/ { $type = q(type="dateTime"); $typename = 'dateTime'; }
106             else { $type = q(maxLength="255");
107             $typename = 'text'; }
108             }
109             push @pivotfields, {FIELDNAME=>$key, COLNUM=>$i++, DATATYPE=>$type};
110             $self->{types}->{$key} = $typename;
111             }
112             return @pivotfields;
113             }
114            
115             #-----------------------------------------------------------------------
116             # this function sets up the subdirectory required by Excel's web object
117             #
118             sub makepivotdir {
119             my $file = shift;
120             my $title = shift;
121             my $rkeys = shift;
122             my $summarytype = shift;
123            
124             mkdir $file . "_files" unless( -d $file . "_files" );
125             # if the summary flag was not set or the directory does not exist
126             # generate table main page ( as opposed to the data page )
127             # based on pivotfields
128             my $fh = FileHandle->new(">$file".".htm")
129             or die "Unable to open $file\n";
130            
131             printPivotHdr($fh, $title, $file, $rkeys, $summarytype);
132            
133             $fh->close;
134             $fh->open(">$file".'_files/filelist.xml') or
135             die "Unable to open $file _files/filelist.xml\n";
136             $filelisttmpl =~ s/CACHENAME/$file/g;
137             print $fh $filelisttmpl;
138             $fh->close;
139             }
140            
141             #-----------------------------------------------------------------------
142             # this is an internal function that takes each successive row of data
143             # and puts it in the required format
144             #
145             sub addPivotData {
146             my $self = shift;
147             my $fh = shift;
148             my $href = shift;
149             my $datarows = shift;
150             my $rkeys = shift;
151             my $i;
152            
153             $self->cleanhash4xml($href); # takes care of escaping characters.
154             my @keys = @$rkeys;
155             my $key1 = $keys[0];
156             my $keyN = $keys[$#keys];
157             my @dkeys = keys %$href;
158             my %keysh; @keysh{@keys} = @keys;
159             map { push @keys, $_ unless(exists $keysh{$_}) } @dkeys;
160             #print "keys: @keys\n";
161             my @datacolumns;
162             for ($i=1; my $key = shift @keys; $i++) {
163             push @datacolumns, qq(Col$i="$href->{$key}");
164             }
165             print $fh " \n";
166             return $i; # return the column count
167             }
168            
169            
170             #-----------------------------------------------------------------------
171             # this is the top level function. The only one called directly by the
172             # user.
173             #
174             sub makewebpivot {
175             #my $self = shift;
176             my $self = bless({},'Spreadsheet::WriteExcel::WebPivot');
177             my $dbh = shift; my $query = shift;
178             my $rquerykeys = shift;
179             my $summarytype = shift;
180             my $file = shift;
181             my $title = shift;
182            
183             # the line below allows us to pass in a reference to
184             # an array of hash refs and the code will pretend it is a
185             # DBI object and fetch each hashref in the array.
186             $dbh = FakeDBI->new($dbh) if( ref($dbh) eq 'ARRAY' );
187            
188             $self->{SummaryType} = $summarytype;
189            
190             my @datarows; my @queries = ();
191             if( 'ARRAY' eq ref($query) ) {
192             @queries = @$query;
193             $query = shift @queries;
194             }
195             my $sth = $dbh->prepare($query);
196             $sth->execute;
197            
198             makepivotdir($file,$title,$rquerykeys,$summarytype);
199            
200             my $fh = FileHandle->new(">$file"."_files/$file".'_1234_cachedata001.xml');
201             die "Unable to open cache\n" unless($fh);
202            
203             my $href = $sth->fetchrow_hashref;
204             my @pivotfields = $self->getDataTypes($href,$rquerykeys);
205             {
206             local $/ = undef; # INPUT SEPARATOR
207             local $" = "\n"; # OUTPUT SEPARATOR
208             my @ncolumns = (map { qq( ) }
209             (1..scalar(@pivotfields))
210             );
211             my @columns;
212             map { push @columns,
213             qq( ),
214             qq( {DATATYPE}/>),
215             qq( ); } @pivotfields;
216             my $outtext = eval $pivotcachetext;
217             print $fh $outtext;
218             }
219             my $colcount = $self->addPivotData($fh,$href,\@datarows, $rquerykeys);
220            
221             # a bit of code gymnastics here to handle an array of query strings
222             # if there are multiple query strings we run execute each new query
223             # and run the loop again.
224             do {
225             while( $href = $sth->fetchrow_hashref ) {
226             $colcount = $self->addPivotData($fh,$href, \@datarows, $rquerykeys);
227             }
228             $sth->finish;
229             } while( ($query = shift @queries) && ($sth = $dbh->prepare($query)) && $sth->execute );
230            
231             print $fh $pivotcachefooter;
232             $fh->close;
233            
234             #$sth->finish;
235            
236             } # end makewebpivot
237            
238            
239             #-----------------------------------------------------------------------
240             # internal variable initialization
241             #
242            
243             $pivotcachetext = q(qq(
244             xmlns:dt="uuid:C2F41010-65B3-11d1-A29F-00AA00C14882"
245             xmlns:s="uuid:BDC6E3F0-6DA3-11d1-A2A3-00AA00C14882"
246             xmlns:rs="urn:schemas-microsoft-com:rowset" xmlns:z="#RowsetSchema">
247            
248             1
249            
250            
251             @ncolumns
252            
253            
254             @columns
255            
256            
257             ));
258            
259             $pivotcachefooter = q(
260            
261            
262            
263             );
264            
265             $filelisttmpl = q(
266            
267            
268            
269             PublicationID="CACHENAME"/>
270            
271            
272             );
273            
274             # another "role your own template" function
275             # printPivotHdr creates the file that serves as the header file for Excel XML
276             # web objects
277            
278             sub printPivotHdr {
279             my ($fh,$TITLE,$CACHENAME,$rkeys,$SUMMARYTYPE,$NOSUBTOTAL) = @_;
280             #print "Summary Type = $SUMMARYTYPE\n";
281             if($NOSUBTOTAL) {
282             $NOSUBTOTAL = q(<Subtotal>None</Subtotal> );
283             } else { $NOSUBTOTAL = ''; }
284            
285             my @pivotfields = @$rkeys;
286             my $DATAFIELD = $pivotfields[$#pivotfields];
287             my @pivotfieldsloop;
288             my ($POS,$FIELDNAME);
289            
290             map { $POS++; $FIELDNAME = $_;
291             push @pivotfieldsloop, qq(
292             <PivotField>
293             <Name>$FIELDNAME</Name>
294             <Orientation>Row</Orientation>
295             $NOSUBTOTAL
296             <Position>$POS</Position>
297             <PivotItem> <Name></Name>
298             <Hidden/> <HideDetail/>
299             </PivotItem> </PivotField>
300             ); } @pivotfields[0..$#pivotfields-1];
301            
302             my $TODAY = strftime '%Y-%m-%d %H:%M:%S', localtime;
303             $TODAY =~ s/ /T/;
304             $pivothdrtext =~ s/CACHENAME/$CACHENAME/gm;
305             $pivothdrtext =~ s/TITLE/$TITLE/gm;
306             $pivothdrtext =~ s/TODAY/$TODAY/gm;
307             $pivothdrtext =~ s/DATAFIELD/$DATAFIELD/gm;
308             $pivothdrtext =~ s/SUMMARYTYPE/$SUMMARYTYPE/gm;
309             $pivothdrtext =~ s/PIVOTFIELDSLOOP/@pivotfieldsloop/m;
310             print $fh $pivothdrtext;
311             #print $fh "@pivotfieldsloop\n";
312             }
313            
314             # I appologize in advance for the big, ugly inlined document that follows
315             # I would have prefered to store this text after the END marker and use
316             # the handle to access it but that doesn't work in this module file.
317            
318             $pivothdrtext = q(
319             xmlns:x="urn:schemas-microsoft-com:office:excel"
320             xmlns="http://www.w3.org/TR/REC-html40">
321            
322             TITLE
323            
324            
325            
326            
327            
328            
329            
330            
332            
334            
335            
336            
337            
338             id="CACHENAME_1234_PivotTable"
339             classid="CLSID:0002E552-0000-0000-C000-000000000046">
340             341             xmlns:o="urn:schemas-microsoft-com:office:office"
342             xmlns:x="urn:schemas-microsoft-com:office:excel"
343             xmlns:html="http://www.w3.org/TR/REC-html40">
344             <WorksheetOptions
345             xmlns="urn:schemas-microsoft-com:office:excel">
346             <Zoom>0</Zoom> <Selected/>
347             <TopRowVisible>2</TopRowVisible>
348             <Panes> <Pane>
349             <Number>3</Number>
350             <RangeSelection>$D:$D</RangeSelection>
351             </Pane> </Panes>
352             <ProtectContents>False</ProtectContents>
353             <ProtectObjects>False</ProtectObjects>
354             <ProtectScenarios>False</ProtectScenarios>
355             </WorksheetOptions> <PivotTable
356             xmlns="urn:schemas-microsoft-com:office:excel">
357             <PTSource>
358             <DataMember>XLDataSource</DataMember>
359             <CacheIndex>1</CacheIndex>
360             <VersionLastRefresh>1</VersionLastRefresh>
361             <RefreshName>perlpivot</RefreshName>
362             <CacheFile HRef="CACHENAME_files/CACHENAME_1234_cachedata001.xml"/>
363             <RefreshDate>TODAY</RefreshDate>
364             <RefreshDateCopy>TODAY</RefreshDateCopy>
365             </PTSource>
366             <Name> TITLE </Name>
367             <DataMember>XLDataSource</DataMember>
368             <ImmediateItemsOnDrop/>
369             <ShowPageMultipleItemLabel/>
370             <Location>$A$1:$D$5</Location>
371             <VersionLastUpdate>1</VersionLastUpdate>
372             <DefaultVersion>1</DefaultVersion>
373             <PivotField>
374             <Name>DATAFIELD</Name>
375             </PivotField>
376             PIVOTFIELDSLOOP
377             <PivotField> <DataField/>
378             <Name>Data</Name>
379             <Orientation>Row</Orientation>
380             <Position>-1</Position>
381             </PivotField>
382             <PivotField>
383             <Name>SUMMARYTYPE of DATAFIELD</Name>
384             <ParentField>DATAFIELD</ParentField>
385             <NumberFormat>#,##0</NumberFormat>
386             <Orientation>Data</Orientation>
387             <Function>SUMMARYTYPE</Function>
388             <Position>1</Position>
389             </PivotField> <PTFormat
390             Style='mso-number-format:"\#\,\#\#0"'>
391             <PTRule>
392             <RuleType>DataOnly</RuleType>
393             </PTRule> </PTFormat> <PTFormat
394             Style='mso-number-format:"\#\,\#\#0"'>
395             <PTRule>
396             <RuleType>Blanks</RuleType>
397             </PTRule> </PTFormat>
398             </PivotTable> </xml><![endif]-->">

399             style='margin-top:100;font-family:Arial;font-size:8.0pt'>To use this Web
400             page interactively, you must have Microsoft® Internet Explorer 4.01 Service
401             Pack 1 (SP1) or later and the Microsoft Office XP Web Components.

402            

See the

403             href="http://office.microsoft.com/office/redirect/10/MSOWCPub.asp?HelpLCID=1033">Microsoft
404             Office Web site for more information.

405            
406            
407            
408            
409            
410            
411            
412             );
413            
414             package FakeDBI;
415            
416             # the constructor
417             sub new {
418             my $class = shift;
419             my $arg = shift;
420             if( defined($arg) and ref($arg) eq 'ARRAY' ) {
421             bless($arg); # I don't expect anyone to ever inherit from this
422             } else {
423             $arg = [];
424             bless($arg);
425             }
426             return $arg;
427             }
428            
429             sub prepare {
430             my $self = shift;
431             return $self;
432             }
433            
434             sub execute {
435             }
436            
437             sub finish {
438             }
439            
440             sub fetchrow_hashref {
441             my $self = shift;
442             return shift @$self;
443             }
444            
445             # Autoload methods go after =cut, and are processed by the autosplit program.
446            
447             1;
448            
449             __END__