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