From ee146c3eada3bdb419ba471dd6df5e889d7dd7e5 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 29 Apr 2004 09:23:31 +0000 Subject: adding DBD::Pg and DBIx::DBSchema for 5.005. argh freebsd and solaris! --- .../DBIx-DBSchema-0.23-5.005kludge/DBSchema.pm | 367 +++++++++++++++++++++ 1 file changed, 367 insertions(+) create mode 100644 install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema.pm (limited to 'install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema.pm') diff --git a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema.pm b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema.pm new file mode 100644 index 000000000..fc4916df1 --- /dev/null +++ b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema.pm @@ -0,0 +1,367 @@ +package DBIx::DBSchema; + +use strict; +use vars qw(@ISA $VERSION); +#use Exporter; +use Carp qw(confess); +use DBI; +use FreezeThaw qw(freeze thaw cmpStr); +use DBIx::DBSchema::Table; +use DBIx::DBSchema::Column; +use DBIx::DBSchema::ColGroup::Unique; +use DBIx::DBSchema::ColGroup::Index; + +#@ISA = qw(Exporter); +@ISA = (); + +$VERSION = "0.23"; + +=head1 NAME + +DBIx::DBSchema - Database-independent schema objects + +=head1 SYNOPSIS + + use DBIx::DBSchema; + + $schema = new DBIx::DBSchema @dbix_dbschema_table_objects; + $schema = new_odbc DBIx::DBSchema $dbh; + $schema = new_odbc DBIx::DBSchema $dsn, $user, $pass; + $schema = new_native DBIx::DBSchema $dbh; + $schema = new_native DBIx::DBSchema $dsn, $user, $pass; + + $schema->save("filename"); + $schema = load DBIx::DBSchema "filename"; + + $schema->addtable($dbix_dbschema_table_object); + + @table_names = $schema->tables; + + $DBIx_DBSchema_table_object = $schema->table("table_name"); + + @sql = $schema->sql($dbh); + @sql = $schema->sql($dsn, $username, $password); + @sql = $schema->sql($dsn); #doesn't connect to database - less reliable + + $perl_code = $schema->pretty_print; + %hash = eval $perl_code; + use DBI qw(:sql_types); $schema = pretty_read DBIx::DBSchema \%hash; + +=head1 DESCRIPTION + +DBIx::DBSchema objects are collections of DBIx::DBSchema::Table objects and +represent a database schema. + +This module implements an OO-interface to database schemas. Using this module, +you can create a database schema with an OO Perl interface. You can read the +schema from an existing database. You can save the schema to disk and restore +it a different process. Most importantly, DBIx::DBSchema can write SQL +CREATE statements statements for different databases from a single source. + +Currently supported databases are MySQL and PostgreSQL. Sybase support is +partially implemented. DBIx::DBSchema will attempt to use generic SQL syntax +for other databases. Assistance adding support for other databases is +welcomed. See L, "Driver Writer's Guide and Base Class". + +=head1 METHODS + +=over 4 + +=item new TABLE_OBJECT, TABLE_OBJECT, ... + +Creates a new DBIx::DBSchema object. + +=cut + +sub new { + my($proto, @tables) = @_; + my %tables = map { $_->name, $_ } @tables; #check for duplicates? + + my $class = ref($proto) || $proto; + my $self = { + 'tables' => \%tables, + }; + + bless ($self, $class); + +} + +=item new_odbc DATABASE_HANDLE | DATA_SOURCE USERNAME PASSWORD [ ATTR ] + +Creates a new DBIx::DBSchema object from an existing data source, which can be +specified by passing an open DBI database handle, or by passing the DBI data +source name, username, and password. This uses the experimental DBI type_info +method to create a schema with standard (ODBC) SQL column types that most +closely correspond to any non-portable column types. Use this to import a +schema that you wish to use with many different database engines. Although +primary key and (unique) index information will only be read from databases +with DBIx::DBSchema::DBD drivers (currently MySQL and PostgreSQL), import of +column names and attributes *should* work for any database. Note that this +method only uses "ODBC" column types; it does not require or use an ODBC +driver. + +=cut + +sub new_odbc { + my($proto, $dbh) = (shift, shift); + $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr unless ref($dbh); + $proto->new( + map { new_odbc DBIx::DBSchema::Table $dbh, $_ } _tables_from_dbh($dbh) + ); +} + +=item new_native DATABASE_HANDLE | DATA_SOURCE USERNAME PASSWORD [ ATTR ] + +Creates a new DBIx::DBSchema object from an existing data source, which can be +specified by passing an open DBI database handle, or by passing the DBI data +source name, username and password. This uses database-native methods to read +the schema, and will preserve any non-portable column types. The method is +only available if there is a DBIx::DBSchema::DBD for the corresponding database engine (currently, MySQL and PostgreSQL). + +=cut + +sub new_native { + my($proto, $dbh) = (shift, shift); + $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr unless ref($dbh); + $proto->new( + map { new_native DBIx::DBSchema::Table ( $dbh, $_ ) } _tables_from_dbh($dbh) + ); +} + +=item load FILENAME + +Loads a DBIx::DBSchema object from a file. + +=cut + +sub load { + my($proto,$file)=@_; #use $proto ? + open(FILE,"<$file") or die "Can't open $file: $!"; + my($string)=join('',); #can $string have newlines? pry not? + close FILE or die "Can't close $file: $!"; + my($self)=thaw $string; + #no bless needed? + $self; +} + +=item save FILENAME + +Saves a DBIx::DBSchema object to a file. + +=cut + +sub save { + my($self,$file)=@_; + my($string)=freeze $self; + open(FILE,">$file") or die "Can't open $file: $!"; + print FILE $string; + close FILE or die "Can't close file: $!"; + my($check_self)=thaw $string; + die "Verify error: Can't freeze and thaw dbdef $self" + if (cmpStr($self,$check_self)); +} + +=item addtable TABLE_OBJECT + +Adds the given DBIx::DBSchema::Table object to this DBIx::DBSchema. + +=cut + +sub addtable { + my($self,$table)=@_; + $self->{'tables'}->{$table->name} = $table; #check for dupliates? +} + +=item tables + +Returns a list of the names of all tables. + +=cut + +sub tables { + my($self)=@_; + keys %{$self->{'tables'}}; +} + +=item table TABLENAME + +Returns the specified DBIx::DBSchema::Table object. + +=cut + +sub table { + my($self,$table)=@_; + $self->{'tables'}->{$table}; +} + +=item sql [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ] + +Returns a list of SQL `CREATE' statements for this schema. + +The data source can be specified by passing an open DBI database handle, or by +passing the DBI data source name, username and password. + +Although the username and password are optional, it is best to call this method +with a database handle or data source including a valid username and password - +a DBI connection will be opened and the quoting and type mapping will be more +reliable. + +If passed a DBI data source (or handle) such as `DBI:mysql:database' or +`DBI:Pg:dbname=database', will use syntax specific to that database engine. +Currently supported databases are MySQL and PostgreSQL. + +If not passed a data source (or handle), or if there is no driver for the +specified database, will attempt to use generic SQL syntax. + +=cut + +sub sql { + my($self, $dbh) = (shift, shift); + my $created_dbh = 0; + unless ( ref($dbh) || ! @_ ) { + $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr; + $created_dbh = 1; + } + my @r = map { $self->table($_)->sql_create_table($dbh); } $self->tables; + $dbh->disconnect if $created_dbh; + @r; +} + +=item pretty_print + +Returns the data in this schema as Perl source, suitable for assigning to a +hash. + +=cut + +sub pretty_print { + my($self) = @_; + join("},\n\n", + map { + my $table = $_; + "'$table' => {\n". + " 'columns' => [\n". + join("", map { + #cant because -w complains about , in qw() + # (also biiiig problems with empty lengths) + #" qw( $_ ". + #$self->table($table)->column($_)->type. " ". + #( $self->table($table)->column($_)->null ? 'NULL' : 0 ). " ". + #$self->table($table)->column($_)->length. " ),\n" + " '$_', ". + "'". $self->table($table)->column($_)->type. "', ". + "'". $self->table($table)->column($_)->null. "', ". + "'". $self->table($table)->column($_)->length. "', ". + "'". $self->table($table)->column($_)->default. "', ". + "'". $self->table($table)->column($_)->local. "',\n" + } $self->table($table)->columns + ). + " ],\n". + " 'primary_key' => '". $self->table($table)->primary_key. "',\n". + " 'unique' => [ ". join(', ', + map { "[ '". join("', '", @{$_}). "' ]" } + @{$self->table($table)->unique->lol_ref} + ). " ],\n". + " 'index' => [ ". join(', ', + map { "[ '". join("', '", @{$_}). "' ]" } + @{$self->table($table)->index->lol_ref} + ). " ],\n" + #" 'index' => [ ". " ],\n" + } $self->tables + ), "}\n"; +} + +=cut + +=item pretty_read HASHREF + +Creates a schema as specified by a data structure such as that created by +B method. + +=cut + +sub pretty_read { + my($proto, $href) = @_; + my $schema = $proto->new( map { + my(@columns); + while ( @{$href->{$_}{'columns'}} ) { + push @columns, DBIx::DBSchema::Column->new( + splice @{$href->{$_}{'columns'}}, 0, 6 + ); + } + DBIx::DBSchema::Table->new( + $_, + $href->{$_}{'primary_key'}, + DBIx::DBSchema::ColGroup::Unique->new($href->{$_}{'unique'}), + DBIx::DBSchema::ColGroup::Index->new($href->{$_}{'index'}), + @columns, + ); + } (keys %{$href}) ); +} + +# private subroutines + +sub _load_driver { + my($dbh) = @_; + my $driver; + if ( ref($dbh) ) { + $driver = $dbh->{Driver}->{Name}; + } else { + $dbh =~ s/^dbi:(\w*?)(?:\((.*?)\))?://i #nicked from DBI->connect + or '' =~ /()/; # ensure $1 etc are empty if match fails + $driver = $1 or confess "can't parse data source: $dbh"; + } + + #require "DBIx/DBSchema/DBD/$driver.pm"; + #$driver; + eval 'require "DBIx/DBSchema/DBD/$driver.pm"' and $driver or die $@; +} + +sub _tables_from_dbh { + my($dbh) = @_; + my $sth = $dbh->table_info or die $dbh->errstr; + #map { $_->{TABLE_NAME} } grep { $_->{TABLE_TYPE} eq 'TABLE' } + # @{ $sth->fetchall_arrayref({ TABLE_NAME=>1, TABLE_TYPE=>1}) }; + map { $_->[0] } grep { $_->[1] =~ /^TABLE$/i } + @{ $sth->fetchall_arrayref([2,3]) }; +} + +=back + +=head1 AUTHOR + +Ivan Kohler + +Charles Shapiro and Mitchell Friedman + contributed the start of a Sybase driver. + +=head1 COPYRIGHT + +Copyright (c) 2000 Ivan Kohler +Copyright (c) 2000 Mail Abuse Prevention System LLC +All rights reserved. +This program is free software; you can redistribute it and/or modify it under +the same terms as Perl itself. + +=head1 BUGS + +Each DBIx::DBSchema object should have a name which corresponds to its name +within the SQL database engine (DBI data source). + +pretty_print is actually pretty ugly. + +Perhaps pretty_read should eval column types so that we can use DBI +qw(:sql_types) here instead of externally. + +=head1 SEE ALSO + +L, L, +L, L, +L, L, +L, L, L, +L + +=cut + +1; + -- cgit v1.2.1