Mojo-Pg-2.35/000755 000765 000024 00000000000 13035370163 012654 5ustar00sristaff000000 000000 Mojo-Pg-2.35/Changes000644 000765 000024 00000015507 13035370104 014152 0ustar00sristaff000000 000000 2.35 2017-01-11 - Updated for Mojolicious 7.15. 2.34 2017-01-02 - Removed with_temp_schema method from Mojo::Pg. 2.33 2017-01-01 - Fixed a few fork-safety bugs in Mojo::Pg. 2.32 2017-01-01 - Added with_temp_schema method to Mojo::Pg. 2.31 2016-10-09 - Improved from_string method in Mojo::Pg to accept the "postgres://" scheme as well. (polettix) - Improved examples to use new Mojolicious 7.12 features. 2.30 2016-09-02 - Improved query method in Mojo::Pg::Database to allow binding of specific DBD::Pg data types to placeholders. 2.29 2016-08-10 - Added database_class attribute to Mojo::Pg. - Added results_class attribute to Mojo::Pg::Database. - Fixed a few fork-safety bugs and memory leaks in Mojo::Pg::PubSub. 2.28 2016-06-14 - Updated for Mojolicious 6.65. 2.27 2016-05-21 - Improved query method in Mojo::Pg::Database to include caller information in error messages. 2.26 2016-04-25 - Improved expand performance slightly. 2.25 2016-03-26 - Added support for encoding and decoding of JSON notifications. - Added json method to Mojo::Pg::PubSub. 2.24 2016-03-23 - Fixed copyright notice. 2.23 2016-02-13 - Improved tables method in Mojo::Pg::Database to list all tables and views that are visible to the current user and not internal. 2.22 2016-02-13 - Fixed bug where views would be included in the list of table names. 2.21 2016-02-13 - Added tables method to Mojo::Pg::Database. 2.20 2016-02-12 - Fixed schema bugs in tests. 2.19 2016-02-12 - Improved tests to use custom schemas. 2.18 2016-01-23 - Added auto_migrate attribute to Mojo::Pg. - Updated example applications. 2.17 2016-01-03 - Updated links to Mojolicious website. 2.16 2015-11-25 - Added finish method to Mojo::Pg::Results. 2.15 2015-10-30 - Improved Mojo::Pg::Migrations to detect if the currently active version is greater than the latest version. 2.14 2015-10-25 - Improved unlisten method in Mojo::Pg::PubSub with support for removing all subscribers of a channel at once. 2.13 2015-10-23 - Added search_path attribute to Mojo::Pg. 2.12 2015-10-05 - Updated example applications. 2.11 2015-09-29 - Improved notification performance slightly. 2.10 2015-09-16 - Updated DBD::Pg requirement to 3.5.1 due to certain JSON features not working with older versions. 2.09 2015-08-29 - Fixed Makefile.PL to be compliant with version 2 of the CPAN distribution metadata specification. 2.08 2015-08-14 - Improved support for long-lived Mojo::Pg::Results objects. (Grinnz, sri) 2.07 2015-06-17 - Fixed a few JSON encoding and decoding issues. 2.06 2015-06-07 - Fixed bug in Mojo::Pg::Database where sequential non-blocking queries would not work correctly. 2.05 2015-04-06 - Fixed bug in Mojo::Pg::Migrations where migrations would sometimes be executed in the wrong order. 2.04 2015-04-05 - Fixed bug in Mojo::Pg::Migrations where the latest version could not always be determined correctly. (Hernan Lopes) 2.03 2015-04-02 - Updated example applications. 2.02 2015-03-30 - Improved fork-safety of Mojo::Pg::PubSub. 2.01 2015-03-25 - Fixed bug where Perl would close the DBD::Pg file descriptor unexpectedly. 2.0 2015-03-25 - Removed support for sequential non-blocking queries, because they are currently incompatible with DBD::Pg. - Removed max_statements attribute from Mojo::Pg. - Removed db attribute from Mojo::Pg::Results. - Removed backlog method from Mojo::Pg::Database. - Removed deprecated do method from Mojo::Pg::Database. - Improved performance by using prepare_cached from DBI to cache statement handles. 1.17 2015-03-20 - Improved Mojo::Pg::Migrations to make no changes to the database when checking the currently active version. 1.16 2015-03-18 - Added max_statements attribute to Mojo::Pg. - Added db attribute to Mojo::Pg::Results. - Improved performance for many different queries significantly with a statement handle cache. 1.15 2015-03-17 - Improved portability of some tests. 1.14 2015-03-12 - Fixed bug where non-blocking queries could get lost after the database connection got closed unexpectedly. 1.13 2015-03-11 - Improved notify performance significantly. 1.12 2015-03-09 - Fixed Mojo::Pg::Migrations to handle UTF-8 encoded files correctly. 1.11 2015-03-04 - Removed experimental status from Mojo::Pg::PubSub. - Removed experimental status from pubsub attribute in Mojo::Pg. 1.10 2015-02-20 - Updated for Mojolicious 5.81. 1.09 2015-02-15 - Added EXPERIMENTAL module Mojo::Pg::PubSub. - Added EXPERIMENTAL pubsub attribute to Mojo::Pg. - Improved fork-safety by activating AutoInactiveDestroy by default. 1.08 2015-02-12 - Deprecated Mojo::Pg::Database::do in favor of Mojo::Pg::Database::query. 1.07 2015-01-03 - Added support for encoding and decoding of JSON values. - Added expand method to Mojo::Pg::Results. 1.06 2014-12-28 - Added dollar_only method to Mojo::Pg::Database. 1.05 2014-12-27 - Improved Mojo::Pg::Migrations to create a mojo_migrations table with stricter constraints. 1.04 2014-12-22 - Improved all methods not to use question marks in queries. 1.03 2014-12-21 - Fixed bug where Perl would close the DBD::Pg file descriptor after it had been used with the event loop. 1.02 2014-11-22 - Improved performance for many different queries significantly by deactivating pg_server_prepare by default. 1.01 2014-11-20 - Improved documentation. 1.0 2014-11-19 - Removed experimental status from distribution. 0.11 2014-11-13 - Added pid method to Mojo::Pg::Database. - Added close event to Mojo::Pg::Database. 0.10 2014-11-12 - Removed dbh attribute from Mojo::Pg::Transaction. - Added db attribute to Mojo::Pg::Transaction. - Fixed bug where notifications did not get delivered immediately to the process that sent them. 0.09 2014-11-02 - Updated Mojolicious requirement to 5.57. 0.08 2014-10-13 - Changed default data source name in Mojo::Pg to allow more DBD::Pg environment variables to work correctly. - Improved Mojo::Pg to allow service names in connection strings. 0.07 2014-10-13 - Removed commit and rollback methods from Mojo::Pg::Database. - Added Mojo::Pg::Transaction. - Added connection event to Mojo::Pg. 0.06 2014-10-12 - Added notify method to Mojo::Pg::Database. 0.05 2014-10-11 - Updated Mojolicious requirement to 5.49 to ensure migrations in the DATA section are not served as static files. 0.04 2014-10-10 - Added support for migrations. - Added Mojo::Pg::Migrations. - Added migrations attribute to Mojo::Pg. 0.03 2014-10-06 - Improved non-blocking queries to be able to introspect the statement handle. 0.02 2014-10-03 - Added support for PostgreSQL connection strings. - Added from_string method to Mojo::Pg. 0.01 2014-10-03 - First release. Mojo-Pg-2.35/examples/000755 000765 000024 00000000000 13035370163 014472 5ustar00sristaff000000 000000 Mojo-Pg-2.35/lib/000755 000765 000024 00000000000 13035370163 013422 5ustar00sristaff000000 000000 Mojo-Pg-2.35/LICENSE000644 000765 000024 00000021413 12733154131 013661 0ustar00sristaff000000 000000 The Artistic License 2.0 Copyright (c) 2000-2006, The Perl Foundation. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble This license establishes the terms under which a given free software Package may be copied, modified, distributed, and/or redistributed. The intent is that the Copyright Holder maintains some artistic control over the development of that Package while still keeping the Package available as open source and free software. You are always permitted to make arrangements wholly outside of this license directly with the Copyright Holder of a given Package. If the terms of this license do not permit the full use that you propose to make of the Package, you should contact the Copyright Holder and seek a different licensing arrangement. Definitions "Copyright Holder" means the individual(s) or organization(s) named in the copyright notice for the entire Package. "Contributor" means any party that has contributed code or other material to the Package, in accordance with the Copyright Holder's procedures. "You" and "your" means any person who would like to copy, distribute, or modify the Package. "Package" means the collection of files distributed by the Copyright Holder, and derivatives of that collection and/or of those files. A given Package may consist of either the Standard Version, or a Modified Version. "Distribute" means providing a copy of the Package or making it accessible to anyone else, or in the case of a company or organization, to others outside of your company or organization. "Distributor Fee" means any fee that you charge for Distributing this Package or providing support for this Package to another party. It does not mean licensing fees. "Standard Version" refers to the Package if it has not been modified, or has been modified only in ways explicitly requested by the Copyright Holder. "Modified Version" means the Package, if it has been changed, and such changes were not explicitly requested by the Copyright Holder. "Original License" means this Artistic License as Distributed with the Standard Version of the Package, in its current version or as it may be modified by The Perl Foundation in the future. "Source" form means the source code, documentation source, and configuration files for the Package. "Compiled" form means the compiled bytecode, object code, binary, or any other form resulting from mechanical transformation or translation of the Source form. Permission for Use and Modification Without Distribution (1) You are permitted to use the Standard Version and create and use Modified Versions for any purpose without restriction, provided that you do not Distribute the Modified Version. Permissions for Redistribution of the Standard Version (2) You may Distribute verbatim copies of the Source form of the Standard Version of this Package in any medium without restriction, either gratis or for a Distributor Fee, provided that you duplicate all of the original copyright notices and associated disclaimers. At your discretion, such verbatim copies may or may not include a Compiled form of the Package. (3) You may apply any bug fixes, portability changes, and other modifications made available from the Copyright Holder. The resulting Package will still be considered the Standard Version, and as such will be subject to the Original License. Distribution of Modified Versions of the Package as Source (4) You may Distribute your Modified Version as Source (either gratis or for a Distributor Fee, and with or without a Compiled form of the Modified Version) provided that you clearly document how it differs from the Standard Version, including, but not limited to, documenting any non-standard features, executables, or modules, and provided that you do at least ONE of the following: (a) make the Modified Version available to the Copyright Holder of the Standard Version, under the Original License, so that the Copyright Holder may include your modifications in the Standard Version. (b) ensure that installation of your Modified Version does not prevent the user installing or running the Standard Version. In addition, the Modified Version must bear a name that is different from the name of the Standard Version. (c) allow anyone who receives a copy of the Modified Version to make the Source form of the Modified Version available to others under (i) the Original License or (ii) a license that permits the licensee to freely copy, modify and redistribute the Modified Version using the same licensing terms that apply to the copy that the licensee received, and requires that the Source form of the Modified Version, and of any works derived from it, be made freely available in that license fees are prohibited but Distributor Fees are allowed. Distribution of Compiled Forms of the Standard Version or Modified Versions without the Source (5) You may Distribute Compiled forms of the Standard Version without the Source, provided that you include complete instructions on how to get the Source of the Standard Version. Such instructions must be valid at the time of your distribution. If these instructions, at any time while you are carrying out such distribution, become invalid, you must provide new instructions on demand or cease further distribution. If you provide valid instructions or cease distribution within thirty days after you become aware that the instructions are invalid, then you do not forfeit any of your rights under this license. (6) You may Distribute a Modified Version in Compiled form without the Source, provided that you comply with Section 4 with respect to the Source of the Modified Version. Aggregating or Linking the Package (7) You may aggregate the Package (either the Standard Version or Modified Version) with other packages and Distribute the resulting aggregation provided that you do not charge a licensing fee for the Package. Distributor Fees are permitted, and licensing fees for other components in the aggregation are permitted. The terms of this license apply to the use and Distribution of the Standard or Modified Versions as included in the aggregation. (8) You are permitted to link Modified and Standard Versions with other works, to embed the Package in a larger work of your own, or to build stand-alone binary or bytecode versions of applications that include the Package, and Distribute the result without restriction, provided the result does not expose a direct interface to the Package. Items That are Not Considered Part of a Modified Version (9) Works (including, but not limited to, modules and scripts) that merely extend or make use of the Package, do not, by themselves, cause the Package to be a Modified Version. In addition, such works are not considered parts of the Package itself, and are not subject to the terms of this license. General Provisions (10) Any use, modification, and distribution of the Standard or Modified Versions is governed by this Artistic License. By using, modifying or distributing the Package, you accept this license. Do not use, modify, or distribute the Package, if you do not accept this license. (11) If your Modified Version has been derived from a Modified Version made by someone other than you, you are nevertheless required to ensure that your Modified Version complies with the requirements of this license. (12) This license does not grant you the right to use any trademark, service mark, tradename, or logo of the Copyright Holder. (13) This license includes the non-exclusive, worldwide, free-of-charge patent license to make, have made, use, offer to sell, sell, import and otherwise transfer the Package with respect to any patent claims licensable by the Copyright Holder that are necessarily infringed by the Package. If you institute patent litigation (including a cross-claim or counterclaim) against any party alleging that the Package constitutes direct or contributory patent infringement, then this Artistic License to you shall terminate on the date that such litigation is filed. (14) Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. Mojo-Pg-2.35/Makefile.PL000644 000765 000024 00000002037 13035367734 014642 0ustar00sristaff000000 000000 use 5.010001; use strict; use warnings; use utf8; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Mojo::Pg', VERSION_FROM => 'lib/Mojo/Pg.pm', ABSTRACT => 'Mojolicious ♥ PostgreSQL', AUTHOR => 'Sebastian Riedel ', LICENSE => 'artistic_2', META_MERGE => { dynamic_config => 0, 'meta-spec' => {version => 2}, no_index => {directory => ['examples', 't']}, prereqs => {runtime => {requires => {perl => '5.010001'}}}, resources => { bugtracker => {web => 'https://github.com/kraih/mojo-pg/issues'}, homepage => 'http://mojolicious.org', license => ['http://www.opensource.org/licenses/artistic-license-2.0'], repository => { type => 'git', url => 'https://github.com/kraih/mojo-pg.git', web => 'https://github.com/kraih/mojo-pg', }, x_IRC => 'irc://irc.perl.org/#mojo' }, }, PREREQ_PM => {Mojolicious => '7.15', 'DBD::Pg' => 3.005001}, test => {TESTS => 't/*.t t/*/*.t'} ); Mojo-Pg-2.35/MANIFEST000644 000765 000024 00000001734 13035370163 014012 0ustar00sristaff000000 000000 Changes examples/blog/blog.conf examples/blog/lib/Blog.pm examples/blog/lib/Blog/Controller/Posts.pm examples/blog/lib/Blog/Model/Posts.pm examples/blog/migrations/blog.sql examples/blog/script/blog examples/blog/templates/layouts/blog.html.ep examples/blog/templates/posts/_form.html.ep examples/blog/templates/posts/create.html.ep examples/blog/templates/posts/edit.html.ep examples/blog/templates/posts/index.html.ep examples/blog/templates/posts/show.html.ep examples/chat.pl lib/Mojo/Pg.pm lib/Mojo/Pg/Database.pm lib/Mojo/Pg/Migrations.pm lib/Mojo/Pg/PubSub.pm lib/Mojo/Pg/Results.pm lib/Mojo/Pg/Transaction.pm LICENSE Makefile.PL MANIFEST This list of files MANIFEST.SKIP README.md t/connection.t t/database.t t/migrations.t t/migrations/test.sql t/pg_lite_app.t t/pod.t t/pod_coverage.t t/pubsub.t t/results.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Mojo-Pg-2.35/MANIFEST.SKIP000644 000765 000024 00000000115 12733154131 014546 0ustar00sristaff000000 000000 ^\.(?!perltidyrc) .*\.old$ \.tar\.gz$ ^Makefile$ ^MYMETA\. ^blib ^pm_to_blib Mojo-Pg-2.35/META.json000644 000765 000024 00000002741 13035370163 014301 0ustar00sristaff000000 000000 { "abstract" : "Mojolicious ♥ PostgreSQL", "author" : [ "Sebastian Riedel " ], "dynamic_config" : 0, "generated_by" : "ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150010", "license" : [ "artistic_2" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Mojo-Pg", "no_index" : { "directory" : [ "t", "inc", "examples", "t" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "DBD::Pg" : "3.005001", "Mojolicious" : "7.15", "perl" : "5.010001" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/kraih/mojo-pg/issues" }, "homepage" : "http://mojolicious.org", "license" : [ "http://www.opensource.org/licenses/artistic-license-2.0" ], "repository" : { "type" : "git", "url" : "https://github.com/kraih/mojo-pg.git", "web" : "https://github.com/kraih/mojo-pg" }, "x_IRC" : "irc://irc.perl.org/#mojo" }, "version" : "2.35", "x_serialization_backend" : "JSON::PP version 2.27400" } Mojo-Pg-2.35/META.yml000644 000765 000024 00000001550 13035370163 014126 0ustar00sristaff000000 000000 --- abstract: 'Mojolicious ♥ PostgreSQL' author: - 'Sebastian Riedel ' build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 generated_by: 'ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150010' license: artistic_2 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Mojo-Pg no_index: directory: - t - inc - examples - t requires: DBD::Pg: '3.005001' Mojolicious: '7.15' perl: '5.010001' resources: IRC: irc://irc.perl.org/#mojo bugtracker: https://github.com/kraih/mojo-pg/issues homepage: http://mojolicious.org license: http://www.opensource.org/licenses/artistic-license-2.0 repository: https://github.com/kraih/mojo-pg.git version: '2.35' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Mojo-Pg-2.35/README.md000644 000765 000024 00000002771 12733154131 014141 0ustar00sristaff000000 000000 # Mojo::Pg [![Build Status](https://travis-ci.org/kraih/mojo-pg.svg?branch=master)](https://travis-ci.org/kraih/mojo-pg) A tiny wrapper around [DBD::Pg](https://metacpan.org/pod/DBD::Pg) that makes [PostgreSQL](http://www.postgresql.org) a lot of fun to use with the [Mojolicious](http://mojolicious.org) real-time web framework. ```perl use Mojolicious::Lite; use Mojo::Pg; use 5.20.0; use experimental 'signatures'; helper pg => sub { state $pg = Mojo::Pg->new('postgresql://postgres@/test') }; # Use migrations to create a table during startup app->pg->migrations->from_data->migrate; get '/' => sub ($c) { my $db = $c->pg->db; my $ip = $c->tx->remote_address; # Store information about current visitor blocking $db->query('insert into visitors values (now(), ?)', $ip); # Retrieve information about previous visitors non-blocking $db->query('select * from visitors limit 50' => sub ($db, $err, $results) { return $c->reply->exception($err) if $err; $c->render(json => $results->hashes->to_array); }); }; app->start; __DATA__ @@ migrations -- 1 up create table visitors (at timestamp with time zone, ip text); -- 1 down drop table visitors; ``` ## Installation All you need is a one-liner, it takes less than a minute. $ curl -L https://cpanmin.us | perl - -M https://cpan.metacpan.org -n Mojo::Pg We recommend the use of a [Perlbrew](http://perlbrew.pl) environment. ## Want to know more? Take a look at our excellent [documentation](http://mojolicious.org/perldoc>)! Mojo-Pg-2.35/t/000755 000765 000024 00000000000 13035370163 013117 5ustar00sristaff000000 000000 Mojo-Pg-2.35/t/connection.t000644 000765 000024 00000006067 13031461676 015462 0ustar00sristaff000000 000000 use Mojo::Base -strict; use Test::More; use Mojo::Pg; # Defaults my $pg = Mojo::Pg->new; is $pg->dsn, 'dbi:Pg:', 'right data source'; is $pg->username, '', 'no username'; is $pg->password, '', 'no password'; my $options = {AutoCommit => 1, AutoInactiveDestroy => 1, PrintError => 0, RaiseError => 1}; is_deeply $pg->options, $options, 'right options'; # Minimal connection string with database $pg = Mojo::Pg->new('postgresql:///test1'); is $pg->dsn, 'dbi:Pg:dbname=test1', 'right data source'; is $pg->username, '', 'no username'; is $pg->password, '', 'no password'; $options = {AutoCommit => 1, AutoInactiveDestroy => 1, PrintError => 0, RaiseError => 1}; is_deeply $pg->options, $options, 'right options'; # Minimal connection string with service and option $pg = Mojo::Pg->new('postgres://?service=foo&PrintError=1'); is $pg->dsn, 'dbi:Pg:service=foo', 'right data source'; is $pg->username, '', 'no username'; is $pg->password, '', 'no password'; $options = {AutoCommit => 1, AutoInactiveDestroy => 1, PrintError => 1, RaiseError => 1}; is_deeply $pg->options, $options, 'right options'; # Connection string with host and port $pg = Mojo::Pg->new('postgresql://127.0.0.1:8080/test2'); is $pg->dsn, 'dbi:Pg:dbname=test2;host=127.0.0.1;port=8080', 'right data source'; is $pg->username, '', 'no username'; is $pg->password, '', 'no password'; $options = {AutoCommit => 1, AutoInactiveDestroy => 1, PrintError => 0, RaiseError => 1}; is_deeply $pg->options, $options, 'right options'; # Connection string username but without host $pg = Mojo::Pg->new('postgres://postgres@/test3'); is $pg->dsn, 'dbi:Pg:dbname=test3', 'right data source'; is $pg->username, 'postgres', 'right username'; is $pg->password, '', 'no password'; $options = {AutoCommit => 1, AutoInactiveDestroy => 1, PrintError => 0, RaiseError => 1}; is_deeply $pg->options, $options, 'right options'; # Connection string with unix domain socket and options $pg = Mojo::Pg->new( 'postgresql://x1:y2@%2ftmp%2fpg.sock/test4?PrintError=1&RaiseError=0'); is $pg->dsn, 'dbi:Pg:dbname=test4;host=/tmp/pg.sock', 'right data source'; is $pg->username, 'x1', 'right username'; is $pg->password, 'y2', 'right password'; $options = {AutoCommit => 1, AutoInactiveDestroy => 1, PrintError => 1, RaiseError => 0}; is_deeply $pg->options, $options, 'right options'; # Connection string with lots of zeros $pg = Mojo::Pg->new('postgresql://0:0@/0?RaiseError=0'); is $pg->dsn, 'dbi:Pg:dbname=0', 'right data source'; is $pg->username, '0', 'right username'; is $pg->password, '0', 'right password'; $options = {AutoCommit => 1, AutoInactiveDestroy => 1, PrintError => 0, RaiseError => 0}; is_deeply $pg->options, $options, 'right options'; # Invalid connection string eval { Mojo::Pg->new('http://localhost:3000/test') }; like $@, qr/Invalid PostgreSQL connection string/, 'right error'; done_testing(); Mojo-Pg-2.35/t/database.t000644 000765 000024 00000023501 13032222675 015052 0ustar00sristaff000000 000000 use Mojo::Base -strict; BEGIN { $ENV{MOJO_REACTOR} = 'Mojo::Reactor::Poll' } use Test::More; plan skip_all => 'set TEST_ONLINE to enable this test' unless $ENV{TEST_ONLINE}; use Mojo::IOLoop; use Mojo::JSON 'true'; use Mojo::Pg; # Connected my $pg = Mojo::Pg->new($ENV{TEST_ONLINE}); ok $pg->db->ping, 'connected'; # Custom search_path $pg = Mojo::Pg->new($ENV{TEST_ONLINE})->search_path(['$user', 'foo', 'bar']); is_deeply $pg->db->query('show search_path')->hash, {search_path => '"$user", foo, bar'}, 'right structure'; $pg = Mojo::Pg->new($ENV{TEST_ONLINE}); # Blocking select is_deeply $pg->db->query('select 1 as one, 2 as two, 3 as three')->hash, {one => 1, two => 2, three => 3}, 'right structure'; # Non-blocking select my ($fail, $result); 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; Mojo::IOLoop->stop; } ); Mojo::IOLoop->start; ok !$fail, 'no error'; is_deeply $result, {one => 1, two => 2, three => 3}, 'right structure'; # Concurrent non-blocking selects ($fail, $result) = (); Mojo::IOLoop->delay( sub { my $delay = shift; $pg->db->query('select 1 as one' => $delay->begin); $pg->db->query('select 2 as two' => $delay->begin); $pg->db->query('select 2 as two' => $delay->begin); }, sub { my ($delay, $err_one, $one, $err_two, $two, $err_again, $again) = @_; $fail = $err_one || $err_two || $err_again; $result = [$one->hashes->first, $two->hashes->first, $again->hashes->first]; } )->wait; ok !$fail, 'no error'; is_deeply $result, [{one => 1}, {two => 2}, {two => 2}], 'right structure'; # Sequential non-blocking selects ($fail, $result) = (undef, []); $db = $pg->db; Mojo::IOLoop->delay( sub { my $delay = shift; $db->query('select 1 as one' => $delay->begin); }, sub { my ($delay, $err, $one) = @_; $fail = $err; push @$result, $one->hashes->first; $db->query('select 1 as one' => $delay->begin); }, sub { my ($delay, $err, $again) = @_; $fail ||= $err; push @$result, $again->hashes->first; $db->query('select 2 as two' => $delay->begin); }, sub { my ($delay, $err, $two) = @_; $fail ||= $err; push @$result, $two->hashes->first; } )->wait; ok !$fail, 'no error'; is_deeply $result, [{one => 1}, {one => 1}, {two => 2}], 'right structure'; # Connection cache is $pg->max_connections, 5, 'right default'; my @dbhs = map { $_->dbh } $pg->db, $pg->db, $pg->db, $pg->db, $pg->db; is_deeply \@dbhs, [map { $_->dbh } $pg->db, $pg->db, $pg->db, $pg->db, $pg->db], 'same database handles'; @dbhs = (); my $dbh = $pg->max_connections(1)->db->dbh; is $pg->db->dbh, $dbh, 'same database handle'; isnt $pg->db->dbh, $pg->db->dbh, 'different database handles'; is $pg->db->dbh, $dbh, 'different database handles'; $dbh = $pg->db->dbh; is $pg->db->dbh, $dbh, 'same database handle'; $pg->db->disconnect; isnt $pg->db->dbh, $dbh, 'different database handles'; # Statement cache $db = $pg->db; my $sth = $db->query('select 3 as three')->sth; is $db->query('select 3 as three')->sth, $sth, 'same statement handle'; isnt $db->query('select 4 as four')->sth, $sth, 'different statement handles'; is $db->query('select 3 as three')->sth, $sth, 'same statement handle'; undef $db; $db = $pg->db; my $results = $db->query('select 3 as three'); is $results->sth, $sth, 'same statement handle'; isnt $db->query('select 3 as three')->sth, $sth, 'different statement handles'; $sth = $db->query('select 3 as three')->sth; is $db->query('select 3 as three')->sth, $sth, 'same statement handle'; isnt $db->query('select 5 as five')->sth, $sth, 'different statement handles'; isnt $db->query('select 6 as six')->sth, $sth, 'different statement handles'; is $db->query('select 3 as three')->sth, $sth, 'same statement handle'; # Dollar only $db = $pg->db; is $db->dollar_only->query('select $1::int as test', 23)->hash->{test}, 23, 'right result'; eval { $db->dollar_only->query('select ?::int as test', 23) }; like $@, qr/Statement has no placeholders to bind/, 'right error'; is $db->query('select ?::int as test', 23)->hash->{test}, 23, 'right result'; # JSON $db = $pg->db; is_deeply $db->query('select ?::json as foo', {json => {bar => 'baz'}}) ->expand->hash, {foo => {bar => 'baz'}}, 'right structure'; is_deeply $db->query('select ?::jsonb as foo', {json => {bar => 'baz'}}) ->expand->hash, {foo => {bar => 'baz'}}, 'right structure'; is_deeply $db->query('select ?::json as foo', {json => {bar => 'baz'}}) ->expand->array, [{bar => 'baz'}], 'right structure'; is_deeply $db->query('select ?::json as foo', {json => {bar => 'baz'}}) ->expand->hashes->first, {foo => {bar => 'baz'}}, 'right structure'; is_deeply $db->query('select ?::json as foo', {json => {bar => 'baz'}}) ->expand->arrays->first, [{bar => 'baz'}], 'right structure'; is_deeply $db->query('select ?::json as foo', {json => {bar => 'baz'}})->hash, {foo => '{"bar":"baz"}'}, 'right structure'; is_deeply $db->query('select ?::json as foo', {json => \1}) ->expand->hashes->first, {foo => true}, 'right structure'; is_deeply $db->query('select ?::json as foo', undef)->expand->hash, {foo => undef}, 'right structure'; is_deeply $db->query('select ?::json as foo', undef)->expand->array, [undef], 'right structure'; $results = $db->query('select ?::json', undef); is_deeply $results->expand->array, [undef], 'right structure'; is_deeply $results->expand->array, undef, 'no more results'; is_deeply $db->query('select ?::json as unicode', {json => {'☃' => '♥'}}) ->expand->hash, {unicode => {'☃' => '♥'}}, 'right structure'; is_deeply $db->query("select json_build_object('☃', ?::text) as unicode", '♥')->expand->hash, {unicode => {'☃' => '♥'}}, 'right structure'; # Fork-safety $dbh = $pg->db->dbh; my ($connections, $current) = @_; $pg->on( connection => sub { my ($pg, $dbh) = @_; $connections++; $current = $dbh; } ); is $pg->db->dbh, $dbh, 'same database handle'; ok !$connections, 'no new connections'; { local $$ = -23; isnt $pg->db->dbh, $dbh, 'different database handles'; is $pg->db->dbh, $current, 'same database handle'; is $connections, 1, 'one new connection'; }; $pg->unsubscribe('connection'); # Notifications $db = $pg->db; ok !$db->is_listening, 'not listening'; ok $db->listen('dbtest')->is_listening, 'listening'; my $db2 = $pg->db->listen('dbtest'); my @notifications; Mojo::IOLoop->delay( sub { my $delay = shift; $db->once(notification => $delay->begin); $db2->once(notification => $delay->begin); Mojo::IOLoop->next_tick(sub { $db2->notify(dbtest => 'foo') }); }, sub { my ($delay, $name, $pid, $payload, $name2, $pid2, $payload2) = @_; push @notifications, [$name, $pid, $payload], [$name2, $pid2, $payload2]; $db->once(notification => $delay->begin); $db2->unlisten('dbtest'); Mojo::IOLoop->next_tick(sub { $pg->db->notify('dbtest') }); }, sub { my ($delay, $name, $pid, $payload) = @_; push @notifications, [$name, $pid, $payload]; $db2->listen('dbtest2')->once(notification => $delay->begin); Mojo::IOLoop->next_tick(sub { $db2->query("notify dbtest2, 'bar'") }); }, sub { my ($delay, $name, $pid, $payload) = @_; push @notifications, [$name, $pid, $payload]; $db2->once(notification => $delay->begin); my $tx = $db2->begin; Mojo::IOLoop->next_tick( sub { $db2->notify(dbtest2 => 'baz'); $tx->commit; } ); }, sub { my ($delay, $name, $pid, $payload) = @_; push @notifications, [$name, $pid, $payload]; } )->wait; ok !$db->unlisten('dbtest')->is_listening, 'not listening'; ok !$db2->unlisten('*')->is_listening, 'not listening'; is $notifications[0][0], 'dbtest', 'right channel name'; ok $notifications[0][1], 'has process id'; is $notifications[0][2], 'foo', 'right payload'; is $notifications[1][0], 'dbtest', 'right channel name'; ok $notifications[1][1], 'has process id'; is $notifications[1][2], 'foo', 'right payload'; is $notifications[2][0], 'dbtest', 'right channel name'; ok $notifications[2][1], 'has process id'; is $notifications[2][2], '', 'no payload'; is $notifications[3][0], 'dbtest2', 'right channel name'; ok $notifications[3][1], 'has process id'; is $notifications[3][2], 'bar', 'no payload'; is $notifications[4][0], 'dbtest2', 'right channel name'; ok $notifications[4][1], 'has process id'; is $notifications[4][2], 'baz', 'no payload'; is $notifications[5], undef, 'no more notifications'; # Stop listening for all notifications ok !$db->is_listening, 'not listening'; ok $db->listen('dbtest')->listen('dbtest2')->unlisten('dbtest2')->is_listening, 'listening'; ok !$db->unlisten('*')->is_listening, 'not listening'; # Connection close while listening for notifications { ok $db->listen('dbtest')->is_listening, 'listening'; my $close = 0; $db->on(close => sub { $close++ }); local $db->dbh->{Warn} = 0; $pg->db->query('select pg_terminate_backend(?)', $db->pid); Mojo::IOLoop->start; is $close, 1, 'close event has been emitted once'; }; # Blocking error eval { $pg->db->query('does_not_exist') }; like $@, qr/does_not_exist.*database\.t/s, 'right error'; # Non-blocking error ($fail, $result) = (); $pg->db->query( 'does_not_exist' => sub { my ($db, $err, $results) = @_; ($fail, $result) = ($err, $results); Mojo::IOLoop->stop; } ); Mojo::IOLoop->start; like $fail, qr/does_not_exist/, 'right error'; is $result->sth->errstr, $fail, 'same error'; # Non-blocking query in progress $db = $pg->db; $db->query('select 1' => sub { }); eval { $db->query('select 1' => sub { }); }; like $@, qr/Non-blocking query already in progress/, 'right error'; # CLean up non-blocking query $fail = undef; $db = $pg->db; $db->query( 'select 1' => sub { my ($db, $err, $results) = @_; $fail = $err; } ); $db->disconnect; undef $db; is $fail, 'Premature connection close', 'right error'; done_testing(); Mojo-Pg-2.35/t/migrations/000755 000765 000024 00000000000 13035370163 015273 5ustar00sristaff000000 000000 Mojo-Pg-2.35/t/migrations.t000644 000765 000024 00000014040 13032222777 015463 0ustar00sristaff000000 000000 use Mojo::Base -strict; BEGIN { $ENV{MOJO_REACTOR} = 'Mojo::Reactor::Poll' } use Test::More; plan skip_all => 'set TEST_ONLINE to enable this test' unless $ENV{TEST_ONLINE}; use File::Spec::Functions 'catfile'; use FindBin; use Mojo::Pg; # Isolate tests my $pg = Mojo::Pg->new($ENV{TEST_ONLINE})->search_path(['mojo_migrations_test']); $pg->db->query('drop schema if exists mojo_migrations_test cascade'); $pg->db->query('create schema mojo_migrations_test'); # Defaults is $pg->migrations->name, 'migrations', 'right name'; is $pg->migrations->latest, 0, 'latest version is 0'; is $pg->migrations->active, 0, 'active version is 0'; # Create migrations table ok !(grep {/^mojo_migrations_test\.mojo_migrations$/} @{$pg->db->tables}), 'migrations table does not exist'; is $pg->migrations->migrate->active, 0, 'active version is 0'; ok !!(grep {/^mojo_migrations_test\.mojo_migrations$/} @{$pg->db->tables}), 'migrations table exists'; # Migrations from DATA section is $pg->migrations->from_data->latest, 0, 'latest version is 0'; is $pg->migrations->from_data(__PACKAGE__)->latest, 0, 'latest version is 0'; is $pg->migrations->name('test1')->from_data->latest, 10, 'latest version is 10'; is $pg->migrations->name('test2')->from_data->latest, 2, 'latest version is 2'; is $pg->migrations->name('migrations')->from_data(__PACKAGE__, 'test1')->latest, 10, 'latest version is 10'; is $pg->migrations->name('test2')->from_data(__PACKAGE__)->latest, 2, 'latest version is 2'; # Different syntax variations $pg->migrations->name('migrations_test')->from_string(<migrations->latest, 10, 'latest version is 10'; is $pg->migrations->active, 0, 'active version is 0'; is $pg->migrations->migrate->active, 10, 'active version is 10'; ok !!(grep {/^mojo_migrations_test\.migration_test_one$/} @{$pg->db->tables}), 'first table exists'; ok !!(grep {/^mojo_migrations_test\.migration_test_two$/} @{$pg->db->tables}), 'second table exists'; is_deeply $pg->db->query('select * from migration_test_one')->hash, {foo => 'works ♥'}, 'right structure'; is $pg->migrations->migrate->active, 10, 'active version is 10'; is $pg->migrations->migrate(1)->active, 1, 'active version is 1'; is $pg->db->query('select * from migration_test_one')->hash, undef, 'no result'; is $pg->migrations->migrate(3)->active, 3, 'active version is 3'; is $pg->db->query('select * from migration_test_two')->hash, undef, 'no result'; is $pg->migrations->migrate->active, 10, 'active version is 10'; is_deeply $pg->db->query('select * from migration_test_two')->hash, {bar => 'works too'}, 'right structure'; is $pg->migrations->migrate(0)->active, 0, 'active version is 0'; # Bad and concurrent migrations my $pg2 = Mojo::Pg->new($ENV{TEST_ONLINE})->search_path(['mojo_migrations_test']); $pg2->migrations->name('migrations_test2') ->from_file(catfile($FindBin::Bin, 'migrations', 'test.sql')); is $pg2->migrations->latest, 4, 'latest version is 4'; is $pg2->migrations->active, 0, 'active version is 0'; eval { $pg2->migrations->migrate }; like $@, qr/does_not_exist/, 'right error'; is $pg2->migrations->migrate(3)->active, 3, 'active version is 3'; is $pg2->migrations->migrate(2)->active, 2, 'active version is 3'; is $pg->migrations->active, 0, 'active version is still 0'; is $pg->migrations->migrate->active, 10, 'active version is 10'; is_deeply $pg2->db->query('select * from migration_test_three') ->hashes->to_array, [{baz => 'just'}, {baz => 'works ♥'}], 'right structure'; is $pg->migrations->migrate(0)->active, 0, 'active version is 0'; is $pg2->migrations->migrate(0)->active, 0, 'active version is 0'; # Migrate automatically my $pg3 = Mojo::Pg->new($ENV{TEST_ONLINE})->search_path(['mojo_migrations_test']); $pg3->migrations->name('migrations_test')->from_string(<auto_migrate(1)->db; is $pg3->migrations->active, 6, 'active version is 6'; is_deeply $pg3->db->query('select * from migration_test_six')->hashes, [{foo => 'works!'}], 'right structure'; is $pg3->migrations->migrate(5)->active, 5, 'active version is 5'; is_deeply $pg3->db->query('select * from migration_test_six')->hashes, [], 'right structure'; is $pg3->migrations->migrate(0)->active, 0, 'active version is 0'; # Unknown version eval { $pg->migrations->migrate(23) }; like $@, qr/Version 23 has no migration/, 'right error'; # Version mismatch my $newer = <migrations->name('migrations_test3')->from_string($newer); is $pg->migrations->migrate->active, 2, 'active version is 2'; $pg->migrations->from_string(<migrations->migrate }; like $@, qr/Active version 2 is greater than the latest version 1/, 'right error'; eval { $pg->migrations->migrate(0) }; like $@, qr/Active version 2 is greater than the latest version 1/, 'right error'; is $pg->migrations->from_string($newer)->migrate(0)->active, 0, 'active version is 0'; # Clean up once we are done $pg->db->query('drop schema mojo_migrations_test cascade'); done_testing(); __DATA__ @@ test1 -- 7 up create table migration_test_four (test int); -- 10 up insert into migration_test_four values (10); @@ test2 -- 2 up create table migration_test_five (test int); Mojo-Pg-2.35/t/pg_lite_app.t000644 000765 000024 00000003643 13032241443 015570 0ustar00sristaff000000 000000 use Mojo::Base -strict; BEGIN { $ENV{MOJO_REACTOR} = 'Mojo::Reactor::Poll' } use Test::More; plan skip_all => 'set TEST_ONLINE to enable this test' unless $ENV{TEST_ONLINE}; use Mojo::Pg; use Mojolicious::Lite; use Scalar::Util 'refaddr'; use Test::Mojo; # Isolate tests my $pg = Mojo::Pg->new($ENV{TEST_ONLINE}); $pg->db->query('drop schema if exists mojo_app_test cascade'); $pg->db->query('create schema mojo_app_test'); helper pg => sub { state $pg = Mojo::Pg->new($ENV{TEST_ONLINE})->search_path(['mojo_app_test']); }; app->pg->db->query('create table if not exists app_test (stuff text)'); app->pg->db->query('insert into app_test values (?)', 'I ♥ Mojolicious!'); get '/blocking' => sub { my $c = shift; my $db = $c->pg->db; $c->res->headers->header('X-Ref' => refaddr $db->dbh); $c->render(text => $db->query('select * from app_test')->hash->{stuff}); }; get '/non-blocking' => sub { my $c = shift; $c->pg->db->query( 'select * from app_test' => sub { my ($db, $err, $results) = @_; $c->res->headers->header('X-Ref' => refaddr $db->dbh); $c->render(text => $results->hash->{stuff}); } ); }; my $t = Test::Mojo->new; # Make sure migrations are not served as static files $t->get_ok('/app_test')->status_is(404); # Blocking select (with connection reuse) $t->get_ok('/blocking')->status_is(200)->content_is('I ♥ Mojolicious!'); my $ref = $t->tx->res->headers->header('X-Ref'); $t->get_ok('/blocking')->status_is(200)->header_is('X-Ref', $ref) ->content_is('I ♥ Mojolicious!'); # Non-blocking select (with connection reuse) $t->get_ok('/non-blocking')->status_is(200)->header_is('X-Ref', $ref) ->content_is('I ♥ Mojolicious!'); $t->get_ok('/non-blocking')->status_is(200)->header_is('X-Ref', $ref) ->content_is('I ♥ Mojolicious!'); $t->app->pg->db->query('drop table app_test'); # Clean up once we are done $pg->db->query('drop schema mojo_app_test cascade'); done_testing(); Mojo-Pg-2.35/t/pod.t000644 000765 000024 00000000400 12733154131 014057 0ustar00sristaff000000 000000 use Mojo::Base -strict; use Test::More; plan skip_all => 'set TEST_POD to enable this test (developer only!)' unless $ENV{TEST_POD}; plan skip_all => 'Test::Pod 1.14+ required for this test!' unless eval 'use Test::Pod 1.14; 1'; all_pod_files_ok(); Mojo-Pg-2.35/t/pod_coverage.t000644 000765 000024 00000000427 12733154131 015743 0ustar00sristaff000000 000000 use Mojo::Base -strict; use Test::More; plan skip_all => 'set TEST_POD to enable this test (developer only!)' unless $ENV{TEST_POD}; plan skip_all => 'Test::Pod::Coverage 1.04+ required for this test!' unless eval 'use Test::Pod::Coverage 1.04; 1'; all_pod_coverage_ok(); Mojo-Pg-2.35/t/pubsub.t000644 000765 000024 00000012324 12752617741 014621 0ustar00sristaff000000 000000 use Mojo::Base -strict; BEGIN { $ENV{MOJO_REACTOR} = 'Mojo::Reactor::Poll' } use Test::More; plan skip_all => 'set TEST_ONLINE to enable this test' unless $ENV{TEST_ONLINE}; use Mojo::IOLoop; use Mojo::JSON 'true'; use Mojo::Pg; # Notifications with event loop my $pg = Mojo::Pg->new($ENV{TEST_ONLINE}); my ($db, @all, @test); $pg->pubsub->on(reconnect => sub { $db = pop }); $pg->pubsub->listen( pstest => sub { my ($pubsub, $payload) = @_; push @test, $payload; Mojo::IOLoop->next_tick(sub { $pubsub->pg->db->notify(pstest => 'stop') }); Mojo::IOLoop->stop if $payload eq 'stop'; } ); $db->on(notification => sub { push @all, [@_[1, 3]] }); $pg->db->notify(pstest => '♥test♥'); Mojo::IOLoop->start; is_deeply \@test, ['♥test♥', 'stop'], 'right messages'; is_deeply \@all, [['pstest', '♥test♥'], ['pstest', 'stop']], 'right notifications'; # JSON $pg = Mojo::Pg->new($ENV{TEST_ONLINE}); my (@json, @raw); $pg->pubsub->json('pstest')->listen( pstest => sub { my ($pubsub, $payload) = @_; push @json, $payload; Mojo::IOLoop->stop if ref $payload eq 'HASH' && $payload->{msg} eq 'stop'; } ); $pg->pubsub->listen( pstest2 => sub { my ($pubsub, $payload) = @_; push @raw, $payload; } ); Mojo::IOLoop->next_tick( sub { $pg->db->notify(pstest => 'fail'); $pg->pubsub->notify('pstest')->notify(pstest => {msg => '♥works♥'}) ->notify(pstest => [1, 2, 3])->notify(pstest => true) ->notify(pstest2 => '♥works♥')->notify(pstest => {msg => 'stop'}); } ); Mojo::IOLoop->start; is_deeply \@json, [undef, undef, {msg => '♥works♥'}, [1, 2, 3], true, {msg => 'stop'}], 'right data structures'; is_deeply \@raw, ['♥works♥'], 'right messages'; # Unsubscribe $pg = Mojo::Pg->new($ENV{TEST_ONLINE}); $db = undef; $pg->pubsub->on(reconnect => sub { $db = pop }); @all = @test = (); my $first = $pg->pubsub->listen(pstest => sub { push @test, pop }); my $second = $pg->pubsub->listen(pstest => sub { push @test, pop }); $db->on(notification => sub { push @all, [@_[1, 3]] }); $pg->pubsub->notify('pstest')->notify(pstest => 'first'); is_deeply \@test, ['', '', 'first', 'first'], 'right messages'; is_deeply \@all, [['pstest', ''], ['pstest', 'first']], 'right notifications'; $pg->pubsub->unlisten(pstest => $first)->notify(pstest => 'second'); is_deeply \@test, ['', '', 'first', 'first', 'second'], 'right messages'; is_deeply \@all, [['pstest', ''], ['pstest', 'first'], ['pstest', 'second']], 'right notifications'; $pg->pubsub->unlisten(pstest => $second)->notify(pstest => 'third'); is_deeply \@test, ['', '', 'first', 'first', 'second'], 'right messages'; is_deeply \@all, [['pstest', ''], ['pstest', 'first'], ['pstest', 'second']], 'right notifications'; @all = @test = (); my $third = $pg->pubsub->listen(pstest => sub { push @test, pop }); my $fourth = $pg->pubsub->listen(pstest => sub { push @test, pop }); $pg->pubsub->notify(pstest => 'first'); is_deeply \@test, ['first', 'first'], 'right messages'; $pg->pubsub->notify(pstest => 'second'); is_deeply \@test, ['first', 'first', 'second', 'second'], 'right messages'; $pg->pubsub->unlisten('pstest')->notify(pstest => 'third'); is_deeply \@test, ['first', 'first', 'second', 'second'], 'right messages'; # Reconnect while listening $pg = Mojo::Pg->new($ENV{TEST_ONLINE}); my @dbhs = @test = (); $pg->pubsub->on(reconnect => sub { push @dbhs, pop->dbh }); $pg->pubsub->listen(pstest => sub { push @test, pop }); ok $dbhs[0], 'database handle'; is_deeply \@test, [], 'no messages'; { local $dbhs[0]{Warn} = 0; $pg->pubsub->on( reconnect => sub { shift->notify(pstest => 'works'); Mojo::IOLoop->stop }); $pg->db->query('select pg_terminate_backend(?)', $dbhs[0]{pg_pid}); Mojo::IOLoop->start; ok $dbhs[1], 'database handle'; isnt $dbhs[0], $dbhs[1], 'different database handles'; is_deeply \@test, ['works'], 'right messages'; }; # Reconnect while not listening $pg = Mojo::Pg->new($ENV{TEST_ONLINE}); @dbhs = @test = (); $pg->pubsub->on(reconnect => sub { push @dbhs, pop->dbh }); $pg->pubsub->notify(pstest => 'fail'); ok $dbhs[0], 'database handle'; is_deeply \@test, [], 'no messages'; { local $dbhs[0]{Warn} = 0; $pg->pubsub->on(reconnect => sub { Mojo::IOLoop->stop }); $pg->db->query('select pg_terminate_backend(?)', $dbhs[0]{pg_pid}); Mojo::IOLoop->start; ok $dbhs[1], 'database handle'; isnt $dbhs[0], $dbhs[1], 'different database handles'; $pg->pubsub->listen(pstest => sub { push @test, pop }); $pg->pubsub->notify(pstest => 'works too'); is_deeply \@test, ['works too'], 'right messages'; }; # Fork-safety $pg = Mojo::Pg->new($ENV{TEST_ONLINE}); @dbhs = @test = (); $pg->pubsub->on(reconnect => sub { push @dbhs, pop->dbh }); $pg->pubsub->listen(pstest => sub { push @test, pop }); ok $dbhs[0], 'database handle'; $pg->pubsub->notify(pstest => 'first'); is_deeply \@test, ['first'], 'right messages'; { local $$ = -23; $pg->pubsub->notify(pstest => 'second'); ok $dbhs[1], 'database handle'; isnt $dbhs[0], $dbhs[1], 'different database handles'; is_deeply \@test, ['first'], 'right messages'; $pg->pubsub->listen(pstest => sub { push @test, pop }); $pg->pubsub->notify(pstest => 'third'); ok !$dbhs[2], 'no database handle'; is_deeply \@test, ['first', 'third'], 'right messages'; }; done_testing(); Mojo-Pg-2.35/t/results.t000644 000765 000024 00000013404 13032241443 015002 0ustar00sristaff000000 000000 use Mojo::Base -strict; BEGIN { $ENV{MOJO_REACTOR} = 'Mojo::Reactor::Poll' } use Test::More; plan skip_all => 'set TEST_ONLINE to enable this test' unless $ENV{TEST_ONLINE}; use DBD::Pg ':pg_types'; use Mojo::Pg; use Mojo::Util 'encode'; package MojoPgTest::Database; use Mojo::Base 'Mojo::Pg::Database'; sub results_class {'MojoPgTest::Results'} package MojoPgTest::Results; use Mojo::Base 'Mojo::Pg::Results'; sub array_test { shift->array } package main; # Isolate tests my $pg = Mojo::Pg->new($ENV{TEST_ONLINE})->search_path(['mojo_results_test']); $pg->db->query('drop schema if exists mojo_results_test cascade'); $pg->db->query('create schema mojo_results_test'); my $db = $pg->db; is_deeply $pg->search_path, ['mojo_results_test'], 'right search path'; $db->query( 'create table if not exists results_test ( id serial primary key, name text )' ); $db->query('insert into results_test (name) values (?)', $_) for qw(foo bar); # Tables ok !!(grep {/^mojo_results_test\.results.test$/} @{$db->tables}), 'results table exists'; ok !(grep {/^information_schema\.tables$/} @{$db->tables}), 'internal tables are hidden'; ok !(grep {/^pg_catalog\.pg_tables$/} @{$db->tables}), 'internal tables are hidden'; # Result methods is_deeply $db->query('select * from results_test')->rows, 2, 'two rows'; is_deeply $db->query('select * from results_test')->columns, ['id', 'name'], 'right structure'; is_deeply $db->query('select * from results_test')->array, [1, 'foo'], 'right structure'; is_deeply $db->query('select * from results_test')->arrays->to_array, [[1, 'foo'], [2, 'bar']], 'right structure'; is_deeply $db->query('select * from results_test')->hash, {id => 1, name => 'foo'}, 'right structure'; is_deeply $db->query('select * from results_test')->hashes->to_array, [{id => 1, name => 'foo'}, {id => 2, name => 'bar'}], 'right structure'; is $pg->db->query('select * from results_test')->text, "1 foo\n2 bar\n", 'right text'; # Custom database and results classes is ref $db, 'Mojo::Pg::Database', 'right class'; $pg->database_class('MojoPgTest::Database'); $db = $pg->db; is ref $db, 'MojoPgTest::Database', 'right class'; is ref $db->query('select 1'), 'MojoPgTest::Results', 'right class'; is_deeply $db->query('select * from results_test')->array_test, [1, 'foo'], 'right structure'; # JSON is_deeply $db->query('select ?::json as foo', {json => {bar => 'baz'}}) ->expand->hash, {foo => {bar => 'baz'}}, 'right structure'; is_deeply $db->query('select ?::json as foo', {json => {bar => 'baz'}}) ->expand->array, [{bar => 'baz'}], 'right structure'; my $hashes = [{foo => {one => 1}, bar => 'a'}, {foo => {two => 2}, bar => 'b'}]; is_deeply $db->query( "select 'a' as bar, ?::json as foo union all select 'b' as bar, ?::json as foo", {json => {one => 1}}, {json => {two => 2}} )->expand->hashes->to_array, $hashes, 'right structure'; my $arrays = [['a', {one => 1}], ['b', {two => 2}]]; is_deeply $db->query( "select 'a' as bar, ?::json as foo union all select 'b' as bar, ?::json as foo", {json => {one => 1}}, {json => {two => 2}} )->expand->arrays->to_array, $arrays, 'right structure'; # Iterate my $results = $db->query('select * from results_test'); is_deeply $results->array, [1, 'foo'], 'right structure'; is_deeply $results->array, [2, 'bar'], 'right structure'; is $results->array, undef, 'no more results'; # Non-blocking query where not all results have been fetched my ($fail, $result); Mojo::IOLoop->delay( sub { my $delay = shift; $db->query('select name from results_test' => $delay->begin); }, sub { my ($delay, $err, $results) = @_; $fail = $err; push @$result, $results->array; $results->finish; $db->query('select name from results_test' => $delay->begin); }, sub { my ($delay, $err, $results) = @_; $fail ||= $err; push @$result, $results->array_test; $results->finish; $db->query('select name from results_test' => $delay->begin); }, sub { my ($delay, $err, $results) = @_; $fail ||= $err; push @$result, $results->array; } )->wait; ok !$fail, 'no error'; is_deeply $result, [['foo'], ['foo'], ['foo']], 'right structure'; # Transactions { my $tx = $db->begin; $db->query("insert into results_test (name) values ('tx1')"); $db->query("insert into results_test (name) values ('tx1')"); $tx->commit; }; is_deeply $db->query('select * from results_test where name = ?', 'tx1') ->hashes->to_array, [{id => 3, name => 'tx1'}, {id => 4, name => 'tx1'}], 'right structure'; { my $tx = $db->begin; $db->query("insert into results_test (name) values ('tx2')"); $db->query("insert into results_test (name) values ('tx2')"); }; is_deeply $db->query('select * from results_test where name = ?', 'tx2') ->hashes->to_array, [], 'no results'; eval { my $tx = $db->begin; $db->query("insert into results_test (name) values ('tx3')"); $db->query("insert into results_test (name) values ('tx3')"); $db->query('does_not_exist'); $tx->commit; }; like $@, qr/does_not_exist/, 'right error'; is_deeply $db->query('select * from results_test where name = ?', 'tx3') ->hashes->to_array, [], 'no results'; # Long-lived results my $results1 = $db->query('select 1 as one'); is_deeply $results1->hashes, [{one => 1}], 'right structure'; my $results2 = $db->query('select 1 as one'); undef $results1; is_deeply $results2->hashes, [{one => 1}], 'right structure'; # Custom data types $db->query('create table if not exists results_test2 (stuff bytea)'); my $snowman = encode 'UTF-8', '☃'; $db->query( 'insert into results_test2 (stuff) values (?)', {value => $snowman, type => PG_BYTEA} ); is_deeply $db->query('select * from results_test2')->hash, {stuff => $snowman}, 'right structure'; # Clean up once we are done $pg->db->query('drop schema mojo_results_test cascade'); done_testing(); Mojo-Pg-2.35/t/migrations/test.sql000644 000765 000024 00000000422 12733154131 016770 0ustar00sristaff000000 000000 -- 1 up create table if not exists migration_test_three (baz varchar(255)); -- 1 down drop table if exists migration_test_three; -- 2 up insert into migration_test_three values ('just'); insert into migration_test_three values ('works ♥'); -- 3 up -- 4 up does_not_exist; Mojo-Pg-2.35/lib/Mojo/000755 000765 000024 00000000000 13035370163 014326 5ustar00sristaff000000 000000 Mojo-Pg-2.35/lib/Mojo/Pg/000755 000765 000024 00000000000 13035370163 014674 5ustar00sristaff000000 000000 Mojo-Pg-2.35/lib/Mojo/Pg.pm000644 000765 000024 00000032065 13032241737 015241 0ustar00sristaff000000 000000 package Mojo::Pg; use Mojo::Base 'Mojo::EventEmitter'; use Carp 'croak'; use DBI; use Mojo::Pg::Database; use Mojo::Pg::Migrations; use Mojo::Pg::PubSub; use Mojo::URL; use Scalar::Util 'weaken'; has [qw(auto_migrate search_path)]; has database_class => 'Mojo::Pg::Database'; has dsn => 'dbi:Pg:'; has max_connections => 5; has migrations => sub { my $migrations = Mojo::Pg::Migrations->new(pg => shift); weaken $migrations->{pg}; return $migrations; }; has options => sub { {AutoCommit => 1, AutoInactiveDestroy => 1, PrintError => 0, RaiseError => 1}; }; has [qw(password username)] => ''; has pubsub => sub { my $pubsub = Mojo::Pg::PubSub->new(pg => shift); weaken $pubsub->{pg}; return $pubsub; }; our $VERSION = '2.35'; sub db { $_[0]->database_class->new(dbh => $_[0]->_dequeue, pg => $_[0]) } sub from_string { my ($self, $str) = @_; # Protocol return $self unless $str; my $url = Mojo::URL->new($str); croak qq{Invalid PostgreSQL connection string "$str"} unless $url->protocol =~ /^postgres(?:ql)?$/; # Connection information my $db = $url->path->parts->[0]; my $dsn = defined $db ? "dbi:Pg:dbname=$db" : 'dbi:Pg:'; if (my $host = $url->host) { $dsn .= ";host=$host" } if (my $port = $url->port) { $dsn .= ";port=$port" } if (defined(my $username = $url->username)) { $self->username($username) } if (defined(my $password = $url->password)) { $self->password($password) } # Service my $hash = $url->query->to_hash; if (my $service = delete $hash->{service}) { $dsn .= "service=$service" } # Options @{$self->options}{keys %$hash} = values %$hash; return $self->dsn($dsn); } sub new { @_ > 1 ? shift->SUPER::new->from_string(@_) : shift->SUPER::new } sub _dequeue { my $self = shift; # Fork-safety delete @$self{qw(pid queue)} unless ($self->{pid} //= $$) eq $$; while (my $dbh = shift @{$self->{queue} || []}) { return $dbh if $dbh->ping } my $dbh = DBI->connect(map { $self->$_ } qw(dsn username password options)); # Search path if (my $path = $self->search_path) { my $search_path = join ', ', map { $dbh->quote_identifier($_) } @$path; $dbh->do("set search_path to $search_path"); } # Automatic migrations ++$self->{migrated} and $self->migrations->migrate if !$self->{migrated} && $self->auto_migrate; $self->emit(connection => $dbh); return $dbh; } sub _enqueue { my ($self, $dbh) = @_; my $queue = $self->{queue} ||= []; push @$queue, $dbh if $dbh->{Active}; shift @$queue while @$queue > $self->max_connections; } 1; =encoding utf8 =head1 NAME Mojo::Pg - Mojolicious ♥ PostgreSQL =head1 SYNOPSIS use Mojo::Pg; # Select the server version my $pg = Mojo::Pg->new('postgresql://postgres@/test'); say $pg->db->query('select version() as version')->hash->{version}; # Use migrations to create a table $pg->migrations->name('my_names_app')->from_string(<migrate; -- 1 up create table names (id serial primary key, name text); -- 1 down drop table names; EOF # Use migrations to drop and recreate the table $pg->migrations->migrate(0)->migrate; # Insert a few rows my $db = $pg->db; $db->query('insert into names (name) values (?)', 'Sara'); $db->query('insert into names (name) values (?)', 'Stefan'); # Insert more rows in a transaction eval { my $tx = $db->begin; $db->query('insert into names (name) values (?)', 'Baerbel'); $db->query('insert into names (name) values (?)', 'Wolfgang'); $tx->commit; }; say $@ if $@; # Insert another row and return the generated id say $db->query('insert into names (name) values (?) returning id', 'Daniel') ->hash->{id}; # JSON roundtrip say $db->query('select ?::json as foo', {json => {bar => 'baz'}}) ->expand->hash->{foo}{bar}; # Select one row at a time my $results = $db->query('select * from names'); while (my $next = $results->hash) { say $next->{name}; } # Select all rows blocking say $_->{name} for $db->query('select * from names')->hashes->each; # Select all rows non-blocking $db->query('select * from names' => sub { my ($db, $err, $results) = @_; die $err if $err; say $_->{name} for $results->hashes->each; }); Mojo::IOLoop->start unless Mojo::IOLoop->is_running; # Concurrent non-blocking queries (synchronized with a delay) Mojo::IOLoop->delay( sub { my $delay = shift; $pg->db->query('select now() as now' => $delay->begin); $pg->db->query('select * from names' => $delay->begin); }, sub { my ($delay, $time_err, $time, $names_err, $names) = @_; if (my $err = $time_err || $names_err) { die $err } say $time->hash->{now}; say $_->{name} for $names->hashes->each; } )->wait; # Send and receive notifications non-blocking $pg->pubsub->listen(foo => sub { my ($pubsub, $payload) = @_; say "foo: $payload"; $pubsub->notify(bar => $payload); }); $pg->pubsub->listen(bar => sub { my ($pubsub, $payload) = @_; say "bar: $payload"; }); $pg->pubsub->notify(foo => 'PostgreSQL rocks!'); Mojo::IOLoop->start unless Mojo::IOLoop->is_running; =head1 DESCRIPTION L is a tiny wrapper around L that makes L a lot of fun to use with the L real-time web framework. 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. use Mojolicious::Lite; use Mojo::Pg; helper pg => sub { state $pg = Mojo::Pg->new('postgresql://postgres@/test') }; get '/' => sub { my $c = shift; my $db = $c->pg->db; $c->render(json => $db->query('select now() as now')->hash); }; app->start; In this example application, we create a C helper to store a L object. Our action calls that helper and uses the method L to dequeue a L object from the connection pool. Then we use the method L to execute an L statement, which returns a L object. And finally we call the method L to retrieve the first row as a hash reference. While all I/O operations are performed blocking, you can wait for long running queries asynchronously, allowing the L event loop to perform other tasks in the meantime. Since database connections usually have a very low latency, this often results in very good performance. Every database connection can only handle one active query at a time, this includes asynchronous ones. To perform multiple queries concurrently, you have to use multiple connections. # Performed concurrently (5 seconds) $pg->db->query('select pg_sleep(5)' => sub {...}); $pg->db->query('select pg_sleep(5)' => sub {...}); All cached database handles will be reset automatically if a new process has been forked, this allows multiple processes to share the same L object safely. =head1 GROWING And as your application grows, you can move queries into model classes. package MyApp::Model::Time; use Mojo::Base -base; has 'pg'; sub now { shift->pg->db->query('select now() as now')->hash } 1; Which get integrated into your application with helpers. use Mojolicious::Lite; use Mojo::Pg; use MyApp::Model::Time; helper pg => sub { state $pg = Mojo::Pg->new('postgresql://postgres@/test') }; helper time => sub { state $time = MyApp::Model::Time->new(pg => shift->pg) }; get '/' => sub { my $c = shift; $c->render(json => $c->time->now); }; app->start; =head1 EVENTS L inherits all events from L and can emit the following new ones. =head2 connection $pg->on(connection => sub { my ($pg, $dbh) = @_; ... }); Emitted when a new database connection has been established. $pg->on(connection => sub { my ($pg, $dbh) = @_; $dbh->do('set search_path to my_schema'); }); =head1 ATTRIBUTES L implements the following attributes. =head2 auto_migrate my $bool = $pg->auto_migrate; $pg = $pg->auto_migrate($bool); Automatically migrate to the latest database schema with L, as soon as the first database connection has been established. =head2 database_class my $class = $pg->database_class; $pg = $pg->database_class('MyApp::Database'); Class to be used by L, defaults to L. Note that this class needs to have already been loaded before L is called. =head2 dsn my $dsn = $pg->dsn; $pg = $pg->dsn('dbi:Pg:dbname=foo'); Data source name, defaults to C. =head2 max_connections my $max = $pg->max_connections; $pg = $pg->max_connections(3); Maximum number of idle database handles to cache for future use, defaults to C<5>. =head2 migrations my $migrations = $pg->migrations; $pg = $pg->migrations(Mojo::Pg::Migrations->new); L object you can use to change your database schema more easily. # Load migrations from file and migrate to latest version $pg->migrations->from_file('/home/sri/migrations.sql')->migrate; =head2 options my $options = $pg->options; $pg = $pg->options({AutoCommit => 1, RaiseError => 1}); Options for database handles, defaults to activating C, C as well as C and deactivating C. Note that C and C are considered mandatory, so deactivating them would be very dangerous. =head2 password my $password = $pg->password; $pg = $pg->password('s3cret'); Database password, defaults to an empty string. =head2 pubsub my $pubsub = $pg->pubsub; $pg = $pg->pubsub(Mojo::Pg::PubSub->new); L object you can use to send and receive notifications very efficiently, by sharing a single database connection with many consumers. # Subscribe to a channel $pg->pubsub->listen(news => sub { my ($pubsub, $payload) = @_; say "Received: $payload"; }); # Notify a channel $pg->pubsub->notify(news => 'PostgreSQL rocks!'); =head2 search_path my $path = $pg->search_path; $pg = $pg->search_path(['$user', 'foo', 'public']); Schema search path assigned to all new connections. # Isolate tests and avoid race conditions when running them in parallel my $pg = Mojo::Pg->new('postgresql:///test')->search_path(['test_one']); $pg->db->query('drop schema if exists test_one cascade'); $pg->db->query('create schema test_one'); ... $pg->db->query('drop schema test_one cascade'); =head2 username my $username = $pg->username; $pg = $pg->username('sri'); Database username, defaults to an empty string. =head1 METHODS L inherits all methods from L and implements the following new ones. =head2 db my $db = $pg->db; Get a database object based on L for a cached or newly established database connection. The L database handle will be automatically cached again when that object is destroyed, so you can handle problems like connection timeouts gracefully by holding on to it only for short amounts of time. # Add up all the money say $pg->db->query('select * from accounts') ->hashes->reduce(sub { $a->{money} + $b->{money} }); =head2 from_string $pg = $pg->from_string('postgresql://postgres@/test'); Parse configuration from connection string. # Just a database $pg->from_string('postgresql:///db1'); # Just a service $pg->from_string('postgresql://?service=foo'); # Username and database $pg->from_string('postgresql://sri@/db2'); # Short scheme, username, password, host and database $pg->from_string('postgres://sri:s3cret@localhost/db3'); # Username, domain socket and database $pg->from_string('postgresql://sri@%2ftmp%2fpg.sock/db4'); # Username, database and additional options $pg->from_string('postgresql://sri@/db5?PrintError=1&pg_server_prepare=0'); # Service and additional options $pg->from_string('postgresql://?service=foo&PrintError=1&RaiseError=0'); =head2 new my $pg = Mojo::Pg->new; my $pg = Mojo::Pg->new('postgresql://postgres@/test'); Construct a new L object and parse connection string with L if necessary. # Customize configuration further my $pg = Mojo::Pg->new->dsn('dbi:Pg:service=foo'); =head1 REFERENCE This is the class hierarchy of the L distribution. =over 2 =item * L =item * L =item * L =item * L =item * L =item * L =back =head1 AUTHOR Sebastian Riedel, C. =head1 CREDITS In alphabetical order: =over 2 Dan Book Flavio Poletti Hernan Lopes William Lindley =back =head1 COPYRIGHT AND LICENSE Copyright (C) 2014-2017, Sebastian Riedel and others. This program is free software, you can redistribute it and/or modify it under the terms of the Artistic License version 2.0. =head1 SEE ALSO L, L, L. =cut Mojo-Pg-2.35/lib/Mojo/Pg/Database.pm000644 000765 000024 00000021425 13027460401 016736 0ustar00sristaff000000 000000 package Mojo::Pg::Database; use Mojo::Base 'Mojo::EventEmitter'; use Carp qw(croak shortmess); use DBD::Pg ':async'; use Mojo::IOLoop; use Mojo::JSON 'to_json'; use Mojo::Pg::Results; use Mojo::Pg::Transaction; use Scalar::Util 'weaken'; has [qw(dbh pg)]; has results_class => 'Mojo::Pg::Results'; sub DESTROY { my $self = shift; my $waiting = $self->{waiting}; $waiting->{cb}($self, 'Premature connection close', undef) if $waiting->{cb}; return unless (my $pg = $self->pg) && (my $dbh = $self->dbh); $pg->_enqueue($dbh); } sub begin { my $self = shift; my $tx = Mojo::Pg::Transaction->new(db => $self); weaken $tx->{db}; return $tx; } sub disconnect { my $self = shift; $self->_unwatch; $self->dbh->disconnect; } sub dollar_only { ++$_[0]{dollar_only} and return $_[0] } sub is_listening { !!keys %{shift->{listen} || {}} } sub listen { my ($self, $name) = @_; my $dbh = $self->dbh; $dbh->do('listen ' . $dbh->quote_identifier($name)) unless $self->{listen}{$name}++; $self->_watch; return $self; } sub notify { my ($self, $name, $payload) = @_; my $dbh = $self->dbh; my $notify = 'notify ' . $dbh->quote_identifier($name); $notify .= ', ' . $dbh->quote($payload) if defined $payload; $dbh->do($notify); $self->_notifications; return $self; } sub pid { shift->dbh->{pg_pid} } sub ping { shift->dbh->ping } sub query { my ($self, $query) = (shift, shift); my $cb = ref $_[-1] eq 'CODE' ? pop : undef; croak 'Non-blocking query already in progress' if $self->{waiting}; my %attrs; $attrs{pg_placeholder_dollaronly} = 1 if delete $self->{dollar_only}; $attrs{pg_async} = PG_ASYNC if $cb; my $sth = $self->dbh->prepare_cached($query, \%attrs, 3); local $sth->{HandleError} = sub { $_[0] = shortmess $_[0]; 0 }; for (my $i = 0; $#_ >= $i; $i++) { my ($param, $attrs) = ($_[$i], {}); if (ref $param eq 'HASH') { if (exists $param->{json}) { $param = to_json $param->{json} } elsif (exists $param->{type} && exists $param->{value}) { ($attrs->{pg_type}, $param) = @{$param}{qw(type value)}; } } $sth->bind_param($i + 1, $param, $attrs); } $sth->execute; # Blocking unless ($cb) { $self->_notifications; return $self->results_class->new(sth => $sth); } # Non-blocking $self->{waiting} = {cb => $cb, sth => $sth}; $self->_watch; } sub tables { my @tables = shift->dbh->tables('', '', '', ''); return [grep { $_ !~ /^(?:pg_catalog|information_schema)\./ } @tables]; } sub unlisten { my ($self, $name) = @_; my $dbh = $self->dbh; $dbh->do('unlisten ' . $dbh->quote_identifier($name)); $name eq '*' ? delete $self->{listen} : delete $self->{listen}{$name}; $self->_unwatch unless $self->{waiting} || $self->is_listening; return $self; } sub _notifications { my $self = shift; my $dbh = $self->dbh; while (my $n = $dbh->pg_notifies) { $self->emit(notification => @$n) } } sub _unwatch { my $self = shift; return unless delete $self->{watching}; Mojo::IOLoop->singleton->reactor->remove($self->{handle}); $self->emit('close') if $self->is_listening; } sub _watch { my $self = shift; return if $self->{watching} || $self->{watching}++; my $dbh = $self->dbh; unless ($self->{handle}) { open $self->{handle}, '<&', $dbh->{pg_socket} or die "Can't dup: $!"; } Mojo::IOLoop->singleton->reactor->io( $self->{handle} => sub { my $reactor = shift; $self->_unwatch if !eval { $self->_notifications; 1 }; return unless $self->{waiting} && $dbh->pg_ready; my ($sth, $cb) = @{delete $self->{waiting}}{qw(sth cb)}; # Do not raise exceptions inside the event loop 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->_unwatch unless $self->{waiting} || $self->is_listening; } )->watch($self->{handle}, 1, 0); } 1; =encoding utf8 =head1 NAME Mojo::Pg::Database - Database =head1 SYNOPSIS use Mojo::Pg::Database; my $db = Mojo::Pg::Database->new(pg => $pg, dbh => $dbh); $db->query('select * from foo') ->hashes->map(sub { $_->{bar} })->join("\n")->say; =head1 DESCRIPTION L is a container for L database handles used by L. =head1 EVENTS L inherits all events from L and can emit the following new ones. =head2 close $db->on(close => sub { my $db = shift; ... }); Emitted when the database connection gets closed while waiting for notifications. =head2 notification $db->on(notification => sub { my ($db, $name, $pid, $payload) = @_; ... }); Emitted when a notification has been received. =head1 ATTRIBUTES L implements the following attributes. =head2 dbh my $dbh = $db->dbh; $db = $db->dbh($dbh); L database handle used for all queries. # Use DBI utility methods my $quoted = $db->dbh->quote_identifier('foo.bar'); =head2 pg my $pg = $db->pg; $db = $db->pg(Mojo::Pg->new); L object this database belongs to. =head2 results_class my $class = $db->results_class; $db = $db->results_class('MyApp::Results'); Class to be used by L, defaults to L. Note that this class needs to have already been loaded before L is called. =head1 METHODS L inherits all methods from L and implements the following new ones. =head2 begin my $tx = $db->begin; Begin transaction and return L object, which will automatically roll back the transaction unless L has been called before it is destroyed. # Insert rows in a transaction eval { my $tx = $db->begin; $db->query('insert into frameworks values (?)', 'Catalyst'); $db->query('insert into frameworks values (?)', 'Mojolicious'); $tx->commit; }; say $@ if $@; =head2 disconnect $db->disconnect; Disconnect L and prevent it from getting reused. =head2 dollar_only $db = $db->dollar_only; Activate C for next L call and allow C to be used as an operator. # Check for a key in a JSON document $db->dollar_only->query('select * from foo where bar ? $1', 'baz') ->expand->hashes->map(sub { $_->{bar}{baz} })->join("\n")->say; =head2 is_listening my $bool = $db->is_listening; Check if L is listening for notifications. =head2 listen $db = $db->listen('foo'); Subscribe to a channel and receive L events when the L event loop is running. =head2 notify $db = $db->notify('foo'); $db = $db->notify(foo => 'bar'); Notify a channel. =head2 pid my $pid = $db->pid; Return the process id of the backend server process. =head2 ping my $bool = $db->ping; Check database connection. =head2 query my $results = $db->query('select * from foo'); my $results = $db->query('insert into foo values (?, ?, ?)', @values); my $results = $db->query('select ?::json as foo', {json => {bar => 'baz'}}); Execute a blocking L statement and return a results object based on L with the query results. The L statement handle will be automatically reused when it is not active anymore, to increase the performance of future queries. You can also append a callback to perform operations non-blocking. $db->query('insert into foo values (?, ?, ?)' => @values => sub { my ($db, $err, $results) = @_; ... }); Mojo::IOLoop->start unless Mojo::IOLoop->is_running; Hash reference arguments containing a value named C, will be encoded to JSON text with L. To accomplish the reverse, you can use the method L, which automatically decodes all fields of the types C and C with L to Perl values. # "I ♥ Mojolicious!" $db->query('select ?::jsonb as foo', {json => {bar => 'I ♥ Mojolicious!'}}) ->expand->hash->{foo}{bar}; Hash reference arguments containing values named C and C, can be used to bind specific L data types to placeholders. # Insert binary data use DBD::Pg ':pg_types'; $db->query('insert into bar values (?)', {type => PG_BYTEA, value => $bytes}); =head2 tables my $tables = $db->tables; Return table and view names for this database, that are visible to the current user and not internal, as an array reference. # Names of all tables say for @{$db->tables}; =head2 unlisten $db = $db->unlisten('foo'); $db = $db->unlisten('*'); Unsubscribe from a channel, C<*> can be used to unsubscribe from all channels. =head1 SEE ALSO L, L, L. =cut Mojo-Pg-2.35/lib/Mojo/Pg/Migrations.pm000644 000765 000024 00000013551 13035370031 017345 0ustar00sristaff000000 000000 package Mojo::Pg::Migrations; use Mojo::Base -base; use Carp 'croak'; use Mojo::File 'path'; use Mojo::Loader 'data_section'; use Mojo::Util 'decode'; use constant DEBUG => $ENV{MOJO_MIGRATIONS_DEBUG} || 0; has name => 'migrations'; has 'pg'; sub active { $_[0]->_active($_[0]->pg->db) } sub from_data { my ($self, $class, $name) = @_; return $self->from_string( data_section($class //= caller, $name // $self->name)); } sub from_file { shift->from_string(decode 'UTF-8', path(pop)->slurp) } sub from_string { my ($self, $sql) = @_; my ($version, $way); my $migrations = $self->{migrations} = {up => {}, down => {}}; for my $line (split "\n", $sql // '') { ($version, $way) = ($1, lc $2) if $line =~ /^\s*--\s*(\d+)\s*(up|down)/i; $migrations->{$way}{$version} .= "$line\n" if $version; } return $self; } sub latest { (sort { $a <=> $b } keys %{shift->{migrations}{up}})[-1] || 0; } sub migrate { my ($self, $target) = @_; # Unknown version my $latest = $self->latest; $target //= $latest; my ($up, $down) = @{$self->{migrations}}{qw(up down)}; croak "Version $target has no migration" if $target != 0 && !$up->{$target}; # Already the right version (make sure migrations table exists) my $db = $self->pg->db; return $self if $self->_active($db, 1) == $target; # Lock migrations table and check version again my $tx = $db->begin; $db->query('lock table mojo_migrations in exclusive mode'); return $self if (my $active = $self->_active($db, 1)) == $target; # Newer version 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}; } 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; return $self; } sub _active { my ($self, $db, $create) = @_; my $name = $self->name; my $results; { local $db->dbh->{RaiseError} = 0; my $sql = 'select version from mojo_migrations where name = $1'; $results = $db->query($sql, $name); }; if ((my $next = $results->array) || !$create) { return $next->[0] || 0 } $db->query( 'create table if not exists mojo_migrations ( name text unique not null, version bigint not null check (version >= 0) )' ) if $results->sth->err; $db->query('insert into mojo_migrations values ($1, $2)', $name, 0); return 0; } 1; =encoding utf8 =head1 NAME Mojo::Pg::Migrations - Migrations =head1 SYNOPSIS use Mojo::Pg::Migrations; my $migrations = Mojo::Pg::Migrations->new(pg => $pg); $migrations->from_file('/home/sri/migrations.sql')->migrate; =head1 DESCRIPTION L is used by L to allow database schemas to evolve easily over time. A migration file is just a collection of sql blocks, with one or more statements, separated by comments of the form C<-- VERSION UP/DOWN>. -- 1 up create table messages (message text); insert into messages values ('I ♥ Mojolicious!'); -- 1 down drop table messages; -- 2 up (...you can comment freely here...) create table stuff (whatever int); -- 2 down drop table stuff; The idea is to let you migrate from any version, to any version, up and down. Migrations are very safe, because they are performed in transactions and only one can be performed at a time. If a single statement fails, the whole migration will fail and get rolled back. Every set of migrations has a L, which is stored together with the currently active version in an automatically created table named C. =head1 ATTRIBUTES L implements the following attributes. =head2 name my $name = $migrations->name; $migrations = $migrations->name('foo'); Name for this set of migrations, defaults to C. =head2 pg my $pg = $migrations->pg; $migrations = $migrations->pg(Mojo::Pg->new); L object these migrations belong to. =head1 METHODS L inherits all methods from L and implements the following new ones. =head2 active my $version = $migrations->active; Currently active version. =head2 from_data $migrations = $migrations->from_data; $migrations = $migrations->from_data('main'); $migrations = $migrations->from_data('main', 'file_name'); Extract migrations from a file in the DATA section of a class with L, defaults to using the caller class and L. __DATA__ @@ migrations -- 1 up create table messages (message text); insert into messages values ('I ♥ Mojolicious!'); -- 1 down drop table messages; =head2 from_file $migrations = $migrations->from_file('/home/sri/migrations.sql'); Extract migrations from a file. =head2 from_string $migrations = $migrations->from_string( '-- 1 up create table foo (bar int); -- 1 down drop table foo;' ); Extract migrations from string. =head2 latest my $version = $migrations->latest; Latest version available. =head2 migrate $migrations = $migrations->migrate; $migrations = $migrations->migrate(3); Migrate from L to a different version, up or down, defaults to using L. All version numbers need to be positive, with version C<0> representing an empty database. # Reset database $migrations->migrate(0)->migrate; =head1 DEBUGGING You can set the C environment variable to get some advanced diagnostics information printed to C. MOJO_MIGRATIONS_DEBUG=1 =head1 SEE ALSO L, L, L. =cut Mojo-Pg-2.35/lib/Mojo/Pg/PubSub.pm000644 000765 000024 00000010356 13032241614 016432 0ustar00sristaff000000 000000 package Mojo::Pg::PubSub; use Mojo::Base 'Mojo::EventEmitter'; use Mojo::JSON qw(from_json to_json); use Scalar::Util 'weaken'; has 'pg'; sub DESTROY { Mojo::Util::_global_destruction() or shift->_cleanup } sub json { ++$_[0]{json}{$_[1]} and return $_[0] } sub listen { my ($self, $name, $cb) = @_; $self->_db->listen($name) unless @{$self->{chans}{$name} ||= []}; push @{$self->{chans}{$name}}, $cb; return $cb; } sub notify { $_[0]->_db->notify(_json(@_)) and return $_[0] } sub unlisten { my ($self, $name, $cb) = @_; my $chan = $self->{chans}{$name}; @$chan = $cb ? grep { $cb ne $_ } @$chan : (); $self->_db->unlisten($name) and delete $self->{chans}{$name} unless @$chan; return $self; } sub _cleanup { my $self = shift; $self->{db}->_unwatch; delete @$self{qw(chans db pid)}; } sub _db { my $self = shift; # Fork-safety $self->_cleanup unless ($self->{pid} //= $$) eq $$; return $self->{db} if $self->{db}; my $db = $self->{db} = $self->pg->db; weaken $db->{pg}; weaken $self; $db->on( notification => sub { my ($db, $name, $pid, $payload) = @_; $payload = eval { from_json $payload } if $self->{json}{$name}; for my $cb (@{$self->{chans}{$name}}) { $self->$cb($payload) } } ); $db->once( close => sub { delete $self->{db}; eval { $self->_db }; } ); $db->listen($_) for keys %{$self->{chans}}, 'mojo.pubsub'; $self->emit(reconnect => $db); return $db; } sub _json { $_[1], $_[0]{json}{$_[1]} ? to_json $_[2] : $_[2] } 1; =encoding utf8 =head1 NAME Mojo::Pg::PubSub - Publish/Subscribe =head1 SYNOPSIS use Mojo::Pg::PubSub; my $pubsub = Mojo::Pg::PubSub->new(pg => $pg); my $cb = $pubsub->listen(foo => sub { my ($pubsub, $payload) = @_; say "Received: $payload"; }); $pubsub->notify(foo => 'I ♥ Mojolicious!'); $pubsub->unlisten(foo => $cb); =head1 DESCRIPTION L is a scalable implementation of the publish/subscribe pattern used by L. It is based on PostgreSQL notifications and allows many consumers to share the same database connection, to avoid many common scalability problems. All subscriptions will be reset automatically and the database connection re-established if a new process has been forked, this allows multiple processes to share the same L object safely. =head1 EVENTS L inherits all events from L and can emit the following new ones. =head2 reconnect $pubsub->on(reconnect => sub { my ($pubsub, $db) = @_; ... }); Emitted after switching to a new database connection for sending and receiving notifications. =head1 ATTRIBUTES L implements the following attributes. =head2 pg my $pg = $pubsub->pg; $pubsub = $pubsub->pg(Mojo::Pg->new); L object this publish/subscribe container belongs to. =head1 METHODS L inherits all methods from L and implements the following new ones. =head2 json $pubsub = $pubsub->json('foo'); Activate automatic JSON encoding and decoding with L and L for a channel. # Send and receive data structures $pubsub->json('foo')->listen(foo => sub { my ($pubsub, $payload) = @_; say $payload->{bar}; }); $pubsub->notify(foo => {bar => 'I ♥ Mojolicious!'}); =head2 listen my $cb = $pubsub->listen(foo => sub {...}); Subscribe to a channel, there is no limit on how many subscribers a channel can have. Automatic decoding of JSON text to Perl values can be activated with L. # Subscribe to the same channel twice $pubsub->listen(foo => sub { my ($pubsub, $payload) = @_; say "One: $payload"; }); $pubsub->listen(foo => sub { my ($pubsub, $payload) = @_; say "Two: $payload"; }); =head2 notify $pubsub = $pubsub->notify('foo'); $pubsub = $pubsub->notify(foo => 'I ♥ Mojolicious!'); $pubsub = $pubsub->notify(foo => {bar => 'baz'}); Notify a channel. Automatic encoding of Perl values to JSON text can be activated with L. =head2 unlisten $pubsub = $pubsub->unlisten('foo'); $pubsub = $pubsub->unlisten(foo => $cb); Unsubscribe from a channel. =head1 SEE ALSO L, L, L. =cut Mojo-Pg-2.35/lib/Mojo/Pg/Results.pm000644 000765 000024 00000010300 12762356016 016674 0ustar00sristaff000000 000000 package Mojo::Pg::Results; use Mojo::Base -base; use Mojo::Collection; use Mojo::JSON 'from_json'; use Mojo::Util 'tablify'; has 'sth'; sub DESTROY { my $self = shift; return unless my $sth = $self->{sth}; $sth->finish unless --$sth->{private_mojo_results}; } sub array { ($_[0]->_expand($_[0]->sth->fetchrow_arrayref))[0] } sub arrays { _collect($_[0]->_expand(@{$_[0]->sth->fetchall_arrayref})) } sub columns { shift->sth->{NAME} } sub hash { ($_[0]->_expand($_[0]->sth->fetchrow_hashref))[0] } sub expand { ++$_[0]{expand} and return $_[0] } sub finish { shift->sth->finish } sub hashes { _collect($_[0]->_expand(@{$_[0]->sth->fetchall_arrayref({})})) } sub new { my $self = shift->SUPER::new(@_); ($self->{sth}{private_mojo_results} //= 0)++; return $self; } sub rows { shift->sth->rows } sub text { tablify shift->arrays } sub _collect { Mojo::Collection->new(@_) } sub _expand { my ($self, @rows) = @_; return @rows unless $self->{expand} && $rows[0]; my ($idx, $name) = @$self{qw(idx name)}; unless ($idx) { my $types = $self->sth->{pg_type}; my @idx = grep { $types->[$_] eq 'json' || $types->[$_] eq 'jsonb' } 0 .. $#$types; ($idx, $name) = @$self{qw(idx name)} = (\@idx, [@{$self->columns}[@idx]]); } return @rows unless @$idx; if (ref $rows[0] eq 'HASH') { for my $r (@rows) { $r->{$_} && ($r->{$_} = from_json $r->{$_}) for @$name } } else { for my $r (@rows) { $r->[$_] && ($r->[$_] = from_json $r->[$_]) for @$idx } } return @rows; } 1; =encoding utf8 =head1 NAME Mojo::Pg::Results - Results =head1 SYNOPSIS use Mojo::Pg::Results; my $results = Mojo::Pg::Results->new(sth => $sth); $results->hashes->map(sub { $_->{foo} })->shuffle->join("\n")->say; =head1 DESCRIPTION L is a container for L statement handles used by L. =head1 ATTRIBUTES L implements the following attributes. =head2 sth my $sth = $results->sth; $results = $results->sth($sth); L statement handle results are fetched from. =head1 METHODS L inherits all methods from L and implements the following new ones. =head2 array my $array = $results->array; Fetch next row from L and return it as an array reference. Note that L needs to be called if you are not fetching all the possible rows. # Process one row at a time while (my $next = $results->array) { say $next->[3]; } =head2 arrays my $collection = $results->arrays; Fetch all rows from L and return them as a L object containing array references. # Process all rows at once say $results->arrays->reduce(sub { $a->[3] + $b->[3] }); =head2 columns my $columns = $results->columns; Return column names as an array reference. # Names of all columns say for @{$results->columns}; =head2 expand $results = $results->expand; Decode C and C fields automatically to Perl values for all rows. # Expand JSON $results->expand->hashes->map(sub { $_->{foo}{bar} })->join("\n")->say; =head2 finish $results->finish; Indicate that you are finished with L and will not be fetching all the remaining rows. =head2 hash my $hash = $results->hash; Fetch next row from L and return it as a hash reference. Note that L needs to be called if you are not fetching all the possible rows. # Process one row at a time while (my $next = $results->hash) { say $next->{money}; } =head2 hashes my $collection = $results->hashes; Fetch all rows from L and return them as a L object containing hash references. # Process all rows at once say $results->hashes->reduce(sub { $a->{money} + $b->{money} }); =head2 new my $results = Mojo::Pg::Results->new; my $results = Mojo::Pg::Results->new(sth => $sth); my $results = Mojo::Pg::Results->new({sth => $sth}); Construct a new L object. =head2 rows my $num = $results->rows; Number of rows. =head2 text my $text = $results->text; Fetch all rows from L and turn them into a table with L. =head1 SEE ALSO L, L, L. =cut Mojo-Pg-2.35/lib/Mojo/Pg/Transaction.pm000644 000765 000024 00000002712 12762337453 017534 0ustar00sristaff000000 000000 package Mojo::Pg::Transaction; use Mojo::Base -base; has 'db'; sub DESTROY { my $self = shift; if ($self->{rollback} && (my $dbh = $self->{dbh})) { $dbh->rollback } } sub commit { my $self = shift; $self->{dbh}->commit if delete $self->{rollback}; if (my $db = $self->db) { $db->_notifications } } sub new { my $self = shift->SUPER::new(@_, rollback => 1); my $dbh = $self->{dbh} = $self->db->dbh; $dbh->begin_work; return $self; } 1; =encoding utf8 =head1 NAME Mojo::Pg::Transaction - Transaction =head1 SYNOPSIS use Mojo::Pg::Transaction; my $tx = Mojo::Pg::Transaction->new(db => $db); $tx->commit; =head1 DESCRIPTION L is a scope guard for L transactions used by L. =head1 ATTRIBUTES L implements the following attributes. =head2 db my $db = $tx->db; $tx = $tx->db(Mojo::Pg::Database->new); L object this transaction belongs to. =head1 METHODS L inherits all methods from L and implements the following new ones. =head2 commit $tx->commit; Commit transaction. =head2 new my $tx = Mojo::Pg::Transaction->new; my $tx = Mojo::Pg::Transaction->new(db => Mojo::Pg::Database->new); my $tx = Mojo::Pg::Transaction->new({db => Mojo::Pg::Database->new}); Construct a new L object. =head1 SEE ALSO L, L, L. =cut Mojo-Pg-2.35/examples/blog/000755 000765 000024 00000000000 13035370163 015415 5ustar00sristaff000000 000000 Mojo-Pg-2.35/examples/chat.pl000644 000765 000024 00000001656 12762335577 015776 0ustar00sristaff000000 000000 use Mojolicious::Lite; use Mojo::Pg; helper pg => sub { state $pg = Mojo::Pg->new('postgresql://postgres@/test') }; get '/' => 'chat'; websocket '/channel' => sub { my $c = shift; $c->inactivity_timeout(3600); # Forward messages from the browser to PostgreSQL $c->on(message => sub { shift->pg->pubsub->notify(mojochat => shift) }); # Forward messages from PostgreSQL to the browser my $cb = $c->pg->pubsub->listen(mojochat => sub { $c->send(pop) }); $c->on(finish => sub { shift->pg->pubsub->unlisten(mojochat => $cb) }); }; app->start; __DATA__ @@ chat.html.ep
Mojo-Pg-2.35/examples/blog/blog.conf000644 000765 000024 00000000104 13027460640 017203 0ustar00sristaff000000 000000 {pg => 'postgresql://tester:testing@/test', secrets => ['s3cret']}; Mojo-Pg-2.35/examples/blog/lib/000755 000765 000024 00000000000 13035370163 016163 5ustar00sristaff000000 000000 Mojo-Pg-2.35/examples/blog/migrations/000755 000765 000024 00000000000 13035370163 017571 5ustar00sristaff000000 000000 Mojo-Pg-2.35/examples/blog/script/000755 000765 000024 00000000000 13035370163 016721 5ustar00sristaff000000 000000 Mojo-Pg-2.35/examples/blog/templates/000755 000765 000024 00000000000 13035370163 017413 5ustar00sristaff000000 000000 Mojo-Pg-2.35/examples/blog/templates/layouts/000755 000765 000024 00000000000 13035370163 021113 5ustar00sristaff000000 000000 Mojo-Pg-2.35/examples/blog/templates/posts/000755 000765 000024 00000000000 13035370163 020563 5ustar00sristaff000000 000000 Mojo-Pg-2.35/examples/blog/templates/posts/_form.html.ep000644 000765 000024 00000000346 12733154131 023160 0ustar00sristaff000000 000000 %= form_for $target => begin %= label_for title => 'Title'
%= text_field title => $post->{title}
%= label_for body => 'Body'
%= text_area body => $post->{body}
%= submit_button $caption % end Mojo-Pg-2.35/examples/blog/templates/posts/create.html.ep000644 000765 000024 00000000176 12733154131 023322 0ustar00sristaff000000 000000 % layout 'blog', title => 'New post';

