Mojo-Pg-4.26/000755 000765 000024 00000000000 14116227130 012652 5ustar00sristaff000000 000000 Mojo-Pg-4.26/LICENSE000644 000765 000024 00000021413 14114713525 013666 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-4.26/Changes000644 000765 000024 00000026744 14116226771 014174 0ustar00sristaff000000 000000 4.26 2021-09-08 - Fixed a bug in Mojo::Pg::PubSub would sometimes miss notifications. (akarelas) 4.25 2021-02-20 - Moved SQL::Abstract::Pg into a separate distribution. 4.24 2021-01-27 - Fixed Mojolicious 8.72 support. 4.23 2020-12-20 - Updated examples to use signatures. - Improved Mojo::Pg::PubSub to handle unknown notifications more gracefully. 4.22 2020-11-06 - Added from_dir method to Mojo::Pg::Migrations. (kiwiroy) - Improved Mojo::Pg::Database to handle connection errors more gracefully. 4.21 2020-10-25 - Added reset method to Mojo::Pg. - Changed SQL style to use uppercase keywords. 4.20 2020-10-01 - Fixed fork-safety feature to work with more than one fork. 4.19 2020-05-30 - Improved .perltidyrc with more modern settings. - Fixed validation problem in blog example. 4.18 2020-01-30 - Improved support for -json values to be a little more consistent. 4.17 2019-10-07 - Reverted connection cache optimization from 4.14, because it caused problems with some connections closed by the PostgreSQL server. - Updated mojo_migrations table created by Mojo::Pg::Migrations to use a primary key. 4.16 2019-09-04 - Updated DBD::Pg requirement to 3.7.4 due to certain JSON features not working with older versions. 4.15 2019-07-24 - Improved compatibility with older versions of DBI. 4.14 2019-07-22 - Improved connection cache to be more than an order of magnitude faster for blocking queries. - Fixed a bug in Mojo::Pg::PubSub where listen/unlisten did not work while reconnecting. 4.13 2019-01-20 - Added support for multi-column joins to SQL::Abstract::Pg. (rsindlin) 4.12 2018-11-24 - Added reconnect_interval attribute to Mojo::Pg::PubSub. (jberger) - Added db method to Mojo::Pg::PubSub. (jberger) - Fixed reconnect logic in Mojo::Pg::PubSub. (jberger) 4.11 2018-10-18 - Improved various attributes to use new Mojolicious 8.03 features to avoid memory leaks. 4.10 2018-09-15 - Updated project metadata. 4.09 2018-08-02 - Added support for -json unary op to SQL::Abstract::Pg. - Added support for multi-column unique constraints in upserts to SQL::Abstract::Pg. - Added support for literal SQL with bind values in select fields to SQL::Abstract::Pg. 4.08 2018-01-29 - Improved on_conflict option of insert and insert_p methods in Mojo::Pg::Database with a shortcut for simple conflict targets. 4.07 2018-01-28 - Added support for "JOIN" to select and select_p methods in Mojo::Pg::Database. - Added support for field aliases to select and select_p methods in Mojo::Pg::Database. - Added support for having option to select and select_p methods in Mojo::Pg::Database. - Improved on_conflict option of insert and insert_p methods in Mojo::Pg::Database with shortcuts for "ON CONFLICT DO UPDATE SET" and "ON CONFLICT DO NOTHING". - Improved for option of select and select_p methods in Mojo::Pg::Database with a shortcut for "FOR UPDATE". 4.06 2018-01-27 - Added support for on_conflict option to insert and insert_p methods in Mojo::Pg::Database. - Updated SQL::Abstract requirement to 1.84. - Improved error messages generated by SQL::Abstract::Pg to be compatible with SQL::Abstract. 4.05 2018-01-26 - Added support for for, group_by, limit, offset and order_by options to select and select_p methods in Mojo::Pg::Database. - Added module SQL::Abstract::Pg. 4.04 2017-12-16 - Added db attribute to Mojo::Pg::Results. - Added sql_for method to Mojo::Pg::Migrations. - Fixed a bug that could cause connections to be cached for reuse too early. 4.03 2017-11-04 - Improved Mojo::Pg::Database to use Mojo::Promise. 4.02 2017-11-02 - Added delete_p, insert_p, query_p, select_p and update_p methods to Mojo::Pg::Database. 4.01 2017-07-20 - Decreased default max_connections from 5 to 1 in Mojo::Pg. 4.0 2017-07-06 - Added support for sharing the database connection cache between multiple Mojo::Pg objects. - Added parent attribute to Mojo::Pg. - Fixed a bug where automatic migrations would leak database connections. 3.06 2017-06-01 - Updated example application with tests. - Improved Mojo::Pg to be a little less noisy by deactivating PrintWarn by default. 3.05 2017-03-12 - Improved from_string method in Mojo::Pg with search_path support. 3.04 2017-03-08 - Fixed array reference handling in queries generated with SQL::Abstract. 3.03 2017-03-07 - Added reset method to Mojo::Pg::PubSub. 3.02 2017-02-18 - Fixed quoting bugs in queries generated with SQL::Abstract. 3.01 2017-02-12 - Fixed bug in examples where migrations would not be handled correctly. 3.0 2017-02-11 - Added support for generating queries with SQL::Abstract. - Added abstract attribute to Mojo::Pg. - Added delete, insert, select and update methods to Mojo::Pg::Database. 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-4.26/MANIFEST000644 000765 000024 00000002421 14116227130 014002 0ustar00sristaff000000 000000 .perltidyrc 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/t/blog.t 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/crud.t t/database.t t/migrations.t t/migrations/test.sql t/migrations/tree/1/down.sql t/migrations/tree/1/up.sql t/migrations/tree/2/down.sql t/migrations/tree/2/up.sql t/migrations/tree/36/up.sql t/migrations/tree/55/upgrade.sql t/migrations/tree/99/up.sql t/migrations/tree2/8/up.sql t/migrations/tree2/subtree/9/up.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-4.26/t/000755 000765 000024 00000000000 14116227130 013115 5ustar00sristaff000000 000000 Mojo-Pg-4.26/README.md000644 000765 000024 00000002756 14114713525 014151 0ustar00sristaff000000 000000 # Mojo::Pg [![](https://github.com/mojolicious/mojo-pg/workflows/linux/badge.svg)](https://github.com/mojolicious/mojo-pg/actions) A tiny wrapper around [DBD::Pg](https://metacpan.org/pod/DBD::Pg) that makes [PostgreSQL](https://www.postgresql.org) a lot of fun to use with the [Mojolicious](https://mojolicious.org) real-time web framework. ```perl use Mojolicious::Lite -signatures; use Mojo::Pg; 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](https://mojolicious.org/perldoc/Mojo/Pg)! Mojo-Pg-4.26/MANIFEST.SKIP000644 000765 000024 00000000132 14114713525 014552 0ustar00sristaff000000 000000 ^\.(?!perltidyrc) .*\.old$ \.tar\.gz$ ^Makefile$ ^MYMETA\. ^blib ^pm_to_blib \B\.DS_Store Mojo-Pg-4.26/examples/000755 000765 000024 00000000000 14116227130 014470 5ustar00sristaff000000 000000 Mojo-Pg-4.26/META.yml000644 000765 000024 00000001700 14116227130 014121 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.62, 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.007004' Mojolicious: '8.50' SQL::Abstract::Pg: '1.0' perl: '5.016' resources: IRC: url: irc://irc.libera.chat/#mojo web: https://web.libera.chat/#mojo bugtracker: https://github.com/mojolicious/mojo-pg/issues homepage: https://mojolicious.org license: http://www.opensource.org/licenses/artistic-license-2.0 repository: https://github.com/mojolicious/mojo-pg.git version: '4.26' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Mojo-Pg-4.26/lib/000755 000765 000024 00000000000 14116227130 013420 5ustar00sristaff000000 000000 Mojo-Pg-4.26/Makefile.PL000644 000765 000024 00000002200 14116226674 014632 0ustar00sristaff000000 000000 use 5.016; 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.016'}}}, resources => { bugtracker => {web => 'https://github.com/mojolicious/mojo-pg/issues'}, homepage => 'https://mojolicious.org', license => ['http://www.opensource.org/licenses/artistic-license-2.0'], repository => { type => 'git', url => 'https://github.com/mojolicious/mojo-pg.git', web => 'https://github.com/mojolicious/mojo-pg', }, x_IRC => {url => 'irc://irc.libera.chat/#mojo', web => 'https://web.libera.chat/#mojo'} }, }, PREREQ_PM => {'DBD::Pg' => 3.007004, Mojolicious => '8.50', 'SQL::Abstract::Pg' => '1.0'}, test => {TESTS => 't/*.t t/*/*.t'} ); Mojo-Pg-4.26/.perltidyrc000644 000765 000024 00000001024 14114713525 015037 0ustar00sristaff000000 000000 -pbp # Start with Perl Best Practices -w # Show all warnings -iob # Ignore old breakpoints -l=120 # 120 characters per line -mbl=2 # No more than 2 blank lines -i=2 # Indentation is 2 columns -ci=2 # Continuation indentation is 2 columns -vt=0 # Less vertical tightness -pt=2 # High parenthesis tightness -bt=2 # High brace tightness -sbt=2 # High square bracket tightness -wn # Weld nested containers -isbc # Don't indent comments without leading space -nst # Don't output to STDOUT Mojo-Pg-4.26/META.json000644 000765 000024 00000003145 14116227130 014276 0ustar00sristaff000000 000000 { "abstract" : "Mojolicious ♥ PostgreSQL", "author" : [ "Sebastian Riedel " ], "dynamic_config" : 0, "generated_by" : "ExtUtils::MakeMaker version 7.62, 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.007004", "Mojolicious" : "8.50", "SQL::Abstract::Pg" : "1.0", "perl" : "5.016" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/mojolicious/mojo-pg/issues" }, "homepage" : "https://mojolicious.org", "license" : [ "http://www.opensource.org/licenses/artistic-license-2.0" ], "repository" : { "type" : "git", "url" : "https://github.com/mojolicious/mojo-pg.git", "web" : "https://github.com/mojolicious/mojo-pg" }, "x_IRC" : { "url" : "irc://irc.libera.chat/#mojo", "web" : "https://web.libera.chat/#mojo" } }, "version" : "4.26", "x_serialization_backend" : "JSON::PP version 4.06" } Mojo-Pg-4.26/lib/Mojo/000755 000765 000024 00000000000 14116227130 014324 5ustar00sristaff000000 000000 Mojo-Pg-4.26/lib/Mojo/Pg.pm000644 000765 000024 00000037255 14114713525 015252 0ustar00sristaff000000 000000 package Mojo::Pg; use Mojo::Base 'Mojo::EventEmitter'; use Carp qw(croak); use DBI; use Mojo::Pg::Database; use Mojo::Pg::Migrations; use Mojo::Pg::PubSub; use Mojo::URL; use Scalar::Util qw(blessed); use SQL::Abstract::Pg; has abstract => sub { SQL::Abstract::Pg->new(array_datatypes => 1, name_sep => '.', quote_char => '"') }; has [qw(auto_migrate parent search_path)]; has database_class => 'Mojo::Pg::Database'; has dsn => 'dbi:Pg:'; has max_connections => 1; has migrations => sub { Mojo::Pg::Migrations->new(pg => shift) }; has options => sub { {AutoCommit => 1, AutoInactiveDestroy => 1, PrintError => 0, PrintWarn => 0, RaiseError => 1}; }; has [qw(password username)] => ''; has pubsub => sub { Mojo::Pg::PubSub->new(pg => shift) }; our $VERSION = '4.26'; sub db { $_[0]->database_class->new(dbh => $_[0]->_prepare, pg => $_[0]) } sub from_string { my ($self, $str) = @_; # Parent return $self unless $str; return $self->parent($str) if blessed $str && $str->isa('Mojo::Pg'); # Protocol 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 and search_path my $hash = $url->query->to_hash; if (my $service = delete $hash->{service}) { $dsn .= "service=$service" } if (my $path = delete $hash->{search_path}) { $self->search_path(ref $path ? $path : [$path]); } # Options @{$self->options}{keys %$hash} = values %$hash; return $self->dsn($dsn); } sub new { @_ > 1 ? shift->SUPER::new->from_string(@_) : shift->SUPER::new } sub reset { ($_[0]->{queue} = []) and return $_[0] } sub _dequeue { my $self = shift; # Fork-safety delete @$self{qw(pid queue)} if $self->{pid} && $self->{pid} ne $$; $self->{pid} //= $$; 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"); } $self->emit(connection => $dbh); return $dbh; } sub _enqueue { my ($self, $dbh) = @_; if (my $parent = $self->parent) { return $parent->_enqueue($dbh) } my $queue = $self->{queue} ||= []; push @$queue, $dbh if $dbh->{Active}; shift @$queue while @$queue > $self->max_connections; } sub _prepare { my $self = shift; # Automatic migrations ++$self->{migrated} and $self->migrations->migrate if !$self->{migrated} && $self->auto_migrate; my $parent = $self->parent; return $parent ? $parent->_prepare : $self->_dequeue; } 1; =encoding utf8 =head1 NAME Mojo::Pg - Mojolicious ♥ PostgreSQL =head1 SYNOPSIS use Mojo::Pg; # Use a PostgreSQL connection string for configuration my $pg = Mojo::Pg->new('postgresql://postgres@/test'); # Select the server version 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; # Get a database handle from the cache for multiple queries my $db = $pg->db; # Use SQL::Abstract to generate simple CRUD queries for you $db->insert('names', {name => 'Isabell'}); my $id = $db->select('names', ['id'], {name => 'Isabell'})->hash->{id}; $db->update('names', {name => 'Belle'}, {id => $id}); $db->delete('names', {name => 'Belle'}); # Insert a few rows in a transaction with SQL and placeholders eval { my $tx = $db->begin; $db->query('INSERT INTO names (name) VALUES (?)', 'Sara'); $db->query('INSERT INTO names (name) VALUES (?)', 'Stefan'); $tx->commit; }; say $@ if $@; # Insert another row with SQL::Abstract and return the generated id say $db->insert('names', {name => 'Daniel'}, {returning => 'id'})->hash->{id}; # JSON roundtrip say $db->query('SELECT ?::JSON AS foo', {json => {bar => 'baz'}}) ->expand->hash->{foo}{bar}; # Select all rows blocking with SQL::Abstract say $_->{name} for $db->select('names')->hashes->each; # Select all rows non-blocking with SQL::Abstract $db->select('names' => sub ($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 promises) my $now = $pg->db->query_p('SELECT NOW() AS now'); my $names = $pg->db->query_p('SELECT * FROM names'); Mojo::Promise->all($now, $names)->then(sub ($now, $names) { say $now->[0]->hash->{now}; say $_->{name} for $names->[0]->hashes->each; })->catch(sub ($err) { warn "Something went wrong: $err"; })->wait; # Send and receive notifications non-blocking $pg->pubsub->listen(foo => sub ($pubsub, $payload) { say "foo: $payload"; $pubsub->notify(bar => $payload); }); $pg->pubsub->listen(bar => sub ($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. Perform queries blocking and non-blocking, use all L PostgreSQL has to offer, generate CRUD queries from data structures, manage your database schema with migrations and build scalable real-time web applications with the publish/subscribe pattern. =head1 BASICS Database and statement handles are cached automatically, and will be reused transparently to increase performance. You can handle connection timeouts gracefully by holding on to them only for short amounts of time. use Mojolicious::Lite -signatures; use Mojo::Pg; helper pg => sub { state $pg = Mojo::Pg->new('postgresql://postgres@/test') }; get '/' => sub ($c) { 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 ($db, $err, $results) {...}); $pg->db->query('SELECT PG_SLEEP(5)' => sub ($db, $err, $results) {...}); 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, -signatures; has 'pg'; sub now ($self) { return $self->pg->db->query('SELECT NOW() AS now')->hash; } 1; Which get integrated into your application with helpers. use Mojolicious::Lite -signatures; 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 ($c) { $c->render(json => $c->time->now); }; app->start; =head1 EXAMPLES This distribution also contains two great L you can use for inspiration. The minimal L application will show you how to scale WebSockets to multiple servers, and the well-structured L application how to apply the MVC design pattern in practice. =head1 EVENTS L inherits all events from L and can emit the following new ones. =head2 connection $pg->on(connection => sub ($pg, $dbh) { ... }); Emitted when a new database connection has been established. $pg->on(connection => sub ($pg, $dbh) { $dbh->do('SET search_path TO my_schema'); }); =head1 ATTRIBUTES L implements the following attributes. =head2 abstract my $abstract = $pg->abstract; $pg = $pg->abstract(SQL::Abstract::Pg->new); L object used to generate CRUD queries for L, defaults to enabling C and setting C to C<.> and C to C<">. # Generate WHERE clause and bind values my($stmt, @bind) = $pg->abstract->where({foo => 'bar', baz => 'yada'}); =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 L has been called for the first time. =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<1>. =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 as well as C. Note that C and C are considered mandatory, so deactivating them would be very dangerous. =head2 parent my $parent = $pg->parent; $pg = $pg->parent(Mojo::Pg->new); Another L object to use for connection management, instead of establishing and caching our own database connections. =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 ($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 (which is usually 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->select('accounts')->hashes->reduce(sub { $a->{money} + $b->{money} }); =head2 from_string $pg = $pg->from_string('postgresql://postgres@/test'); $pg = $pg->from_string(Mojo::Pg->new); Parse configuration from connection string or use another L object as L. # 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'); # Username, database, an option and search_path $pg->from_string('postgres://sri@/db6?&PrintError=1&search_path=test_schema'); =head2 new my $pg = Mojo::Pg->new; my $pg = Mojo::Pg->new('postgresql://postgres@/test'); my $pg = Mojo::Pg->new(Mojo::Pg->new); 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'); =head2 reset $pg = $pg->reset; Reset connection cache. =head1 DEBUGGING You can set the C environment variable to get some advanced diagnostics information printed by L. DBI_TRACE=1 DBI_TRACE=15 DBI_TRACE=SQL =head1 API 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 Christopher Eveland Dan Book Flavio Poletti Hernan Lopes Joel Berger Matt S Trout Peter Rabbitson William Lindley =back =head1 COPYRIGHT AND LICENSE Copyright (C) 2014-2021, 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-4.26/lib/Mojo/Pg/000755 000765 000024 00000000000 14116227130 014672 5ustar00sristaff000000 000000 Mojo-Pg-4.26/lib/Mojo/Pg/Results.pm000644 000765 000024 00000007737 14114713525 016715 0ustar00sristaff000000 000000 package Mojo::Pg::Results; use Mojo::Base -base; use Mojo::Collection; use Mojo::JSON qw(from_json); use Mojo::Util qw(tablify); has [qw(db 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 db my $db = $results->db; $results = $results->db(Mojo::Pg::Database->new); L object these results belong to. =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 one row from L and return it as an array reference. =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 + $b->[3] }, 0); =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 one row from L and return it as a hash reference. =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 + $b->{money} }, 0); =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-4.26/lib/Mojo/Pg/Database.pm000644 000765 000024 00000043060 14116226674 016753 0ustar00sristaff000000 000000 package Mojo::Pg::Database; use Mojo::Base 'Mojo::EventEmitter'; use Carp qw(croak shortmess); use DBD::Pg qw(:async); use Mojo::IOLoop; use Mojo::JSON qw(to_json); use Mojo::Pg::Results; use Mojo::Pg::Transaction; use Mojo::Promise; use Mojo::Util qw(monkey_patch); has 'dbh'; has pg => undef, weak => 1; has results_class => 'Mojo::Pg::Results'; for my $name (qw(delete insert select update)) { monkey_patch __PACKAGE__, $name, sub { my ($self, @cb) = (shift, ref $_[-1] eq 'CODE' ? pop : ()); return $self->query($self->pg->abstract->$name(@_), @cb); }; monkey_patch __PACKAGE__, "${name}_p", sub { my $self = shift; return $self->query_p($self->pg->abstract->$name(@_)); }; } 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) unless $dbh->{private_mojo_no_reuse}; } sub begin { Mojo::Pg::Transaction->new(db => shift) } 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; $self->_notifications; 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->{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(db => $self, sth => $sth); } # Non-blocking $self->{waiting} = {cb => $cb, sth => $sth}; $self->_watch; } sub query_p { my $self = shift; my $promise = Mojo::Promise->new; $self->query(@_ => sub { $_[1] ? $promise->reject($_[1]) : $promise->resolve($_[2]) }); return $promise; } 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->_notifications; $self->_unwatch unless $self->{waiting} || $self->is_listening; return $self; } sub _notifications { my $self = shift; my $dbh = $self->dbh; my $n; return undef unless $n = eval { $dbh->pg_notifies }; while ($n) { $self->emit(notification => @$n); $n = eval { $dbh->pg_notifies }; } return 1; } 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; return $self->_unwatch if !$self->_notifications && !$self->{waiting}; return if !$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(db => $self, 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 ($db) { ... }); Emitted when the database connection gets closed while waiting for notifications. =head2 notification $db->on(notification => sub ($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. Note that this attribute is weakened. =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->insert('frameworks', {name => 'Catalyst'}); $db->insert('frameworks', {name => 'Mojolicious'}); $tx->commit; }; say $@ if $@; =head2 delete my $results = $db->delete($table, \%where, \%options); Generate a C statement with L (usually an L object) and execute it with L. You can also append a callback to perform operations non-blocking. $db->delete(some_table => sub ($db, $err, $results) { ... }); Mojo::IOLoop->start unless Mojo::IOLoop->is_running; Use all the same argument variations you would pass to the C method of L. # "DELETE FROM some_table" $db->delete('some_table'); # "DELETE FROM some_table WHERE foo = 'bar'" $db->delete('some_table', {foo => 'bar'}); # "DELETE from some_table WHERE foo LIKE '%test%'" $db->delete('some_table', {foo => {-like => '%test%'}}); # "DELETE FROM some_table WHERE foo = 'bar' RETURNING id" $db->delete('some_table', {foo => 'bar'}, {returning => 'id'}); =head2 delete_p my $promise = $db->delete_p($table, \%where, \%options); Same as L, but performs all operations non-blocking and returns a L object instead of accepting a callback. $db->delete_p('some_table')->then(sub ($results) { ... })->catch(sub ($err) { ... })->wait; =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 insert my $results = $db->insert($table, \@values || \%fieldvals, \%options); Generate an C statement with L (usually an L object) and execute it with L. You can also append a callback to perform operations non-blocking. $db->insert(some_table => {foo => 'bar'} => sub ($db, $err, $results) { ... }); Mojo::IOLoop->start unless Mojo::IOLoop->is_running; Use all the same argument variations you would pass to the C method of L. # "INSERT INTO some_table (foo, baz) VALUES ('bar', 'yada')" $db->insert('some_table', {foo => 'bar', baz => 'yada'}); # "INSERT INTO some_table (foo) VALUES ({1,2,3})" $db->insert('some_table', {foo => [1, 2, 3]}); # "INSERT INTO some_table (foo) VALUES ('bar') RETURNING id" $db->insert('some_table', {foo => 'bar'}, {returning => 'id'}); # "INSERT INTO some_table (foo) VALUES ('bar') RETURNING id, foo" $db->insert('some_table', {foo => 'bar'}, {returning => ['id', 'foo']}); As well as some PostgreSQL specific extensions added by L. # "INSERT INTO some_table (foo) VALUES ('{"test":23}')" $db->insert('some_table', {foo => {-json => {test => 23}}}); # "INSERT INTO some_table (foo) VALUES ('bar') ON CONFLICT DO NOTHING" $db->insert('some_table', {foo => 'bar'}, {on_conflict => undef}); Including operations commonly referred to as C. # "INSERT INTO t (a) VALUES ('b') ON CONFLICT (a) DO UPDATE SET a = 'c'" $db->insert('t', {a => 'b'}, {on_conflict => [a => {a => 'c'}]}); # "INSERT INTO t (a, b) VALUES ('c', 'd') ON CONFLICT (a, b) DO UPDATE SET a = 'e'" $db->insert('t', {a => 'c', b => 'd'}, {on_conflict => [['a', 'b'] => {a => 'e'}]}); =head2 insert_p my $promise = $db->insert_p($table, \@values || \%fieldvals, \%options); Same as L, but performs all operations non-blocking and returns a L object instead of accepting a callback. $db->insert_p(some_table => {foo => 'bar'})->then(sub ($results) { ... })->catch(sub ($err) { ... })->wait; =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 (which is usually 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 ($db, $err, $results) { ... }); Mojo::IOLoop->start unless Mojo::IOLoop->is_running; Hash reference arguments containing a value named C<-json> or 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 query_p my $promise = $db->query_p('SELECT * FROM foo'); Same as L, but performs all operations non-blocking and returns a L object instead of accepting a callback. $db->query_p('INSERT INTO foo VALUES (?, ?, ?)' => @values)->then(sub ($results) { ... })->catch(sub ($err) { ... })->wait; =head2 select my $results = $db->select($source, $fields, $where, \%options); Generate a C method of L. # "SELECT * FROM some_table" $db->select('some_table'); # "SELECT id, foo FROM some_table" $db->select('some_table', ['id', 'foo']); # "SELECT * FROM some_table WHERE foo = 'bar'" $db->select('some_table', undef, {foo => 'bar'}); # "SELECT * FROM some_table WHERE foo LIKE '%test%'" $db->select('some_table', undef, {foo => {-like => '%test%'}}); As well as some PostgreSQL specific extensions added by L. # "SELECT * FROM foo JOIN bar ON (bar.foo_id = foo.id)" $db->select(['foo', ['bar', foo_id => 'id']]); # "SELECT * FROM foo LEFT JOIN bar ON (bar.foo_id = foo.id)" $db->select(['foo', [-left => 'bar', foo_id => 'id']]); # "SELECT foo AS bar FROM some_table" $db->select('some_table', [[foo => 'bar']]); # "SELECT * FROM some_table WHERE foo = '[1,2,3]'" $db->select('some_table', '*', {foo => {'=' => {-json => [1, 2, 3]}}}); # "SELECT EXTRACT(EPOCH FROM foo) AS foo, bar FROM some_table" $db->select('some_table', [\'extract(epoch from foo) AS foo', 'bar']); # "SELECT 'test' AS foo, bar FROM some_table" $db->select('some_table', [\['? AS foo', 'test'], 'bar']); Including a new last argument to pass many new options. # "SELECT * FROM some_table WHERE foo = 'bar' ORDER BY id DESC" $db->select('some_table', '*', {foo => 'bar'}, {order_by => {-desc => 'id'}}); # "SELECT * FROM some_table LIMIT 10 OFFSET 20" $db->select('some_table', '*', undef, {limit => 10, offset => 20}); # "SELECT * FROM some_table WHERE foo = 23 GROUP BY foo, bar" $db->select('some_table', '*', {foo => 23}, {group_by => ['foo', 'bar']}); # "SELECT * FROM t WHERE a = 'b' GROUP BY c HAVING d = 'e'" $db->select('t', '*', {a => 'b'}, {group_by => ['c'], having => {d => 'e'}}); # "SELECT * FROM some_table WHERE id = 1 FOR UPDATE" $db->select('some_table', '*', {id => 1}, {for => 'update'}); # "SELECT * FROM some_table WHERE id = 1 FOR UPDATE SKIP LOCKED" $db->select('some_table', '*', {id => 1}, {for => \'update skip locked'}); =head2 select_p my $promise = $db->select_p($source, $fields, $where, \%options); Same as L, but performs all operations non-blocking and returns a L object instead of accepting a callback. $db->select_p(some_table => ['foo'] => {bar => 'yada'})->then(sub ($results) { ... })->catch(sub ($err) { ... })->wait; =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. =head2 update my $results = $db->update($table, \%fieldvals, \%where, \%options); Generate an C statement with L (usually an L object) and execute it with L. You can also append a callback to perform operations non-blocking. $db->update(some_table => {foo => 'baz'} => {foo => 'bar'} => sub ($db, $err, $results) { ... }); Mojo::IOLoop->start unless Mojo::IOLoop->is_running; Use all the same argument variations you would pass to the C method of L. # "UPDATE some_table SET foo = 'bar' WHERE id = 23" $db->update('some_table', {foo => 'bar'}, {id => 23}); # "UPDATE some_table SET foo = {1,2,3} WHERE id = 23" $db->update('some_table', {foo => [1, 2, 3]}, {id => 23}); # "UPDATE some_table SET foo = 'bar' WHERE foo LIKE '%test%'" $db->update('some_table', {foo => 'bar'}, {foo => {-like => '%test%'}}); # "UPDATE some_table SET foo = 'bar' WHERE id = 23 RETURNING id" $db->update('some_table', {foo => 'bar'}, {id => 23}, {returning => 'id'}); # "UPDATE some_table SET foo = '[1,2,3]' WHERE bar = 23" $db->update('some_table', {foo => {-json => [1, 2, 3]}}, {bar => 23}); =head2 update_p my $promise = $db->update_p($table, \%fieldvals, \%where, \%options); Same as L, but performs all operations non-blocking and returns a L object instead of accepting a callback. $db->update_p(some_table => {foo => 'baz'} => {foo => 'bar'})->then(sub ($results) { ... })->catch(sub ($err) { ... })->wait; =head1 SEE ALSO L, L, L. =cut Mojo-Pg-4.26/lib/Mojo/Pg/Transaction.pm000644 000765 000024 00000003004 14114713525 017520 0ustar00sristaff000000 000000 package Mojo::Pg::Transaction; use Mojo::Base -base; has db => undef, weak => 1; 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. Note that this attribute is weakened. =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-4.26/lib/Mojo/Pg/Migrations.pm000644 000765 000024 00000015644 14114713525 017364 0ustar00sristaff000000 000000 package Mojo::Pg::Migrations; use Mojo::Base -base; use Carp qw(croak); use Mojo::File qw(path); use Mojo::Loader qw(data_section); use Mojo::Util qw(decode); use constant DEBUG => $ENV{MOJO_MIGRATIONS_DEBUG} || 0; has name => 'migrations'; has pg => undef, weak => 1; 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_dir { my ($self, $dir) = @_; my $migrations = $self->{migrations} = {up => {}, down => {}}; for my $file (path($dir)->list_tree({max_depth => 2})->each) { next unless my ($way) = ($file->basename =~ /^(up|down)\.sql$/); next unless my ($version) = ($file->dirname->basename =~ /^(\d+)$/); $migrations->{$way}{$version} = decode 'UTF-8', $file->slurp; } return $self; } 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; my $sql = $self->sql_for($active, $target); warn "-- Migrate ($active -> $target)\n$sql\n" if DEBUG; $sql .= ';UPDATE mojo_migrations SET version = $1 WHERE name = $2;'; $db->query($sql, $target, $self->name) and $tx->commit; return $self; } sub sql_for { my ($self, $from, $to) = @_; # Up my ($up, $down) = @{$self->{migrations}}{qw(up down)}; if ($from < $to) { my @up = grep { $_ <= $to && $_ > $from } keys %$up; return join '', @$up{sort { $a <=> $b } @up}; } # Down my @down = grep { $_ > $to && $_ <= $from } keys %$down; return join '', @$down{reverse sort { $a <=> $b } @down}; } sub _active { my ($self, $db, $create) = @_; 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 PRIMARY KEY, 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. Note that this attribute is weakened. =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_dir $migrations = $migrations->from_dir('/home/sri/migrations'); Extract migrations from a directory tree where each versioned migration is in a directory, named for the version, and each migration has one or both of the files named C or C. migrations/1/up.sql migrations/1/down.sql migrations/2/up.sql migrations/3/up.sql migrations/3/down.sql =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; =head2 sql_for my $sql = $migrations->sql_for(5, 10); Get SQL to migrate from one version to another, up or down. =head1 DEBUGGING You can set the C environment variable to get some advanced diagnostics information printed to C. MOJO_MIGRATIONS_DEBUG=1 =head1 SEE ALSO L, L, L. =cut Mojo-Pg-4.26/lib/Mojo/Pg/PubSub.pm000644 000765 000024 00000013121 14114713525 016434 0ustar00sristaff000000 000000 package Mojo::Pg::PubSub; use Mojo::Base 'Mojo::EventEmitter'; use Mojo::JSON qw(from_json to_json); use Scalar::Util qw(weaken); has pg => undef, weak => 1; has reconnect_interval => 1; sub db { my $self = shift; return $self->{db} if $self->{db}; my $db = $self->{db} = $self->pg->db; weaken $self; $db->on( notification => sub { my ($db, $name, $pid, $payload) = @_; return unless my $cbs = $self->{chans}{$name}; $payload = eval { from_json $payload } if $self->{json}{$name}; for my $cb (@$cbs) { $self->$cb($payload) } } ); $db->once(close => sub { $self->emit(disconnect => delete $self->{db}) }); $db->listen($_) for keys %{$self->{chans}}, 'mojo.pubsub'; delete $self->{reconnecting}; $self->emit(reconnect => $db); return $db; } sub DESTROY { shift->reset unless ${^GLOBAL_PHASE} eq 'DESTRUCT' } sub json { ++$_[0]{json}{$_[1]} and return $_[0] } sub listen { my ($self, $name, $cb) = @_; $self->db->listen($name) if !@{$self->{chans}{$name} ||= []} && !$self->{reconnecting}; push @{$self->{chans}{$name}}, $cb; return $cb; } sub new { my $self = shift->SUPER::new(@_); $self->on(disconnect => \&_disconnect); return $self; } sub notify { $_[0]->db->notify(_json(@_)) and return $_[0] } sub reset { my $self = shift; delete @$self{qw(chans json pid)}; return unless my $db = delete $self->{db}; ++$db->dbh->{private_mojo_no_reuse} and $db->_unwatch; } sub unlisten { my ($self, $name, $cb) = @_; my $chan = $self->{chans}{$name}; unless (@$chan = $cb ? grep { $cb ne $_ } @$chan : ()) { $self->db->unlisten($name) unless $self->{reconnecting}; delete $self->{chans}{$name}; } return $self; } sub _disconnect { my $self = shift; $self->{reconnecting} = 1; weaken $self; my $r; $r = Mojo::IOLoop->recurring( $self->reconnect_interval => sub { Mojo::IOLoop->remove($r) if eval { $self->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 ($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. =head1 EVENTS L inherits all events from L and can emit the following new ones. =head2 disconnect $pubsub->on(disconnect => sub ($pubsub, $db) { ... }); Emitted after the current database connection is lost. =head2 reconnect $pubsub->on(reconnect => sub ($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. Note that this attribute is weakened. =head2 reconnect_interval my $interval = $pubsub->reconnect_interval; $pubsub = $pubsub->reconnect_interval(0.1); Amount of time in seconds to wait to reconnect after disconnecting, defaults to C<1>. =head1 METHODS L inherits all methods from L and implements the following new ones. =head2 db my $db = $pubsub->db; Build and cache or get cached L connection from L. Used to reconnect if disconnected. # Reconnect immediately $pubsub->unsubscribe('disconnect')->on(disconnect => sub ($pubsub, $db) { pubsub->db }); =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 ($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 ($pubsub, $payload) { say "One: $payload"; }); $pubsub->listen(foo => sub ($pubsub, $payload) { say "Two: $payload"; }); =head2 new my $pubsub = Mojo::Pg::PubSub->new; my $pubsub = Mojo::Pg::PubSub->new(pg => Mojo::Pg->new); my $pubsub = Mojo::Pg::PubSub->new({pg => Mojo::Pg->new}); Construct a new L object and subscribe to the L event with default reconnect logic. =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 reset $pubsub->reset; Reset all subscriptions and the database connection. This is usually done after a new process has been forked, to prevent the child process from stealing notifications meant for the parent process. =head2 unlisten $pubsub = $pubsub->unlisten('foo'); $pubsub = $pubsub->unlisten(foo => $cb); Unsubscribe from a channel. =head1 SEE ALSO L, L, L. =cut Mojo-Pg-4.26/examples/blog/000755 000765 000024 00000000000 14116227130 015413 5ustar00sristaff000000 000000 Mojo-Pg-4.26/examples/chat.pl000644 000765 000024 00000001727 14114713525 015761 0ustar00sristaff000000 000000 use Mojolicious::Lite -signatures; use Mojo::Pg; helper pg => sub { state $pg = Mojo::Pg->new('postgresql://postgres@/test') }; get '/' => 'chat'; websocket '/channel' => sub ($c) { $c->inactivity_timeout(3600); # Forward messages from the browser to PostgreSQL $c->on(message => sub ($c, $message) { $c->pg->pubsub->notify(mojochat => $message) }); # Forward messages from PostgreSQL to the browser my $cb = $c->pg->pubsub->listen(mojochat => sub ($pubsub, $message) { $c->send($message) }); $c->on(finish => sub ($c) { $c->pg->pubsub->unlisten(mojochat => $cb) }); }; app->start; __DATA__ @@ chat.html.ep
Mojo-Pg-4.26/examples/blog/migrations/000755 000765 000024 00000000000 14116227130 017567 5ustar00sristaff000000 000000 Mojo-Pg-4.26/examples/blog/t/000755 000765 000024 00000000000 14116227130 015656 5ustar00sristaff000000 000000 Mojo-Pg-4.26/examples/blog/script/000755 000765 000024 00000000000 14116227130 016717 5ustar00sristaff000000 000000 Mojo-Pg-4.26/examples/blog/blog.conf000644 000765 000024 00000000132 14114713525 017207 0ustar00sristaff000000 000000 { pg => 'postgresql://postgres@127.0.0.1:5432/postgres', secrets => ['s3cret'] } Mojo-Pg-4.26/examples/blog/lib/000755 000765 000024 00000000000 14116227130 016161 5ustar00sristaff000000 000000 Mojo-Pg-4.26/examples/blog/templates/000755 000765 000024 00000000000 14116227130 017411 5ustar00sristaff000000 000000 Mojo-Pg-4.26/examples/blog/templates/posts/000755 000765 000024 00000000000 14116227130 020561 5ustar00sristaff000000 000000 Mojo-Pg-4.26/examples/blog/templates/layouts/000755 000765 000024 00000000000 14116227130 021111 5ustar00sristaff000000 000000 Mojo-Pg-4.26/examples/blog/templates/layouts/blog.html.ep000644 000765 000024 00000000724 14114713525 023336 0ustar00sristaff000000 000000 <%= title %>

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

