Class-DBI-Pg-0.09/0000755000076500007650000000000010454246776014574 5ustar daisukedaisuke00000000000000Class-DBI-Pg-0.09/Build.PL0000555000076500007650000000107610454246776016075 0ustar daisukedaisuke00000000000000# $Id: /mirror/Class-DBI-Pg/Build.PL 1974 2006-05-20T01:18:11.362146Z daisuke $ # # Copyright (c) 2006 Daisuke Maki # All rights reserved. use strict; use Module::Build; my $build = Module::Build->new( dist_name => 'Class-DBI-Pg', dist_version_from => 'lib/Class/DBI/Pg.pm', requires => { 'Class::DBI' => '>= 0.89', 'DBD::Pg' => '>= 1.13', }, build_requires => { 'Test::More' => 0 }, license => 'perl', create_readme => 1, create_makefile_pl => 'traditional', ); $build->create_build_script;Class-DBI-Pg-0.09/Changes0000444000076500007650000000240610454246776016067 0ustar daisukedaisuke00000000000000Revision history for Perl extension Class::DBI::Pg 0.09 Mon Jul 10 03:40:00 2006 * "I'm doind this as I watch the World Cup Finals" release - Add POD tests 0.08_02 Mon May 29 15:30:00 2006 - Apply patches from Boris Sukholitko. Adds "Primary As Option" and "Column Groups" features 0.08_01 Sat May 20 10:00:00 2006 - Fix typo in the sequence detection - Restructure directory structure 0.08 Sat Mar 11 17:00:00 2006 - Stop using _croak (#18093) 0.07 Thu Jan 26 03:00:00 2006 - work with PostgreSQL 8.1's new sequence display - pg_version(full_version => 1) gets you the major, minor, micro version strings - maintainer changed to Daisuke Maki 0.06 Wed Dec 02 18:00:00 2004 - support for compound primary keys (Simon Flack) 0.05 Wed Dec 01 14:00:00 2004 - no more warnings for missing sequences (Marcus Ramberg) 0.04 Wed Dec 01 10:00:00 2004 - cleanup 0.03 Thu Sep 10 00:00:00 2004 - 0.03 - treat dropped column correctly. - fixed sequence test. - added pg_version(). - fixed PREREQ_PM 0.02 Thu Aug 08 00:00:00 2004 - 0.01 - original version - 0.02 - added SERIAL type support. Class-DBI-Pg-0.09/lib/0000755000076500007650000000000010454246776015342 5ustar daisukedaisuke00000000000000Class-DBI-Pg-0.09/lib/Class/0000755000076500007650000000000010454246776016407 5ustar daisukedaisuke00000000000000Class-DBI-Pg-0.09/lib/Class/DBI/0000755000076500007650000000000010454246776017005 5ustar daisukedaisuke00000000000000Class-DBI-Pg-0.09/lib/Class/DBI/Pg.pm0000444000076500007650000001213610454246776017712 0ustar daisukedaisuke00000000000000# $Id: /mirror/Class-DBI-Pg/lib/Class/DBI/Pg.pm 1980 2006-07-09T18:42:00.901499Z daisuke $ # # Copyright (c) Ikebe Tomohiro # Sebastian Riedel # 2006 Daisuke Maki # All rights reserved. package Class::DBI::Pg; use strict; require Class::DBI; use base 'Class::DBI'; use vars qw($VERSION); $VERSION = '0.09'; sub set_up_table { my ( $class, $table, $opts ) = @_; $opts ||= {}; my $dbh = $class->db_Main; my $catalog = ""; if ( $class->pg_version >= 7.3 ) { $catalog = 'pg_catalog.'; } # find primary key my $sth = $dbh->prepare(<<"SQL"); SELECT indkey FROM ${catalog}pg_index WHERE indisprimary=true AND indrelid=( SELECT oid FROM ${catalog}pg_class WHERE relname = ?) SQL $sth->execute($table); my %prinum = map { $_ => 1 } split ' ', ($sth->fetchrow_array || ''); $sth->finish; # find all columns $sth = $dbh->prepare(<<"SQL"); SELECT a.attname, a.attnum FROM ${catalog}pg_class c, ${catalog}pg_attribute a WHERE c.relname = ? AND a.attnum > 0 AND a.attrelid = c.oid ORDER BY a.attnum SQL $sth->execute($table); my $columns = $sth->fetchall_arrayref; $sth->finish; # find SERIAL type. # nextval('"table_id_seq"'::text) $sth = $dbh->prepare(<<"SQL"); SELECT adsrc FROM ${catalog}pg_attrdef WHERE adrelid=(SELECT oid FROM ${catalog}pg_class WHERE relname=?) SQL $sth->execute($table); my ($nextval_str) = $sth->fetchrow_array; $sth->finish; # the text representation for nextval() changed between 7.x and 8.x my $sequence; if ($nextval_str) { if ($class->pg_version() >= 8.1) { # hackish, but oh well... ($sequence) = $nextval_str =~ m!^nextval\('"?([^"']+)"?'::regclass\)!i ? $1 : $nextval_str =~ m!^nextval\(\('"?([^"']+)"?'::text\)?::regclass\)!i ? $1 : undef; } else { ($sequence) = $nextval_str =~ m!^nextval\('"?([^"']+)"?'::text\)!; } } my ( @cols, @primary ); foreach my $col (@$columns) { # skip dropped column. next if $col->[0] =~ /^\.+pg\.dropped\.\d+\.+$/; push @cols, $col->[0]; next unless $prinum{ $col->[1] }; push @primary, $col->[0]; } @primary = @{ $opts->{Primary} } if $opts->{Primary}; if (!@primary) { require Carp; Carp::croak("$table has no primary key"); } if ($opts->{Primary} && (! $opts->{ColumnGroup} || $opts->{ColumnGroup} eq 'All')) { $opts->{ColumnGroup} = 'Essential'; } $class->table($table); $class->columns( Primary => @primary ); $class->columns( ($opts->{ColumnGroup} || 'All') => @cols ); $class->sequence($sequence) if $sequence; } sub pg_version { my $class = shift; my %args = @_; my $dbh = $class->db_Main; my $sth = $dbh->prepare("SELECT version()"); $sth->execute; my ($ver_str) = $sth->fetchrow_array; $sth->finish; my ($ver) = $args{full_version} ? $ver_str =~ m/^PostgreSQL ([\d\.]{5})/ : $ver_str =~ m/^PostgreSQL ([\d\.]{3})/; return $ver; } __END__ =head1 NAME Class::DBI::Pg - Class::DBI extension for Postgres =head1 SYNOPSIS use strict; use base qw(Class::DBI::Pg); __PACKAGE__->set_db(Main => 'dbi:Pg:dbname=dbname', 'user', 'password'); __PACKAGE__->set_up_table('film'); =head1 DESCRIPTION Class::DBI::Pg automate the setup of Class::DBI columns and primary key for Postgres. select Postgres system catalog and find out all columns, primary key and SERIAL type column. create table. CREATE TABLE cd ( id SERIAL NOT NULL PRIMARY KEY, title TEXT, artist TEXT, release_date DATE ); setup your class. package CD; use strict; use base qw(Class::DBI::Pg); __PACKAGE__->set_db(Main => 'dbi:Pg:dbname=db', 'user', 'password'); __PACKAGE__->set_up_table('cd'); This is almost the same as the following way. package CD; use strict; use base qw(Class::DBI); __PACKAGE__->set_db(Main => 'dbi:Pg:dbname=db', 'user', 'password'); __PACKAGE__->table('cd'); __PACKAGE__->columns(Primary => 'id'); __PACKAGE__->columns(All => qw(id title artist release_date)); __PACKAGE__->sequence('cd_id_seq'); =head1 METHODS =head2 set_up_table TABLENAME HASHREF Declares the Class::DBI class specified by TABLENAME. HASHREF can specify options to when setting up the table. =over 4 =item ColumnGroup You can specify the column group that you want your columns to be in. $class->set_up_table($table, { ColumnGroup => 'Essential' }); The default is 'All' =item Primary Overrides primary key setting. This can be useful when working with views instead of tables. =back =head2 pg_version Returns the postgres version that you are currently using. =head1 AUTHOR Daisuke Maki C =head1 AUTHOR EMERITUS Sebastian Riedel, C IKEBE Tomohiro, C =head1 LICENSE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L L L =cut Class-DBI-Pg-0.09/Makefile.PL0000444000076500007650000000100510454246776016540 0ustar daisukedaisuke00000000000000# Note: this file was auto-generated by Module::Build::Compat version 0.03 use ExtUtils::MakeMaker; WriteMakefile ( 'DISTNAME' => 'Class-DBI-Pg', 'VERSION_FROM' => 'lib/Class/DBI/Pg.pm', 'PREREQ_PM' => { 'Class::DBI' => '>= 0.89', 'DBD::Pg' => '>= 1.13', 'Test::More' => '0' }, 'INSTALLDIRS' => 'site', 'EXE_FILES' => [], 'PL_FILES' => {} ) ; Class-DBI-Pg-0.09/MANIFEST0000444000076500007650000000023210454246776015720 0ustar daisukedaisuke00000000000000Build.PL Changes lib/Class/DBI/Pg.pm MANIFEST This list of files t/00_compile.t t/01_table.t t/99-pod-coverage.t t/99-pod.t Makefile.PL README META.yml Class-DBI-Pg-0.09/META.yml0000444000076500007650000000074710454246776016053 0ustar daisukedaisuke00000000000000--- name: Class-DBI-Pg version: 0.09 author: - 'Daisuke Maki C' abstract: Class::DBI extension for Postgres license: perl resources: license: http://dev.perl.org/licenses/ requires: Class::DBI: '>= 0.89' DBD::Pg: '>= 1.13' build_requires: Test::More: 0 provides: Class::DBI::Pg: file: lib/Class/DBI/Pg.pm version: 0.09 generated_by: Module::Build version 0.2801 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.2.html version: 1.2 Class-DBI-Pg-0.09/README0000444000076500007650000000403110454246776015450 0ustar daisukedaisuke00000000000000NAME Class::DBI::Pg - Class::DBI extension for Postgres SYNOPSIS use strict; use base qw(Class::DBI::Pg); __PACKAGE__->set_db(Main => 'dbi:Pg:dbname=dbname', 'user', 'password'); __PACKAGE__->set_up_table('film'); DESCRIPTION Class::DBI::Pg automate the setup of Class::DBI columns and primary key for Postgres. select Postgres system catalog and find out all columns, primary key and SERIAL type column. create table. CREATE TABLE cd ( id SERIAL NOT NULL PRIMARY KEY, title TEXT, artist TEXT, release_date DATE ); setup your class. package CD; use strict; use base qw(Class::DBI::Pg); __PACKAGE__->set_db(Main => 'dbi:Pg:dbname=db', 'user', 'password'); __PACKAGE__->set_up_table('cd'); This is almost the same as the following way. package CD; use strict; use base qw(Class::DBI); __PACKAGE__->set_db(Main => 'dbi:Pg:dbname=db', 'user', 'password'); __PACKAGE__->table('cd'); __PACKAGE__->columns(Primary => 'id'); __PACKAGE__->columns(All => qw(id title artist release_date)); __PACKAGE__->sequence('cd_id_seq'); METHODS set_up_table TABLENAME HASHREF Declares the Class::DBI class specified by TABLENAME. HASHREF can specify options to when setting up the table. ColumnGroup You can specify the column group that you want your columns to be in. $class->set_up_table($table, { ColumnGroup => 'Essential' }); The default is 'All' Primary Overrides primary key setting. This can be useful when working with views instead of tables. pg_version Returns the postgres version that you are currently using. AUTHOR Daisuke Maki "dmaki@cpan.org" AUTHOR EMERITUS Sebastian Riedel, "sri@oook.de" IKEBE Tomohiro, "ikebe@edge.co.jp" LICENSE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. SEE ALSO Class::DBI Class::DBI::mysql DBD::Pg Class-DBI-Pg-0.09/t/0000755000076500007650000000000010454246776015037 5ustar daisukedaisuke00000000000000Class-DBI-Pg-0.09/t/00_compile.t0000444000076500007650000000011210454246776017143 0ustar daisukedaisuke00000000000000use strict; use Test::More tests => 1; BEGIN { use_ok 'Class::DBI::Pg' } Class-DBI-Pg-0.09/t/01_table.t0000444000076500007650000000501310454246776016610 0ustar daisukedaisuke00000000000000use strict; use Test::More tests => 8; use DBI; my $dbh; my $database = $ENV{DB_NAME}; my $user = $ENV{DB_USER}; my $password = $ENV{DB_PASS}; SKIP: { skip 'You need to set the DB_NAME, DB_USER and DB_PASS environment variables', 8 unless ( $database && $user ); my $dsn = "dbi:Pg:dbname=$database" if $database; $dbh = DBI->connect( $dsn, $user, $password, { AutoCommit => 1, PrintError => 0, RaiseError => 1, } ); $dbh->do(<<'SQL'); CREATE TABLE class_dbi_pg1 ( id SERIAL NOT NULL PRIMARY KEY, dat TEXT ) SQL my $sth = $dbh->prepare(<<"SQL"); INSERT INTO class_dbi_pg1 (dat) VALUES(?) SQL for my $dat (qw(foo bar baz)) { $sth->execute($dat); } $sth->finish; eval <<'' or die $@; package Class::DBI::Pg::Test; use base qw(Class::DBI::Pg); __PACKAGE__->set_db( Main => $dsn, $user, $password ); __PACKAGE__->set_up_table('class_dbi_pg1'); 1; is( Class::DBI::Pg::Test->retrieve_all, 3 ); my $obj = Class::DBI::Pg::Test->retrieve(2); is( $obj->dat, 'bar' ); my ($obj2) = Class::DBI::Pg::Test->search( dat => 'foo' ); is( $obj2->id, 1 ); like( Class::DBI::Pg::Test->sequence, qr/class_dbi_pg1_id_seq/ ); my $new_obj = Class::DBI::Pg::Test->create( { dat => 'newone' } ); is( $new_obj->id, 4 ); eval <<'' or die $@; package Class::DBI::Pg::Test2; use base qw(Class::DBI::Pg); __PACKAGE__->set_db( Main => $dsn, $user, $password ); __PACKAGE__->set_up_table('class_dbi_pg1', { ColumnGroup => 'Essential' }); 1; $obj = Class::DBI::Pg::Test2->retrieve(2); is( $obj->dat, 'bar' ); is_deeply( [ $obj->columns('Essential') ], [ qw(id dat) ] ); $dbh->do(<<'SQL'); CREATE VIEW class_dbi_pg1_v AS SELECT * FROM class_dbi_pg1 SQL eval <<'' or die $@; package Class::DBI::Pg::TestView; use base qw(Class::DBI::Pg); __PACKAGE__->set_db( Main => $dsn, $user, $password ); __PACKAGE__->set_up_table('class_dbi_pg1_v', { Primary => [ qw(id) ] }); 1; $obj = Class::DBI::Pg::TestView->retrieve(2); is( $obj->dat, 'bar' ); Class::DBI::Pg::Test->db_Main->disconnect; Class::DBI::Pg::Test2->db_Main->disconnect; Class::DBI::Pg::TestView->db_Main->disconnect; } END { if ($dbh) { eval { unless ( Class::DBI::Pg::Test->pg_version >= 7.3 ) { $dbh->do('DROP SEQUENCE class_dbi_pg1_id_seq'); } $dbh->do('DROP TABLE class_dbi_pg1 CASCADE'); }; $dbh->disconnect; } } Class-DBI-Pg-0.09/t/99-pod-coverage.t0000444000076500007650000000040010454246776020026 0ustar daisukedaisuke00000000000000#!perl use Test::More; BEGIN { eval "use Test::Pod"; eval "use Test::Pod::Coverage"; if ($@) { plan(skip_all => "Test::Pod::Coverage required for testing POD"); eval "sub all_pod_coverage_ok {}"; } } all_pod_coverage_ok(); Class-DBI-Pg-0.09/t/99-pod.t0000444000076500007650000000037610454246776016251 0ustar daisukedaisuke00000000000000use Test::More; BEGIN { eval "use Test::Pod"; if ($@) { plan skip_all => "Test::Pod required for testing POD"; eval "sub all_pod_files_ok {}"; eval "sub all_pod_files {}"; } } all_pod_files_ok(all_pod_files(qw(blib)));