New post

%= include 'posts/_form', caption => 'Create', target => 'store_post' Mojo-Pg-2.35/examples/blog/templates/posts/edit.html.ep000644 000765 000024 00000000273 13027462153 023005 0ustar00sristaff000000 000000 % layout 'blog', title => 'Edit post';

Edit post

%= include 'posts/_form', caption => 'Update', target => 'update_post' %= button_to Remove => remove_post => {id => $post->{id}} Mojo-Pg-2.35/examples/blog/templates/posts/index.html.ep000644 000765 000024 00000000331 12733154131 023157 0ustar00sristaff000000 000000 % layout 'blog', title => 'Blog'; % for my $post (@$posts) {

<%= link_to $post->{title} => show_post => {id => $post->{id}} %>

%= $post->{body}

% } %= link_to 'New post' => 'create_post' Mojo-Pg-2.35/examples/blog/templates/posts/show.html.ep000644 000765 000024 00000000233 13027461345 023036 0ustar00sristaff000000 000000 % layout 'blog', title => $post->{title};

<%= $post->{title} %>

<%= $post->{body} %>

%= link_to 'Edit' => edit_post => {id => $post->{id}} Mojo-Pg-2.35/examples/blog/templates/layouts/blog.html.ep000644 000765 000024 00000000724 12733154130 023330 0ustar00sristaff000000 000000 <%= title %>

