dbd.pm

SinFP是一种新的识别对方计算机操作系统类型的工具

      my $port = delete $attr->{drv_port} || 123456;

      # Assume you can attach to your database via drv_connect:
      my $connection = drv_connect($db, $host, $port, $user, $auth)
          or return $drh->set_err(1, "Can't connect to $dr_dsn: ...");

      # create a 'blank' dbh (call superclass constructor)
      my ($outer, $dbh) = DBI::_new_dbh($drh, { Name => $dr_dsn });

      $dbh->STORE('Active', 1 );
      $dbh->{drv_connection} = $connection;

      return $outer;
  }

The Name attribute is a standard DBI attribute.

This is mostly the same as in the I<driver handle constructor> above.
The arguments are described in the DBI man page.
See L<DBI>.
The constructor _new_dbh is called, returning a database handle.
The constructor's prototype is:

  ($outer, $inner) = DBI::_new_dbh($drh, $public_attr, $private_attr);

with similar arguments to those in the I<driver handle constructor>,
except that the C<$class> is replaced by C<$drh>.

In scalar context, only the outer handle is returned.

Note the use of the I<STORE> method for setting the dbh attributes.
That's because within the driver code, the handle object you have is
the 'inner' handle of a tied hash, not the outer handle that the
users of your driver have.

Because you have the inner handle, tie magic doesn't get invoked
when you get or set values in the hash. This is often very handy for
speed when you want to get or set simple non-special driver-specific
attributes.

However, some attribute values, such as those handled by the DBI
like PrintError, don't actually exist in the hash and must be
read via $h->FETCH($attrib) and set via $h->STORE($attrib, $value).
If in any doubt, use these methods.

=head4 The data_sources method

The data_sources method must populate and return a list of valid data
sources, prefixed with the "dbi:Driver" incantation that allows them to
be used in the first argument of the C<DBI-E<gt>connect> method.
An example of this might be scanning the I<$HOME/.odbcini> file on Unix
for ODBC data sources (DSNs).
As a trivial example, consider a fixed list of data sources:

  sub data_sources
  {
      my($drh, $attr) = @_;
      my(@list) = ();
      # You need more sophisticated code than this to set @list...
      push @list, "dbi:Driver:abc";
      push @list, "dbi:Driver:def";
      push @list, "dbi:Driver:ghi";
      # End of code to set @list
      return @list;
  }

=head4 Error handling

It is quite likely that something fails in the connect method.
With DBD::File for example, you might catch an error when setting the
current directory to something not existent by using the
(driver-specific) f_dir attribute.

To report an error, you use the C<set_err> method:

  $h->set_err($err, $errmsg, $state);

This will ensure that the error is recorded correctly and that
RaiseError and PrintError etc are handled correctly.
Typically you'll
always use the method instance, aka your method's first argument.

As set_err always returns undef your error handling code can
usually be simplified to something like this:

  return $h->set_err($err, $errmsg, $state) if ...;

=head4 The disconnect_all method

If you need to release any resources when the driver is unloaded, you
can provide a disconnect_all method.

=head4 Other driver handle methods

If you need any other driver handle methods, they can follow here.

=head3 The DBD::Driver::db package

=head4 The statement handle constructor

