package ExcelPerl; use warnings; use strict; use Carp qw(croak); our $VERSION = 0.10; # use Readonly; # better not, since Readonly is no standard module yet use Win32::OLE; use Win32::OLE::Const 'Microsoft Excel'; use Win32::OLE::Variant; Win32::OLE->Option( Warn => 3); use vars qw( @ObjInterfaceMethods @F ); # which object interface methods shell be available as standard #Readonly::Array: Readonly is not yet a standard module :-( @ObjInterfaceMethods = qw( excelFile excel workBook worksheet colSeparator worksheetNumber currentRow lastRow maxCol changeCount ); # install object interface methods at startup foreach my $method ( @ObjInterfaceMethods ) { no strict 'refs'; # Sub::Install is no standard module :-( *{ $method } = sub { my( $self, @values ) = @_; $self->{ $method } = $values[0] if scalar @values; return $self->{ $method }; }; } # foreach # ============================================================ sub new { my( $class, %params ) = @_; my $self = bless {}, $class; foreach my $param (keys %params) { $self->$param( $params{$param} ); } # foreach return $self; } # new # ------------------------------------------------------------ sub increaseCurrentRow { my $self = shift; return $self->currentRow( 1 + $self->currentRow ); } # increaseCurrentRow # ------------------------------------------------------------ sub increaseChangeCount { my $self = shift; if( defined $self->changeCount ) { $self->changeCount( 1 + $self->changeCount ); } # if else { $self->changeCount( 1 ); } # else return; } # increaseChangeCount # ------------------------------------------------------------ sub open { my( $self ) = @_; my $filename = $self->excelFile; defined $filename or croak "Error: no filename given"; -f $filename or croak( "Error: filename '$filename' doesn't exist"); my $excel; # try to re-use running instance of Excel eval { $excel = Win32::OLE->GetActiveObject( 'Excel.Application' ) }; die "Error: no Excel installed\n" if $@; unless( defined $excel ) { # if not running, start excel $excel = Win32::OLE->new( 'Excel.Application', sub { $_[0]->Quit } ) or die "Error: can't start Excel\n"; } # unless $self->excel( $excel ); $self->workBook( $excel->Workbooks->Open( $filename ) ); $self->worksheet( $self->workBook->Worksheets( $self->worksheetNumber ) ); my $range = $self->worksheet->UsedRange->{Value}; $self->lastRow( $#{$range} + 1 ); $self->currentRow( 0 ); return $self; } # open # ------------------------------------------------------------ sub getNextRow { my( $self, $F ) = @_; $self->increaseCurrentRow; my $row = $self->currentRow; my $sheet = $self->worksheet; return if $row > $self->lastRow; # thanks to pKai for this idea: my $bottomRight = ( split( /:/, $self->worksheet->UsedRange->address(0,0) ) )[-1]; my( $colNameMax, $rowNumMax ) = $bottomRight =~ /^([A-Z]+)(\d+)$/; $self->lastRow( $rowNumMax ); $self->maxCol ( $colNameMax ); my $rowData = $sheet->Range("A$row:" . $self->maxCol . $row)->{Value}; # prepare ole objects for return representing array of cells my @cells = (); for my $cell ( 'A' .. $self->maxCol ) { push( @cells, $sheet->Range( "$cell$row" ) ); } # for tie( @$F, 'ExcelPerl::RowArray', $self ); foreach my $value ( ref $rowData ? @{ $rowData->[0] } : $rowData ) { push( @$F, $value ); } # foreach return @cells; } # getNextRow # ------------------------------------------------------------ # ============================================================ package ExcelPerl::RowArray; # ------------------------------------------------------------ use Tie::Array; use vars qw( @ISA ); @ISA = qw( Tie::Array ); # ------------------------------------------------------------ sub TIEARRAY { my( $class, $excelObj ) = @_; my $self = bless( { data => [] }, $class ); $self->{excelObj} = $excelObj; $self->{row} = $excelObj->currentRow; return $self; } # TIEARRAY # ------------------------------------------------------------ sub FETCH { my( $self, $index) = @_; return $self->{data}->[ $index ]; } # FETCH # ------------------------------------------------------------ sub STORE { my( $self, $index, $newValue ) = @_; my $excelObj = $self->{excelObj}; my $sheet = $excelObj->worksheet; my $row = $excelObj->currentRow; my $col = $index + 1; my $oldValue = $self->{data}->[$index]; if( ( not defined $oldValue and defined $newValue ) or ( defined $oldValue and not defined $newValue ) or ( $oldValue ne $newValue ) ) { $excelObj->increaseChangeCount; $sheet ->Cells($row, $col)->{'Value' } = $newValue; $self ->{'data'} ->[ $index ] = $newValue; } # if return; } # STORE # ------------------------------------------------------------ sub FETCHSIZE { my $self = shift; return $#{ $self->{data} }; } # FETCHSIZE # ------------------------------------------------------------ sub STORESIZE { my( $self, $newLength ) = @_; return $#{ $self->{data} } = $newLength; } # STORESIZE # ------------------------------------------------------------ sub PUSH { my $self = shift; return push( @{ $self->{data} }, @_ ); } # PUSH # ------------------------------------------------------------ sub CLEAR { my( $self ) = @_; my $data = $self->{data}; for my $i ( 0..$#{$data} ) { $self->STORE( $i, '' ); } # for return; } # CLEAR # ------------------------------------------------------------ 1; # modules have to return a true value