view release on metacpan or  search on metacpan

SQLAnywhere.pm  view on Meta::CPAN

		$conn_str .= ';' . $user;
	    } else {
		$conn_str .= ';UID=' . $user;
	    }
	}
	if( defined( $auth ) && ($auth ne '') ) {
	    $conn_str .= ';PWD=' . $auth;
	}

	# create a 'blank' dbh
	my $dbh = DBI::_new_dbh($drh, {
	    'Name' => $conn_str,
	    'USER' => $user, 'CURRENT_USER' => $user,
	    });

	# Call SQLAnywhere connect func in SQLAnywhere.xs file
	# and populate internal handle data.

	if( !DBD::SQLAnywhere::db::_login($dbh, $conn_str, 
					  (defined $sqlcap) ? $sqlcap : '', '', $attr) ) {
	    return undef;
	}

	$dbh;
    }
}


{   package DBD::SQLAnywhere::db; # ====== DATABASE ======
    use strict;

    sub prepare {
	my($dbh, $statement, @attribs)= @_;

	# create a 'blank' sth

	my $sth = DBI::_new_sth($dbh, {
	    'Statement' => $statement,
	    });

	# Call SQLAnywhere OCI oparse func in SQLAnywhere.xs file.
	# (This will actually also call oopen for you.)
	# and populate internal handle data.

	DBD::SQLAnywhere::st::_prepare($sth, $statement, @attribs)
	    or return undef;

	$sth;
    }

    sub ping {
	my( $dbh ) = @_;

	# Doing a prepare() will actually talk to the server and so this
	# is a cheap test.
	# Strictly speaking, the prepare() could fail due to an error
	# reported from the server (eg. if we exceed the prepared statement
	# limit) but we don't have access to the ping facility through DBCAPI
	# so this is usually a valid test.
	my $rv = eval { $dbh->prepare( "select 1" ); };
	my $alive = ( defined( $rv ) ? 1 : 0 );

	# Suppress the error for ping() -- it should just return a boolean without reporting error
	$dbh->set_err( undef, undef );

	return( $alive );
    }


# Use the DBI-provided quote routine
#    sub quote {
#	my($dbh, $value) = @_;
#	return $value;
#    }


#    sub quote_identifier {
#	my($dbh, $name) = @_;
#	return "\"".$name."\"";
#    }


    sub table_info {
	my($dbh,$catalogue,$schema,$table,$type)       = @_;		# XXX add qualification

	if ( !defined($schema) || $schema eq "" ) {
	    $schema = '%';
	}

	if ( !defined($table) || $table eq "" ) {
	    $table = '%';
	}

	if ( !defined($type) || $type eq "" ) {
	    # $type = 'TABLE,VIEW,SYSTEM TABLE,GLOBAL TEMPORARY,LOCAL TEMPORARY,ALIAS,SYNONYM';
	    $type = '%';
	}

	my $sth = $dbh->prepare("
        select
	    NULL as TABLE_CAT,
	    u.user_name as TABLE_SCHEM,
	    t.table_name as TABLE_NAME,
	    (if t.table_type = 'BASE' then (if t.creator = 0 then 'SYSTEM ' else '' endif) ||'TABLE'
		else (if t.table_type = 'GBL TEMP' then 'GLOBAL TEMPORARY' 
		      else t.table_type
		      endif)
		endif) as TABLE_TYPE,
	    t.remarks as REMARKS
	from SYS.SYSTABLE t, SYS.SYSUSER u
	where t.creator = u.user_id
	  and u.user_name  like ?
 	  and t.table_name like ?
	  and TABLE_TYPE   like ?
	order by u.user_name, t.table_name
	") or return undef;
# and TABLE_TYPE  IN (?)
	$sth->bind_param( 1, $schema );
	$sth->bind_param( 2, $table );
	$sth->bind_param( 3, $type );
	$sth->execute or return undef;
	$sth;
    }


    sub type_info_all {