package ExcelPerl; use warnings; use strict; use Carp qw(croak); our $VERSION = 0.08; # 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 worksheetNumber currentRow lastRow 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 DESTROY { # my $self = shift; # print "DESTROY: ", ref $self->excel, "\n"; } # DESTROY # ------------------------------------------------------------ sub increaseCurrentRow { my $self = shift; $self->currentRow( 1 + $self->currentRow ); } # increaseCurrentRow # ------------------------------------------------------------ sub increaseChangeCount { my $self = shift; no warnings; $self->changeCount( 1 + $self->changeCount ); } # 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; my $rowData = $sheet->Range("A$row:IV$row")->{Value}; # dirty my $itemsFound = 0; tie( @$F, 'ExcelPerl::RowArray', $self ); foreach my $value ( reverse @{ $rowData->[0] } ) { if( defined $value ) { unshift( @$F, $value ); $itemsFound++; } else { unshift( @$F, '' ) if scalar @$F; } } # foreach return 1; } # 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, $value ) = @_; my $excelObj = $self->{excelObj}; my $sheet = $excelObj->worksheet; my $row = $excelObj->currentRow; my $col = $index + 1; if( $self->{data}->[$index] ne $value ) { $excelObj->increaseChangeCount; $sheet ->Cells($row, $col)->{'Value' } = $value; $self ->{'data'} ->[ $index ] = $value; } # if } # STORE # ------------------------------------------------------------ sub FETCHSIZE { my $self = shift; return $#{ $self->{data} }; } # FETCHSIZE # ------------------------------------------------------------ sub STORESIZE { my( $self, $newLength ) = @_; $#{ $self->{data} } = $newLength; } # STORESIZE # ------------------------------------------------------------ sub UNSHIFT { my $self = shift; unshift( @{ $self->{data} }, @_ ); } # UNSHIFT # ------------------------------------------------------------ sub SHIFT { my $self = shift; return shift @{ $self->{data} }; } # SHIFT # ------------------------------------------------------------ sub POP { my $self = shift; return pop @{ $self->{data} }; } # POP # ------------------------------------------------------------ sub PUSH { my $self = shift; push( @{ $self->{data} }, @_ ); } # PUSH # ------------------------------------------------------------ sub CLEAR { my( $self ) = @_; # TODO: update excel $self->{data} = []; } # CLEAR # ------------------------------------------------------------ sub DESTROY { # my $self = shift; } # DESTROY # ------------------------------------------------------------ # ... # ------------------------------------------------------------ 1; # modules have to return a true value