This is an automated email from the git hooks/post-receive script. jame-guest pushed a commit to branch master in repository libpgobject-simple-perl.
commit e573a232c98f185c9d2bae3d763dffac34173b81 Author: Robert James Clay <[email protected]> Date: Fri Jun 23 13:42:21 2017 -0400 New upstream version 3.000002 --- Changes | 52 ++++++++++++---- MANIFEST | 3 +- MANIFEST.SKIP | 2 + META.json | 8 ++- META.yml | 14 +++-- MYMETA.json | 41 ------------- Makefile.PL | 5 +- lib/PGObject/Simple.pm | 157 ++++++++++++++++++++++++++++++++++++++----------- t/01-constructor.t | 9 ++- t/02-call_procedure.t | 53 +++++++++++++---- 10 files changed, 232 insertions(+), 112 deletions(-) diff --git a/Changes b/Changes index 6c09fc9..e57d112 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,35 @@ Revision history for PGObject-Simple +3.0.2 2016-06-10 + Fixed bug introduced during refactoring for byteas + +3.0.1 2017-05-20 + Fixed a bug where package defaults are never called where they should be + +3.0 2017-05-19 + Removed support for Perl 5.6 and 5.8 + Code cleanup + Now provide exports for code re-use in rolls and adaptors + Give precedence to functions over hash elements in object mappings. + Added getters and setters for dbh + Added association interface + Added support for package-level reader/factories for param defaults + Added support for object accessors for param defaults + +2.0.0 2016-11-21 + Release version 2.0.0 in order to get out of the 1.9 vs 1.10 mess + +1.91 2016-11-21 + CPAN won't accept 1.10.1 as it's lower than 1.9... Renumbering + +1.10.1 2016-11-21 + Fix minimum dependency on PGObject + +1.9 2016-11-20 + Fix issue #5: Don't call $value->to_db() [PGObject already does] + Fix issue #6: Don't special-case BYTEA arguments + Fix author tests + 1.8 2014-08-21 1. Made use of catalog-lookups memoization-safe. @@ -7,19 +37,19 @@ Revision history for PGObject-Simple 1. Solved a number of issues regarding overriding defaults for application frameworks -1.6 2014-02-24 - 1. Added per class schema handling (overridden by per call handling). - 2. Re-arranged requirements in Makefile.PL - 3. DB tests now use DB_TESTING=1 to set on, consistent with other - PGObject modules +1.6 2014-02-24 + 1. Added per class schema handling (overridden by per call handling). + 2. Re-arranged requirements in Makefile.PL + 3. DB tests now use DB_TESTING=1 to set on, consistent with other + PGObject modules -1.5 2014-02-16 - 1. Added contextual return handling so that db procedure calls can - return either the first row of the set (usually useful where that is - the only row) or the full set. +1.5 2014-02-16 + 1. Added contextual return handling so that db procedure calls can + return either the first row of the set (usually useful where that is + the only row) or the full set. -1.4 2013-11-12 - 1. Fixed __PACKAGE__->call_dbmethod interface so it works. +1.4 2013-11-12 + 1. Fixed __PACKAGE__->call_dbmethod interface so it works. 1.3 2013-06-07 1. Fixed test case that caused thins to bomb diff --git a/MANIFEST b/MANIFEST index f2c26f3..c50c7dc 100644 --- a/MANIFEST +++ b/MANIFEST @@ -3,9 +3,8 @@ ignore.txt lib/PGObject/Simple.pm LICENSE Makefile.PL -MANIFEST This list of files +MANIFEST This list of files MANIFEST.SKIP -MYMETA.json README README.md t/00-load.t diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP index f509077..e569db9 100644 --- a/MANIFEST.SKIP +++ b/MANIFEST.SKIP @@ -36,6 +36,8 @@ ^tmp \bTAGS$ ^MYMETA.yml$ +^.travis.yml$ +^MYMETA.json$ \bSu-[\d\.\_]+ diff --git a/META.json b/META.json index c2ed3ee..2c54924 100644 --- a/META.json +++ b/META.json @@ -4,7 +4,7 @@ "Chris Travers <[email protected]>" ], "dynamic_config" : 1, - "generated_by" : "ExtUtils::MakeMaker version 6.72, CPAN::Meta::Converter version 2.132140", + "generated_by" : "ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150005", "license" : [ "bsd" ], @@ -22,6 +22,7 @@ "prereqs" : { "build" : { "requires" : { + "Data::Dumper" : "0", "Test::More" : "0" } }, @@ -32,10 +33,11 @@ }, "runtime" : { "requires" : { - "PGObject" : "1.1" + "PGObject" : "v1.403.2" } } }, "release_status" : "stable", - "version" : "1.8" + "version" : 3.000002, + "x_serialization_backend" : "JSON::PP version 2.27400" } diff --git a/META.yml b/META.yml index 150bd7f..9cebf03 100644 --- a/META.yml +++ b/META.yml @@ -3,20 +3,22 @@ abstract: "Minimalist stored procedure mapper based on LedgerSMB's DBObject" author: - 'Chris Travers <[email protected]>' build_requires: - Test::More: 0 + Data::Dumper: '0' + Test::More: '0' configure_requires: - ExtUtils::MakeMaker: 0 + ExtUtils::MakeMaker: '0' dynamic_config: 1 -generated_by: 'ExtUtils::MakeMaker version 6.72, CPAN::Meta::Converter version 2.132140' +generated_by: 'ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150005' license: bsd meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html - version: 1.4 + version: '1.4' name: PGObject-Simple no_index: directory: - t - inc requires: - PGObject: 1.1 -version: 1.8 + PGObject: v1.403.2 +version: 3.000002 +x_serialization_backend: 'CPAN::Meta::YAML version 0.018' diff --git a/MYMETA.json b/MYMETA.json deleted file mode 100644 index c6059d9..0000000 --- a/MYMETA.json +++ /dev/null @@ -1,41 +0,0 @@ -{ - "abstract" : "Minimalist stored procedure mapper based on LedgerSMB's DBObject", - "author" : [ - "Chris Travers <[email protected]>" - ], - "dynamic_config" : 0, - "generated_by" : "ExtUtils::MakeMaker version 6.72, CPAN::Meta::Converter version 2.132140", - "license" : [ - "bsd" - ], - "meta-spec" : { - "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec";, - "version" : "2" - }, - "name" : "PGObject-Simple", - "no_index" : { - "directory" : [ - "t", - "inc" - ] - }, - "prereqs" : { - "build" : { - "requires" : { - "Test::More" : "0" - } - }, - "configure" : { - "requires" : { - "ExtUtils::MakeMaker" : "0" - } - }, - "runtime" : { - "requires" : { - "PGObject" : "1.1" - } - } - }, - "release_status" : "stable", - "version" : "1.8" -} diff --git a/Makefile.PL b/Makefile.PL index 8531cad..b89566d 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -1,4 +1,4 @@ -use 5.006; +use 5.010; use strict; use warnings; use ExtUtils::MakeMaker; @@ -13,10 +13,11 @@ WriteMakefile( : ()), PL_FILES => {}, PREREQ_PM => { - 'PGObject' => 1.1, + 'PGObject' => '1.403.2', }, BUILD_REQUIRES => { 'Test::More' => 0, + 'Data::Dumper' => 0, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'PGObject-Simple-*' }, diff --git a/lib/PGObject/Simple.pm b/lib/PGObject/Simple.pm index 95da521..fa673d9 100644 --- a/lib/PGObject/Simple.pm +++ b/lib/PGObject/Simple.pm @@ -1,10 +1,11 @@ package PGObject::Simple; -use 5.006; +use 5.010; use strict; use warnings; use Carp; use PGObject; +use parent 'Exporter'; =head1 NAME @@ -12,12 +13,11 @@ PGObject::Simple - Minimalist stored procedure mapper based on LedgerSMB's DBObj =head1 VERSION -Version 1.8 +Version 3.0.2 =cut -our $VERSION = '1.8'; - +our $VERSION = 3.000002; =head1 SYNOPSIS @@ -60,6 +60,52 @@ To call a stored procedure with named arguments from a hashref with overrides. args => { id => undef }, # force to create new! ); + +=head1 EXPORTS + +We now allow various calls to be exported. We recommend using the tags. + +=head2 One-at-a-time Exports + +=over + +=item call_dbmethod + +=item call_procedure + +=item set_dbh + +=item _set_funcprefix + +=item _set_funcschema + +=item _set_registry + +=back + +=head2 Export Tags + +Below are the export tags listed including the leading ':' used to invoke them. + +=over + +=item :mapper + call_dbmethod, call_procedure, and set_dbh + +=item :full + All methods that can be exported at once. + +=back + +=cut + +our @EXPORT_OK = qw(call_dbmethod call_procedure set_dbh associate dbh + _set_funcprefix + _set_funcschema _set_registry); + +our %EXPORT_TAGS = (mapper => [qw(call_dbmethod call_procedure set_dbh dbh)], + full => \@EXPORT_OK); + =head1 DESCRIPTION PGObject::Simple a top-half object system for PGObject which is simple and @@ -106,6 +152,7 @@ sub new { $ref->_set_funcprefix($ref->{_funcprefix}); $ref->_set_funcschema($ref->{_funcschema}); $ref->_set_registry($ref->{_registry}); + $ref->associate($self) if ref $self; return $ref; } @@ -117,7 +164,29 @@ Sets the database handle (needs DBD::Pg 2.0 or later) to $dbh sub set_dbh { my ($self, $dbh) = @_; - $self->{_DBH} = $dbh; + $self->{_dbh} = $dbh; +} + +=head2 dbh + +Returns the database handle for the object. + +=cut + +sub dbh { + my ($self) = @_; + return ($self->{_dbh} or $self->{_DBH}); +} + +=head2 associate($pgobject) + +Sets the db handle to that from the $pgobject. + +=cut + +sub associate { + my ($self, $other) = @_; + $self->set_dbh($other->dbh); } =head2 _set_funcprefix @@ -174,32 +243,61 @@ stored procedures should be prepared to handle these. As with call_procedure below, this returns a single hashref when called in a scalar context, and a list of hashrefs when called in a list context. +NEW IN 2.0: We now give preference to functions of the same name over +properties. So $obj->foo() will be used before $obj->{foo}. This enables +better data encapsulation. + =cut +sub _arg_defaults { + my ($self, %args) = @_; + local $@; + if (ref $self) { + $args{dbh} ||= eval { $self->dbh } ; + $args{funcprefix} //= eval { $self->funcprefix } ; + $args{funcschema} //= eval { $self->funcschema } ; + $args{funcprefix} //= $self->{_func_prefix}; + $args{funcschema} //= $self->{_func_schema}; + $args{funcprefix} //= eval {$self->_get_prefix() }; + } else { + # see if we have package-level reader/factories + $args{dbh} ||= "$self"->dbh; # if eval {"$self"->dbh}; + $args{funcschema} //= "$self"->funcschema if eval {"$self"->funcschema}; + $args{funcprefix} //= "$self"->funcprefix if eval {"$self"->funcprefix}; + } + $args{funcprefix} //= ''; + + return %args +} + +sub _self_to_arg { # refactored from map call, purely internal + my ($self, $args, $argname) = @_; + my $db_arg; + $argname =~ s/^in_//; + local $@; + if (ref $self and $argname){ + if (eval { $self->can($argname) } ) { + eval { $db_arg = $self->can($argname)->($self) }; + } else { + $db_arg = $self->{$argname}; + } + } + $db_arg = $args->{args}->{$argname} if exists $args->{args}->{$argname}; + $db_arg = $db_arg->to_db if eval {$db_arg->can('to_db')}; + + return $db_arg; +} + sub call_dbmethod { my ($self) = shift @_; my %args = @_; croak 'No function name provided' unless $args{funcname}; - if (eval { $self->isa(__PACKAGE__) } and ref $self){ - $args{dbh} = $self->{_DBH} if $self->{_DBH} and !$args{dbh}; - - $args{funcprefix} = $self->{_func_prefix} if !defined $args{funcprefix}; - $args{funcschema} = $self->{_func_schema} if !defined $args{funcschema}; - } - $args{funcprefix} ||= ''; + %args = _arg_defaults($self, %args); my $info = PGObject->function_info(%args); my $arglist = []; - @{$arglist} = map { - my $argname = $_->{name}; - my $db_arg; - $argname =~ s/^in_//; - $db_arg = $self->{$argname} if ref $self; - $db_arg = $args{args}->{$argname} if exists $args{args}->{$argname}; - $db_arg = $db_arg->to_db if eval {$db_arg->can('to_db')}; - $db_arg = { type => 'bytea', value => $db_arg} if $_->{type} eq 'bytea'; - $db_arg; - } @{$info->{args}}; + @{$arglist} = map { _self_to_arg($self, \%args, $_->{name}) } + @{$info->{args}}; $args{args} = $arglist; # The conditional return is necessary since the object may carry a registry @@ -222,17 +320,8 @@ simply returns the single first row returned. =cut sub call_procedure { - my ($self) = shift @_; - my %args = @_; - if (eval { $self->isa(__PACKAGE__) } and ref $self ){ - $args{funcprefix} = $self->{_func_prefix} if !defined $args{funcprefix}; - $args{funcschema} = $self->{_func_schema} if !defined $args{funcschema}; - $args{registry} = $self->{_registry} if !defined $args{registry}; - - $args{dbh} = $self->{_DBH} if $self->{_DBH} and !$args{dbh}; - } - $args{funcprefix} ||= ''; - + my ($self, %args) = @_; + %args = _arg_defaults($self, %args); croak 'No DB handle provided' unless $args{dbh}; my @rows = PGObject->call_procedure(%args); return shift @rows unless wantarray; @@ -336,7 +425,7 @@ L<http://search.cpan.org/dist/PGObject-Simple/> =head1 LICENSE AND COPYRIGHT -Copyright 2013-2014 Chris Travers. +Copyright 2013-2017 Chris Travers. Redistribution and use in source and compiled forms with or without modification, are permitted provided that the following conditions are met: diff --git a/t/01-constructor.t b/t/01-constructor.t index 963ea7e..483296a 100644 --- a/t/01-constructor.t +++ b/t/01-constructor.t @@ -1,5 +1,5 @@ use PGObject::Simple; -use Test::More tests => 3; +use Test::More tests => 5; use DBI; my %hash = ( @@ -16,5 +16,10 @@ my $obj = PGObject::Simple->new(%hash); ok($obj->isa('PGObject::Simple'), 'Object successfully created'); is($obj->set_dbh($dbh), $dbh, 'Set database handle successfully'); -is($dbh, $obj->{_DBH}, "database handle cross check"); +is($dbh, $obj->dbh, "database handle cross check"); + +my $obj2 = PGObject::Simple->new(%hash); +is($obj2->dbh, undef, 'No db handle for second object'); +$obj2->associate($obj); +is($dbh, $obj2->dbh, "database handle cross check after association"); diff --git a/t/02-call_procedure.t b/t/02-call_procedure.t index e47da4a..93d7f39 100644 --- a/t/02-call_procedure.t +++ b/t/02-call_procedure.t @@ -1,6 +1,25 @@ +package dbtest; +use parent 'PGObject::Simple'; +sub dbh { + my ($self) = @_; + return $self->SUPER::dbh(@_) if ref $self; + return $main::dbh; +} + +sub func_prefix { + return ''; +} + +sub func_schema { + return 'public'; +} + +package main; + use PGObject::Simple; use Test::More; use DBI; +use Data::Dumper; my %hash = ( foo => 'foo', @@ -10,12 +29,12 @@ my %hash = ( ); plan skip_all => 'Not set up for db tests' unless $ENV{DB_TESTING}; -plan tests => 9; +plan tests => 11; my $dbh1 = DBI->connect('dbi:Pg:dbname=postgres', 'postgres'); $dbh1->do('CREATE DATABASE pgobject_test_db') if $dbh1; -my $dbh = DBI->connect('dbi:Pg:dbname=pgobject_test_db', 'postgres'); +our $dbh = DBI->connect('dbi:Pg:dbname=pgobject_test_db', 'postgres'); $dbh->do(' CREATE FUNCTION public.foobar (in_foo text, in_bar text, in_baz int, in_id int) RETURNS int language sql as $$ @@ -42,14 +61,19 @@ SKIP: { funcname => 'foobar', args => ['text', 'text2', '5', '30'] ); - is ($ref->{foobar}, 159, 'Correct value returned, call_procedure'); + is ($ref->{foobar}, 159, 'Correct value returned, call_procedure') or diag Dumper($ref); ($ref) = PGObject::Simple->call_procedure( dbh => $dbh, funcname => 'foobar', args => ['text', 'text2', '5', '30'] ); - is ($ref->{foobar}, 159, 'Correct value returned, call_procedure, package invocation'); + is ($ref->{foobar}, 159, 'Correct value returned, call_procedure, package invocation') or diag Dumper($ref); + + ($ref) = dbtest->call_procedure(funcname => 'foobar', + args => ['text', 'text2', '5', '30'] + ); + is ($ref->{foobar}, 159, 'Correct value returned, package invocation with factories') or diag Dumper($ref); ($ref) = $obj->call_procedure( @@ -58,39 +82,44 @@ SKIP: { args => ['text1', 'text2', '5', '30'] ); - is ($ref->{foobar}, 160, 'Correct value returned, call_procedure w/schema'); + is ($ref->{foobar}, 160, 'Correct value returned, call_procedure w/schema') or diag Dumper($ref); ($ref) = $obj->call_dbmethod( funcname => 'foobar' ); - is ($ref->{foobar}, $answer, 'Correct value returned, call_dbmethod'); + is ($ref->{foobar}, $answer, 'Correct value returned, call_dbmethod') or diag Dumper($ref); ($ref) = PGObject::Simple->call_dbmethod( funcname => 'foobar', args => \%hash, dbh => $dbh, ); - is ($ref->{foobar}, $answer, 'Correct value returned, call_dbmethod'); + is ($ref->{foobar}, $answer, 'Correct value returned, call_dbmethodi with hash and no ref') or diag Dumper($ref); + ($ref) = dbtest->call_dbmethod(funcname => 'foobar', + args => \%hash + ); + is ($ref->{foobar}, $answer, 'Correct value returned, package invocation with factories and dbmethod') or diag Dumper($ref); + ($ref) = $obj->call_dbmethod( funcname => 'foobar', args => {id => 4} ); - is ($ref->{foobar}, 14, 'Correct value returned, call_dbmethod w/args'); + is ($ref->{foobar}, 14, 'Correct value returned, call_dbmethod w/args') or diag Dumper($ref); $obj->_set_funcprefix('foo'); ($ref) = ($ref) = $obj->call_dbmethod( funcname => 'bar', args => {id => 4} ); - is ($ref->{foobar}, 14, 'Correct value returned, call_dbmethod w/args/prefix'); + is ($ref->{foobar}, 14, 'Correct value returned, call_dbmethod w/args/prefix') or diag Dumper($ref); ($ref) = ($ref) = $obj->call_dbmethod( funcname => 'oobar', args => {id => 4}, funcprefix => 'f' ); - is ($ref->{foobar}, 14, 'Correct value returned, call_dbmethod w/exp. pre.'); + is ($ref->{foobar}, 14, 'Correct value returned, call_dbmethod w/exp. pre.') or diag Dumper($ref); $obj->_set_funcschema('test'); $obj->_set_funcprefix(''); @@ -98,7 +127,9 @@ SKIP: { funcname => 'foobar' ); - is ($ref->{foobar}, $answer * 2, 'Correct value returned, call_dbmethod'); + is ($ref->{foobar}, $answer * 2, 'Correct value returned, call_dbmethod') or diag Dumper($ref); + $obh = dbtest->new(); + } $dbh->disconnect if $dbh; -- Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libpgobject-simple-perl.git _______________________________________________ Pkg-perl-cvs-commits mailing list [email protected] http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits
