RDBAL::Schema - RDBAL Schema information object

  use RDBAL;
  use RDBAL::Schema;
  $X = RDBAL::Connect('username', 'password', 'server');
  $schema = new($X,$database);
  $database = $schema->Database();
  @user_tables = $schema->User_Tables();
  @views = $schema->Views();
  @procedures = $schema->Procedures();
  @system_tables = $schema->System_Tables();
  @fields = $schema->Table_Fields($table);
  @fields = $schema->System_Table_Fields($table);
  @fields = $schema->View_Fields($view);
  @fields = $schema->Procedure_Parameters($procedure);
  @fields = $schema->Fields($object,$object_type);
  $field_info = $schema->Field_Info($object,$field,$object_type,$info_type);
  $primary_key_number = $schema->Primary_Key($object,$field,$object_type);
  $field_type = $schema->Field_Type($object,$field,$object_type);
  $field_length = $schema->Field_Length($object,$field,$object_type);
  $field_width = $schema->Field_Width($object,$field,$object_type);
  $field_precision = $schema->Field_Precision($object,$field,$object_type);
  $field_scale = $schema->Field_Scale($object,$field,$object_type);
  $field_identity = $schema->Field_Identity($object,$field,$object_type);
  $field_null = $schema->Field_Null($object,$field,$object_type);
  @indexes = $schema->Indexes($table,$object_type);
  @primary_keys = $schema->Primary_Keys($table,$object_type);
  @keys = $schema->Keys($table,$object_type);
  @children_tables = $schema->Children($table);
  @parent_tables = $schema->Parents($table);
  @field_equivalences = $schema->Relation($parent,$child);
  # Get comments (views' and procedures' definitions)
  $comments = $schema->Comments($object,$object_type)
  # Get view's tables
  @tables = $schema->View_Tables($view)

        perl Makefile.PL
        make
        make test
        make install

	make schema_cache

    alter table table2
        add foreign key  (field1, field2)
           references table1 (field1, field2)
    go

	create rule fk_table2_insert as on insert to table2
	where new.field1 <> table1.field1 and new.field2 <> table1.field1
        do instead nothing;

	create rule fk_table2_update as on update to table2
	where new.field1 <> table1.field1 and new.field2 <> table1.field2
        do instead nothing;

	create rule pk_table1_update as on update to table1
	where old.field1 = table2.field1 and old.field2 = table2.field2
        do instead nothing;

	create rule pk_table1_delete as on delete to table1
	where old.field1 = table2.field1 and old.field2 = table2.field2
        do instead nothing;

     $query = new RDBAL::Schema($connection,$database);

     OR

     $query = new RDBAL::Schema($connection,$database, -option => value);

     -server         Database server name.  This is used to differentiate
                     between databases when caching.
     -server_type    Database server type.  This is used to differentiate
                     how to retrieve the schema.  The default is Transact-SQL
                     or a hand-crafted schema cache file.  Currently, the
                     only correct values for this are I<undef>, I<pg>,
                     I<oracle>, I<dbi:Sybase>, or I<dbi:Oracle>.
     -get_system     1 or undef.  A true value for this option causes retrieval
                     (and caching) of schema for system tables.
     -nocache        1 or undef.  A true value causes the cached schema to not
                     be used and a new cache to be written.
     -username       Database username.  This is used to differentiate
                     between different users views of a database when caching.

  use RDBAL;
  $connection = RDBAL::Connect('username', 'password', 'server');

     $database = $schema->Database();

     @user_tables = $schema->User_Tables();

     @views = $schema->Views();

     @procedures = $schema->Procedures();

     @system_tables = $schema->System_Tables();

     @fields = $schema->Table_Fields($table);

     @fields = $schema->System_Table_Fields($table);

     @fields = $schema->View_Fields($view);

     @parameters = $schema->Procedure_Parameters($procedure);

     @fields = $schema->Fields($object,$object_type);

     $primary_key_number = $schema->Primary_Key($object,$field,$object_type);

     $field_type = $schema->Field_Type($object,$field,$object_type);

     $field_length = $schema->Field_Length($object,$field,$object_type);

     $field_width = $schema->Field_Width($object,$field,$object_type);

     $field_precision = $schema->Field_Precision($object,$field,$object_type);

     $field_scale = $schema->Field_Scale($object,$field,$object_type);

     $field_identity = $schema->Field_Identity($object,$field,$object_type);

     $field_null = $schema->Field_Null($object,$field,$object_type);

     $field_info = $schema->Field_Info($object,$field,$object_type,$info_type);

     @indexes = $schema->Indexes($table,$object_type);

    index_name	index_description	comma_seperated_index_field_list

     PK_STS	clustered, unique located on default	chromosome, arm, id_number

     @primary_keys = $schema->Primary_Keys($table,$object_type);

     @keys = $schema->Keys($table,$object_type);

     @children_tables = $schema->Children($table);

     @parent_tables = $schema->Parents($table);

     @field_equivalences = $schema->Relation($parent,$child);

     $comments = $schema->Comments($object,$object_type)

     @tables = $schema->View_Tables($view)

     $quoted_field = $schema->Quote_Field($object,$field,$value,$object_type);

  #!/usr/local/bin/perl

  use RDBAL
  use RDBAL::Schema;

  $server   = shift;
  $database = shift;
  $username = shift;
  $password = shift;

  # Check to see if we want to use a different name for the server
  if ($RDBAL::Layer{'SybaseDBlib'} || $RDBAL::Layer{'ApacheSybaseDBlib'}) {
      $server = 'sybase_sql';
  } else {
      $server = 'odbc_sql';
  }
  if (!defined($server) ||
      !defined($database) ||
      !defined($username) ||
      !defined($password)) {
      die "Usage is: get_schema.pl server database username password\n";
  }

  # Get connnection to database server
  ( $X = RDBAL::Connect($username,$password,$server)
   or (die "Failed to connect to $server $username"));

  $schema = new RDBAL::Schema($X,$database, -get_system => 1);

  $, = "\t";
  print "Info for database: " . $schema->Database() . "\n";
  print "User Tables:\n";
  map {
      $table = $_;
      print "\tTable: $table\n";
      map {
  	print "\t\t". $_ . (($schema->Primary_Key($table,$_)) ? '*' : ''),
  	$schema->Field_Type($table,$_),
  	$schema->Field_Length($table,$_),
  	$schema->Field_Precision($table,$_),
  	$schema->Field_Scale($table,$_),
  	(($schema->Field_Identity($table,$_)) ? 'Identity' : ''),
  	(($schema->Field_Null($table,$_)) ? 'NULL' : 'NONNULL')
  	  . "\n";
      } $schema->Table_Fields($table);
      print "\t\tPrimary keys:", $schema->Primary_Keys($table,'User Table'),"\n";
      map {
  	@keys = split(',',$_);
  	print "\t\tIndex keys:", @keys ,"\n";
      } $schema->Keys($table,'User Table');
      map {
  	($index_name, $index_description, $keys) = split("\t",$_);
  	print "\t\tIndexes:\t$index_name\t$keys\t$index_description\n";
      } $schema->Indexes($table,'User Table');
      print "\t\tComments:", $schema->Comments($table,'User Table'), "\n";
      map {
  	print "\t\tParents: $_ (Reverse)", $schema->Relation($_,$table),"\n";
      } $schema->Parents($table);
      map {
  	print "\t\tChildren: $_", $schema->Relation($table,$_),"\n";
      } $schema->Children($table);
  } $schema->User_Tables();

  print "System Tables:\n";
  map {
      $table = $_;
      print "\tTable: $table\n";
      map {
  	print "\t\t". $_ . (($schema->Primary_Key($table,$_,'System Table')) ? '*' : ''),
  	$schema->Field_Type($table,$_,'System Table'),
  	$schema->Field_Length($table,$_,'System Table'),
  	$schema->Field_Precision($table,$_,'System Table'),
  	$schema->Field_Scale($table,$_,'System Table'),
  	(($schema->Field_Identity($table,$_,'System Table')) ? 'Identity' : ''),
  	(($schema->Field_Null($table,$_,'System Table')) ? 'NULL' : 'NONNULL')
  	    . "\n";
      } $schema->System_Table_Fields($table);
      print "\t\tComments:", $schema->Comments($table,'System Table'), "\n";
  } $schema->System_Tables();

  print "Views:\n";
  map {
      $table = $_;
      print "\tView: $table (Tables:", $schema->View_Tables($_), ")\n";
      map {
  	print "\t\t". $_,
  	$schema->Field_Type($table,$_,'View'),
  	$schema->Field_Length($table,$_,'View'),
  	$schema->Field_Precision($table,$_,'View'),
  	$schema->Field_Scale($table,$_,'View'),
  	(($schema->Field_Null($table,$_,'View')) ? 'NULL' : 'NONNULL')
  	  . "\n";
      } $schema->View_Fields($table);
      print "\tComments:", $schema->Comments($table,'View'), "\n";
  } $schema->Views();

  print "Procedures:\n";
  map {
      $table = $_;
      print "\tProcedure: $table\n";
      map {
  	print "\t\t". $_,
  	$schema->Field_Type($table,$_,'Procedure'),
  	$schema->Field_Length($table,$_,'Procedure'),
  	$schema->Field_Precision($table,$_,'Procedure'),
  	$schema->Field_Scale($table,$_,'Procedure'),
  	(($schema->Field_Null($table,$_,'Procedure')) ? 'NULL' : 'NONNULL')
  	 . "\n";
      } $schema->Procedure_Parameters($table);
      print "\tComments:", $schema->Comments($table,'Procedure'), "\n";
  } $schema->Procedures();

     for suggestions and bug fixes.

