odbc.pm

ARM上的如果你对底层感兴趣

package Win32::ODBC;

$VERSION = '0.03';

# Win32::ODBC.pm
#       +==========================================================+
#       |                                                          |
#       |                     ODBC.PM package                      |
#       |                     ---------------                      |
#       |                                                          |
#       | Copyright (c) 1996, 1997 Dave Roth. All rights reserved. |
#       |   This program is free software; you can redistribute    |
#       | it and/or modify it under the same terms as Perl itself. |
#       |                                                          |
#       +==========================================================+
#
#
#         based on original code by Dan DeMaggio ([e-mail])
#
#	Use under GNU General Public License or Larry Wall's "Artistic License"
#
#	Check the README.TXT file that comes with this package for details about
#	it's history.
#

require Exporter;
require DynaLoader;

$ODBCPackage = "Win32::ODBC";
$ODBCPackage::Version = 970208;
$::ODBC = $ODBCPackage;
$CacheConnection = 0;

    #   Reserve ODBC in the main namespace for US!
*ODBC::=\%Win32::ODBC::;


@ISA= qw( Exporter DynaLoader );
    # Items to export into callers namespace by default. Note: do not export
    # names by default without a very good reason. Use EXPORT_OK instead.
    # Do not simply export all your public functions/methods/constants.
@EXPORT = qw(
            ODBC_ADD_DSN
            ODBC_REMOVE_DSN
            ODBC_CONFIG_DSN

            SQL_DONT_CLOSE
            SQL_DROP
            SQL_CLOSE
            SQL_UNBIND
            SQL_RESET_PARAMS

            SQL_FETCH_NEXT
            SQL_FETCH_FIRST
            SQL_FETCH_LAST
            SQL_FETCH_PRIOR
            SQL_FETCH_ABSOLUTE
            SQL_FETCH_RELATIVE
            SQL_FETCH_BOOKMARK

            SQL_COLUMN_COUNT
            SQL_COLUMN_NAME
            SQL_COLUMN_TYPE
            SQL_COLUMN_LENGTH
            SQL_COLUMN_PRECISION
            SQL_COLUMN_SCALE
            SQL_COLUMN_DISPLAY_SIZE
            SQL_COLUMN_NULLABLE
            SQL_COLUMN_UNSIGNED
            SQL_COLUMN_MONEY
            SQL_COLUMN_UPDATABLE
            SQL_COLUMN_AUTO_INCREMENT
            SQL_COLUMN_CASE_SENSITIVE
            SQL_COLUMN_SEARCHABLE
            SQL_COLUMN_TYPE_NAME
            SQL_COLUMN_TABLE_NAME
            SQL_COLUMN_OWNER_NAME
            SQL_COLUMN_QUALIFIER_NAME
            SQL_COLUMN_LABEL
            SQL_COLATT_OPT_MAX
            SQL_COLUMN_DRIVER_START
            SQL_COLATT_OPT_MIN
            SQL_ATTR_READONLY
            SQL_ATTR_WRITE
            SQL_ATTR_READWRITE_UNKNOWN
            SQL_UNSEARCHABLE
            SQL_LIKE_ONLY
            SQL_ALL_EXCEPT_LIKE
            SQL_SEARCHABLE
        );
    #The above are included for backward compatibility


sub new
{
    my ($n, $self);
    my ($type) = shift;
    my ($DSN) = shift;
    my (@Results) = @_;

    if (ref $DSN){
        @Results = ODBCClone($DSN->{'connection'});
    }else{
        @Results = ODBCConnect($DSN, @Results);
    }
    @Results = processError(-1, @Results);
    if (! scalar(@Results)){
        return undef;
    }
    $self = bless {};
    $self->{'connection'} = $Results[0];
    $ErrConn = $Results[0];
    $ErrText = $Results[1];
    $ErrNum = 0;
    $self->{'DSN'} = $DSN;
    $self;
}

####
#   Close this ODBC session (or all sessions)
####
sub Close
{
    my ($self, $Result) = shift;
    $Result = DESTROY($self);
    $self->{'connection'} = -1;
    return $Result;
}

