view release on metacpan or  search on metacpan

lib/DBD/Unify.pm  view on Meta::CPAN

	Carp::carp "\$dr_h->data_sources () not defined for Unify\n";
    "";
    } # data_sources

1;

####### Database ##############################################################

package DBD::Unify::db;

$DBD::Unify::db::imp_data_size = 0;

sub parse_trace_flag {
    my ($dbh, $name) = @_;
  # print STDERR "# Flags: $name\n";
    return 0x7FFFFF00 if $name eq "DBD";	# $h->trace ("DBD"); -- ALL
  # return 0x01000000 if $name eq "select";	# $h->trace ("SQL|select");
  # return 0x02000000 if $name eq "update";	# $h->trace ("1|update");
  # return 0x04000000 if $name eq "delete";
  # return 0x08000000 if $name eq "insert";
    return $dbh->SUPER::parse_trace_flag ($name);
    } # parse_trace_flag

sub type_info_all {
    #my ($dbh) = @_;
    require DBD::Unify::TypeInfo;
    return [ @$DBD::Unify::TypeInfo::type_info_all ];
    } # type_info_all

sub get_info {
    my ($dbh, $info_type) = @_;
    require  DBD::Unify::GetInfo;
    my $v = $DBD::Unify::GetInfo::info{int $info_type};
    ref $v eq "CODE" and $v = $v->($dbh);
    return $v;
    } # get_info

sub private_attribute_info {
    return {
	dbd_verbose	=> undef,

	uni_verbose	=> undef,
	uni_unicode	=> undef,
	};
    } # private_attribute_info

sub ping {
    my $dbh = shift;
    $dbh->prepare ("select USER_NAME from SYS.DATABASE_USERS") or return 0;
    return 1;
    } # ping

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

    # Strip comments
    $statement = join "" => map {
	my $s = $_;
	$s =~ m/^'.*'$/ or $s =~ s/(--.*)$//m;
	$s;
	} split m/('[^']*')/ => $statement;
    # create a 'blank' sth
    my $sth = DBI::_new_sth ($dbh, {
	Statement => $statement,
	});

    # Setup module specific data
#   $sth->STORE ("driver_params" => []);
#   $sth->STORE ("NUM_OF_PARAMS" => ($statement =~ tr/?//));

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

    $sth;
    } # prepare

sub _is_or_like {
    my ($fld, $val) = @_;
    $val =~ m/[_%]/ ? "$fld like '$val'" : "$fld = '$val'";
    } # _is_or_like

sub table_info {
    my $dbh = shift;
    my ($catalog, $schema, $table, $type, $attr);
    ref $_[0] or ($catalog, $schema, $table, $type) = splice @_, 0, 4;
    if ($attr = shift) {
	ref ($attr) eq "HASH" or
	    Carp::croak qq{usage: table_info ({ TABLE_NAME => "foo", ... })};
	exists $attr->{TABLE_SCHEM} and $schema = $attr->{TABLE_SCHEM};
	exists $attr->{TABLE_NAME}  and $table  = $attr->{TABLE_NAME};
	exists $attr->{TABLE_TYPE}  and $type   = $attr->{TABLE_TYPE};
	}
    if ($catalog) {
	$dbh->{Warn} and
	    Carp::carp "Unify does not support catalogs in table_info\n";
	return;
	}

    my @where;
    $schema and push @where => _is_or_like ("OWNR",       $schema);
    $table  and push @where => _is_or_like ("TABLE_NAME", $table);
    $type   and $type = uc substr $type, 0, 1;
    $type   and push @where => _is_or_like ("TABLE_TYPE", $type);
    local $" = " and ";
    my $sql = join " " =>
	q{select '', OWNR, TABLE_NAME, TABLE_TYPE, RDWRITE},
	q{from   SYS.ACCESSIBLE_TABLES},
	(@where ? " where @where" : "");
    my $sth = $dbh->prepare ($sql);
    $sth or return;
    $sth->{ChopBlanks} = 1;
    $sth->execute;
    $sth;
    } # table_info

{   my (%cache, @links, $pki);

    sub _sys_clear_cache {
	%cache = ();
	@links = ();
	$pki   = undef;
	} # _sys_clear_cache