#
# This is a perl module to work with an SQL database
#
# new($DBconnection,$database)
#	create a new schema object
#
# Brian Dunford-Shore 1/6/98
#
package RDBAL::Schema;

require 5.000;

$VERSION = "1.2";
sub Version { $VERSION; }

use RDBAL::Config;
use strict;
use vars qw(@ISA @EXPORT $VERSION $DefaultClass $AutoloadClass);
use Exporter;
@ISA = qw();

@EXPORT = ( );

sub import {
    my $pkg = shift;
    my $callpkg = caller;
    Exporter::export 'RDBAL::Schema', $callpkg, @_;
}

# Default class for the SQL object to use when all else fails.
$DefaultClass = 'RDBAL::Schema' unless defined $RDBAL::Schema::DefaultClass;
# This is where to look for autoloaded routines.
$AutoloadClass = $DefaultClass unless defined $RDBAL::Schema::AutoloadClass;


#
# Method: new
# Get database information
#

sub new {
    my($class,$connection,$database,%options) = @_;
    my $self = {};
    my($cache_output);

    if (!defined($connection) || !defined($database)) {
	return undef;
    }
    $connection->UseDatabase($database);
#    ( $connection->UseDatabase($database) )
#        or (print "Unable to USE database $database\n" and 
#        die "Failed to use $database database");

    bless $self,ref $class || $class || $DefaultClass;
    $self->{'connection'} = $connection;
    $self->{'server'} = $options{'-server'};
    $self->{'user'} = $options{'-username'};
    $self->{'database'} = $database;
    $self->{'get_system'} = $options{'-get_system'};
    $self->{'server_type'} = $options{'-server_type'};

    if ($options{'-nocache'}) {
	$cache_output = $self->get_schema();
	$self->write_schema_cache($cache_output,1);
    } else {
	if (!$self->read_schema_cache()) {
	    $cache_output = $self->get_schema();
	    $self->write_schema_cache($cache_output);
	}
    }
    return $self;
}

sub get_schema {
    my($self) = shift;
    my($connection) = $self->{'connection'};
    my($database) = $self->{'database'};
    my($cache_output);

    $connection->UseDatabase($database);
#    ( $connection->UseDatabase($database) )
#        or (print "Unable to USE database $database\n" and 
#        die "Failed to use $database database");

    $cache_output .= $self->get_schema_objects();

    $cache_output .= $self->get_pkeys('User Table',$self->User_Tables());
    $cache_output .= $self->get_fkeys('User Table',$self->User_Tables());
    $cache_output .= $self->get_index('User Table',$self->User_Tables());
    $cache_output .= $self->get_comments('User Table',$self->User_Tables());

    $cache_output .=
	$self->get_pkeys('System Table',$self->System_Tables());
    $cache_output .=
	$self->get_fkeys('System Table',$self->System_Tables());
    $cache_output .=
	$self->get_index('System Table',$self->System_Tables());
    $cache_output .=
	$self->get_comments('System Table',$self->System_Tables());

    $cache_output .= $self->get_comments('View',$self->Views());

    $cache_output .= $self->get_comments('Procedure',$self->Procedures());

    return $cache_output;
}

