| [ Index ] |
PHP Cross Reference of Unnamed Project |
[Summary view] [Print] [Text view]
1 # -*- perl -*- 2 # 3 # DBD::File - A base class for implementing DBI drivers that 4 # act on plain files 5 # 6 # This module is currently maintained by 7 # 8 # Jeff Zucker < jzucker AT cpan.org > 9 # 10 # The original author is Jochen Wiedmann. 11 # 12 # Copyright (C) 2004 by Jeff Zucker 13 # Copyright (C) 1998 by Jochen Wiedmann 14 # 15 # All rights reserved. 16 # 17 # You may distribute this module under the terms of either the GNU 18 # General Public License or the Artistic License, as specified in 19 # the Perl README file. 20 # 21 require 5.004; 22 use strict; 23 24 use DBI (); 25 require DBI::SQL::Nano; 26 my $haveFileSpec = eval { require File::Spec }; 27 28 package DBD::File; 29 30 use vars qw(@ISA $VERSION $drh $valid_attrs); 31 32 $VERSION = '0.35'; 33 34 $drh = undef; # holds driver handle(s) once initialised 35 36 sub driver ($;$) { 37 my($class, $attr) = @_; 38 39 # Drivers typically use a singleton object for the $drh 40 # We use a hash here to have one singleton per subclass. 41 # (Otherwise DBD::CSV and DBD::DBM, for example, would 42 # share the same driver object which would cause problems.) 43 # An alternative would be not not cache the $drh here at all 44 # and require that subclasses do that. Subclasses should do 45 # their own caching, so caching here just provides extra safety. 46 return $drh->{$class} if $drh->{$class}; 47 48 DBI->setup_driver('DBD::File'); # only needed once but harmless to repeat 49 $attr ||= {}; 50 no strict qw(refs); 51 if (!$attr->{Attribution}) { 52 $attr->{Attribution} = "$class by Jeff Zucker" 53 if $class eq 'DBD::File'; 54 $attr->{Attribution} ||= ${$class . '::ATTRIBUTION'} 55 || "oops the author of $class forgot to define this"; 56 } 57 $attr->{Version} ||= ${$class . '::VERSION'}; 58 ($attr->{Name} = $class) =~ s/^DBD\:\:// unless $attr->{Name}; 59 60 $drh->{$class} = DBI::_new_drh($class . "::dr", $attr); 61 $drh->{$class}->STORE(ShowErrorStatement => 1); 62 return $drh->{$class}; 63 } 64 65 sub CLONE { 66 undef $drh; 67 } 68 69 package DBD::File::dr; # ====== DRIVER ====== 70 71 $DBD::File::dr::imp_data_size = 0; 72 73 sub connect ($$;$$$) { 74 my($drh, $dbname, $user, $auth, $attr)= @_; 75 76 # create a 'blank' dbh 77 my $this = DBI::_new_dbh($drh, { 78 'Name' => $dbname, 79 'USER' => $user, 80 'CURRENT_USER' => $user, 81 }); 82 83 if ($this) { 84 my($var, $val); 85 $this->{f_dir} = $haveFileSpec ? File::Spec->curdir() : '.'; 86 while (length($dbname)) { 87 if ($dbname =~ s/^((?:[^\\;]|\\.)*?);//s) { 88 $var = $1; 89 } else { 90 $var = $dbname; 91 $dbname = ''; 92 } 93 if ($var =~ /^(.+?)=(.*)/s) { 94 $var = $1; 95 ($val = $2) =~ s/\\(.)/$1/g; 96 $this->{$var} = $val; 97 } 98 } 99 $this->{f_valid_attrs} = { 100 f_version => 1 # DBD::File version 101 , f_dir => 1 # base directory 102 , f_tables => 1 # base directory 103 }; 104 $this->{sql_valid_attrs} = { 105 sql_handler => 1 # Nano or S:S 106 , sql_nano_version => 1 # Nano version 107 , sql_statement_version => 1 # S:S version 108 }; 109 } 110 $this->STORE('Active',1); 111 return set_versions($this); 112 } 113 114 sub set_versions { 115 my $this = shift; 116 $this->{f_version} = $DBD::File::VERSION; 117 for (qw( nano_version statement_version)) { 118 $this->{'sql_'.$_} = $DBI::SQL::Nano::versions->{$_}||''; 119 } 120 $this->{sql_handler} = ($this->{sql_statement_version}) 121 ? 'SQL::Statement' 122 : 'DBI::SQL::Nano'; 123 return $this; 124 } 125 126 sub data_sources ($;$) { 127 my($drh, $attr) = @_; 128 my($dir) = ($attr and exists($attr->{'f_dir'})) ? 129 $attr->{'f_dir'} : $haveFileSpec ? File::Spec->curdir() : '.'; 130 my($dirh) = Symbol::gensym(); 131 if (!opendir($dirh, $dir)) { 132 $drh->set_err($DBI::stderr, "Cannot open directory $dir: $!"); 133 return undef; 134 } 135 my($file, @dsns, %names, $driver); 136 if ($drh->{'ImplementorClass'} =~ /^dbd\:\:([^\:]+)\:\:/i) { 137 $driver = $1; 138 } else { 139 $driver = 'File'; 140 } 141 while (defined($file = readdir($dirh))) { 142 if ($^O eq 'VMS') { 143 # if on VMS then avoid warnings from catdir if you use a file 144 # (not a dir) as the file below 145 next if $file !~ /\.dir$/oi; 146 } 147 my $d = $haveFileSpec ? 148 File::Spec->catdir($dir, $file) : "$dir/$file"; 149 # allow current dir ... it can be a data_source too 150 if ( $file ne ($haveFileSpec ? File::Spec->updir() : '..') 151 and -d $d) { 152 push(@dsns, "DBI:$driver:f_dir=$d"); 153 } 154 } 155 @dsns; 156 } 157 158 sub disconnect_all { 159 } 160 161 sub DESTROY { 162 undef; 163 } 164 165 166 package DBD::File::db; # ====== DATABASE ====== 167 168 $DBD::File::db::imp_data_size = 0; 169 170 sub ping { return (shift->FETCH('Active')) ? 1 : 0 }; 171 172 sub prepare ($$;@) { 173 my($dbh, $statement, @attribs)= @_; 174 175 # create a 'blank' sth 176 my $sth = DBI::_new_sth($dbh, {'Statement' => $statement}); 177 178 if ($sth) { 179 my $class = $sth->FETCH('ImplementorClass'); 180 $class =~ s/::st$/::Statement/; 181 my($stmt); 182 183 # if using SQL::Statement version > 1 184 # cache the parser object if the DBD supports parser caching 185 # SQL::Nano and older SQL::Statements don't support this 186 187 if ( $dbh->{sql_handler} eq 'SQL::Statement' 188 and $dbh->{sql_statement_version} > 1) 189 { 190 my $parser = $dbh->{csv_sql_parser_object}; 191 $parser ||= eval { $dbh->func('csv_cache_sql_parser_object') }; 192 if ($@) { 193 $stmt = eval { $class->new($statement) }; 194 } 195 else { 196 $stmt = eval { $class->new($statement,$parser) }; 197 } 198 } 199 else { 200 $stmt = eval { $class->new($statement) }; 201 } 202 if ($@) { 203 $dbh->set_err($DBI::stderr, $@); 204 undef $sth; 205 } else { 206 $sth->STORE('f_stmt', $stmt); 207 $sth->STORE('f_params', []); 208 $sth->STORE('NUM_OF_PARAMS', scalar($stmt->params())); 209 } 210 } 211 $sth; 212 } 213 sub csv_cache_sql_parser_object { 214 my $dbh = shift; 215 my $parser = { 216 dialect => 'CSV', 217 RaiseError => $dbh->FETCH('RaiseError'), 218 PrintError => $dbh->FETCH('PrintError'), 219 }; 220 my $sql_flags = $dbh->FETCH('sql_flags') || {}; 221 %$parser = (%$parser,%$sql_flags); 222 $parser = SQL::Parser->new($parser->{dialect},$parser); 223 $dbh->{csv_sql_parser_object} = $parser; 224 return $parser; 225 } 226 sub disconnect ($) { 227 shift->STORE('Active',0); 228 1; 229 } 230 sub FETCH ($$) { 231 my ($dbh, $attrib) = @_; 232 if ($attrib eq 'AutoCommit') { 233 return 1; 234 } elsif ($attrib eq (lc $attrib)) { 235 # Driver private attributes are lower cased 236 237 # Error-check for valid attributes 238 # not implemented yet, see STORE 239 # 240 return $dbh->{$attrib}; 241 } 242 # else pass up to DBI to handle 243 return $dbh->SUPER::FETCH($attrib); 244 } 245 246 sub STORE ($$$) { 247 my ($dbh, $attrib, $value) = @_; 248 249 if ($attrib eq 'AutoCommit') { 250 return 1 if $value; # is already set 251 die("Can't disable AutoCommit"); 252 } elsif ($attrib eq (lc $attrib)) { 253 # Driver private attributes are lower cased 254 255 # I'm not implementing this yet becuase other drivers may be 256 # setting f_ and sql_ attrs I don't know about 257 # I'll investigate and publicize warnings to DBD authors 258 # then implement this 259 # 260 # return to implementor if not f_ or sql_ 261 # not implemented yet 262 # my $class = $dbh->FETCH('ImplementorClass'); 263 # 264 # if ( !$dbh->{f_valid_attrs}->{$attrib} 265 # and !$dbh->{sql_valid_attrs}->{$attrib} 266 # ) { 267 # return $dbh->set_err( $DBI::stderr,"Invalid attribute '$attrib'"); 268 # } 269 # else { 270 # $dbh->{$attrib} = $value; 271 # } 272 273 if ($attrib eq 'f_dir') { 274 return $dbh->set_err( $DBI::stderr,"No such directory '$value'") 275 unless -d $value; 276 } 277 $dbh->{$attrib} = $value; 278 return 1; 279 } 280 return $dbh->SUPER::STORE($attrib, $value); 281 } 282 283 sub DESTROY ($) { 284 my $dbh = shift; 285 $dbh->disconnect if $dbh->SUPER::FETCH('Active'); 286 } 287 288 sub type_info_all ($) { 289 [ 290 { TYPE_NAME => 0, 291 DATA_TYPE => 1, 292 PRECISION => 2, 293 LITERAL_PREFIX => 3, 294 LITERAL_SUFFIX => 4, 295 CREATE_PARAMS => 5, 296 NULLABLE => 6, 297 CASE_SENSITIVE => 7, 298 SEARCHABLE => 8, 299 UNSIGNED_ATTRIBUTE=> 9, 300 MONEY => 10, 301 AUTO_INCREMENT => 11, 302 LOCAL_TYPE_NAME => 12, 303 MINIMUM_SCALE => 13, 304 MAXIMUM_SCALE => 14, 305 }, 306 [ 'VARCHAR', DBI::SQL_VARCHAR(), 307 undef, "'","'", undef,0, 1,1,0,0,0,undef,1,999999 308 ], 309 [ 'CHAR', DBI::SQL_CHAR(), 310 undef, "'","'", undef,0, 1,1,0,0,0,undef,1,999999 311 ], 312 [ 'INTEGER', DBI::SQL_INTEGER(), 313 undef, "", "", undef,0, 0,1,0,0,0,undef,0, 0 314 ], 315 [ 'REAL', DBI::SQL_REAL(), 316 undef, "", "", undef,0, 0,1,0,0,0,undef,0, 0 317 ], 318 [ 'BLOB', DBI::SQL_LONGVARBINARY(), 319 undef, "'","'", undef,0, 1,1,0,0,0,undef,1,999999 320 ], 321 [ 'BLOB', DBI::SQL_LONGVARBINARY(), 322 undef, "'","'", undef,0, 1,1,0,0,0,undef,1,999999 323 ], 324 [ 'TEXT', DBI::SQL_LONGVARCHAR(), 325 undef, "'","'", undef,0, 1,1,0,0,0,undef,1,999999 326 ] 327 ] 328 } 329 330 331 { 332 my $names = ['TABLE_QUALIFIER', 'TABLE_OWNER', 'TABLE_NAME', 333 'TABLE_TYPE', 'REMARKS']; 334 335 sub table_info ($) { 336 my($dbh) = @_; 337 my($dir) = $dbh->{f_dir}; 338 my($dirh) = Symbol::gensym(); 339 if (!opendir($dirh, $dir)) { 340 $dbh->set_err($DBI::stderr, "Cannot open directory $dir: $!"); 341 return undef; 342 } 343 my($file, @tables, %names); 344 while (defined($file = readdir($dirh))) { 345 if ($file ne '.' && $file ne '..' && -f "$dir/$file") { 346 my $user = eval { getpwuid((stat(_))[4]) }; 347 push(@tables, [undef, $user, $file, "TABLE", undef]); 348 } 349 } 350 if (!closedir($dirh)) { 351 $dbh->set_err($DBI::stderr, "Cannot close directory $dir: $!"); 352 return undef; 353 } 354 355 my $dbh2 = $dbh->{'csv_sponge_driver'}; 356 if (!$dbh2) { 357 $dbh2 = $dbh->{'csv_sponge_driver'} = DBI->connect("DBI:Sponge:"); 358 if (!$dbh2) { 359 $dbh->set_err($DBI::stderr, $DBI::errstr); 360 return undef; 361 } 362 } 363 364 # Temporary kludge: DBD::Sponge dies if @tables is empty. :-( 365 return undef if !@tables; 366 367 my $sth = $dbh2->prepare("TABLE_INFO", { 'rows' => \@tables, 368 'NAMES' => $names }); 369 if (!$sth) { 370 $dbh->set_err($DBI::stderr, $dbh2->errstr); 371 } 372 $sth; 373 } 374 } 375 sub list_tables ($) { 376 my $dbh = shift; 377 my($sth, @tables); 378 if (!($sth = $dbh->table_info())) { 379 return (); 380 } 381 while (my $ref = $sth->fetchrow_arrayref()) { 382 push(@tables, $ref->[2]); 383 } 384 @tables; 385 } 386 387 sub quote ($$;$) { 388 my($self, $str, $type) = @_; 389 if (!defined($str)) { return "NULL" } 390 if (defined($type) && 391 ($type == DBI::SQL_NUMERIC() || 392 $type == DBI::SQL_DECIMAL() || 393 $type == DBI::SQL_INTEGER() || 394 $type == DBI::SQL_SMALLINT() || 395 $type == DBI::SQL_FLOAT() || 396 $type == DBI::SQL_REAL() || 397 $type == DBI::SQL_DOUBLE() || 398 $type == DBI::SQL_TINYINT())) { 399 return $str; 400 } 401 $str =~ s/\\/\\\\/sg; 402 $str =~ s/\0/\\0/sg; 403 $str =~ s/\'/\\\'/sg; 404 $str =~ s/\n/\\n/sg; 405 $str =~ s/\r/\\r/sg; 406 "'$str'"; 407 } 408 409 sub commit ($) { 410 my($dbh) = shift; 411 if ($dbh->FETCH('Warn')) { 412 warn("Commit ineffective while AutoCommit is on", -1); 413 } 414 1; 415 } 416 417 sub rollback ($) { 418 my($dbh) = shift; 419 if ($dbh->FETCH('Warn')) { 420 warn("Rollback ineffective while AutoCommit is on", -1); 421 } 422 0; 423 } 424 425 package DBD::File::st; # ====== STATEMENT ====== 426 427 $DBD::File::st::imp_data_size = 0; 428 429 sub bind_param ($$$;$) { 430 my($sth, $pNum, $val, $attr) = @_; 431 $sth->{f_params}->[$pNum-1] = $val; 432 1; 433 } 434 435 sub execute { 436 my $sth = shift; 437 my $params; 438 if (@_) { 439 $sth->{'f_params'} = ($params = [@_]); 440 } else { 441 $params = $sth->{'f_params'}; 442 } 443 444 $sth->finish; 445 my $stmt = $sth->{'f_stmt'}; 446 my $result = eval { $stmt->execute($sth, $params); }; 447 return $sth->set_err($DBI::stderr,$@) if $@; 448 if ($stmt->{'NUM_OF_FIELDS'}) { # is a SELECT statement 449 $sth->STORE(Active => 1); 450 $sth->STORE('NUM_OF_FIELDS', $stmt->{'NUM_OF_FIELDS'}) 451 if !$sth->FETCH('NUM_OF_FIELDS'); 452 } 453 return $result; 454 } 455 sub finish { 456 my $sth = shift; 457 $sth->SUPER::STORE(Active => 0); 458 delete $sth->{f_stmt}->{data}; 459 return 1; 460 } 461 sub fetch ($) { 462 my $sth = shift; 463 my $data = $sth->{f_stmt}->{data}; 464 if (!$data || ref($data) ne 'ARRAY') { 465 $sth->set_err($DBI::stderr, "Attempt to fetch row without a preceeding execute() call or from a non-SELECT statement"); 466 return undef; 467 } 468 my $dav = shift @$data; 469 if (!$dav) { 470 $sth->finish; 471 return undef; 472 } 473 if ($sth->FETCH('ChopBlanks')) { 474 map { $_ =~ s/\s+$// if $_; $_ } @$dav; 475 } 476 $sth->_set_fbav($dav); 477 } 478 *fetchrow_arrayref = \&fetch; 479 480 sub FETCH ($$) { 481 my ($sth, $attrib) = @_; 482 return undef if ($attrib eq 'TYPE'); # Workaround for a bug in DBI 0.93 483 return $sth->FETCH('f_stmt')->{'NAME'} if ($attrib eq 'NAME'); 484 if ($attrib eq 'NULLABLE') { 485 my($meta) = $sth->FETCH('f_stmt')->{'NAME'}; # Intentional ! 486 if (!$meta) { 487 return undef; 488 } 489 my($names) = []; 490 my($col); 491 foreach $col (@$meta) { 492 push(@$names, 1); 493 } 494 return $names; 495 } 496 if ($attrib eq (lc $attrib)) { 497 # Private driver attributes are lower cased 498 return $sth->{$attrib}; 499 } 500 # else pass up to DBI to handle 501 return $sth->SUPER::FETCH($attrib); 502 } 503 504 sub STORE ($$$) { 505 my ($sth, $attrib, $value) = @_; 506 if ($attrib eq (lc $attrib)) { 507 # Private driver attributes are lower cased 508 $sth->{$attrib} = $value; 509 return 1; 510 } 511 return $sth->SUPER::STORE($attrib, $value); 512 } 513 514 sub DESTROY ($) { 515 my $sth = shift; 516 $sth->finish if $sth->SUPER::FETCH('Active'); 517 } 518 519 sub rows ($) { shift->{'f_stmt'}->{'NUM_OF_ROWS'} }; 520 521 522 package DBD::File::Statement; 523 524 # We may have a working flock() built-in but that doesn't mean that locking 525 # will work on NFS (flock() may hang hard) 526 my $locking = eval { flock STDOUT, 0; 1 }; 527 528 # Jochen's old check for flock() 529 # 530 # my $locking = $^O ne 'MacOS' && 531 # ($^O ne 'MSWin32' || !Win32::IsWin95()) && 532 # $^O ne 'VMS'; 533 534 @DBD::File::Statement::ISA = qw(DBI::SQL::Nano::Statement); 535 536 my $open_table_re = 537 $haveFileSpec ? 538 sprintf('(?:%s|%s|%s)', 539 quotemeta(File::Spec->curdir()), 540 quotemeta(File::Spec->updir()), 541 quotemeta(File::Spec->rootdir())) 542 : '(?:\.?\.)?\/'; 543 544 sub get_file_name($$$) { 545 my($self,$data,$table)=@_; 546 $table =~ s/^\"//; # handle quoted identifiers 547 $table =~ s/\"$//; 548 my $file = $table; 549 if ( $file !~ /^$open_table_re/o 550 and $file !~ m!^[/\\]! # root 551 and $file !~ m!^[a-z]\:! # drive letter 552 ) { 553 $file = $haveFileSpec ? 554 File::Spec->catfile($data->{Database}->{'f_dir'}, $table) 555 : $data->{Database}->{'f_dir'} . "/$table"; 556 } 557 return($table,$file); 558 } 559 560 sub open_table ($$$$$) { 561 my($self, $data, $table, $createMode, $lockMode) = @_; 562 my $file; 563 ($table,$file) = $self->get_file_name($data,$table); 564 require IO::File; 565 my $fh; 566 my $safe_drop = 1 if $self->{ignore_missing_table}; 567 if ($createMode) { 568 if (-f $file) { 569 die "Cannot create table $table: Already exists"; 570 } 571 if (!($fh = IO::File->new($file, "a+"))) { 572 die "Cannot open $file for writing: $!"; 573 } 574 if (!$fh->seek(0, 0)) { 575 die " Error while seeking back: $!"; 576 } 577 } else { 578 if (!($fh = IO::File->new($file, ($lockMode ? "r+" : "r")))) { 579 die " Cannot open $file: $!" unless $safe_drop; 580 } 581 } 582 binmode($fh) if $fh; 583 if ($locking and $fh) { 584 if ($lockMode) { 585 if (!flock($fh, 2)) { 586 die " Cannot obtain exclusive lock on $file: $!"; 587 } 588 } else { 589 if (!flock($fh, 1)) { 590 die "Cannot obtain shared lock on $file: $!"; 591 } 592 } 593 } 594 my $columns = {}; 595 my $array = []; 596 my $pos = $fh->tell() if $fh; 597 my $tbl = { 598 file => $file, 599 fh => $fh, 600 col_nums => $columns, 601 col_names => $array, 602 first_row_pos => $pos, 603 }; 604 my $class = ref($self); 605 $class =~ s/::Statement/::Table/; 606 bless($tbl, $class); 607 $tbl; 608 } 609 610 611 package DBD::File::Table; 612 613 @DBD::File::Table::ISA = qw(DBI::SQL::Nano::Table); 614 615 sub drop ($) { 616 my($self) = @_; 617 # We have to close the file before unlinking it: Some OS'es will 618 # refuse the unlink otherwise. 619 $self->{'fh'}->close() if $self->{fh}; 620 unlink($self->{'file'}); 621 return 1; 622 } 623 624 sub seek ($$$$) { 625 my($self, $data, $pos, $whence) = @_; 626 if ($whence == 0 && $pos == 0) { 627 $pos = $self->{'first_row_pos'}; 628 } elsif ($whence != 2 || $pos != 0) { 629 die "Illegal seek position: pos = $pos, whence = $whence"; 630 } 631 if (!$self->{'fh'}->seek($pos, $whence)) { 632 die "Error while seeking in " . $self->{'file'} . ": $!"; 633 } 634 } 635 636 sub truncate ($$) { 637 my($self, $data) = @_; 638 if (!$self->{'fh'}->truncate($self->{'fh'}->tell())) { 639 die "Error while truncating " . $self->{'file'} . ": $!"; 640 } 641 1; 642 } 643 644 1; 645 646 647 __END__ 648 649 =head1 NAME 650 651 DBD::File - Base class for writing DBI drivers 652 653 =head1 SYNOPSIS 654 655 This module is a base class for writing other DBDs. 656 It is not intended to function as a DBD itself. 657 If you want to access flatfiles, use DBD::AnyData, or DBD::CSV, 658 (both of which are subclasses of DBD::File). 659 660 =head1 DESCRIPTION 661 662 The DBD::File module is not a true DBI driver, but an abstract 663 base class for deriving concrete DBI drivers from it. The implication is, 664 that these drivers work with plain files, for example CSV files or 665 INI files. The module is based on the SQL::Statement module, a simple 666 SQL engine. 667 668 See L<DBI> for details on DBI, L<SQL::Statement> for details on 669 SQL::Statement and L<DBD::CSV> or L<DBD::IniFile> for example 670 drivers. 671 672 673 =head2 Metadata 674 675 The following attributes are handled by DBI itself and not by DBD::File, 676 thus they all work like expected: 677 678 Active 679 ActiveKids 680 CachedKids 681 CompatMode (Not used) 682 InactiveDestroy 683 Kids 684 PrintError 685 RaiseError 686 Warn (Not used) 687 688 The following DBI attributes are handled by DBD::File: 689 690 =over 4 691 692 =item AutoCommit 693 694 Always on 695 696 =item ChopBlanks 697 698 Works 699 700 =item NUM_OF_FIELDS 701 702 Valid after C<$sth->execute> 703 704 =item NUM_OF_PARAMS 705 706 Valid after C<$sth->prepare> 707 708 =item NAME 709 710 Valid after C<$sth->execute>; undef for Non-Select statements. 711 712 =item NULLABLE 713 714 Not really working, always returns an array ref of one's, as DBD::CSV 715 doesn't verify input data. Valid after C<$sth->execute>; undef for 716 Non-Select statements. 717 718 =back 719 720 These attributes and methods are not supported: 721 722 bind_param_inout 723 CursorName 724 LongReadLen 725 LongTruncOk 726 727 Additional to the DBI attributes, you can use the following dbh 728 attribute: 729 730 =over 4 731 732 =item f_dir 733 734 This attribute is used for setting the directory where CSV files are 735 opened. Usually you set it in the dbh, it defaults to the current 736 directory ("."). However, it is overwritable in the statement handles. 737 738 =back 739 740 741 =head2 Driver private methods 742 743 =over 4 744 745 =item data_sources 746 747 The C<data_sources> method returns a list of subdirectories of the current 748 directory in the form "DBI:CSV:f_dir=$dirname". 749 750 If you want to read the subdirectories of another directory, use 751 752 my($drh) = DBI->install_driver("CSV"); 753 my(@list) = $drh->data_sources('f_dir' => '/usr/local/csv_data' ); 754 755 =item list_tables 756 757 This method returns a list of file names inside $dbh->{'f_dir'}. 758 Example: 759 760 my($dbh) = DBI->connect("DBI:CSV:f_dir=/usr/local/csv_data"); 761 my(@list) = $dbh->func('list_tables'); 762 763 Note that the list includes all files contained in the directory, even 764 those that have non-valid table names, from the view of SQL. 765 766 =back 767 768 =head1 KNOWN BUGS 769 770 =over 8 771 772 =item * 773 774 The module is using flock() internally. However, this function is not 775 available on all platforms. Using flock() is disabled on MacOS and 776 Windows 95: There's no locking at all (perhaps not so important on 777 MacOS and Windows 95, as there's a single user anyways). 778 779 =back 780 781 782 =head1 AUTHOR AND COPYRIGHT 783 784 This module is currently maintained by 785 786 Jeff Zucker < jzucker @ cpan.org > 787 788 The original author is Jochen Wiedmann. 789 790 Copyright (C) 2004 by Jeff Zucker 791 Copyright (C) 1998 by Jochen Wiedmann 792 793 All rights reserved. 794 795 You may freely distribute and/or modify this module under the terms of either the GNU General Public License (GPL) or the Artistic License, as specified in 796 the Perl README file. 797 798 =head1 SEE ALSO 799 800 L<DBI>, L<Text::CSV_XS>, L<SQL::Statement> 801 802 803 =cut
title
Description
Body
title
Description
Body
title
Description
Body
title
Body
| Generated: Tue Mar 17 22:47:18 2015 | Cross-referenced by PHPXref 0.7.1 |