dbi.pm

视频监控网络部分的协议ddns,的模块的实现代码,请大家大胆指正.

# $Id: DBI.pm 10087 2007-10-16 12:42:37Z timbo $
# vim: ts=8:sw=4
#
# Copyright (c) 1994-2007  Tim Bunce  Ireland
#
# See COPYRIGHT section in pod text below for usage and distribution rights.
#

require 5.006_00;

BEGIN {
$DBI::VERSION = "1.601"; # ==> ALSO update the version in the pod text below!
}

=head1 NAME

DBI - Database independent interface for Perl

=head1 SYNOPSIS

  use DBI;

  @driver_names = DBI->available_drivers;
  %drivers      = DBI->installed_drivers;
  @data_sources = DBI->data_sources($driver_name, \%attr);

  $dbh = DBI->connect($data_source, $username, $auth, \%attr);

  $rv  = $dbh->do($statement);
  $rv  = $dbh->do($statement, \%attr);
  $rv  = $dbh->do($statement, \%attr, @bind_values);

  $ary_ref  = $dbh->selectall_arrayref($statement);
  $hash_ref = $dbh->selectall_hashref($statement, $key_field);

  $ary_ref  = $dbh->selectcol_arrayref($statement);
  $ary_ref  = $dbh->selectcol_arrayref($statement, \%attr);

  @row_ary  = $dbh->selectrow_array($statement);
  $ary_ref  = $dbh->selectrow_arrayref($statement);
  $hash_ref = $dbh->selectrow_hashref($statement);

  $sth = $dbh->prepare($statement);
  $sth = $dbh->prepare_cached($statement);

  $rc = $sth->bind_param($p_num, $bind_value);
  $rc = $sth->bind_param($p_num, $bind_value, $bind_type);
  $rc = $sth->bind_param($p_num, $bind_value, \%attr);

  $rv = $sth->execute;
  $rv = $sth->execute(@bind_values);
  $rv = $sth->execute_array(\%attr, ...);

  $rc = $sth->bind_col($col_num, \$col_variable);
  $rc = $sth->bind_columns(@list_of_refs_to_vars_to_bind);

  @row_ary  = $sth->fetchrow_array;
  $ary_ref  = $sth->fetchrow_arrayref;
  $hash_ref = $sth->fetchrow_hashref;

  $ary_ref  = $sth->fetchall_arrayref;
  $ary_ref  = $sth->fetchall_arrayref( $slice, $max_rows );

  $hash_ref = $sth->fetchall_hashref( $key_field );

  $rv  = $sth->rows;

  $rc  = $dbh->begin_work;
  $rc  = $dbh->commit;
  $rc  = $dbh->rollback;

  $quoted_string = $dbh->quote($string);

  $rc  = $h->err;
  $str = $h->errstr;
  $rv  = $h->state;

  $rc  = $dbh->disconnect;

I<The synopsis above only lists the major methods and parameters.>


=head2 GETTING HELP

If you have questions about DBI, or DBD driver modules, you can get
help from the I<[e-mail]> mailing list.  You don't have to subscribe
to the list in order to post, though I'd recommend it. You can get help on
subscribing and using the list by emailing I<[e-mail]>.

I don't recommend the DBI cpanform (at http://www.cpanforum.com/dist/DBI)
because relatively few people read it compared with [e-mail].

To help you make the best use of the dbi-users mailing list,
and any other lists or forums you may use, I I<strongly>
recommend that you read "How To Ask Questions The Smart Way"
by Eric Raymond: L<http://www.catb.org/~esr/faqs/smart-questions.html>.

If you think you've found a bug then please also read
"How to Report Bugs Effectively" by Simon Tatham:
L<http://www.chiark.greenend.org.uk/~sgtatham/bugs.html>.

The DBI home page at L<http://dbi.perl.org/> is always worth a visit
and includes an FAQ and links to other resources.