sub get_schema_objects {
    my($self) = shift;
    my($connection) = $self->{'connection'};
    my($query);
    my($category);
    my(@row);
    my($cache_output);

    if ($self->{'get_system'}) {
	$category = "'P', 'S', 'U', 'V'";
    } else {
	$category = "'P', 'U', 'V'";
    }
    $query = <<"EndQuery";
select 'Table'=user_name(t.uid)+'.'+t.name, 'Object_Type'=t.type, 'Field'=c.name,
    'Type'=d.name, 'Length'=c.length, 'Precision'=c.prec, 'Scale'=c.scale,
    'Identity'=(c.status & 128), 'Null'=convert(bit,(c.status & 8))
    from sysobjects t, sysusers u, syscolumns c, systypes d
    where t.type in ( $category ) and u.uid=t.uid and t.id=c.id
    and d.name in ( 'tinyint', 'smallint', 'int', 'intn', 'numeric', 'decimal',
		   'numericn', 'decimaln',
                    'float', 'floatn', 'double', 'real',
		   'smallmoney', 'money', 'moneyn',
                    'smalldatetime', 'datetime', 'datetimn',
		   'timestamp',
                    'char', 'varchar', 'nchar', 'nvarchar',
                    'binary', 'varbinary', 'bit', 'text', 'image' )
    and c.type=d.type and d.name <> 'nvarchar'
--	and c.usertype=d.usertype
	order by t.type, t.name, c.colid
EndQuery
    if ($self->{'server_type'} eq 'oracle') {
	$query = "select user_catalog.table_name, table_type, column_name, data_type, data_length, data_precision, data_scale, 0, nullable from user_catalog, user_tab_columns where user_catalog.table_name=user_tab_columns.table_name and table_type != 'SYNONYM'";
    }
    if ($self->{'server_type'} eq 'Pg') {
	$cache_output .= pg_get_table_fields($connection,$self);
    } else {
	$connection->Sql($query);
	while(@row = $connection->NextRow()) {
	    if ($connection->Regular_Row()) {
		@row = trim_spaces(@row);
		$cache_output .= join("\t",('O', @row)) . "\n";
		$self->add_table_row(@row);
	    }
	}
	while ($connection->More_Results()) {}
    }
    $cache_output .= "\f\n";
    return $cache_output;
}

sub get_pkeys {
    my($self) = shift;
    my($object_type) = shift;
    my(@objects) = @_;
    my($connection) = $self->{'connection'};
    my($object);
    my(@row);
    my($sp_pkeys);
    my($owner,$kobject);
    my($cache_output);

    if ($self->{'server_type'} eq 'Pg') {
	$cache_output .= pg_get_primary_keys($connection,$self,$object_type,
					     $self->{'database'});
    } else {
	# Get primary keys and indexes of tables
	map {
	    $object = $_;
	    if (/\./) {
		($owner,$kobject) = /^([^\.]+)\.(.*)$/;
		$sp_pkeys = "execute sp_pkeys $kobject, $owner";
	    } else {
		$sp_pkeys = "execute sp_pkeys $_";
	    }
	    if ($self->{'server_type'} eq 'oracle') {
		$sp_pkeys = "select 'table_qualifier', all_constraints.owner,
  all_constraints.table_name, column_name, position
  from all_constraints, all_cons_columns
  where all_constraints.constraint_type='P'
  and all_constraints.constraint_name=all_cons_columns.constraint_name
  and all_constraints.owner=all_cons_columns.owner
  and all_constraints.table_name=all_cons_columns.table_name
  and all_constraints.table_name = '$_'";
	    }
	    $connection->Sql($sp_pkeys);
	    while(@row = $connection->NextRow()) {
		if ($connection->Regular_Row()) {
		    @row = trim_spaces(@row);
		    $cache_output .= join("\t",('PK',$object, $object_type, @row)) . "\n";
		    $self->add_pkey_row($object,$object_type,@row);
		}
	    }
	    while ($connection->More_Results()) {}
	} @objects;
    }
    $cache_output .= "\f\n";
    return $cache_output;
}

sub get_fkeys {
    my($self) = shift;
    my($object_type) = shift;
    my(@objects) = @_;
    my($connection) = $self->{'connection'};
    my($object);
    my(@row);
    my($sp_fkeys);
    my($owner,$kobject);
    my($cache_output);

    if ($self->{'server_type'} eq 'Pg') {
	$cache_output .= pg_get_fk($connection,$self,$object_type,
				   ,$self->{'database'});
    } else {
	# Get relations
	map {
	    $object = $_;
	    if (/\./) {
		($owner,$kobject) = /^([^\.]+)\.(.*)$/;
		$sp_fkeys = "execute sp_fkeys $kobject, $owner";
	    } else {
		$sp_fkeys = "execute sp_fkeys $_";
	    }
	    if ($self->{'server_type'} eq 'oracle') {
		$sp_fkeys = "select 'tq' as pk_tq, a.owner as pk_owner, a.table_name as pk_table, a.column_name as pk_column,
  'tq', b.owner, b.table_name, b.column_name, a.position as pk_position, b.position
  from all_cons_columns a, all_cons_columns b, all_constraints ac
  where ac.constraint_type='R' and a.table_name='$_'
  and ac.r_constraint_name=a.constraint_name
  and ac.constraint_name=b.constraint_name";
	    }
	    $connection->Sql($sp_fkeys);
	    while(@row = $connection->NextRow()) {
		if ($connection->Regular_Row() &&
		    defined($row[2]) && $row[2] !~ /^\s*$/ &&
		    defined($row[3]) && $row[3] !~ /^\s*$/ &&
		    defined($row[6]) && $row[6] !~ /^\s*$/ &&
		    defined($row[7]) && $row[7] !~ /^\s*$/ ) {
		    @row = trim_spaces(@row);
		    $cache_output .= join("\t",('FK', $object_type, @row)) . "\n";
		    $self->add_fkey_row($object_type,@row);
		}
	    }
	    while ($connection->More_Results()) {}
	} @objects;
    }
    $cache_output .= "\f\n";
    return $cache_output;
}

