[libpgobject-simple-perl] 01/04: Imported Upstream version 1.6
Robert James Clay
jame at rocasa.us
Tue Apr 15 02:14:00 UTC 2014
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 682e95c2ed6100c03d1bd3b3ae2f64033a5ebec3
Author: Robert James Clay <jame at rocasa.us>
Date: Mon Apr 14 21:47:43 2014 -0400
Imported Upstream version 1.6
---
Changes | 14 +++++++++++
LICENSE | 23 +++++++++++++++++++
MANIFEST | 4 ++++
MANIFEST.SKIP | 45 ++++++++++++++++++++++++++++++++++++
META.json | 11 ++++-----
META.yml | 9 ++++----
META.json => MYMETA.json | 13 +++++------
Makefile.PL | 4 +++-
README.md | 60 ++++++++++++++++++++++++++++++++++++++++++++++++
ignore.txt | 1 +
lib/PGObject/Simple.pm | 55 ++++++++++++++++++++++++++++++++++----------
t/02-call_procedure.t | 37 ++++++++++++++++++++++++++---
12 files changed, 242 insertions(+), 34 deletions(-)
diff --git a/Changes b/Changes
index 964fe8f..c8b3253 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,19 @@
Revision history for PGObject-Simple
+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.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/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 6b7d695..f2c26f3 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1,9 +1,13 @@
Changes
ignore.txt
lib/PGObject/Simple.pm
+LICENSE
Makefile.PL
MANIFEST This list of files
+MANIFEST.SKIP
+MYMETA.json
README
+README.md
t/00-load.t
t/01-constructor.t
t/02-call_procedure.t
diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP
new file mode 100644
index 0000000..f509077
--- /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\.git\b
+\B\.gitignore\b
+\B\.hg\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 70126f5..126a018 100644
--- a/META.json
+++ b/META.json
@@ -4,9 +4,9 @@
"Chris Travers <chris.travers at 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"
+ "bsd"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
@@ -22,7 +22,7 @@
"prereqs" : {
"build" : {
"requires" : {
- "ExtUtils::MakeMaker" : "0"
+ "Test::More" : "0"
}
},
"configure" : {
@@ -32,11 +32,10 @@
},
"runtime" : {
"requires" : {
- "PGObject" : "1.1",
- "Test::More" : "0"
+ "PGObject" : "1.1"
}
}
},
"release_status" : "stable",
- "version" : "1.3"
+ "version" : "1.6"
}
diff --git a/META.yml b/META.yml
index 9a21a4f..9bfc7f4 100644
--- a/META.yml
+++ b/META.yml
@@ -3,12 +3,12 @@ abstract: "Minimalist stored procedure mapper based on LedgerSMB's DBObject"
author:
- 'Chris Travers <chris.travers at gmail.com>'
build_requires:
- ExtUtils::MakeMaker: 0
+ Test::More: 0
configure_requires:
ExtUtils::MakeMaker: 0
dynamic_config: 1
-generated_by: 'ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.120921'
-license: perl
+generated_by: 'ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120921'
+license: bsd
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
@@ -19,5 +19,4 @@ no_index:
- inc
requires:
PGObject: 1.1
- Test::More: 0
-version: 1.3
+version: 1.6
diff --git a/META.json b/MYMETA.json
similarity index 75%
copy from META.json
copy to MYMETA.json
index 70126f5..0b1b82a 100644
--- a/META.json
+++ b/MYMETA.json
@@ -3,10 +3,10 @@
"author" : [
"Chris Travers <chris.travers at 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"
+ "bsd"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
@@ -22,7 +22,7 @@
"prereqs" : {
"build" : {
"requires" : {
- "ExtUtils::MakeMaker" : "0"
+ "Test::More" : "0"
}
},
"configure" : {
@@ -32,11 +32,10 @@
},
"runtime" : {
"requires" : {
- "PGObject" : "1.1",
- "Test::More" : "0"
+ "PGObject" : "1.1"
}
}
},
"release_status" : "stable",
- "version" : "1.3"
+ "version" : "1.6"
}
diff --git a/Makefile.PL b/Makefile.PL
index 6508acd..d51c863 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -9,11 +9,13 @@ WriteMakefile(
VERSION_FROM => 'lib/PGObject/Simple.pm',
ABSTRACT_FROM => 'lib/PGObject/Simple.pm',
($ExtUtils::MakeMaker::VERSION >= 6.3002
- ? ('LICENSE'=> 'perl')
+ ? ('LICENSE'=> 'BSD')
: ()),
PL_FILES => {},
PREREQ_PM => {
'PGObject' => 1.1,
+ },
+ BUILD_REQUIRES => {
'Test::More' => 0,
},
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..566ae5f
--- /dev/null
+++ b/README.md
@@ -0,0 +1,60 @@
+PGObject-Simple
+
+PBObject::Simple is a minimalist framework for mapping stored procedures in
+PostgreSQL to object methods. The framework is truly minimalist and hence the
+"Simple" designation (in fact the module contains less than 50 lines of code,
+and the code is dwarfed by both POD and test cases).
+It is intended to be of use for developers wishing for such a minimalist
+framework and those who may want to have a reference for how to build such a
+mapping framework themselves.
+
+The framework lends itself to a few specific antipatterns. Objects can become
+ill-formed, overly nebulous, or the like. It is thus very important when using
+this for actual development to ensure that acceptable data structures are well
+documented and that these are adhered to.
+
+This module is based on a simple idea, namely that stored procedures can tell
+application classes how to call them. See the POD for specific information and
+guidelines.
+
+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
+
+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
+
+ AnnoCPAN, Annotated CPAN documentation
+ http://annocpan.org/dist/PGObject-Simple
+
+ CPAN Ratings
+ http://cpanratings.perl.org/d/PGObject-Simple
+
+ Search CPAN
+ http://search.cpan.org/dist/PGObject-Simple/
+
+
+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.
+
diff --git a/ignore.txt b/ignore.txt
index fffd222..bd1ad6f 100644
--- a/ignore.txt
+++ b/ignore.txt
@@ -10,3 +10,4 @@ pm_to_blib*
cover_db
pod2htm*.tmp
PGObject-Simple-*
+.git*
diff --git a/lib/PGObject/Simple.pm b/lib/PGObject/Simple.pm
index c575e95..b5c51fb 100644
--- a/lib/PGObject/Simple.pm
+++ b/lib/PGObject/Simple.pm
@@ -12,11 +12,11 @@ PGObject::Simple - Minimalist stored procedure mapper based on LedgerSMB's DBObj
=head1 VERSION
-Version 1.3
+Version 1.6
=cut
-our $VERSION = '1.3';
+our $VERSION = '1.6';
=head1 SYNOPSIS
@@ -133,6 +133,19 @@ sub _set_funcprefix {
$self->{_func_prefix} = $funcprefix;
}
+=head2 _set_funcschema
+
+This sets the default funcschema for future calls. This is overwridden by
+per-call arguments, (PGObject::Util::DBMethod provides for such overrides on a
+per-method basis).
+
+=cut
+
+sub _set_funcschema {
+ my ($self, $funcschema) = @_;
+ $self->{_func_schema} = $funcschema;
+}
+
=head2 _set_registry
This sets the registry for future calls. The idea here is that this allows for
@@ -155,24 +168,30 @@ object property. The $args{args} hashref can be used to override arguments by
name. Unknown properties are handled simply by passing a NULL in, so the
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.
+
=cut
sub call_dbmethod {
my ($self) = shift @_;
my %args = @_;
croak 'No function name provided' unless $args{funcname};
- $args{dbh} = $self->{_DBH} if $self->{_DBH} and !$args{dbh};
+ 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{funcprefix} = $self->{_func_prefix} if !defined $args{funcprefix};
+ $args{funcschema} = $self->{_func_schema} if !defined $args{funcschema};
+ }
$args{funcprefix} ||= '';
my $info = PGObject->function_info(%args);
my $dbargs = [];
for my $arg (@{$info->{args}}){
$arg->{name} =~ s/^in_//;
- my $db_arg = $self->{$arg->{name}};
+ my $db_arg = $self->{$arg->{name}} if ref $self;
if ($args{args}->{$arg->{name}}){
- $db_arg = $args{args}->{$arg->{name}};
+ $db_arg = $args{args}->{$arg->{name}};
}
if (eval {$db_arg->can('to_db')}){
$db_arg = $db_arg->to_db;
@@ -183,7 +202,10 @@ sub call_dbmethod {
push @$dbargs, $db_arg;
}
$args{args} = $dbargs;
- return $self->call_procedure(%args);
+ # The conditional return is necessary since the object may carry a registry
+ # --CT
+ return $self->call_procedure(%args) if ref $self;
+ return __PACKAGE__->call_procedure(%args);
}
=head2 call_procedure
@@ -193,19 +215,28 @@ passes the currently attached db connection in. We use the previously set
funcprefix and dbh by default but other values can be passed in to override the
default object's values.
+This returns a single hashref when called in a scalar context, and a list of
+hashrefs when called in a list context. When called in a scalar context it
+simply returns the single first row returned.
+
=cut
sub call_procedure {
my ($self) = shift @_;
my %args = @_;
- $args{funcprefix} = $self->{_func_prefix} if !defined $args{funcprefix};
- $args{funcprefix} ||= '';
- $args{registry} = $self->{_registry} if !defined $args{registry};
+ 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{dbh} = $self->{_DBH} if $self->{_DBH} and !$args{dbh};
+ }
+ $args{funcprefix} ||= '';
croak 'No DB handle provided' unless $args{dbh};
- PGObject->call_procedure(%args);
+ my @rows = PGObject->call_procedure(%args);
+ return shift @rows unless wantarray;
+ return @rows;
}
=head1 WRITING CLASSES WITH PGObject::Simple
diff --git a/t/02-call_procedure.t b/t/02-call_procedure.t
index 0c72495..e47da4a 100644
--- a/t/02-call_procedure.t
+++ b/t/02-call_procedure.t
@@ -9,8 +9,8 @@ my %hash = (
id => '33',
);
-plan skip_all => 'Not set up for db tests' unless $ENV{TEST_DB};
-plan tests => 6;
+plan skip_all => 'Not set up for db tests' unless $ENV{DB_TESTING};
+plan tests => 9;
my $dbh1 = DBI->connect('dbi:Pg:dbname=postgres', 'postgres');
$dbh1->do('CREATE DATABASE pgobject_test_db') if $dbh1;
@@ -23,10 +23,19 @@ $dbh->do('
$$;
') if $dbh;
+$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);
+ $$;
+') if $dbh;
+
my $answer = 72;
SKIP: {
- skip 'No database connection', 6 unless $dbh;
+ skip 'No database connection', 8 unless $dbh;
my $obj = PGObject::Simple->new(%hash);
$obj->set_dbh($dbh);
my ($ref) = $obj->call_procedure(
@@ -35,6 +44,14 @@ SKIP: {
);
is ($ref->{foobar}, 159, 'Correct value returned, call_procedure');
+ ($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');
+
+
($ref) = $obj->call_procedure(
funcname => 'foobar',
funcschema => 'public',
@@ -48,6 +65,13 @@ SKIP: {
);
is ($ref->{foobar}, $answer, 'Correct value returned, call_dbmethod');
+ ($ref) = PGObject::Simple->call_dbmethod(
+ funcname => 'foobar',
+ args => \%hash,
+ dbh => $dbh,
+ );
+ is ($ref->{foobar}, $answer, 'Correct value returned, call_dbmethod');
+
($ref) = $obj->call_dbmethod(
funcname => 'foobar',
@@ -68,6 +92,13 @@ SKIP: {
);
is ($ref->{foobar}, 14, 'Correct value returned, call_dbmethod w/exp. pre.');
+ $obj->_set_funcschema('test');
+ $obj->_set_funcprefix('');
+ ($ref) = $obj->call_dbmethod(
+ funcname => 'foobar'
+ );
+
+ is ($ref->{foobar}, $answer * 2, 'Correct value returned, call_dbmethod');
}
$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
More information about the Pkg-perl-cvs-commits
mailing list