####
#   Auto-Kill an instance of this module
####
sub DESTROY
{
    my ($self) = shift;
    my (@Results) = (0);
    if($self->{'connection'} > -1){
        @Results = ODBCDisconnect($self->{'connection'});
        @Results = processError($self, @Results);
        if ($Results[0]){
            undef $self->{'DSN'};
            undef @{$self->{'fnames'}};
            undef %{$self->{'field'}};
            undef %{$self->{'connection'}};
        }
    }
    return $Results[0];
}


sub sql{
    return (Sql(@_));
}

####
#   Submit an SQL Execute statement for processing
####
sub Sql{
    my ($self, $Sql, @Results) = @_;
    @Results = ODBCExecute($self->{'connection'}, $Sql);
    return updateResults($self, @Results);
}

####
#   Retrieve data from a particular field
####
sub Data{

        #   Change by JOC 06-APR-96
        #   Altered by Dave Roth <[e-mail]> 96.05.07
    my($self) = shift;
    my(@Fields) = @_;
    my(@Results, $Results, $Field);

    if ($self->{'Dirty'}){
        GetData($self);
        $self->{'Dirty'} = 0;
    }
    @Fields = @{$self->{'fnames'}} if (! scalar(@Fields));
    foreach $Field (@Fields) {
        if (wantarray) {
            push(@Results, data($self, $Field));
        } else {
            $Results .= data($self, $Field);
        }
    }
    return wantarray ? @Results : $Results;
}

sub DataHash{
    my($self, @Results) = @_;
    my(%Results, $Element);

    if ($self->{'Dirty'}){
        GetData($self);
        $self->{'Dirty'} = 0;
    }
    @Results = @{$self->{'fnames'}} if (! scalar(@Results));
    foreach $Element (@Results) {
        $Results{$Element} = data($self, $Element);
    }

    return %Results;
}

####
#   Retrieve data from the data buffer
####
sub data
{  $_[0]->{'data'}->{$_[1]}; }


sub fetchrow{
    return (FetchRow(@_));
}
####
#   Put a row from an ODBC data set into data buffer
####
sub FetchRow{
    my ($self, @Results) = @_;
    my ($item, $num, $sqlcode);
        # Added by JOC 06-APR-96
        #   $num = 0;
    $num = 0;
    undef $self->{'data'};


    @Results = ODBCFetch($self->{'connection'}, @Results);
    if (! (@Results = processError($self, @Results))){
        ####
        #   There should be an innocuous error "No records remain"
        #   This indicates no more records in the dataset
        ####
        return undef;
    }
        #   Set the Dirty bit so we will go and extract data via the
        #   ODBCGetData function. Otherwise use the cache.
    $self->{'Dirty'} = 1;

        #   Return the array of field Results.
    return @Results;
}

sub GetData{
    my($self) = @_;
    my(@Results, $num);

    @Results = ODBCGetData($self->{'connection'});
    if (!(@Results = processError($self, @Results))){
        return undef;
    }
        ####
        #   This is a special case. Do not call processResults
        ####
    ClearError();
    foreach (@Results){
        s/ +$//; # HACK
        $self->{'data'}->{ ${$self->{'fnames'}}[$num] } = $_;
        $num++;
    }
        #   return is a hack to interface with a assoc array.
    return wantarray? (1, 1): 1;
}

####
#   See if any more ODBC Results Sets
#		Added by Brian Dunfordshore <[e-mail]> 
#		96.07.10
####
sub MoreResults{
    my ($self) = @_;

    my(@Results) = ODBCMoreResults($self->{'connection'});
    return (processError($self, @Results))[0];
}

####
#   Retrieve the catalog from the current DSN
#	NOTE: All Field names are uppercase!!!
####
sub Catalog{
    my ($self) = shift;
    my ($Qualifier, $Owner, $Name, $Type) = @_;
    my (@Results) = ODBCTableList($self->{'connection'}, $Qualifier, $Owner, $Name, $Type);

        #   If there was an error return 0 else 1
    return (updateResults($self, @Results) != 1);
}