sub get_index {
    my($self) = shift;
    my($object_type) = shift;
    my(@objects) = @_;
    my($connection) = $self->{'connection'};
    my($object);
    my(@row);
    my($sp_helpindex);
    my(@indexes);
    my($cache_output);
    my($last_index);
    my($last_string);
    my(@fields);
    my(@irow);

    if ($self->{'server_type'} eq 'Pg') {
	$cache_output .= pg_get_indexes($connection,$self,$object_type,
					$self->{'database'});
    } else {
	# Get index of table
	map {
	    $object = $_;
	    $sp_helpindex = "if exists (select id from sysindexes where id=object_id('$object') and indid > 0 and indid < 255) execute sp_helpindex '$object'";
	    if ($self->{'server_type'} eq 'oracle') {
		$sp_helpindex = "select a.index_name, uniqueness,
		column_name
		from all_indexes a, all_ind_columns b
		where owner=index_owner and a.index_name=b.index_name
                and a.table_name='$_'
		and a.table_owner=b.table_owner and a.table_name=b.table_name
		order by index_owner, a.index_name, a.table_owner, a.table_name, column_position";
	    }
	    $connection->Sql($sp_helpindex);
	    do {
		while(@row = $connection->NextRow()) {
		    if ($connection->Regular_Row()) {
			@row = trim_spaces(@row);
			if ($#row > 1) {
			    if ($row[0] ne $last_index) {
				if (defined($last_index)) {
				    @irow = ($last_index, $last_string,
					     join(', ',@fields));
				    $self->add_index_row($object,$object_type,
							 @irow);
				    $cache_output .= join("\t",('I',
								$object,
								$object_type,
								@irow)) . "\n";
				    push @indexes, join("\t",($irow[0], $irow[2],
							      $irow[1]));
				}
				undef @fields;
				$last_index = $row[0];
				$last_string = $row[1];
			    }
			    push @fields, ($row[2]);
			}
		    }
		}
	    } while ($connection->More_Results());
	    if (defined($last_index)) {
		@irow = ($last_index, $last_string,
			 join(', ',@fields));
		$self->add_index_row($object,$object_type,@irow);
		$cache_output .= join("\t",('I',
					    $object, $object_type,
					    @irow)) . "\n";
		push @indexes, join("\t",($irow[0], $irow[2],
					  $irow[1]));
	    }
	    if (defined(@indexes)) {
		$self->add_indexes($object,$object_type,@indexes);
	    }
	    undef @indexes;
	    undef $last_index;
	    undef @fields;
	    $cache_output .= "\n";
	} @objects;
    }
    $cache_output .= "\f\n";
    return $cache_output;
}

sub get_comments {
    my($self) = shift;
    my($object_type) = shift;
    my(@objects) = @_;
    my($connection) = $self->{'connection'};
    my($object);
    my($comment_query);
    my(@row);
    my($cache_output);

    map {
	$object = $_;
	my($comment_query) = <<"EndQuery";
	select text from syscomments
	    where id=object_id('$object') order by number
EndQuery
	if ($self->{'server_type'} eq 'oracle') {
	    $comment_query = "select text from all_views where view_name='$object'";
	} elsif ($self->{'server_type'} eq 'Pg') {
	    $comment_query = "SELECT definition FROM pg_views WHERE viewname='$object'";
	}
	$connection->Sql($comment_query);
	while(@row = $connection->NextRow()) {
	    if ($connection->Regular_Row()) {
		$row[0] =~ s/\r\n/\n/g;
		$row[0] =~ s/\n\r/\n/g;
		$row[0] =~ s/\n$//g;
		$row[0] =~ s/^\s*//g;
		$row[0] =~ s/\s*$//g;
		$row[0] =~ s/\t/     /g;
		if ($self->{'server_type'} eq 'Pg') {
		    $row[0] =~ s/\s*\;\s*$//;
		}		
		$self->{$object_type}->{$object}->{'comments'} .= $row[0];
		$row[0] =~ s/\n/\r/g;
		$cache_output .= join("\t",('C',$object,$object_type, $row[0] )) . "\n";
	    }
	}
	while ($connection->More_Results()) {}
    } @objects;
    $cache_output .= "\f\n";
    return $cache_output;
}


# Object destroy routine
sub DESTROY {
}

#
# $database = $schema->Database();
#

sub Database {
    my($self) = shift;
    return $self->{'database'};
}

#
# @user_tables = $schema->User_Tables();
#

sub User_Tables {
    my($self) = shift;
    return (keys %{$self->{'User Table'}});
}

#
# @views = $schema->Views();
#

sub Views {
    my($self) = shift;
    return (keys %{$self->{'View'}});
}

#
# @procedures = $schema->Procedures();
#

sub Procedures {
    my($self) = shift;
    return (keys %{$self->{'Procedure'}});
}

#
# @system_tables = $schema->System_Tables();
#

sub System_Tables {
    my($self) = shift;
    return (keys %{$self->{'System Table'}});
}

#
# @fields = $schema->Table_Fields($table);
#

sub Table_Fields {
    my($self) = shift;
    my($object) = shift;
    return $self->Fields($object,'User Table');
}

#
# @fields = $schema->System_Table_Fields($table);
#

sub System_Table_Fields {
    my($self) = shift;
    my($object) = shift;
    return $self->Fields($object,'System Table');
}

#
# @fields = $schema->View_Fields($view);
#

sub View_Fields {
    my($self) = shift;
    my($object) = shift;
    return $self->Fields($object,'View');
}

#
# @fields = $schema->Procedure_Parameters($procedure);
#

sub Procedure_Parameters {
    my($self) = shift;
    my($object) = shift;
    return $self->Fields($object,'Procedure');
}

#
# @fields = $schema->Fields($object,$object_type);
#

sub Fields {
    my($self) = shift;
    my($object) = shift;
    my($object_type) = shift;
    $object_type = (defined($object_type)) ? $object_type : 'User Table';
    if (defined($self->{$object_type}->{$object}->{'Fields'})) {
	return @{$self->{$object_type}->{$object}->{'Fields'}};
    } else {
	return ();
    }
}

#
# $field_info = $schema->Field_Info($object,$field,$object_type,$info_type);
#