Before asking any questions, reread this document, consult the
archives and read the DBI FAQ. The archives are listed
at the end of this document and on the DBI home page.
An FAQ is installed as a L<DBI::FAQ> module so
you can read it by executing C<perldoc DBI::FAQ>.
However the DBI::FAQ module is currently (2004) outdated relative
to the online FAQ on the DBI home page.

This document often uses terms like I<references>, I<objects>,
I<methods>.  If you're not familar with those terms then it would
be a good idea to read at least the following perl manuals first:
L<perlreftut>, L<perldsc>, L<perllol>, and L<perlboot>.

Please note that Tim Bunce does not maintain the mailing lists or the
web page (generous volunteers do that).  So please don't send mail
directly to him; he just doesn't have the time to answer questions
personally. The I<dbi-users> mailing list has lots of experienced
people who should be able to help you if you need it. If you do email
Tim he's very likely to just forward it to the mailing list.

=head2 NOTES

This is the DBI specification that corresponds to the DBI version 1.601
($Revision: 10087 $).

The DBI is evolving at a steady pace, so it's good to check that
you have the latest copy.

The significant user-visible changes in each release are documented
in the L<DBI::Changes> module so you can read them by executing
C<perldoc DBI::Changes>.

Some DBI changes require changes in the drivers, but the drivers
can take some time to catch up. Newer versions of the DBI have
added features that may not yet be supported by the drivers you
use.  Talk to the authors of your drivers if you need a new feature
that's not yet supported.

Features added after DBI 1.21 (February 2002) are marked in the
text with the version number of the DBI release they first appeared in.

Extensions to the DBI API often use the C<DBIx::*> namespace.
See L</Naming Conventions and Name Space>. DBI extension modules
can be found at L<http://search.cpan.org/search?mode=module&query=DBIx>.
And all modules related to the DBI can be found at
L<http://search.cpan.org/search?query=DBI&mode=all>.

=cut

# The POD text continues at the end of the file.


package DBI;

use Carp();
use DynaLoader ();
use Exporter ();

BEGIN {
@ISA = qw(Exporter DynaLoader);

# Make some utility functions available if asked for
@EXPORT    = ();		    # we export nothing by default
@EXPORT_OK = qw(%DBI %DBI_methods hash); # also populated by export_ok_tags:
%EXPORT_TAGS = (
   sql_types => [ qw(
	SQL_GUID
	SQL_WLONGVARCHAR
	SQL_WVARCHAR
	SQL_WCHAR
	SQL_BIGINT
	SQL_BIT
	SQL_TINYINT
	SQL_LONGVARBINARY
	SQL_VARBINARY
	SQL_BINARY
	SQL_LONGVARCHAR
	SQL_UNKNOWN_TYPE
	SQL_ALL_TYPES
	SQL_CHAR
	SQL_NUMERIC
	SQL_DECIMAL
	SQL_INTEGER
	SQL_SMALLINT
	SQL_FLOAT
	SQL_REAL
	SQL_DOUBLE
	SQL_DATETIME
	SQL_DATE
	SQL_INTERVAL
	SQL_TIME
	SQL_TIMESTAMP
	SQL_VARCHAR
	SQL_BOOLEAN
	SQL_UDT
	SQL_UDT_LOCATOR
	SQL_ROW
	SQL_REF
	SQL_BLOB
	SQL_BLOB_LOCATOR
	SQL_CLOB
	SQL_CLOB_LOCATOR
	SQL_ARRAY
	SQL_ARRAY_LOCATOR
	SQL_MULTISET
	SQL_MULTISET_LOCATOR
	SQL_TYPE_DATE
	SQL_TYPE_TIME
	SQL_TYPE_TIMESTAMP
	SQL_TYPE_TIME_WITH_TIMEZONE
	SQL_TYPE_TIMESTAMP_WITH_TIMEZONE
	SQL_INTERVAL_YEAR
	SQL_INTERVAL_MONTH
	SQL_INTERVAL_DAY
	SQL_INTERVAL_HOUR
	SQL_INTERVAL_MINUTE
	SQL_INTERVAL_SECOND
	SQL_INTERVAL_YEAR_TO_MONTH
	SQL_INTERVAL_DAY_TO_HOUR
	SQL_INTERVAL_DAY_TO_MINUTE
	SQL_INTERVAL_DAY_TO_SECOND
	SQL_INTERVAL_HOUR_TO_MINUTE
	SQL_INTERVAL_HOUR_TO_SECOND
	SQL_INTERVAL_MINUTE_TO_SECOND
   ) ],
   sql_cursor_types => [ qw(
	 SQL_CURSOR_FORWARD_ONLY
	 SQL_CURSOR_KEYSET_DRIVEN
	 SQL_CURSOR_DYNAMIC
	 SQL_CURSOR_STATIC
	 SQL_CURSOR_TYPE_DEFAULT
   ) ], # for ODBC cursor types
   utils     => [ qw(
	neat neat_list $neat_maxlen dump_results looks_like_number
	data_string_diff data_string_desc data_diff
   ) ],
   profile   => [ qw(
	dbi_profile dbi_profile_merge dbi_profile_merge_nodes dbi_time
   ) ], # notionally "in" DBI::Profile and normally imported from there
);

$DBI::dbi_debug = 0;
$DBI::neat_maxlen = 400;
$DBI::stderr = 2_000_000_000; # a very round number below 2**31

# If you get an error here like "Can't find loadable object ..."
# then you haven't installed the DBI correctly. Read the README
# then install it again.
if ( $ENV{DBI_PUREPERL} ) {
    eval { bootstrap DBI } if       $ENV{DBI_PUREPERL} == 1;
    require DBI::PurePerl  if $@ or $ENV{DBI_PUREPERL} >= 2;
    $DBI::PurePerl ||= 0; # just to silence "only used once" warnings
}
else {
    bootstrap DBI;
}

$EXPORT_TAGS{preparse_flags} = [ grep { /^DBIpp_\w\w_/ } keys %{__PACKAGE__."::"} ];

Exporter::export_ok_tags(keys %EXPORT_TAGS);

}