There's nothing much new in the statement handle constructor.

  package DBD::Driver::db; # ====== DATABASE ======

  $DBD::Driver::db::imp_data_size = 0;

  sub prepare
  {
      my ($dbh, $statement, @attribs) = @_;

      # create a 'blank' sth
      my ($outer, $sth) = DBI::_new_sth($dbh, { Statement => $statement });

      $sth->STORE('NUM_OF_PARAMS', ($statement =~ tr/?//));

      $sth->{drv_params} = [];

      return $outer;
  }

This is still the same: check the arguments and call the super class
constructor I<DBI::_new_sth>.
Again, in scalar context, only the outer handle is returned.
The C<Statement> attribute should be cached as shown.

Note the prefix I<drv_> in the attribute names: it is required that
all your private attributes use a lowercase prefix unique to your driver.
The DBI contains a registry of known driver prefixes and may one day
warn about unknown attributes that don't have a registered prefix.

Note that we parse the statement here in order to set the attribute
I<NUM_OF_PARAMS>.
The technique illustrated is not very reliable; it can be confused by
question marks appearing in quoted strings, delimited identifiers or in
SQL comments that are part of the SQL statement.
We could set I<NUM_OF_PARAMS> in the I<execute> method instead because
the DBI specification explicitly allows a driver to defer this, but then
the user could not call I<bind_param>.

=head4 Transaction handling

Pure Perl drivers will rarely support transactions. Thus your I<commit>
and I<rollback> methods will typically be quite simple:

  sub commit
  {
      my ($dbh) = @_;
      if ($dbh->FETCH('Warn')) {
          warn("Commit ineffective while AutoCommit is on");
      }
      0;
  }

  sub rollback {
      my ($dbh) = @_;
      if ($dbh->FETCH('Warn')) {
          warn("Rollback ineffective while AutoCommit is on");
      }
      0;
  }

Or even simpler, just use the default methods provided by the DBI that
do nothing except return undef.

The DBI's default begin_work method can be used by inheritance.

=head4 The STORE and FETCH methods

These methods (that we have already used, see above) are called for
you, whenever the user does a:

  $dbh->{$attr} = $val;

or, respectively,

  $val = $dbh->{$attr};

See L<perltie> for details on tied hash refs to understand why these
methods are required.

The DBI will handle most attributes for you, in particular attributes
like I<RaiseError> or I<PrintError>.
All you have to do is handle your driver's private attributes and any
attributes, like AutoCommit and ChopBlanks, that the DBI can't handle
for you.
A good example might look like this:

  sub STORE
  {
      my ($dbh, $attr, $val) = @_;
      if ($attr eq 'AutoCommit') {
          # AutoCommit is currently the only standard attribute we have
          # to consider.
          if (!$val) { die "Can't disable AutoCommit"; }
          return 1;
      }
      if ($attr =~ m/^drv_/) {
          # Handle only our private attributes here
          # Note that we could trigger arbitrary actions.
          # Ideally we should warn about unknown attributes.
          $dbh->{$attr} = $val; # Yes, we are allowed to do this,
          return 1;             # but only for our private attributes
      }
      # Else pass up to DBI to handle for us
      $dbh->SUPER::STORE($attr, $val);
  }

  sub FETCH
  {
      my ($dbh, $attr) = @_;
      if ($attr eq 'AutoCommit') { return 1; }
      if ($attr =~ m/^drv_/) {
          # Handle only our private attributes here
          # Note that we could trigger arbitrary actions.
          return $dbh->{$attr}; # Yes, we are allowed to do this,
                                # but only for our private attributes
      }
      # Else pass up to DBI to handle
      $dbh->SUPER::FETCH($attr);
  }

The DBI will actually store and fetch driver-specific attributes (with all
lowercase names) without warning or error, so there's actually no need to
implement driver-specific any code in your FETCH and STORE methods unless
you need extra logic/checks, beyond getting or setting the value.

Unless your driver documentation indicates otherwise, the return value of
the STORE method is unspecified and the caller shouldn't use that value.

=head4 Other database handle methods

As with the driver package, other database handle methods may follow
here.
In particular you should consider a (possibly empty) I<disconnect>
method and possibly a I<quote> method if DBI's default isn't correct for
you.

Where reasonable use $h->SUPER::foo() to call the DBI's method in
some or all cases and just wrap your custom behavior around that.

If you want to use private trace flags you'll probably want to be
able to set them by name. To do that you'll need to define a
parse_trace_flag() method (note that's parse_trace_flag not parse_trace_flags).

  sub parse_trace_flag {
      my ($h, $name) = @_;
      return 0x01000000 if $name eq 'foo';
      return 0x02000000 if $name eq 'bar';
      return 0x04000000 if $name eq 'baz';
      return 0x08000000 if $name eq 'boo';
      return 0x10000000 if $name eq 'bop';
      return $h->SUPER::parse_trace_flag($name);
  }

All private flag names must be lowercase, and all private flags
must be in the top 8 of the 32 bits.

=head3 The DBD::Driver::st package

=head4 The execute method

This is perhaps the most difficult method because we have to consider
parameter bindings here. We present a simplified implementation by
using the I<drv_params> attribute from above:

  package DBD::Driver::st;

  $DBD::Driver::st::imp_data_size = 0;

  sub bind_param
  {
      my ($sth, $pNum, $val, $attr) = @_;
      my $type = (ref $attr) ? $attr->{TYPE} : $attr;
      if ($type) {
          my $dbh = $sth->{Database};
          $val = $dbh->quote($sth, $type);
      }
      my $params = $sth->{drv_params};
      $params->[$pNum-1] = $val;
      1;
  }

  sub execute
  {
      my ($sth, @bind_values) = @_;

      # start of by finishing any previous execution if still active
      $sth->finish if $sth->FETCH('Active');

      my $params = (@bind_values) ?
          \@bind_values : $sth->{drv_params};
      my $numParam = $sth->FETCH('NUM_OF_PARAMS');
      return $sth->set_err(1, "Wrong number of parameters")
          if @$params != $numParam;
      my $statement = $sth->{'Statement'};
      for (my $i = 0;  $i < $numParam;  $i++) {
          $statement =~ s/?/$params->[$i]/; # XXX doesn't deal with quoting etc!
      }
      # Do anything ... we assume that an array ref of rows is
      # created and store it:
      $sth->{'drv_data'} = $data;
      $sth->{'drv_rows'} = @$data; # number of rows
      $sth->STORE('NUM_OF_FIELDS') = $numFields;
      @$data || '0E0';
  }

There are a number of things you should note here.
We setup the NUM_OF_FIELDS attribute
here, because this is essential for I<bind_columns> to work.
We use attribute C<$sth-E<gt>{Statement}> which we created
within I<prepare>. The attribute C<$sth-E<gt>{Database}>, which is
nothing else than the I<dbh>, was automatically created by DBI.

Finally note that (as specified in the DBI specification) we return the
string '0E0' instead of the number 0, so that the result tests true but
equal to zero.

  $sth->execute() or die $sth->errstr;

=head4 Fetching data

We should not implement the methods I<fetchrow_array>, I<fetchall_arrayref>,
... because these are already part of DBI.
All we need is the method
I<fetchrow_arrayref>:

  sub fetchrow_arrayref
  {
      my ($sth) = @_;
      my $data = $sth->{drv_data};
      my $row = shift @$data;
      if (!$row) {
          $sth->STORE(Active => 0); # mark as no longer active
          return undef;
      }
      if ($sth->FETCH('ChopBlanks')) {
          map { $_ =~ s/\s+$//; } @$row;
      }
      return $sth->_set_fbav($row);
  }
  *fetch = \&fetchrow_arrayref; # required alias for fetchrow_arrayref

Note the use of the method I<_set_fbav>: This is required so that
I<bind_col> and I<bind_columns> work.

If an error occurs which leaves the $sth in a state where remaining rows
can't be fetched then Active should be turned off
before the method returns.

The rows method for this driver can be implemented like this:

  sub rows { shift->{drv_rows} }

because it knows in advance how many rows it has fetched.
Alternatively you could delete that method and so fallback
to the DBI's own method which does the right thing based
on the number of calls to _set_fbav().

=head4 Statement attributes

The main difference between dbh and sth attributes is, that you
should implement a lot of attributes here that are required by
the DBI, such as I<NAME>, I<NULLABLE>, I<TYPE>, ...