sub Field_Info {
    my($self) = shift;
    my($object) = shift;
    my($field) = shift;
    my($object_type) = shift;
    my($info_type) = shift;
    $object_type = (defined($object_type)) ? $object_type : 'User Table';
    $info_type = (defined($info_type)) ? $info_type : 'Type';
    return $self->{$object_type}->{$object}->{'Field'}->{$field}->{$info_type};
}

#
# $primary_key_number = $schema->Primary_Key($object,$field,$object_type);
#

sub Primary_Key {
    my($self) = shift;
    my($object) = shift;
    my($field) = shift;
    my($object_type) = shift;
    return $self->Field_Info($object,$field,$object_type,'Primary_Key');
}

#
# $field_type = $schema->Field_Type($object,$field,$object_type);
#

sub Field_Type {
    my($self) = shift;
    my($object) = shift;
    my($field) = shift;
    my($object_type) = shift;
    return $self->Field_Info($object,$field,$object_type,'Type');
}

#
# $field_length = $schema->Field_Length($object,$field,$object_type);
#

sub Field_Length {
    my($self) = shift;
    my($object) = shift;
    my($field) = shift;
    my($object_type) = shift;
    return $self->Field_Info($object,$field,$object_type,'Length');
}

#
# $field_width = $schema->Field_Width($object,$field,$object_type);
#

sub Field_Width {
    my($self) = shift;
    my($object) = shift;
    my($field) = shift;
    my($object_type) = shift;
    my($type) = $self->Field_Type($object,$field,$object_type);
    my($length) = $self->Field_Length($object,$field,$object_type);;
    my(%numeric_length) = ( 1 => 3,
			   2 => 5,
			   4 => 10 );
    my($width);

    if ($type =~ /char/ ||
	$type =~ /decimal/ ||
	$type =~ /numeric/ ) {
	$width = $length;
    } elsif ($type =~ /text/ ) {
	$width = 255;		# Not a real good answer for this one
    } elsif ($type =~ /int/) {
	$width = $numeric_length{$length};
    } elsif ($type =~ /float/ || $type =~ /real/ ) {
	$width = 15;		# this might vary
    } elsif ($type eq 'smallmoney' ) {
	$width = 14;
    } elsif ($type =~ /money/ ) {
	$width = 26;
    } elsif ($type =~ /date/ ) {
	$width = 26;		# Not a real good answer for this one
    } elsif ($type eq 'bit' ) {
	$width = 1;
    } else {
	$width = $length;
    }
    
    return $width;
}

#
# $field_precision = $schema->Field_Precision($object,$field,$object_type);
#

sub Field_Precision {
    my($self) = shift;
    my($object) = shift;
    my($field) = shift;
    my($object_type) = shift;
    return $self->Field_Info($object,$field,$object_type,'Precision');
}

#
# $field_scale = $schema->Field_Scale($object,$field,$object_type);
#

sub Field_Scale {
    my($self) = shift;
    my($object) = shift;
    my($field) = shift;
    my($object_type) = shift;
    return $self->Field_Info($object,$field,$object_type,'Scale');
}

#
# $field_identity = $schema->Field_Identity($object,$field,$object_type);
#

sub Field_Identity {
    my($self) = shift;
    my($object) = shift;
    my($field) = shift;
    my($object_type) = shift;
    return $self->Field_Info($object,$field,$object_type,'Identity');
}

#
# $field_null = $schema->Field_Null($object,$field,$object_type);
#

sub Field_Null {
    my($self) = shift;
    my($object) = shift;
    my($field) = shift;
    my($object_type) = shift;
    return $self->Field_Info($object,$field,$object_type,'Null');
}

#
# @indexes = $schema->Indexes($table,$object_type);
#

sub Indexes {
    my($self) = shift;
    my($table) = shift;
    my($object_type) = shift;

    $object_type = (defined($object_type)) ? $object_type : 'User Table';
    return split("\n",$self->{$object_type}->{$table}->{'indexes'});
}

#
# @primary_keys = $schema->Primary_Keys($table,$object_type);
#

sub Primary_Keys {
    my($self) = shift;
    my($table) = shift;
    my($object_type) = shift;

    $object_type = (defined($object_type)) ? $object_type : 'User Table';
    if (defined($self->{$object_type}->{$table}->{'primary_keys'})) {
	return @{$self->{$object_type}->{$table}->{'primary_keys'}};
    } else {
	return ();
    }
}


#
# @keys = $schema->Keys($table,$object_type);
#

sub Keys {
    my($self) = shift;
    my($table) = shift;
    my($object_type) = shift;

    $object_type = (defined($object_type)) ? $object_type : 'User Table';
    if (defined($self->{$object_type}->{$table}->{'index_keys'})) {
	return @{$self->{$object_type}->{$table}->{'index_keys'}};
    } else {
	return ();
    }
}

#
# @children_tables = $schema->Children($table);
#

sub Children {
    my($self) = shift;
    my($object) = shift;
    my($object_type) = 'User Table';

    if (defined($self->{$object_type}->{$object}->{'children'})) {
	return @{$self->{$object_type}->{$object}->{'children'}};
    } else {
	return ();
    }
}

#
# @parent_tables = $schema->Parents($table);
#

sub Parents {
    my($self) = shift;
    my($object) = shift;
    my($object_type) = 'User Table';

    if (defined($self->{$object_type}->{$object}->{'parents'})) {
	return @{$self->{$object_type}->{$object}->{'parents'}};
    } else {
	return ();
    }
}

#
# @field_equivalences = $schema->Relation($parent,$child);
#

sub Relation {
    my($self) = shift;
    my($parent) = shift;
    my($child) = shift;
    my($object_type) = 'User Table';

    if (defined($self->{'Relation'}->{"$parent\t$child"})) {
	return @{$self->{'Relation'}->{"$parent\t$child"}};
    } else {
	return ();
    }
}



#
# Get comments (views' and procedures' definitions)
#
# $comments = $schema->Comments($object,$object_type)
#

sub Comments {
    my($self) = shift;
    my($object) = shift;
    my($object_type) = shift;

    $object_type = (defined($object_type)) ? $object_type : 'Procedure';
    return $self->{$object_type}->{$object}->{'comments'};
}

#
# Get view's tables
#
# @tables = $schema->View_Tables($view)
#

