[ Index ]

PHP Cross Reference of Unnamed Project

title

Body

[close]

/se3-unattended/var/se3/unattended/install/linuxaux/opt/perl/lib/site_perl/5.10.0/i586-linux-thread-multi/DBD/ -> DBM.pm (source)

   1  #######################################################################
   2  #
   3  #  DBD::DBM - a DBI driver for DBM files
   4  #
   5  #  Copyright (c) 2004 by Jeff Zucker < jzucker AT cpan.org >
   6  #
   7  #  All rights reserved.
   8  #
   9  #  You may freely distribute and/or modify this  module under the terms
  10  #  of either the GNU  General Public License (GPL) or the Artistic License,
  11  #  as specified in the Perl README file.
  12  #
  13  #  USERS - see the pod at the bottom of this file
  14  #
  15  #  DBD AUTHORS - see the comments in the code
  16  #
  17  #######################################################################
  18  require 5.005_03;
  19  use strict;
  20  
  21  #################
  22  package DBD::DBM;
  23  #################
  24  use base qw( DBD::File );
  25  use vars qw($VERSION $ATTRIBUTION $drh $methods_already_installed);
  26  $VERSION     = '0.03';
  27  $ATTRIBUTION = 'DBD::DBM by Jeff Zucker';
  28  
  29  # no need to have driver() unless you need private methods
  30  #
  31  sub driver ($;$) {
  32      my($class, $attr) = @_;
  33      return $drh if $drh;
  34  
  35      # do the real work in DBD::File
  36      #
  37      $attr->{Attribution} = 'DBD::DBM by Jeff Zucker';
  38      my $this = $class->SUPER::driver($attr);
  39  
  40      # install private methods
  41      #
  42      # this requires that dbm_ (or foo_) be a registered prefix
  43      # but you can write private methods before official registration
  44      # by hacking the $dbd_prefix_registry in a private copy of DBI.pm
  45      #
  46      if ( $DBI::VERSION >= 1.37 and !$methods_already_installed++ ) {
  47          DBD::DBM::db->install_method('dbm_versions');
  48          DBD::DBM::st->install_method('dbm_schema');
  49      }
  50  
  51      $this;
  52  }
  53  
  54  sub CLONE {
  55      undef $drh;
  56  }
  57  
  58  #####################
  59  package DBD::DBM::dr;
  60  #####################
  61  $DBD::DBM::dr::imp_data_size = 0;
  62  @DBD::DBM::dr::ISA = qw(DBD::File::dr);
  63  
  64  # you can get by without connect() if you don't have to check private
  65  # attributes, DBD::File will gather the connection string arguements for you
  66  #
  67  sub connect ($$;$$$) {
  68      my($drh, $dbname, $user, $auth, $attr)= @_;
  69  
  70      # create a 'blank' dbh
  71      my $this = DBI::_new_dbh($drh, {
  72      Name => $dbname,
  73      });
  74  
  75      # parse the connection string for name=value pairs
  76      if ($this) {
  77  
  78          # define valid private attributes
  79          #
  80          # attempts to set non-valid attrs in connect() or
  81          # with $dbh->{attr} will throw errors
  82          #
  83          # the attrs here *must* start with dbm_ or foo_
  84          #
  85          # see the STORE methods below for how to check these attrs
  86          #
  87          $this->{dbm_valid_attrs} = {
  88              dbm_tables            => 1  # per-table information
  89            , dbm_type              => 1  # the global DBM type e.g. SDBM_File
  90            , dbm_mldbm             => 1  # the global MLDBM serializer
  91            , dbm_cols              => 1  # the global column names
  92            , dbm_version           => 1  # verbose DBD::DBM version
  93            , dbm_ext               => 1  # file extension
  94            , dbm_lockfile          => 1  # lockfile extension
  95            , dbm_store_metadata    => 1  # column names, etc.
  96            , dbm_berkeley_flags    => 1  # for BerkeleyDB
  97          };
  98  
  99      my($var, $val);
 100      $this->{f_dir} = $DBD::File::haveFileSpec ? File::Spec->curdir() : '.';
 101      while (length($dbname)) {
 102          if ($dbname =~ s/^((?:[^\\;]|\\.)*?);//s) {
 103          $var = $1;
 104          } else {
 105          $var = $dbname;
 106          $dbname = '';
 107          }
 108          if ($var =~ /^(.+?)=(.*)/s) {
 109          $var = $1;
 110          ($val = $2) =~ s/\\(.)/$1/g;
 111  
 112                  # in the connect string the attr names
 113                  # can either have dbm_ (or foo_) prepended or not
 114                  # this will add the prefix if it's missing
 115                  #
 116                  $var = 'dbm_' . $var unless $var =~ /^dbm_/
 117                                       or     $var eq 'f_dir';
 118          # XXX should pass back to DBI via $attr for connect() to STORE
 119          $this->{$var} = $val;
 120          }
 121      }
 122      $this->{f_version} = $DBD::File::VERSION;
 123          $this->{dbm_version} = $DBD::DBM::VERSION;
 124          for (qw( nano_version statement_version)) {
 125              $this->{'sql_'.$_} = $DBI::SQL::Nano::versions->{$_}||'';
 126          }
 127          $this->{sql_handler} = ($this->{sql_statement_version})
 128                               ? 'SQL::Statement'
 129                              : 'DBI::SQL::Nano';
 130      }
 131      $this->STORE('Active',1);
 132      return $this;
 133  }
 134  
 135  # you could put some :dr private methods here
 136  
 137  # you may need to over-ride some DBD::File::dr methods here
 138  # but you can probably get away with just letting it do the work
 139  # in most cases
 140  
 141  #####################
 142  package DBD::DBM::db;
 143  #####################
 144  $DBD::DBM::db::imp_data_size = 0;
 145  @DBD::DBM::db::ISA = qw(DBD::File::db);
 146  
 147  # the ::db::STORE method is what gets called when you set
 148  # a lower-cased database handle attribute such as $dbh->{somekey}=$someval;
 149  #
 150  # STORE should check to make sure that "somekey" is a valid attribute name
 151  # but only if it is really one of our attributes (starts with dbm_ or foo_)
 152  # You can also check for valid values for the attributes if needed
 153  # and/or perform other operations
 154  #
 155  sub STORE ($$$) {
 156      my ($dbh, $attrib, $value) = @_;
 157  
 158      # use DBD::File's STORE unless its one of our own attributes
 159      #
 160      return $dbh->SUPER::STORE($attrib,$value) unless $attrib =~ /^dbm_/;
 161  
 162      # throw an error if it has our prefix but isn't a valid attr name
 163      #
 164      if ( $attrib ne 'dbm_valid_attrs'          # gotta start somewhere :-)
 165       and !$dbh->{dbm_valid_attrs}->{$attrib} ) {
 166          return $dbh->set_err( $DBI::stderr,"Invalid attribute '$attrib'!");
 167      }
 168      else {
 169  
 170          # check here if you need to validate values
 171          # or conceivably do other things as well
 172          #
 173      $dbh->{$attrib} = $value;
 174          return 1;
 175      }
 176  }
 177  
 178  # and FETCH is done similar to STORE
 179  #
 180  sub FETCH ($$) {
 181      my ($dbh, $attrib) = @_;
 182  
 183      return $dbh->SUPER::FETCH($attrib) unless $attrib =~ /^dbm_/;
 184  
 185      # throw an error if it has our prefix but isn't a valid attr name
 186      #
 187      if ( $attrib ne 'dbm_valid_attrs'          # gotta start somewhere :-)
 188       and !$dbh->{dbm_valid_attrs}->{$attrib} ) {
 189          return $dbh->set_err( $DBI::stderr,"Invalid attribute '$attrib'");
 190      }
 191      else {
 192  
 193          # check here if you need to validate values
 194          # or conceivably do other things as well
 195          #
 196      return $dbh->{$attrib};
 197      }
 198  }
 199  
 200  
 201  # this is an example of a private method
 202  # these used to be done with $dbh->func(...)
 203  # see above in the driver() sub for how to install the method
 204  #
 205  sub dbm_versions {
 206      my $dbh   = shift;
 207      my $table = shift || '';
 208      my $dtype = $dbh->{dbm_tables}->{$table}->{type}
 209               || $dbh->{dbm_type}
 210               || 'SDBM_File';
 211      my $mldbm = $dbh->{dbm_tables}->{$table}->{mldbm}
 212               || $dbh->{dbm_mldbm}
 213               || '';
 214      $dtype   .= ' + MLDBM + ' . $mldbm if $mldbm;
 215  
 216      my %version = ( DBI => $DBI::VERSION );
 217      $version{"DBI::PurePerl"} = $DBI::PurePerl::VERSION    if $DBI::PurePerl;
 218      $version{OS}   = "$^O ($Config::Config{osvers})";
 219      $version{Perl} = "$] ($Config::Config{archname})";
 220      my $str = sprintf "%-16s %s\n%-16s %s\n%-16s %s\n",
 221        'DBD::DBM'         , $dbh->{Driver}->{Version} . " using $dtype"
 222      , '  DBD::File'      , $dbh->{f_version}
 223      , '  DBI::SQL::Nano' , $dbh->{sql_nano_version}
 224      ;
 225      $str .= sprintf "%-16s %s\n",
 226      , '  SQL::Statement' , $dbh->{sql_statement_version}
 227        if $dbh->{sql_handler} eq 'SQL::Statement';
 228      for (sort keys %version) {
 229          $str .= sprintf "%-16s %s\n", $_, $version{$_};
 230      }
 231      return "$str\n";
 232  }
 233  
 234  # you may need to over-ride some DBD::File::db methods here
 235  # but you can probably get away with just letting it do the work
 236  # in most cases
 237  
 238  #####################
 239  package DBD::DBM::st;
 240  #####################
 241  $DBD::DBM::st::imp_data_size = 0;
 242  @DBD::DBM::st::ISA = qw(DBD::File::st);
 243  
 244  sub dbm_schema {
 245      my($sth,$tname)=@_;
 246      return $sth->set_err($DBI::stderr,'No table name supplied!') unless $tname;
 247      return $sth->set_err($DBI::stderr,"Unknown table '$tname'!")
 248         unless $sth->{Database}->{dbm_tables}
 249            and $sth->{Database}->{dbm_tables}->{$tname};
 250      return $sth->{Database}->{dbm_tables}->{$tname}->{schema};
 251  }
 252  # you could put some :st private methods here
 253  
 254  # you may need to over-ride some DBD::File::st methods here
 255  # but you can probably get away with just letting it do the work
 256  # in most cases
 257  
 258  ############################
 259  package DBD::DBM::Statement;
 260  ############################
 261  use base qw( DBD::File::Statement );
 262  use IO::File;  # for locking only
 263  use Fcntl;
 264  
 265  my $HAS_FLOCK = eval { flock STDOUT, 0; 1 };
 266  
 267  # you must define open_table;
 268  # it is done at the start of all executes;
 269  # it doesn't necessarily have to "open" anything;
 270  # you must define the $tbl and at least the col_names and col_nums;
 271  # anything else you put in depends on what you need in your
 272  # ::Table methods below; you must bless the $tbl into the
 273  # appropriate class as shown
 274  #
 275  # see also the comments inside open_table() showing the difference
 276  # between global, per-table, and default settings
 277  #
 278  sub open_table ($$$$$) {
 279      my($self, $data, $table, $createMode, $lockMode) = @_;
 280      my $dbh = $data->{Database};
 281  
 282      my $tname = $table || $self->{tables}->[0]->{name};
 283      my $file;
 284      ($table,$file) = $self->get_file_name($data,$tname);
 285  
 286      # note the use of three levels of attribute settings below
 287      # first it looks for a per-table setting
 288      # if none is found, it looks for a global setting
 289      # if none is found, it sets a default
 290      #
 291      # your DBD may not need this, gloabls and defaults may be enough
 292      #
 293      my $dbm_type = $dbh->{dbm_tables}->{$tname}->{type}
 294                  || $dbh->{dbm_type}
 295                  || 'SDBM_File';
 296      $dbh->{dbm_tables}->{$tname}->{type} = $dbm_type;
 297  
 298      my $serializer = $dbh->{dbm_tables}->{$tname}->{mldbm}
 299                    || $dbh->{dbm_mldbm}
 300                    || '';
 301      $dbh->{dbm_tables}->{$tname}->{mldbm} = $serializer if $serializer;
 302  
 303      my $ext =  '' if $dbm_type eq 'GDBM_File'
 304                    or $dbm_type eq 'DB_File'
 305                    or $dbm_type eq 'BerkeleyDB';
 306      # XXX NDBM_File on FreeBSD (and elsewhere?) may actually be Berkeley
 307      # behind the scenes and so create a single .db file.
 308      $ext = '.pag' if $dbm_type eq 'NDBM_File'
 309                    or $dbm_type eq 'SDBM_File'
 310                    or $dbm_type eq 'ODBM_File';
 311      $ext = $dbh->{dbm_ext} if defined $dbh->{dbm_ext};
 312      $ext = $dbh->{dbm_tables}->{$tname}->{ext}
 313          if defined $dbh->{dbm_tables}->{$tname}->{ext};
 314      $ext = '' unless defined $ext;
 315  
 316      my $open_mode = O_RDONLY;
 317         $open_mode = O_RDWR                 if $lockMode;
 318         $open_mode = O_RDWR|O_CREAT|O_TRUNC if $createMode;
 319  
 320      my($tie_type);
 321  
 322      if ( $serializer ) {
 323         require 'MLDBM.pm';
 324         $MLDBM::UseDB      = $dbm_type;
 325         $MLDBM::UseDB      = 'BerkeleyDB::Hash' if $dbm_type eq 'BerkeleyDB';
 326         $MLDBM::Serializer = $serializer;
 327         $tie_type = 'MLDBM';
 328      }
 329      else {
 330         require "$dbm_type.pm";
 331         $tie_type = $dbm_type;
 332      }
 333  
 334      # Second-guessing the file extension isn't great here (or in general)
 335      # could replace this by trying to open the file in non-create mode
 336      # first and dieing if that succeeds.
 337      # Currently this test doesn't work where NDBM is actually Berkeley (.db)
 338      die "Cannot CREATE '$file$ext' because it already exists"
 339          if $createMode and (-e "$file$ext");
 340  
 341      # LOCKING
 342      #
 343      my($nolock,$lockext,$lock_table);
 344      $lockext = $dbh->{dbm_tables}->{$tname}->{lockfile};
 345      $lockext = $dbh->{dbm_lockfile} if !defined $lockext;
 346      if ( (defined $lockext and $lockext == 0) or !$HAS_FLOCK
 347      ) {
 348          undef $lockext;
 349          $nolock = 1;
 350      }
 351      else {
 352          $lockext ||= '.lck';
 353      }
 354      # open and flock the lockfile, creating it if necessary
 355      #
 356      if (!$nolock) {
 357          $lock_table = $self->SUPER::open_table(
 358              $data, "$table$lockext", $createMode, $lockMode
 359          );
 360      }
 361  
 362      # TIEING
 363      #
 364      # allow users to pass in a pre-created tied object
 365      #
 366      my @tie_args;
 367      if ($dbm_type eq 'BerkeleyDB') {
 368         my $DB_CREATE = 1;  # but import constants if supplied
 369         my $DB_RDONLY = 16; #
 370         my %flags;
 371         if (my $f = $dbh->{dbm_berkeley_flags}) {
 372             $DB_CREATE  = $f->{DB_CREATE} if $f->{DB_CREATE};
 373             $DB_RDONLY  = $f->{DB_RDONLY} if $f->{DB_RDONLY};
 374             delete $f->{DB_CREATE};
 375             delete $f->{DB_RDONLY};
 376             %flags = %$f;
 377         }
 378         $flags{'-Flags'} = $DB_RDONLY;
 379         $flags{'-Flags'} = $DB_CREATE if $lockMode or $createMode;
 380          my $t = 'BerkeleyDB::Hash';
 381             $t = 'MLDBM' if $serializer;
 382      @tie_args = ($t, -Filename=>$file, %flags);
 383      }
 384      else {
 385          @tie_args = ($tie_type, $file, $open_mode, 0666);
 386      }
 387      my %h;
 388      if ( $self->{command} ne 'DROP') {
 389      my $tie_class = shift @tie_args;
 390      eval { tie %h, $tie_class, @tie_args };
 391      die "Cannot tie(%h $tie_class @tie_args): $@" if $@;
 392      }
 393  
 394  
 395      # COLUMN NAMES
 396      #
 397      my $store = $dbh->{dbm_tables}->{$tname}->{store_metadata};
 398         $store = $dbh->{dbm_store_metadata} unless defined $store;
 399         $store = 1 unless defined $store;
 400      $dbh->{dbm_tables}->{$tname}->{store_metadata} = $store;
 401  
 402      my($meta_data,$schema,$col_names);
 403      $meta_data = $col_names = $h{"_metadata \0"} if $store;
 404      if ($meta_data and $meta_data =~ m~<dbd_metadata>(.+)</dbd_metadata>~is) {
 405          $schema  = $col_names = $1;
 406          $schema  =~ s~.*<schema>(.+)</schema>.*~$1~is;
 407          $col_names =~ s~.*<col_names>(.+)</col_names>.*~$1~is;
 408      }
 409      $col_names ||= $dbh->{dbm_tables}->{$tname}->{c_cols}
 410                 || $dbh->{dbm_tables}->{$tname}->{cols}
 411                 || $dbh->{dbm_cols}
 412                 || ['k','v'];
 413      $col_names = [split /,/,$col_names] if (ref $col_names ne 'ARRAY');
 414      $dbh->{dbm_tables}->{$tname}->{cols}   = $col_names;
 415      $dbh->{dbm_tables}->{$tname}->{schema} = $schema;
 416  
 417      my $i;
 418      my %col_nums  = map { $_ => $i++ } @$col_names;
 419  
 420      my $tbl = {
 421      table_name     => $tname,
 422      file           => $file,
 423      ext            => $ext,
 424          hash           => \%h,
 425          dbm_type       => $dbm_type,
 426          store_metadata => $store,
 427          mldbm          => $serializer,
 428          lock_fh        => $lock_table->{fh},
 429          lock_ext       => $lockext,
 430          nolock         => $nolock,
 431      col_nums       => \%col_nums,
 432      col_names      => $col_names
 433      };
 434  
 435      my $class = ref($self);
 436      $class =~ s/::Statement/::Table/;
 437      bless($tbl, $class);
 438      $tbl;
 439  }
 440  
 441  ########################
 442  package DBD::DBM::Table;
 443  ########################
 444  use base qw( DBD::File::Table );
 445  
 446  # you must define drop
 447  # it is called from execute of a SQL DROP statement
 448  #
 449  sub drop ($$) {
 450      my($self,$data) = @_;
 451      untie %{$self->{hash}} if $self->{hash};
 452      my $ext = $self->{ext};
 453      unlink $self->{file}.$ext if -f $self->{file}.$ext;
 454      unlink $self->{file}.'.dir' if -f $self->{file}.'.dir'
 455                                 and $ext eq '.pag';
 456      if (!$self->{nolock}) {
 457          $self->{lock_fh}->close if $self->{lock_fh};
 458          unlink $self->{file}.$self->{lock_ext}
 459              if -f $self->{file}.$self->{lock_ext};
 460      }
 461      return 1;
 462  }
 463  
 464  # you must define fetch_row, it is called on all fetches;
 465  # it MUST return undef when no rows are left to fetch;
 466  # checking for $ary[0] is specific to hashes so you'll
 467  # probably need some other kind of check for nothing-left.
 468  # as Janis might say: "undef's just another word for
 469  # nothing left to fetch" :-)
 470  #
 471  sub fetch_row ($$$) {
 472      my($self, $data, $row) = @_;
 473      # fetch with %each
 474      #
 475      my @ary = each %{$self->{hash}};
 476      @ary = each %{$self->{hash}} if $self->{store_metadata}
 477                                   and $ary[0]
 478                                   and $ary[0] eq "_metadata \0";
 479  
 480      my($key,$val) = @ary;
 481      return undef unless $key;
 482      my @row = (ref($val) eq 'ARRAY') ? ($key,@$val) : ($key,$val);
 483      return (@row) if wantarray;
 484      return \@row;
 485  
 486      # fetch without %each
 487      #
 488      # $self->{keys} = [sort keys %{$self->{hash}}] unless $self->{keys};
 489      # my $key = shift @{$self->{keys}};
 490      # $key = shift @{$self->{keys}} if $self->{store_metadata}
 491      #                             and $key
 492      #                             and $key eq "_metadata \0";
 493      # return undef unless defined $key;
 494      # my @ary;
 495      # $row = $self->{hash}->{$key};
 496      # if (ref $row eq 'ARRAY') {
 497      #   @ary = ( $key, @{$row} );
 498      # }
 499      # else {
 500      #    @ary = ($key,$row);
 501      # }
 502      # return (@ary) if wantarray;
 503      # return \@ary;
 504  }
 505  
 506  # you must define push_row
 507  # it is called on inserts and updates
 508  #
 509  sub push_row ($$$) {
 510      my($self, $data, $row_aryref) = @_;
 511      my $key = shift @$row_aryref;
 512      if ( $self->{mldbm} ) {
 513          $self->{hash}->{$key}= $row_aryref;
 514      }
 515      else {
 516          $self->{hash}->{$key}=$row_aryref->[0];
 517      }
 518      1;
 519  }
 520  
 521  # this is where you grab the column names from a CREATE statement
 522  # if you don't need to do that, it must be defined but can be empty
 523  #
 524  sub push_names ($$$) {
 525      my($self, $data, $row_aryref) = @_;
 526      $data->{Database}->{dbm_tables}->{$self->{table_name}}->{c_cols}
 527         = $row_aryref;
 528      return unless $self->{store_metadata};
 529      my $stmt = $data->{f_stmt};
 530      my $col_names = join ',', @{$row_aryref};
 531      my $schema = $data->{Database}->{Statement};
 532         $schema =~ s/^[^\(]+\((.+)\)$/$1/s;
 533         $schema = $stmt->schema_str if $stmt->can('schema_str');
 534      $self->{hash}->{"_metadata \0"} = "<dbd_metadata>"
 535                                      . "<schema>$schema</schema>"
 536                                      . "<col_names>$col_names</col_names>"
 537                                      . "</dbd_metadata>"
 538                                      ;
 539  }
 540  
 541  # fetch_one_row, delete_one_row, update_one_row
 542  # are optimized for hash-style lookup without looping;
 543  # if you don't need them, omit them, they're optional
 544  # but, in that case you may need to define
 545  # truncate() and seek(), see below
 546  #
 547  sub fetch_one_row ($$;$) {
 548      my($self,$key_only,$key) = @_;
 549      return $self->{col_names}->[0] if $key_only;
 550      return undef unless exists $self->{hash}->{$key};
 551      my $val = $self->{hash}->{$key};
 552      $val = (ref($val)eq'ARRAY') ? $val : [$val];
 553      my $row = [$key, @$val];
 554      return @$row if wantarray;
 555      return $row;
 556  }
 557  sub delete_one_row ($$$) {
 558      my($self,$data,$aryref) = @_;
 559      delete $self->{hash}->{$aryref->[0]};
 560  }
 561  sub update_one_row ($$$) {
 562      my($self,$data,$aryref) = @_;
 563      my $key = shift @$aryref;
 564      return undef unless defined $key;
 565      my $row = (ref($aryref)eq'ARRAY') ? $aryref : [$aryref];
 566      if ( $self->{mldbm} ) {
 567          $self->{hash}->{$key}= $row;
 568      }
 569      else {
 570          $self->{hash}->{$key}=$row->[0];
 571      }
 572  }
 573  
 574  # you may not need to explicitly DESTROY the ::Table
 575  # put cleanup code to run when the execute is done
 576  #
 577  sub DESTROY ($) {
 578      my $self=shift;
 579      untie %{$self->{hash}} if $self->{hash};
 580      # release the flock on the lock file
 581      $self->{lock_fh}->close if !$self->{nolock} and $self->{lock_fh};
 582  }
 583  
 584  # truncate() and seek() must be defined to satisfy DBI::SQL::Nano
 585  # *IF* you define the *_one_row methods above, truncate() and
 586  # seek() can be empty or you can use them without actually
 587  # truncating or seeking anything but if you don't define the
 588  # *_one_row methods, you may need to define these
 589  
 590  # if you need to do something after a series of
 591  # deletes or updates, you can put it in truncate()
 592  # which is called at the end of executing
 593  #
 594  sub truncate ($$) {
 595      my($self,$data) = @_;
 596      1;
 597  }
 598  
 599  # seek() is only needed if you use IO::File
 600  # though it could be used for other non-file operations
 601  # that you need to do before "writes" or truncate()
 602  #
 603  sub seek ($$$$) {
 604      my($self, $data, $pos, $whence) = @_;
 605  }
 606  
 607  # Th, th, th, that's all folks!  See DBD::File and DBD::CSV for other
 608  # examples of creating pure perl DBDs.  I hope this helped.
 609  # Now it's time to go forth and create your own DBD!
 610  # Remember to check in with dbi-dev@perl.org before you get too far.
 611  # We may be able to make suggestions or point you to other related
 612  # projects.
 613  
 614  1;
 615  __END__
 616  
 617  =pod
 618  
 619  =head1 NAME
 620  
 621  DBD::DBM - a DBI driver for DBM & MLDBM files
 622  
 623  =head1 SYNOPSIS
 624  
 625   use DBI;
 626   $dbh = DBI->connect('dbi:DBM:');                # defaults to SDBM_File
 627   $dbh = DBI->connect('DBI:DBM(RaiseError=1):');  # defaults to SDBM_File
 628   $dbh = DBI->connect('dbi:DBM:type=GDBM_File');  # defaults to GDBM_File
 629   $dbh = DBI->connect('dbi:DBM:mldbm=Storable');  # MLDBM with SDBM_File
 630                                                   # and Storable
 631  
 632  or
 633  
 634   $dbh = DBI->connect('dbi:DBM:', undef, undef);
 635   $dbh = DBI->connect('dbi:DBM:', undef, undef, { dbm_type => 'ODBM_File' });
 636  
 637  and other variations on connect() as shown in the DBI docs and with
 638  the dbm_ attributes shown below
 639  
 640  ... and then use standard DBI prepare, execute, fetch, placeholders, etc.,
 641  see L<QUICK START> for an example
 642  
 643  =head1 DESCRIPTION
 644  
 645  DBD::DBM is a database management sytem that can work right out of the box.  If you have a standard installation of Perl and a standard installation of DBI, you can begin creating, accessing, and modifying database tables without any further installation.  You can also add some other modules to it for more robust capabilities if you wish.
 646  
 647  The module uses a DBM file storage layer.  DBM file storage is common on many platforms and files can be created with it in many languges.  That means that, in addition to creating files with DBI/SQL, you can also use DBI/SQL to access and modify files created by other DBM modules and programs.  You can also use those programs to access files created with DBD::DBM.
 648  
 649  DBM files are stored in binary format optimized for quick retrieval when using a key field.  That optimization can be used advantageously to make DBD::DBM SQL operations that use key fields very fast.  There are several different "flavors" of DBM - different storage formats supported by different sorts of perl modules such as SDBM_File and MLDBM.  This module supports all of the flavors that perl supports and, when used with MLDBM, supports tables with any number of columns and insertion of Perl objects into tables.
 650  
 651  DBD::DBM has been tested with the following DBM types: SDBM_File, NDBM_File, ODBM_File, GDBM_File, DB_File, BerekeleyDB.  Each type was tested both with and without MLDBM.
 652  
 653  =head1 QUICK START
 654  
 655  DBD::DBM operates like all other DBD drivers - it's basic syntax and operation is specified by DBI.  If you're not familiar with DBI, you should start by reading L<DBI> and the documents it points to and then come back and read this file.  If you are familiar with DBI, you already know most of what you need to know to operate this module.  Just jump in and create a test script something like the one shown below.
 656  
 657  You should be aware that there are several options for the SQL engine underlying DBD::DBM, see L<Supported SQL syntax>.  There are also many options for DBM support, see especially the section on L<Adding multi-column support with MLDBM>.
 658  
 659  But here's a sample to get you started.
 660  
 661   use DBI;
 662   my $dbh = DBI->connect('dbi:DBM:');
 663   $dbh->{RaiseError} = 1;
 664   for my $sql( split /;\n+/,"
 665       CREATE TABLE user ( user_name TEXT, phone TEXT );
 666       INSERT INTO user VALUES ('Fred Bloggs','233-7777');
 667       INSERT INTO user VALUES ('Sanjay Patel','777-3333');
 668       INSERT INTO user VALUES ('Junk','xxx-xxxx');
 669       DELETE FROM user WHERE user_name = 'Junk';
 670       UPDATE user SET phone = '999-4444' WHERE user_name = 'Sanjay Patel';
 671       SELECT * FROM user
 672   "){
 673       my $sth = $dbh->prepare($sql);
 674       $sth->execute;
 675       $sth->dump_results if $sth->{NUM_OF_FIELDS};
 676   }
 677   $dbh->disconnect;
 678  
 679  =head1 USAGE
 680  
 681  =head2 Specifiying Files and Directories
 682  
 683  DBD::DBM will automatically supply an appropriate file extension for the type of DBM you are using.  For example, if you use SDBM_File, a table called "fruit" will be stored in two files called "fruit.pag" and "fruit.dir".  You should I<never> specify the file extensions in your SQL statements.
 684  
 685  However, I am not aware (and therefore DBD::DBM is not aware) of all possible extensions for various DBM types.  If your DBM type uses an extension other than .pag and .dir, you should set the I<dbm_ext> attribute to the extension. B<And> you should write me with the name of the implementation and extension so I can add it to DBD::DBM!  Thanks in advance for that :-).
 686  
 687      $dbh = DBI->connect('dbi:DBM:ext=.db');  # .db extension is used
 688      $dbh = DBI->connect('dbi:DBM:ext=');     # no extension is used
 689  
 690  or
 691  
 692      $dbh->{dbm_ext}='.db';                      # global setting
 693      $dbh->{dbm_tables}->{'qux'}->{ext}='.db';   # setting for table 'qux'
 694  
 695  By default files are assumed to be in the current working directory.  To have the module look in a different directory, specify the I<f_dir> attribute in either the connect string or by setting the database handle attribute.
 696  
 697  For example, this will look for the file /foo/bar/fruit (or /foo/bar/fruit.pag for DBM types that use that extension)
 698  
 699     my $dbh = DBI->connect('dbi:DBM:f_dir=/foo/bar');
 700     my $ary = $dbh->selectall_arrayref(q{ SELECT * FROM fruit });
 701  
 702  And this will too:
 703  
 704     my $dbh = DBI->connect('dbi:DBM:');
 705     $dbh->{f_dir} = '/foo/bar';
 706     my $ary = $dbh->selectall_arrayref(q{ SELECT x FROM fruit });
 707  
 708  You can also use delimited identifiers to specify paths directly in SQL statements.  This looks in the same place as the two examples above but without setting I<f_dir>:
 709  
 710     my $dbh = DBI->connect('dbi:DBM:');
 711     my $ary = $dbh->selectall_arrayref(q{
 712         SELECT x FROM "/foo/bar/fruit"
 713     });
 714  
 715  If you have SQL::Statement installed, you can use table aliases:
 716  
 717     my $dbh = DBI->connect('dbi:DBM:');
 718     my $ary = $dbh->selectall_arrayref(q{
 719         SELECT f.x FROM "/foo/bar/fruit" AS f
 720     });
 721  
 722  See the L<GOTCHAS AND WARNINGS> for using DROP on tables.
 723  
 724  =head2 Table locking and flock()
 725  
 726  Table locking is accomplished using a lockfile which has the same name as the table's file but with the file extension '.lck' (or a lockfile extension that you suppy, see belwo).  This file is created along with the table during a CREATE and removed during a DROP.  Every time the table itself is opened, the lockfile is flocked().  For SELECT, this is an shared lock.  For all other operations, it is an exclusive lock.
 727  
 728  Since the locking depends on flock(), it only works on operating systems that support flock().  In cases where flock() is not implemented, DBD::DBM will not complain, it will simply behave as if the flock() had occurred although no actual locking will happen.  Read the documentation for flock() if you need to understand this.
 729  
 730  Even on those systems that do support flock(), the locking is only advisory - as is allways the case with flock().  This means that if some other program tries to access the table while DBD::DBM has the table locked, that other program will *succeed* at opening the table.  DBD::DBM's locking only applies to DBD::DBM.  An exception to this would be the situation in which you use a lockfile with the other program that has the same name as the lockfile used in DBD::DBM and that program also uses flock() on that lockfile.  In that case, DBD::DBM and your other program will respect each other's locks.
 731  
 732  If you wish to use a lockfile extension other than '.lck', simply specify the dbm_lockfile attribute:
 733  
 734    $dbh = DBI->connect('dbi:DBM:lockfile=.foo');
 735    $dbh->{dbm_lockfile} = '.foo';
 736    $dbh->{dbm_tables}->{qux}->{lockfile} = '.foo';
 737  
 738  If you wish to disable locking, set the dbm_lockfile equal to 0.
 739  
 740    $dbh = DBI->connect('dbi:DBM:lockfile=0');
 741    $dbh->{dbm_lockfile} = 0;
 742    $dbh->{dbm_tables}->{qux}->{lockfile} = 0;
 743  
 744  =head2 Specifying the DBM type
 745  
 746  Each "flavor" of DBM stores its files in a different format and has different capabilities and different limitations.  See L<AnyDBM_File> for a comparison of DBM types.
 747  
 748  By default, DBD::DBM uses the SDBM_File type of storage since SDBM_File comes with Perl itself.  But if you have other types of DBM storage available, you can use any of them with DBD::DBM also.
 749  
 750  You can specify the DBM type using the "dbm_type" attribute which can be set in the connection string or with the $dbh->{dbm_type} attribute for global settings or with the $dbh->{dbm_tables}->{$table_name}->{type} attribute for per-table settings in cases where a single script is accessing more than one kind of DBM file.
 751  
 752  In the connection string, just set type=TYPENAME where TYPENAME is any DBM type such as GDBM_File, DB_File, etc.  Do I<not> use MLDBM as your dbm_type, that is set differently, see below.
 753  
 754   my $dbh=DBI->connect('dbi:DBM:');               # uses the default SDBM_File
 755   my $dbh=DBI->connect('dbi:DBM:type=GDBM_File'); # uses the GDBM_File
 756  
 757  You can also use $dbh->{dbm_type} to set global DBM type:
 758  
 759   $dbh->{dbm_type} = 'GDBM_File';  # set the global DBM type
 760   print $dbh->{dbm_type};          # display the global DBM type
 761  
 762  If you are going to have several tables in your script that come from different DBM types, you can use the $dbh->{dbm_tables} hash to store different settings for the various tables.  You can even use this to perform joins on files that have completely different storage mechanisms.
 763  
 764   my $dbh->('dbi:DBM:type=GDBM_File');
 765   #
 766   # sets global default of GDBM_File
 767  
 768   my $dbh->{dbm_tables}->{foo}->{type} = 'DB_File';
 769   #
 770   # over-rides the global setting, but only for the table called "foo"
 771  
 772   print $dbh->{dbm_tables}->{foo}->{type};
 773   #
 774   # prints the dbm_type for the table "foo"
 775  
 776  =head2 Adding multi-column support with MLDBM
 777  
 778  Most of the DBM types only support two columns.  However a CPAN module called MLDBM overcomes this limitation by allowing more than two columns.  It does this by serializing the data - basically it puts a reference to an array into the second column.  It can also put almost any kind of Perl object or even Perl coderefs into columns.
 779  
 780  If you want more than two columns, you must install MLDBM.  It's available for many platforms and is easy to install.
 781  
 782  MLDBM can use three different modules to serialize the column - Data::Dumper, Storable, and FreezeThaw.  Data::Dumper is the default, Storable is the fastest.  MLDBM can also make use of user-defined serialization methods.  All of this is available to you through DBD::DBM with just one attribute setting.
 783  
 784  To use MLDBM with DBD::DBM, you need to set the dbm_mldbm attribute to the name of the serialization module.
 785  
 786  Some examples:
 787  
 788   $dbh=DBI->connect('dbi:DBM:mldbm=Storable');  # use MLDBM with Storable
 789   $dbh=DBI->connect(
 790      'dbi:DBM:mldbm=MySerializer'           # use MLDBM with a user defined module
 791   );
 792   $dbh->{dbm_mldbm} = 'MySerializer';       # same as above
 793   print $dbh->{dbm_mldbm}                   # show the MLDBM serializer
 794   $dbh->{dbm_tables}->{foo}->{mldbm}='Data::Dumper';   # set Data::Dumper for table "foo"
 795   print $dbh->{dbm_tables}->{foo}->{mldbm}; # show serializer for table "foo"
 796  
 797  MLDBM works on top of other DBM modules so you can also set a DBM type along with setting dbm_mldbm.  The examples above would default to using SDBM_File with MLDBM.  If you wanted GDBM_File instead, here's how:
 798  
 799   $dbh = DBI->connect('dbi:DBM:type=GDBM_File;mldbm=Storable');
 800   #
 801   # uses GDBM_File with MLDBM and Storable
 802  
 803  SDBM_File, the default file type is quite limited, so if you are going to use MLDBM, you should probably use a different type, see L<AnyDBM_File>.
 804  
 805  See below for some L<GOTCHAS AND WARNINGS> about MLDBM.
 806  
 807  =head2 Support for Berkeley DB
 808  
 809  The Berkeley DB storage type is supported through two different Perl modules - DB_File (which supports only features in old versions of Berkeley DB) and BerkeleyDB (which supports all versions).  DBD::DBM supports specifying either "DB_File" or "BerkeleyDB" as a I<dbm_type>, with or without MLDBM support.
 810  
 811  The "BerkeleyDB" dbm_type is experimental and its interface is likely to chagne.  It currently defaults to BerkeleyDB::Hash and does not currently support ::Btree or ::Recno.
 812  
 813  With BerkeleyDB, you can specify initialization flags by setting them in your script like this:
 814  
 815   my $dbh = DBI->connect('dbi:DBM:type=BerkeleyDB;mldbm=Storable');
 816   use BerkeleyDB;
 817   my $env = new BerkeleyDB::Env -Home => $dir;  # and/or other Env flags
 818   $dbh->{dbm_berkeley_flags} = {
 819        'DB_CREATE'  => DB_CREATE  # pass in constants
 820      , 'DB_RDONLY'  => DB_RDONLY  # pass in constants
 821      , '-Cachesize' => 1000       # set a ::Hash flag
 822      , '-Env'       => $env       # pass in an environment
 823   };
 824  
 825  Do I<not> set the -Flags or -Filename flags, those are determined by the SQL (e.g. -Flags => DB_RDONLY is set automatically when you issue a SELECT statement).
 826  
 827  Time has not permitted me to provide support in this release of DBD::DBM for further Berkeley DB features such as transactions, concurrency, locking, etc.  I will be working on these in the future and would value suggestions, patches, etc.
 828  
 829  See L<DB_File> and L<BerkeleyDB> for further details.
 830  
 831  =head2 Supported SQL syntax
 832  
 833  DBD::DBM uses a subset of SQL.  The robustness of that subset depends on what other modules you have installed. Both options support basic SQL operations including CREATE TABLE, DROP TABLE, INSERT, DELETE, UPDATE, and SELECT.
 834  
 835  B<Option #1:> By default, this module inherits its SQL support from DBI::SQL::Nano that comes with DBI.  Nano is, as its name implies, a *very* small SQL engine.  Although limited in scope, it is faster than option #2 for some operations.  See L<DBI::SQL::Nano> for a description of the SQL it supports and comparisons of it with option #2.
 836  
 837  B<Option #2:> If you install the pure Perl CPAN module SQL::Statement, DBD::DBM will use it instead of Nano.  This adds support for table aliases, for functions, for joins, and much more.  If you're going to use DBD::DBM for anything other than very simple tables and queries, you should install SQL::Statement.  You don't have to change DBD::DBM or your scripts in any way, simply installing SQL::Statement will give you the more robust SQL capabilities without breaking scripts written for DBI::SQL::Nano.  See L<SQL::Statement> for a description of the SQL it supports.
 838  
 839  To find out which SQL module is working in a given script, you can use the dbm_versions() method or, if you don't need the full output and version numbers, just do this:
 840  
 841   print $dbh->{sql_handler};
 842  
 843  That will print out either "SQL::Statement" or "DBI::SQL::Nano".
 844  
 845  =head2 Optimizing use of key fields
 846  
 847  Most "flavors" of DBM have only two physical columns (but can contain multiple logical columns as explained below).  They work similarly to a Perl hash with the first column serving as the key.  Like a Perl hash, DBM files permit you to do quick lookups by specifying the key and thus avoid looping through all records.  Also like a Perl hash, the keys must be unique.  It is impossible to create two records with the same key.  To put this all more simply and in SQL terms, the key column functions as the PRIMARY KEY.
 848  
 849  In DBD::DBM, you can take advantage of the speed of keyed lookups by using a WHERE clause with a single equal comparison on the key field.  For example, the following SQL statements are optimized for keyed lookup:
 850  
 851   CREATE TABLE user ( user_name TEXT, phone TEXT);
 852   INSERT INTO user VALUES ('Fred Bloggs','233-7777');
 853   # ... many more inserts
 854   SELECT phone FROM user WHERE user_name='Fred Bloggs';
 855  
 856  The "user_name" column is the key column since it is the first column. The SELECT statement uses the key column in a single equal comparision - "user_name='Fred Bloggs' - so the search will find it very quickly without having to loop through however many names were inserted into the table.
 857  
 858  In contrast, thes searches on the same table are not optimized:
 859  
 860   1. SELECT phone FROM user WHERE user_name < 'Fred';
 861   2. SELECT user_name FROM user WHERE phone = '233-7777';
 862  
 863  In #1, the operation uses a less-than (<) comparison rather than an equals comparison, so it will not be optimized for key searching.  In #2, the key field "user_name" is not specified in the WHERE clause, and therefore the search will need to loop through all rows to find the desired result.
 864  
 865  =head2 Specifying Column Names
 866  
 867  DBM files don't have a standard way to store column names.   DBD::DBM gets around this issue with a DBD::DBM specific way of storing the column names.  B<If you are working only with DBD::DBM and not using files created by or accessed with other DBM programs, you can ignore this section.>
 868  
 869  DBD::DBM stores column names as a row in the file with the key I<_metadata \0>.  So this code
 870  
 871   my $dbh = DBI->connect('dbi:DBM:');
 872   $dbh->do("CREATE TABLE baz (foo CHAR(10), bar INTEGER)");
 873   $dbh->do("INSERT INTO baz (foo,bar) VALUES ('zippy',1)");
 874  
 875  Will create a file that has a structure something like this:
 876  
 877    _metadata \0 | foo,bar
 878    zippy        | 1
 879  
 880  The next time you access this table with DBD::DBM, it will treat the _metadata row as a header rather than as data and will pull the column names from there.  However, if you access the file with something other than DBD::DBM, the row will be treated as a regular data row.
 881  
 882  If you do not want the column names stored as a data row in the table you can set the I<dbm_store_metadata> attribute to 0.
 883  
 884   my $dbh = DBI->connect('dbi:DBM:store_metadata=0');
 885  
 886  or
 887  
 888   $dbh->{dbm_store_metadata} = 0;
 889  
 890  or, for per-table setting
 891  
 892   $dbh->{dbm_tables}->{qux}->{store_metadata} = 0;
 893  
 894  By default, DBD::DBM assumes that you have two columns named "k" and "v" (short for "key" and "value").  So if you have I<dbm_store_metadata> set to 1 and you want to use alternate column names, you need to specify the column names like this:
 895  
 896   my $dbh = DBI->connect('dbi:DBM:store_metadata=0;cols=foo,bar');
 897  
 898  or
 899  
 900   $dbh->{dbm_store_metadata} = 0;
 901   $dbh->{dbm_cols}           = 'foo,bar';
 902  
 903  To set the column names on per-table basis, do this:
 904  
 905   $dbh->{dbm_tables}->{qux}->{store_metadata} = 0;
 906   $dbh->{dbm_tables}->{qux}->{cols}           = 'foo,bar';
 907   #
 908   # sets the column names only for table "qux"
 909  
 910  If you have a file that was created by another DBM program or created with I<dbm_store_metadata> set to zero and you want to convert it to using DBD::DBM's column name storage, just use one of the methods above to name the columns but *without* specifying I<dbm_store_metadata> as zero.  You only have to do that once - thereafter you can get by without setting either I<dbm_store_metadata> or setting I<dbm_cols> because the names will be stored in the file.
 911  
 912  =head2 Statement handle ($sth) attributes and methods
 913  
 914  Most statement handle attributes such as NAME, NUM_OF_FIELDS, etc. are available only after an execute.  The same is true of $sth->rows which is available after the execute but does I<not> require a fetch.
 915  
 916  =head2 The $dbh->dbm_versions() method
 917  
 918  The private method dbm_versions() presents a summary of what other modules are being used at any given time.  DBD::DBM can work with or without many other modules - it can use either SQL::Statement or DBI::SQL::Nano as its SQL engine, it can be run with DBI or DBI::PurePerl, it can use many kinds of DBM modules, and many kinds of serializers when run with MLDBM.  The dbm_versions() method reports on all of that and more.
 919  
 920    print $dbh->dbm_versions;               # displays global settings
 921    print $dbh->dbm_versions($table_name);  # displays per table settings
 922  
 923  An important thing to note about this method is that when called with no arguments, it displays the *global* settings.  If you over-ride these by setting per-table attributes, these will I<not> be shown unless you specifiy a table name as an argument to the method call.
 924  
 925  =head2 Storing Objects
 926  
 927  If you are using MLDBM, you can use DBD::DBM to take advantage of its serializing abilities to serialize any Perl object that MLDBM can handle.  To store objects in columns, you should (but don't absolutely need to) declare it as a column of type BLOB (the type is *currently* ignored by the SQL engine, but heh, it's good form).
 928  
 929  You *must* use placeholders to insert or refer to the data.
 930  
 931  =head1 GOTCHAS AND WARNINGS
 932  
 933  Using the SQL DROP command will remove any file that has the name specified in the command with either '.pag' or '.dir' or your {dbm_ext} appended to it.  So
 934  this be dangerous if you aren't sure what file it refers to:
 935  
 936   $dbh->do(qq{DROP TABLE "/path/to/any/file"});
 937  
 938  Each DBM type has limitations.  SDBM_File, for example, can only store values of less than 1,000 characters.  *You* as the script author must ensure that you don't exceed those bounds.  If you try to insert a value that is bigger than the DBM can store, the results will be unpredictable.  See the documentation for whatever DBM you are using for details.
 939  
 940  Different DBM implementations return records in different orders.  That means that you can I<not> depend on the order of records unless you use an ORDER BY statement.  DBI::SQL::Nano does not currently support ORDER BY (though it may soon) so if you need ordering, you'll have to install SQL::Statement.
 941  
 942  DBM data files are platform-specific.  To move them from one platform to another, you'll need to do something along the lines of dumping your data to CSV on platform #1 and then dumping from CSV to DBM on platform #2.  DBD::AnyData and DBD::CSV can help with that.  There may also be DBM conversion tools for your platforms which would probably be quickest.
 943  
 944  When using MLDBM, there is a very powerful serializer - it will allow you to store Perl code or objects in database columns.  When these get de-serialized, they may be evaled - in other words MLDBM (or actually Data::Dumper when used by MLDBM) may take the values and try to execute them in Perl.  Obviously, this can present dangers, so if you don't know what's in a file, be careful before you access it with MLDBM turned on!
 945  
 946  See the entire section on L<Table locking and flock()> for gotchas and warnings about the use of flock().
 947  
 948  =head1 GETTING HELP, MAKING SUGGESTIONS, AND REPORTING BUGS
 949  
 950  If you need help installing or using DBD::DBM, please write to the DBI users mailing list at dbi-users@perl.org or to the comp.lang.perl.modules newsgroup on usenet.  I'm afraid I can't always answer these kinds of questions quickly and there are many on the mailing list or in the newsgroup who can.
 951  
 952  If you have suggestions, ideas for improvements, or bugs to report, please write me directly at the email shown below.
 953  
 954  When reporting bugs, please send the output of $dbh->dbm_versions($table) for a table that exhibits the bug and, if possible, as small a sample as you can make of the code that produces the bug.  And of course, patches are welcome too :-).
 955  
 956  =head1 ACKNOWLEDGEMENTS
 957  
 958  Many, many thanks to Tim Bunce for prodding me to write this, and for copious, wise, and patient suggestions all along the way.
 959  
 960  =head1 AUTHOR AND COPYRIGHT
 961  
 962  This module is written and maintained by
 963  
 964  Jeff Zucker < jzucker AT cpan.org >
 965  
 966  Copyright (c) 2004 by Jeff Zucker, all rights reserved.
 967  
 968  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 the Perl README file.
 969  
 970  =head1 SEE ALSO
 971  
 972  L<DBI>, L<SQL::Statement>, L<DBI::SQL::Nano>, L<AnyDBM_File>, L<MLDBM>
 973  
 974  =cut
 975  


Generated: Tue Mar 17 22:47:18 2015 Cross-referenced by PHPXref 0.7.1