#!/usr/bin/perl #=============================================================================== # DBD::Excel - A class for DBI drivers that act on Excel File # # This module is Copyright (C) 2001 Kawai,Takanori (Hippo2000) Japan # All rights reserved. # # You may distribute this module under the terms of either the GNU # General Public License or the Artistic License, as specified in # the Perl README file. #=============================================================================== require 5.004; use strict; require DynaLoader; require DBI; require SQL::Statement; require SQL::Eval; require Spreadsheet::ParseExcel::SaveParser; #=============================================================================== # DBD::Excel #=============================================================================== package DBD::Excel; use vars qw(@ISA $VERSION $hDr $err $errstr $sqlstate); @ISA = qw(DynaLoader); $VERSION = '0.06'; $err = 0; # holds error code for DBI::err $errstr = ""; # holds error string for DBI::errstr $sqlstate = ""; # holds error state for DBI::state $hDr = undef; # holds driver handle once initialised #------------------------------------------------------------------------------- # driver (DBD::Excel) # create driver-handle #------------------------------------------------------------------------------- sub driver { #0. already created - return it return $hDr if $hDr; #1. not created(maybe normal case) my($sClass, $rhAttr) = @_; $sClass .= "::dr"; $hDr = DBI::_new_drh($sClass, #create as 'DBD::Excel' + '::dr' { 'Name' => 'Excel', 'Version' => $VERSION, 'Err' => \$DBD::Excel::err, 'Errstr' => \$DBD::Excel::errstr, 'State' => \$DBD::Excel::sqlstate, 'Attribution' => 'DBD::Excel by Kawai,Takanori', } ); return $hDr; } #=============================================================================== # DBD::Excel::dr #=============================================================================== package DBD::Excel::dr; $DBD::Excel::dr::imp_data_size = 0; #------------------------------------------------------------------------------- # connect (DBD::Excel::dr) # connect database(ie. parse specified Excel file) #------------------------------------------------------------------------------- sub connect($$@) { my($hDr, $sDbName, $sUsr, $sAuth, $rhAttr)= @_; #1. create database-handle my $hDb = DBI::_new_dbh($hDr, { Name => $sDbName, USER => $sUsr, CURRENT_USER => $sUsr, }); #2. parse extra strings in DSN(key1=val1;key2=val2;...) foreach my $sItem (split(/;/, $sDbName)) { if ($sItem =~ /(.*?)=(.*)/) { $hDb->STORE($1, $2); } } #3.check file and parse it return undef unless($hDb->{file}); my $oExcel = new Spreadsheet::ParseExcel::SaveParser; my $oBook = $oExcel->Parse($hDb->{file}, $rhAttr->{xl_fmt}); return undef unless defined $oBook; my %hTbl; for(my $iSheet=0; $iSheet < $oBook->{SheetCount} ; $iSheet++) { my $oWkS = $oBook->{Worksheet}[$iSheet]; $oWkS->{MaxCol} ||=0; $oWkS->{MinCol} ||=0; # my($raColN, $rhColN) = _getColName($oWkS, 0, $oWkS->{MinCol}, # $oWkS->{MaxCol}-$oWkS->{MinCol}+1); my $MaxCol = defined ($oWkS->{MaxCol}) ? $oWkS->{MaxCol} : 0; my $MinCol = defined ($oWkS->{MinCol}) ? $oWkS->{MinCol} : 0; my($raColN, $rhColN, $iColCnt) = _getColName($rhAttr->{xl_ignorecase}, $rhAttr->{xl_skiphidden}, $oWkS, 0, $MinCol, $MaxCol-$MinCol+1); my $sTblN = ($rhAttr->{xl_ignorecase})? uc($oWkS->{Name}): $oWkS->{Name}; $hTbl{$sTblN} = { xl_t_vtbl => undef, xl_t_ttlrow => 0, xl_t_startcol => $oWkS->{MinCol}, # xl_t_colcnt => $oWkS->{MaxCol}-$oWkS->{MinCol}+1, xl_t_colcnt => $iColCnt, # $MaxCol - $MinCol - $HidCols + 1, xl_t_datrow => 1, xl_t_datlmt => undef, xl_t_name => $sTblN, xl_t_sheetno => $iSheet, xl_t_sheet => $oWkS, xl_t_currow => 0, col_nums => $rhColN, col_names => $raColN, }; } while(my($sKey, $rhVal)= each(%{$rhAttr->{xl_vtbl}})) { $sKey = uc($sKey) if($rhAttr->{xl_ignorecase}); unless($hTbl{$rhVal->{sheetName}}) { if ($hDb->FETCH('Warn')) { warn qq/There is no "$rhVal->{sheetName}"/; } next; } my $oWkS = $hTbl{$rhVal->{sheetName}}->{xl_t_sheet}; my($raColN, $rhColN, $iColCnt) = _getColName( $rhAttr->{xl_ignorecase}, $rhAttr->{xl_skiphidden}, $oWkS, $rhVal->{ttlRow}, $rhVal->{startCol}, $rhVal->{colCnt}); $hTbl{$sKey} = { xl_t_vtbl => $sKey, xl_t_ttlrow => $rhVal->{ttlRow}, xl_t_startcol => $rhVal->{startCol}, xl_t_colcnt => $iColCnt, #$rhVal->{colCnt}, xl_t_datrow => $rhVal->{datRow}, xl_t_datlmt => $rhVal->{datLmt}, xl_t_name => $sKey, xl_t_sheetno => $hTbl{$rhVal->{sheetName}}->{xl_t_sheetno}, xl_t_sheet => $oWkS, xl_t_currow => 0, col_nums => $rhColN, col_names => $raColN, }; } $hDb->STORE('xl_tbl', \%hTbl); $hDb->STORE('xl_parser', $oExcel); $hDb->STORE('xl_book', $oBook); $hDb->STORE('xl_skiphidden', $rhAttr->{xl_skiphidden}) if $rhAttr->{xl_skiphidden}; $hDb->STORE('xl_ignorecase', $rhAttr->{xl_ignorecase}) if $rhAttr->{xl_ignorecase}; return $hDb; } #------------------------------------------------------------------------------- # _getColName (DBD::Excel::dr) # internal use #------------------------------------------------------------------------------- sub _getColName($$$$$$) { my($iIgnore, $iHidden, $oWkS, $iRow, $iColS, $iColCnt) = @_; my $iColMax; #MAXIAM Range of Columns (Contains HIDDEN Columns) my $iCntWk = 0; my $MaxCol = defined ($oWkS->{MaxCol}) ? $oWkS->{MaxCol} : 0; if(defined $iColCnt) { if(($iColS + $iColCnt - 1) <= $MaxCol){ $iColMax = $iColS + $iColCnt - 1; } else{ $iColMax = $MaxCol; } } else { $iColMax = $MaxCol; } #2.2 get column name my (@aColName, %hColName); for(my $iC = $iColS; $iC <= $iColMax; $iC++) { next if($iHidden &&($oWkS->{ColWidth}[$iC] == 0)); $iCntWk++; my $sName; if(defined $iRow) { my $oWkC = $oWkS->{Cells}[$iRow][$iC]; $sName = (defined $oWkC && defined $oWkC->Value)? $oWkC->Value: "COL_${iC}_"; } else { $sName = "COL_${iC}_"; } if(grep(/^\Q$sName\E$/, @aColName)) { my $iCnt = grep(/^\Q$sName\E_(\d+)_$/, @aColName); $sName = "${sName}_${iCnt}_"; } $sName = uc($sName) if($iIgnore); push @aColName, $sName; $hColName{$sName} = ($iC - $iColS); } return (\@aColName, \%hColName, $iColCnt); } #------------------------------------------------------------------------------- # data_sources (DBD::Excel::dr) # Nothing done #------------------------------------------------------------------------------- sub data_sources ($;$) { my($hDr, $rhAttr) = @_; #1. Open specified directry my $sDir = ($rhAttr and exists($rhAttr->{'xl_dir'})) ? $rhAttr->{'xl_dir'} : '.'; if (!opendir(DIR, $sDir)) { DBI::set_err($hDr, 1, "Cannot open directory $sDir"); return undef; } #2. Check and push it array my($file, @aDsns, $sDrv); if ($hDr->{'ImplementorClass'} =~ /^dbd\:\:([^\:]+)\:\:/i) { $sDrv = $1; } else { $sDrv = 'Excel'; } my $sFile; while (defined($sFile = readdir(DIR))) { next if($sFile !~/\.xls$/i); my $sFullPath = "$sDir/$sFile"; if (($sFile ne '.') and ($sFile ne '..') and (-f $sFullPath)) { push(@aDsns, "DBI:$sDrv:file=$sFullPath"); } } return @aDsns; } #------------------------------------------------------------------------------- # disconnect_all, DESTROY (DBD::Excel::dr) # Nothing done #------------------------------------------------------------------------------- sub disconnect_all { } sub DESTROY { } #=============================================================================== # DBD::Excel::db #=============================================================================== package DBD::Excel::db; $DBD::Excel::db::imp_data_size = 0; #------------------------------------------------------------------------------- # prepare (DBD::Excel::db) #------------------------------------------------------------------------------- sub prepare ($$;@) { my($hDb, $sStmt, @aAttr)= @_; # 1. create a 'blank' dbh my $hSt = DBI::_new_sth($hDb, {'Statement' => $sStmt}); # 2. set attributes if ($hSt) { $@ = ''; my $sClass = $hSt->FETCH('ImplementorClass'); # 3. create DBD::Excel::Statement $sClass =~ s/::st$/::Statement/; my($oStmt) = eval { $sClass->new($sStmt) }; #3.1 error if ($@) { DBI::set_err($hDb, 1, $@); undef $hSt; } #3.2 succeed else { $hSt->STORE('xl_stmt', $oStmt); $hSt->STORE('xl_params', []); $hSt->STORE('NUM_OF_PARAMS', scalar($oStmt->params())); } } return $hSt; } #------------------------------------------------------------------------------- # disconnect (DBD::Excel::db) #------------------------------------------------------------------------------- sub disconnect ($) { 1; } #------------------------------------------------------------------------------- # FETCH (DBD::Excel::db) #------------------------------------------------------------------------------- sub FETCH ($$) { my ($hDb, $sAttr) = @_; #1. AutoCommit always 1 if ($sAttr eq 'AutoCommit') { return 1; } #2. Driver private attributes are lower cased elsif ($sAttr eq (lc $sAttr)) { return $hDb->{$sAttr}; } #3. pass up to DBI to handle return $hDb->DBD::_::db::FETCH($sAttr); } #------------------------------------------------------------------------------- # STORE (DBD::Excel::db) #------------------------------------------------------------------------------- sub STORE ($$$) { my ($hDb, $sAttr, $sValue) = @_; #1. AutoCommit always 1 if ($sAttr eq 'AutoCommit') { return 1 if $sValue; # is already set die("Can't disable AutoCommit"); } #2. Driver private attributes are lower cased elsif ($sAttr eq (lc $sAttr)) { $hDb->{$sAttr} = $sValue; return 1; } #3. pass up to DBI to handle return $hDb->DBD::_::db::STORE($sAttr, $sValue); } #------------------------------------------------------------------------------- # DESTROY (DBD::Excel::db) #------------------------------------------------------------------------------- sub DESTROY ($) { my($oThis) = @_; #1. Save as Excel faile # $oThis->{xl_parser}->SaveAs($oThis->{xl_book}, $oThis->{file}); undef; } #------------------------------------------------------------------------------- # type_info_all (DBD::Excel::db) #------------------------------------------------------------------------------- sub type_info_all ($) { [ { TYPE_NAME => 0, DATA_TYPE => 1, PRECISION => 2, LITERAL_PREFIX => 3, LITERAL_SUFFIX => 4, CREATE_PARAMS => 5, NULLABLE => 6, CASE_SENSITIVE => 7, SEARCHABLE => 8, UNSIGNED_ATTRIBUTE=> 9, MONEY => 10, AUTO_INCREMENT => 11, LOCAL_TYPE_NAME => 12, MINIMUM_SCALE => 13, MAXIMUM_SCALE => 14, }, [ 'VARCHAR', DBI::SQL_VARCHAR(), undef, "'","'", undef,0, 1,1,0,0,0,undef,1,999999 ], [ 'CHAR', DBI::SQL_CHAR(), undef, "'","'", undef,0, 1,1,0,0,0,undef,1,999999 ], [ 'INTEGER', DBI::SQL_INTEGER(), undef, "", "", undef,0, 0,1,0,0,0,undef,0, 0 ], [ 'REAL', DBI::SQL_REAL(), undef, "", "", undef,0, 0,1,0,0,0,undef,0, 0 ], # [ 'BLOB', DBI::SQL_LONGVARBINARY(), # undef, "'","'", undef,0, 1,1,0,0,0,undef,1,999999 # ], # [ 'BLOB', DBI::SQL_LONGVARBINARY(), # undef, "'","'", undef,0, 1,1,0,0,0,undef,1,999999 # ], # [ 'TEXT', DBI::SQL_LONGVARCHAR(), # undef, "'","'", undef,0, 1,1,0,0,0,undef,1,999999 # ] ] } #------------------------------------------------------------------------------- # table_info (DBD::Excel::db) #------------------------------------------------------------------------------- sub table_info ($) { my($hDb) = @_; #1. get table names from Excel my @aTables; my $rhTbl = $hDb->FETCH('xl_tbl'); while(my($sTbl, $rhVal) = each(%$rhTbl)) { my $sKind = ($rhVal->{xl_t_vtbl})? 'VTBL' : 'TABLE'; push(@aTables, [undef, undef, $sTbl, $sKind, undef]); } my $raNames = ['TABLE_QUALIFIER', 'TABLE_OWNER', 'TABLE_NAME', 'TABLE_TYPE', 'REMARKS']; #2. create DBD::Sponge driver my $hDb2 = $hDb->{'_sponge_driver'}; if (!$hDb2) { $hDb2 = $hDb->{'_sponge_driver'} = DBI->connect("DBI:Sponge:"); if (!$hDb2) { DBI::set_err($hDb, 1, $DBI::errstr); return undef; } } # Temporary kludge: DBD::Sponge dies if @aTables is empty. :-( return undef if !@aTables; #3. assign table info to the DBD::Sponge driver my $hSt = $hDb2->prepare("TABLE_INFO", { 'rows' => \@aTables, 'NAMES' => $raNames }); if (!$hSt) { DBI::set_err($hDb, 1, $hDb2->errstr()); } return $hSt; } #------------------------------------------------------------------------------- # list_tables (DBD::Excel::db) #------------------------------------------------------------------------------- sub list_tables ($@) { my($hDb) = @_; #shift; my($hSt, @aTables); #1. get table info if (!($hSt = $hDb->table_info())) { return (); } #2. push them into array while (my $raRow = $hSt->fetchrow_arrayref()) { push(@aTables, $raRow->[2]); } @aTables; } #------------------------------------------------------------------------------- # quote (DBD::Excel::db) # (same as DBD::File) #------------------------------------------------------------------------------- sub quote ($$;$) { my($oThis, $sObj, $iType) = @_; #1.Numeric if (defined($iType) && ($iType == DBI::SQL_NUMERIC() || $iType == DBI::SQL_DECIMAL() || $iType == DBI::SQL_INTEGER() || $iType == DBI::SQL_SMALLINT() || $iType == DBI::SQL_FLOAT() || $iType == DBI::SQL_REAL() || $iType == DBI::SQL_DOUBLE() || $iType == DBI::TINYINT())) { return $sObj; } #2.NULL return 'NULL' unless(defined $sObj); #3. Others $sObj =~ s/\\/\\\\/sg; $sObj =~ s/\0/\\0/sg; $sObj =~ s/\'/\\\'/sg; $sObj =~ s/\n/\\n/sg; $sObj =~ s/\r/\\r/sg; "'$sObj'"; } #------------------------------------------------------------------------------- # commit (DBD::Excel::db) # (No meaning for this driver) #------------------------------------------------------------------------------- sub commit ($) { my($hDb) = shift; if ($hDb->FETCH('Warn')) { # warn("Commit ineffective while AutoCommit is on", -1); warn("Commit ineffective with this driver", -1); } 1; } #------------------------------------------------------------------------------- # rollback (DBD::Excel::db) # (No meaning for this driver) #------------------------------------------------------------------------------- sub rollback ($) { my($hDb) = shift; if ($hDb->FETCH('Warn')) { # warn("Rollback ineffective while AutoCommit is on", -1); warn("Rollback ineffective with this driver", -1); } 0; } #------------------------------------------------------------------------------- # save (DBD::Excel::db) private_func #------------------------------------------------------------------------------- sub save ($;$) { my($oThis, $sFile) = @_; #1. Save as Excel file $sFile ||= $oThis->{file}; $oThis->{xl_parser}->SaveAs($oThis->{xl_book}, $sFile); undef; } #=============================================================================== # DBD::Excel::st #=============================================================================== package DBD::Excel::st; $DBD::Excel::st::imp_data_size = 0; #------------------------------------------------------------------------------- # bind_param (DBD::Excel::st) # set bind parameters into xl_params #------------------------------------------------------------------------------- sub bind_param ($$$;$) { my($hSt, $pNum, $val, $rhAttr) = @_; $hSt->{xl_params}->[$pNum-1] = $val; 1; } #------------------------------------------------------------------------------- # execute (DBD::Excel::st) #------------------------------------------------------------------------------- sub execute { my ($hSt, @aRest) = @_; #1. Set params my $params; if (@aRest) { $hSt->{xl_params} = ($params = [@aRest]); } else { $params = $hSt->{xl_params}; } #2. execute my $oStmt = $hSt->{xl_stmt}; my $oResult = eval { $oStmt->execute($hSt, $params); }; if ($@) { DBI::set_err($hSt, 1, $@); return undef; } #3. Set NUM_OF_FIELDS if ($oStmt->{NUM_OF_FIELDS} && !$hSt->FETCH('NUM_OF_FIELDS')) { $hSt->STORE('NUM_OF_FIELDS', $oStmt->{'NUM_OF_FIELDS'}); } return $oResult; } #------------------------------------------------------------------------------- # execute (DBD::Excel::st) #------------------------------------------------------------------------------- sub fetch ($) { my ($hSt) = @_; #1. ref of get data my $raData = $hSt->{xl_stmt}->{data}; if (!$raData || ref($raData) ne 'ARRAY') { DBI::set_err($hSt, 1, "Attempt to fetch row from a Non-SELECT statement"); return undef; } #2. get data my $raDav = shift @$raData; return undef if (!$raDav); if ($hSt->FETCH('ChopBlanks')) { map { $_ =~ s/\s+$//; } @$raDav; } $hSt->_set_fbav($raDav); } #alias *fetchrow_arrayref = \&fetch; #------------------------------------------------------------------------------- # FETCH (DBD::Excel::st) #------------------------------------------------------------------------------- sub FETCH ($$) { my ($hSt, $sAttr) = @_; # 1.TYPE (Workaround for a bug in DBI 0.93) return undef if ($sAttr eq 'TYPE'); # 2. NAME return $hSt->FETCH('xl_stmt')->{'NAME'} if ($sAttr eq 'NAME'); # 3. NULLABLE if ($sAttr eq 'NULLABLE') { my($raName) = $hSt->FETCH('xl_stmt')->{'NAME'}; # Intentional ! return undef unless ($raName) ; my @aNames = map { 1; } @$raName; return \@aNames; } # Private driver attributes are lower cased elsif ($sAttr eq (lc $sAttr)) { return $hSt->{$sAttr}; } # else pass up to DBI to handle return $hSt->DBD::_::st::FETCH($sAttr); } #------------------------------------------------------------------------------- # STORE (DBD::Excel::st) #------------------------------------------------------------------------------- sub STORE ($$$) { my ($hSt, $sAttr, $sValue) = @_; #1. Private driver attributes are lower cased if ($sAttr eq (lc $sAttr)) { $hSt->{$sAttr} = $sValue; return 1; } #2. else pass up to DBI to handle return $hSt->DBD::_::st::STORE($sAttr, $sValue); } #------------------------------------------------------------------------------- # DESTROY (DBD::Excel::st) #------------------------------------------------------------------------------- sub DESTROY ($) { undef; } #------------------------------------------------------------------------------- # rows (DBD::Excel::st) #------------------------------------------------------------------------------- sub rows ($) { shift->{xl_stmt}->{NUM_OF_ROWS} }; #------------------------------------------------------------------------------- # finish (DBD::Excel::st) #------------------------------------------------------------------------------- sub finish ($) { 1; } #=============================================================================== # DBD::Excel::Statement #=============================================================================== package DBD::Excel::Statement; @DBD::Excel::Statement::ISA = qw(SQL::Statement); #------------------------------------------------------------------------------- # open_table (DBD::Excel::Statement) #------------------------------------------------------------------------------- sub open_table ($$$$$) { my($oThis, $oData, $sTable, $createMode, $lockMode) = @_; #0. Init my $rhTbl = $oData->{Database}->FETCH('xl_tbl'); #1. Create Mode $sTable = uc($sTable) if($oData->{Database}->FETCH('xl_ignorecase')); if ($createMode) { if(defined $rhTbl->{$sTable}) { die "Cannot create table $sTable : Already exists"; } #1.2 create table object(DBD::Excel::Table) my @aColName; my %hColName; $rhTbl->{$sTable} = { xl_t_vtbl => undef, xl_t_ttlrow => 0, xl_t_startcol => 0, xl_t_colcnt => 0, xl_t_datrow => 1, xl_t_datlmt => undef, xl_t_name => $sTable, xl_t_sheetno => undef, xl_t_sheet => undef, xl_t_currow => 0, col_nums => \%hColName, col_names => \@aColName, }; } else { return undef unless(defined $rhTbl->{$sTable}); } my $rhItem = $rhTbl->{$sTable}; $rhItem->{xl_t_currow}=0; $rhItem->{xl_t_database} = $oData->{Database}; my $sClass = ref($oThis); $sClass =~ s/::Statement/::Table/; bless($rhItem, $sClass); return $rhItem; } #=============================================================================== # DBD::Excel::Table #=============================================================================== package DBD::Excel::Table; @DBD::Excel::Table::ISA = qw(SQL::Eval::Table); #------------------------------------------------------------------------------- # column_num (DBD::Excel::Statement) # Called with "SELECT ... FETCH" #------------------------------------------------------------------------------- sub column_num($$) { my($oThis, $sCol) =@_; $sCol = uc($sCol) if($oThis->{xl_t_database}->FETCH('xl_ignorecase')); return $oThis->SUPER::column_num($sCol); } #------------------------------------------------------------------------------- # column(DBD::Excel::Statement) # Called with "SELECT ... FETCH" #------------------------------------------------------------------------------- sub column($$;$) { my($oThis, $sCol, $sVal) =@_; $sCol = uc($sCol) if($oThis->{xl_t_database}->FETCH('xl_ignorecase')); if(defined $sVal) { return $oThis->SUPER::column($sCol, $sVal); } else { return $oThis->SUPER::column($sCol); } } #------------------------------------------------------------------------------- # fetch_row (DBD::Excel::Statement) # Called with "SELECT ... FETCH" #------------------------------------------------------------------------------- sub fetch_row ($$$) { my($oThis, $oData, $row) = @_; my $skip_hidden = 0; $skip_hidden = $oData->{Database}->FETCH('xl_skiphidden') if $oData->{Database}->FETCH('xl_skiphidden'); #1. count up currentrow my $HidRows = 0; if($skip_hidden) { for (my $i = $oThis->{xl_t_sheet}->{MinRow}; $i <= $oThis->{xl_t_sheet}->{MaxRow}; $i++) { $HidRows++ if $oThis->{xl_t_sheet}->{RowHeight}[$i] == 0; }; } my $iRMax = (defined $oThis->{xl_t_datlmt})? $oThis->{xl_t_datlmt} : ($oThis->{xl_t_sheet}->{MaxRow} - $oThis->{xl_t_datrow} - $HidRows + 1); return undef if($oThis->{xl_t_currow} >= $iRMax); my $oWkS = $oThis->{xl_t_sheet}; #2. get row data my @aRow = (); my $iFlg = 0; my $iR = $oThis->{xl_t_currow} + $oThis->{xl_t_datrow}; while((!defined ($oThis->{xl_t_sheet}->{RowHeight}[$iR])|| $oThis->{xl_t_sheet}->{RowHeight}[$iR] == 0) && $skip_hidden) { ++$iR; ++$oThis->{xl_t_currow}; return undef if $iRMax <= $iR - $oThis->{xl_t_datrow} - $HidRows; }; for(my $iC = $oThis->{xl_t_startcol} ; $iC < $oThis->{xl_t_startcol}+$oThis->{xl_t_colcnt}; $iC++) { next if($skip_hidden &&($oWkS->{ColWidth}[$iC] == 0)); push @aRow, (defined $oWkS->{Cells}[$iR][$iC])? $oWkS->{Cells}[$iR][$iC]->Value : undef; $iFlg = 1 if(defined $oWkS->{Cells}[$iR][$iC]); } return undef unless($iFlg); #No Data ++$oThis->{xl_t_currow}; $oThis->{row} = (@aRow ? \@aRow : undef); return \@aRow; } #------------------------------------------------------------------------------- # push_names (DBD::Excel::Statement) # Called with "CREATE TABLE" #------------------------------------------------------------------------------- sub push_names ($$$) { my($oThis, $oData, $raNames) = @_; #1.get database handle my $oBook = $oData->{Database}->{xl_book}; #2.add new worksheet my $iWkN = $oBook->AddWorksheet($oThis->{xl_t_name}); $oBook->{Worksheet}[$iWkN]->{MinCol}=0; $oBook->{Worksheet}[$iWkN]->{MaxCol}=0; #2.1 set names my @aColName =(); my %hColName =(); for(my $i = 0; $i<=$#$raNames; $i++) { $oBook->AddCell($iWkN, 0, $i, $raNames->[$i], 0); my $sWk = ($oData->{Database}->{xl_ignorecase})? uc($raNames->[$i]) : $raNames->[$i]; push @aColName, $sWk; $hColName{$sWk} = $i; } $oThis->{xl_t_colcnt} = $#$raNames + 1; $oThis->{xl_t_sheetno} = $iWkN; $oThis->{xl_t_sheet} = $oBook->{Worksheet}[$iWkN]; $oThis->{col_nums} = \%hColName; $oThis->{col_names} = \@aColName; return 1; } #------------------------------------------------------------------------------- # drop (DBD::Excel::Statement) # Called with "DROP TABLE" #------------------------------------------------------------------------------- sub drop ($$) { my($oThis, $oData) = @_; die "Cannot drop vtbl $oThis->{xl_t_vtbl} : " if(defined $oThis->{xl_t_vtbl}); #1. delete specified worksheet my $oBook = $oData->{Database}->{xl_book}; splice(@{$oBook->{Worksheet}}, $oThis->{xl_t_sheetno}, 1 ); $oBook->{SheetCount}--; my $rhTbl = $oData->{Database}->FETCH('xl_tbl'); while(my($sTbl, $rhVal) = each(%$rhTbl)) { $rhVal->{xl_t_sheetno}-- if($rhVal->{xl_t_sheetno} > $oThis->{xl_t_sheetno}); } $rhTbl->{$oThis->{xl_t_name}} = undef; return 1; } #------------------------------------------------------------------------------- # push_row (DBD::Excel::Statement) # Called with "INSERT" , "DELETE" and "UPDATE" #------------------------------------------------------------------------------- sub push_row ($$$) { my($oThis, $oData, $raFields) = @_; if((defined $oThis->{xl_t_datlmt}) && ($oThis->{xl_t_currow} >= $oThis->{xl_t_datlmt})) { die "Attempt to INSERT row over limit"; return undef ; } #1. add cells at current row my @aFmt; for(my $i = 0; $i<=$#$raFields; $i++) { push @aFmt, $oThis->{xl_t_sheet}->{Cells}[$oThis->{xl_t_datrow}][$oThis->{xl_t_startcol}+$i]->{FormatNo}; } for(my $i = 0; $i<$oThis->{xl_t_colcnt}; $i++) { my $oFmt = $aFmt[$i]; $oFmt ||= 0; my $oFld = $raFields->[$i]; $oFld ||= ''; $oData->{Database}->{xl_book}->AddCell( $oThis->{xl_t_sheetno}, $oThis->{xl_t_currow} + $oThis->{xl_t_datrow}, $i + $oThis->{xl_t_startcol}, $oFld, $oFmt ); } ++$oThis->{xl_t_currow}; return 1; } #------------------------------------------------------------------------------- # seek (DBD::Excel::Statement) # Called with "INSERT" , "DELETE" and "UPDATE" #------------------------------------------------------------------------------- sub seek ($$$$) { my($oThis, $oData, $iPos, $iWhence) = @_; my $iRow = $oThis->{xl_t_currow}; if ($iWhence == 0) { $iRow = $iPos; } elsif ($iWhence == 1) { $iRow += $iPos; } elsif ($iWhence == 2) { my $oWkS = $oThis->{xl_t_sheet}; my $iRowMax = (defined $oThis->{xl_t_datlmt})? $oThis->{xl_t_datlmt} : ($oWkS->{MaxRow} - $oThis->{xl_t_datrow}); my $iR; for($iR = 0; $iR <= $iRowMax; $iR++) { my $iFlg=0; for(my $iC = $oThis->{xl_t_startcol}; $iC < $oThis->{xl_t_startcol} + $oThis->{xl_t_colcnt}; $iC++) { if(defined $oWkS->{Cells}[$iR+$oThis->{xl_t_datrow}][$iC]) { $iFlg = 1; last; } } last unless($iFlg); } $iRow = $iR + $iPos; } else { die $oThis . "->seek: Illegal whence argument ($iWhence)"; } if ($iRow < 0) { die "Illegal row number: $iRow"; } return $oThis->{xl_t_currow} = $iRow; } #------------------------------------------------------------------------------- # truncate (DBD::Excel::Statement) # Called with "DELETE" and "UPDATE" #------------------------------------------------------------------------------- sub truncate ($$) { my($oThis, $oData) = @_; for(my $iC = $oThis->{xl_t_startcol}; $iC < $oThis->{xl_t_startcol} + $oThis->{xl_t_colcnt}; $iC++) { $oThis->{xl_t_sheet}->{Cells}[$oThis->{xl_t_currow}+$oThis->{xl_t_datrow}][$iC] = undef; } $oThis->{xl_t_sheet}->{MaxRow} = $oThis->{xl_t_currow}+$oThis->{xl_t_datrow} - 1 unless($oThis->{xl_t_vtbl}); return 1; } 1; __END__ =head1 NAME DBD::Excel - A class for DBI drivers that act on Excel File. This is still B. =head1 SYNOPSIS use DBI; $hDb = DBI->connect("DBI:Excel:file=test.xls") or die "Cannot connect: " . $DBI::errstr; $hSt = $hDb->prepare("CREATE TABLE a (id INTEGER, name CHAR(10))") or die "Cannot prepare: " . $hDb->errstr(); $hSt->execute() or die "Cannot execute: " . $hSt->errstr(); $hSt->finish(); $hDb->disconnect(); =head1 DESCRIPTION This is still B. The DBD::Excel module is a DBI driver. The module is based on these modules: =over 4 =item * Spreadsheet::ParseExcel reads Excel files. =item * Spreadsheet::WriteExcel writes Excel files. =item * SQL::Statement a simple SQL engine. =item * DBI Of course. :-) =back This module assumes TABLE = Worksheet. The contents of first row of each worksheet as column name. Adding that, this module accept temporary table definition at "connect" method with "xl_vtbl". ex. my $hDb = DBI->connect( "DBI:Excel:file=dbdtest.xls", undef, undef, {xl_vtbl => {TESTV => { sheetName => 'TEST_V', ttlRow => 5, startCol => 1, colCnt => 4, datRow => 6, datLmt => 4, } } }); For more information please refer sample/tex.pl included in this distribution. =head2 Metadata The following attributes are handled by DBI itself and not by DBD::Excel, thus they all work like expected: Active ActiveKids CachedKids CompatMode (Not used) InactiveDestroy Kids PrintError RaiseError Warn (Not used) The following DBI attributes are handled by DBD::Excel: =over 4 =item AutoCommit Always on =item ChopBlanks Works =item NUM_OF_FIELDS Valid after C<$hSt-Eexecute> =item NUM_OF_PARAMS Valid after C<$hSt-Eprepare> =item NAME Valid after C<$hSt-Eexecute>; undef for Non-Select statements. =item NULLABLE Not really working, always returns an array ref of one's. Valid after C<$hSt-Eexecute>; undef for Non-Select statements. =back These attributes and methods are not supported: bind_param_inout CursorName LongReadLen LongTruncOk Additional to the DBI attributes, you can use the following dbh attribute: =over 4 =item xl_fmt This attribute is used for setting the formatter class for parsing. =item xl_dir This attribute is used only with C on setting the directory where Excel files ('*.xls') are searched. It defaults to the current directory ("."). =item xl_vtbl assumes specified area as a table. I. =item xl_skiphidden skip hidden rows(=row height is 0) and hidden columns(=column width is 0). I. =item xl_ignorecase set casesensitive or not about table name and columns. Default is sensitive (maybe as SQL::Statement). I. =back =head2 Driver private methods =over 4 =item data_sources The C method returns a list of '*.xls' files of the current directory in the form "DBI:Excel:xl_dir=$dirname". If you want to read the subdirectories of another directory, use my($hDr) = DBI->install_driver("Excel"); my(@list) = $hDr->data_sources( { xl_dir => '/usr/local/xl_data' } ); =item list_tables This method returns a list of sheet names contained in the $hDb->{file}. Example: my $hDb = DBI->connect("DBI:Excel:file=test.xls"); my @list = $hDb->func('list_tables'); =back =head1 TODO =over 4 =item More tests First of all... =item Type and Format The current version not support date/time and text formatting. =item Joins The current version of the module works with single table SELECT's only, although the basic design of the SQL::Statement module allows joins and the likes. =back =head1 KNOWN BUGS =over 8 =item * There are too many TODO things. So I can't determind what is BUG. :-) =back =head1 AUTHOR Kawai Takanori (Hippo2000) kwitknr@cpan.org Homepage: http://member.nifty.ne.jp/hippo2000/ (Japanese) http://member.nifty.ne.jp/hippo2000/index_e.htm (English) Wiki: http://www.hippo2000.net/cgi-bin/KbWiki/KbWiki.pl (Japanese) http://www.hippo2000.net/cgi-bin/KbWikiE/KbWiki.pl (English) =head1 SEE ALSO DBI, Spreadsheet::WriteExcel, Spreadsheet::ParseExcel, SQL::Statement =head1 COPYRIGHT Copyright (c) 2001 KAWAI,Takanori All rights reserved. You may distribute under the terms of either the GNU General Public License or the Artistic License, as specified in the Perl README file. =cut