sub View_Tables {
    my($self) = shift;
    my($object) = shift;
    my(@tables);
    my($view_query);
    my(%hash_table);

    $view_query = $self->Comments($object,'View');
    # See if object is a table
    if (!defined($view_query) || $view_query eq '') {
	push @tables, ($object);
    } else {
	$view_query =~ s/\n/ /g;
	$view_query =~ s/^.*\s+[Ff][Rr][Oo][Mm]\s+//;
	$view_query =~ s/[Ww][Hh][Ee][Rr][Ee]\s+.*$//;
	$view_query =~ s/\(//g;
	$view_query =~ s/\)//g;
	$view_query =~ s/[Jj][Oo][Ii][Nn]/,/g;
	map {
	    s/^\s*//g;
	    s/\s*$//g;
	    s/^(\S+)\s+.*$/$1/;
	    if (!defined($hash_table{$_}) ) {
		$hash_table{$_} = 1;
	    }
	} split(',',$view_query);
	@tables = keys %hash_table;
    }
    return @tables;
}

#
# $quoted_field = $schema->Quote_Field($object,$field,$value,$object_type);
#

sub Quote_Field {
    my($self) = shift;
    my($object) = shift;
    my($field) = shift;
    my($value) = shift;
    my($object_type) = shift;
    my($type) = $self->Field_Info($object,$field,$object_type,'Type');
    my($length) = $self->Field_Length($object,$field,$object_type);
    my($quoted);

    $type =~ tr/[A-Z]/[a-z]/;
    if ($type =~ /char/ ||
	$type =~ /text/ ||
	$type =~ /date/ ) {
	$quoted = 1;
    }
    if ($quoted) {
	$value =~ s/\'/\'\'/g;	# Quote quotes
	if (length($value) > $length &&
	    $type !~ /date/ && 
	    $type !~ /text/) {
	    $value = substr($value,0,$length);
	}
	$value = "'$value'";
    }
    if ($type =~ /date/ &&
	$self->{'server_type'} eq 'oracle') {
	$value = "TO_DATE($value, 'YYYY-MM-DD HH24:MI:SS')";
    }
    return $value;
}


sub read_schema_cache {
    my($self) = shift;
    my($database) = $self->{'database'};
    my($server) = $self->{'server'};
    my($user) = $self->{'user'};
    my($line_type);
    my(@row);
    my($object, $object_type);
    my(@indexes);
    my($cache);

    $cache = "$RDBAL::Config::cache_directory/$server$database$user.cache";
    if (-e $cache && -r $cache) {
	open(CACHE,"$cache");
	while(<CACHE>) {
	    chomp;
	    ($line_type, @row) = split("\t");
	    if ($line_type eq 'O') {
		$self->add_table_row(@row);
	    } elsif ($line_type eq 'PK') {
		$self->add_pkey_row(@row);
	    } elsif ($line_type eq 'FK') {
		$self->add_fkey_row(@row);
	    } elsif ($line_type eq 'I') {
		$self->add_index_row(@row);
		$object = $row[0];
		$object_type = $row[1];
		push @indexes, join("\t",($row[2], $row[4], $row[3]));
	    } elsif ($line_type eq 'C') {
		$row[2] =~ s/\r/\n/g;
		$self->{$row[1]}->{$row[0]}->{'comments'} .= $row[2];
	    } elsif ($line_type =~ /^$/) {
		if (defined($object) && defined($object_type)) {
		    $self->add_indexes($object,$object_type,@indexes);
		}
		undef $object;
		undef $object_type;
		undef @indexes;
	    }
	}
	close(CACHE);
	return 1;
    } else {
	return 0;
    } 
}

sub write_schema_cache {
    my($self) = shift;
    my($cache_output) = shift;
    my($nocache) = shift;
    my($database) = $self->{'database'};
    my($server) = $self->{'server'};
    my($user) = $self->{'user'};
    my($cache);

    $cache = "$RDBAL::Config::cache_directory/$server$database$user.cache";
    if (-e $RDBAL::Config::cache_directory &&
	($nocache || !-e $cache)) {
	open(CACHE,">$cache");
	print CACHE $cache_output;
	close(CACHE);
	return 1;
    } else {
	return 0;
    } 
}

sub trim_spaces {
    my($item);
    foreach $item (@_) {
	$item =~ s/^\s*//g;
	$item =~ s/\s*$//g;
	$item =~ s/\t/ /g;
    }
    return @_;
}


sub add_table_row {
    my($self) = shift;
    my($object,
       $object_type,
       $field,
       $type,
       $length,
       $precision,
       $scale,
       $identity,
       $null) = @_;
    my(%otype_name) = ( 'S' => 'System Table',
			'U' => 'User Table',
			'V' => 'View',
			'P' => 'Procedure',
			'TABLE' => 'User Table',
			'VIEW' => 'View',
			'PROCEDURE' => 'Procedure'
			);
    my($objref);

    $object =~ s/^dbo\.//;
    $objref = $self->{$otype_name{$object_type}}->{$object};
    if ($identity) {
	$objref->{'Identity_Column'} = $field;
    }
    $objref->{'Field'}->{$field} =
    {
	'Type' => $type,
	'Length' => $length,
	'Precision' => $precision,
	'Scale' => $scale,
	'Identity' => $identity,
	'Null' => $null
	};
    push @{$objref->{'Fields'}}, ($field);
    $self->{$otype_name{$object_type}}->{$object} = $objref;
    return $self;
}

sub add_pkey_row {
    my($self) = shift;
    my($object) = shift;
    my($object_type) = shift;
    my(@row) = @_;

    if (!defined($self->{$object_type}->{$object}->{'primary_keys'})) {
	$self->{$object_type}->{$object}->{'primary_keys'} = [];
    }
    push @{$self->{$object_type}->{$object}->{'primary_keys'}}, ($row[3]);
    $self->{$object_type}->{$object}->{'Field'}->{$row[3]}->{'Primary_Key'} =
	$row[4];
    return $self;
}

sub add_index_row {
    my($self) = shift;
    my($table) = shift;
    my($object_type) = shift;
    my(@row) = @_;
    if (!defined($self->{$object_type}->{$table}->{'index_keys'})) {
	$self->{$object_type}->{$table}->{'index_keys'} = [];
    }
    push @{$self->{$object_type}->{$table}->{'index_keys'}}, ($row[2]);
}

