package DbDefInfo;use strict;use warnings;our($VERSION, @ISA, @EXPORT, @EXPORT_OK);require Exporter;use Carp;$VERSION = '0.0001';@ISA = qw(Exporter);@EXPORT = qw(get_table_def_infos);@EXPORT_OK = qw();
 use DBI;my $column_info_query = <<EOD;
  SELECT DISTINCT
    PG_ATTRIBUTE.ATTNAME AS NAME,
    PG_TYPE.TYPNAME AS TYPE,
    PG_ATTRIBUTE.ATTTYPMOD - 4 AS SUBTYPE,
    PG_ATTRIBUTE.ATTNOTNULL AS NOTNULL,
    PG_ATTRDEF.ADSRC AS DEFAULT,
    PG_DESCRIPTION.DESCRIPTION AS DESCRIPTION,
    PG_ATTRIBUTE.ATTNUM AS NO,
    PG_ATTRIBUTE.ATTALIGN
  FROM
    PG_ATTRIBUTE
  INNER JOIN PG_CLASS ON 
    PG_CLASS.OID = PG_ATTRIBUTE.ATTRELID
  INNER JOIN PG_TYPE ON
    PG_ATTRIBUTE.ATTTYPID = PG_TYPE.OID
  LEFT JOIN PG_DESCRIPTION ON
    PG_CLASS.OID = PG_DESCRIPTION.OBJOID AND
    PG_ATTRIBUTE.ATTNUM = PG_DESCRIPTION.OBJSUBID
  LEFT JOIN PG_ATTRDEF ON 
      PG_ATTRIBUTE.ATTRELID = PG_ATTRDEF.ADRELID AND
      PG_ATTRIBUTE.ATTNUM = PG_ATTRDEF.ADNUM
  WHERE
    PG_CLASS.RELNAME='%s' AND
    PG_ATTRIBUTE.ATTNUM > 0
  ORDER BY
    PG_ATTRIBUTE.ATTNUM 
EOD
 my $keys_info_query = <<EOD;
  SELECT
   C.RELNAME AS TABLENAME, 
   A.ATTNAME AS COLUMNNAME,
   FCLASS.RELNAME AS FTABLENAME,
   FATTR.ATTNAME AS FCOLUMNNAME
  FROM
    PG_CONSTRAINT N
  INNER JOIN  PG_CLASS C
   ON N.CONRELID = C.OID
  INNER JOIN PG_ATTRIBUTE A
   ON A.ATTRELID = C.OID
  LEFT JOIN 
   PG_CLASS AS FCLASS ON
    N.CONFRELID = FCLASS.OID
  LEFT JOIN PG_ATTRIBUTE FATTR
   ON FATTR.ATTRELID = C.OID AND
      FATTR.ATTNUM = ANY(N.CONFKEY)
  WHERE
    A.ATTNUM =ANY (N.CONKEY) AND
    C.RELNAME = '%s'
EOD
 my $all_table_query = <<EOD;
  SELECT DISTINCT
    PG_CLASS.RELNAME,
    PG_DESCRIPTION.DESCRIPTION
  FROM
    PG_CLASS
  INNER JOIN 
    PG_TABLES ON
      PG_CLASS.RELNAME = PG_TABLES.TABLENAME
  LEFT JOIN
    PG_DESCRIPTION ON
      PG_CLASS.OID = PG_DESCRIPTION.OBJOID AND
      PG_DESCRIPTION.OBJSUBID = 0
  WHERE
    SCHEMANAME = '%s' AND PG_CLASS.RELKIND = 'r'
EOD
 sub get_all_tables {my ($db, $schema_name) = @_;my $st = $db->prepare(sprintf $all_table_query, $schema_name);my $res = $st->execute;my @table_infos;while (my ($table_name, $table_comment) = $st->fetchrow) {push @table_infos, {table_name => $table_name, table_comment => $table_comment};}$st->finish;return @table_infos;}
 sub get_keys_infos {my ($db, $table_name) = @_;my @keys;my $st_keys = $db->prepare(sprintf($keys_info_query, $table_name));my $res_columns = $st_keys->execute;while (my $row_hashref = $st_keys->fetchrow_hashref) {push @keys, $row_hashref;}$st_keys->finish;return @keys;}
 sub get_column_infos {my ($db, $table_name) = @_;my @columns;my $st_columns = $db->prepare(sprintf($column_info_query, $table_name));my $res_columns = $st_columns->execute;while (my $row_hashref = $st_columns->fetchrow_hashref) {push @columns, $row_hashref;}$st_columns->finish;return @columns;}
 sub get_table_def_infos {my $settings = shift;my $db = DBI->connect("DBI:$settings->{type}:host=$settings->{host};dbname=$settings->{dbname}",$settings->{user},$settings->{passwd})or die "DBI connect failed : $DBI::errstr";my @rows;for my $table_info (get_all_tables($db, $settings->{schema_name})) {my @columns = get_column_infos($db, $table_info->{table_name});my @keys = get_keys_infos($db, $table_info->{table_name});push @rows, { table_info => $table_info, column_infos => \@columns, key_infos => \@keys};}$db->disconnect;return @rows;}1;

