diff -Nru libmojo-pg-perl-4.03/Changes libmojo-pg-perl-4.04/Changes --- libmojo-pg-perl-4.03/Changes 2017-11-04 17:01:39.000000000 +0000 +++ libmojo-pg-perl-4.04/Changes 2017-12-16 15:24:58.000000000 +0000 @@ -1,4 +1,9 @@ +4.04 2017-12-16 + - Added db attribute to Mojo::Pg::Results. + - Added sql_for method to Mojo::Pg::Migrations. + - Fixed a bug that could cause connections to be cached for reuse too early. + 4.03 2017-11-04 - Improved Mojo::Pg::Database to use Mojo::Promise. diff -Nru libmojo-pg-perl-4.03/debian/changelog libmojo-pg-perl-4.04/debian/changelog --- libmojo-pg-perl-4.03/debian/changelog 2017-11-30 20:31:52.000000000 +0000 +++ libmojo-pg-perl-4.04/debian/changelog 2017-12-21 20:44:08.000000000 +0000 @@ -1,3 +1,13 @@ +libmojo-pg-perl (4.04-1) unstable; urgency=medium + + [ Damyan Ivanov ] + * declare conformance with Policy 4.1.2 (no changes needed) + + [ Nick Morrott ] + * New upstream version 4.04 + + -- Nick Morrott Thu, 21 Dec 2017 20:44:08 +0000 + libmojo-pg-perl (4.03-1) unstable; urgency=medium * New upstream version 4.03 diff -Nru libmojo-pg-perl-4.03/debian/control libmojo-pg-perl-4.04/debian/control --- libmojo-pg-perl-4.03/debian/control 2017-11-30 20:31:52.000000000 +0000 +++ libmojo-pg-perl-4.04/debian/control 2017-12-21 20:44:08.000000000 +0000 @@ -9,7 +9,7 @@ libmojolicious-perl (>= 7.53), libsql-abstract-perl (>= 1.81), perl -Standards-Version: 4.1.1 +Standards-Version: 4.1.2 Vcs-Browser: https://anonscm.debian.org/cgit/pkg-perl/packages/libmojo-pg-perl.git Vcs-Git: https://anonscm.debian.org/git/pkg-perl/packages/libmojo-pg-perl.git Homepage: https://metacpan.org/release/Mojo-Pg diff -Nru libmojo-pg-perl-4.03/lib/Mojo/Pg/Database.pm libmojo-pg-perl-4.04/lib/Mojo/Pg/Database.pm --- libmojo-pg-perl-4.03/lib/Mojo/Pg/Database.pm 2017-11-04 15:21:36.000000000 +0000 +++ libmojo-pg-perl-4.04/lib/Mojo/Pg/Database.pm 2017-12-16 15:23:31.000000000 +0000 @@ -106,7 +106,7 @@ # Blocking unless ($cb) { $self->_notifications; - return $self->results_class->new(sth => $sth); + return $self->results_class->new(db => $self, sth => $sth); } # Non-blocking @@ -172,7 +172,7 @@ my $result = do { local $dbh->{RaiseError} = 0; $dbh->pg_result }; my $err = defined $result ? undef : $dbh->errstr; - $self->$cb($err, $self->results_class->new(sth => $sth)); + $self->$cb($err, $self->results_class->new(db => $self, sth => $sth)); $self->_unwatch unless $self->{waiting} || $self->is_listening; } )->watch($self->{handle}, 1, 0); @@ -308,7 +308,7 @@ my $promise = $db->delete_p($table, \%where, \%options); Same as L, but performs all operations non-blocking and returns a -L object to be used as a promise instead of accepting a callback. +L object instead of accepting a callback. $db->delete_p('some_table')->then(sub { my $results = shift; @@ -369,7 +369,7 @@ my $promise = $db->insert_p($table, \@values || \%fieldvals, \%options); Same as L, but performs all operations non-blocking and returns a -L object to be used as a promise instead of accepting a callback. +L object instead of accepting a callback. $db->insert_p(some_table => {foo => 'bar'})->then(sub { my $results = shift; @@ -451,7 +451,7 @@ my $promise = $db->query_p('select * from foo'); Same as L, but performs all operations non-blocking and returns a -L object to be used as a promise instead of accepting a callback. +L object instead of accepting a callback. $db->query_p('insert into foo values (?, ?, ?)' => @values)->then(sub { my $results = shift; @@ -498,7 +498,7 @@ my $promise = $db->select_p($source, $fields, $where, $order); Same as L, but performs all operations non-blocking and returns a -L object to be used as a promise instead of accepting a callback. +L object instead of accepting a callback. $db->select_p(some_table => ['foo'] => {bar => 'yada'})->then(sub { my $results = shift; @@ -559,7 +559,7 @@ my $promise = $db->update_p($table, \%fieldvals, \%where, \%options); Same as L, but performs all operations non-blocking and returns a -L object to be used as a promise instead of accepting a +L object instead of accepting a callback. $db->update_p(some_table => {foo => 'baz'} => {foo => 'bar'})->then(sub { diff -Nru libmojo-pg-perl-4.03/lib/Mojo/Pg/Migrations.pm libmojo-pg-perl-4.04/lib/Mojo/Pg/Migrations.pm --- libmojo-pg-perl-4.03/lib/Mojo/Pg/Migrations.pm 2017-06-24 13:01:30.000000000 +0000 +++ libmojo-pg-perl-4.04/lib/Mojo/Pg/Migrations.pm 2017-12-14 18:43:41.000000000 +0000 @@ -60,19 +60,7 @@ croak "Active version $active is greater than the latest version $latest" if $active > $latest; - # Up - my $sql; - if ($active < $target) { - my @up = grep { $_ <= $target && $_ > $active } keys %$up; - $sql = join '', @$up{sort { $a <=> $b } @up}; - } - - # Down - else { - my @down = grep { $_ > $target && $_ <= $active } keys %$down; - $sql = join '', @$down{reverse sort { $a <=> $b } @down}; - } - + my $sql = $self->sql_for($active, $target); warn "-- Migrate ($active -> $target)\n$sql\n" if DEBUG; $sql .= ';update mojo_migrations set version = $1 where name = $2;'; $db->query($sql, $target, $self->name) and $tx->commit; @@ -80,6 +68,21 @@ return $self; } +sub sql_for { + my ($self, $from, $to) = @_; + + # Up + my ($up, $down) = @{$self->{migrations}}{qw(up down)}; + if ($from < $to) { + my @up = grep { $_ <= $to && $_ > $from } keys %$up; + return join '', @$up{sort { $a <=> $b } @up}; + } + + # Down + my @down = grep { $_ > $to && $_ <= $from } keys %$down; + return join '', @$down{reverse sort { $a <=> $b } @down}; +} + sub _active { my ($self, $db, $create) = @_; @@ -225,6 +228,12 @@ # Reset database $migrations->migrate(0)->migrate; +=head2 sql_for + + my $sql = $migrations->sql_for(5, 10); + +Get SQL to migrate from one version to another, up or down. + =head1 DEBUGGING You can set the C environment variable to get some diff -Nru libmojo-pg-perl-4.03/lib/Mojo/Pg/Results.pm libmojo-pg-perl-4.04/lib/Mojo/Pg/Results.pm --- libmojo-pg-perl-4.03/lib/Mojo/Pg/Results.pm 2017-07-23 13:57:01.000000000 +0000 +++ libmojo-pg-perl-4.04/lib/Mojo/Pg/Results.pm 2017-12-17 18:00:44.000000000 +0000 @@ -5,7 +5,7 @@ use Mojo::JSON 'from_json'; use Mojo::Util 'tablify'; -has 'sth'; +has [qw(db sth)]; sub DESTROY { my $self = shift; @@ -86,6 +86,13 @@ L implements the following attributes. +=head2 db + + my $db = $results->db; + $results = $results->db(Mojo::Pg::Database->new); + +L object these results belong to. + =head2 sth my $sth = $results->sth; diff -Nru libmojo-pg-perl-4.03/lib/Mojo/Pg.pm libmojo-pg-perl-4.04/lib/Mojo/Pg.pm --- libmojo-pg-perl-4.03/lib/Mojo/Pg.pm 2017-11-04 17:03:27.000000000 +0000 +++ libmojo-pg-perl-4.04/lib/Mojo/Pg.pm 2017-12-14 18:43:41.000000000 +0000 @@ -38,7 +38,7 @@ return $pubsub; }; -our $VERSION = '4.03'; +our $VERSION = '4.04'; sub db { $_[0]->database_class->new(dbh => $_[0]->_prepare, pg => $_[0]) } @@ -219,6 +219,8 @@ database schema with migrations and build scalable real-time web applications with the publish/subscribe pattern. +=head1 BASICS + Database and statement handles are cached automatically, and will be reused transparently to increase performance. You can handle connection timeouts gracefully by holding on to them only for short amounts of time. diff -Nru libmojo-pg-perl-4.03/META.json libmojo-pg-perl-4.04/META.json --- libmojo-pg-perl-4.03/META.json 2017-11-04 17:04:41.000000000 +0000 +++ libmojo-pg-perl-4.04/META.json 2017-12-17 18:00:55.000000000 +0000 @@ -57,6 +57,6 @@ }, "x_IRC" : "irc://irc.perl.org/#mojo" }, - "version" : "4.03", - "x_serialization_backend" : "JSON::PP version 2.94" + "version" : "4.04", + "x_serialization_backend" : "JSON::PP version 2.97000" } diff -Nru libmojo-pg-perl-4.03/META.yml libmojo-pg-perl-4.04/META.yml --- libmojo-pg-perl-4.03/META.yml 2017-11-04 17:04:41.000000000 +0000 +++ libmojo-pg-perl-4.04/META.yml 2017-12-17 18:00:55.000000000 +0000 @@ -30,5 +30,5 @@ homepage: http://mojolicious.org license: http://www.opensource.org/licenses/artistic-license-2.0 repository: https://github.com/kraih/mojo-pg.git -version: '4.03' +version: '4.04' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' diff -Nru libmojo-pg-perl-4.03/t/database.t libmojo-pg-perl-4.04/t/database.t --- libmojo-pg-perl-4.03/t/database.t 2017-11-02 18:31:37.000000000 +0000 +++ libmojo-pg-perl-4.04/t/database.t 2017-12-16 15:37:38.000000000 +0000 @@ -27,16 +27,19 @@ # Non-blocking select my ($fail, $result); +my $same; my $db = $pg->db; $db->query( 'select 1 as one, 2 as two, 3 as three' => sub { my ($db, $err, $results) = @_; $fail = $err; $result = $results->hash; + $same = $db->dbh eq $results->db->dbh; Mojo::IOLoop->stop; } ); Mojo::IOLoop->start; +ok $same, 'same database handles'; ok !$fail, 'no error'; is_deeply $result, {one => 1, two => 2, three => 3}, 'right structure'; @@ -121,6 +124,20 @@ isnt $db->query('select 6 as six')->sth, $sth, 'different statement handles'; is $db->query('select 3 as three')->sth, $sth, 'same statement handle'; +# Connection reuse +$db = $pg->db; +$dbh = $db->dbh; +$results = $db->query('select 1'); +undef $db; +my $db2 = $pg->db; +isnt $db2->dbh, $dbh, 'new database handle'; +undef $results; +my $db3 = $pg->db; +is $db3->dbh, $dbh, 'same database handle'; +$results = $db3->query('select 2'); +is $results->db->dbh, $dbh, 'same database handle'; +is $results->array->[0], 2, 'right result'; + # Dollar only $db = $pg->db; is $db->dollar_only->query('select $1::int as test', 23)->hash->{test}, 23, @@ -199,7 +216,7 @@ $db = $pg->db; ok !$db->is_listening, 'not listening'; ok $db->listen('dbtest')->is_listening, 'listening'; -my $db2 = $pg->db->listen('dbtest'); +$db2 = $pg->db->listen('dbtest'); my @notifications; Mojo::IOLoop->delay( sub { diff -Nru libmojo-pg-perl-4.03/t/migrations.t libmojo-pg-perl-4.04/t/migrations.t --- libmojo-pg-perl-4.03/t/migrations.t 2017-07-06 21:36:56.000000000 +0000 +++ libmojo-pg-perl-4.04/t/migrations.t 2017-12-06 21:47:28.000000000 +0000 @@ -125,6 +125,22 @@ is_deeply $pg3->db->query('select * from migration_test_six')->hashes, [], 'right structure'; is $pg3->migrations->migrate(0)->active, 0, 'active version is 0'; +is $pg3->migrations->sql_for(0, 5), <migrations->sql_for(6, 0), <migrations->sql_for(6, 5), <migrations->sql_for(6, 6), '', 'right SQL'; +is $pg3->migrations->sql_for(2, 3), '', 'right SQL'; # Migrate automatically with shared connection cache my $pg4