diff options
Diffstat (limited to 'install/5.005/DBIx-DBSchema-0.23-5.005kludge')
19 files changed, 0 insertions, 2072 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 deleted file mode 100644 index f413bd9..0000000 --- a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/Changes +++ /dev/null @@ -1,62 +0,0 @@ -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 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; - 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 deleted file mode 100644 index ceeb223..0000000 --- a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/ColGroup.pm +++ /dev/null @@ -1,141 +0,0 @@ -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 deleted file mode 100644 index 1a92baa..0000000 --- a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/ColGroup/Index.pm +++ /dev/null @@ -1,37 +0,0 @@ -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 deleted file mode 100644 index 450043f..0000000 --- a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/ColGroup/Unique.pm +++ /dev/null @@ -1,38 +0,0 @@ -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 deleted file mode 100644 index 4e26646..0000000 --- a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/Column.pm +++ /dev/null @@ -1,300 +0,0 @@ -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 deleted file mode 100644 index a4c6000..0000000 --- a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/DBD.pm +++ /dev/null @@ -1,113 +0,0 @@ -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 deleted file mode 100644 index 018b890..0000000 --- a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/DBD/Pg.pm +++ /dev/null @@ -1,175 +0,0 @@ -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 deleted file mode 100755 index 4a74069..0000000 --- a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/DBD/Sybase.pm +++ /dev/null @@ -1,141 +0,0 @@ -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 deleted file mode 100644 index f3804dd..0000000 --- a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/DBD/mysql.pm +++ /dev/null @@ -1,126 +0,0 @@ -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 deleted file mode 100644 index 2d6272e..0000000 --- a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/Table.pm +++ /dev/null @@ -1,471 +0,0 @@ -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 deleted file mode 100644 index b04de25..0000000 --- a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/MANIFEST +++ /dev/null @@ -1,19 +0,0 @@ -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 deleted file mode 100644 index ae335e7..0000000 --- a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/MANIFEST.SKIP +++ /dev/null @@ -1 +0,0 @@ -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 deleted file mode 100644 index a10e4da..0000000 --- a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/Makefile.PL +++ /dev/null @@ -1,11 +0,0 @@ -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 deleted file mode 100644 index 8911ea4..0000000 --- a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/README +++ /dev/null @@ -1,42 +0,0 @@ -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 deleted file mode 100644 index e75850b..0000000 --- a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/TODO +++ /dev/null @@ -1,6 +0,0 @@ -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 deleted file mode 100644 index 78818c1..0000000 --- a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/t/load-mysql.t +++ /dev/null @@ -1,5 +0,0 @@ -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 deleted file mode 100644 index 93fcf4a..0000000 --- a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/t/load-pg.t +++ /dev/null @@ -1,12 +0,0 @@ -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 deleted file mode 100644 index 67ea44b..0000000 --- a/install/5.005/DBIx-DBSchema-0.23-5.005kludge/t/load.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n"; } -END {print "not ok 1\n" unless $loaded;} -use DBIx::DBSchema; -$loaded = 1; -print "ok 1\n"; |