package DbDefInfo; use strict; use warnings; our($VERSION, @ISA, @EXPORT, @EXPORT_OK); require Exporter; use Carp; $VERSION = '0.0001'; @ISA = qw(Exporter); @EXPORT = qw(get_table_def_infos); @EXPORT_OK = qw(); use DBI; my $column_info_query = <<EOD; SELECT DISTINCT PG_ATTRIBUTE.ATTNAME AS NAME, PG_TYPE.TYPNAME AS TYPE, PG_ATTRIBUTE.ATTTYPMOD - 4 AS SUBTYPE, PG_ATTRIBUTE.ATTNOTNULL AS NOTNULL, PG_ATTRDEF.ADSRC AS DEFAULT, PG_DESCRIPTION.DESCRIPTION AS DESCRIPTION, PG_ATTRIBUTE.ATTNUM AS NO, PG_ATTRIBUTE.ATTALIGN FROM PG_ATTRIBUTE INNER JOIN PG_CLASS ON PG_CLASS.OID = PG_ATTRIBUTE.ATTRELID INNER JOIN PG_TYPE ON PG_ATTRIBUTE.ATTTYPID = PG_TYPE.OID LEFT JOIN PG_DESCRIPTION ON PG_CLASS.OID = PG_DESCRIPTION.OBJOID AND PG_ATTRIBUTE.ATTNUM = PG_DESCRIPTION.OBJSUBID LEFT JOIN PG_ATTRDEF ON PG_ATTRIBUTE.ATTRELID = PG_ATTRDEF.ADRELID AND PG_ATTRIBUTE.ATTNUM = PG_ATTRDEF.ADNUM WHERE PG_CLASS.RELNAME='%s' AND PG_ATTRIBUTE.ATTNUM > 0 ORDER BY PG_ATTRIBUTE.ATTNUM EOD my $keys_info_query = <<EOD; SELECT C.RELNAME AS TABLENAME, A.ATTNAME AS COLUMNNAME, FCLASS.RELNAME AS FTABLENAME, FATTR.ATTNAME AS FCOLUMNNAME FROM PG_CONSTRAINT N INNER JOIN PG_CLASS C ON N.CONRELID = C.OID INNER JOIN PG_ATTRIBUTE A ON A.ATTRELID = C.OID LEFT JOIN PG_CLASS AS FCLASS ON N.CONFRELID = FCLASS.OID LEFT JOIN PG_ATTRIBUTE FATTR ON FATTR.ATTRELID = C.OID AND FATTR.ATTNUM = ANY(N.CONFKEY) WHERE A.ATTNUM =ANY (N.CONKEY) AND C.RELNAME = '%s' EOD my $all_table_query = <<EOD; SELECT DISTINCT PG_CLASS.RELNAME, PG_DESCRIPTION.DESCRIPTION FROM PG_CLASS INNER JOIN PG_TABLES ON PG_CLASS.RELNAME = PG_TABLES.TABLENAME LEFT JOIN PG_DESCRIPTION ON PG_CLASS.OID = PG_DESCRIPTION.OBJOID AND PG_DESCRIPTION.OBJSUBID = 0 WHERE SCHEMANAME = '%s' AND PG_CLASS.RELKIND = 'r' EOD sub get_all_tables { my ($db, $schema_name) = @_; my $st = $db->prepare(sprintf $all_table_query, $schema_name); my $res = $st->execute; my @table_infos; while (my ($table_name, $table_comment) = $st->fetchrow) { push @table_infos, {table_name => $table_name, table_comment => $table_comment}; } $st->finish; return @table_infos; } sub get_keys_infos { my ($db, $table_name) = @_; my @keys; my $st_keys = $db->prepare(sprintf($keys_info_query, $table_name)); my $res_columns = $st_keys->execute; while (my $row_hashref = $st_keys->fetchrow_hashref) { push @keys, $row_hashref; } $st_keys->finish; return @keys; } sub get_column_infos { my ($db, $table_name) = @_; my @columns; my $st_columns = $db->prepare(sprintf($column_info_query, $table_name)); my $res_columns = $st_columns->execute; while (my $row_hashref = $st_columns->fetchrow_hashref) { push @columns, $row_hashref; } $st_columns->finish; return @columns; } sub get_table_def_infos { my $settings = shift; my $db = DBI->connect( "DBI:$settings->{type}:host=$settings->{host};dbname=$settings->{dbname}", $settings->{user}, $settings->{passwd}) or die "DBI connect failed : $DBI::errstr"; my @rows; for my $table_info (get_all_tables($db, $settings->{schema_name})) { my @columns = get_column_infos($db, $table_info->{table_name}); my @keys = get_keys_infos($db, $table_info->{table_name}); push @rows, { table_info => $table_info, column_infos => \@columns, key_infos => \@keys }; } $db->disconnect; return @rows; } 1;