diff options
Diffstat (limited to 'install/5.005/DBIx-DBSchema-0.23-5.005kludge')
19 files changed, 2072 insertions, 0 deletions
diff --git a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/Changes b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/Changes new file mode 100644 index 0000000..f413bd9 --- /dev/null +++ b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/Changes @@ -0,0 +1,62 @@ +Revision history for Perl extension DBIx::DBSchema. + +0.23 Mon Feb 16 17:35:54 PST 2004 + - Update Pg dependancy to 1.32 + - Update the simple load test so it skips DBIx::DBSchema::DBD::Pg if + DBD::Pg 1.32 is not installed. + +0.22 Thu Oct 23 15:18:21 PDT 2003 + - Pg reverse-engineering fix: varchar with no limit + - Pg needs (unreleased) DBD::Pg 1.30 (or deb 1.22-2... interesting) + +0.21 Thu Sep 19 05:04:18 PDT 2002 + - Pg reverse-engineering fix: now sets default + +0.20 Mon Mar 4 04:58:34 2002 + - documentation updates + - fix Column->new when using named params + - fix Pg driver reverse-engineering length of numeric columns: + translate 655362 to 10,2, etc. + - fix Pg driver reverse-engineering of text columns (don't have a + length) + +0.19 Tue Oct 23 08:49:12 2001 + - documentation for %typemap + - preliminary Sybase driver from Charles Shapiro + <charles.shapiro@numethods.com> and Mitchell J. Friedman + <mitchell.friedman@numethods.com>. + - Fix Column::line to return a scalar as documented, not a list. + - Should finally eliminate the Use of uninitialized value at + ... DBIx/DBSchema/Column.pm line 251 + +0.18 Fri Aug 10 17:07:28 2001 + - Added Table::delcolumn + - patch from Charles Shapiro <cshapiro@numethods.com> to add + `ORDER BY a.attnum' to the SQL in DBIx::DBSchema::DBD::Pg::columns + +0.17 Sat Jul 7 17:55:33 2001 + - Rework Table->new interface for named params + - Fixes for Pg blobs, yay! + - MySQL doesn't need non-standard index syntax anymore (since 3.22). + - patch from Mark Ethan Trostler <mark@zzo.com> for generating + tables without indices. + +0.16 Fri Jan 5 15:55:50 2001 + - Don't overflow index names. + +0.15 Fri Nov 24 23:39:16 2000 + - MySQL handling of BOOL type (change to TINYINT) + +0.14 Tue Oct 24 14:43:16 2000 + - MySQL handling of SERIAL type (change to INTEGER AUTO_INCREMENT) + +0.13 Wed Oct 11 10:47:13 2000 + - fixed up type mapping foo, added default values, added named + parameters to Column->new, fixed quoting of default values + +0.11 Sun Sep 28 02:16:25 2000 + - oops, original verison got 0.10, so this one will get 0.11 + +0.01 Sun Sep 17 07:57:35 2000 + - original version; created by h2xs 1.19 + 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 0000000..fc4916d --- /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<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; + diff --git a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/ColGroup.pm b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/ColGroup.pm new file mode 100644 index 0000000..ceeb223 --- /dev/null +++ b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/ColGroup.pm @@ -0,0 +1,141 @@ +package DBIx::DBSchema::ColGroup; + +use strict; +use vars qw(@ISA); +#use Exporter; + +#@ISA = qw(Exporter); +@ISA = qw(); + +=head1 NAME + +DBIx::DBSchema::ColGroup - Column group objects + +=head1 SYNOPSIS + + use DBIx::DBSchema::ColGroup; + + $colgroup = new DBIx::DBSchema::ColGroup ( $lol_ref ); + $colgroup = new DBIx::DBSchema::ColGroup ( \@lol ); + $colgroup = new DBIx::DBSchema::ColGroup ( + [ + [ 'single_column' ], + [ 'multiple_columns', 'another_column', ], + ] + ); + + $lol_ref = $colgroup->lol_ref; + + @sql_lists = $colgroup->sql_list; + + @singles = $colgroup->singles; + +=head1 DESCRIPTION + +DBIx::DBSchema::ColGroup objects represent sets of sets of columns. (IOW a +"list of lists" - see L<perllol>.) + +=head1 METHODS + +=over 4 + +=item new [ LOL_REF ] + +Creates a new DBIx::DBSchema::ColGroup object. Pass a reference to a list of +lists of column names. + +=cut + +sub new { + my($proto, $lol) = @_; + + my $class = ref($proto) || $proto; + my $self = { + 'lol' => $lol, + }; + + bless ($self, $class); + +} + +=item lol_ref + +Returns a reference to a list of lists of column names. + +=cut + +sub lol_ref { + my($self) = @_; + $self->{'lol'}; +} + +=item sql_list + +Returns a flat list of comma-separated values, for SQL statements. + +For example: + + @lol = ( + [ 'single_column' ], + [ 'multiple_columns', 'another_column', ], + ); + + $colgroup = new DBIx::DBSchema::ColGroup ( \@lol ); + + print join("\n", $colgroup->sql_list), "\n"; + +Will print: + + single_column + multiple_columns, another_column + +=cut + +sub sql_list { #returns a flat list of comman-separates lists (for sql) + my($self)=@_; + grep $_ ne '', map join(', ', @{$_}), @{$self->{'lol'}}; +} + +=item singles + +Returns a flat list of all single item lists. + +=cut + +sub singles { #returns single-field groups as a flat list + my($self)=@_; + #map ${$_}[0], grep scalar(@{$_}) == 1, @{$self->{'lol'}}; + map { + ${$_}[0] =~ /^(\w+)$/ + #aah! + or die "Illegal column ", ${$_}[0], " in colgroup!"; + $1; + } grep scalar(@{$_}) == 1, @{$self->{'lol'}}; +} + +=back + +=head1 AUTHOR + +Ivan Kohler <ivan-dbix-dbschema@420.am> + +=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 + +=head1 SEE ALSO + +L<DBIx::DBSchema::Table>, L<DBIx::DBSchema::ColGroup::Unique>, +L<DBIx::DBSchema::ColGroup::Index>, L<DBIx::DBSchema>, L<perllol>, L<perldsc>, +L<DBI> + +=cut + +1; + diff --git a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/ColGroup/Index.pm b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/ColGroup/Index.pm new file mode 100644 index 0000000..1a92baa --- /dev/null +++ b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/ColGroup/Index.pm @@ -0,0 +1,37 @@ +package DBIx::DBSchema::ColGroup::Index; + +use strict; +use vars qw(@ISA); +use DBIx::DBSchema::ColGroup; + +@ISA=qw(DBIx::DBSchema::ColGroup); + +=head1 NAME + +DBIx::DBSchema::ColGroup::Index - Index column group object + +=head1 SYNOPSIS + + use DBIx::DBSchema::ColGroup::Index; + + # see DBIx::DBSchema::ColGroup methods + +=head1 DESCRIPTION + +DBIx::DBSchema::ColGroup::Index objects represent the (non-unique) indices of a +database table (L<DBIx::DBSchema::Table>). DBIx::DBSchema::ColGroup::Index +inherits from DBIx::DBSchema::ColGroup. + +=head1 BUGS + +Is this empty subclass needed? + +=head1 SEE ALSO + +L<DBIx::DBSchema::ColGroup>, L<DBIx::DBSchema::ColGroup::Unique>, +L<DBIx::DBSchema::Table>, L<DBIx::DBSchema>, L<FS::Record> + +=cut + +1; + diff --git a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/ColGroup/Unique.pm b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/ColGroup/Unique.pm new file mode 100644 index 0000000..450043f --- /dev/null +++ b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/ColGroup/Unique.pm @@ -0,0 +1,38 @@ +package DBIx::DBSchema::ColGroup::Unique; + +use strict; +use vars qw(@ISA); +use DBIx::DBSchema::ColGroup; + +@ISA=qw(DBIx::DBSchema::ColGroup); + +=head1 NAME + +DBIx::DBSchema::ColGroup::Unique - Unique column group object + +=head1 SYNOPSIS + + use DBIx::DBSchema::ColGroup::Unique; + + # see DBIx::DBSchema::ColGroup methods + +=head1 DESCRIPTION + +DBIx::DBSchema::ColGroup::Unique objects represent the unique indices of a +database table (L<DBIx::DBSchema::Table>). DBIx::DBSchema::ColGroup:Unique +inherits from DBIx::DBSchema::ColGroup. + +=head1 BUGS + +Is this empty subclass needed? + +=head1 SEE ALSO + +L<DBIx::DBSchema::ColGroup>, L<DBIx::DBSchema::ColGroup::Index>, +L<DBIx::DBSchema::Table>, L<DBIx::DBSchema>, L<FS::Record> + +=cut + +1; + + diff --git a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/Column.pm b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/Column.pm new file mode 100644 index 0000000..4e26646 --- /dev/null +++ b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/Column.pm @@ -0,0 +1,300 @@ +package DBIx::DBSchema::Column; + +use strict; +use vars qw(@ISA $VERSION); +#use Carp; +#use Exporter; + +#@ISA = qw(Exporter); +@ISA = qw(); + +$VERSION = '0.02'; + +=head1 NAME + +DBIx::DBSchema::Column - Column objects + +=head1 SYNOPSIS + + use DBIx::DBSchema::Column; + + #named params with a hashref (preferred) + $column = new DBIx::DBSchema::Column ( { + 'name' => 'column_name', + 'type' => 'varchar' + 'null' => 'NOT NULL', + 'length' => 64, + 'default' => ' + 'local' => '', + } ); + + #list + $column = new DBIx::DBSchema::Column ( $name, $sql_type, $nullability, $length, $default, $local ); + + $name = $column->name; + $column->name( 'name' ); + + $sql_type = $column->type; + $column->type( 'sql_type' ); + + $null = $column->null; + $column->null( 'NULL' ); + $column->null( 'NOT NULL' ); + $column->null( '' ); + + $length = $column->length; + $column->length( '10' ); + $column->length( '8,2' ); + + $default = $column->default; + $column->default( 'Roo' ); + + $sql_line = $column->line; + $sql_line = $column->line($datasrc); + +=head1 DESCRIPTION + +DBIx::DBSchema::Column objects represent columns in tables (see +L<DBIx::DBSchema::Table>). + +=head1 METHODS + +=over 4 + +=item new HASHREF + +=item new [ name [ , type [ , null [ , length [ , default [ , local ] ] ] ] ] ] + +Creates a new DBIx::DBSchema::Column object. Takes a hashref of named +parameters, or a list. B<name> is the name of the column. B<type> is the SQL +data type. B<null> is the nullability of the column (intrepreted using Perl's +rules for truth, with one exception: `NOT NULL' is false). B<length> is the +SQL length of the column. B<default> is the default value of the column. +B<local> is reserved for database-specific information. + +=cut + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + + my $self; + if ( ref($_[0]) ) { + $self = shift; + } else { + $self = { map { $_ => shift } qw(name type null length default local) }; + } + + #croak "Illegal name: ". $self->{'name'} + # if grep $self->{'name'} eq $_, @reserved_words; + + $self->{'null'} =~ s/^NOT NULL$//i; + $self->{'null'} = 'NULL' if $self->{'null'}; + + bless ($self, $class); + +} + +=item name [ NAME ] + +Returns or sets the column name. + +=cut + +sub name { + my($self,$value)=@_; + if ( defined($value) ) { + #croak "Illegal name: $name" if grep $name eq $_, @reserved_words; + $self->{'name'} = $value; + } else { + $self->{'name'}; + } +} + +=item type [ TYPE ] + +Returns or sets the column type. + +=cut + +sub type { + my($self,$value)=@_; + if ( defined($value) ) { + $self->{'type'} = $value; + } else { + $self->{'type'}; + } +} + +=item null [ NULL ] + +Returns or sets the column null flag (the empty string is equivalent to +`NOT NULL') + +=cut + +sub null { + my($self,$value)=@_; + if ( defined($value) ) { + $value =~ s/^NOT NULL$//i; + $value = 'NULL' if $value; + $self->{'null'} = $value; + } else { + $self->{'null'}; + } +} + +=item length [ LENGTH ] + +Returns or sets the column length. + +=cut + +sub length { + my($self,$value)=@_; + if ( defined($value) ) { + $self->{'length'} = $value; + } else { + $self->{'length'}; + } +} + +=item default [ LOCAL ] + +Returns or sets the default value. + +=cut + +sub default { + my($self,$value)=@_; + if ( defined($value) ) { + $self->{'default'} = $value; + } else { + $self->{'default'}; + } +} + + +=item local [ LOCAL ] + +Returns or sets the database-specific field. + +=cut + +sub local { + my($self,$value)=@_; + if ( defined($value) ) { + $self->{'local'} = $value; + } else { + $self->{'local'}; + } +} + +=item line [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ] + +Returns an SQL column definition. + +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. Non-standard syntax +for other engines (if applicable) may also be supported in the future. + +=cut + +sub line { + my($self,$dbh) = (shift, shift); + + my $created_dbh = 0; + unless ( ref($dbh) || ! @_ ) { + $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr; + my $gratuitous = $DBI::errstr; #surpress superfluous `used only once' error + $created_dbh = 1; + } + + my $driver = DBIx::DBSchema::_load_driver($dbh); + my %typemap; + %typemap = eval "\%DBIx::DBSchema::DBD::${driver}::typemap" if $driver; + my $type = defined( $typemap{uc($self->type)} ) + ? $typemap{uc($self->type)} + : $self->type; + + my $null = $self->null; + + my $default; + if ( defined($self->default) && $self->default ne '' + && ref($dbh) + # false laziness: nicked from FS::Record::_quote + && ( $self->default !~ /^\-?\d+(\.\d+)?$/ + || $type =~ /(char|binary|blob|text)$/i + ) + ) { + $default = $dbh->quote($self->default); + } else { + $default = $self->default; + } + + #this should be a callback into the driver + if ( $driver eq 'mysql' ) { #yucky mysql hack + $null ||= "NOT NULL"; + $self->local('AUTO_INCREMENT') if uc($self->type) eq 'SERIAL'; + } elsif ( $driver eq 'Pg' ) { #yucky Pg hack + $null ||= "NOT NULL"; + $null =~ s/^NULL$//; + } + + my $r = join(' ', + $self->name, + $type. ( ( defined($self->length) && $self->length ) + ? '('.$self->length.')' + : '' + ), + $null, + ( ( defined($default) && $default ne '' ) + ? 'DEFAULT '. $default + : '' + ), + ( ( $driver eq 'mysql' && defined($self->local) ) + ? $self->local + : '' + ), + ); + $dbh->disconnect if $created_dbh; + $r; + +} + +=back + +=head1 AUTHOR + +Ivan Kohler <ivan-dbix-dbschema@420.am> + +=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 + +line() has database-specific foo that probably ought to be abstracted into +the DBIx::DBSchema:DBD:: modules. + +=head1 SEE ALSO + +L<DBIx::DBSchema::Table>, L<DBIx::DBSchema>, L<DBIx::DBSchema::DBD>, L<DBI> + +=cut + +1; + diff --git a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/DBD.pm b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/DBD.pm new file mode 100644 index 0000000..a4c6000 --- /dev/null +++ b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/DBD.pm @@ -0,0 +1,113 @@ +package DBIx::DBSchema::DBD; + +use strict; +use vars qw($VERSION); + +$VERSION = '0.02'; + +=head1 NAME + +DBIx::DBSchema::DBD - DBIx::DBSchema Driver Writer's Guide and Base Class + +=head1 SYNOPSIS + + perldoc DBIx::DBSchema::DBD + + package DBIx::DBSchema::DBD::FooBase + use DBIx::DBSchmea::DBD; + @ISA = qw(DBIx::DBSchema::DBD); + +=head1 DESCRIPTION + +Drivers should be named DBIx::DBSchema::DBD::DatabaseName, where DatabaseName +is the same as the DBD:: driver for this database. Drivers should implement the +following class methods: + +=over 4 + +=item columns CLASS DBI_DBH TABLE + +Given an active DBI database handle, return a listref of listrefs (see +L<perllol>), each containing six elements: column name, column type, +nullability, column length, column default, and a field reserved for +driver-specific use. + +=item column CLASS DBI_DBH TABLE COLUMN + +Same as B<columns> above, except return the listref for a single column. You +can inherit from DBIx::DBSchema::DBD to provide this function. + +=cut + +sub column { + my($proto, $dbh, $table, $column) = @_; + #@a = grep { $_->[0] eq $column } @{ $proto->columns( $dbh, $table ) }; + #$a[0]; + @{ [ + grep { $_->[0] eq $column } @{ $proto->columns( $dbh, $table ) } + ] }[0]; #force list context on grep, return scalar of first element +} + +=item primary_key CLASS DBI_DBH TABLE + +Given an active DBI database handle, return the primary key for the specified +table. + +=item unique CLASS DBI_DBH TABLE + +Given an active DBI database handle, return a hashref of unique indices. The +keys of the hashref are index names, and the values are arrayrefs which point +a list of column names for each. See L<perldsc/"HASHES OF LISTS"> and +L<DBIx::DBSchema::ColGroup>. + +=item index CLASS DBI_DBH TABLE + +Given an active DBI database handle, return a hashref of (non-unique) indices. +The keys of the hashref are index names, and the values are arrayrefs which +point a list of column names for each. See L<perldsc/"HASHES OF LISTS"> and +L<DBIx::DBSchema::ColGroup>. + +=back + +=head1 TYPE MAPPING + +You can define a %typemap array for your driver to map "standard" data +types to database-specific types. For example, the MySQL TIMESTAMP field +has non-standard auto-updating semantics; the MySQL DATETIME type is +what other databases and the ODBC standard call TIMESTAMP, so one of the +entries in the MySQL %typemap is: + + 'TIMESTAMP' => 'DATETIME', + +Another example is the Pg %typemap which maps the standard types BLOB and +LONG VARBINARY to the Pg-specific BYTEA: + + 'BLOB' => 'BYTEA', + 'LONG VARBINARY' => 'BYTEA', + +Make sure you use all uppercase-keys. + +=head1 AUTHOR + +Ivan Kohler <ivan-dbix-dbschema@420.am> + +=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 + +=head1 SEE ALSO + +L<DBIx::DBSchema>, L<DBIx::DBSchema::DBD::mysql>, L<DBIx::DBSchema::DBD::Pg>, +L<DBIx::DBSchema::ColGroup>, L<DBI>, L<DBI::DBD>, L<perllol>, +L<perldsc/"HASHES OF LISTS"> + +=cut + +1; + diff --git a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/DBD/Pg.pm b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/DBD/Pg.pm new file mode 100644 index 0000000..018b890 --- /dev/null +++ b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/DBD/Pg.pm @@ -0,0 +1,175 @@ +package DBIx::DBSchema::DBD::Pg; + +use strict; +use vars qw($VERSION @ISA %typemap); +use DBD::Pg 1.22; +use DBIx::DBSchema::DBD; + +$VERSION = '0.08'; +@ISA = qw(DBIx::DBSchema::DBD); + +%typemap = ( + 'BLOB' => 'BYTEA', + 'LONG VARBINARY' => 'BYTEA', +); + +=head1 NAME + +DBIx::DBSchema::DBD::Pg - PostgreSQL native driver for DBIx::DBSchema + +=head1 SYNOPSIS + +use DBI; +use DBIx::DBSchema; + +$dbh = DBI->connect('dbi:Pg:dbname=database', 'user', 'pass'); +$schema = new_native DBIx::DBSchema $dbh; + +=head1 DESCRIPTION + +This module implements a PostgreSQL-native driver for DBIx::DBSchema. + +=cut + +sub columns { + my($proto, $dbh, $table) = @_; + my $sth = $dbh->prepare(<<END) or die $dbh->errstr; + SELECT a.attname, t.typname, a.attlen, a.atttypmod, a.attnotnull, + a.atthasdef, a.attnum + FROM pg_class c, pg_attribute a, pg_type t + WHERE c.relname = '$table' + AND a.attnum > 0 AND a.attrelid = c.oid AND a.atttypid = t.oid + ORDER BY a.attnum +END + $sth->execute or die $sth->errstr; + + map { + + my $default = ''; + if ( $_->{atthasdef} ) { + my $attnum = $_->{attnum}; + my $d_sth = $dbh->prepare(<<END) or die $dbh->errstr; + SELECT substring(d.adsrc for 128) FROM pg_attrdef d, pg_class c + WHERE c.relname = '$table' AND c.oid = d.adrelid AND d.adnum = $attnum +END + $d_sth->execute or die $d_sth->errstr; + + $default = $d_sth->fetchrow_arrayref->[0]; + }; + + my $len = ''; + if ( $_->{attlen} == -1 && $_->{atttypmod} != -1 + && $_->{typname} ne 'text' ) { + $len = $_->{atttypmod} - 4; + if ( $_->{typname} eq 'numeric' ) { + $len = ($len >> 16). ','. ($len & 0xffff); + } + } + + my $type = $_->{'typname'}; + $type = 'char' if $type eq 'bpchar'; + + [ + $_->{'attname'}, + $type, + ! $_->{'attnotnull'}, + $len, + $default, + '' #local + ]; + + } @{ $sth->fetchall_arrayref({}) }; +} + +sub primary_key { + my($proto, $dbh, $table) = @_; + my $sth = $dbh->prepare(<<END) or die $dbh->errstr; + SELECT a.attname, a.attnum + FROM pg_class c, pg_attribute a, pg_type t + WHERE c.relname = '${table}_pkey' + AND a.attnum > 0 AND a.attrelid = c.oid AND a.atttypid = t.oid +END + $sth->execute or die $sth->errstr; + my $row = $sth->fetchrow_hashref or return ''; + $row->{'attname'}; +} + +sub unique { + my($proto, $dbh, $table) = @_; + my $gratuitous = { map { $_ => [ $proto->_index_fields($dbh, $_ ) ] } + grep { $proto->_is_unique($dbh, $_ ) } + $proto->_all_indices($dbh, $table) + }; +} + +sub index { + my($proto, $dbh, $table) = @_; + my $gratuitous = { map { $_ => [ $proto->_index_fields($dbh, $_ ) ] } + grep { ! $proto->_is_unique($dbh, $_ ) } + $proto->_all_indices($dbh, $table) + }; +} + +sub _all_indices { + my($proto, $dbh, $table) = @_; + my $sth = $dbh->prepare(<<END) or die $dbh->errstr; + SELECT c2.relname + FROM pg_class c, pg_class c2, pg_index i + WHERE c.relname = '$table' AND c.oid = i.indrelid AND i.indexrelid = c2.oid +END + $sth->execute or die $sth->errstr; + map { $_->{'relname'} } + grep { $_->{'relname'} !~ /_pkey$/ } + @{ $sth->fetchall_arrayref({}) }; +} + +sub _index_fields { + my($proto, $dbh, $index) = @_; + my $sth = $dbh->prepare(<<END) or die $dbh->errstr; + SELECT a.attname, a.attnum + FROM pg_class c, pg_attribute a, pg_type t + WHERE c.relname = '$index' + AND a.attnum > 0 AND a.attrelid = c.oid AND a.atttypid = t.oid +END + $sth->execute or die $sth->errstr; + map { $_->{'attname'} } @{ $sth->fetchall_arrayref({}) }; +} + +sub _is_unique { + my($proto, $dbh, $index) = @_; + my $sth = $dbh->prepare(<<END) or die $dbh->errstr; + SELECT i.indisunique + FROM pg_index i, pg_class c, pg_am a + WHERE i.indexrelid = c.oid AND c.relname = '$index' AND c.relam = a.oid +END + $sth->execute or die $sth->errstr; + my $row = $sth->fetchrow_hashref or die 'guru meditation #420'; + $row->{'indisunique'}; +} + +=head1 AUTHOR + +Ivan Kohler <ivan-dbix-dbschema@420.am> + +=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 + +Yes. + +columns doesn't return column default information. + +=head1 SEE ALSO + +L<DBIx::DBSchema>, L<DBIx::DBSchema::DBD>, L<DBI>, L<DBI::DBD> + +=cut + +1; + diff --git a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/DBD/Sybase.pm b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/DBD/Sybase.pm new file mode 100755 index 0000000..4a74069 --- /dev/null +++ b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/DBD/Sybase.pm @@ -0,0 +1,141 @@ +package DBIx::DBSchema::DBD::Sybase; + +use strict; +use vars qw($VERSION @ISA %typemap); +use DBIx::DBSchema::DBD; + +$VERSION = '0.03'; +@ISA = qw(DBIx::DBSchema::DBD); + +%typemap = ( +# 'empty' => 'empty' +); + +=head1 NAME + +DBIx::DBSchema::DBD::Sybase - Sybase database driver for DBIx::DBSchema + +=head1 SYNOPSIS + +use DBI; +use DBIx::DBSchema; + +$dbh = DBI->connect('dbi:Sybase:dbname=database', 'user', 'pass'); +$schema = new_native DBIx::DBSchema $dbh; + +=head1 DESCRIPTION + +This module implements a Sybase driver for DBIx::DBSchema. + +=cut + +sub columns { + my($proto, $dbh, $table) = @_; + + my $sth = $dbh->prepare("sp_columns \@table_name=$table") + or die $dbh->errstr; + + $sth->execute or die $sth->errstr; + my @cols = map { + [ + $_->{'column_name'}, + $_->{'type_name'}, + ($_->{'nullable'} ? 1 : ''), + $_->{'length'}, + '', #default + '' #local + ] + } @{ $sth->fetchall_arrayref({}) }; + $sth->finish; + + @cols; +} + +sub primary_key { + return("StubbedPrimaryKey"); +} + + +sub unique { + my($proto, $dbh, $table) = @_; + my $gratuitous = { map { $_ => [ $proto->_index_fields($dbh, $table, $_ ) ] } + grep { $proto->_is_unique($dbh, $_ ) } + $proto->_all_indices($dbh, $table) + }; +} + +sub index { + my($proto, $dbh, $table) = @_; + my $gratuitous = { map { $_ => [ $proto->_index_fields($dbh, $table, $_ ) ] } + grep { ! $proto->_is_unique($dbh, $_ ) } + $proto->_all_indices($dbh, $table) + }; +} + +sub _all_indices { + my($proto, $dbh, $table) = @_; + + my $sth = $dbh->prepare_cached(<<END) or die $dbh->errstr; + SELECT name + FROM sysindexes + WHERE id = object_id('$table') and indid between 1 and 254 +END + $sth->execute or die $sth->errstr; + my @indices = map { $_->[0] } @{ $sth->fetchall_arrayref() }; + $sth->finish; + $sth = undef; + @indices; +} + +sub _index_fields { + my($proto, $dbh, $table, $index) = @_; + + my @keys; + + my ($indid) = $dbh->selectrow_array("select indid from sysindexes where id = object_id('$table') and name = '$index'"); + for (1..30) { + push @keys, $dbh->selectrow_array("select index_col('$table', $indid, $_)") || (); + } + + return @keys; +} + +sub _is_unique { + my($proto, $dbh, $table, $index) = @_; + + my ($isunique) = $dbh->selectrow_array("select status & 2 from sysindexes where id = object_id('$table') and name = '$index'"); + + return $isunique; +} + +=head1 AUTHOR + +Charles Shapiro <charles.shapiro@numethods.com> +(courtesy of Ivan Kohler <ivan-dbix-dbschema@420.am>) + +Mitchell Friedman <mitchell.friedman@numethods.com> + +Bernd Dulfer <bernd@widd.de> + +=head1 COPYRIGHT + +Copyright (c) 2001 Charles Shapiro, Mitchell J. Friedman +Copyright (c) 2001 nuMethods 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 + +Yes. + +The B<primary_key> method does not yet work. + +=head1 SEE ALSO + +L<DBIx::DBSchema>, L<DBIx::DBSchema::DBD>, L<DBI>, L<DBI::DBD> + +=cut + +1; + diff --git a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/DBD/mysql.pm b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/DBD/mysql.pm new file mode 100644 index 0000000..f3804dd --- /dev/null +++ b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/DBD/mysql.pm @@ -0,0 +1,126 @@ +package DBIx::DBSchema::DBD::mysql; + +use strict; +use vars qw($VERSION @ISA %typemap); +use DBIx::DBSchema::DBD; + +$VERSION = '0.03'; +@ISA = qw(DBIx::DBSchema::DBD); + +%typemap = ( + 'TIMESTAMP' => 'DATETIME', + 'SERIAL' => 'INTEGER', + 'BOOL' => 'TINYINT', + 'LONG VARBINARY' => 'LONGBLOB', +); + +=head1 NAME + +DBIx::DBSchema::DBD::mysql - MySQL native driver for DBIx::DBSchema + +=head1 SYNOPSIS + +use DBI; +use DBIx::DBSchema; + +$dbh = DBI->connect('dbi:mysql:database', 'user', 'pass'); +$schema = new_native DBIx::DBSchema $dbh; + +=head1 DESCRIPTION + +This module implements a MySQL-native driver for DBIx::DBSchema. + +=cut + +sub columns { + my($proto, $dbh, $table ) = @_; + my $sth = $dbh->prepare("SHOW COLUMNS FROM $table") or die $dbh->errstr; + $sth->execute or die $sth->errstr; + map { + $_->{'Type'} =~ /^(\w+)\(?([\d\,]+)?\)?( unsigned)?$/ + or die "Illegal type: ". $_->{'Type'}. "\n"; + my($type, $length) = ($1, $2); + [ + $_->{'Field'}, + $type, + $_->{'Null'}, + $length, + $_->{'Default'}, + $_->{'Extra'} + ] + } @{ $sth->fetchall_arrayref( {} ) }; +} + +#sub primary_key { +# my($proto, $dbh, $table ) = @_; +# my $primary_key = ''; +# my $sth = $dbh->prepare("SHOW INDEX FROM $table") +# or die $dbh->errstr; +# $sth->execute or die $sth->errstr; +# my @pkey = map { $_->{'Column_name'} } grep { +# $_->{'Key_name'} eq "PRIMARY" +# } @{ $sth->fetchall_arrayref( {} ) }; +# scalar(@pkey) ? $pkey[0] : ''; +#} + +sub primary_key { + my($proto, $dbh, $table) = @_; + my($pkey, $unique_href, $index_href) = $proto->_show_index($dbh, $table); + $pkey; +} + +sub unique { + my($proto, $dbh, $table) = @_; + my($pkey, $unique_href, $index_href) = $proto->_show_index($dbh, $table); + $unique_href; +} + +sub index { + my($proto, $dbh, $table) = @_; + my($pkey, $unique_href, $index_href) = $proto->_show_index($dbh, $table); + $index_href; +} + +sub _show_index { + my($proto, $dbh, $table ) = @_; + my $sth = $dbh->prepare("SHOW INDEX FROM $table") + or die $dbh->errstr; + $sth->execute or die $sth->errstr; + + my $pkey = ''; + my(%index, %unique); + foreach my $row ( @{ $sth->fetchall_arrayref({}) } ) { + if ( $row->{'Key_name'} eq 'PRIMARY' ) { + $pkey = $row->{'Column_name'}; + } elsif ( $row->{'Non_unique'} ) { #index + push @{ $index{ $row->{'Key_name'} } }, $row->{'Column_name'}; + } else { #unique + push @{ $unique{ $row->{'Key_name'} } }, $row->{'Column_name'}; + } + } + + ( $pkey, \%unique, \%index ); +} + +=head1 AUTHOR + +Ivan Kohler <ivan-dbix-dbschema@420.am> + +=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 + +=head1 SEE ALSO + +L<DBIx::DBSchema>, L<DBIx::DBSchema::DBD>, L<DBI>, L<DBI::DBD> + +=cut + +1; + diff --git a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/Table.pm b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/Table.pm new file mode 100644 index 0000000..2d6272e --- /dev/null +++ b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/Table.pm @@ -0,0 +1,471 @@ +package DBIx::DBSchema::Table; + +use strict; +use vars qw(@ISA %create_params); +#use Carp; +#use Exporter; +use DBIx::DBSchema::Column 0.02; +use DBIx::DBSchema::ColGroup::Unique; +use DBIx::DBSchema::ColGroup::Index; + +#@ISA = qw(Exporter); +@ISA = qw(); + +=head1 NAME + +DBIx::DBSchema::Table - Table objects + +=head1 SYNOPSIS + + use DBIx::DBSchema::Table; + + #old style (depriciated) + $table = new DBIx::DBSchema::Table ( + "table_name", + "primary_key", + $dbix_dbschema_colgroup_unique_object, + $dbix_dbschema_colgroup_index_object, + @dbix_dbschema_column_objects, + ); + + #new style (preferred), pass a hashref of parameters + $table = new DBIx::DBSchema::Table ( + { + name => "table_name", + primary_key => "primary_key", + unique => $dbix_dbschema_colgroup_unique_object, + 'index' => $dbix_dbschema_colgroup_index_object, + columns => \@dbix_dbschema_column_objects, + } + ); + + $table->addcolumn ( $dbix_dbschema_column_object ); + + $table_name = $table->name; + $table->name("table_name"); + + $primary_key = $table->primary_key; + $table->primary_key("primary_key"); + + $dbix_dbschema_colgroup_unique_object = $table->unique; + $table->unique( $dbix_dbschema__colgroup_unique_object ); + + $dbix_dbschema_colgroup_index_object = $table->index; + $table->index( $dbix_dbschema_colgroup_index_object ); + + @column_names = $table->columns; + + $dbix_dbschema_column_object = $table->column("column"); + + #preferred + @sql_statements = $table->sql_create_table( $dbh ); + @sql_statements = $table->sql_create_table( $datasrc, $username, $password ); + + #possible problems + @sql_statements = $table->sql_create_table( $datasrc ); + @sql_statements = $table->sql_create_table; + +=head1 DESCRIPTION + +DBIx::DBSchema::Table objects represent a single database table. + +=head1 METHODS + +=over 4 + +=item new [ TABLE_NAME [ , PRIMARY_KEY [ , UNIQUE [ , INDEX [ , COLUMN... ] ] ] ] ] + +=item new HASHREF + +Creates a new DBIx::DBSchema::Table object. The preferred usage is to pass a +hash reference of named parameters. + + { + name => TABLE_NAME, + primary_key => PRIMARY_KEY, + unique => UNIQUE, + 'index' => INDEX, + columns => COLUMNS + } + +TABLE_NAME is the name of the table. PRIMARY_KEY is the primary key (may be +empty). UNIQUE is a DBIx::DBSchema::ColGroup::Unique object (see +L<DBIx::DBSchema::ColGroup::Unique>). INDEX is a +DBIx::DBSchema::ColGroup::Index object (see +L<DBIx::DBSchema::ColGroup::Index>). COLUMNS is a reference to an array of +DBIx::DBSchema::Column objects (see L<DBIx::DBSchema::Column>). + +=cut + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + + my $self; + if ( ref($_[0]) ) { + + $self = shift; + $self->{column_order} = [ map { $_->name } @{$self->{columns}} ]; + $self->{columns} = { map { $_->name, $_ } @{$self->{columns}} }; + + } else { + + my($name,$primary_key,$unique,$index,@columns) = @_; + + my %columns = map { $_->name, $_ } @columns; + my @column_order = map { $_->name } @columns; + + $self = { + 'name' => $name, + 'primary_key' => $primary_key, + 'unique' => $unique, + 'index' => $index, + 'columns' => \%columns, + 'column_order' => \@column_order, + }; + + } + + #check $primary_key, $unique and $index to make sure they are $columns ? + # (and sanity check?) + + bless ($self, $class); + +} + +=item new_odbc DATABASE_HANDLE TABLE_NAME + +Creates a new DBIx::DBSchema::Table object from the supplied DBI database +handle for the specified table. This uses the experimental DBI type_info +method to create a table 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 imported from databases +with DBIx::DBSchema::DBD drivers (currently MySQL and PostgreSQL), import of +column names and attributes *should* work for any database. + +Note: the _odbc refers to the column types used and nothing else - you do not +have to have ODBC installed or connect to the database via ODBC. + +=cut + +%create_params = ( +# undef => sub { '' }, + '' => sub { '' }, + 'max length' => sub { $_[0]->{PRECISION}->[$_[1]]; }, + 'precision,scale' => + sub { $_[0]->{PRECISION}->[$_[1]]. ','. $_[0]->{SCALE}->[$_[1]]; } +); + +sub new_odbc { + my( $proto, $dbh, $name) = @_; + my $driver = DBIx::DBSchema::_load_driver($dbh); + my $sth = _null_sth($dbh, $name); + my $sthpos = 0; + $proto->new ( + $name, + scalar(eval "DBIx::DBSchema::DBD::$driver->primary_key(\$dbh, \$name)"), + DBIx::DBSchema::ColGroup::Unique->new( + $driver + ? [values %{eval "DBIx::DBSchema::DBD::$driver->unique(\$dbh, \$name)"}] + : [] + ), + DBIx::DBSchema::ColGroup::Index->new( + $driver + ? [ values %{eval "DBIx::DBSchema::DBD::$driver->index(\$dbh, \$name)"} ] + : [] + ), + map { + my $type_info = scalar($dbh->type_info($sth->{TYPE}->[$sthpos])) + or die "DBI::type_info ". $dbh->{Driver}->{Name}. " driver ". + "returned no results for type ". $sth->{TYPE}->[$sthpos]; + new DBIx::DBSchema::Column + $_, + $type_info->{'TYPE_NAME'}, + #"SQL_". uc($type_info->{'TYPE_NAME'}), + $sth->{NULLABLE}->[$sthpos], + &{ $create_params{ $type_info->{CREATE_PARAMS} } }( $sth, $sthpos++ ), $driver && #default + ${ [ + eval "DBIx::DBSchema::DBD::$driver->column(\$dbh, \$name, \$_)" + ] }[4] + # DB-local + } @{$sth->{NAME}} + ); +} + +=item new_native DATABASE_HANDLE TABLE_NAME + +Creates a new DBIx::DBSchema::Table object from the supplied DBI database +handle for the specified table. 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, $name) = @_; + my $driver = DBIx::DBSchema::_load_driver($dbh); + $proto->new ( + $name, + scalar(eval "DBIx::DBSchema::DBD::$driver->primary_key(\$dbh, \$name)"), + DBIx::DBSchema::ColGroup::Unique->new( + [ values %{eval "DBIx::DBSchema::DBD::$driver->unique(\$dbh, \$name)"} ] + ), + DBIx::DBSchema::ColGroup::Index->new( + [ values %{eval "DBIx::DBSchema::DBD::$driver->index(\$dbh, \$name)"} ] + ), + map { + DBIx::DBSchema::Column->new( @{$_} ) + } eval "DBIx::DBSchema::DBD::$driver->columns(\$dbh, \$name)" + ); +} + +=item addcolumn COLUMN + +Adds this DBIx::DBSchema::Column object. + +=cut + +sub addcolumn { + my($self,$column)=@_; + ${$self->{'columns'}}{$column->name}=$column; #sanity check? + push @{$self->{'column_order'}}, $column->name; +} + +=item delcolumn COLUMN_NAME + +Deletes this column. Returns false if no column of this name was found to +remove, true otherwise. + +=cut + +sub delcolumn { + my($self,$column) = @_; + return 0 unless exists $self->{'columns'}{$column}; + delete $self->{'columns'}{$column}; + @{$self->{'column_order'}}= grep { $_ ne $column } @{$self->{'column_order'}}; 1; +} + +=item name [ TABLE_NAME ] + +Returns or sets the table name. + +=cut + +sub name { + my($self,$value)=@_; + if ( defined($value) ) { + $self->{name} = $value; + } else { + $self->{name}; + } +} + +=item primary_key [ PRIMARY_KEY ] + +Returns or sets the primary key. + +=cut + +sub primary_key { + my($self,$value)=@_; + if ( defined($value) ) { + $self->{primary_key} = $value; + } else { + #$self->{primary_key}; + #hmm. maybe should untaint the entire structure when it comes off disk + # cause if you don't trust that, ? + $self->{primary_key} =~ /^(\w*)$/ + #aah! + or die "Illegal primary key: ", $self->{primary_key}; + $1; + } +} + +=item unique [ UNIQUE ] + +Returns or sets the DBIx::DBSchema::ColGroup::Unique object. + +=cut + +sub unique { + my($self,$value)=@_; + if ( defined($value) ) { + $self->{unique} = $value; + } else { + $self->{unique}; + } +} + +=item index [ INDEX ] + +Returns or sets the DBIx::DBSchema::ColGroup::Index object. + +=cut + +sub index { + my($self,$value)=@_; + if ( defined($value) ) { + $self->{'index'} = $value; + } else { + $self->{'index'}; + } +} + +=item columns + +Returns a list consisting of the names of all columns. + +=cut + +sub columns { + my($self)=@_; + #keys %{$self->{'columns'}}; + #must preserve order + @{ $self->{'column_order'} }; +} + +=item column COLUMN_NAME + +Returns the column object (see L<DBIx::DBSchema::Column>) for the specified +COLUMN_NAME. + +=cut + +sub column { + my($self,$column)=@_; + $self->{'columns'}->{$column}; +} + +=item sql_create_table [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ] + +Returns a list of SQL statments to create this table. + +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', will use +MySQL- or PostgreSQL-specific syntax. Non-standard syntax for other engines +(if applicable) may also be supported in the future. + +=cut + +sub sql_create_table { + my($self, $dbh) = (shift, shift); + + my $created_dbh = 0; + unless ( ref($dbh) || ! @_ ) { + $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr; + my $gratuitous = $DBI::errstr; #surpress superfluous `used only once' error + $created_dbh = 1; + } + #false laziness: nicked from DBSchema::_load_driver + my $driver; + if ( ref($dbh) ) { + $driver = $dbh->{Driver}->{Name}; + } else { + my $discard = $dbh; + $discard =~ s/^dbi:(\w*?)(?:\((.*?)\))?://i #nicked from DBI->connect + or '' =~ /()/; # ensure $1 etc are empty if match fails + $driver = $1 or die "can't parse data source: $dbh"; + } + #eofalse + +#should be in the DBD somehwere :/ +# my $saved_pkey = ''; +# if ( $driver eq 'Pg' && $self->primary_key ) { +# my $pcolumn = $self->column( ( +# grep { $self->column($_)->name eq $self->primary_key } $self->columns +# )[0] ); +##AUTO-INCREMENT# $pcolumn->type('serial') if lc($pcolumn->type) eq 'integer'; +# $pcolumn->local( $pcolumn->local. ' PRIMARY KEY' ); +# #my $saved_pkey = $self->primary_key; +# #$self->primary_key(''); +# #change it back afterwords :/ +# } + + my @columns = map { $self->column($_)->line($dbh) } $self->columns; + + push @columns, "PRIMARY KEY (". $self->primary_key. ")" + #if $self->primary_key && $driver ne 'Pg'; + if $self->primary_key; + + my $indexnum = 1; + + my @r = ( + "CREATE TABLE ". $self->name. " (\n ". join(",\n ", @columns). "\n)\n" + ); + + push @r, map { + #my($index) = $self->name. "__". $_ . "_idx"; + #$index =~ s/,\s*/_/g; + my $index = $self->name. $indexnum++; + "CREATE UNIQUE INDEX $index ON ". $self->name. " ($_)\n" + } $self->unique->sql_list + if $self->unique; + + push @r, map { + #my($index) = $self->name. "__". $_ . "_idx"; + #$index =~ s/,\s*/_/g; + my $index = $self->name. $indexnum++; + "CREATE INDEX $index ON ". $self->name. " ($_)\n" + } $self->index->sql_list + if $self->index; + + #$self->primary_key($saved_pkey) if $saved_pkey; + $dbh->disconnect if $created_dbh; + @r; +} + +# + +sub _null_sth { + my($dbh, $table) = @_; + my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1=0") + or die $dbh->errstr; + $sth->execute or die $sth->errstr; + $sth; +} + +=back + +=head1 AUTHOR + +Ivan Kohler <ivan-dbix-dbschema@420.am> + +Thanks to Mark Ethan Trostler <mark@zzo.com> for a patch to allow tables +with no indices. + +=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 + +sql_create_table() has database-specific foo that probably ought to be +abstracted into the DBIx::DBSchema::DBD:: modules. + +sql_create_table may change or destroy the object's data. If you need to use +the object after sql_create_table, make a copy beforehand. + +Some of the logic in new_odbc might be better abstracted into Column.pm etc. + +=head1 SEE ALSO + +L<DBIx::DBSchema>, L<DBIx::DBSchema::ColGroup::Unique>, +L<DBIx::DBSchema::ColGroup::Index>, L<DBIx::DBSchema::Column>, L<DBI> + +=cut + +1; + diff --git a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/MANIFEST b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/MANIFEST new file mode 100644 index 0000000..b04de25 --- /dev/null +++ b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/MANIFEST @@ -0,0 +1,19 @@ +Changes +MANIFEST +MANIFEST.SKIP +README +TODO +Makefile.PL +DBSchema.pm +t/load.t +t/load-mysql.t +t/load-pg.t +DBSchema/Table.pm +DBSchema/ColGroup.pm +DBSchema/ColGroup/Index.pm +DBSchema/ColGroup/Unique.pm +DBSchema/Column.pm +DBSchema/DBD.pm +DBSchema/DBD/mysql.pm +DBSchema/DBD/Pg.pm +DBSchema/DBD/Sybase.pm diff --git a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/MANIFEST.SKIP b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/MANIFEST.SKIP new file mode 100644 index 0000000..ae335e7 --- /dev/null +++ b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/MANIFEST.SKIP @@ -0,0 +1 @@ +CVS/ diff --git a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/Makefile.PL b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/Makefile.PL new file mode 100644 index 0000000..a10e4da --- /dev/null +++ b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/Makefile.PL @@ -0,0 +1,11 @@ +use ExtUtils::MakeMaker; +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. +WriteMakefile( + 'NAME' => 'DBIx::DBSchema', + 'VERSION_FROM' => 'DBSchema.pm', # finds $VERSION + 'PREREQ_PM' => { + 'DBI' => 0, + 'FreezeThaw' => 0, + }, +); diff --git a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/README b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/README new file mode 100644 index 0000000..8911ea4 --- /dev/null +++ b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/README @@ -0,0 +1,42 @@ +DBIx::DBSchema + +Copyright (c) 2000-2002 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. + +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 from different process. Most importantly, DBIx::DBSchema can write SQL +CREATE statements for different databases from a single source. + +Currently supported databases are MySQL, PostgreSQL and Sybase. +DBIx::DBSchema will attempt to use generic SQL syntax for other databases. +Assistance adding support for other databases is welcomed. See the +DBIx::DBSchema::DBD manpage, "Driver Writer's Guide and Base Class". + +To install: + perl Makefile.PL + make + make test # nothing substantial yet + make install + +Documentation will then be available via `man DBIx::DBSchema' or +`perldoc DBIx::DBSchema'. + +Anonymous CVS access is available: + $ export CVSROOT=":pserver:anonymous@cleanwhisker.420.am:/home/cvs/cvsroot" + $ cvs login + (Logging in to anonymous@cleanwhisker.420.am) + CVS password: anonymous + $ cvs checkout DBIx-DBSchema +as well as <http://www.420.am/cgi-bin/cvsweb/DBIx-DBSchema>. + +A mailing list is available. Send a blank message to +<ivan-dbix-dbschema-users-subscribe@420.am>. + +Homepage: <http://www.420.am/dbix-dbschema> + +$Id: README,v 1.1 2004-04-29 09:21:27 ivan Exp $ diff --git a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/TODO b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/TODO new file mode 100644 index 0000000..e75850b --- /dev/null +++ b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/TODO @@ -0,0 +1,6 @@ +port and test with additional databases + +sql CREATE TABLE output should convert integers +(i.e. use DBI qw(:sql_types);) to local types using DBI->type_info plus a hash +to fudge things + diff --git a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/t/load-mysql.t b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/t/load-mysql.t new file mode 100644 index 0000000..78818c1 --- /dev/null +++ b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/t/load-mysql.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n"; } +END {print "not ok 1\n" unless $loaded;} +use DBIx::DBSchema::DBD::mysql; +$loaded = 1; +print "ok 1\n"; diff --git a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/t/load-pg.t b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/t/load-pg.t new file mode 100644 index 0000000..93fcf4a --- /dev/null +++ b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/t/load-pg.t @@ -0,0 +1,12 @@ +print "1..1\n"; +eval "use DBD::Pg 1.32"; +if ( length($@) ) { + print "ok 1 # Skipped: DBD::Pg 1.32 required for Pg"; +} else { + eval "use DBIx::DBSchema::DBD::Pg;"; + if ( length($@) ) { + print "not ok 1\n"; + } else { + print "ok 1\n"; + } +} diff --git a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/t/load.t b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/t/load.t new file mode 100644 index 0000000..67ea44b --- /dev/null +++ b/install/5.005/DBIx-DBSchema-0.23-5.005kludge/t/load.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n"; } +END {print "not ok 1\n" unless $loaded;} +use DBIx::DBSchema; +$loaded = 1; +print "ok 1\n"; |