sub add_indexes {
    my($self) = shift;
    my($table) = shift;
    my($object_type) = shift;
    my(@indexes) = @_;

    $self->{$object_type}->{$table}->{'indexes'} = join("\n",@indexes);
    return $self;
}


sub add_fkey_row {
    my($self) = shift;
    my($object_type) = shift;
    my(@row) = @_;
    my($object);

    $object = $row[2];
    if (!defined($self->{$object_type}->{$object}->{'children'})) {
#	$self->{$object_type}->{$object}->{'children'} = [];
    }
    if (!defined($self->{$object_type}->{$object}->{'parents'})) {
	$self->{$object_type}->{$object}->{'parents'} = [];
    }
    if (!defined($self->{'Relation'}->{"$object\t$row[6]"})) {
	$self->{'Relation'}->{"$object\t$row[6]"} = [];
    }
    push @{$self->{'Relation'}->{"$object\t$row[6]"}}, ("$row[3]=$row[7]");
    if (!defined($self->{'children'}->{"$object\t$row[6]"})) {
	$self->{'children'}->{"$object\t$row[6]"} = 1;
	push @{$self->{$object_type}->{$object}->{'children'}}, ($row[6]);
	push @{$self->{$object_type}->{$row[6]}->{'parents'}}, ($object);
    }
    return $self;
}

sub pg_get_table_fields {
    my($X) = shift;
    my($self) = shift;
    my($view_query) = 'SELECT viewname from pg_views';
    # Table Fields:
    my($query) = "SELECT c.relname as \"object\", 'U' as \"objecttype\",
				a.attname as \"fieldname\", t.typname as \"typename\",
				a.attlen as \"typelength\", a.atttypmod as \"fieldlength\",
				0 as \"identity\", a.attnotnull as \"nullable\"
		FROM pg_class c, pg_attribute a, pg_user u, pg_type t 
		WHERE c.relkind = 'r' and
				a.attnum > 0 and a.attrelid = c.oid and
				c.relowner=u.usesysid and a.atttypid = t.oid
		ORDER BY c.relname, attnum";
    my(@row);
    my($result);
    my($status);
    my($cache_output);

    $result = $X->Sql($view_query);
    my($view);
    my(%VIEW);
    do {
	while(@row = $X->NextRow()) {
	    if ($X->Regular_Row()) {
		$view = $row[0];
		$VIEW{$view} = 1;
	    }
	}
    } while ($X->More_Results());

    $result = $X->Sql($query);
    my($object, $objecttype, $fieldname, $typename, $typelength, $attlength,
       $identity, $nullable);
    do {
	while(@row = $X->NextRow()) {
	    if ($X->Regular_Row()) {
		($object, $objecttype, $fieldname, $typename,
		 $typelength, $attlength,
		 $identity, $nullable) = @row;
		my($fieldlength, $precision, $scale);
		my(%TYPEMAP) = (
				'abstime' => 'datetime',
				'aclitem' => 'binary',
				'bool' => 'bit',
				'box' => 'binary',
				'bpchar' => 'char',
				'bytea' => 'tinyint',
				'cid' => 'binary',
				'cidr' => 'binary',
				'circle' => 'binary',
				'date' => 'datetime',
				'filename' => 'varchar',
				'float4' => 'float',
				'float8' => 'double',
				'inet' => 'binary',
				'int2' => 'smallint',
				'int4' => 'int',
				'int8' => 'int',
				'line' => 'binary',
				'lseg' => 'binary',
				'macaddr' => 'binary',
				'name' => 'varchar',
				'oid' => 'int',
				'oid8' => 'int',
				'path' => 'varchar',
				'point' => 'binary',
				'polygon' => 'binary',
				'regproc' => 'binary',
				'reltime' => 'datetime',
				'smgr' => 'binary',
				'tid' => 'int',
				'time' => 'datetime',
				'timespan' => 'datetime',
				'tinterval' => 'datetime',
				'unknown' => 'binary',
				'xid' => 'int'
				);
		
		if (defined($TYPEMAP{$typename})) {
		    $typename = $TYPEMAP{$typename};
		}
		
		if ($typelength > 0) {
		    $fieldlength = $typelength;
		    undef $precision;
		    undef $scale;
		} else {
		    if ($typename =~ /[Nn][Uu][Mm][Ee][Rr][Ii][Cc]/) {
			$precision = ($attlength - 4) >> 16;
			$scale = ($attlength - 4) & 0xffff;
			$fieldlength = $precision;
		    } else {
			$fieldlength = $attlength - 4;
			undef $precision;
			undef $scale;
		    }
		}
		$nullable = ($nullable =~ /[Tt]/) ? 0 : 1;
		$objecttype = (defined($VIEW{$object})) ? 
		    ( ($object =~ /^pg_/) ? 'SV' : 'V') :
			( ($object =~ /^pg_/) ? 'S' : 'U') ;
		@row = ($object, $objecttype, $fieldname,
				     $typename, $fieldlength,
				     $precision, $scale,
				     $identity, $nullable);
		$cache_output .= join("\t",('O', @row)) . "\n";
		$self->add_table_row(@row);
	    }
	}
    } while ($X->More_Results());
    return $cache_output;
}


sub pg_get_primary_keys {
    my($X) = shift;
    my($self) = shift;
    my($ob_type) = shift;
    my($database) = shift;
    my($cache_output);

    # Primary Key
    my($query) = "SELECT t.relname as \"object\",
				'User Table' as \"objecttype\",
				'$database' as \"database\", ' ' as \"owner\",
				t.relname as \"object\",
				a.attname as \"fieldname\", a.attnum as \"position\",
				c.relname as \"primary_key\"
		FROM pg_class c, pg_class t, pg_index i, pg_attribute a
		WHERE a.attnum > 0 and a.attrelid=c.oid and t.oid=i.indrelid
		and c.oid=i.indexrelid and i.indisunique='t'
		ORDER BY t.relname, attnum";
    my(@row);
    my($result);
    my($status);

    $result = $X->Sql($query);
    do {
	while(@row = $X->NextRow()) {
	    if ($X->Regular_Row()) {
		if (($ob_type eq 'User Table' && $row[0] !~ '^pg_') ||
		    ($ob_type eq 'System Table' && $row[0] =~ '^pg_')) {
			$cache_output .= join("\t",('PK',@row)) . "\n";
			$self->add_pkey_row(@row);
		}
	    }
	}
    } while ($X->More_Results());
    return $cache_output;
}

