diff options
Diffstat (limited to 'install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema')
9 files changed, 0 insertions, 1542 deletions
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; - |