odbc.pm

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

#           SQL_DROP
#           SQL_CLOSE
#           SQL_UNBIND
#           SQL_RESET_PARAMS
#   Returns the newly set value.
####
sub SetStmtCloseType{
    my($self, $Type, $Connection) = @_;
    if (! ref($self)){
        $Connection = $Type;
        $Type = $self;
        $self = 0;
    }
    if (! $Connection){$Connection = $self->{'connection'};}
    my(@Results) = ODBCSetStmtCloseType($Connection, $Type);
    return (processError($self, @Results))[0];
}

sub ColAttributes{
    my($self, $Type, @Field) = @_;
    my(%Results, @Results, $Results, $Attrib, $Connection, $Temp);
    if (! ref($self)){
        $Type = $Field;
        $Field = $self;
        $self = 0;
    }
    $Connection = $self->{'connection'};
    if (! scalar(@Field)){ @Field = $self->fieldnames;}
    foreach $Temp (@Field){
        @Results = ODBCColAttributes($Connection, $Temp, $Type);
        ($Attrib) = processError($self, @Results);
        if (wantarray){
            $Results{$Temp} = $Attrib;
        }else{
            $Results .= "$Temp";
        }
    }
    return wantarray? %Results:$Results;
}

sub GetInfo{
    my($self, $Type) = @_;
    my($Connection, @Results);
    if(! ref $self){
        $Type = $self;
        $self = 0;
        $Connection = 0;
    }else{
        $Connection = $self->{'connection'};
    }
    @Results = ODBCGetInfo($Connection, $Type);
    return (processError($self, @Results))[0];
}

sub GetConnectOption{
    my($self, $Type) = @_;
    my(@Results);
    if(! ref $self){
        $Type = $self;
        $self = 0;
    }
    @Results = ODBCGetConnectOption($self->{'connection'}, $Type);
    return (processError($self, @Results))[0];
}

sub SetConnectOption{
    my($self, $Type, $Value) = @_;
    if(! ref $self){
        $Value = $Type;
        $Type = $self;
        $self = 0;
    }
    my(@Results) = ODBCSetConnectOption($self->{'connection'}, $Type, $Value);
    return (processError($self, @Results))[0];
}


sub Transact{
    my($self, $Type) = @_;
    my(@Results);
    if(! ref $self){
        $Type = $self;
        $self = 0;
    }
    @Results = ODBCTransact($self->{'connection'}, $Type);
    return (processError($self, @Results))[0];
}


sub SetPos{
    my($self, @Results) = @_;
    @Results = ODBCSetPos($self->{'connection'}, @Results);
    $self->{'Dirty'} = 1;
    return (processError($self, @Results))[0];
}

sub ConfigDSN{
    my($self) = shift @_;
    my($Type, $Connection);
    if(! ref $self){
        $Type = $self;
        $Connection = 0;
        $self = 0;
    }else{
        $Type = shift @_;
        $Connection = $self->{'connection'};
    }
    my($Driver, @Attributes) = @_;
    @Results = ODBCConfigDSN($Connection, $Type, $Driver, @Attributes);
    return (processError($self, @Results))[0];
}


sub Version{
	my($self, @Packages) = @_;
    my($Temp, @Results);
	if (! ref($self)){
		push(@Packages, $self);
	}
	my($ExtName, $ExtVersion) = Info();
	if (! scalar(@Packages)){
		@Packages = ("ODBC.PM", "ODBC.PLL");
	}
	foreach $Temp (@Packages){
		if ($Temp =~ /pll/i){
            push(@Results, "ODBC.PM:$Win32::ODBC::Version");
		}elsif ($Temp =~ /pm/i){
            push(@Results, "ODBC.PLL:$ExtVersion");
		}
	}
    return @Results;
}


sub SetStmtOption{
    my($self, $Option, $Value) = @_;
    if(! ref $self){
        $Value = $Option;
        $Option = $self;
        $self = 0;
    }
    my(@Results) = ODBCSetStmtOption($self->{'connection'}, $Option, $Value);
    return (processError($self, @Results))[0];
}

