[libpgobject-simple-perl] 01/03: New upstream version 3.000002
Robert James Clay
jame at rocasa.us
Fri Jun 23 18:25:25 UTC 2017
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 <jame at rocasa.us>
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 <chris.travers at gmail.com>"
],
"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 <chris.travers at gmail.com>'
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 <chris.travers at gmail.com>"
- ],
- "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
More information about the Pkg-perl-cvs-commits
mailing list