# Alias some handle methods to also be DBI class methods
for (qw(trace_msg set_err parse_trace_flag parse_trace_flags)) {
  no strict;
  *$_ = \&{"DBD::_::common::$_"};
}

use strict;

DBI->trace(split /=/, $ENV{DBI_TRACE}, 2) if $ENV{DBI_TRACE};

$DBI::connect_via ||= "connect";

# check if user wants a persistent database connection ( Apache + mod_perl )
if ($INC{'Apache/DBI.pm'} && $ENV{MOD_PERL}) {
    $DBI::connect_via = "Apache::DBI::connect";
    DBI->trace_msg("DBI connect via $DBI::connect_via in $INC{'Apache/DBI.pm'}\n");
}

# check for weaken support, used by ChildHandles
my $HAS_WEAKEN = eval {
    require Scalar::Util;
    # this will croak() if this Scalar::Util doesn't have a working weaken().
    Scalar::Util::weaken( \my $test ); # same test as in t/72childhandles.t
    1;
};

%DBI::installed_drh = ();  # maps driver names to installed driver handles
sub installed_drivers { %DBI::installed_drh }
%DBI::installed_methods = (); # XXX undocumented, may change
sub installed_methods { %DBI::installed_methods }

# Setup special DBI dynamic variables. See DBI::var::FETCH for details.
# These are dynamically associated with the last handle used.
tie $DBI::err,    'DBI::var', '*err';    # special case: referenced via IHA list
tie $DBI::state,  'DBI::var', '"state';  # special case: referenced via IHA list
tie $DBI::lasth,  'DBI::var', '!lasth';  # special case: return boolean
tie $DBI::errstr, 'DBI::var', '&errstr'; # call &errstr in last used pkg
tie $DBI::rows,   'DBI::var', '&rows';   # call &rows   in last used pkg
sub DBI::var::TIESCALAR{ my $var = $_[1]; bless \$var, 'DBI::var'; }
sub DBI::var::STORE    { Carp::croak("Can't modify \$DBI::${$_[0]} special variable") }