sub GetStmtOption{
    my($self, $Type) = @_;
    if(! ref $self){
        $Type = $self;
        $self = 0;
    }
    my(@Results) = ODBCGetStmtOption($self->{'connection'}, $Type);
    return (processError($self, @Results))[0];
}

sub GetFunctions{
    my($self, @Results)=@_;
    @Results = ODBCGetFunctions($self->{'connection'}, @Results);
    return (processError($self, @Results));
}

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

sub SetCursorName{
    my($self, $Name) = @_;
    my(@Results) = ODBCSetCursorName($self->{'connection'}, $Name);
    return (processError($self, @Results))[0];
}

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

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


# ----------- R e s u l t   P r o c e s s i n g   F u n c t i o n s ----------
####
#   Generic processing of data into associative arrays
####
sub updateResults{
    my ($self, $Error, @Results) = @_;

    undef %{$self->{'field'}};

    ClearError($self);
    if ($Error){
        SetError($self, $Results[0], $Results[1]);
        return ($Error);
    }

    @{$self->{'fnames'}} = @Results;

    foreach (0..$#{$self->{'fnames'}}){
        s/ +$//;
        $self->{'field'}->{${$self->{'fnames'}}[$_]} = $_;
    }
    return undef;
}

# ----------------------------------------------------------------------------
# ----------------- D e b u g g i n g   F u n c t i o n s --------------------

sub Debug{
    my($self, $iDebug, $File) = @_;
    my(@Results);
    if (! ref($self)){
        if (defined $self){
            $File = $iDebug;
            $iDebug = $self;
        }
        $Connection = 0;
        $self = 0;
    }else{
        $Connection = $self->{'connection'};
    }
    push(@Results, ($Connection, $iDebug));
    push(@Results, $File) if ($File ne "");
    @Results = ODBCDebug(@Results);
    return (processError($self, @Results))[0];
}

####
#   Prints out the current dataset (used mostly for testing)
####
sub DumpData {
    my($self) = @_; my($f, $goo);

        #   Changed by JOC 06-Apr-96
        #   print "\nDumping Data for connection: $conn->{'connection'}\n";
    print "\nDumping Data for connection: $self->{'connection'}\n";
    print "Error: \"";
    print $self->Error();
    print "\"\n";
    if (! $self->Error()){
       foreach $f ($self->FieldNames){
            print $f . " ";
            $goo .= "-" x length($f);
            $goo .= " ";
        }
        print "\n$goo\n";
        while ($self->FetchRow()){
            foreach $f ($self->FieldNames){
                print $self->data($f) . " ";
            }
            print "\n";
        }
    }
}

sub DumpError{
    my($self) = @_;
    my($ErrNum, $ErrText, $ErrConn);
    my($Temp);

    print "\n---------- Error Report: ----------\n";
    if (ref $self){
        ($ErrNum, $ErrText, $ErrConn) = $self->Error();
        ($Temp = $self->GetDSN()) =~ s/.*DSN=(.*?);.*/$1/i;
        print "Errors for \"$Temp\" on connection " . $self->{'connection'} . ":\n";
    }else{
        ($ErrNum, $ErrText, $ErrConn) = Error();
        print "Errors for the package:\n";
    }

    print "Connection Number: $ErrConn\nError number: $ErrNum\nError message: \"$ErrText\"\n";
    print "-----------------------------------\n";

}

####
#   Submit an SQL statement and print data about it (used mostly for testing)
####
sub Run{
    my($self, $Sql) = @_;

    print "\nExcecuting connection $self->{'connection'}\nsql statement: \"$Sql\"\n";
    $self->sql($Sql);
    print "Error: \"";
    print $self->error;
    print "\"\n";
    print "--------------------\n\n";
}

# ----------------------------------------------------------------------------
# ----------- E r r o r   P r o c e s s i n g   F u n c t i o n s ------------

