1#!/usr/bin/perl -w
2
3#######################################################################
4#
5# chartex - A utility to extract charts from an Excel file for
6# insertion into a Spreadsheet::WriteExcel file.
7#
8# reverse('�'), September 2007, John McNamara, jmcnamara@cpan.org
9#
10# Documentation after __END__
11#
12
13
14use strict;
15use OLE::Storage_Lite;
16use Getopt::Long;
17use Pod::Usage;
18
19
20my $man         = 0;
21my $help        = 0;
22my $in_chart    = 0;
23my $chart_name  = 'chart';
24my $chart_index = 1;
25my $sheet_index = -1;
26my @sheetnames;
27my @exrefs;
28my $depth_count = 0;
29my $max_font    = 0;
30
31#
32# Do the Getopt and Pod::Usage routines.
33#
34GetOptions(
35            'help|?'    => \$help,
36            'man'       => \$man,
37            'chart=s'   => \$chart_name,
38          ) or pod2usage(2);
39
40pod2usage(1) if $help;
41pod2usage(-verbose => 2) if $man;
42
43
44# From the Pod::Usage pod:
45# If no arguments were given, then allow STDIN to be used only
46# if it's not connected to a terminal (otherwise print usage)
47pod2usage() if @ARGV == 0 && -t STDIN;
48
49
50
51
52# Check that the file can be opened because OLE::Storage_Lite won't tell us.
53# Possible race condition here. Could fix with latest OLE::Storage_Lite. TODO.
54#
55my $file = $ARGV[0];
56
57open  TMP, $file or die "Couldn't open $file. $!\n";
58close TMP;
59
60my $ole      = OLE::Storage_Lite->new($file);
61my $book97   = pack 'v*', unpack 'C*', 'Workbook';
62my $workbook = ($ole->getPpsSearch([$book97], 1, 1))[0];
63
64die "Couldn't find Excel97 data in file $file.\n" unless $workbook;
65
66
67# Write the data to a file so that we can access it with read().
68my $tmpfile = IO::File->new_tmpfile();
69binmode $tmpfile;
70
71my $biff = $workbook->{Data};
72print {$tmpfile} $biff;
73seek $tmpfile, 0, 0;
74
75
76
77my $header;
78my $data;
79
80# Read the file record by record and look for a chart BOF record.
81#
82while (read $tmpfile, $header, 4) {
83
84    my ($record, $length) = unpack "vv", $header;
85    next unless $record;
86
87    read $tmpfile, $data, $length;
88
89    # BOUNDSHEET
90    if ($record == 0x0085) {
91        push @sheetnames, substr $data, 8;
92    }
93
94    # EXTERNSHEET
95    if ($record == 0x0017) {
96        my $count = unpack 'v', $data;
97
98        for my $i (1 .. $count) {
99            my @tmp = unpack 'vvv', substr($data, 2 +6*($i-1));
100            push @exrefs, [@tmp];
101        }
102
103    }
104
105    # BOF
106    if ($record == 0x0809) {
107        my $type = unpack 'xx v', $data;
108
109        if ($type == 0x0020) {
110            my $filename = sprintf "%s%02d.bin", $chart_name, $chart_index;
111            open    CHART, ">$filename" or die "Couldn't open $filename: $!";
112            binmode CHART;
113
114            my $sheet_name = $sheetnames[$sheet_index];
115            $sheet_name .= ' embedded' if $depth_count;
116
117            printf "\nExtracting \%s\ to %s", $sheet_name, $filename;
118            $in_chart = 1;
119            $chart_index++;
120        }
121        $depth_count++;
122    }
123
124
125    # FBI, Chart fonts
126    if ($record == 0x1060) {
127
128        my $index = substr $data, 8, 2, '';
129           $index = unpack 'v', $index;
130
131        # Ignore the inbuilt fonts.
132        if ($index >= 5) {
133            $max_font = $index if $index > $max_font;
134
135            # Shift index past S::WE fonts
136            $index += 2;
137        }
138
139        $data .= pack 'v', $index;
140    }
141
142    # FONTX, Chart fonts
143    if ($record == 0x1026) {
144
145        my $index = unpack 'v', $data;
146
147        # Ignore the inbuilt fonts.
148        if ($index >= 5) {
149            $max_font = $index if $index > $max_font;
150
151            # Shift index past S::WE fonts
152            $index += 2;
153        }
154
155        $data = pack 'v', $index;
156    }
157
158
159
160    if ($in_chart) {
161        print CHART $header, $data;
162    }
163
164
165    # EOF
166    if ($record == 0x000A) {
167            $in_chart = 0;
168            $depth_count--;
169            $sheet_index++ if $depth_count == 0;
170;
171    }
172}
173
174
175if ($chart_index > 1) {
176    print "\n\n";
177    print "Add the following near the start of your program\n";
178    print "and change the variable names if required.\n\n";
179}
180else {
181    print "\nNo charts found in workbook\n";
182}
183
184for my $aref (@exrefs) {
185    my $sheet1 = $sheetnames[$aref->[1]];
186    my $sheet2 = $sheetnames[$aref->[2]];
187
188    my $range;
189
190    if ($sheet1 ne $sheet2) {
191        $range = $sheet1 . ":" .  $sheet2;
192    }
193    else {
194        $range = $sheet1;
195    }
196
197    $range = "'$range'" if $range =~ /[^\w:]/;
198
199    print "    \$worksheet->store_formula('=$range!A1');\n";
200}
201
202print "\n";
203
204for my $i (5 .. $max_font) {
205
206    printf "    my \$chart_font_%d = \$workbook->add_format(font_only => 1);\n",
207                $i -4;
208
209}
210
211
212
213
214
215__END__
216
217
218=head1 NAME
219
220chartex - A utility to extract charts from an Excel file for insertion into a Spreadsheet::WriteExcel file.
221
222=head1 DESCRIPTION
223
224This program is used for extracting one or more charts from an Excel file in binary format. The charts can then be included in a C<Spreadsheet::WriteExcel> file.
225
226See the C<add_chart_ext()> section of the  Spreadsheet::WriteExcel documentation for more details.
227
228
229=head1 SYNOPSIS
230
231chartex [--chartname --help --man] file.xls
232
233    Options:
234        --chartname -c  The root name for the extracted charts,
235                        defaults to "chart".
236
237
238=head1 OPTIONS
239
240=over 4
241
242=item B<--chartname or -c>
243
244This sets the root name for the extracted charts, defaults to "chart". For example:
245
246    $ chartex file.xls
247
248    Extracting "Chart1" to chart01.bin
249
250
251    $ chartex -c mychart file.xls
252
253    Extracting "Chart1" to mychart01.bin
254
255=item B<--help or -h>
256
257Print a brief help message and exits.
258
259
260=item B<--man or -m>
261
262Prints the manual page and exits.
263
264=back
265
266
267=head1 AUTHOR
268
269John McNamara jmcnamara@cpan.org
270
271
272=head1 VERSION
273
274Version 0.02.
275
276
277=head1 COPYRIGHT
278
279� MMV, John McNamara.
280
281All Rights Reserved. This program is free software. It may be used, redistributed and/or modified under the same terms as Perl itself.
282
283
284=cut
285