{   # used to catch DBI->{Attrib} mistake
    sub DBI::DBI_tie::TIEHASH { bless {} }
    sub DBI::DBI_tie::STORE   { Carp::carp("DBI->{$_[1]} is invalid syntax (you probably want \$h->{$_[1]})");}
    *DBI::DBI_tie::FETCH = \&DBI::DBI_tie::STORE;
}
tie %DBI::DBI => 'DBI::DBI_tie';

# --- Driver Specific Prefix Registry ---

my $dbd_prefix_registry = {
  ad_      => { class => 'DBD::AnyData',	},
  ado_     => { class => 'DBD::ADO',		},
  amzn_    => { class => 'DBD::Amazon',		},
  best_    => { class => 'DBD::BestWins',	},
  csv_     => { class => 'DBD::CSV',		},
  db2_     => { class => 'DBD::DB2',		},
  dbi_     => { class => 'DBI',			},
  dbm_     => { class => 'DBD::DBM',		},
  df_      => { class => 'DBD::DF',		},
  f_       => { class => 'DBD::File',		},
  file_    => { class => 'DBD::TextFile',	},
  go_      => { class => 'DBD::Gofer',  	},
  ib_      => { class => 'DBD::InterBase',	},
  ing_     => { class => 'DBD::Ingres',		},
  ix_      => { class => 'DBD::Informix',	},
  jdbc_    => { class => 'DBD::JDBC',		},
  monetdb_ => { class => 'DBD::monetdb',	},
  msql_    => { class => 'DBD::mSQL',		},
  mysql_   => { class => 'DBD::mysql',		},
  mx_      => { class => 'DBD::Multiplex',	},
  nullp_   => { class => 'DBD::NullP',		},
  odbc_    => { class => 'DBD::ODBC',		},
  ora_     => { class => 'DBD::Oracle',		},
  pg_      => { class => 'DBD::Pg',		},
  plb_     => { class => 'DBD::Plibdata',	},
  proxy_   => { class => 'DBD::Proxy',		},
  rdb_     => { class => 'DBD::RDB',		},
  sapdb_   => { class => 'DBD::SAP_DB',		},
  solid_   => { class => 'DBD::Solid',		},
  sponge_  => { class => 'DBD::Sponge',		},
  sql_     => { class => 'SQL::Statement',	},
  syb_     => { class => 'DBD::Sybase',		},
  tdat_    => { class => 'DBD::Teradata',	},
  tmpl_    => { class => 'DBD::Template',	},
  tmplss_  => { class => 'DBD::TemplateSS',	},
  tuber_   => { class => 'DBD::Tuber',		},
  uni_     => { class => 'DBD::Unify',		},
  vt_      => { class => 'DBD::Vt',		},
  wmi_     => { class => 'DBD::WMI',		},
  x_       => { }, # for private use
  xbase_   => { class => 'DBD::XBase',		},
  xl_      => { class => 'DBD::Excel',		},
  yaswi_   => { class => 'DBD::Yaswi',		},
};

sub dump_dbd_registry {
    require Data::Dumper;
    local $Data::Dumper::Sortkeys=1;
    local $Data::Dumper::Indent=1;
    print Data::Dumper->Dump([$dbd_prefix_registry], [qw($dbd_prefix_registry)]);
}

# --- Dynamically create the DBI Standard Interface

my $keeperr = { O=>0x0004 };

%DBI::DBI_methods = ( # Define the DBI interface methods per class:

    common => {		# Interface methods common to all DBI handle classes
	'DESTROY'	=> { O=>0x004|0x10000 },
	'CLEAR'  	=> $keeperr,
	'EXISTS' 	=> $keeperr,
	'FETCH'		=> { O=>0x0404 },
	'FETCH_many'	=> { O=>0x0404 },
	'FIRSTKEY'	=> $keeperr,
	'NEXTKEY'	=> $keeperr,
	'STORE'		=> { O=>0x0418 | 0x4 },
	_not_impl	=> undef,