####
#   Return an array of names from the catalog for the current DSN
#       TableList($Qualifier, $Owner, $Name, $Type)
#           Return: (array of names of tables)
#	NOTE: All Field names are uppercase!!!
####
sub TableList{
    my ($self) = shift;
    my (@Results) = @_;
    if (! scalar(@Results)){
        @Results = ("", "", "%", "TABLE");
    }

    if (! Catalog($self, @Results)){
        return undef;
    }
    undef @Results;
    while (FetchRow($self)){
        push(@Results, Data($self, "TABLE_NAME"));
    }
    return sort(@Results);
}


sub fieldnames{
    return (FieldNames(@_));
}
####
#   Return an array of fieldnames extracted from the current dataset
####
sub FieldNames { $self = shift; return @{$self->{'fnames'}}; }


####
#   Closes this connection. This is used mostly for testing. You should
#   probably use Close().
####
sub ShutDown{
    my($self) = @_;
    print "\nClosing connection $self->{'connection'}...";
    $self->Close();
    print "\nDone\n";
}

####
#   Return this connection number
####
sub Connection{
    my($self) = @_;
    return $self->{'connection'};
}

####
#   Returns the current connections that are in use.
####
sub GetConnections{
    return ODBCGetConnections();
}

####
#   Set the Max Buffer Size for this connection. This determines just how much
#   ram can be allocated when a fetch() is performed that requires a HUGE amount
#   of memory. The default max is 10k and the absolute max is 100k.
#   This will probably never be used but I put it in because I noticed a fetch()
#   of a MEMO field in an Access table was something like 4Gig. Maybe I did
#   something wrong, but after checking several times I decided to impliment
#   this limit thingie.
####
sub SetMaxBufSize{
    my($self, $Size) = @_;
    my(@Results) = ODBCSetMaxBufSize($self->{'connection'}, $Size);
    return (processError($self, @Results))[0];
}

####
#   Returns the Max Buffer Size for this connection. See SetMaxBufSize().
####
sub GetMaxBufSize{
    my($self) = @_;
    my(@Results) = ODBCGetMaxBufSize($self->{'connection'});
    return (processError($self, @Results))[0];
}


####
#   Returns the DSN for this connection as an associative array.
####
sub GetDSN{
    my($self, $DSN) = @_;
    if(! ref($self)){
        $DSN = $self;
        $self = 0;
    }
    if (! $DSN){
        $self = $self->{'connection'};
	}
    my(@Results) = ODBCGetDSN($self, $DSN);
    return (processError($self, @Results));
}

####
#   Returns an associative array of $XXX{'DSN'}=Description
####
sub DataSources{
    my($self, $DSN) = @_;
    if(! ref $self){
        $DSN = $self;
        $self = 0;
    }
    my(@Results) = ODBCDataSources($DSN);
    return (processError($self, @Results));
}

####
#   Returns an associative array of $XXX{'Driver Name'}=Driver Attributes
####
sub Drivers{
    my($self) = @_;
    if(! ref $self){
        $self = 0;
    }
    my(@Results) = ODBCDrivers();
    return (processError($self, @Results));
}

####
#   Returns the number of Rows that were affected by the previous SQL command.
####
sub RowCount{
    my($self, $Connection) = @_;
    if (! ref($self)){
        $Connection = $self;
        $self = 0;
    }
    if (! $Connection){$Connection = $self->{'connection'};}
    my(@Results) = ODBCRowCount($Connection);
    return (processError($self, @Results))[0];
}

####
#   Returns the Statement Close Type -- how does ODBC Close a statment.
#       Types:
#           SQL_DROP
#           SQL_CLOSE
#           SQL_UNBIND
#           SQL_RESET_PARAMS
####
sub GetStmtCloseType{
    my($self, $Connection) = @_;
    if (! ref($self)){
        $Connection = $self;
        $self = 0;
    }
    if (! $Connection){$Connection = $self->{'connection'};}
    my(@Results) = ODBCGetStmtCloseType($Connection);
    return (processError($self, @Results));
}

####
#   Sets the Statement Close Type -- how does ODBC Close a statment.
#       Types: