1#!perl 2#=============================================================================== 3# DBD::Excel - A class for DBI drivers that act on Excel File 4# 5# This module is Copyright (C) 2001 Kawai,Takanori (Hippo2000) Japan 6# All rights reserved. 7# 8# You may distribute this module under the terms of either the GNU 9# General Public License or the Artistic License, as specified in 10# the Perl README file. 11#=============================================================================== 12require 5.004; 13use strict; 14require DynaLoader; 15require DBI; 16require SQL::Statement; 17require SQL::Eval; 18require Spreadsheet::ParseExcel::SaveParser; 19 20#=============================================================================== 21# DBD::Excel 22#=============================================================================== 23package DBD::Excel; 24 25use vars qw(@ISA $VERSION $hDr $err $errstr $sqlstate); 26@ISA = qw(DynaLoader); 27 28$VERSION = '0.06'; 29 30$err = 0; # holds error code for DBI::err 31$errstr = ""; # holds error string for DBI::errstr 32$sqlstate = ""; # holds error state for DBI::state 33$hDr = undef; # holds driver handle once initialised 34 35#------------------------------------------------------------------------------- 36# driver (DBD::Excel) 37# create driver-handle 38#------------------------------------------------------------------------------- 39sub driver { 40#0. already created - return it 41 return $hDr if $hDr; 42 43#1. not created(maybe normal case) 44 my($sClass, $rhAttr) = @_; 45 $sClass .= "::dr"; 46 $hDr = DBI::_new_drh($sClass, #create as 'DBD::Excel' + '::dr' 47 { 48 'Name' => 'Excel', 49 'Version' => $VERSION, 50 'Err' => \$DBD::Excel::err, 51 'Errstr' => \$DBD::Excel::errstr, 52 'State' => \$DBD::Excel::sqlstate, 53 'Attribution' => 'DBD::Excel by Kawai,Takanori', 54 } 55 ); 56 return $hDr; 57} 58#=============================================================================== 59# DBD::Excel::dr 60#=============================================================================== 61package DBD::Excel::dr; 62 63$DBD::Excel::dr::imp_data_size = 0; 64 65#------------------------------------------------------------------------------- 66# connect (DBD::Excel::dr) 67# connect database(ie. parse specified Excel file) 68#------------------------------------------------------------------------------- 69sub connect($$@) { 70 my($hDr, $sDbName, $sUsr, $sAuth, $rhAttr)= @_; 71#1. create database-handle 72 my $hDb = DBI::_new_dbh($hDr, { 73 Name => $sDbName, 74 USER => $sUsr, 75 CURRENT_USER => $sUsr, 76 }); 77#2. parse extra strings in DSN(key1=val1;key2=val2;...) 78 foreach my $sItem (split(/;/, $sDbName)) { 79 if ($sItem =~ /(.*?)=(.*)/) { 80 $hDb->STORE($1, $2); 81 } 82 } 83#3.check file and parse it 84 return undef unless($hDb->{file}); 85 my $oExcel = new Spreadsheet::ParseExcel::SaveParser; 86 my $oBook = $oExcel->Parse($hDb->{file}, $rhAttr->{xl_fmt}); 87 return undef unless defined $oBook; 88 89 my %hTbl; 90 for(my $iSheet=0; $iSheet < $oBook->{SheetCount} ; $iSheet++) { 91 my $oWkS = $oBook->{Worksheet}[$iSheet]; 92 $oWkS->{MaxCol} ||=0; 93 $oWkS->{MinCol} ||=0; 94# my($raColN, $rhColN) = _getColName($oWkS, 0, $oWkS->{MinCol}, 95# $oWkS->{MaxCol}-$oWkS->{MinCol}+1); 96 my $MaxCol = defined ($oWkS->{MaxCol}) ? $oWkS->{MaxCol} : 0; 97 my $MinCol = defined ($oWkS->{MinCol}) ? $oWkS->{MinCol} : 0; 98 my($raColN, $rhColN, $iColCnt) = 99 _getColName($rhAttr->{xl_ignorecase}, 100 $rhAttr->{xl_skiphidden}, 101 $oWkS, 0, $MinCol, $MaxCol-$MinCol+1); 102=cmmt 103 my $HidCols=0; 104 if $rhAttr->{xl_skiphidden} { 105 for (my $i = $MinCol, $HidCols = 0; $i <= $MaxCol; $i++) { 106 $HidCols++ if $oWkS->{ColWidth}[$i] && $oWkS->{ColWidth}[$i] == 0; 107 }; 108 } 109=cut 110 my $sTblN = ($rhAttr->{xl_ignorecase})? uc($oWkS->{Name}): $oWkS->{Name}; 111 $hTbl{$sTblN} = { 112 xl_t_vtbl => undef, 113 xl_t_ttlrow => 0, 114 xl_t_startcol => $oWkS->{MinCol}, 115# xl_t_colcnt => $oWkS->{MaxCol}-$oWkS->{MinCol}+1, 116 xl_t_colcnt => $iColCnt, # $MaxCol - $MinCol - $HidCols + 1, 117 xl_t_datrow => 1, 118 xl_t_datlmt => undef, 119 120 xl_t_name => $sTblN, 121 xl_t_sheetno => $iSheet, 122 xl_t_sheet => $oWkS, 123 xl_t_currow => 0, 124 col_nums => $rhColN, 125 col_names => $raColN, 126 }; 127 } 128 while(my($sKey, $rhVal)= each(%{$rhAttr->{xl_vtbl}})) { 129 $sKey = uc($sKey) if($rhAttr->{xl_ignorecase}); 130 unless($hTbl{$rhVal->{sheetName}}) { 131 if ($hDb->FETCH('Warn')) { 132 warn qq/There is no "$rhVal->{sheetName}"/; 133 } 134 next; 135 } 136 my $oWkS = $hTbl{$rhVal->{sheetName}}->{xl_t_sheet}; 137 my($raColN, $rhColN, $iColCnt) = _getColName( 138 $rhAttr->{xl_ignorecase}, 139 $rhAttr->{xl_skiphidden}, 140 $oWkS, $rhVal->{ttlRow}, 141 $rhVal->{startCol}, $rhVal->{colCnt}); 142 $hTbl{$sKey} = { 143 xl_t_vtbl => $sKey, 144 xl_t_ttlrow => $rhVal->{ttlRow}, 145 xl_t_startcol => $rhVal->{startCol}, 146 xl_t_colcnt => $iColCnt, #$rhVal->{colCnt}, 147 xl_t_datrow => $rhVal->{datRow}, 148 xl_t_datlmt => $rhVal->{datLmt}, 149 150 xl_t_name => $sKey, 151 xl_t_sheetno => $hTbl{$rhVal->{sheetName}}->{xl_t_sheetno}, 152 xl_t_sheet => $oWkS, 153 xl_t_currow => 0, 154 col_nums => $rhColN, 155 col_names => $raColN, 156 }; 157 } 158 $hDb->STORE('xl_tbl', \%hTbl); 159 $hDb->STORE('xl_parser', $oExcel); 160 $hDb->STORE('xl_book', $oBook); 161 $hDb->STORE('xl_skiphidden', $rhAttr->{xl_skiphidden}) if $rhAttr->{xl_skiphidden}; 162 $hDb->STORE('xl_ignorecase', $rhAttr->{xl_ignorecase}) if $rhAttr->{xl_ignorecase}; 163 return $hDb; 164} 165#------------------------------------------------------------------------------- 166# _getColName (DBD::Excel::dr) 167# internal use 168#------------------------------------------------------------------------------- 169sub _getColName($$$$$$) { 170 my($iIgnore, $iHidden, $oWkS, $iRow, $iColS, $iColCnt) = @_; 171 my $iColMax; #MAXIAM Range of Columns (Contains HIDDEN Columns) 172 173 my $iCntWk = 0; 174 my $MaxCol = defined ($oWkS->{MaxCol}) ? $oWkS->{MaxCol} : 0; 175 if(defined $iColCnt) { 176 if(($iColS + $iColCnt - 1) <= $MaxCol){ 177 $iColMax = $iColS + $iColCnt - 1; 178 } 179 else{ 180 $iColMax = $MaxCol; 181 } 182 } 183 else { 184 $iColMax = $MaxCol; 185 } 186#2.2 get column name 187 my (@aColName, %hColName); 188 for(my $iC = $iColS; $iC <= $iColMax; $iC++) { 189 next if($iHidden &&($oWkS->{ColWidth}[$iC] == 0)); 190 $iCntWk++; 191 my $sName; 192 if(defined $iRow) { 193 my $oWkC = $oWkS->{Cells}[$iRow][$iC]; 194 $sName = (defined $oWkC && defined $oWkC->Value)? 195 $oWkC->Value: "COL_${iC}_"; 196 } 197 else { 198 $sName = "COL_${iC}_"; 199 } 200 if(grep(/^\Q$sName\E$/, @aColName)) { 201 my $iCnt = grep(/^\Q$sName\E_(\d+)_$/, @aColName); 202 $sName = "${sName}_${iCnt}_"; 203 } 204 $sName = uc($sName) if($iIgnore); 205 push @aColName, $sName; 206 $hColName{$sName} = ($iC - $iColS); 207 } 208 return (\@aColName, \%hColName, $iColCnt); 209} 210#------------------------------------------------------------------------------- 211# data_sources (DBD::Excel::dr) 212# Nothing done 213#------------------------------------------------------------------------------- 214sub data_sources ($;$) { 215 my($hDr, $rhAttr) = @_; 216#1. Open specified directry 217 my $sDir = ($rhAttr and exists($rhAttr->{'xl_dir'})) ? $rhAttr->{'xl_dir'} : '.'; 218 if (!opendir(DIR, $sDir)) { 219 DBI::set_err($hDr, 1, "Cannot open directory $sDir"); 220 return undef; 221 } 222#2. Check and push it array 223 my($file, @aDsns, $sDrv); 224 if ($hDr->{'ImplementorClass'} =~ /^dbd\:\:([^\:]+)\:\:/i) { 225 $sDrv = $1; 226 } else { 227 $sDrv = 'Excel'; 228 } 229 my $sFile; 230 while (defined($sFile = readdir(DIR))) { 231 next if($sFile !~/\.xls$/i); 232 my $sFullPath = "$sDir/$sFile"; 233 if (($sFile ne '.') and ($sFile ne '..') and 234 (-f $sFullPath)) { 235 push(@aDsns, "DBI:$sDrv:file=$sFullPath"); 236 } 237 } 238 return @aDsns; 239} 240#------------------------------------------------------------------------------- 241# disconnect_all, DESTROY (DBD::Excel::dr) 242# Nothing done 243#------------------------------------------------------------------------------- 244sub disconnect_all { } 245sub DESTROY { } 246 247#=============================================================================== 248# DBD::Excel::db 249#=============================================================================== 250package DBD::Excel::db; 251 252$DBD::Excel::db::imp_data_size = 0; 253#------------------------------------------------------------------------------- 254# prepare (DBD::Excel::db) 255#------------------------------------------------------------------------------- 256sub prepare ($$;@) { 257 my($hDb, $sStmt, @aAttr)= @_; 258 259# 1. create a 'blank' dbh 260 my $hSt = DBI::_new_sth($hDb, {'Statement' => $sStmt}); 261 262# 2. set attributes 263 if ($hSt) { 264 $@ = ''; 265 my $sClass = $hSt->FETCH('ImplementorClass'); 266# 3. create DBD::Excel::Statement 267 $sClass =~ s/::st$/::Statement/; 268 my($oStmt) = eval { $sClass->new($sStmt) }; 269 #3.1 error 270 if ($@) { 271 DBI::set_err($hDb, 1, $@); 272 undef $hSt; 273 } 274 #3.2 succeed 275 else { 276 $hSt->STORE('xl_stmt', $oStmt); 277 $hSt->STORE('xl_params', []); 278 $hSt->STORE('NUM_OF_PARAMS', scalar($oStmt->params())); 279 } 280 } 281 return $hSt; 282} 283 284#------------------------------------------------------------------------------- 285# disconnect (DBD::Excel::db) 286#------------------------------------------------------------------------------- 287sub disconnect ($) { 1; } 288#------------------------------------------------------------------------------- 289# FETCH (DBD::Excel::db) 290#------------------------------------------------------------------------------- 291sub FETCH ($$) { 292 my ($hDb, $sAttr) = @_; 293#1. AutoCommit always 1 294 if ($sAttr eq 'AutoCommit') { 295 return 1; 296 } 297#2. Driver private attributes are lower cased 298 elsif ($sAttr eq (lc $sAttr)) { 299 return $hDb->{$sAttr}; 300 } 301#3. pass up to DBI to handle 302 return $hDb->DBD::_::db::FETCH($sAttr); 303} 304#------------------------------------------------------------------------------- 305# STORE (DBD::Excel::db) 306#------------------------------------------------------------------------------- 307sub STORE ($$$) { 308 my ($hDb, $sAttr, $sValue) = @_; 309#1. AutoCommit always 1 310 if ($sAttr eq 'AutoCommit') { 311 return 1 if $sValue; # is already set 312 die("Can't disable AutoCommit"); 313 } 314#2. Driver private attributes are lower cased 315 elsif ($sAttr eq (lc $sAttr)) { 316 $hDb->{$sAttr} = $sValue; 317 return 1; 318 } 319#3. pass up to DBI to handle 320 return $hDb->DBD::_::db::STORE($sAttr, $sValue); 321} 322#------------------------------------------------------------------------------- 323# DESTROY (DBD::Excel::db) 324#------------------------------------------------------------------------------- 325sub DESTROY ($) { 326 my($oThis) = @_; 327#1. Save as Excel faile 328# $oThis->{xl_parser}->SaveAs($oThis->{xl_book}, $oThis->{file}); 329 undef; 330} 331 332#------------------------------------------------------------------------------- 333# type_info_all (DBD::Excel::db) 334#------------------------------------------------------------------------------- 335sub type_info_all ($) { 336 [ 337 { TYPE_NAME => 0, 338 DATA_TYPE => 1, 339 PRECISION => 2, 340 LITERAL_PREFIX => 3, 341 LITERAL_SUFFIX => 4, 342 CREATE_PARAMS => 5, 343 NULLABLE => 6, 344 CASE_SENSITIVE => 7, 345 SEARCHABLE => 8, 346 UNSIGNED_ATTRIBUTE=> 9, 347 MONEY => 10, 348 AUTO_INCREMENT => 11, 349 LOCAL_TYPE_NAME => 12, 350 MINIMUM_SCALE => 13, 351 MAXIMUM_SCALE => 14, 352 }, 353 [ 'VARCHAR', DBI::SQL_VARCHAR(), 354 undef, "'","'", undef,0, 1,1,0,0,0,undef,1,999999 355 ], 356 [ 'CHAR', DBI::SQL_CHAR(), 357 undef, "'","'", undef,0, 1,1,0,0,0,undef,1,999999 358 ], 359 [ 'INTEGER', DBI::SQL_INTEGER(), 360 undef, "", "", undef,0, 0,1,0,0,0,undef,0, 0 361 ], 362 [ 'REAL', DBI::SQL_REAL(), 363 undef, "", "", undef,0, 0,1,0,0,0,undef,0, 0 364 ], 365# [ 'BLOB', DBI::SQL_LONGVARBINARY(), 366# undef, "'","'", undef,0, 1,1,0,0,0,undef,1,999999 367# ], 368# [ 'BLOB', DBI::SQL_LONGVARBINARY(), 369# undef, "'","'", undef,0, 1,1,0,0,0,undef,1,999999 370# ], 371# [ 'TEXT', DBI::SQL_LONGVARCHAR(), 372# undef, "'","'", undef,0, 1,1,0,0,0,undef,1,999999 373# ] 374 ] 375} 376#------------------------------------------------------------------------------- 377# table_info (DBD::Excel::db) 378#------------------------------------------------------------------------------- 379sub table_info ($) { 380 my($hDb) = @_; 381 382#1. get table names from Excel 383 my @aTables; 384 my $rhTbl = $hDb->FETCH('xl_tbl'); 385 while(my($sTbl, $rhVal) = each(%$rhTbl)) { 386 my $sKind = ($rhVal->{xl_t_vtbl})? 'VTBL' : 'TABLE'; 387 push(@aTables, [undef, undef, $sTbl, $sKind, undef]); 388 389 } 390 my $raNames = ['TABLE_QUALIFIER', 'TABLE_OWNER', 'TABLE_NAME', 391 'TABLE_TYPE', 'REMARKS']; 392 393#2. create DBD::Sponge driver 394 my $hDb2 = $hDb->{'_sponge_driver'}; 395 if (!$hDb2) { 396 $hDb2 = $hDb->{'_sponge_driver'} = DBI->connect("DBI:Sponge:"); 397 if (!$hDb2) { 398 DBI::set_err($hDb, 1, $DBI::errstr); 399 return undef; 400 } 401 } 402 # Temporary kludge: DBD::Sponge dies if @aTables is empty. :-( 403 return undef if !@aTables; 404 405#3. assign table info to the DBD::Sponge driver 406 my $hSt = $hDb2->prepare("TABLE_INFO", 407 { 'rows' => \@aTables, 'NAMES' => $raNames }); 408 if (!$hSt) { 409 DBI::set_err($hDb, 1, $hDb2->errstr()); 410 } 411 return $hSt; 412} 413 414#------------------------------------------------------------------------------- 415# list_tables (DBD::Excel::db) 416#------------------------------------------------------------------------------- 417sub list_tables ($@) { 418 my($hDb) = @_; #shift; 419 my($hSt, @aTables); 420#1. get table info 421 if (!($hSt = $hDb->table_info())) { 422 return (); 423 } 424#2. push them into array 425 while (my $raRow = $hSt->fetchrow_arrayref()) { 426 push(@aTables, $raRow->[2]); 427 } 428 @aTables; 429} 430 431#------------------------------------------------------------------------------- 432# quote (DBD::Excel::db) 433# (same as DBD::File) 434#------------------------------------------------------------------------------- 435sub quote ($$;$) { 436 my($oThis, $sObj, $iType) = @_; 437 438#1.Numeric 439 if (defined($iType) && 440 ($iType == DBI::SQL_NUMERIC() || 441 $iType == DBI::SQL_DECIMAL() || 442 $iType == DBI::SQL_INTEGER() || 443 $iType == DBI::SQL_SMALLINT() || 444 $iType == DBI::SQL_FLOAT() || 445 $iType == DBI::SQL_REAL() || 446 $iType == DBI::SQL_DOUBLE() || 447 $iType == DBI::TINYINT())) { 448 return $sObj; 449 } 450#2.NULL 451 return 'NULL' unless(defined $sObj); 452 453#3. Others 454 $sObj =~ s/\\/\\\\/sg; 455 $sObj =~ s/\0/\\0/sg; 456 $sObj =~ s/\'/\\\'/sg; 457 $sObj =~ s/\n/\\n/sg; 458 $sObj =~ s/\r/\\r/sg; 459 "'$sObj'"; 460} 461 462#------------------------------------------------------------------------------- 463# commit (DBD::Excel::db) 464# (No meaning for this driver) 465#------------------------------------------------------------------------------- 466sub commit ($) { 467 my($hDb) = shift; 468 if ($hDb->FETCH('Warn')) { 469# warn("Commit ineffective while AutoCommit is on", -1); 470 warn("Commit ineffective with this driver", -1); 471 } 472 1; 473} 474#------------------------------------------------------------------------------- 475# rollback (DBD::Excel::db) 476# (No meaning for this driver) 477#------------------------------------------------------------------------------- 478sub rollback ($) { 479 my($hDb) = shift; 480 if ($hDb->FETCH('Warn')) { 481# warn("Rollback ineffective while AutoCommit is on", -1); 482 warn("Rollback ineffective with this driver", -1); 483 } 484 0; 485} 486#------------------------------------------------------------------------------- 487# save (DBD::Excel::db) private_func 488#------------------------------------------------------------------------------- 489sub save ($;$) { 490 my($oThis, $sFile) = @_; 491#1. Save as Excel file 492 $sFile ||= $oThis->{file}; 493 $oThis->{xl_parser}->SaveAs($oThis->{xl_book}, $sFile); 494 undef; 495} 496#=============================================================================== 497# DBD::Excel::st 498#=============================================================================== 499package DBD::Excel::st; 500 501$DBD::Excel::st::imp_data_size = 0; 502#------------------------------------------------------------------------------- 503# bind_param (DBD::Excel::st) 504# set bind parameters into xl_params 505#------------------------------------------------------------------------------- 506sub bind_param ($$$;$) { 507 my($hSt, $pNum, $val, $rhAttr) = @_; 508 $hSt->{xl_params}->[$pNum-1] = $val; 509 1; 510} 511#------------------------------------------------------------------------------- 512# execute (DBD::Excel::st) 513#------------------------------------------------------------------------------- 514sub execute { 515 my ($hSt, @aRest) = @_; 516#1. Set params 517 my $params; 518 if (@aRest) { 519 $hSt->{xl_params} = ($params = [@aRest]); 520 } 521 else { 522 $params = $hSt->{xl_params}; 523 } 524#2. execute 525 my $oStmt = $hSt->{xl_stmt}; 526 my $oResult = eval { $oStmt->execute($hSt, $params); }; 527 if ($@) { 528 DBI::set_err($hSt, 1, $@); 529 return undef; 530 } 531#3. Set NUM_OF_FIELDS 532 if ($oStmt->{NUM_OF_FIELDS} && !$hSt->FETCH('NUM_OF_FIELDS')) { 533 $hSt->STORE('NUM_OF_FIELDS', $oStmt->{'NUM_OF_FIELDS'}); 534 } 535 return $oResult; 536} 537#------------------------------------------------------------------------------- 538# execute (DBD::Excel::st) 539#------------------------------------------------------------------------------- 540sub fetch ($) { 541 my ($hSt) = @_; 542#1. ref of get data 543 my $raData = $hSt->{xl_stmt}->{data}; 544 if (!$raData || ref($raData) ne 'ARRAY') { 545 DBI::set_err($hSt, 1, 546 "Attempt to fetch row from a Non-SELECT statement"); 547 return undef; 548 } 549#2. get data 550 my $raDav = shift @$raData; 551 return undef if (!$raDav); 552 if ($hSt->FETCH('ChopBlanks')) { 553 map { $_ =~ s/\s+$//; } @$raDav; 554 } 555 $hSt->_set_fbav($raDav); 556} 557#alias 558*fetchrow_arrayref = \&fetch; 559 560#------------------------------------------------------------------------------- 561# FETCH (DBD::Excel::st) 562#------------------------------------------------------------------------------- 563sub FETCH ($$) { 564 my ($hSt, $sAttr) = @_; 565 566# 1.TYPE (Workaround for a bug in DBI 0.93) 567 return undef if ($sAttr eq 'TYPE'); 568 569# 2. NAME 570 return $hSt->FETCH('xl_stmt')->{'NAME'} if ($sAttr eq 'NAME'); 571 572# 3. NULLABLE 573 if ($sAttr eq 'NULLABLE') { 574 my($raName) = $hSt->FETCH('xl_stmt')->{'NAME'}; # Intentional ! 575 return undef unless ($raName) ; 576 my @aNames = map { 1; } @$raName; 577 return \@aNames; 578 } 579# Private driver attributes are lower cased 580 elsif ($sAttr eq (lc $sAttr)) { 581 return $hSt->{$sAttr}; 582 } 583# else pass up to DBI to handle 584 return $hSt->DBD::_::st::FETCH($sAttr); 585} 586#------------------------------------------------------------------------------- 587# STORE (DBD::Excel::st) 588#------------------------------------------------------------------------------- 589sub STORE ($$$) { 590 my ($hSt, $sAttr, $sValue) = @_; 591#1. Private driver attributes are lower cased 592 if ($sAttr eq (lc $sAttr)) { 593 $hSt->{$sAttr} = $sValue; 594 return 1; 595 } 596#2. else pass up to DBI to handle 597 return $hSt->DBD::_::st::STORE($sAttr, $sValue); 598} 599#------------------------------------------------------------------------------- 600# DESTROY (DBD::Excel::st) 601#------------------------------------------------------------------------------- 602sub DESTROY ($) { 603 undef; 604} 605#------------------------------------------------------------------------------- 606# rows (DBD::Excel::st) 607#------------------------------------------------------------------------------- 608sub rows ($) { shift->{xl_stmt}->{NUM_OF_ROWS} }; 609#------------------------------------------------------------------------------- 610# finish (DBD::Excel::st) 611#------------------------------------------------------------------------------- 612sub finish ($) { 1; } 613 614#=============================================================================== 615# DBD::Excel::Statement 616#=============================================================================== 617package DBD::Excel::Statement; 618 619@DBD::Excel::Statement::ISA = qw(SQL::Statement); 620#------------------------------------------------------------------------------- 621# open_table (DBD::Excel::Statement) 622#------------------------------------------------------------------------------- 623sub open_table ($$$$$) { 624 my($oThis, $oData, $sTable, $createMode, $lockMode) = @_; 625 626#0. Init 627 my $rhTbl = $oData->{Database}->FETCH('xl_tbl'); 628#1. Create Mode 629 $sTable = uc($sTable) if($oData->{Database}->FETCH('xl_ignorecase')); 630 if ($createMode) { 631 if(defined $rhTbl->{$sTable}) { 632 die "Cannot create table $sTable : Already exists"; 633 } 634#1.2 create table object(DBD::Excel::Table) 635 my @aColName; 636 my %hColName; 637 $rhTbl->{$sTable} = { 638 xl_t_vtbl => undef, 639 xl_t_ttlrow => 0, 640 xl_t_startcol => 0, 641 xl_t_colcnt => 0, 642 xl_t_datrow => 1, 643 xl_t_datlmt => undef, 644 645 xl_t_name => $sTable, 646 xl_t_sheetno => undef, 647 xl_t_sheet => undef, 648 xl_t_currow => 0, 649 col_nums => \%hColName, 650 col_names => \@aColName, 651 }; 652 } 653 else { 654 return undef unless(defined $rhTbl->{$sTable}); 655 } 656 my $rhItem = $rhTbl->{$sTable}; 657 $rhItem->{xl_t_currow}=0; 658 $rhItem->{xl_t_database} = $oData->{Database}; 659 my $sClass = ref($oThis); 660 $sClass =~ s/::Statement/::Table/; 661 bless($rhItem, $sClass); 662 return $rhItem; 663} 664 665#=============================================================================== 666# DBD::Excel::Table 667#=============================================================================== 668package DBD::Excel::Table; 669 670@DBD::Excel::Table::ISA = qw(SQL::Eval::Table); 671#------------------------------------------------------------------------------- 672# column_num (DBD::Excel::Statement) 673# Called with "SELECT ... FETCH" 674#------------------------------------------------------------------------------- 675sub column_num($$) { 676 my($oThis, $sCol) =@_; 677 $sCol = uc($sCol) if($oThis->{xl_t_database}->FETCH('xl_ignorecase')); 678 return $oThis->SUPER::column_num($sCol); 679} 680#------------------------------------------------------------------------------- 681# column(DBD::Excel::Statement) 682# Called with "SELECT ... FETCH" 683#------------------------------------------------------------------------------- 684sub column($$;$) { 685 my($oThis, $sCol, $sVal) =@_; 686 $sCol = uc($sCol) if($oThis->{xl_t_database}->FETCH('xl_ignorecase')); 687 if(defined $sVal) { 688 return $oThis->SUPER::column($sCol, $sVal); 689 } 690 else { 691 return $oThis->SUPER::column($sCol); 692 } 693} 694#------------------------------------------------------------------------------- 695# fetch_row (DBD::Excel::Statement) 696# Called with "SELECT ... FETCH" 697#------------------------------------------------------------------------------- 698sub fetch_row ($$$) { 699 my($oThis, $oData, $row) = @_; 700 701 my $skip_hidden = 0; 702 $skip_hidden = $oData->{Database}->FETCH('xl_skiphidden') if 703 $oData->{Database}->FETCH('xl_skiphidden'); 704 705#1. count up currentrow 706 my $HidRows = 0; 707 if($skip_hidden) { 708 for (my $i = $oThis->{xl_t_sheet}->{MinRow}; $i <= $oThis->{xl_t_sheet}->{MaxRow}; $i++) { 709 $HidRows++ if $oThis->{xl_t_sheet}->{RowHeight}[$i] == 0; 710 }; 711 } 712 713 my $iRMax = (defined $oThis->{xl_t_datlmt})? 714 $oThis->{xl_t_datlmt} : 715 ($oThis->{xl_t_sheet}->{MaxRow} - $oThis->{xl_t_datrow} - $HidRows + 1); 716 return undef if($oThis->{xl_t_currow} >= $iRMax); 717 my $oWkS = $oThis->{xl_t_sheet}; 718 719#2. get row data 720 my @aRow = (); 721 my $iFlg = 0; 722 my $iR = $oThis->{xl_t_currow} + $oThis->{xl_t_datrow}; 723 while((!defined ($oThis->{xl_t_sheet}->{RowHeight}[$iR])|| 724 $oThis->{xl_t_sheet}->{RowHeight}[$iR] == 0) && 725 $skip_hidden) { 726 ++$iR; 727 ++$oThis->{xl_t_currow}; 728 return undef if $iRMax <= $iR - $oThis->{xl_t_datrow} - $HidRows; 729 }; 730 731 for(my $iC = $oThis->{xl_t_startcol} ; 732 $iC < $oThis->{xl_t_startcol}+$oThis->{xl_t_colcnt}; $iC++) { 733 next if($skip_hidden &&($oWkS->{ColWidth}[$iC] == 0)); 734 push @aRow, (defined $oWkS->{Cells}[$iR][$iC])? 735 $oWkS->{Cells}[$iR][$iC]->Value : undef; 736 $iFlg = 1 if(defined $oWkS->{Cells}[$iR][$iC]); 737 } 738 return undef unless($iFlg); #No Data 739 ++$oThis->{xl_t_currow}; 740 $oThis->{row} = (@aRow ? \@aRow : undef); 741 return \@aRow; 742} 743#------------------------------------------------------------------------------- 744# push_names (DBD::Excel::Statement) 745# Called with "CREATE TABLE" 746#------------------------------------------------------------------------------- 747sub push_names ($$$) { 748 my($oThis, $oData, $raNames) = @_; 749#1.get database handle 750 my $oBook = $oData->{Database}->{xl_book}; 751#2.add new worksheet 752 my $iWkN = $oBook->AddWorksheet($oThis->{xl_t_name}); 753 $oBook->{Worksheet}[$iWkN]->{MinCol}=0; 754 $oBook->{Worksheet}[$iWkN]->{MaxCol}=0; 755 756#2.1 set names 757 my @aColName =(); 758 my %hColName =(); 759 for(my $i = 0; $i<=$#$raNames; $i++) { 760 $oBook->AddCell($iWkN, 0, $i, $raNames->[$i], 0); 761 my $sWk = ($oData->{Database}->{xl_ignorecase})? 762 uc($raNames->[$i]) : $raNames->[$i]; 763 push @aColName, $sWk; 764 $hColName{$sWk} = $i; 765 } 766 $oThis->{xl_t_colcnt} = $#$raNames + 1; 767 $oThis->{xl_t_sheetno} = $iWkN; 768 $oThis->{xl_t_sheet} = $oBook->{Worksheet}[$iWkN]; 769 $oThis->{col_nums} = \%hColName; 770 $oThis->{col_names} = \@aColName; 771 return 1; 772} 773#------------------------------------------------------------------------------- 774# drop (DBD::Excel::Statement) 775# Called with "DROP TABLE" 776#------------------------------------------------------------------------------- 777sub drop ($$) { 778 my($oThis, $oData) = @_; 779 780 die "Cannot drop vtbl $oThis->{xl_t_vtbl} : " if(defined $oThis->{xl_t_vtbl}); 781 782#1. delete specified worksheet 783 my $oBook = $oData->{Database}->{xl_book}; 784 splice(@{$oBook->{Worksheet}}, $oThis->{xl_t_sheetno}, 1 ); 785 $oBook->{SheetCount}--; 786 787 my $rhTbl = $oData->{Database}->FETCH('xl_tbl'); 788 789 while(my($sTbl, $rhVal) = each(%$rhTbl)) { 790 $rhVal->{xl_t_sheetno}-- 791 if($rhVal->{xl_t_sheetno} > $oThis->{xl_t_sheetno}); 792 } 793 $rhTbl->{$oThis->{xl_t_name}} = undef; 794 795 return 1; 796} 797#------------------------------------------------------------------------------- 798# push_row (DBD::Excel::Statement) 799# Called with "INSERT" , "DELETE" and "UPDATE" 800#------------------------------------------------------------------------------- 801sub push_row ($$$) { 802 my($oThis, $oData, $raFields) = @_; 803 if((defined $oThis->{xl_t_datlmt}) && 804 ($oThis->{xl_t_currow} >= $oThis->{xl_t_datlmt})) { 805 die "Attempt to INSERT row over limit"; 806 return undef ; 807 } 808#1. add cells at current row 809 my @aFmt; 810 for(my $i = 0; $i<=$#$raFields; $i++) { 811 push @aFmt, 812 $oThis->{xl_t_sheet}->{Cells}[$oThis->{xl_t_datrow}][$oThis->{xl_t_startcol}+$i]->{FormatNo}; 813 } 814 for(my $i = 0; $i<$oThis->{xl_t_colcnt}; $i++) { 815 my $oFmt = $aFmt[$i]; 816 $oFmt ||= 0; 817 my $oFld = $raFields->[$i]; 818 $oFld ||= ''; 819 820 $oData->{Database}->{xl_book}->AddCell( 821 $oThis->{xl_t_sheetno}, 822 $oThis->{xl_t_currow} + $oThis->{xl_t_datrow}, 823 $i + $oThis->{xl_t_startcol}, 824 $oFld, 825 $oFmt 826 ); 827 } 828 ++$oThis->{xl_t_currow}; 829 return 1; 830} 831#------------------------------------------------------------------------------- 832# seek (DBD::Excel::Statement) 833# Called with "INSERT" , "DELETE" and "UPDATE" 834#------------------------------------------------------------------------------- 835sub seek ($$$$) { 836 my($oThis, $oData, $iPos, $iWhence) = @_; 837 838 my $iRow = $oThis->{xl_t_currow}; 839 if ($iWhence == 0) { 840 $iRow = $iPos; 841 } 842 elsif ($iWhence == 1) { 843 $iRow += $iPos; 844 } 845 elsif ($iWhence == 2) { 846 my $oWkS = $oThis->{xl_t_sheet}; 847 my $iRowMax = (defined $oThis->{xl_t_datlmt})? 848 $oThis->{xl_t_datlmt} : 849 ($oWkS->{MaxRow} - $oThis->{xl_t_datrow}); 850 my $iR; 851 for($iR = 0; $iR <= $iRowMax; $iR++) { 852 my $iFlg=0; 853 for(my $iC = $oThis->{xl_t_startcol}; 854 $iC < $oThis->{xl_t_startcol} + $oThis->{xl_t_colcnt}; 855 $iC++) { 856 if(defined $oWkS->{Cells}[$iR+$oThis->{xl_t_datrow}][$iC]) { 857 $iFlg = 1; 858 last; 859 } 860 } 861 last unless($iFlg); 862 } 863 $iRow = $iR + $iPos; 864 } 865 else { 866 die $oThis . "->seek: Illegal whence argument ($iWhence)"; 867 } 868 if ($iRow < 0) { 869 die "Illegal row number: $iRow"; 870 } 871 return $oThis->{xl_t_currow} = $iRow; 872} 873#------------------------------------------------------------------------------- 874# truncate (DBD::Excel::Statement) 875# Called with "DELETE" and "UPDATE" 876#------------------------------------------------------------------------------- 877sub truncate ($$) { 878 my($oThis, $oData) = @_; 879 for(my $iC = $oThis->{xl_t_startcol}; 880 $iC < $oThis->{xl_t_startcol} + $oThis->{xl_t_colcnt}; $iC++) { 881 $oThis->{xl_t_sheet}->{Cells}[$oThis->{xl_t_currow}+$oThis->{xl_t_datrow}][$iC] = undef; 882 } 883 $oThis->{xl_t_sheet}->{MaxRow} = $oThis->{xl_t_currow}+$oThis->{xl_t_datrow} - 1 884 unless($oThis->{xl_t_vtbl}); 885 return 1; 886} 8871; 888 889__END__ 890 891=head1 NAME 892 893DBD::Excel - A class for DBI drivers that act on Excel File. 894 895This is still B<alpha version>. 896 897=head1 SYNOPSIS 898 899 use DBI; 900 $hDb = DBI->connect("DBI:Excel:file=test.xls") 901 or die "Cannot connect: " . $DBI::errstr; 902 $hSt = $hDb->prepare("CREATE TABLE a (id INTEGER, name CHAR(10))") 903 or die "Cannot prepare: " . $hDb->errstr(); 904 $hSt->execute() or die "Cannot execute: " . $hSt->errstr(); 905 $hSt->finish(); 906 $hDb->disconnect(); 907 908=head1 DESCRIPTION 909 910This is still B<alpha version>. 911 912The DBD::Excel module is a DBI driver. 913The module is based on these modules: 914 915=over 4 916 917=item * 918Spreadsheet::ParseExcel 919 920reads Excel files. 921 922=item * 923Spreadsheet::WriteExcel 924 925writes Excel files. 926 927=item * 928SQL::Statement 929 930a simple SQL engine. 931 932=item * 933DBI 934 935Of course. :-) 936 937=back 938 939This module assumes TABLE = Worksheet. 940The contents of first row of each worksheet as column name. 941 942Adding that, this module accept temporary table definition at "connect" method 943with "xl_vtbl". 944 945ex. 946 my $hDb = DBI->connect( 947 "DBI:Excel:file=dbdtest.xls", undef, undef, 948 {xl_vtbl => 949 {TESTV => 950 { 951 sheetName => 'TEST_V', 952 ttlRow => 5, 953 startCol => 1, 954 colCnt => 4, 955 datRow => 6, 956 datLmt => 4, 957 } 958 } 959 }); 960 961For more information please refer sample/tex.pl included in this distribution. 962 963=head2 Metadata 964 965The following attributes are handled by DBI itself and not by DBD::Excel, 966thus they all work like expected: 967 968 Active 969 ActiveKids 970 CachedKids 971 CompatMode (Not used) 972 InactiveDestroy 973 Kids 974 PrintError 975 RaiseError 976 Warn (Not used) 977 978The following DBI attributes are handled by DBD::Excel: 979 980=over 4 981 982=item AutoCommit 983 984Always on 985 986=item ChopBlanks 987 988Works 989 990=item NUM_OF_FIELDS 991 992Valid after C<$hSt-E<gt>execute> 993 994=item NUM_OF_PARAMS 995 996Valid after C<$hSt-E<gt>prepare> 997 998=item NAME 999 1000Valid after C<$hSt-E<gt>execute>; undef for Non-Select statements. 1001 1002=item NULLABLE 1003 1004Not really working, always returns an array ref of one's. 1005Valid after C<$hSt-E<gt>execute>; undef for Non-Select statements. 1006 1007=back 1008 1009These attributes and methods are not supported: 1010 1011 bind_param_inout 1012 CursorName 1013 LongReadLen 1014 LongTruncOk 1015 1016Additional to the DBI attributes, you can use the following dbh 1017attribute: 1018 1019=over 4 1020 1021=item xl_fmt 1022 1023This attribute is used for setting the formatter class for parsing. 1024 1025=item xl_dir 1026 1027This attribute is used only with C<data_sources> on setting the directory where 1028Excel files ('*.xls') are searched. It defaults to the current directory ("."). 1029 1030=item xl_vtbl 1031 1032assumes specified area as a table. 1033I<See sample/tex.pl>. 1034 1035=item xl_skiphidden 1036 1037skip hidden rows(=row height is 0) and hidden columns(=column width is 0). 1038I<See sample/thidden.pl>. 1039 1040=item xl_ignorecase 1041 1042set casesensitive or not about table name and columns. 1043Default is sensitive (maybe as SQL::Statement). 1044I<See sample/thidden.pl>. 1045 1046=back 1047 1048 1049=head2 Driver private methods 1050 1051=over 4 1052 1053=item data_sources 1054 1055The C<data_sources> method returns a list of '*.xls' files of the current 1056directory in the form "DBI:Excel:xl_dir=$dirname". 1057 1058If you want to read the subdirectories of another directory, use 1059 1060 my($hDr) = DBI->install_driver("Excel"); 1061 my(@list) = $hDr->data_sources( 1062 { xl_dir => '/usr/local/xl_data' } ); 1063 1064=item list_tables 1065 1066This method returns a list of sheet names contained in the $hDb->{file}. 1067Example: 1068 1069 my $hDb = DBI->connect("DBI:Excel:file=test.xls"); 1070 my @list = $hDb->func('list_tables'); 1071 1072=back 1073 1074 1075=head1 TODO 1076 1077=over 4 1078 1079=item More tests 1080 1081First of all... 1082 1083=item Type and Format 1084 1085The current version not support date/time and text formating. 1086 1087=item Joins 1088 1089The current version of the module works with single table SELECT's 1090only, although the basic design of the SQL::Statement module allows 1091joins and the likes. 1092 1093=back 1094 1095 1096=head1 KNOWN BUGS 1097 1098=over 8 1099 1100=item * 1101 1102There are too many TODO things. So I can't determind what is BUG. :-) 1103 1104=back 1105 1106=head1 AUTHOR 1107 1108Kawai Takanori (Hippo2000) kwitknr@cpan.org 1109 1110 Homepage: 1111 http://member.nifty.ne.jp/hippo2000/ (Japanese) 1112 http://member.nifty.ne.jp/hippo2000/index_e.htm (English) 1113 1114 Wiki: 1115 http://www.hippo2000.net/cgi-bin/KbWiki/KbWiki.pl (Japanese) 1116 http://www.hippo2000.net/cgi-bin/KbWikiE/KbWiki.pl (English) 1117 1118=head1 SEE ALSO 1119 1120DBI, Spreadsheet::WriteExcel, Spreadsheet::ParseExcel, SQL::Statement 1121 1122 1123=head1 COPYRIGHT 1124 1125Copyright (c) 2001 KAWAI,Takanori 1126All rights reserved. 1127 1128You may distribute under the terms of either the GNU General Public 1129License or the Artistic License, as specified in the Perl README file. 1130 1131=cut 1132