DBD::Template - A template/sample class for DBI drivers.

    use DBI;
    $hDb = DBI->connect("DBI:Template:", '', '',
        {AutoCommit => 1, RaiseError=> 1,
                tmpl_func_ => {
                    connect => \&connect,
                    prepare => \&prepare,
                    execute => \&execute,
                    fetch   => \&fetch,
                    rows    => \&rows,
                    name    => \&name,
                    table_info    => \&table_info,
                },
                tmpl_your_var => 'what you want', #...
            )
        or die "Cannot connect: " . $DBI::errstr;
    $hSt = $hDb->prepare("CREATE TABLE a (id INTEGER, name CHAR(10))")
        or die "Cannot prepare: " . $hDb->errstr();
    ...
    $hDb->disconnect();

#!perl
#===============================================================================
#   DBD::Template - A sample class for DBI
#   This module is Copyright (C) 2002 Kawai,Takanori (Hippo2000) Japan
#   All rights reserved.
#===============================================================================
require 5.004;
use strict;
#%%%% DBD::Template =================================================================
package DBD::Template;  #<< Change
require DBI;
require SQL::Statement;
require SQL::Eval;
use vars qw($VERSION $err $errstr $sqlstate $drh);
$VERSION = '0.01';      #<< Change
$err = 0;               # holds error code   for DBI::err
$errstr =  '';          # holds error string for DBI::errstr
$sqlstate = '00000';    # holds sqlstate for DBI::sqlstate
$drh = undef;           # holds driver handle once initialised
use vars qw($DBD_IGNORECASE);
$DBD_IGNORECASE = 1;
#>>>>> driver (DBD::Template) >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
sub driver($$){
#0. already created - return it
    return $drh if $drh;
#1. not created(maybe normal case)
    my($sClass, $rhAttr) = @_;
    $sClass .= '::dr';
    $drh = DBI::_new_drh($sClass,   
        {   Name        => $sClass,
            Version     => $VERSION,
            Err         => \$DBD::Template::err,
            Errstr      => \$DBD::Template::errstr,
            State       => \$DBD::Template::sqlstate,
            Attribution => 'DBD::Template by KAWAI,Takanori',  #<< Change
        }
    );
    return $drh;
}
#%%%% DBD::Template::dr =============================================================
package DBD::Template::dr;
$DBD::Template::dr::imp_data_size = 0;
#>>>>> connect (DBD::Template::dr) >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
sub connect($$;$$$) {
    my($drh, $sDbName, $sUsr, $sAuth, $rhAttr)= @_;
#1. create database-handle
    my $dbh = DBI::_new_dbh($drh, {
        Name         => $sDbName,
        USER         => $sUsr,
        CURRENT_USER => $sUsr,
    });
#2. Parse extra strings in DSN(key1=val1;key2=val2;...)
    foreach my $sItem (split(/;/, $sDbName)) {
        $dbh->STORE($1, $2) if ($sItem =~ /(.*?)=(.*)/);
    }
#3. Add Extra attributes
    foreach my $sKey (keys %$rhAttr) {
        $dbh->STORE($sKey, $rhAttr->{$sKey});
    }
    $dbh->{AutoCommit}  =1;

#4. Initialize
    my @aReqF = qw(prepare execute fetch rows name);
    my @aMissing=();
    for my $sFunc (@aReqF) {
        push @aMissing, $sFunc unless(defined($dbh->{tmpl_func_}->{$sFunc}));
    }
    die "Set " . join(',', @aMissing) if(@aMissing);

    &{$dbh->{tmpl_func_}->{connect}}($drh, $dbh) 
                if(defined($dbh->{tmpl_func_}->{connect})); #<<-- Change
    return $dbh;
}
#>>>>> data_sources (DBD::Template::dr) >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
sub data_sources ($;$) {
    my($drh, $rhAttr) = @_;
    my $sDbdName = 'Template';
    my @aDsns = ();

    @aDsns = &{$rhAttr->{tmpl_datasources}} ($drh)
        if(defined($rhAttr->{tmpl_datasources}));   #<<-- Change

    return (map {"dbi:$sDbdName:$_"} @aDsns);
}
#>>>>> disconnect_all (DBD::Template::dr) >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
sub disconnect_all($) { }

#%%%%% DBD::Template::db =============================================================
package DBD::Template::db;
$DBD::Template::db::imp_data_size = 0;
#>>>>> prepare (DBD::Template::db) >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
sub prepare {
    my($dbh, $sStmt, $rhAttr) = @_;
#1. Create blank sth
    my $sth = DBI::_new_sth($dbh, { Statement   => $sStmt, });
    return $sth unless($sth);
# 2. Init parameters and store parameter
    $sth->STORE('tmpl_params__', []);
    my $iPrm = &{$dbh->{tmpl_func_}->{prepare}}($dbh, $sth, $sStmt, $rhAttr);
    $sth->STORE('NUM_OF_PARAMS', $iPrm);
    return $sth;
}
#>>>>> commit (DBD::Template::db) >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
sub commit ($) {
    my($dbh) = shift;
    &{$dbh->{tmpl_func_}->{commit}} ($dbh)
            if(defined($dbh->{tmpl_func_}->{commit}));  #-->> Change
}
#>>>>> rollback (DBD::Template::db) >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
sub rollback ($) {
    my($dbh) = shift;
    &{$dbh->{tmpl_func_}->{rollback}} ($dbh)
            if(defined($dbh->{tmpl_func_}->{rollback}));    #-->> Change
    return 1;
}
#>>>>> tmpl_func_ (DBD::Template::db) >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
#-->>Change
sub tmpl_func($@) {
    my($dbh, @aRest) = @_;
    return unless($dbh->{tmpl_func_}->{funcs});

    my $sFunc = pop(@aRest);
    &{$dbh->{tmpl_func_}->{funcs}->{$sFunc}}($dbh, @aRest)
            if(defined($dbh->{tmpl_func_}->{funcs}->{$sFunc}));
}
#<<--Change
#>>>>> table_info (DBD::Template::db) -----------------------------------------------
sub table_info ($) {
    my($dbh) = @_;
#-->> Change 
    my ($raTables, $raName) = 
            &{$dbh->{tmpl_func_}->{table_info}}($dbh)
                        if(defined($dbh->{tmpl_func_}->{table_info}));
#<<-- Change 
    return undef unless $raTables;
#2. create DBD::Sponge driver
    my $dbh2 = $dbh->{'_sponge_driver'};
    if (!$dbh2) {
        $dbh2 = $dbh->{'_sponge_driver'} = DBI->connect("DBI:Sponge:");
        if (!$dbh2) {
            $dbh->DBI::set_err( 1, $DBI::errstr);
            return undef;
            $DBI::errstr .= ''; #Just for IGNORE warning
        }
    }
#3. assign table info to the DBD::Sponge driver
    my $sth = $dbh2->prepare("TABLE_INFO", 
            { 'rows' => $raTables, 'NAMES' => $raName });
    if (!$sth) {
        $dbh->DBI::set_err(1, $dbh2->errstr());
    }
    return  $sth;
}
#>>>>> quote (DBD::Template::db) ----------------------------------------------------
sub quote ($$;$) {
    my($dbh, $sObj, $iType) = @_;
    return &{$dbh->{tmpl_func_}->{quote}}($dbh, $sObj, $iType)
                        if(defined($dbh->{tmpl_func_}->{quote}));   #Change

#1.Numeric
    if (defined($iType)  &&
        ($iType == DBI::SQL_NUMERIC()   || $iType == DBI::SQL_DECIMAL()   ||
         $iType == DBI::SQL_INTEGER()   || $iType == DBI::SQL_SMALLINT()  ||
         $iType == DBI::SQL_FLOAT()     || $iType == DBI::SQL_REAL()      ||
         $iType == DBI::SQL_DOUBLE()    || $iType == DBI::TINYINT())) {
        return $sObj;
    }
#2.NULL
    return 'NULL' unless(defined $sObj);
#3. Others
    $sObj =~ s/\\/\\\\/sg;
    $sObj =~ s/\0/\\0/sg;
    $sObj =~ s/\'/\\\'/sg;
    $sObj =~ s/\n/\\n/sg;
    $sObj =~ s/\r/\\r/sg;
    return "'$sObj'";
}
#>>>>> type_info_all (DBD::Template::db) --------------------------------------------
sub type_info_all ($) {
    my ($dbh) = @_;

    my $raType = &{$dbh->{tmpl_func_}->{type_info_all}}($dbh)
                        if(defined($dbh->{tmpl_func_}->{type_info_all}));   #Change
    $raType ||= 
        [
            [ 'VARCHAR',                #TYPE_NAME
                DBI::SQL_VARCHAR(),     #DATA_TYPE
                undef,                  #PRECISION
                "'",                    #LITERAL_PREFIX
                "'",                    #LITERAL_SUFFIX
                undef,                  #CREATE_PARAMS
                0,                      #NULLABLE
                1,                      #CASE_SENSITIVE
                1,                      #SEARCHABLE
                0,                      #UNSIGNED_ATTRIBUTE
                0,                      #MONEY
                0,                      #AUTO_INCREMENT
                undef,                  #LOCAL_TYPE_NAME
                0,                      #MINIMUM_SCALE
                0                       #MAXIMUM_SCALE
            ],
        ];

    return [
        {   TYPE_NAME       =>  0, DATA_TYPE      =>  1, PRECISION      =>  2,
            LITERAL_PREFIX  =>  3, LITERAL_SUFFIX =>  4, CREATE_PARAMS  =>  5,
            NULLABLE        =>  6, CASE_SENSITIVE =>  7, SEARCHABLE     =>  8,
            UNSIGNED_ATTRIBUTE =>  9, MONEY       => 10, AUTO_INCREMENT => 11,
            LOCAL_TYPE_NAME => 12, MINIMUM_SCALE  => 13, MAXIMUM_SCALE  => 14,
        },
        @$raType,
    ];
}
#>>>>> disconnect (DBD::Template::db) -----------------------------------------------
sub disconnect ($) { 
    my ($dbh) = @_;
    &{$dbh->{tmpl_func_}->{disconnect}}($dbh)
                        if(defined($dbh->{tmpl_func_}->{disconnect}));
    1;
}
#>>>>> FETCH (DBD::Template::db) ----------------------------------------------------
sub FETCH ($$) {
    my ($dbh, $sAttr) = @_;
# 1. AutoCommit
    return $dbh->{$sAttr} if ($sAttr eq 'AutoCommit');
# 2. lower cased = Driver private attributes 
    return $dbh->{$sAttr} if ($sAttr eq (lc $sAttr));
# 3. pass up to DBI to handle
    return $dbh->SUPER::FETCH($sAttr);
}
#>>>>> STORE (DBD::Template::db) ----------------------------------------------------
sub STORE ($$$) {
    my ($dbh, $sAttr, $sValue) = @_;
#1. AutoCommit
    if ($sAttr eq 'AutoCommit') {
        if(defined($dbh->{tmpl_func_}->{rollback})) {
            $dbh->{$sAttr} = ($sValue)? 1: 0;
        }
        else{
    #Rollback
            warn("Can't disable AutoCommit with no rollback func", -1)
                                    unless($sValue);
            $dbh->{$sAttr} = 1;
        }
        return 1;
    } 
#2. Driver private attributes are lower cased
    elsif ($sAttr eq (lc $sAttr)) {
        $dbh->{$sAttr} = $sValue;
        return 1;
    }
#3. pass up to DBI to handle
    return $dbh->SUPER::STORE($sAttr, $sValue);
}
#>>>>> DESTROY (DBD::Template::db) --------------------------------------------------
sub DESTROY($) {
    my($dbh) = @_;
    &{$dbh->{tmpl_func_}->{dbh_destroy}}($dbh)
                        if(defined($dbh->{tmpl_func_}->{dbh_destroy}));
}

#%%%%% DBD::Template::st ============================================================
package DBD::Template::st;
$DBD::Template::st::imp_data_size = 0;
#>>>>> bind_param (DBD::Template::st) -----------------------------------------------
sub bind_param ($$$;$) {
    my($sth, $param, $value, $attribs) = @_;
    return $sth->DBI::set_err(2, "Can't bind_param $param, too big")
        if ($param >= $sth->FETCH('NUM_OF_PARAMS'));
    $sth->{tmpl_params__}->[$param] = $value;  #<<Change (tmpl_)
    return 1;
}
#>>>>> execute (DBD::Template::st) --------------------------------------------------
sub execute($@) {
    my ($sth, @aRest) = @_;
#1. Set Parameters
#1.1 Get Parameters
    my ($raParams, @aRec);
    $raParams = (@aRest)? [@aRest] : $sth->{tmpl_params__};  #<<Change (tmpl_)
#1.2 Check Param count
    my $iParams = $sth->FETCH('NUM_OF_PARAMS');
    if ($iParams && scalar(@$raParams) != $iParams) { #CHECK FOR RIGHT # PARAMS.
        return $sth->DBI::set_err((scalar(@$raParams)-$iParams), 
                "..execute: Wrong number of bind variables (".
                (scalar(@$raParams)-$iParams)." too many!)");
    }
#2. Execute
    my($oResult, $iNumFld, $sErr) = 
        &{$sth->{Database}->{tmpl_func_}->{execute}}($sth, $raParams);
    if ($sErr) { return $sth->DBI::set_err( 1, $@); }
#3. Set NUM_OF_FIELDS
    if ($iNumFld  &&  !$sth->FETCH('NUM_OF_FIELDS')) {
        $sth->STORE('NUM_OF_FIELDS', $iNumFld);
    }
#4. AutoCommit
    $sth->{Database}->commit if($sth->{Database}->FETCH('AutoCommit'));
    return $oResult;
}
#>>>>> fetch (DBD::Template::st) ----------------------------------------------------
sub fetch ($) {
    my ($sth) = @_;

#1. get data
    my ($raDav, $bFinish, $bNotSel) = 
        &{$sth->{Database}->{tmpl_func_}->{fetch}}($sth); #<<Change (tmpl_);

    return $sth->DBI::set_err( 1, 
        "Attempt to fetch row from a Non-SELECT Statement") if ($bNotSel);

    if ($bFinish) {
        $sth->finish;
        return undef;
    }

    if ($sth->FETCH('ChopBlanks')) {
        map { $_ =~ s/\s+$//; } @$raDav;
    }
    $sth->_set_fbav($raDav);
}
*fetchrow_arrayref = \&fetch;
#>>>>> rows (DBD::Template::st) -----------------------------------------------------
sub rows ($) { 
    my($sth) = @_;
    return &{$sth->{Database}->{tmpl_func_}->{rows}}($sth); #<<Change (tmpl_)
}
#>>>>> finish (DBD::Template::st) ---------------------------------------------------
sub finish ($) {
    my ($sth) = @_;
#-->> Change (if you want)
    &{$sth->{Database}->{tmpl_func_}->{finish}}($sth)
        if(defined($sth->{Database}->{tmpl_func_}->{finish}));
#<<-- Change
    $sth->SUPER::finish();
    return 1;
}
#>>>>> FETCH (DBD::Template::st) ----------------------------------------------------
sub FETCH ($$) {
    my ($sth, $attrib) = @_;
#NAME
    return &{$sth->{Database}->{tmpl_func_}->{name}}($sth) #<<Change (tmpl_)
                if ($attrib eq 'NAME');
#TYPE... Statement attribute
    return [(DBI::SQL_VARCHAR()) x $sth->FETCH('NUM_OF_FIELDS')]
        if($attrib eq 'TYPE');
    return [(-1) x $sth->FETCH('NUM_OF_FIELDS')]
        if($attrib eq 'PRECISION');
    return [(undef) x $sth->FETCH('NUM_OF_FIELDS')]
        if($attrib eq 'SCALE');
    return [(1) x $sth->FETCH('NUM_OF_FIELDS')]
        if($attrib eq 'NULLABLE');
    return undef if($attrib eq 'RowInCache');
    return undef if($attrib eq 'CursorName');
# Private driver attributes are lower cased
    return $sth->{$attrib} if ($attrib eq (lc $attrib));
    return $sth->SUPER::FETCH($attrib);
}
#>>>>> STORE (DBD::Template::st) ----------------------------------------------------
sub STORE ($$$) {
    my ($sth, $attrib, $value) = @_;
#1. Private driver attributes are lower cased
    if ($attrib eq (lc $attrib)) {
        $sth->{$attrib} = $value;
        return 1;
    }
    else {
        return $sth->SUPER::STORE($attrib, $value);
    }
}
#>>>>> DESTROY (DBD::Template::st) --------------------------------------------------
sub DESTROY {
    my ($sth) = @_;
    &{$sth->{Database}->{tmpl_func_}->{sth_destroy}}($sth)
        if(defined($sth->{Database}->{tmpl_func_}->{sth_destroy}));
}
#>> Just for no warning-----------------------------------------------
$DBD::Template::dr::imp_data_size = 0;
$DBD::Template::db::imp_data_size = 0;
$DBD::Template::st::imp_data_size = 0;
*DBD::Template::st::fetchrow_arrayref = \&DBD::Template::st::fetch;
#<< Just for no warning------------------------------------------------
1;
__END__