This is an automated email from the git hooks/post-receive script. jame-guest pushed a commit to branch master in repository libpgobject-simple-role-perl.
commit b437b8a253e9e4c4dad0625710a8ed3eb06ea71b Author: Robert James Clay <j...@rocasa.us> Date: Mon Apr 14 22:22:54 2014 -0400 Imported Upstream version 1.01 --- Changes | 32 +++++++++ LICENSE | 23 ++++++ MANIFEST | 5 ++ MANIFEST.SKIP | 45 ++++++++++++ META.json | 4 +- META.yml | 4 +- META.json => MYMETA.json | 6 +- Makefile.PL | 0 README | 38 +++++++--- README.md | 73 +++++++++++++++++++ TODO | 3 + ignore.txt | 0 lib/PGObject/Simple/Role.pm | 169 ++++++++++++++++++++++++++++++++++++++------ t/01-basic-constructor.t | 4 +- t/02-dbtests.t | 60 ++++++++++++++-- 15 files changed, 422 insertions(+), 44 deletions(-) diff --git a/Changes b/Changes old mode 100644 new mode 100755 index 62aff82..b8590a9 --- a/Changes +++ b/Changes @@ -1,5 +1,37 @@ Revision history for PGObject-Simple-Role +1.01 2014-02-25 + Handling of per-class default schemas + +1.00 2014-02-18 + Correct handling of lazy attributes + Removed dbmethod() and documented why + Contextual return of results so scalars return first row. + +0.71 2014-02-15 + Fixed Makefile.PL to ensure proper dependencies + +0.70 2014-02-15 + dbmethod() refactored so it is usable by libraries other than this one, + is better tested, and more general. Use of the export here is now + deprecated. + +0.52 2014-01-14 + Fixed funcprefix handling with call_procedure + +0.51 2013-11-20 + Fixed inability to push funcprefix through to PGObject::Simple + +0.50 2013-11-13 + Refactored to centralize logic in PGObject::Simple + Added dbmethod() for declaratively defining database methods. + +0.13 2013-11-06 + Fixed test cases requiring Carp::Always, which was not in makefile. + +0.12 2013-11-05 + call_procedure can now be called on subclasses by package name if + desired. 0.11 2013-05-31 Fixed an issue with the Makefile not reporting Moo::Role as a dependency diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..5de41ee --- /dev/null +++ b/LICENSE @@ -0,0 +1,23 @@ +Copyright (c) 2013, Chris Travers +All rights reserved. + +Redistribution and use in source and binary forms, with or without modification, +are permitted provided that the following conditions are met: + +* Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +* Redistributions in binary form must reproduce the above copyright notice, this + list of conditions and the following disclaimer in the documentation and/or + other materials provided with the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON +ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/MANIFEST b/MANIFEST index a7e94a5..9d66730 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,9 +1,13 @@ Changes ignore.txt lib/PGObject/Simple/Role.pm +LICENSE Makefile.PL MANIFEST This list of files +MANIFEST.SKIP +MYMETA.json README +README.md t/00-load.t t/01-basic-constructor.t t/02-dbtests.t @@ -11,5 +15,6 @@ t/boilerplate.t t/manifest.t t/pod-coverage.t t/pod.t +TODO META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP new file mode 100644 index 0000000..4da46a8 --- /dev/null +++ b/MANIFEST.SKIP @@ -0,0 +1,45 @@ + +#!start included /usr/lib/perl5/5.10/ExtUtils/MANIFEST.SKIP +# Avoid version control files. +\B\.svn\b +\B\.hg\b +\B\.git\b +\B\.gitignore\b + +# Avoid Makemaker generated and utility files. +\bMANIFEST\.bak +\bMakefile$ +\bblib/ +\bMakeMaker-\d +\bpm_to_blib\.ts$ +\bpm_to_blib$ +\bblibdirs\.ts$ # 6.18 through 6.25 generated this + +# Avoid Module::Build generated and utility files. +\bBuild$ +\b_build/ + +# Avoid temp and backup files. +~$ +\.old$ +\#$ +\b\.# +\.bak$ + +# Avoid Devel::Cover files. +\bcover_db\b +#!end included /usr/lib/perl5/5.10/ExtUtils/MANIFEST.SKIP + +^extlib +^Su-.+\.tar\.gz$ +^work +^tmp +\bTAGS$ +^MYMETA.yml$ + +\bSu-[\d\.\_]+ + +\bt_util/ + +Debian_CPANTS.txt +\blib/Su/Procs/ diff --git a/META.json b/META.json index f92f704..686dda9 100644 --- a/META.json +++ b/META.json @@ -4,7 +4,7 @@ "Chris Travers, <chris.trav...@gmail.com>" ], "dynamic_config" : 1, - "generated_by" : "ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.120921", + "generated_by" : "ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120921", "license" : [ "perl_5" ], @@ -39,5 +39,5 @@ } }, "release_status" : "stable", - "version" : "0.11" + "version" : "1.01" } diff --git a/META.yml b/META.yml index c3b6bf4..840f138 100644 --- a/META.yml +++ b/META.yml @@ -7,7 +7,7 @@ build_requires: configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 -generated_by: 'ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.120921' +generated_by: 'ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120921' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html @@ -21,4 +21,4 @@ requires: Moo::Role: 0 PGObject::Simple: 0 Test::More: 0 -version: 0.11 +version: 1.01 diff --git a/META.json b/MYMETA.json similarity index 85% copy from META.json copy to MYMETA.json index f92f704..bc3c33f 100644 --- a/META.json +++ b/MYMETA.json @@ -3,8 +3,8 @@ "author" : [ "Chris Travers, <chris.trav...@gmail.com>" ], - "dynamic_config" : 1, - "generated_by" : "ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.120921", + "dynamic_config" : 0, + "generated_by" : "ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120921", "license" : [ "perl_5" ], @@ -39,5 +39,5 @@ } }, "release_status" : "stable", - "version" : "0.11" + "version" : "1.01" } diff --git a/Makefile.PL b/Makefile.PL old mode 100644 new mode 100755 diff --git a/README b/README old mode 100644 new mode 100755 index fb24b0c..e959a9d --- a/README +++ b/README @@ -1,7 +1,9 @@ PGObject-Simple-Role -PGObject::Simple::Role is a role implementation of the PGObject::Simple -functionality aimed at cases where the quick and dirty approach is not idea. +PGObject::Simple::Role is a Moo/Moose mapper for minimalist PGObject framework +(embodied in PGObject::Simple). Basically it provides a way to easily map +stored procedures using the conventions of PGObject::Simple for Moo/Moose +environments. PGObject::Simple::Role is a Moo role which allows you to use this functionality in Moo and Moose environments. The role itself makes no assumptions about @@ -45,11 +47,27 @@ You can also look for information at: LICENSE AND COPYRIGHT -Copyright (C) 2013 Chris Travers, - -This program is free software; you can redistribute it and/or modify it -under the terms of either: the GNU General Public License as published -by the Free Software Foundation; or the Artistic License. - -See http://dev.perl.org/licenses/ for more information. - +Copyright (C) 2013 Chris Travers + +Redistribution and use in source and compiled forms with or without +modification, are permitted provided that the following conditions are met: + +* Redistributions of source code (Perl) must retain the above + copyright notice, this list of conditions and the following disclaimer as the + first lines of this file unmodified. + +* Redistributions in compiled form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + source code, documentation, and/or other materials provided with the + distribution. + +THIS SOFTWARE IS PROVIDED BY THE AUTHOR(S) "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE AUTHOR(S) BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON +ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 index 0000000..e959a9d --- /dev/null +++ b/README.md @@ -0,0 +1,73 @@ +PGObject-Simple-Role + +PGObject::Simple::Role is a Moo/Moose mapper for minimalist PGObject framework +(embodied in PGObject::Simple). Basically it provides a way to easily map +stored procedures using the conventions of PGObject::Simple for Moo/Moose +environments. + +PGObject::Simple::Role is a Moo role which allows you to use this functionality +in Moo and Moose environments. The role itself makes no assumptions about +database state, but provides hooks for classes to use to retrieve or create +database handles for their use. + +This module is suited to quick and easy integration of PostgreSQL stored +procedures with Moo and Moose object models. It is quite powerful and it makes +developing in such environments relatively easy. + +INSTALLATION + +To install this module, run the following commands: + + perl Makefile.PL + make + make test + make install + +SUPPORT AND DOCUMENTATION + +After installing, you can find documentation for this module with the +perldoc command. + + perldoc PGObject::Simple::Role + +You can also look for information at: + + RT, CPAN's request tracker (report bugs here) + http://rt.cpan.org/NoAuth/Bugs.html?Dist=PGObject-Simple-Role + + AnnoCPAN, Annotated CPAN documentation + http://annocpan.org/dist/PGObject-Simple-Role + + CPAN Ratings + http://cpanratings.perl.org/d/PGObject-Simple-Role + + Search CPAN + http://search.cpan.org/dist/PGObject-Simple-Role/ + + +LICENSE AND COPYRIGHT + +Copyright (C) 2013 Chris Travers + +Redistribution and use in source and compiled forms with or without +modification, are permitted provided that the following conditions are met: + +* Redistributions of source code (Perl) must retain the above + copyright notice, this list of conditions and the following disclaimer as the + first lines of this file unmodified. + +* Redistributions in compiled form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + source code, documentation, and/or other materials provided with the + distribution. + +THIS SOFTWARE IS PROVIDED BY THE AUTHOR(S) "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE AUTHOR(S) BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON +ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/TODO b/TODO new file mode 100755 index 0000000..9b10477 --- /dev/null +++ b/TODO @@ -0,0 +1,3 @@ +TODO for 1.0: + +Done, just need more test cases diff --git a/ignore.txt b/ignore.txt old mode 100644 new mode 100755 diff --git a/lib/PGObject/Simple/Role.pm b/lib/PGObject/Simple/Role.pm index 20b371c..e4e41d2 100644 --- a/lib/PGObject/Simple/Role.pm +++ b/lib/PGObject/Simple/Role.pm @@ -13,11 +13,11 @@ PGObject::Simple::Role - Moo/Moose mappers for minimalist PGObject framework =head1 VERSION -Version 0.11 +Version 1.01 =cut -our $VERSION = '0.11'; +our $VERSION = '1.01'; =head1 SYNOPSIS @@ -25,6 +25,7 @@ our $VERSION = '0.11'; Take the following (Moose) class: package MyAPP::Foo; + use PGObject::Util::DBMethod; use Moose; with 'PGObject::Simple::Role'; @@ -36,6 +37,8 @@ Take the following (Moose) class: sub get_dbh { return DBI->connect('dbi:Pg:dbname=foobar'); } + # PGObject::Util::DBMethod exports this + dbmethod int => (funcname => 'foo_to_int'); And a stored procedure: @@ -51,8 +54,13 @@ Then the following Perl code would work to invoke it: my $foobar = MyApp->foo(id => 3, foo => 'foo', bar => 'baz', baz => 33); $foobar->call_dbmethod(funcname => 'foo_to_int'); +The following will also work since you have the dbmethod call above: + + my $int = $foobar->int; + The full interface of call_dbmethod and call_procedure from PGObject::Simple are -supported. +supported, and call_dbmethod is effectively wrapped by dbmethod(), allowing a +declarative mapping. =head1 DESCRIPTION @@ -64,7 +72,7 @@ supported. # Private attribute for database handle, not intended to be directly set. -has _PGObject_DBH => ( +has _DBH => ( is => 'lazy', isa => sub { croak "Expected a database handle. Got $_[0] instead" @@ -72,21 +80,54 @@ has _PGObject_DBH => ( }, ); -sub _build__PGObject_DBH { +sub _build__DBH { my ($self) = @_; return $self->_get_dbh; } -has _PGObject_FuncPrefix => (is => 'lazy'); +has _Registry => (is => 'lazy'); + +sub _build__Registry { + return _get_registry(); +} + +=head2 _get_registry + +This is a method the consuming classes can override in order to set the +registry of the calls for type mapping purposes. + +=cut + +sub _get_registry{ + return undef; +} + +has _funcschema => (is => 'lazy'); + +=head2 _get_schema + +Returns the default schema associated with the object. + +=cut + +sub _build__funcschema { + return $_[0]->_get_schema; +} + +sub _get_schema { + return undef; +} -=head1 _get_prefix +has _funcprefix => (is => 'lazy'); + +=head2 _get_prefix Returns string, default is an empty string, used to set a prefix for mapping stored prcedures to an object class. =cut -sub _build__PGObject_FuncPrefix { +sub _build__funcprefix { return $_[0]->_get_prefix; } @@ -99,7 +140,19 @@ has _PGObject_Simple => ( ); sub _build__PGObject_Simple { - return PGObject::Simple->new(); + my ($self) = @_; + return PGObject::Simple->new() unless ref $self; + $self->_DBH; + $self->_funcprefix; + my $obj = PGObject::Simple->new(%$self); + $obj->_set_registry($self->_registry); + return $obj; +} + +has _registry => ( is => 'lazy' ); + +sub _build__registry { + return _get_registry(); } =head2 _get_dbh @@ -116,36 +169,110 @@ sub _get_dbh { =head2 call_procedure -Identical interface to PGObject::Simple->call_procedure +Identical interface to PGObject::Simple->call_procedure. + +This can be used on objects or on the packages themselves. I.e. +mypackage->call_procedure() and $myobject->call_procedure() both work. =cut sub call_procedure { my $self = shift @_; my %args = @_; - $args{dbh} ||= $self->_PGObject_DBH; - $args{funcprefix} = $self->_PGObject_FuncPrefix - if not defined $args{funcprefix}; - return $self->_PGObject_Simple->call_procedure(%args); + my $obj = _build__PGObject_Simple($self); + $obj->{_DBH} = $self->_DBH if ref $self and !$args{dbh}; + $obj->{_DBH} = "$self"->_get_dbh unless ref $self or $args{dbh}; + if (ref $self){ + $args{funcprefix} = $self->_funcprefix + unless defined $args{funcprefix} or !ref $self; + $args{funcschema} = $self->_funcschema + unless defined $args{funcschema} or !ref $self; + } else { + $args{funcprefix} = "$self"->_get_prefix + unless defined $args{funcprefix} or ref $self; + $args{funcschema} = "$self"->_get_schema + unless defined $args{funcschema} or ref $self; + } + my @rows = $obj->call_procedure(%args); + return @rows if wantarray; + return shift @rows; } =head2 call_dbmethod Identical interface to PGObject::Simple->call_dbmethod +This can be used on objects or on the packages themselves. I.e. +mypackage->call_dbmethod() and $myobject->call_dbmethod() both work. + =cut sub call_dbmethod { my $self = shift @_; my %args = @_; - $args{dbh} ||= $self->_PGObject_DBH; - $args{funcprefix} = $self->_PGObject_FuncPrefix - if not defined $args{funcprefix}; - for my $key(keys %$self){ - $args{args}->{$key} = $self->{$key} unless defined $args{args}->{$key}; + croak 'No function name provided' unless $args{funcname}; + + $args{dbh} = $self->_DBH if ref $self and !$args{dbh}; + $args{dbh} = "$self"->_get_dbh() unless $args{dbh}; + if (ref $self){ + $args{funcprefix} = $self->_funcprefix unless defined $args{funcprefix}; + $args{funcschema} = $self->_funcschema unless $args{funcschema}; + } else { + $args{funcprefix} = "$self"->_get_prefix + unless defined $args{funcprefix}; + $args{funcschema} = "$self"->_get_schema unless $args{funcschema}; } - return $self->_PGObject_Simple->call_dbmethod(%args); -} + $args{funcprefix} ||= ''; + + my $info = PGObject->function_info(%args); + + my $dbargs = []; + for my $arg (@{$info->{args}}){ + $arg->{name} =~ s/^in_//; + my $db_arg; + eval { $db_arg = $self->can($arg->{name})->($self) } if ref $self; + if ($args{args}->{$arg->{name}}){ + $db_arg = $args{args}->{$arg->{name}}; + } + if (eval {$db_arg->can('to_db')}){ + $db_arg = $db_arg->to_db; + } + if ($arg->{type} eq 'bytea'){ + $db_arg = { type => 'bytea', value => $db_arg}; + } + push @$dbargs, $db_arg; + } + $args{args} = $dbargs; + my @rows; + if (ref $self){ + @rows = $self->call_procedure(%args); + } else { + @rows = "$self"->call_procedure(%args); + } + return @rows if wantarray; + return shift @rows; +} + +=head1 REMOVED METHODS + +These methods were once part of this package but have been removed due to +the philosophy of not adding framework dependencies when an application +dependency can work just as well. + +=head2 dbmethod + +Included in versions 0.50 - 0.71. + +Instead of using this directly, use: + + use PGObject::Util::DBMethod; + +instead. Ideally this should be done in your actual class since that will +allow you to dispense with the extra parentheses. However, if you need a +backwards-compatible and central solution, since PGObject::Simple::Role +generally assumes sub-roles will be created for managing db connections etc. +you can put the use statement there and it will have the same impact as it did +here when it was removed with the benefit of better testing. =head1 AUTHOR diff --git a/t/01-basic-constructor.t b/t/01-basic-constructor.t index 34bf6f3..cde134f 100644 --- a/t/01-basic-constructor.t +++ b/t/01-basic-constructor.t @@ -45,9 +45,9 @@ is($obj->foo, 'test1', 'attribute foo passed'); is($obj->bar, 'test2', 'attribute bar passed'); is($obj->baz, 33, 'attribute baz passed'); ok(!defined($obj->can('biz')), 'No dbh method exists'); -throws_ok {$obj->_build__PGObject_DBH(1)} qr/Subclasses MUST set/, +throws_ok {$obj->_build__DBH(1)} qr/Subclasses MUST set/, 'Threw exception, "Subclasses MUST set"'; lives_ok {$obj = test2->new(%args)} 'created new object without crashing'; -throws_ok {$obj->_PGObject_DBH} qr/Expected a database handle/, +throws_ok {$obj->_DBH} qr/Expected a database handle/, 'Threw exception, "Expected a database handle"'; diff --git a/t/02-dbtests.t b/t/02-dbtests.t index 2a1170d..1313e9a 100644 --- a/t/02-dbtests.t +++ b/t/02-dbtests.t @@ -7,11 +7,17 @@ has id => (is => 'ro'); has foo => (is => 'ro'); has bar => (is => 'ro'); has baz => (is => 'ro'); +has id2 => (is => 'lazy'); + +sub _build_id2 { + return 10; +} sub _get_dbh { return $main::dbh; } + package test2; use Moo; @@ -36,8 +42,9 @@ package main; use Test::More; use Test::Exception; use DBI; +use PGObject::Simple; - +plan skip_all => 'DB_TESTING not set' unless $ENV{DB_TESTING}; # Initial setup my $dbh1 = DBI->connect('dbi:Pg:', 'postgres'); @@ -47,11 +54,10 @@ plan skip_all => 'Needs superuser connection for this test script' unless $dbh1; $dbh1->do('CREATE DATABASE pgobject_test_db'); - our $dbh = DBI->connect('dbi:Pg:dbname=pgobject_test_db', 'postgres'); plan skip_all => 'No db connection' unless $dbh; -plan tests => 8; +plan tests => 17; $dbh->do(' CREATE FUNCTION public.foobar (in_foo text, in_bar text, in_baz int, in_id int) @@ -59,14 +65,50 @@ $dbh->do(' SELECT char_length($1) + char_length($2) + $3 * $4; $$; ') ; +$dbh->do('CREATE SCHEMA TEST'); +$dbh->do(' + CREATE FUNCTION test.foobar (in_foo text, in_bar text, in_baz int, in_id int) + RETURNS int language sql as $$ + SELECT 2*(char_length($1) + char_length($2) + $3 * $4); + $$; +') ; +$dbh->do(' + CREATE FUNCTION public.lazy_foobar (in_foo text, in_bar text, in_baz int, in_id2 int) + RETURNS int language sql as $$ + SELECT char_length($1) + char_length($2) + $3 * $4; + $$; +') ; +my ($result) = test->call_dbmethod( + funcname => 'foobar', + args => {id => 3, foo => 'test1', bar => 'test2', baz => 33}, +); +is($result->{foobar}, 109, 'Correct Result, direct package call to call_dbmethod'); my $obj = test->new(id => 3, foo => 'test1', bar => 'test2', baz => 33); -my ($result) = $obj->call_dbmethod(funcname => 'foobar'); +($result) = $obj->call_dbmethod(funcname => 'foobar'); is($result->{foobar}, 109, 'Correct Result, no argument overrides'); +$result = $obj->call_dbmethod(funcname => 'lazy_foobar'); +is($result->{lazy_foobar}, 340, 'Correct handling of lazy attributes'); ($result) = $obj->call_procedure(funcname => 'foobar', args => ['test1', 'testing', '3', '33']); is($result->{foobar}, 111, 'Correct result, call_procedure'); +($result) = $obj->call_procedure(funcname => 'foobar', + funcschema => 'test', + args => ['test1', 'testing', '3', '33']); +is($result->{foobar}, 222, 'Correct result, call_procedure'); +($result) = test->call_procedure(funcname => 'foobar', + args => ['test1', 'testing', '3', '33']); +is($result->{foobar}, 111, 'Correct result, direct package call to call_procedure'); + +$result = $obj->call_dbmethod(funcname => 'foobar'); +is(ref $result, ref {}, 'Correct result type, scalar return, no arg overrides'); +is($result->{foobar}, 109, 'Correct Result, no argument overrides, scalar return'); +$result = test->call_procedure(funcname => 'foobar', + args => ['test1', 'testing', '3', '33']); +is($result->{foobar}, 111, 'Correct result, direct package call to call_procedure, scalar return'); + + ($result) = $obj->call_dbmethod(funcname => 'foobar', args=> {baz => 1}); is($result->{foobar}, 13, 'Correct result, argument overrides'); @@ -83,6 +125,16 @@ is($result->{foobar}, 111, 'Correct result, call_procedure'); ($result) = $obj->call_dbmethod(funcname => 'bar', args=> {baz => 1}); is($result->{foobar}, 13, 'Correct result, argument overrides'); + +$obj->{_funcschema} = 'test'; +($result) = $obj->call_procedure(funcname => 'bar', + args => ['test1', 'testing', '3', '33']); + +is($result->{foobar}, 222, 'Correct result, call_procedure, set schema'); + +($result) = $obj->call_dbmethod(funcname => 'bar', args=> {baz => 1}); +is($result->{foobar}, 26, 'Correct result, argument overrides'); + throws_ok{$obj->call_dbmethod(funcname => 'bar', dbh => $dbh1)} qr/No such function/, 'No such function thrown using wrong db'; # Teardown connections -- Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libpgobject-simple-role-perl.git _______________________________________________ Pkg-perl-cvs-commits mailing list Pkg-perl-cvs-commits@lists.alioth.debian.org http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits