File Coverage

blib/lib/Spreadsheet/TieExcel.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             package Spreadsheet::TieExcel;
2            
3             our $VERSION = '0.75';
4             our $DEBUG = 1;
5            
6 1     1   642 use strict;
  1         2  
  1         32  
7 1     1   5 use warnings;
  1         2  
  1         22  
8 1     1   5 no warnings qw(uninitialized);
  1         3  
  1         24  
9            
10 1     1   4 use Carp;
  1         1  
  1         74  
11            
12 1     1   1496 use Win32::OLE;
  0            
  0            
13             $Win32::OLE::Warn = 3;
14            
15             our $xl;
16            
17             sub BEGIN {
18             #============================================================
19             # Check Excel is open and there is an active spreadsheet
20             #============================================================
21             $xl = Win32::OLE->GetActiveObject('Excel.Application') or
22             croak "Couldn't find an active Excel application";
23            
24             $xl->Workbooks->Count or
25             croak "Couldn't find an active sheet";
26             }
27            
28             sub getRange {
29             my $range = shift;
30            
31             #============================================================
32             # Returns an Excel range, whatever you pass to it
33             #============================================================
34            
35             #++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
36             # No range? return current selection
37             #++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
38            
39             unless ($range) {
40             return $xl->Selection ||
41             croak "No valid Excel range";
42             }
43            
44             #++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
45             # Got a range: let's check what it is
46             #++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
47            
48             my ($row, $col, $sheet, $width, $height);
49            
50             for (ref $range) {
51             #--------------------------------------------------
52             # a proper range
53             #--------------------------------------------------
54             /^Win32::OLE$/ && do {
55             unless ((join '::', Win32::OLE->QueryObjectType($range)) eq 'Excel::Range') {
56             croak "Doesn't look like a range";
57             } else {
58             return $range;
59             }
60             };
61             #--------------------------------------------------
62             # an array
63             #--------------------------------------------------
64             /^ARRAY$/ && do {
65             ($row, $col, $sheet) = @{$range};
66             };
67             #--------------------------------------------------
68             # a hash
69             #--------------------------------------------------
70             /^HASH$/ && do {
71             $row = $range->{row} || $range->{start_row};
72             $col = $range->{column} ||
73             $range->{col} ||
74             $range->{start_col} ||
75             $range->{start_column};
76            
77             $width = $range->{width}; $width-- if $width;
78             $height = $range->{height}; $height-- if $height;
79             $sheet = $range->{sheet} || $range->{worksheet};
80             };
81             #--------------------------------------------------
82             # a scalar
83             #--------------------------------------------------
84             /^$/ && do {
85             $row = $range;
86             ($col, $sheet) = @_;
87             };
88             }
89            
90             #++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
91             # a lot of checking
92             #++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
93             croak "Row '$row', column '$col' is not a valid address"
94             if (($col <= 0) || ($row <= 0));
95            
96             my $ws;
97             if ($sheet) {
98             croak "Worksheet $sheet not found"
99             unless eval { $ws = $xl->ActiveWorkbook->Worksheets($sheet) };
100             } else {
101             croak "No worksheet not found"
102             unless eval { $ws = $xl->ActiveSheet };
103             }
104            
105             return $ws->Range($ws->Cells($row, $col), $ws->Cells($row + $height, $col + $width));
106             }
107            
108             sub getBook {
109             my $xl = Win32::OLE->GetActiveObject('Excel.Application') or
110             croak "Couldn't find an active Excel application";
111            
112             return $xl->ActiveWorkbook
113             || croak "No active workbook found";
114             }
115            
116            
117             {
118            
119             package Spreadsheet::TieExcel::Array;
120            
121             use strict;
122             use Carp;
123            
124             use Spreadsheet::TieExcel;
125            
126             sub TIEARRAY {
127             my $class = shift;
128             my $range = Spreadsheet::TieExcel::getRange(shift);
129            
130             return bless {
131             SEL => $range
132             }, $class;
133             }
134            
135             sub STORE {
136             my($self, $idx, $value) = @_;
137            
138             return $self->{SEL}->Cells($idx + 1)->{Value} = $value;
139             }
140            
141             sub FETCH {
142             my($self, $idx) = @_;
143             return $self->{SEL}->Cells($idx + 1)->{Value};
144             }
145            
146             sub FETCHSIZE {
147             my($self) = @_;
148            
149             $self->{SEL}->Cells->Count
150             }
151            
152             sub STORESIZE {
153             carp "Can't resize Excel array";
154             }
155            
156             1;
157            
158             }
159            
160            
161            
162             {
163            
164             package Spreadsheet::TieExcel::File;;
165            
166             use Carp;
167             use strict;
168            
169             use Spreadsheet::TieExcel;
170            
171             sub TIEHANDLE {
172             my $class = shift;
173             my $range = Spreadsheet::TieExcel::getRange(shift);
174            
175             return bless {
176             rows => $range->Rows->Count,
177             cols => $range->Columns->Count,
178             start => $range->Row,
179             rrow => 0,
180             frow => $range->Row,
181             prow => $range->Row - 1,
182             fcol => $range->Column,
183             lcol => $range->Column + $range->Columns->Count - 1,
184             sheet => $range->Worksheet
185             }, $class
186             }
187            
188             sub READLINE {
189             my $self = shift;
190            
191             if ($self->{rrow} < $self->{rows}) {
192            
193             $self->{rrow}++;
194             if ($self->{cols} > 1) {
195             return wantarray ?
196             @{$self->{sheet}->Range(
197             $self->{sheet}->Cells($self->{frow} + $self->{rrow} - 1, $self->{fcol}),
198             $self->{sheet}->Cells($self->{frow} + $self->{rrow} - 1, $self->{lcol}),
199             )->{Value}->[0]}
200             :
201             $self->{sheet}->Range(
202             $self->{sheet}->Cells($self->{frow} + $self->{rrow} - 1, $self->{fcol}),
203             $self->{sheet}->Cells($self->{frow} + $self->{rrow} - 1, $self->{lcol}),
204             )->{Value}->[0];
205             } else {
206             return $self->{sheet}->Cells($self->{frow} + $self->{rrow} - 1, $self->{fcol})->{Value};
207             }
208             } else {
209             return;
210             }
211             }
212            
213             sub PRINT {
214             my $self = shift;
215             my $ro = $#_;
216            
217             $self->{prow}++;
218             $self->{sheet}->Range(
219             $self->{sheet}->Cells($self->{prow}, $self->{fcol}),
220             $self->{sheet}->Cells($self->{prow}, $self->{fcol})->Offset(0, $ro),
221             )->{Value} = [@_];
222             }
223            
224            
225             sub DESTROY {
226             my $self = shift;
227             $self = undef;
228             Win32::OLE->Uninitialize;
229             }
230            
231             1;
232            
233             }
234            
235             {
236            
237             package Spreadsheet::TieExcel::Scalar;
238            
239             use Carp;
240             use strict;
241            
242             use Spreadsheet::TieExcel;
243            
244             sub TIESCALAR {
245             my $class = shift;
246             my $range = Spreadsheet::TieExcel::getRange(@_);
247             return bless {
248             range => $range,
249             application => $range->Application,
250             sheet => $range->Worksheet
251             }, $class
252             }
253            
254             sub FETCH {
255             my $self = shift;
256            
257             return $self->{range}->{value};
258             }
259            
260             sub STORE {
261             my $self = shift;
262             my $value = shift;
263            
264             return $self->{range}->{value} = $value;
265             }
266            
267             sub DESTROY {
268             my $self = shift;
269             $self = undef;
270             Win32::OLE->Uninitialize;
271             }
272            
273             #######################################################################
274             # Experimental part
275             #######################################################################
276            
277             use overload
278             '>>' => sub { shift->move(0, shift) },
279             '<<' => sub { shift->move(0, -shift) },
280             '++' => sub { shift->move(1, 0) },
281             '--' => sub { shift->move(-1, 0) },
282            
283             '+' => sub { shift->move(shift, 0) },
284             '-' => sub { shift->move(-shift, 0) };
285            
286             sub _tor_move {
287             my ($row, $move, $max) = @_;
288             return (((($row - 1) + $move) % $max) + 1);
289            
290             }
291            
292             sub move {
293             my $self = shift;
294            
295             my ($row, $col);
296            
297             $row = &_tor_move ($self->{range}->Row, $_[0], $self->{range}->Worksheet->Rows->Count);
298             $col = &_tor_move ($self->{range}->Column, $_[1], $self->{range}->Worksheet->Columns->Count);
299            
300             $self->{range} = $self->{range}->Worksheet->Cells($row, $col);
301             }
302            
303             sub set {
304             my $self = shift;
305             my $val = pop @_;
306             eval '$self->{range}->{' . (join '}->{', @_) . '} = $val';
307             }
308            
309             sub row {
310             my $self = shift;
311             if (my $row = shift) {
312             $self->{sheet}->Cells($row, $self->column)->Select;
313             $self->{range} = $self->{application}->Selection;
314             } else {
315             return $self->{range}->{row};
316             }
317             }
318            
319             sub column {
320             my $self = shift;
321             if (my $col = shift) {
322             $self->{sheet}->Cells($self->row, $col)->Select;
323             $self->{range} = $self->{application}->Selection;
324             } else {
325             return $self->{range}->{column};
326             }
327             }
328            
329             our $AUTOLOAD;
330            
331             sub AUTOLOAD {
332             my $self = shift;
333            
334             my $type = ref($self)
335             or croak "$self is not an object";
336            
337             return if $AUTOLOAD =~ /::DESTROY$/;
338            
339             my $name = $AUTOLOAD;
340             $name =~ s/(.+)::(.+)$/$2/;
341            
342             if (@_) {
343             return $self->{range}->{$name} = $_[0];
344             } else {
345             return $self->{range}->{$name};
346             }
347             }
348            
349             1;
350            
351             }
352            
353             {
354            
355             package Spreadsheet::TieExcel::Hash;
356            
357             use strict;
358             use Carp;
359            
360             use Spreadsheet::TieExcel;
361            
362             sub TIEHASH {
363             my $class = shift;
364            
365             my $wb = Spreadsheet::TieExcel::getBook;
366             my $self = bless {
367             book => $wb,
368             list => {}
369             }, $class;
370            
371             for (1..$self->{book}->Names->Count) {
372             my $name = $self->{book}->Names($_)->Name;
373             $self->{list}->{$name} = $self->{book}->Names($_)->RefersToRange;
374             }
375             return $self;
376             }
377            
378             sub FETCH {
379             my $self = shift;
380             my $name = shift;
381             if ($self->exists($name)) {
382             return $self->names($name)->{Value};
383             } else {
384             }
385             }
386            
387             sub STORE {
388             my $self = shift;
389             my ($name, $value) = @_;
390            
391             if ($self->exists($name)) {
392             $self->names($name)->{Value} = $value;
393             } else {
394             my $range = Spreadsheet::TieExcel::getRange($value);
395             $self->add($name, $range);
396             }
397             }
398            
399             sub DELETE {
400             my $self = shift;
401             my $name = shift;
402             return $self->delete($name);
403             }
404            
405             sub CLEAR {
406             }
407            
408             sub EXISTS {
409             return shift->exists(shift);
410             }
411            
412             sub FIRSTKEY {
413             my $self = shift;
414            
415             $a = keys %{ $self->names };
416             return each %{ $self->names }
417             }
418            
419             sub NEXTKEY {
420             my $self = shift;
421             return each %{ $self->names }
422             }
423            
424             sub exists {
425             my $self = shift;
426             my $name = shift;
427             return $self->names->{$name}
428             }
429            
430             sub length {
431             return scalar keys %{ shift->names };
432             }
433            
434             sub names {
435             my $self = shift;
436             my $name = shift;
437             for (1..$self->{book}->Names->Count) {
438             my $name = $self->{book}->Names($_)->Name;
439             $self->{list}->{$name} = $self->{book}->Names($_)->RefersToRange;
440             $self->{book}->Names($_)->RefersToRange;
441             }
442             return $name ? $self->{list}->{$name} : $self->{list};
443             }
444            
445             sub delete {
446             my $self = shift;
447             my $name = shift;
448            
449             if ($self->exists($name)) {
450             delete $self->names->{$name};
451             return $self->{book}->Names($name)->Delete;
452             }
453             }
454            
455             sub add {
456             my $self = shift;
457             my ($name, $range, $value) = @_;
458            
459             my $address = $range->Address(1, 1, 1, 1);
460             $address =~ /\](.+)/; $address = $1;
461             if (eval { $self->{book}->Names->Add({Name => $name, RefersTo => "=$address"}) }) {
462             $self->names->{$name} = $range;
463             } else {
464             carp "Could not add name referring to range $address";
465             }
466            
467             }
468            
469             1
470            
471             }