(Dlouhe) RESENI: vadny driver DBD::Pg (verze 1.01)

Jindrich Vavruska ok1fou na centrum.cz
Středa Květen 1 17:49:08 MEST 2002


Zdravim vsechny,

nedavno jsem pri nejakych experimentech na PostgreSQL 7.1.3 narazil na vadne 
funkce table_info a tables v driveru DBD::Pg (tyto metody jsou implementovany 
v balicku DBD::Pg::db, odkud je prebira DBI).

Obe puvodni metody ignoruji parametry, takze vraci vzdy stejny vysledek 
(teoreticky tabulky a views). Ale navic je v SQL dotazech techto metod chyba, 
diky ktere se do seznamu nedostanou zadne VIEWs.

Obe funkce jsem predefinoval a najdete je v nasledujicim textu. Autora jsem 
kontaktoval, ale neodpovedel.

# perl ------------------------------

    sub table_info {         # DBI spec: TABLE_CAT, TABLE_SCHEM, TABLE_NAME, 
TABLE_TYPE, REMARKS
        my($dbh, $catalog, $schema, $tname, $reltype) = @_;
        my (@types, $where_type, $where_name) ;
        if( $reltype ) {
            my @rt ;
            $reltype =~ /TABLES/ and push @rt, "'r'" ;
            $reltype =~ /VIEWS/ and push @rt, "'v'" ;
            $reltype =~ /SEQUENCES/ and push @rt, "'s'" ;
            $where_type = ' AND c.relkind IN (' . join(',' , @rt) . ')' ;
        }
        else { $where_type = "AND c.relkind IN ('r','v')" }
        if ($tname) { $where_name = " AND c.relname like '$tname' " } else 
{$where_name=''}
        my $SQL = "SELECT c.reltype, u.usename, c.relname,
            case c.relkind
              when 'r' then 'TABLE'
              when 'v' then 'VIEW'
	      when 's' then 'SEQUENCE'
	      when 'i' then 'INDEX'
              else 'ERROR'
            end,
            ''
            FROM pg_class c, pg_user u
            WHERE c.relname !~ '^pg_'
            AND   c.relname !~ '^xin[vx][0-9]+'
            AND   c.relowner = u.usesysid $where_type $where_name" ;
        my $sth = $dbh->prepare($SQL) or return undef;
        $sth->execute or return undef;
        $sth;
    }

    sub tables {
        my($dbh, $cat, $schem, $tname, $ttype) = @_;

        my $SQL = '' ;
        if( !$ttype or $ttype =~ /TABLES/ ) {
            $SQL .= "SELECT tablename FROM pg_tables WHERE tablename !~ 
'^pg_'" ;
            if( $tname ) { $SQL .= " AND tablename like '$tname'" }
        }
        if( !$ttype or $ttype =~ /VIEWS/ ) {
            $SQL .= ' UNION ' if $SQL ;
            $SQL .= "SELECT viewname FROM pg_views WHERE viewname !~ '^pg_'" ;
            if( $tname ) { $SQL .= " AND viewname like '$tname'" }
        }
        my $sth = $dbh->prepare($SQL) or return undef;
        $sth->execute or return undef;
        my (@tables, @relname);
        while (@relname = $sth->fetchrow_array) {
            push @tables, $relname[0];
        }
        $sth->finish;
        return @tables;
    }

__END__


-- 
Jindra "Bev" Vavruska, OK1FOU, ex-OL4BEV

Electronic devices run on smoke. If you leave the smoke out, they cease to 
function.


Další informace o konferenci Perl