view release on metacpan or  search on metacpan

Database.pm  view on Meta::CPAN

## ----------------------------------------------------------------------------
##
## DoOnConnect
##
## in $cmd  sql cmds
##

sub DoOnConnect

    {
    my ($self, $cmd) = @_ ;
    
    if ($cmd)
        {
        if (ref ($cmd) eq 'ARRAY')
            {
            foreach (@$cmd)
                {
                $self -> do ($_) ;
                }
            }
        elsif (ref ($cmd) eq 'HASH')
            {
            $self -> DoOnConnect ($cmd -> {'*'}) ;
            $self -> DoOnConnect ($cmd -> {$self -> {'*Driver'}}) ;
            }
        else
            {
            $self -> do ($cmd) ;
            }
        }
    }
  

## ----------------------------------------------------------------------------
##
## DBHdl
##
## return DBI database handle
##

sub DBHdl ($)

    {
    return $_[0] -> {'*DBHdl'} ;
    }


## ----------------------------------------------------------------------------
##
## do an non select statement 
##
## $statement = statement to do
## \%attr     = attribs (optional)
## @bind_valus= values to bind (optional)
## or 
## \@bind_valus= values to bind (optional)
## \@bind_types  = data types of bind_values
##

sub do($$;$$$)

    {
    my($self, $statement, $attribs, @params) = @_;
    
    $self -> {'*LastSQLStatement'} = $statement ;

    my $ret ;
    my $bval ;
    my $btype ;
    my $dbh ;
    my $sth ;

    if (@params > 1 && ref ($bval = $params[0]) eq 'ARRAY' && ref ($btype = $params[1]) eq 'ARRAY')
        {
        if ($self->{'*Debug'} > 1) { local $^W = 0 ; print DBIx::Recordset::LOG "DB:  do '$statement' bind_values=<@$bval> bind_types=<@$btype>\n" } ;
        $dbh = $self->{'*DBHdl'} ;
        $sth = $dbh -> prepare ($statement, $attribs) ;
        my $Numeric = $self->{'*NumericTypes'} || {} ;
        local $^W = 0 ; # avoid warnings
        if (defined ($sth))
            {
            for (my $i = 0 ; $i < @$bval; $i++)
                {
                $bval -> [$i] += 0 if (defined ($bval -> [$i]) && defined ($btype -> [$i]) && $Numeric -> {$btype -> [$i]}) ;
                #$sth -> bind_param ($i+1, $bval -> [$i], $btype -> [$i]) ;
                #$sth -> bind_param ($i+1, $bval -> [$i], $btype -> [$i] == DBI::SQL_CHAR()?DBI::SQL_CHAR():undef ) ;
		my $bt = $btype -> [$i] ;
                $sth -> bind_param ($i+1, $bval -> [$i], (defined ($bt) && $bt <= DBI::SQL_CHAR())?{TYPE=>$bt}:undef ) ;
                }
            $ret = $sth -> execute ;
            }
        }
    else
        {
        print DBIx::Recordset::LOG "DB:  do $statement <@params>\n" if ($self->{'*Debug'} > 1) ;
        
        $ret = $self->{'*DBHdl'} -> do ($statement, $attribs, @params) ;
        }

    print DBIx::Recordset::LOG "DB:  do returned " . (defined ($ret)?$ret:'<undef>') . "\n" if ($self->{'*Debug'} > 2) ;
    print DBIx::Recordset::LOG "DB:  ERROR $DBI::errstr\n"  if (!$ret && $self->{'*Debug'}) ;
    print DBIx::Recordset::LOG "DB:  in do $statement <@params>\n" if (!$ret && $self->{'*Debug'} == 1) ;

    $LastErr	= $self->{'*LastErr'}	    = $DBI::err ;
    $LastErrstr = $self->{'*LastErrstr'}    = $DBI::errstr ;
    
    return $ret ;
    }


## ----------------------------------------------------------------------------
##
## QueryMetaData
##
## $table        = table (multiple tables must be comma separated)
##


sub QueryMetaData($$)