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