%= content Mojo-Pg-4.26/examples/blog/templates/posts/edit.html.ep000644 000765 000024 00000000273 14114713525 023007 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-4.26/examples/blog/templates/posts/show.html.ep000644 000765 000024 00000000233 14114713525 023036 0ustar00sristaff000000 000000 % layout 'blog', title => $post->{title};

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

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

%= link_to 'Edit' => edit_post => {id => $post->{id}} Mojo-Pg-4.26/examples/blog/templates/posts/_form.html.ep000644 000765 000024 00000000346 14114713525 023165 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-4.26/examples/blog/templates/posts/index.html.ep000644 000765 000024 00000000327 14114713525 023171 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-4.26/examples/blog/templates/posts/create.html.ep000644 000765 000024 00000000176 14114713525 023327 0ustar00sristaff000000 000000 % layout 'blog', title => 'New post';

New post

%= include 'posts/_form', caption => 'Create', target => 'store_post' Mojo-Pg-4.26/examples/blog/lib/Blog/000755 000765 000024 00000000000 14116227130 017044 5ustar00sristaff000000 000000 Mojo-Pg-4.26/examples/blog/lib/Blog.pm000644 000765 000024 00000002125 14114713525 017410 0ustar00sristaff000000 000000 package Blog; use Mojo::Base 'Mojolicious', -signatures; use Blog::Model::Posts; use Mojo::Pg; sub startup ($self) { # 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->child('migrations', 'blog.sql'); $self->pg->auto_migrate(1)->migrations->name('blog')->from_file($path); # 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-4.26/examples/blog/lib/Blog/Controller/000755 000765 000024 00000000000 14116227130 021167 5ustar00sristaff000000 000000 Mojo-Pg-4.26/examples/blog/lib/Blog/Model/000755 000765 000024 00000000000 14116227130 020104 5ustar00sristaff000000 000000 Mojo-Pg-4.26/examples/blog/lib/Blog/Model/Posts.pm000644 000765 000024 00000001013 14114713525 021553 0ustar00sristaff000000 000000 package Blog::Model::Posts; use Mojo::Base -base, -signatures; has 'pg'; sub add ($self, $post) { return $self->pg->db->insert('posts', $post, {returning => 'id'})->hash->{id}; } sub all ($self) { return $self->pg->db->select('posts')->hashes->to_array; } sub find ($self, $id) { return $self->pg->db->select('posts', '*', {id => $id})->hash; } sub remove ($self, $id) { $self->pg->db->delete('posts', {id => $id}); } sub save ($self, $id, $post) { $self->pg->db->update('posts', $post, {id => $id}); } 1; Mojo-Pg-4.26/examples/blog/lib/Blog/Controller/Posts.pm000644 000765 000024 00000002236 14114713525 022646 0ustar00sristaff000000 000000 package Blog::Controller::Posts; use Mojo::Base 'Mojolicious::Controller', -signatures; sub create ($self) { $self->render(post => {}); } sub edit ($self) { $self->render(post => $self->posts->find($self->param('id'))); } sub index ($self) { $self->render(posts => $self->posts->all); } sub remove ($self) { $self->posts->remove($self->param('id')); $self->redirect_to('posts'); } sub show ($self) { $self->render(post => $self->posts->find($self->param('id'))); } sub store ($self) { my $v = $self->_validation; return $self->render(action => 'create', post => {}) if $v->has_error; my $id = $self->posts->add({title => $v->param('title'), body => $v->param('body')}); $self->redirect_to('show_post', id => $id); } sub update ($self) { my $v = $self->_validation; return $self->render(action => 'edit', post => {}) if $v->has_error; my $id = $self->param('id'); $self->posts->save($id, {title => $v->param('title'), body => $v->param('body')}); $self->redirect_to('show_post', id => $id); } sub _validation ($self) { my $v = $self->validation; $v->required('title', 'not_empty'); $v->required('body', 'not_empty'); return $v; } 1; Mojo-Pg-4.26/examples/blog/script/blog000755 000765 000024 00000000345 14114713525 017600 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-4.26/examples/blog/t/blog.t000644 000765 000024 00000004476 14114713525 017007 0ustar00sristaff000000 000000 use Mojo::Base -strict; use Test::More; # This test requires a PostgreSQL connection string for an existing database # # TEST_ONLINE=postgres://tester:testing@/test script/blog test # plan skip_all => 'set TEST_ONLINE to enable this test' unless $ENV{TEST_ONLINE}; use Mojo::Pg; use Mojo::URL; use Test::Mojo; # Isolate tests my $url = Mojo::URL->new($ENV{TEST_ONLINE})->query([search_path => 'mojo_blog_test']); my $pg = Mojo::Pg->new($url); $pg->db->query('DROP SCHEMA IF EXISTS mojo_blog_test CASCADE'); $pg->db->query('CREATE SCHEMA mojo_blog_test'); # Override configuration for testing my $t = Test::Mojo->new(Blog => {pg => $url, secrets => ['test_s3cret']}); $t->ua->max_redirects(10); # No posts yet $t->get_ok('/')->status_is(200)->text_is('title' => 'Blog')->text_is('body > a' => 'New post') ->element_exists_not('h2'); # Create a new post $t->get_ok('/posts/create')->status_is(200)->text_is('title' => 'New post')->element_exists('form input[name=title]') ->element_exists('form textarea[name=body]'); $t->post_ok('/posts' => form => {title => 'Testing', body => 'This is a test.'})->status_is(200) ->text_is('title' => 'Testing')->text_is('h2' => 'Testing')->text_like('p' => qr/This is a test/); # Read the post $t->get_ok('/')->status_is(200)->text_is('title' => 'Blog')->text_is('h2 a' => 'Testing') ->text_like('p' => qr/This is a test/); $t->get_ok('/posts/1')->status_is(200)->text_is('title' => 'Testing')->text_is('h2' => 'Testing') ->text_like('p' => qr/This is a test/)->text_is('body > a' => 'Edit'); # Update the post $t->get_ok('/posts/1/edit')->status_is(200)->text_is('title' => 'Edit post') ->element_exists('form input[name=title][value=Testing]') ->text_like('form textarea[name=body]' => qr/This is a test/)->element_exists('form input[value=Remove]'); $t->post_ok('/posts/1?_method=PUT' => form => {title => 'Again', body => 'It works.'})->status_is(200) ->text_is('title' => 'Again')->text_is('h2' => 'Again')->text_like('p' => qr/It works/); $t->get_ok('/posts/1')->status_is(200)->text_is('title' => 'Again')->text_is('h2' => 'Again') ->text_like('p' => qr/It works/); # Delete the post $t->post_ok('/posts/1?_method=DELETE')->status_is(200)->text_is('title' => 'Blog')->element_exists_not('h2'); # Clean up once we are done $pg->db->query('DROP SCHEMA mojo_blog_test CASCADE'); done_testing(); Mojo-Pg-4.26/examples/blog/migrations/blog.sql000644 000765 000024 00000000214 14114713525 021236 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-4.26/t/pod.t000644 000765 000024 00000000407 14114713525 014073 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-4.26/t/connection.t000644 000765 000024 00000011245 14114713525 015452 0ustar00sristaff000000 000000 use Mojo::Base -strict; use Test::More; use Mojo::Pg; subtest 'Defaults' => sub { 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, PrintWarn => 0, RaiseError => 1}; is_deeply $pg->options, $options, 'right options'; is $pg->search_path, undef, 'no search_path'; }; subtest 'Minimal connection string with database' => sub { my $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'; my $options = {AutoCommit => 1, AutoInactiveDestroy => 1, PrintError => 0, PrintWarn => 0, RaiseError => 1}; is_deeply $pg->options, $options, 'right options'; }; subtest 'Minimal connection string with service and option' => sub { my $pg = Mojo::Pg->new('postgres://?service=foo&PrintError=1&PrintWarn=1'); is $pg->dsn, 'dbi:Pg:service=foo', 'right data source'; is $pg->username, '', 'no username'; is $pg->password, '', 'no password'; my $options = {AutoCommit => 1, AutoInactiveDestroy => 1, PrintError => 1, PrintWarn => 1, RaiseError => 1}; is_deeply $pg->options, $options, 'right options'; }; subtest 'Connection string with service and search_path' => sub { my $pg = Mojo::Pg->new('postgres://?service=foo&search_path=test_schema'); is $pg->dsn, 'dbi:Pg:service=foo', 'right data source'; is $pg->username, '', 'no username'; is $pg->password, '', 'no password'; my $options = {AutoCommit => 1, AutoInactiveDestroy => 1, PrintError => 0, PrintWarn => 0, RaiseError => 1}; is_deeply $pg->options, $options, 'right options'; is_deeply $pg->search_path, ['test_schema'], 'right search_path'; }; subtest 'Connection string with multiple search_path values' => sub { my $pg = Mojo::Pg->new('postgres://a:b@/c?search_path=test1&search_path=test2'); is $pg->dsn, 'dbi:Pg:dbname=c', 'right data source'; is $pg->username, 'a', 'no username'; is $pg->password, 'b', 'no password'; my $options = {AutoCommit => 1, AutoInactiveDestroy => 1, PrintError => 0, PrintWarn => 0, RaiseError => 1}; is_deeply $pg->options, $options, 'right options'; is_deeply $pg->search_path, ['test1', 'test2'], 'right search_path'; }; subtest 'Connection string with host and port' => sub { my $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'; my $options = {AutoCommit => 1, AutoInactiveDestroy => 1, PrintError => 0, PrintWarn => 0, RaiseError => 1}; is_deeply $pg->options, $options, 'right options'; }; subtest 'Connection string username but without host' => sub { my $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'; my $options = {AutoCommit => 1, AutoInactiveDestroy => 1, PrintError => 0, PrintWarn => 0, RaiseError => 1}; is_deeply $pg->options, $options, 'right options'; }; subtest 'Connection string with unix domain socket and options' => sub { my $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'; my $options = {AutoCommit => 1, AutoInactiveDestroy => 1, PrintError => 1, PrintWarn => 0, RaiseError => 0}; is_deeply $pg->options, $options, 'right options'; }; subtest 'Connection string with lots of zeros' => sub { my $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'; my $options = {AutoCommit => 1, AutoInactiveDestroy => 1, PrintError => 0, PrintWarn => 0, RaiseError => 0}; is_deeply $pg->options, $options, 'right options'; }; subtest 'Invalid connection string' => sub { eval { Mojo::Pg->new('http://localhost:3000/test') }; like $@, qr/Invalid PostgreSQL connection string/, 'right error'; }; done_testing(); Mojo-Pg-4.26/t/migrations/000755 000765 000024 00000000000 14116227130 015271 5ustar00sristaff000000 000000 Mojo-Pg-4.26/t/pubsub.t000644 000765 000024 00000016422 14116227042 014611 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 qw(true); use Mojo::Pg; subtest 'Notifications with event loop' => sub { 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'; }; subtest 'JSON' => sub { my $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'; }; subtest 'Unsubscribe' => sub { my $pg = Mojo::Pg->new($ENV{TEST_ONLINE}); my $db; $pg->pubsub->on(reconnect => sub { $db = pop }); my (@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'; }; subtest 'Reconnect while listening' => sub { my $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'; }; }; subtest 'Reconnect while listening multiple retries' => sub { my $pg = Mojo::Pg->new($ENV{TEST_ONLINE}); my (@dbhs, @test, @test3, @test4); $pg->pubsub->reconnect_interval(0.1); $pg->pubsub->on(reconnect => sub { push @dbhs, pop->dbh }); $pg->pubsub->listen(pstest => sub { push @test, pop }); $pg->pubsub->listen(pstest4 => sub { push @test4, 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')->notify(pstest3 => 'works too')->notify(pstest4 => 'failed'); Mojo::IOLoop->stop; } ); my $dsn = $pg->dsn; $pg->pubsub->on( disconnect => sub { my $pubsub = shift; Mojo::IOLoop->timer(0.2 => sub { $pg->dsn($dsn) }); $pubsub->listen(pstest3 => sub { push @test3, pop }); $pubsub->unlisten('pstest4'); } ); $pg->db->query('SELECT PG_TERMINATE_BACKEND(?)', $dbhs[0]{pg_pid}); $pg->dsn('dbi:Pg:badoption=1'); Mojo::IOLoop->start; ok $dbhs[1], 'database handle'; isnt $dbhs[0], $dbhs[1], 'different database handles'; is_deeply \@test, ['works'], 'right messages'; is_deeply \@test3, ['works too'], 'right messages'; is_deeply \@test4, [], 'no messages'; }; }; subtest 'Reconnect while not listening' => sub { my $pg = Mojo::Pg->new($ENV{TEST_ONLINE}); my (@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'; }; }; subtest 'Reset' => sub { my $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'; $pg->pubsub->notify(pstest => 'first'); is_deeply \@test, ['first'], 'right messages'; { $pg->pubsub->reset; $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'; }; }; subtest 'Call listen/unlisten immediately after notify' => sub { my $pg = Mojo::Pg->new($ENV{TEST_ONLINE}); my @test; $pg->pubsub->listen(pstest => sub { push @test, pop }); $pg->db->notify(pstest => 'works'); $pg->pubsub->listen(pstest2 => sub { }); is_deeply \@test, ['works'], 'right messages'; $pg->db->notify(pstest => 'works too'); $pg->pubsub->unlisten(pstest3 => sub { }); is_deeply \@test, ['works', 'works too'], 'right messages'; }; done_testing(); Mojo-Pg-4.26/t/migrations.t000644 000765 000024 00000021362 14114713525 015470 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::File qw(curfile); 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'); subtest 'Defaults' => sub { 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'; }; subtest 'Create migrations table' => sub { 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'; }; subtest 'Migrations from DATA section' => sub { 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'; }; subtest 'Different syntax variations' => sub { $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'; }; subtest 'Bad and concurrent migrations' => sub { my $pg2 = Mojo::Pg->new($ENV{TEST_ONLINE})->search_path(['mojo_migrations_test']); $pg2->migrations->name('migrations_test2')->from_file(curfile->sibling('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 2'; 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'; }; subtest 'Migrate automatically' => sub { 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'; is $pg3->migrations->sql_for(0, 5), <migrations->sql_for(6, 0), <migrations->sql_for(6, 5), <migrations->sql_for(6, 6), '', 'right SQL'; is $pg3->migrations->sql_for(2, 3), '', 'right SQL'; }; subtest 'Migrate automatically with shared connection cache' => sub { my $pg4 = Mojo::Pg->new($ENV{TEST_ONLINE})->search_path(['mojo_migrations_test']); my $pg5 = Mojo::Pg->new($pg4); $pg4->auto_migrate(1)->migrations->name('test1')->from_data; $pg5->auto_migrate(1)->migrations->name('test3')->from_data; is_deeply $pg5->db->query('SELECT * FROM migration_test_four')->hashes->to_array, [{test => 10}], 'right structure'; is_deeply $pg5->db->query('SELECT * FROM migration_test_six')->hashes->to_array, [], 'right structure'; }; subtest 'Unknown version' => sub { eval { $pg->migrations->migrate(23) }; like $@, qr/Version 23 has no migration/, 'right error'; }; subtest 'Version mismatch' => sub { 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'; }; subtest 'Migration directory' => sub { my $pg = Mojo::Pg->new($ENV{TEST_ONLINE})->search_path(['mojo_migrations_test']); $pg->migrations->name('directory tree')->from_dir(curfile->sibling('migrations', 'tree')); is $pg->migrations->migrate(0)->migrate(2)->active, 2, 'migrate table with unicode'; is_deeply $pg->db->query('SELECT * FROM migration_test_three')->hashes, [{baz => 'just'}, {baz => 'works ♥'}], 'right structure'; eval { $pg->migrations->migrate(36) }; like $@, qr/^Version 36 has no migration/, 'empty file has no version'; eval { $pg->migrations->migrate(54) }; like $@, qr/^Version 54 has no migration/, 'sparse directory has no version'; eval { $pg->migrations->migrate(55) }; like $@, qr/^Version 55 has no migration/, 'upgrade.sql is not up.sql, so no version'; is $pg->migrations->migrate->active, 99, 'active version is 99'; is $pg->migrations->latest, 99, 'latest version is 99'; ok !!(grep {/^mojo_migrations_test\.migration_test_luft_balloons$/} @{$pg->db->tables}), 'last table exists'; $pg->migrations->name('directory tree')->from_dir(curfile->sibling('migrations', 'tree2')); is $pg->migrations->latest, 8, 'latest version is 8'; is $pg->migrations->name('directory tree')->from_dir(curfile->sibling('migrations', 'tree3'))->latest, 0, 'latest 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); @@ test3 -- 2 up CREATE TABLE migration_test_six (test INT); Mojo-Pg-4.26/t/database.t000644 000765 000024 00000030003 14114713525 015050 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 qw(true); use Mojo::Pg; use Mojo::Promise; use Scalar::Util qw(refaddr); my $pg = Mojo::Pg->new($ENV{TEST_ONLINE}); subtest 'Connected' => sub { ok $pg->db->ping, 'connected'; }; subtest 'Custom search_path' => sub { $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}); }; subtest 'Blocking select' => sub { is_deeply $pg->db->query('SELECT 1 AS one, 2 AS two, 3 AS three')->hash, {one => 1, two => 2, three => 3}, 'right structure'; }; subtest 'Non-blocking select' => sub { my ($fail, $result); my $same; my $db = $pg->db; $db->query( 'SELECT 1 AS one, 2 AS two, 3 AS three' => sub { my ($db, $err, $results) = @_; $fail = $err; $result = $results->hash; $same = $db->dbh eq $results->db->dbh; Mojo::IOLoop->stop; } ); Mojo::IOLoop->start; ok $same, 'same database handles'; ok !$fail, 'no error'; is_deeply $result, {one => 1, two => 2, three => 3}, 'right structure'; }; subtest 'Concurrent non-blocking selects' => sub { my ($fail, $result); Mojo::Promise->all( $pg->db->query_p('SELECT 1 AS one'), $pg->db->query_p('SELECT 2 AS two'), $pg->db->query_p('SELECT 2 AS two') )->then(sub { my ($one, $two, $three) = @_; $result = [$one->[0]->hashes->first, $two->[0]->hashes->first, $three->[0]->hashes->first]; })->catch(sub { $fail = shift })->wait; ok !$fail, 'no error'; is_deeply $result, [{one => 1}, {two => 2}, {two => 2}], 'right structure'; }; subtest 'Sequential non-blocking selects' => sub { my ($fail, $result); my $db = $pg->db; $db->query_p('SELECT 1 AS one')->then(sub { push @$result, shift->hashes->first; return $db->query_p('SELECT 1 AS one'); })->then(sub { push @$result, shift->hashes->first; return $db->query_p('SELECT 2 AS two'); })->then(sub { push @$result, shift->hashes->first; })->catch(sub { $fail = shift })->wait; ok !$fail, 'no error'; is_deeply $result, [{one => 1}, {one => 1}, {two => 2}], 'right structure'; }; subtest 'Connection cache' => sub { is $pg->max_connections, 1, 'right default'; $pg->max_connections(5); my @dbhs = map { refaddr $_->dbh } $pg->db, $pg->db, $pg->db, $pg->db, $pg->db; is_deeply \@dbhs, [reverse map { refaddr $_->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'; }; subtest 'Statement cache' => sub { my $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'; }; subtest 'Connection reuse' => sub { my $db = $pg->db; my $dbh = $db->dbh; my $results = $db->query('select 1'); undef $db; my $db2 = $pg->db; isnt $db2->dbh, $dbh, 'new database handle'; undef $results; my $db3 = $pg->db; is $db3->dbh, $dbh, 'same database handle'; $results = $db3->query('SELECT 2'); is $results->db->dbh, $dbh, 'same database handle'; is $results->array->[0], 2, 'right result'; }; subtest 'Dollar only' => sub { my $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'; }; subtest 'JSON' => sub { my $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'; my $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'; }; subtest 'Fork-safety' => sub { my $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; my $dbh2 = $pg->db->dbh; isnt $dbh2, $dbh, 'different database handles'; is $dbh2, $current, 'same database handle'; is $connections, 1, 'one new connection'; { local $$ = -24; isnt $pg->db->dbh, $dbh, 'different database handles'; isnt $pg->db->dbh, $dbh2, 'different database handles'; is $pg->db->dbh, $current, 'same database handle'; is $connections, 2, 'two new connections'; }; }; $pg->unsubscribe('connection'); }; subtest 'Shared connection cache' => sub { my $pg2 = Mojo::Pg->new($pg); is $pg2->parent, $pg, 'right parent'; my $dbh = $pg->db->dbh; is $pg->db->dbh, $dbh, 'same database handle'; is $pg2->db->dbh, $dbh, 'same database handle'; is $pg->db->dbh, $dbh, 'same database handle'; is $pg2->db->dbh, $dbh, 'same database handle'; my $db = $pg->db; is_deeply $db->query('SELECT 1 AS one')->hashes->to_array, [{one => 1}], 'right structure'; $dbh = $db->dbh; $db->disconnect; $db = $pg2->db; is_deeply $db->query('SELECT 1 AS one')->hashes->to_array, [{one => 1}], 'right structure'; isnt $db->dbh, $dbh, 'different database handle'; }; subtest 'Cache reset' => sub { my $dbh = $pg->db->dbh; is $pg->db->dbh, $dbh, 'same database handle'; is $pg->db->dbh, $dbh, 'same database handle again'; is $pg->db->dbh, $dbh, 'same database handle again'; isnt $pg->reset->db->dbh, $dbh, 'different database handle'; $dbh = $pg->db->dbh; is $pg->db->dbh, $dbh, 'same database handle'; is $pg->db->dbh, $dbh, 'same database handle again'; isnt $pg->reset->db->dbh, $dbh, 'different database handle'; }; subtest 'Notifications' => sub { my $db = $pg->db; ok !$db->is_listening, 'not listening'; ok $db->listen('dbtest')->is_listening, 'listening'; my $db2 = $pg->db->listen('dbtest'); my @result; my $promise = Mojo::Promise->new; $db->once(notification => sub { shift; $promise->resolve(@_) }); my $promise2 = Mojo::Promise->new; $db2->once(notification => sub { shift; $promise2->resolve(@_) }); Mojo::IOLoop->next_tick(sub { $db2->notify(dbtest => 'foo') }); Mojo::Promise->all($promise, $promise2)->then(sub { my ($one, $two) = @_; push @result, $one, $two; })->wait; is $result[0][0], 'dbtest', 'right channel name'; ok $result[0][1], 'has process id'; is $result[0][2], 'foo', 'right payload'; is $result[1][0], 'dbtest', 'right channel name'; ok $result[1][1], 'has process id'; is $result[1][2], 'foo', 'right payload'; @result = (); $promise = Mojo::Promise->new; $db->once(notification => sub { shift; $promise->resolve(@_) }); Mojo::IOLoop->next_tick(sub { $pg->db->notify('dbtest') }); $promise->then(sub { push @result, [@_] })->wait; is $result[0][0], 'dbtest', 'right channel name'; ok $result[0][1], 'has process id'; is $result[0][2], '', 'no payload'; @result = (); $promise = Mojo::Promise->new; $db2->listen('dbtest2')->once(notification => sub { shift; $promise->resolve(@_) }); Mojo::IOLoop->next_tick(sub { $db2->query("NOTIFY dbtest2, 'bar'") }); $promise->then(sub { push @result, [@_] })->wait; is $result[0][0], 'dbtest2', 'right channel name'; ok $result[0][1], 'has process id'; is $result[0][2], 'bar', 'no payload'; @result = (); $promise = Mojo::Promise->new; $db2->once(notification => sub { shift; $promise->resolve(@_) }); my $tx = $db2->begin; Mojo::IOLoop->next_tick(sub { $db2->notify(dbtest2 => 'baz'); $tx->commit; }); $promise->then(sub { push @result, [@_] })->wait; is $result[0][0], 'dbtest2', 'right channel name'; ok $result[0][1], 'has process id'; is $result[0][2], 'baz', 'no payload'; ok !$db->unlisten('dbtest')->is_listening, 'not listening'; ok !$db2->unlisten('*')->is_listening, 'not listening'; }; subtest 'Stop listening for all notifications' => sub { my $db = $pg->db; ok !$db->is_listening, 'not listening'; ok $db->listen('dbtest')->listen('dbtest2')->unlisten('dbtest2')->is_listening, 'listening'; ok !$db->unlisten('*')->is_listening, 'not listening'; }; subtest 'Connection close while listening for notifications' => sub { my $db = $pg->db; 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'; }; subtest 'Blocking error' => sub { eval { $pg->db->query('does_not_exist') }; like $@, qr/does_not_exist.*database\.t/s, 'right error'; }; subtest 'Non-blocking error' => sub { my ($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'; }; subtest 'Non-blocking query in progress' => sub { my $db = $pg->db; $db->query('SELECT 1' => sub { }); eval { $db->query('SELECT 1' => sub { }); }; like $@, qr/Non-blocking query already in progress/, 'right error'; }; subtest 'CLean up non-blocking query' => sub { my $fail; my $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-4.26/t/results.t000644 000765 000024 00000014116 14114713525 015014 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 qw(:pg_types); use Mojo::Pg; use Mojo::Promise; use Mojo::Util qw(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); subtest 'Tables' => sub { 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'; }; subtest 'Result methods' => sub { 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'; }; subtest 'Custom database and results classes' => sub { 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'; }; subtest 'JSON' => sub { 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->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'; }; subtest 'Iterate' => sub { 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'; }; subtest 'Non-blocking query where not all results have been fetched' => sub { my ($fail, $result); $db->query_p('SELECT name FROM results_test')->then(sub { my $results = shift; push @$result, $results->array; $results->finish; return $db->query_p('SELECT name FROM results_test'); })->then(sub { my $results = shift; push @$result, $results->array_test; $results->finish; return $db->query_p('SELECT name FROM results_test'); })->then(sub { my $results = shift; push @$result, $results->array; })->catch(sub { $fail = shift })->wait; ok !$fail, 'no error'; is_deeply $result, [['foo'], ['foo'], ['foo']], 'right structure'; }; subtest 'Transactions' => sub { { 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'; }; subtest 'Long-lived results' => sub { 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'; }; subtest 'Custom data types' => sub { $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-4.26/t/pod_coverage.t000644 000765 000024 00000000424 14114713525 015745 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-4.26/t/pg_lite_app.t000644 000765 000024 00000004240 14114713525 015573 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 qw(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; subtest 'Make sure migrations are not served as static files' => sub { $t->get_ok('/app_test')->status_is(404); }; subtest 'Blocking select (with connection reuse)' => sub { $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!'); $t->get_ok('/blocking')->status_is(200)->header_is('X-Ref', $ref)->content_is('I ♥ Mojolicious!'); }; subtest 'Non-blocking select (with connection reuse)' => sub { $t->get_ok('/non-blocking')->status_is(200)->content_is('I ♥ Mojolicious!'); my $ref = $t->tx->res->headers->header('X-Ref'); $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!'); }; # Clean up once we are done $pg->db->query('DROP SCHEMA mojo_app_test CASCADE'); done_testing(); Mojo-Pg-4.26/t/crud.t000644 000765 000024 00000014172 14114713525 014252 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::Pg; use Mojo::Promise; # Isolate tests my $pg = Mojo::Pg->new($ENV{TEST_ONLINE})->search_path(['mojo_crud_test']); $pg->db->query('DROP SCHEMA IF EXISTS mojo_crud_test CASCADE'); $pg->db->query('CREATE SCHEMA mojo_crud_test'); my $db = $pg->db; $db->query( 'CREATE TABLE IF NOT EXISTS crud_test ( id SERIAL PRIMARY KEY, name TEXT )' ); subtest 'Create' => sub { $db->insert('crud_test', {name => 'foo'}); is_deeply $db->select('crud_test')->hashes->to_array, [{id => 1, name => 'foo'}], 'right structure'; is $db->insert('crud_test', {name => 'bar'}, {returning => 'id'})->hash->{id}, 2, 'right value'; is_deeply $db->select('crud_test')->hashes->to_array, [{id => 1, name => 'foo'}, {id => 2, name => 'bar'}], 'right structure'; $db->insert('crud_test', {id => 1, name => 'foo'}, {on_conflict => undef}); $db->insert('crud_test', {id => 2, name => 'bar'}, {on_conflict => [id => {name => 'baz'}]}); }; subtest 'Read' => sub { is_deeply $db->select('crud_test')->hashes->to_array, [{id => 1, name => 'foo'}, {id => 2, name => 'baz'}], 'right structure'; is_deeply $db->select('crud_test', ['name'])->hashes->to_array, [{name => 'foo'}, {name => 'baz'}], 'right structure'; is_deeply $db->select('crud_test', ['name'], {name => 'foo'})->hashes->to_array, [{name => 'foo'}], 'right structure'; is_deeply $db->select('crud_test', ['name'], undef, {-desc => 'id'})->hashes->to_array, [{name => 'baz'}, {name => 'foo'}], 'right structure'; is_deeply $db->select('crud_test', undef, undef, {offset => 1})->hashes->to_array, [{id => 2, name => 'baz'}], 'right structure'; is_deeply $db->select('crud_test', undef, undef, {limit => 1})->hashes->to_array, [{id => 1, name => 'foo'}], 'right structure'; }; subtest 'Non-blocking read' => sub { my $result; my $promise = Mojo::Promise->new; $db->select( 'crud_test', sub { $result = pop->hashes->to_array; $promise->resolve; } ); $promise->wait; is_deeply $result, [{id => 1, name => 'foo'}, {id => 2, name => 'baz'}], 'right structure'; $result = undef; $promise = Mojo::Promise->new; $db->select( 'crud_test', undef, undef, {-desc => 'id'}, sub { $result = pop->hashes->to_array; $promise->resolve; } ); $promise->wait; is_deeply $result, [{id => 2, name => 'baz'}, {id => 1, name => 'foo'}], 'right structure'; }; subtest 'Update' => sub { $db->update('crud_test', {name => 'yada'}, {name => 'foo'}); is_deeply $db->select('crud_test', undef, undef, {-asc => 'id'})->hashes->to_array, [{id => 1, name => 'yada'}, {id => 2, name => 'baz'}], 'right structure'; }; subtest 'Delete' => sub { $db->delete('crud_test', {name => 'yada'}); is_deeply $db->select('crud_test', undef, undef, {-asc => 'id'})->hashes->to_array, [{id => 2, name => 'baz'}], 'right structure'; $db->delete('crud_test'); is_deeply $db->select('crud_test')->hashes->to_array, [], 'right structure'; }; subtest 'Quoting' => sub { $db->query( 'CREATE TABLE IF NOT EXISTS crud_test2 ( id SERIAL PRIMARY KEY, "t e s t" TEXT )' ); $db->insert('crud_test2', {'t e s t' => 'foo'}); $db->insert('mojo_crud_test.crud_test2', {'t e s t' => 'bar'}); is_deeply $db->select('mojo_crud_test.crud_test2')->hashes->to_array, [{id => 1, 't e s t' => 'foo'}, {id => 2, 't e s t' => 'bar'}], 'right structure'; }; subtest 'Arrays' => sub { $db->query( 'CREATE TABLE IF NOT EXISTS crud_test3 ( id SERIAL PRIMARY KEY, names TEXT[] )' ); $db->insert('crud_test3', {names => ['foo', 'bar']}); is_deeply $db->select('crud_test3')->hashes->to_array, [{id => 1, names => ['foo', 'bar']}], 'right structure'; $db->update('crud_test3', {names => ['foo', 'bar', 'baz', 'yada']}, {id => 1}); is_deeply $db->select('crud_test3')->hashes->to_array, [{id => 1, names => ['foo', 'bar', 'baz', 'yada']}], 'right structure'; }; subtest 'Promises' => sub { my $result; $pg->db->insert_p('crud_test', {name => 'promise'}, {returning => '*'})->then(sub { $result = shift->hash })->wait; is $result->{name}, 'promise', 'right result'; $result = undef; $db->select_p('crud_test', '*', {name => 'promise'})->then(sub { $result = shift->hash })->wait; is $result->{name}, 'promise', 'right result'; $result = undef; my $first = $pg->db->query_p("SELECT * FROM crud_test WHERE name = 'promise'"); my $second = $pg->db->query_p("SELECT * FROM crud_test WHERE name = 'promise'"); Mojo::Promise->all($first, $second)->then(sub { my ($first, $second) = @_; $result = [$first->[0]->hash, $second->[0]->hash]; })->wait; is $result->[0]{name}, 'promise', 'right result'; is $result->[1]{name}, 'promise', 'right result'; $result = undef; $db->update_p('crud_test', {name => 'promise_two'}, {name => 'promise'}, {returning => '*'}) ->then(sub { $result = shift->hash })->wait; is $result->{name}, 'promise_two', 'right result'; $db->delete_p('crud_test', {name => 'promise_two'}, {returning => '*'})->then(sub { $result = shift->hash })->wait; is $result->{name}, 'promise_two', 'right result'; }; subtest 'Promises (rejected)' => sub { my $fail; $db->dollar_only->query_p('does_not_exist')->catch(sub { $fail = shift })->wait; like $fail, qr/does_not_exist/, 'right error'; }; subtest 'Join' => sub { $db->query( 'CREATE TABLE IF NOT EXISTS crud_test4 ( id SERIAL PRIMARY KEY, test1 TEXT )' ); $db->query( 'CREATE TABLE IF NOT EXISTS crud_test5 ( id SERIAL PRIMARY KEY, test2 TEXT )' ); $db->insert('crud_test4', {test1 => 'hello'}); $db->insert('crud_test5', {test2 => 'world'}); is_deeply $db->select(['crud_test4', ['crud_test5', id => 'id']], ['crud_test4.id', 'test1', 'test2', ['crud_test4.test1' => 'test3']])->hashes->to_array, [{id => 1, test1 => 'hello', test2 => 'world', test3 => 'hello'}], 'right structure'; }; # Clean up once we are done $pg->db->query('DROP SCHEMA mojo_crud_test CASCADE'); done_testing(); Mojo-Pg-4.26/t/migrations/test.sql000644 000765 000024 00000000422 14114713525 016775 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-4.26/t/migrations/tree/000755 000765 000024 00000000000 14116227130 016230 5ustar00sristaff000000 000000 Mojo-Pg-4.26/t/migrations/tree2/000755 000765 000024 00000000000 14116227130 016312 5ustar00sristaff000000 000000 Mojo-Pg-4.26/t/migrations/tree2/subtree/000755 000765 000024 00000000000 14116227130 017763 5ustar00sristaff000000 000000 Mojo-Pg-4.26/t/migrations/tree2/8/000755 000765 000024 00000000000 14116227130 016461 5ustar00sristaff000000 000000 Mojo-Pg-4.26/t/migrations/tree2/8/up.sql000644 000765 000024 00000000105 14114713525 017630 0ustar00sristaff000000 000000 CREATE TABLE IF NOT EXISTS mojo_migrations_test8 (foo VARCHAR(255)); Mojo-Pg-4.26/t/migrations/tree2/subtree/9/000755 000765 000024 00000000000 14116227130 020133 5ustar00sristaff000000 000000 Mojo-Pg-4.26/t/migrations/tree2/subtree/9/up.sql000644 000765 000024 00000000105 14114713525 021302 0ustar00sristaff000000 000000 CREATE TABLE IF NOT EXISTS mojo_migrations_test9 (foo VARCHAR(255)); Mojo-Pg-4.26/t/migrations/tree/1/000755 000765 000024 00000000000 14116227130 016370 5ustar00sristaff000000 000000 Mojo-Pg-4.26/t/migrations/tree/36/000755 000765 000024 00000000000 14116227130 016460 5ustar00sristaff000000 000000 Mojo-Pg-4.26/t/migrations/tree/99/000755 000765 000024 00000000000 14116227130 016471 5ustar00sristaff000000 000000 Mojo-Pg-4.26/t/migrations/tree/55/000755 000765 000024 00000000000 14116227130 016461 5ustar00sristaff000000 000000 Mojo-Pg-4.26/t/migrations/tree/2/000755 000765 000024 00000000000 14116227130 016371 5ustar00sristaff000000 000000 Mojo-Pg-4.26/t/migrations/tree/2/up.sql000644 000765 000024 00000000151 14114713525 017541 0ustar00sristaff000000 000000 INSERT INTO migration_test_three VALUES ('just'); INSERT INTO migration_test_three VALUES ('works ♥'); Mojo-Pg-4.26/t/migrations/tree/2/down.sql000644 000765 000024 00000000000 14114713525 020055 0ustar00sristaff000000 000000 Mojo-Pg-4.26/t/migrations/tree/55/upgrade.sql000644 000765 000024 00000000111 14114713525 020630 0ustar00sristaff000000 000000 CREATE TABLE IF NOT EXISTS mojo_migrations_upgrading (baz VARCHAR(255)); Mojo-Pg-4.26/t/migrations/tree/99/up.sql000644 000765 000024 00000000114 14114713525 017640 0ustar00sristaff000000 000000 CREATE TABLE IF NOT EXISTS migration_test_luft_balloons (baz VARCHAR(255)); Mojo-Pg-4.26/t/migrations/tree/36/up.sql000644 000765 000024 00000000000 14114713525 017621 0ustar00sristaff000000 000000 Mojo-Pg-4.26/t/migrations/tree/1/up.sql000644 000765 000024 00000000104 14114713525 017536 0ustar00sristaff000000 000000 CREATE TABLE IF NOT EXISTS migration_test_three (baz VARCHAR(255)); Mojo-Pg-4.26/t/migrations/tree/1/down.sql000644 000765 000024 00000000053 14114713525 020064 0ustar00sristaff000000 000000 DROP TABLE IF EXISTS migration_test_three;