diff options
Diffstat (limited to 'install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema.pm')
| -rw-r--r-- | install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema.pm | 367 |
1 files changed, 0 insertions, 367 deletions
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 deleted file mode 100644 index fc4916d..0000000 --- a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema.pm +++ /dev/null @@ -1,367 +0,0 @@ -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<DBIx::DBSchema::DBD>, "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('',<FILE>); #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<pretty_print> 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 <ivan-dbix-dbschema@420.am> - -Charles Shapiro <charles.shapiro@numethods.com> and Mitchell Friedman -<mitchell.friedman@numethods.com> 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<DBIx::DBSchema::Table>, L<DBIx::DBSchema::ColGroup>, -L<DBIx::DBSchema::ColGroup::Unique>, L<DBIx::DBSchema::ColGroup::Index>, -L<DBIx::DBSchema::Column>, L<DBIx::DBSchema::DBD>, -L<DBIx::DBSchema::DBD::mysql>, L<DBIx::DBSchema::DBD::Pg>, L<FS::Record>, -L<DBI> - -=cut - -1; - |