sub pg_get_fk {
    my($X) = shift;
    my($self) = shift;
    my($ob_type) = shift;
    my($database) = shift;
    my($cache_output);

    # Rules
    my($query) = "SELECT tablename, rulename, definition FROM pg_rules";
    my(@row);
    my($result);
    my($status);

    $result = $X->Sql($query);
    my($object, $rulename, $definition);
    my($rule, $ptable, $where);
    do {
	while(@row = $X->NextRow()) {
	    if ($X->Regular_Row()) {
		($object, $rulename, $definition) = @row;
		if ($rulename =~ /^fk_/ &&
		    $definition =~ /^\s*CREATE\s+RULE\s+(\S+)\s+AS\s+ON\s+INSERT\s+TO\s+(\S+)\s+WHERE\s+(.*)\s*DO\s+INSTEAD\s+NOTHING\s*/i) {
		    ($rule, $ptable, $where) = $definition =~ /^\s*CREATE\s+RULE\s+(\S+)\s+AS\s+ON\s+INSERT\s+TO\s+(\S+)\s+WHERE\s+(.*)\s*DO\s+INSTEAD\s+NOTHING\s*/i;
		    $rule =~ s/\"//g;
		    $ptable =~ s/\"//g;
		    if (($ob_type eq 'User Table' && $ptable !~ '^pg_') ||
			($ob_type eq 'System Table' && $ptable =~ '^pg_')) {
			$cache_output .= pg_parse_for_fkey($self,
							   $database,$ptable,
							   $rulename,$where);
		    }
		}
	    }
	}
    } while ($X->More_Results());
    return $cache_output;
}

sub pg_parse_for_fkey {
    my($self) = shift;
    my($database) = shift;
    my($table) = shift;
    my($rulename) = shift;
    my($where) = shift;
    my($relation_ref) = shift;
    my($cache_output) = shift;
    my($conjunction);
    my($first,$operator,$second);
    my($primary, $foreign);
    my($ptable, $ftable, $pfield, $ffield);
    my($object_type) = ($table =~ /^pg_/) ? 'System Table' : 'User Table';
    my($key_seq);
    my(@row);

    if (!defined($relation_ref)) {
	$relation_ref = {};
    }
    if ($where =~ /^\s*$/) {
	return $cache_output;
    }
    ($conjunction) = $where =~ s/^\s*(OR|AND)\s+//i;
    $where =~ s/^\s*(OR|AND)\s+//i;
    $where =~ s/^\(+//;
    ($first,$operator,$second) = $where =~ /^(\S+)\s+(\S+)\s+(\S+)/;
    $second =~ s/\)+//g;
    if ($first =~ /new\./) {
	$primary = $second;
	$foreign = $first;
    } else {
	$primary = $first;
	$foreign = $second;
    }
    $foreign =~ s/new\./$table./;
    $foreign =~ s/\"//g;
    $primary =~ s/\"//g;
    $where =~ s/^\S+\s+\S+\s+\S+//;
    $where =~ s/^\s*\)+\s*//;
    ($ptable, $pfield) = split('\.',$primary);
    ($ftable, $ffield) = split('\.',$foreign);
    $key_seq = $relation_ref->{"$ftable\t$ptable"}; # key sequence position
    $key_seq++;
    $relation_ref->{"$ftable\t$ptable"} = $key_seq;
    @row = ($database, undef, $ptable, $pfield, $database, undef, $ftable,
	    $ffield, $key_seq, 1, 1, $rulename);
    $cache_output .= join("\t",('FK', $object_type, @row)) . "\n";
    $self->add_fkey_row($object_type,@row);
    return pg_parse_for_fkey($self,$database,$table,$rulename,$where,
			     $relation_ref,$cache_output);
}


sub pg_get_indexes {
    my($X) = shift;
    my($self) = shift;
    my($ob_type) = shift;
    my($database) = shift;
    my($cache_output);
    # Indexes
    my($query) = "SELECT t.relname as \"tablename\",
				'User Table' as \"objecttype\",
				c.relname as \"indexname\", a.attname as \"fieldname\",
				i.indisunique, i.indisclustered
		FROM pg_class c, pg_class t, pg_index i, pg_attribute a
		WHERE a.attnum > 0 and a.attrelid=c.oid and t.oid=i.indrelid and
		c.oid=i.indexrelid'
		ORDER BY t.relname, attnum";
    my(@row);
    my($result);
    my($status);
    my($object, $object_type, $indexname, $fieldname, $isunique, $isclustered);
    my($last_index);
    my($last_object, $last_indexname);
    my(@fields);
    my($indexdescription);
    my(@indexdescription);
    my(@irow);
    my(@indexes);

    $result = $X->Sql($query);
    do {
	while(@row = $X->NextRow()) {
	    if ($X->Regular_Row()) {
		($object, $object_type, $indexname, $fieldname,
		 $isunique, $isclustered) = @row;
		if ($last_index ne "$object\t$object_type\t$indexname" &&
		    defined($last_index)) {
		    @irow = ($last_indexname, $indexdescription,
			     join(', ',@fields));
		    if (($ob_type eq 'User Table' && $object !~ '^pg_') ||
			($ob_type eq 'System Table' && $object =~ '^pg_')) {
			$self->add_index_row($last_object,$object_type,
					     @irow);
			$cache_output .= join("\t",('I',
						    $last_object,
						    $object_type,
						    @irow)) . "\n";
			push @indexes, join("\t",($irow[0], $irow[2],
						  $irow[1]));
			if (defined(@indexes)) {
			    $self->add_indexes($last_object,$object_type,
					       @indexes);
			}
			undef @indexes;
		    }
		    undef @fields;
		    if ($last_object ne $object && defined($last_object)) {
			$cache_output .= "\n";
		    }
		}
		$last_object = $object;
		$last_indexname = $indexname;
		undef @indexdescription;
		if ($isunique =~ /[Tt]/) {
		    push @indexdescription, ('unique');
		}
		if ($isclustered =~ /[Tt]/) {
		    push @indexdescription, ('clustered');
		}
		$indexdescription = join(', ',@indexdescription);
		$last_index = "$object\t$object_type\t$indexname";
		push @fields, ($fieldname);
	    }
	}
    } while ($X->More_Results());
    return $cache_output;
}



1;


__END__