####
#   Process Errors returned from a call to ODBCxxxx().
#   It is assumed that the Win32::ODBC function returned the following structure:
#      ($ErrorNumber, $ResultsText, ...)
#           $ErrorNumber....0 = No Error
#                           >0 = Error Number
#           $ResultsText.....if no error then this is the first Results element.
#                           if error then this is the error text.
####
sub processError{
    my($self, $Error, @Results) = @_;
    if ($Error){
        SetError($self, $Results[0], $Results[1]);
        undef @Results;
    }
    return @Results;
}

####
#   Return the last recorded error message
####
sub error{
    return (Error(@_));
}

sub Error{
    my($self) = @_;
    if(ref($self)){
        if($self->{'ErrNum'}){
            my($State) = ODBCGetSQLState($self->{'connection'});
            return (wantarray)? ($self->{'ErrNum'}, $self->{'ErrText'}, $self->{'connection'}, $State) :"[$self->{'ErrNum'}] [$self->{'connection'}] [$State] \"$self->{'ErrText'}\"";
        }
    }elsif ($ErrNum){
        return (wantarray)? ($ErrNum, $ErrText, $ErrConn):"[$ErrNum] [$ErrConn] \"$ErrText\"";
    }
    return undef
}

####
#   SetError:
#       Assume that if $self is not a reference then it is just a placeholder
#       and should be ignored.
####
sub SetError{
    my($self, $Num, $Text, $Conn) = @_;
    if (ref $self){
        $self->{'ErrNum'} = $Num;
        $self->{'ErrText'} = $Text;
        $Conn = $self->{'connection'} if ! $Conn;
    }
    $ErrNum = $Num;
    $ErrText = $Text;

        ####
        #   Test Section Begin
        ####
#    $! = ($Num, $Text);
        ####
        #   Test Section End
        ####

    $ErrConn = $Conn;
}

sub ClearError{
    my($self, $Num, $Text) = @_;
    if (ref $self){
        undef $self->{'ErrNum'};
        undef $self->{'ErrText'};
    }else{
        undef $ErrConn;
        undef $ErrNum;
        undef $ErrText;
    }
    ODBCCleanError();
    return 1;
}


sub GetError{
    my($self, $Connection) = @_;
    my(@Results);
    if (! ref($self)){
        $Connection = $self;
        $self = 0;
    }else{
        if (! defined($Connection)){
            $Connection = $self->{'connection'};
        }
    }

    @Results = ODBCGetError($Connection);
    return @Results;
}




# ----------------------------------------------------------------------------
# ------------------ A U T O L O A D   F U N C T I O N -----------------------

sub AUTOLOAD {
    # This AUTOLOAD is used to 'autoload' constants from the constant()
    # XS function.  If a constant is not found then control is passed
    # to the AUTOLOAD in AutoLoader.

    my($constname);
    ($constname = $AUTOLOAD) =~ s/.*:://;
    #reset $! to zero to reset any current errors.
    $!=0;
    $val = constant($constname, @_ ? $_[0] : 0);

    if ($! != 0) {
    if ($! =~ /Invalid/) {
        $AutoLoader::AUTOLOAD = $AUTOLOAD;
        goto &AutoLoader::AUTOLOAD;
    }
    else {

            # Added by JOC 06-APR-96
            # $pack = 0;
        $pack = 0;
        ($pack,$file,$line) = caller;
            print "Your vendor has not defined Win32::ODBC macro $constname, used in $file at line $line.";
    }
    }
    eval "sub $AUTOLOAD { $val }";
    goto &$AUTOLOAD;
}


    #   --------------------------------------------------------------
    #
    #
    #   Make sure that we shutdown ODBC and free memory even if we are
    #   using perlis.dll on Win32 platform!
END{
#    ODBCShutDown() unless $CacheConnection;
}


bootstrap Win32::ODBC;

# Preloaded methods go here.

# Autoload methods go after __END__, and are processed by the autosplit program.

1;
__END__