<%= link_to 'Blog' => 'posts' %>

%= content Mojo-Pg-2.35/examples/blog/script/blog000755 000765 000024 00000000345 12733154130 017572 0ustar00sristaff000000 000000 #!/usr/bin/env perl use strict; use warnings; use FindBin; BEGIN { unshift @INC, "$FindBin::Bin/../lib" } # Start command line interface for application require Mojolicious::Commands; Mojolicious::Commands->start_app('Blog'); Mojo-Pg-2.35/examples/blog/migrations/blog.sql000644 000765 000024 00000000214 12733154130 021230 0ustar00sristaff000000 000000 -- 1 up create table if not exists posts ( id serial primary key, title text, body text ); -- 1 down drop table if exists posts; Mojo-Pg-2.35/examples/blog/lib/Blog/000755 000765 000024 00000000000 13035370163 017046 5ustar00sristaff000000 000000 Mojo-Pg-2.35/examples/blog/lib/Blog.pm000644 000765 000024 00000002113 12733154130 017377 0ustar00sristaff000000 000000 package Blog; use Mojo::Base 'Mojolicious'; use Blog::Model::Posts; use Mojo::Pg; sub startup { my $self = shift; # Configuration $self->plugin('Config'); $self->secrets($self->config('secrets')); # Model $self->helper(pg => sub { state $pg = Mojo::Pg->new(shift->config('pg')) }); $self->helper( posts => sub { state $posts = Blog::Model::Posts->new(pg => shift->pg) }); # Migrate to latest version if necessary my $path = $self->home->rel_file('migrations/blog.sql'); $self->pg->migrations->name('blog')->from_file($path)->migrate; # Controller my $r = $self->routes; $r->get('/' => sub { shift->redirect_to('posts') }); $r->get('/posts')->to('posts#index'); $r->get('/posts/create')->to('posts#create')->name('create_post'); $r->post('/posts')->to('posts#store')->name('store_post'); $r->get('/posts/:id')->to('posts#show')->name('show_post'); $r->get('/posts/:id/edit')->to('posts#edit')->name('edit_post'); $r->put('/posts/:id')->to('posts#update')->name('update_post'); $r->delete('/posts/:id')->to('posts#remove')->name('remove_post'); } 1; Mojo-Pg-2.35/examples/blog/lib/Blog/Controller/000755 000765 000024 00000000000 13035370163 021171 5ustar00sristaff000000 000000 Mojo-Pg-2.35/examples/blog/lib/Blog/Model/000755 000765 000024 00000000000 13035370163 020106 5ustar00sristaff000000 000000 Mojo-Pg-2.35/examples/blog/lib/Blog/Model/Posts.pm000644 000765 000024 00000001277 12733154130 021561 0ustar00sristaff000000 000000 package Blog::Model::Posts; use Mojo::Base -base; has 'pg'; sub add { my ($self, $post) = @_; my $sql = 'insert into posts (title, body) values (?, ?) returning id'; return $self->pg->db->query($sql, $post->{title}, $post->{body})->hash->{id}; } sub all { shift->pg->db->query('select * from posts')->hashes->to_array } sub find { my ($self, $id) = @_; return $self->pg->db->query('select * from posts where id = ?', $id)->hash; } sub remove { shift->pg->db->query('delete from posts where id = ?', shift) } sub save { my ($self, $id, $post) = @_; my $sql = 'update posts set title = ?, body = ? where id = ?'; $self->pg->db->query($sql, $post->{title}, $post->{body}, $id); } 1; Mojo-Pg-2.35/examples/blog/lib/Blog/Controller/Posts.pm000644 000765 000024 00000002305 12733154130 022635 0ustar00sristaff000000 000000 package Blog::Controller::Posts; use Mojo::Base 'Mojolicious::Controller'; sub create { shift->render(post => {}) } sub edit { my $self = shift; $self->render(post => $self->posts->find($self->param('id'))); } sub index { my $self = shift; $self->render(posts => $self->posts->all); } sub remove { my $self = shift; $self->posts->remove($self->param('id')); $self->redirect_to('posts'); } sub show { my $self = shift; $self->render(post => $self->posts->find($self->param('id'))); } sub store { my $self = shift; my $validation = $self->_validation; return $self->render(action => 'create', post => {}) if $validation->has_error; my $id = $self->posts->add($validation->output); $self->redirect_to('show_post', id => $id); } sub update { my $self = shift; my $validation = $self->_validation; return $self->render(action => 'edit', post => {}) if $validation->has_error; my $id = $self->param('id'); $self->posts->save($id, $validation->output); $self->redirect_to('show_post', id => $id); } sub _validation { my $self = shift; my $validation = $self->validation; $validation->required('title'); $validation->required('body'); return $validation; } 1;