[svn:dbi] rev 343 - dbi/trunk/lib/DBD

[jzucker]

Author: jzucker
Date: Fri May 14 13:55:22 2004
New Revision: 343

Modified:
   dbi/trunk/lib/DBD/DBM.pm
   dbi/trunk/lib/DBD/File.pm
Log:
Active & drh fixes, schema storage for Class::DBI

Modified: dbi/trunk/lib/DBD/DBM.pm
==============================================================================
--- dbi/trunk/lib/DBD/DBM.pm    (original)
+++ dbi/trunk/lib/DBD/DBM.pm    Fri May 14 13:55:22 2004
@@ -45,6 +45,7 @@
     #
     if ( $DBI::VERSION >= 1.37 and !$methods_already_installed++ ) {
         DBD::DBM::db->install_method('dbm_versions');
+        DBD::DBM::st->install_method('dbm_schema');
     }
 
     $this;
@@ -127,6 +128,7 @@
                              ? 'SQL::Statement'
                             : 'DBI::SQL::Nano';
     }
+    $this->STORE('Active',1);
     return $this;
 }
 
@@ -239,6 +241,14 @@
 $DBD::DBM::st::imp_data_size = 0;
 @DBD::DBM::st::ISA = qw(DBD::File::st);
 
+sub dbm_schema {
+    my($sth,$tname)[EMAIL PROTECTED];
+    return $sth->set_err(1,'No table name supplied!') unless $tname;
+    return $sth->set_err(1,"Unknown table '$tname'!")
+       unless $sth->{Database}->{dbm_tables}
+          and $sth->{Database}->{dbm_tables}->{$tname};
+    return $sth->{Database}->{dbm_tables}->{$tname}->{schema};
+}
 # you could put some :st private methods here
 
 # you may need to over-ride some DBD::File::st methods here
@@ -389,13 +399,20 @@
        $store = 1 unless defined $store;
     $dbh->{dbm_tables}->{$tname}->{store_metadata} = $store;
 
-    my $col_names = $h{"_metadata \0"} if $store;
+    my($meta_data,$schema,$col_names);
+    $meta_data = $col_names = $h{"_metadata \0"} if $store;
+    if ($meta_data and $meta_data =~ m~<dbd_metadata>(.+)</dbd_metadata>~is) {
+        $schema  = $col_names = $1;
+        $schema  =~ s~.*<schema>(.+)</schema>.*~$1~is;
+        $col_names =~ s~.*<col_names>(.+)</col_names>.*~$1~is;
+    }
     $col_names ||= $dbh->{dbm_tables}->{$tname}->{c_cols}
                || $dbh->{dbm_tables}->{$tname}->{cols}
                || $dbh->{dbm_cols}
                || ['k','v'];
     $col_names = [split /,/,$col_names] if (ref $col_names ne 'ARRAY');
-    $dbh->{dbm_tables}->{$tname}->{cols} = $col_names;
+    $dbh->{dbm_tables}->{$tname}->{cols}   = $col_names;
+    $dbh->{dbm_tables}->{$tname}->{schema} = $schema;
 
     my $i;
     my %col_nums  = map { $_ => $i++ } @$col_names;
@@ -572,8 +589,17 @@
     my($self, $data, $row_aryref) = @_;
     $data->{Database}->{dbm_tables}->{$self->{table_name}}->{c_cols}
        = $row_aryref;
-    $self->{hash}->{"_metadata \0"} = join(',',@{$row_aryref})
-        if $self->{store_metadata};
+    next unless $self->{store_metadata};
+    my $stmt = $data->{f_stmt};
+    my $col_names = join ',', @{$row_aryref};
+    my $schema = $data->{Database}->{Statement};
+       $schema =~ s/^[^\(]+\((.+)\)$/$1/s;
+       $schema = $stmt->schema_str if $stmt->can('schema_str');
+    $self->{hash}->{"_metadata \0"} = "<dbd_metadata>"
+                                    . "<schema>$schema</schema>"
+                                    . "<col_names>$col_names</col_names>"
+                                    . "</dbd_metadata>"
+                                    ;
 }
 
 # fetch_one_row, delete_one_row, update_one_row
@@ -691,7 +717,7 @@
  use DBI;
  my $dbh = DBI->connect('dbi:DBM:');
  $dbh->{RaiseError} = 1;
- for my $sql( split /\s^;\n+/,"
+ for my $sql( split /;\n+/,"
      CREATE TABLE user ( user_name TEXT, phone TEXT );
      INSERT INTO user VALUES ('Fred Bloggs','233-7777');
      INSERT INTO user VALUES ('Sanjay Patel','777-3333');
@@ -702,7 +728,7 @@
  "){
      my $sth = $dbh->prepare($sql);
      $sth->execute;
-     $sth->dump_results if $sql =~ /SELECT/;
+     $sth->dump_results if $sth->{NUM_OF_FIELDS};
  }
  $dbh->disconnect;
 

Modified: dbi/trunk/lib/DBD/File.pm
==============================================================================
--- dbi/trunk/lib/DBD/File.pm   (original)
+++ dbi/trunk/lib/DBD/File.pm   Fri May 14 13:55:22 2004
@@ -131,8 +131,8 @@
     while (defined($file = readdir($dirh))) {
        my $d = $haveFileSpec ?
            File::Spec->catdir($dir, $file) : "$dir/$file";
-       if ($file ne ($haveFileSpec ? File::Spec->curdir() : '.')
-           and  $file ne ($haveFileSpec ? File::Spec->updir() : '..')
+        # allow current dir ... it can be a data_source too
+       if ( $file ne ($haveFileSpec ? File::Spec->updir() : '..')
            and  -d $d) {
            push(@dsns, "DBI:$driver:f_dir=$d");
        }
@@ -193,13 +193,24 @@
     }
     $sth;
 }
-
+sub csv_cache_sql_parser_object {
+    my $dbh = shift;
+    my $parser = {
+            dialect    => 'CSV',
+            RaiseError => $dbh->FETCH('RaiseError'),
+            PrintError => $dbh->FETCH('PrintError'),
+        };
+    my $sql_flags  = $dbh->FETCH('sql_flags') || {};
+    %$parser = (%$parser,%$sql_flags);
+    $parser = SQL::Parser->new($parser->{dialect},$parser);
+    $dbh->{csv_sql_parser_object} = $parser;
+    return $parser;
+}
 sub disconnect ($) {
     shift->STORE('Active',0);
     undef $DBD::File::drh;
     1;
 }
-
 sub FETCH ($$) {
     my ($dbh, $attrib) = @_;
     if ($attrib eq 'AutoCommit') {
@@ -426,7 +437,11 @@
     }
     return $result;
 }
-
+sub finish {
+    my $sth = shift;
+    $sth->{Active}=0;
+    delete $sth->{f_stmt}->{data};
+}
 sub fetch ($) {
     my $sth = shift;
     my $data = $sth->{f_stmt}->{data};