Mojo-Pg-4.18/000755 000765 000024 00000000000 13614530445 012663 5ustar00sristaff000000 000000 Mojo-Pg-4.18/LICENSE000644 000765 000024 00000021413 13565540163 013674 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.18/Changes000644 000765 000024 00000025510 13614530110 014146 0ustar00sristaff000000 000000 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.18/MANIFEST000644 000765 000024 00000002047 13614530445 014017 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 lib/SQL/Abstract/Pg.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/pg_lite_app.t t/pod.t t/pod_coverage.t t/pubsub.t t/results.t t/sql.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Mojo-Pg-4.18/t/000755 000765 000024 00000000000 13614530445 013126 5ustar00sristaff000000 000000 Mojo-Pg-4.18/README.md000644 000765 000024 00000002762 13565540164 014155 0ustar00sristaff000000 000000 # Mojo::Pg [![Build Status](https://travis-ci.com/mojolicious/mojo-pg.svg?branch=master)](https://travis-ci.com/mojolicious/mojo-pg) 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.18/MANIFEST.SKIP000644 000765 000024 00000000132 13565540164 014561 0ustar00sristaff000000 000000 ^\.(?!perltidyrc) .*\.old$ \.tar\.gz$ ^Makefile$ ^MYMETA\. ^blib ^pm_to_blib \B\.DS_Store Mojo-Pg-4.18/examples/000755 000765 000024 00000000000 13614530445 014501 5ustar00sristaff000000 000000 Mojo-Pg-4.18/META.yml000644 000765 000024 00000001621 13614530445 014134 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.44, 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.03' SQL::Abstract: '1.86' perl: '5.010001' resources: IRC: irc://irc.freenode.net/#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.18' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Mojo-Pg-4.18/lib/000755 000765 000024 00000000000 13614530445 013431 5ustar00sristaff000000 000000 Mojo-Pg-4.18/Makefile.PL000644 000765 000024 00000002112 13565540164 014635 0ustar00sristaff000000 000000 use 5.010001; use strict; use warnings; use utf8; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Mojo::Pg', VERSION_FROM => 'lib/Mojo/Pg.pm', ABSTRACT => 'Mojolicious ♥ PostgreSQL', AUTHOR => 'Sebastian Riedel ', LICENSE => 'artistic_2', META_MERGE => { dynamic_config => 0, 'meta-spec' => {version => 2}, no_index => {directory => ['examples', 't']}, prereqs => {runtime => {requires => {perl => '5.010001'}}}, resources => { bugtracker => {web => 'https://github.com/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 => 'irc://irc.freenode.net/#mojo' }, }, PREREQ_PM => {'DBD::Pg' => 3.007004, Mojolicious => '8.03', 'SQL::Abstract' => '1.86'}, test => {TESTS => 't/*.t t/*/*.t'} ); Mojo-Pg-4.18/.perltidyrc000644 000765 000024 00000001023 13565540164 015045 0ustar00sristaff000000 000000 -pbp # Start with Perl Best Practices -w # Show all warnings -iob # Ignore old breakpoints -l=80 # 80 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.18/META.json000644 000765 000024 00000003031 13614530445 014301 0ustar00sristaff000000 000000 { "abstract" : "Mojolicious ♥ PostgreSQL", "author" : [ "Sebastian Riedel " ], "dynamic_config" : 0, "generated_by" : "ExtUtils::MakeMaker version 7.44, 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.03", "SQL::Abstract" : "1.86", "perl" : "5.010001" } } }, "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" : "irc://irc.freenode.net/#mojo" }, "version" : "4.18", "x_serialization_backend" : "JSON::PP version 4.04" } Mojo-Pg-4.18/lib/Mojo/000755 000765 000024 00000000000 13614530445 014335 5ustar00sristaff000000 000000 Mojo-Pg-4.18/lib/SQL/000755 000765 000024 00000000000 13614530445 014070 5ustar00sristaff000000 000000 Mojo-Pg-4.18/lib/SQL/Abstract/000755 000765 000024 00000000000 13614530445 015633 5ustar00sristaff000000 000000 Mojo-Pg-4.18/lib/SQL/Abstract/Pg.pm000644 000765 000024 00000025457 13565540164 016560 0ustar00sristaff000000 000000 package SQL::Abstract::Pg; use Mojo::Base 'SQL::Abstract'; BEGIN { *puke = \&SQL::Abstract::puke } sub insert { my ($self, $table, $data, $options) = @_; local @{$options}{qw(returning _pg_returning)} = (1, 1) if exists $options->{on_conflict} && !$options->{returning}; return $self->SUPER::insert($table, $data, $options); } sub new { my $self = shift->SUPER::new(@_); # -json op push @{$self->{unary_ops}}, { regex => qr/^json$/, handler => sub { '?', {json => $_[2]} } }; return $self; } sub _insert_returning { my ($self, $options) = @_; delete $options->{returning} if $options->{_pg_returning}; # ON CONFLICT my $sql = ''; my @bind; if (exists $options->{on_conflict}) { my $conflict = $options->{on_conflict}; my ($conflict_sql, @conflict_bind); $self->_SWITCH_refkind( $conflict => { ARRAYREF => sub { my ($target, $set) = @$conflict; puke 'on_conflict value must be in the form [$target, \%set]' unless ref $set eq 'HASH'; $target = [$target] unless ref $target eq 'ARRAY'; $conflict_sql = '(' . join(', ', map { $self->_quote($_) } @$target) . ')'; $conflict_sql .= $self->_sqlcase(' do update set '); my ($set_sql, @set_bind) = $self->_update_set_values($set); $conflict_sql .= $set_sql; push @conflict_bind, @set_bind; }, ARRAYREFREF => sub { ($conflict_sql, @conflict_bind) = @$$conflict }, SCALARREF => sub { $conflict_sql = $$conflict }, UNDEF => sub { $conflict_sql = $self->_sqlcase('do nothing') } } ); $sql .= $self->_sqlcase(' on conflict ') . $conflict_sql; push @bind, @conflict_bind; } $sql .= $self->SUPER::_insert_returning($options) if $options->{returning}; return $sql, @bind; } sub _order_by { my ($self, $options) = @_; # Legacy return $self->SUPER::_order_by($options) if ref $options ne 'HASH' or grep {/^-(?:desc|asc)/i} keys %$options; # GROUP BY my $sql = ''; my @bind; if (defined(my $group = $options->{group_by})) { my $group_sql; $self->_SWITCH_refkind( $group => { ARRAYREF => sub { $group_sql = join ', ', map { $self->_quote($_) } @$group; }, SCALARREF => sub { $group_sql = $$group } } ); $sql .= $self->_sqlcase(' group by ') . $group_sql; } # HAVING if (defined(my $having = $options->{having})) { my ($having_sql, @having_bind) = $self->_recurse_where($having); $sql .= $self->_sqlcase(' having ') . $having_sql; push @bind, @having_bind; } # ORDER BY $sql .= $self->_order_by($options->{order_by}) if defined $options->{order_by}; # LIMIT if (defined $options->{limit}) { $sql .= $self->_sqlcase(' limit ') . '?'; push @bind, $options->{limit}; } # OFFSET if (defined $options->{offset}) { $sql .= $self->_sqlcase(' offset ') . '?'; push @bind, $options->{offset}; } # FOR if (defined(my $for = $options->{for})) { my $for_sql; $self->_SWITCH_refkind( $for => { SCALAR => sub { puke qq{for value "$for" is not allowed} unless $for eq 'update'; $for_sql = $self->_sqlcase('UPDATE'); }, SCALARREF => sub { $for_sql .= $$for } } ); $sql .= $self->_sqlcase(' for ') . $for_sql; } return $sql, @bind; } sub _select_fields { my ($self, $fields) = @_; return $fields unless ref $fields eq 'ARRAY'; my (@fields, @bind); for my $field (@$fields) { $self->_SWITCH_refkind( $field => { ARRAYREF => sub { puke 'field alias must be in the form [$name => $alias]' if @$field < 2; push @fields, $self->_quote($field->[0]) . $self->_sqlcase(' as ') . $self->_quote($field->[1]); }, ARRAYREFREF => sub { push @fields, shift @$$field; push @bind, @$$field; }, SCALARREF => sub { push @fields, $$field }, FALLBACK => sub { push @fields, $self->_quote($field) } } ); } return join(', ', @fields), @bind; } sub _table { my ($self, $table) = @_; return $self->SUPER::_table($table) unless ref $table eq 'ARRAY'; my (@table, @join); for my $t (@$table) { if (ref $t eq 'ARRAY') { push @join, $t } else { push @table, $t } } $table = $self->SUPER::_table(\@table); my $sep = $self->{name_sep} // ''; for my $join (@join) { puke 'join must be in the form [$table, $fk => $pk]' if @$join < 3; my ($type, $name, $fk, $pk, @morekeys) = @$join % 2 == 0 ? @$join : ('', @$join); $table .= $self->_sqlcase($type =~ /^-(.+)$/ ? " $1 join " : ' join ') . $self->_quote($name) . $self->_sqlcase(' on ') . '('; do { $table .= $self->_quote(index($fk, $sep) > 0 ? $fk : "$name.$fk") . ' = ' . $self->_quote(index($pk, $sep) > 0 ? $pk : "$table[0].$pk") . (@morekeys ? $self->_sqlcase(' and ') : ')'); } while ($fk, $pk, @morekeys) = @morekeys; } return $table; } 1; =encoding utf8 =head1 NAME SQL::Abstract::Pg - PostgreSQL =head1 SYNOPSIS use SQL::Abstract::Pg; my $abstract = SQL::Abstract::Pg->new; say $abstract->select('some_table'); =head1 DESCRIPTION L extends L with a few PostgreSQL features used by L. =head2 JSON In many places (as supported by L) you can use the C<-json> unary op to encode JSON from Perl data structures. # "update some_table set foo = '[1,2,3]' where bar = 23" $abstract->update('some_table', {foo => {-json => [1, 2, 3]}}, {bar => 23}); # "select * from some_table where foo = '[1,2,3]'" $abstract->select('some_table', '*', {foo => {'=' => {-json => [1, 2, 3]}}}); =head1 INSERT $abstract->insert($table, \@values || \%fieldvals, \%options); =head2 ON CONFLICT The C option can be used to generate C queries with C clauses. So far, C to pass C, array references to pass C with conflict targets and a C expression, scalar references to pass literal SQL and array reference references to pass literal SQL with bind values are supported. # "insert into t (a) values ('b') on conflict do nothing" $abstract->insert('t', {a => 'b'}, {on_conflict => undef}); # "insert into t (a) values ('b') on conflict do nothing" $abstract->insert('t', {a => 'b'}, {on_conflict => \'do nothing'}); This includes operations commonly referred to as C. # "insert into t (a) values ('b') on conflict (a) do update set a = 'c'" $abstract->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'" $abstract->insert( 't', {a => 'c', b => 'd'}, {on_conflict => [['a', 'b'] => {a => 'e'}]}); # "insert into t (a) values ('b') on conflict (a) do update set a = 'c'" $abstract->insert( 't', {a => 'b'}, {on_conflict => \['(a) do update set a = ?', 'c']}); =head1 SELECT $abstract->select($source, $fields, $where, $order); $abstract->select($source, $fields, $where, \%options); =head2 AS The C<$fields> argument now also accepts array references containing array references with field names and aliases, as well as array references containing scalar references to pass literal SQL and array reference references to pass literal SQL with bind values. # "select foo as bar from some_table" $abstract->select('some_table', [[foo => 'bar']]); # "select foo, bar as baz, yada from some_table" $abstract->select('some_table', ['foo', [bar => 'baz'], 'yada']); # "select extract(epoch from foo) as foo, bar from some_table" $abstract->select('some_table', [\'extract(epoch from foo) as foo', 'bar']); # "select 'test' as foo, bar from some_table" $abstract->select('some_table', [\['? as foo', 'test'], 'bar']); =head2 JOIN The C<$source> argument now also accepts array references containing not only table names, but also array references with tables to generate C clauses for. # "select * from foo join bar on (bar.foo_id = foo.id)" $abstract->select(['foo', ['bar', foo_id => 'id']]); # "select * from foo join bar on (foo.id = bar.foo_id)" $abstract->select(['foo', ['bar', 'foo.id' => 'bar.foo_id']]); # "select * from a join b on (b.a_id = a.id) join c on (c.a_id = a.id)" $abstract->select(['a', ['b', a_id => 'id'], ['c', a_id => 'id']]); # "select * from foo left join bar on (bar.foo_id = foo.id)" $abstract->select(['foo', [-left => 'bar', foo_id => 'id']]); # "select * from a left join b on (b.a_id = a.id and b.a_id2 = a.id2)" $abstract->select(['a', [-left => 'b', a_id => 'id', a_id2 => 'id2']]); =head2 ORDER BY Alternatively to the C<$order> argument accepted by L you can now also pass a hash reference with various options. This includes C, which takes the same values as the C<$order> argument. # "select * from some_table order by foo desc" $abstract->select('some_table', '*', undef, {order_by => {-desc => 'foo'}}); =head2 LIMIT/OFFSET The C and C options can be used to generate C queries with C clauses. So far, array references to pass a list of fields and scalar references to pass literal SQL are supported. # "select * from some_table group by foo, bar" $abstract->select('some_table', '*', undef, {group_by => ['foo', 'bar']}); # "select * from some_table group by foo, bar" $abstract->select('some_table', '*', undef, {group_by => \'foo, bar'}); =head2 HAVING The C option can be used to generate C queries with C clauses. So far, the scalar value C to pass C and scalar references to pass literal SQL are supported. # "select * from some_table for update" $abstract->select('some_table', '*', undef, {for => 'update'}); # "select * from some_table for update skip locked" $abstract->select('some_table', '*', undef, {for => \'update skip locked'}); =head1 METHODS L inherits all methods from L. =head1 SEE ALSO L, L, L. =cut Mojo-Pg-4.18/lib/Mojo/Pg.pm000644 000765 000024 00000037313 13614530072 015244 0ustar00sristaff000000 000000 package Mojo::Pg; use Mojo::Base 'Mojo::EventEmitter'; use Carp 'croak'; use DBI; use Mojo::Pg::Database; use Mojo::Pg::Migrations; use Mojo::Pg::PubSub; use Mojo::URL; use Scalar::Util '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.18'; 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 _dequeue { my $self = shift; # Fork-safety delete @$self{qw(pid queue)} unless ($self->{pid} //= $$) eq $$; while (my $dbh = shift @{$self->{queue} || []}) { return $dbh if $dbh->ping } my $dbh = DBI->connect(map { $self->$_ } qw(dsn username password options)); # Search path if (my $path = $self->search_path) { my $search_path = join ', ', map { $dbh->quote_identifier($_) } @$path; $dbh->do("set search_path to $search_path"); } $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 { my ($db, $err, $results) = @_; die $err if $err; say $_->{name} for $results->hashes->each; }); Mojo::IOLoop->start unless Mojo::IOLoop->is_running; # Concurrent non-blocking queries (synchronized with 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 { my ($now, $names) = @_; say $now->[0]->hash->{now}; say $_->{name} for $names->[0]->hashes->each; })->catch(sub { my $err = shift; warn "Something went wrong: $err"; })->wait; # Send and receive notifications non-blocking $pg->pubsub->listen(foo => sub { my ($pubsub, $payload) = @_; say "foo: $payload"; $pubsub->notify(bar => $payload); }); $pg->pubsub->listen(bar => sub { my ($pubsub, $payload) = @_; say "bar: $payload"; }); $pg->pubsub->notify(foo => 'PostgreSQL rocks!'); Mojo::IOLoop->start unless Mojo::IOLoop->is_running; =head1 DESCRIPTION L is a tiny wrapper around L that makes L a lot of fun to use with the L real-time web framework. 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; use Mojo::Pg; helper pg => sub { state $pg = Mojo::Pg->new('postgresql://postgres@/test') }; get '/' => sub { my $c = shift; my $db = $c->pg->db; $c->render(json => $db->query('select now() as now')->hash); }; app->start; In this example application, we create a C helper to store a L object. Our action calls that helper and uses the method L to dequeue a L object from the connection pool. Then we use the method L to execute an L statement, which returns a L object. And finally we call the method L to retrieve the first row as a hash reference. While all I/O operations are performed blocking, you can wait for long running queries asynchronously, allowing the L event loop to perform other tasks in the meantime. Since database connections usually have a very low latency, this often results in very good performance. Every database connection can only handle one active query at a time, this includes asynchronous ones. To perform multiple queries concurrently, you have to use multiple connections. # Performed concurrently (5 seconds) $pg->db->query('select pg_sleep(5)' => sub {...}); $pg->db->query('select pg_sleep(5)' => sub {...}); All cached database handles will be reset automatically if a new process has been forked, this allows multiple processes to share the same L object safely. =head1 GROWING And as your application grows, you can move queries into model classes. package MyApp::Model::Time; use Mojo::Base -base; has 'pg'; sub now { shift->pg->db->query('select now() as now')->hash } 1; Which get integrated into your application with helpers. use Mojolicious::Lite; use Mojo::Pg; use MyApp::Model::Time; helper pg => sub { state $pg = Mojo::Pg->new('postgresql://postgres@/test') }; helper time => sub { state $time = MyApp::Model::Time->new(pg => shift->pg) }; get '/' => sub { my $c = shift; $c->render(json => $c->time->now); }; app->start; =head1 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 { my ($pg, $dbh) = @_; ... }); Emitted when a new database connection has been established. $pg->on(connection => sub { my ($pg, $dbh) = @_; $dbh->do('set search_path to my_schema'); }); =head1 ATTRIBUTES L implements the following attributes. =head2 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 { my ($pubsub, $payload) = @_; say "Received: $payload"; }); # Notify a channel $pg->pubsub->notify(news => 'PostgreSQL rocks!'); =head2 search_path my $path = $pg->search_path; $pg = $pg->search_path(['$user', 'foo', 'public']); Schema search path assigned to all new connections. # Isolate tests and avoid race conditions when running them in parallel my $pg = Mojo::Pg->new('postgresql:///test')->search_path(['test_one']); $pg->db->query('drop schema if exists test_one cascade'); $pg->db->query('create schema test_one'); ... $pg->db->query('drop schema test_one cascade'); =head2 username my $username = $pg->username; $pg = $pg->username('sri'); Database username, defaults to an empty string. =head1 METHODS L inherits all methods from L and implements the following new ones. =head2 db my $db = $pg->db; Get a database object based on L (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'); =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 REFERENCE This is the class hierarchy of the L distribution. =over 2 =item * L =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-2020, 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.18/lib/Mojo/Pg/000755 000765 000024 00000000000 13614530445 014703 5ustar00sristaff000000 000000 Mojo-Pg-4.18/lib/Mojo/Pg/Results.pm000644 000765 000024 00000010524 13565540164 016710 0ustar00sristaff000000 000000 package Mojo::Pg::Results; use Mojo::Base -base; use Mojo::Collection; use Mojo::JSON 'from_json'; use Mojo::Util '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 next row from L and return it as an array reference. Note that L needs to be called if you are not fetching all the possible rows. # Process one row at a time while (my $next = $results->array) { say $next->[3]; } =head2 arrays my $collection = $results->arrays; Fetch all rows from L and return them as a L object containing array references. # Process all rows at once say $results->arrays->reduce(sub { $a + $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 next row from L and return it as a hash reference. Note that L needs to be called if you are not fetching all the possible rows. # Process one row at a time while (my $next = $results->hash) { say $next->{money}; } =head2 hashes my $collection = $results->hashes; Fetch all rows from L and return them as a L object containing hash references. # Process all rows at once say $results->hashes->reduce(sub { $a + $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.18/lib/Mojo/Pg/Database.pm000644 000765 000024 00000043344 13566073771 016767 0ustar00sristaff000000 000000 package Mojo::Pg::Database; use Mojo::Base 'Mojo::EventEmitter'; use Carp qw(croak shortmess); use DBD::Pg ':async'; use Mojo::IOLoop; use Mojo::JSON 'to_json'; use Mojo::Pg::Results; use Mojo::Pg::Transaction; use Mojo::Promise; use Mojo::Util '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; 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->_unwatch unless $self->{waiting} || $self->is_listening; return $self; } sub _notifications { my $self = shift; my $dbh = $self->dbh; my $n; return undef unless $n = $dbh->pg_notifies; while ($n) { $self->emit(notification => @$n); $n = $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 { my $db = shift; ... }); Emitted when the database connection gets closed while waiting for notifications. =head2 notification $db->on(notification => sub { my ($db, $name, $pid, $payload) = @_; ... }); Emitted when a notification has been received. =head1 ATTRIBUTES L implements the following attributes. =head2 dbh my $dbh = $db->dbh; $db = $db->dbh($dbh); L database handle used for all queries. # Use DBI utility methods my $quoted = $db->dbh->quote_identifier('foo.bar'); =head2 pg my $pg = $db->pg; $db = $db->pg(Mojo::Pg->new); L object this database belongs to. 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 { my ($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 { my $results = shift; ... })->catch(sub { my $err = shift; ... })->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 { my ($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 { my $results = shift; ... })->catch(sub { my $err = shift; ... })->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 { my ($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 { my $results = shift; ... })->catch(sub { my $err = shift; ... })->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 { my $results = shift; ... })->catch(sub { my $err = shift; ... })->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 { my ($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 { my $results = shift; ... })->catch(sub { my $err = shift; ... })->wait; =head1 SEE ALSO L, L, L. =cut Mojo-Pg-4.18/lib/Mojo/Pg/Transaction.pm000644 000765 000024 00000003003 13565540164 017526 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.18/lib/Mojo/Pg/Migrations.pm000644 000765 000024 00000014200 13565540164 017356 0ustar00sristaff000000 000000 package Mojo::Pg::Migrations; use Mojo::Base -base; use Carp 'croak'; use Mojo::File 'path'; use Mojo::Loader 'data_section'; use Mojo::Util 'decode'; use constant DEBUG => $ENV{MOJO_MIGRATIONS_DEBUG} || 0; has name => 'migrations'; has pg => 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_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_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.18/lib/Mojo/Pg/PubSub.pm000644 000765 000024 00000013224 13565540164 016447 0ustar00sristaff000000 000000 package Mojo::Pg::PubSub; use Mojo::Base 'Mojo::EventEmitter'; use Mojo::JSON qw(from_json to_json); use Scalar::Util 'weaken'; has pg => 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) = @_; $payload = eval { from_json $payload } if $self->{json}{$name}; my @cbs = @{$self->{chans}{$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 { Mojo::Util::_global_destruction() or shift->reset } 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 { my ($pubsub, $payload) = @_; say "Received: $payload"; }); $pubsub->notify(foo => 'I ♥ Mojolicious!'); $pubsub->unlisten(foo => $cb); =head1 DESCRIPTION L is a scalable implementation of the publish/subscribe pattern used by L. It is based on PostgreSQL notifications and allows many consumers to share the same database connection, to avoid many common scalability problems. =head1 EVENTS L inherits all events from L and can emit the following new ones. =head2 disconnect $pubsub->on(disconnect => sub { my ($pubsub, $db) = @_; ... }); Emitted after the current database connection is lost. =head2 reconnect $pubsub->on(reconnect => sub { my ($pubsub, $db) = @_; ... }); Emitted after switching to a new database connection for sending and receiving notifications. =head1 ATTRIBUTES L implements the following attributes. =head2 pg my $pg = $pubsub->pg; $pubsub = $pubsub->pg(Mojo::Pg->new); L object this publish/subscribe container belongs to. 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 { shift->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 { my ($pubsub, $payload) = @_; say $payload->{bar}; }); $pubsub->notify(foo => {bar => 'I ♥ Mojolicious!'}); =head2 listen my $cb = $pubsub->listen(foo => sub {...}); Subscribe to a channel, there is no limit on how many subscribers a channel can have. Automatic decoding of JSON text to Perl values can be activated with L. # Subscribe to the same channel twice $pubsub->listen(foo => sub { my ($pubsub, $payload) = @_; say "One: $payload"; }); $pubsub->listen(foo => sub { my ($pubsub, $payload) = @_; say "Two: $payload"; }); =head2 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.18/examples/blog/000755 000765 000024 00000000000 13614530445 015424 5ustar00sristaff000000 000000 Mojo-Pg-4.18/examples/chat.pl000644 000765 000024 00000001656 13565540164 015771 0ustar00sristaff000000 000000 use Mojolicious::Lite; use Mojo::Pg; helper pg => sub { state $pg = Mojo::Pg->new('postgresql://postgres@/test') }; get '/' => 'chat'; websocket '/channel' => sub { my $c = shift; $c->inactivity_timeout(3600); # Forward messages from the browser to PostgreSQL $c->on(message => sub { shift->pg->pubsub->notify(mojochat => shift) }); # Forward messages from PostgreSQL to the browser my $cb = $c->pg->pubsub->listen(mojochat => sub { $c->send(pop) }); $c->on(finish => sub { shift->pg->pubsub->unlisten(mojochat => $cb) }); }; app->start; __DATA__ @@ chat.html.ep
Mojo-Pg-4.18/examples/blog/migrations/000755 000765 000024 00000000000 13614530445 017600 5ustar00sristaff000000 000000 Mojo-Pg-4.18/examples/blog/t/000755 000765 000024 00000000000 13614530445 015667 5ustar00sristaff000000 000000 Mojo-Pg-4.18/examples/blog/script/000755 000765 000024 00000000000 13614530445 016730 5ustar00sristaff000000 000000 Mojo-Pg-4.18/examples/blog/blog.conf000644 000765 000024 00000000132 13565540164 017216 0ustar00sristaff000000 000000 { pg => 'postgresql://postgres@127.0.0.1:5432/postgres', secrets => ['s3cret'] } Mojo-Pg-4.18/examples/blog/lib/000755 000765 000024 00000000000 13614530445 016172 5ustar00sristaff000000 000000 Mojo-Pg-4.18/examples/blog/templates/000755 000765 000024 00000000000 13614530445 017422 5ustar00sristaff000000 000000 Mojo-Pg-4.18/examples/blog/templates/posts/000755 000765 000024 00000000000 13614530445 020572 5ustar00sristaff000000 000000 Mojo-Pg-4.18/examples/blog/templates/layouts/000755 000765 000024 00000000000 13614530445 021122 5ustar00sristaff000000 000000 Mojo-Pg-4.18/examples/blog/templates/layouts/blog.html.ep000644 000765 000024 00000000724 13565540164 023345 0ustar00sristaff000000 000000 <%= title %>

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

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

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

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

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

New post

%= include 'posts/_form', caption => 'Create', target => 'store_post' Mojo-Pg-4.18/examples/blog/lib/Blog/000755 000765 000024 00000000000 13614530445 017055 5ustar00sristaff000000 000000 Mojo-Pg-4.18/examples/blog/lib/Blog.pm000644 000765 000024 00000002123 13565540164 017415 0ustar00sristaff000000 000000 package Blog; use Mojo::Base 'Mojolicious'; use Blog::Model::Posts; use Mojo::Pg; sub startup { my $self = shift; # Configuration $self->plugin('Config'); $self->secrets($self->config('secrets')); # Model $self->helper(pg => sub { state $pg = Mojo::Pg->new(shift->config('pg')) }); $self->helper( posts => sub { state $posts = Blog::Model::Posts->new(pg => shift->pg) }); # Migrate to latest version if necessary my $path = $self->home->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.18/examples/blog/lib/Blog/Controller/000755 000765 000024 00000000000 13614530445 021200 5ustar00sristaff000000 000000 Mojo-Pg-4.18/examples/blog/lib/Blog/Model/000755 000765 000024 00000000000 13614530445 020115 5ustar00sristaff000000 000000 Mojo-Pg-4.18/examples/blog/lib/Blog/Model/Posts.pm000644 000765 000024 00000001030 13565540164 021561 0ustar00sristaff000000 000000 package Blog::Model::Posts; use Mojo::Base -base; has 'pg'; sub add { my ($self, $post) = @_; return $self->pg->db->insert('posts', $post, {returning => 'id'})->hash->{id}; } sub all { shift->pg->db->select('posts')->hashes->to_array } sub find { my ($self, $id) = @_; return $self->pg->db->select('posts', '*', {id => $id})->hash; } sub remove { my ($self, $id) = @_; $self->pg->db->delete('posts', {id => $id}); } sub save { my ($self, $id, $post) = @_; $self->pg->db->update('posts', $post, {id => $id}); } 1; Mojo-Pg-4.18/examples/blog/lib/Blog/Controller/Posts.pm000644 000765 000024 00000002147 13565540164 022656 0ustar00sristaff000000 000000 package Blog::Controller::Posts; use Mojo::Base 'Mojolicious::Controller'; sub create { shift->render(post => {}) } sub edit { my $self = shift; $self->render(post => $self->posts->find($self->param('id'))); } sub index { my $self = shift; $self->render(posts => $self->posts->all); } sub remove { my $self = shift; $self->posts->remove($self->param('id')); $self->redirect_to('posts'); } sub show { my $self = shift; $self->render(post => $self->posts->find($self->param('id'))); } sub store { my $self = shift; my $v = $self->_validation; return $self->render(action => 'create', post => {}) if $v->has_error; my $id = $self->posts->add($v->output); $self->redirect_to('show_post', id => $id); } sub update { my $self = shift; my $v = $self->_validation; return $self->render(action => 'edit', post => {}) if $v->has_error; my $id = $self->param('id'); $self->posts->save($id, $v->output); $self->redirect_to('show_post', id => $id); } sub _validation { my $self = shift; my $v = $self->validation; $v->required('title'); $v->required('body'); return $v; } 1; Mojo-Pg-4.18/examples/blog/script/blog000755 000765 000024 00000000345 13565540164 017607 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.18/examples/blog/t/blog.t000644 000765 000024 00000004524 13565540164 017010 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.18/examples/blog/migrations/blog.sql000644 000765 000024 00000000214 13565540164 021245 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.18/t/pod.t000644 000765 000024 00000000400 13565540164 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.18/t/connection.t000644 000765 000024 00000011230 13565540164 015453 0ustar00sristaff000000 000000 use Mojo::Base -strict; use Test::More; use Mojo::Pg; # Defaults my $pg = Mojo::Pg->new; is $pg->dsn, 'dbi:Pg:', 'right data source'; is $pg->username, '', 'no username'; is $pg->password, '', 'no password'; my $options = { AutoCommit => 1, AutoInactiveDestroy => 1, PrintError => 0, PrintWarn => 0, RaiseError => 1 }; is_deeply $pg->options, $options, 'right options'; is $pg->search_path, undef, 'no search_path'; # Minimal connection string with database $pg = Mojo::Pg->new('postgresql:///test1'); is $pg->dsn, 'dbi:Pg:dbname=test1', 'right data source'; is $pg->username, '', 'no username'; is $pg->password, '', 'no password'; $options = { AutoCommit => 1, AutoInactiveDestroy => 1, PrintError => 0, PrintWarn => 0, RaiseError => 1 }; is_deeply $pg->options, $options, 'right options'; # Minimal connection string with service and option $pg = Mojo::Pg->new('postgres://?service=foo&PrintError=1&PrintWarn=1'); is $pg->dsn, 'dbi:Pg:service=foo', 'right data source'; is $pg->username, '', 'no username'; is $pg->password, '', 'no password'; $options = { AutoCommit => 1, AutoInactiveDestroy => 1, PrintError => 1, PrintWarn => 1, RaiseError => 1 }; is_deeply $pg->options, $options, 'right options'; # Connection string with service and search_path $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'; $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'; # Connection string with multiple search_path values $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'; $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'; # Connection string with host and port $pg = Mojo::Pg->new('postgresql://127.0.0.1:8080/test2'); is $pg->dsn, 'dbi:Pg:dbname=test2;host=127.0.0.1;port=8080', 'right data source'; is $pg->username, '', 'no username'; is $pg->password, '', 'no password'; $options = { AutoCommit => 1, AutoInactiveDestroy => 1, PrintError => 0, PrintWarn => 0, RaiseError => 1 }; is_deeply $pg->options, $options, 'right options'; # Connection string username but without host $pg = Mojo::Pg->new('postgres://postgres@/test3'); is $pg->dsn, 'dbi:Pg:dbname=test3', 'right data source'; is $pg->username, 'postgres', 'right username'; is $pg->password, '', 'no password'; $options = { AutoCommit => 1, AutoInactiveDestroy => 1, PrintError => 0, PrintWarn => 0, RaiseError => 1 }; is_deeply $pg->options, $options, 'right options'; # Connection string with unix domain socket and options $pg = Mojo::Pg->new( 'postgresql://x1:y2@%2ftmp%2fpg.sock/test4?PrintError=1&RaiseError=0'); is $pg->dsn, 'dbi:Pg:dbname=test4;host=/tmp/pg.sock', 'right data source'; is $pg->username, 'x1', 'right username'; is $pg->password, 'y2', 'right password'; $options = { AutoCommit => 1, AutoInactiveDestroy => 1, PrintError => 1, PrintWarn => 0, RaiseError => 0 }; is_deeply $pg->options, $options, 'right options'; # Connection string with lots of zeros $pg = Mojo::Pg->new('postgresql://0:0@/0?RaiseError=0'); is $pg->dsn, 'dbi:Pg:dbname=0', 'right data source'; is $pg->username, '0', 'right username'; is $pg->password, '0', 'right password'; $options = { AutoCommit => 1, AutoInactiveDestroy => 1, PrintError => 0, PrintWarn => 0, RaiseError => 0 }; is_deeply $pg->options, $options, 'right options'; # Invalid connection string eval { Mojo::Pg->new('http://localhost:3000/test') }; like $@, qr/Invalid PostgreSQL connection string/, 'right error'; done_testing(); Mojo-Pg-4.18/t/migrations/000755 000765 000024 00000000000 13614530445 015302 5ustar00sristaff000000 000000 Mojo-Pg-4.18/t/sql.t000644 000765 000024 00000016533 13565540164 014126 0ustar00sristaff000000 000000 use Mojo::Base -strict; use Test::More; use Mojo::Pg; use SQL::Abstract::Test import => ['is_same_sql_bind']; sub is_query { my ($got, $want, $msg) = @_; my $got_sql = shift @$got; my $want_sql = shift @$want; local $Test::Builder::Level = $Test::Builder::Level + 1; is_same_sql_bind $got_sql, $got, $want_sql, $want, $msg; } # Basics my $pg = Mojo::Pg->new; my $abstract = $pg->abstract; is_query [$abstract->insert('foo', {bar => 'baz'})], ['INSERT INTO "foo" ( "bar") VALUES ( ? )', 'baz'], 'right query'; is_query [$abstract->select('foo', '*')], ['SELECT * FROM "foo"'], 'right query'; is_query [$abstract->select(['foo', 'bar', 'baz'])], ['SELECT * FROM "foo", "bar", "baz"'], 'right query'; # ON CONFLICT my @sql = $abstract->insert('foo', {bar => 'baz'}, {on_conflict => \'do nothing'}); is_query \@sql, ['INSERT INTO "foo" ( "bar") VALUES ( ? ) ON CONFLICT do nothing', 'baz'], 'right query'; @sql = $abstract->insert('foo', {bar => 'baz'}, {on_conflict => undef}); is_query \@sql, ['INSERT INTO "foo" ( "bar") VALUES ( ? ) ON CONFLICT DO NOTHING', 'baz'], 'right query'; @sql = $abstract->insert( 'foo', {bar => 'baz'}, {on_conflict => \'do nothing', returning => '*'} ); my $result = [ 'INSERT INTO "foo" ( "bar") VALUES ( ? ) ON CONFLICT do nothing RETURNING *', 'baz' ]; is_query \@sql, $result, 'right query'; @sql = $abstract->insert( 'foo', {bar => 'baz'}, {on_conflict => \['(foo) do update set foo = ?', 'yada']} ); $result = [ 'INSERT INTO "foo" ( "bar") VALUES ( ? )' . ' ON CONFLICT (foo) do update set foo = ?', 'baz', 'yada' ]; is_query \@sql, $result, 'right query'; @sql = $abstract->insert( 'foo', {bar => 'baz'}, {on_conflict => [foo => {foo => 'yada'}]} ); $result = [ 'INSERT INTO "foo" ( "bar") VALUES ( ? )' . ' ON CONFLICT ("foo") DO UPDATE SET "foo" = ?', 'baz', 'yada' ]; is_query \@sql, $result, 'right query'; @sql = $abstract->insert( 'foo', {bar => 'baz'}, {on_conflict => [['foo', 'bar'] => {foo => 'yada'}]} ); $result = [ 'INSERT INTO "foo" ( "bar") VALUES ( ? )' . ' ON CONFLICT ("foo", "bar") DO UPDATE SET "foo" = ?', 'baz', 'yada' ]; is_query \@sql, $result, 'right query'; # ON CONFLICT (unsupported value) eval { $abstract->insert('foo', {bar => 'baz'}, {on_conflict => [[], []]}) }; like $@, qr/on_conflict value must be in the form \[\$target, \\\%set\]/, 'right error'; eval { $abstract->insert('foo', {bar => 'baz'}, {on_conflict => {}}) }; like $@, qr/HASHREF/, 'right error'; # ORDER BY @sql = $abstract->select('foo', '*', {bar => 'baz'}, {-desc => 'yada'}); is_query \@sql, ['SELECT * FROM "foo" WHERE ( "bar" = ? ) ORDER BY "yada" DESC', 'baz'], 'right query'; @sql = $abstract->select('foo', '*', {bar => 'baz'}, {order_by => {-desc => 'yada'}}); is_query \@sql, ['SELECT * FROM "foo" WHERE ( "bar" = ? ) ORDER BY "yada" DESC', 'baz'], 'right query'; # LIMIT/OFFSET @sql = $abstract->select('foo', '*', undef, {limit => 10, offset => 5}); is_query \@sql, ['SELECT * FROM "foo" LIMIT ? OFFSET ?', 10, 5], 'right query'; # GROUP BY @sql = $abstract->select('foo', '*', undef, {group_by => \'bar, baz'}); is_query \@sql, ['SELECT * FROM "foo" GROUP BY bar, baz'], 'right query'; @sql = $abstract->select('foo', '*', undef, {group_by => ['bar', 'baz']}); is_query \@sql, ['SELECT * FROM "foo" GROUP BY "bar", "baz"'], 'right query'; # HAVING @sql = $abstract->select('foo', '*', undef, {group_by => ['bar'], having => {baz => 'yada'}}); is_query \@sql, ['SELECT * FROM "foo" GROUP BY "bar" HAVING "baz" = ?', 'yada'], 'right query'; @sql = $abstract->select( 'foo', '*', {bar => {'>' => 'baz'}}, {group_by => ['bar'], having => {baz => {'<' => 'bar'}}} ); $result = [ 'SELECT * FROM "foo" WHERE ( "bar" > ? ) GROUP BY "bar" HAVING "baz" < ?', 'baz', 'bar' ]; is_query \@sql, $result, 'right query'; # GROUP BY (unsupported value) eval { $abstract->select('foo', '*', undef, {group_by => {}}) }; like $@, qr/HASHREF/, 'right error'; # FOR @sql = $abstract->select('foo', '*', undef, {for => 'update'}); is_query \@sql, ['SELECT * FROM "foo" FOR UPDATE'], 'right query'; @sql = $abstract->select('foo', '*', undef, {for => \'update skip locked'}); is_query \@sql, ['SELECT * FROM "foo" FOR update skip locked'], 'right query'; # FOR (unsupported value) eval { $abstract->select('foo', '*', undef, {for => 'update skip locked'}) }; like $@, qr/for value "update skip locked" is not allowed/, 'right error'; eval { $abstract->select('foo', '*', undef, {for => []}) }; like $@, qr/ARRAYREF/, 'right error'; # AS @sql = $abstract->select('foo', ['bar', [bar => 'baz'], 'yada']); is_query \@sql, ['SELECT "bar", "bar" AS "baz", "yada" FROM "foo"'], 'right query'; @sql = $abstract->select('foo', ['bar', \'extract(epoch from baz) as baz', 'yada']); is_query \@sql, ['SELECT "bar", extract(epoch from baz) as baz, "yada" FROM "foo"'], 'right query'; @sql = $abstract->select('foo', ['bar', \['? as baz', 'test'], 'yada']); is_query \@sql, ['SELECT "bar", ? as baz, "yada" FROM "foo"', 'test'], 'right query'; # AS (unsupported value) eval { $abstract->select('foo', [[]]) }; like $@, qr/field alias must be in the form \[\$name => \$alias\]/, 'right error'; # JSON @sql = $abstract->update('foo', {bar => {-json => [1, 2, 3]}}); is_query \@sql, ['UPDATE "foo" SET "bar" = ?', {json => [1, 2, 3]}], 'right query'; @sql = $abstract->select('foo', '*', {bar => {'=' => {-json => [1, 2, 3]}}}); is_query \@sql, ['SELECT * FROM "foo" WHERE ( "bar" = ? )', {json => [1, 2, 3]}], 'right query'; # JOIN @sql = $abstract->select(['foo', ['bar', foo_id => 'id']]); is_query \@sql, ['SELECT * FROM "foo" JOIN "bar" ON ("bar"."foo_id" = "foo"."id")'], 'right query'; @sql = $abstract->select(['foo', ['bar', 'foo.id' => 'bar.foo_id']]); is_query \@sql, ['SELECT * FROM "foo" JOIN "bar" ON ("foo"."id" = "bar"."foo_id")'], 'right query'; @sql = $abstract->select([ 'foo', ['bar', 'foo.id' => 'bar.foo_id', 'foo.id2' => 'bar.foo_id2'] ]); is_query \@sql, [ 'SELECT * FROM "foo" JOIN "bar" ON ("foo"."id" = "bar"."foo_id"' . ' AND "foo"."id2" = "bar"."foo_id2"' . ')' ], 'right query'; @sql = $abstract->select(['foo', ['bar', foo_id => 'id'], ['baz', foo_id => 'id'] ]); $result = [ 'SELECT * FROM "foo"' . ' JOIN "bar" ON ("bar"."foo_id" = "foo"."id")' . ' JOIN "baz" ON ("baz"."foo_id" = "foo"."id")' ]; is_query \@sql, $result, 'right query'; @sql = $abstract->select(['foo', [-left => 'bar', foo_id => 'id']]); is_query \@sql, ['SELECT * FROM "foo" LEFT JOIN "bar" ON ("bar"."foo_id" = "foo"."id")'], 'right query'; @sql = $abstract->select(['foo', [-right => 'bar', foo_id => 'id']]); is_query \@sql, ['SELECT * FROM "foo" RIGHT JOIN "bar" ON ("bar"."foo_id" = "foo"."id")'], 'right query'; @sql = $abstract->select(['foo', [-inner => 'bar', foo_id => 'id']]); is_query \@sql, ['SELECT * FROM "foo" INNER JOIN "bar" ON ("bar"."foo_id" = "foo"."id")'], 'right query'; @sql = $abstract->select([ 'foo', [-left => 'bar', foo_id => 'id', foo_id2 => 'id2', foo_id3 => 'id3'] ]); is_query \@sql, [ 'SELECT * FROM "foo" LEFT JOIN "bar" ON ("bar"."foo_id" = "foo"."id"' . ' AND "bar"."foo_id2" = "foo"."id2"' . ' AND "bar"."foo_id3" = "foo"."id3"' . ')' ], 'right query'; # JOIN (unsupported value) eval { $abstract->select(['foo', []]) }; like $@, qr/join must be in the form \[\$table, \$fk => \$pk\]/, 'right error'; done_testing(); Mojo-Pg-4.18/t/pubsub.t000644 000765 000024 00000014661 13565540164 014627 0ustar00sristaff000000 000000 use Mojo::Base -strict; BEGIN { $ENV{MOJO_REACTOR} = 'Mojo::Reactor::Poll' } use Test::More; plan skip_all => 'set TEST_ONLINE to enable this test' unless $ENV{TEST_ONLINE}; use Mojo::IOLoop; use Mojo::JSON 'true'; use Mojo::Pg; # Notifications with event loop my $pg = Mojo::Pg->new($ENV{TEST_ONLINE}); my ($db, @all, @test); $pg->pubsub->on(reconnect => sub { $db = pop }); $pg->pubsub->listen( pstest => sub { my ($pubsub, $payload) = @_; push @test, $payload; Mojo::IOLoop->next_tick(sub { $pubsub->pg->db->notify(pstest => 'stop') }); Mojo::IOLoop->stop if $payload eq 'stop'; } ); $db->on(notification => sub { push @all, [@_[1, 3]] }); $pg->db->notify(pstest => '♥test♥'); Mojo::IOLoop->start; is_deeply \@test, ['♥test♥', 'stop'], 'right messages'; is_deeply \@all, [['pstest', '♥test♥'], ['pstest', 'stop']], 'right notifications'; # JSON $pg = Mojo::Pg->new($ENV{TEST_ONLINE}); my (@json, @raw); $pg->pubsub->json('pstest')->listen( pstest => sub { my ($pubsub, $payload) = @_; push @json, $payload; Mojo::IOLoop->stop if ref $payload eq 'HASH' && $payload->{msg} eq 'stop'; } ); $pg->pubsub->listen( pstest2 => sub { my ($pubsub, $payload) = @_; push @raw, $payload; } ); Mojo::IOLoop->next_tick(sub { $pg->db->notify(pstest => 'fail'); $pg->pubsub->notify('pstest')->notify(pstest => {msg => '♥works♥'}) ->notify(pstest => [1, 2, 3])->notify(pstest => true) ->notify(pstest2 => '♥works♥')->notify(pstest => {msg => 'stop'}); }); Mojo::IOLoop->start; is_deeply \@json, [undef, undef, {msg => '♥works♥'}, [1, 2, 3], true, {msg => 'stop'}], 'right data structures'; is_deeply \@raw, ['♥works♥'], 'right messages'; # Unsubscribe $pg = Mojo::Pg->new($ENV{TEST_ONLINE}); $db = undef; $pg->pubsub->on(reconnect => sub { $db = pop }); @all = @test = (); my $first = $pg->pubsub->listen(pstest => sub { push @test, pop }); my $second = $pg->pubsub->listen(pstest => sub { push @test, pop }); $db->on(notification => sub { push @all, [@_[1, 3]] }); $pg->pubsub->notify('pstest')->notify(pstest => 'first'); is_deeply \@test, ['', '', 'first', 'first'], 'right messages'; is_deeply \@all, [['pstest', ''], ['pstest', 'first']], 'right notifications'; $pg->pubsub->unlisten(pstest => $first)->notify(pstest => 'second'); is_deeply \@test, ['', '', 'first', 'first', 'second'], 'right messages'; is_deeply \@all, [['pstest', ''], ['pstest', 'first'], ['pstest', 'second']], 'right notifications'; $pg->pubsub->unlisten(pstest => $second)->notify(pstest => 'third'); is_deeply \@test, ['', '', 'first', 'first', 'second'], 'right messages'; is_deeply \@all, [['pstest', ''], ['pstest', 'first'], ['pstest', 'second']], 'right notifications'; @all = @test = (); my $third = $pg->pubsub->listen(pstest => sub { push @test, pop }); my $fourth = $pg->pubsub->listen(pstest => sub { push @test, pop }); $pg->pubsub->notify(pstest => 'first'); is_deeply \@test, ['first', 'first'], 'right messages'; $pg->pubsub->notify(pstest => 'second'); is_deeply \@test, ['first', 'first', 'second', 'second'], 'right messages'; $pg->pubsub->unlisten('pstest')->notify(pstest => 'third'); is_deeply \@test, ['first', 'first', 'second', 'second'], 'right messages'; # Reconnect while listening $pg = Mojo::Pg->new($ENV{TEST_ONLINE}); my @dbhs = @test = (); $pg->pubsub->on(reconnect => sub { push @dbhs, pop->dbh }); $pg->pubsub->listen(pstest => sub { push @test, pop }); ok $dbhs[0], 'database handle'; is_deeply \@test, [], 'no messages'; { local $dbhs[0]{Warn} = 0; $pg->pubsub->on( reconnect => sub { shift->notify(pstest => 'works'); Mojo::IOLoop->stop }); $pg->db->query('select pg_terminate_backend(?)', $dbhs[0]{pg_pid}); Mojo::IOLoop->start; ok $dbhs[1], 'database handle'; isnt $dbhs[0], $dbhs[1], 'different database handles'; is_deeply \@test, ['works'], 'right messages'; }; # Reconnect while listening multiple retries $pg = Mojo::Pg->new($ENV{TEST_ONLINE}); @dbhs = @test = (); my (@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'; }; # Reconnect while not listening $pg = Mojo::Pg->new($ENV{TEST_ONLINE}); @dbhs = @test = (); $pg->pubsub->on(reconnect => sub { push @dbhs, pop->dbh }); $pg->pubsub->notify(pstest => 'fail'); ok $dbhs[0], 'database handle'; is_deeply \@test, [], 'no messages'; { local $dbhs[0]{Warn} = 0; $pg->pubsub->on(reconnect => sub { Mojo::IOLoop->stop }); $pg->db->query('select pg_terminate_backend(?)', $dbhs[0]{pg_pid}); Mojo::IOLoop->start; ok $dbhs[1], 'database handle'; isnt $dbhs[0], $dbhs[1], 'different database handles'; $pg->pubsub->listen(pstest => sub { push @test, pop }); $pg->pubsub->notify(pstest => 'works too'); is_deeply \@test, ['works too'], 'right messages'; }; # Reset $pg = Mojo::Pg->new($ENV{TEST_ONLINE}); @dbhs = @test = (); $pg->pubsub->on(reconnect => sub { push @dbhs, pop->dbh }); $pg->pubsub->listen(pstest => sub { push @test, pop }); ok $dbhs[0], 'database handle'; $pg->pubsub->notify(pstest => 'first'); is_deeply \@test, ['first'], 'right messages'; { $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'; }; done_testing(); Mojo-Pg-4.18/t/migrations.t000644 000765 000024 00000016123 13565540164 015476 0ustar00sristaff000000 000000 use Mojo::Base -strict; BEGIN { $ENV{MOJO_REACTOR} = 'Mojo::Reactor::Poll' } use Test::More; plan skip_all => 'set TEST_ONLINE to enable this test' unless $ENV{TEST_ONLINE}; use File::Spec::Functions 'catfile'; use FindBin; use Mojo::Pg; # Isolate tests my $pg = Mojo::Pg->new($ENV{TEST_ONLINE})->search_path(['mojo_migrations_test']); $pg->db->query('drop schema if exists mojo_migrations_test cascade'); $pg->db->query('create schema mojo_migrations_test'); # Defaults is $pg->migrations->name, 'migrations', 'right name'; is $pg->migrations->latest, 0, 'latest version is 0'; is $pg->migrations->active, 0, 'active version is 0'; # Create migrations table ok !(grep {/^mojo_migrations_test\.mojo_migrations$/} @{$pg->db->tables}), 'migrations table does not exist'; is $pg->migrations->migrate->active, 0, 'active version is 0'; ok !!(grep {/^mojo_migrations_test\.mojo_migrations$/} @{$pg->db->tables}), 'migrations table exists'; # Migrations from DATA section is $pg->migrations->from_data->latest, 0, 'latest version is 0'; is $pg->migrations->from_data(__PACKAGE__)->latest, 0, 'latest version is 0'; is $pg->migrations->name('test1')->from_data->latest, 10, 'latest version is 10'; is $pg->migrations->name('test2')->from_data->latest, 2, 'latest version is 2'; is $pg->migrations->name('migrations')->from_data(__PACKAGE__, 'test1')->latest, 10, 'latest version is 10'; is $pg->migrations->name('test2')->from_data(__PACKAGE__)->latest, 2, 'latest version is 2'; # Different syntax variations $pg->migrations->name('migrations_test')->from_string(<migrations->latest, 10, 'latest version is 10'; is $pg->migrations->active, 0, 'active version is 0'; is $pg->migrations->migrate->active, 10, 'active version is 10'; ok !!(grep {/^mojo_migrations_test\.migration_test_one$/} @{$pg->db->tables}), 'first table exists'; ok !!(grep {/^mojo_migrations_test\.migration_test_two$/} @{$pg->db->tables}), 'second table exists'; is_deeply $pg->db->query('select * from migration_test_one')->hash, {foo => 'works ♥'}, 'right structure'; is $pg->migrations->migrate->active, 10, 'active version is 10'; is $pg->migrations->migrate(1)->active, 1, 'active version is 1'; is $pg->db->query('select * from migration_test_one')->hash, undef, 'no result'; is $pg->migrations->migrate(3)->active, 3, 'active version is 3'; is $pg->db->query('select * from migration_test_two')->hash, undef, 'no result'; is $pg->migrations->migrate->active, 10, 'active version is 10'; is_deeply $pg->db->query('select * from migration_test_two')->hash, {bar => 'works too'}, 'right structure'; is $pg->migrations->migrate(0)->active, 0, 'active version is 0'; # Bad and concurrent migrations my $pg2 = Mojo::Pg->new($ENV{TEST_ONLINE})->search_path(['mojo_migrations_test']); $pg2->migrations->name('migrations_test2') ->from_file(catfile($FindBin::Bin, 'migrations', 'test.sql')); is $pg2->migrations->latest, 4, 'latest version is 4'; is $pg2->migrations->active, 0, 'active version is 0'; eval { $pg2->migrations->migrate }; like $@, qr/does_not_exist/, 'right error'; is $pg2->migrations->migrate(3)->active, 3, 'active version is 3'; is $pg2->migrations->migrate(2)->active, 2, 'active version is 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'; # Migrate automatically my $pg3 = Mojo::Pg->new($ENV{TEST_ONLINE})->search_path(['mojo_migrations_test']); $pg3->migrations->name('migrations_test')->from_string(<auto_migrate(1)->db; is $pg3->migrations->active, 6, 'active version is 6'; is_deeply $pg3->db->query('select * from migration_test_six')->hashes, [{foo => 'works!'}], 'right structure'; is $pg3->migrations->migrate(5)->active, 5, 'active version is 5'; is_deeply $pg3->db->query('select * from migration_test_six')->hashes, [], 'right structure'; is $pg3->migrations->migrate(0)->active, 0, 'active version is 0'; is $pg3->migrations->sql_for(0, 5), <migrations->sql_for(6, 0), <migrations->sql_for(6, 5), <migrations->sql_for(6, 6), '', 'right SQL'; is $pg3->migrations->sql_for(2, 3), '', 'right SQL'; # Migrate automatically with shared connection cache my $pg4 = 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'; # Unknown version eval { $pg->migrations->migrate(23) }; like $@, qr/Version 23 has no migration/, 'right error'; # Version mismatch my $newer = <migrations->name('migrations_test3')->from_string($newer); is $pg->migrations->migrate->active, 2, 'active version is 2'; $pg->migrations->from_string(<migrations->migrate }; like $@, qr/Active version 2 is greater than the latest version 1/, 'right error'; eval { $pg->migrations->migrate(0) }; like $@, qr/Active version 2 is greater than the latest version 1/, 'right error'; is $pg->migrations->from_string($newer)->migrate(0)->active, 0, 'active version is 0'; # Clean up once we are done $pg->db->query('drop schema mojo_migrations_test cascade'); done_testing(); __DATA__ @@ test1 -- 7 up create table migration_test_four (test int); -- 10 up insert into migration_test_four values (10); @@ test2 -- 2 up create table migration_test_five (test int); @@ test3 -- 2 up create table migration_test_six (test int); Mojo-Pg-4.18/t/database.t000644 000765 000024 00000025670 13565540164 015075 0ustar00sristaff000000 000000 use Mojo::Base -strict; BEGIN { $ENV{MOJO_REACTOR} = 'Mojo::Reactor::Poll' } use Test::More; plan skip_all => 'set TEST_ONLINE to enable this test' unless $ENV{TEST_ONLINE}; use Mojo::IOLoop; use Mojo::JSON 'true'; use Mojo::Pg; use Scalar::Util 'refaddr'; # Connected my $pg = Mojo::Pg->new($ENV{TEST_ONLINE}); ok $pg->db->ping, 'connected'; # Custom search_path $pg = Mojo::Pg->new($ENV{TEST_ONLINE})->search_path(['$user', 'foo', 'bar']); is_deeply $pg->db->query('show search_path')->hash, {search_path => '"$user", foo, bar'}, 'right structure'; $pg = Mojo::Pg->new($ENV{TEST_ONLINE}); # Blocking select is_deeply $pg->db->query('select 1 as one, 2 as two, 3 as three')->hash, {one => 1, two => 2, three => 3}, 'right structure'; # Non-blocking select my ($fail, $result); my $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'; # Concurrent non-blocking selects ($fail, $result) = (); Mojo::IOLoop->delay( sub { my $delay = shift; $pg->db->query('select 1 as one' => $delay->begin); $pg->db->query('select 2 as two' => $delay->begin); $pg->db->query('select 2 as two' => $delay->begin); }, sub { my ($delay, $err_one, $one, $err_two, $two, $err_again, $again) = @_; $fail = $err_one || $err_two || $err_again; $result = [$one->hashes->first, $two->hashes->first, $again->hashes->first]; } )->wait; ok !$fail, 'no error'; is_deeply $result, [{one => 1}, {two => 2}, {two => 2}], 'right structure'; # Sequential non-blocking selects ($fail, $result) = (undef, []); $db = $pg->db; Mojo::IOLoop->delay( sub { my $delay = shift; $db->query('select 1 as one' => $delay->begin); }, sub { my ($delay, $err, $one) = @_; $fail = $err; push @$result, $one->hashes->first; $db->query('select 1 as one' => $delay->begin); }, sub { my ($delay, $err, $again) = @_; $fail ||= $err; push @$result, $again->hashes->first; $db->query('select 2 as two' => $delay->begin); }, sub { my ($delay, $err, $two) = @_; $fail ||= $err; push @$result, $two->hashes->first; } )->wait; ok !$fail, 'no error'; is_deeply $result, [{one => 1}, {one => 1}, {two => 2}], 'right structure'; # Connection cache is $pg->max_connections, 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'; # Statement cache $db = $pg->db; my $sth = $db->query('select 3 as three')->sth; is $db->query('select 3 as three')->sth, $sth, 'same statement handle'; isnt $db->query('select 4 as four')->sth, $sth, 'different statement handles'; is $db->query('select 3 as three')->sth, $sth, 'same statement handle'; undef $db; $db = $pg->db; my $results = $db->query('select 3 as three'); is $results->sth, $sth, 'same statement handle'; isnt $db->query('select 3 as three')->sth, $sth, 'different statement handles'; $sth = $db->query('select 3 as three')->sth; is $db->query('select 3 as three')->sth, $sth, 'same statement handle'; isnt $db->query('select 5 as five')->sth, $sth, 'different statement handles'; isnt $db->query('select 6 as six')->sth, $sth, 'different statement handles'; is $db->query('select 3 as three')->sth, $sth, 'same statement handle'; # Connection reuse $db = $pg->db; $dbh = $db->dbh; $results = $db->query('select 1'); undef $db; my $db2 = $pg->db; isnt $db2->dbh, $dbh, 'new database handle'; undef $results; my $db3 = $pg->db; is $db3->dbh, $dbh, 'same database handle'; $results = $db3->query('select 2'); is $results->db->dbh, $dbh, 'same database handle'; is $results->array->[0], 2, 'right result'; # Dollar only $db = $pg->db; is $db->dollar_only->query('select $1::int as test', 23)->hash->{test}, 23, 'right result'; eval { $db->dollar_only->query('select ?::int as test', 23) }; like $@, qr/Statement has no placeholders to bind/, 'right error'; is $db->query('select ?::int as test', 23)->hash->{test}, 23, 'right result'; # JSON $db = $pg->db; is_deeply $db->query('select ?::json as foo', {json => {bar => 'baz'}}) ->expand->hash, {foo => {bar => 'baz'}}, 'right structure'; is_deeply $db->query('select ?::jsonb as foo', {json => {bar => 'baz'}}) ->expand->hash, {foo => {bar => 'baz'}}, 'right structure'; is_deeply $db->query('select ?::json as foo', {json => {bar => 'baz'}}) ->expand->array, [{bar => 'baz'}], 'right structure'; is_deeply $db->query('select ?::json as foo', {json => {bar => 'baz'}}) ->expand->hashes->first, {foo => {bar => 'baz'}}, 'right structure'; is_deeply $db->query('select ?::json as foo', {json => {bar => 'baz'}}) ->expand->arrays->first, [{bar => 'baz'}], 'right structure'; is_deeply $db->query('select ?::json as foo', {json => {bar => 'baz'}})->hash, {foo => '{"bar":"baz"}'}, 'right structure'; is_deeply $db->query('select ?::json as foo', {json => \1}) ->expand->hashes->first, {foo => true}, 'right structure'; is_deeply $db->query('select ?::json as foo', undef)->expand->hash, {foo => undef}, 'right structure'; is_deeply $db->query('select ?::json as foo', undef)->expand->array, [undef], 'right structure'; $results = $db->query('select ?::json', undef); is_deeply $results->expand->array, [undef], 'right structure'; is_deeply $results->expand->array, undef, 'no more results'; is_deeply $db->query('select ?::json as unicode', {json => {'☃' => '♥'}}) ->expand->hash, {unicode => {'☃' => '♥'}}, 'right structure'; is_deeply $db->query("select json_build_object('☃', ?::text) as unicode", '♥')->expand->hash, {unicode => {'☃' => '♥'}}, 'right structure'; # Fork-safety $dbh = $pg->db->dbh; my ($connections, $current) = @_; $pg->on( connection => sub { my ($pg, $dbh) = @_; $connections++; $current = $dbh; } ); is $pg->db->dbh, $dbh, 'same database handle'; ok !$connections, 'no new connections'; { local $$ = -23; isnt $pg->db->dbh, $dbh, 'different database handles'; is $pg->db->dbh, $current, 'same database handle'; is $connections, 1, 'one new connection'; }; $pg->unsubscribe('connection'); # Shared connection cache my $pg2 = Mojo::Pg->new($pg); is $pg2->parent, $pg, 'right parent'; $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'; $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'; # Notifications $db = $pg->db; ok !$db->is_listening, 'not listening'; ok $db->listen('dbtest')->is_listening, 'listening'; $db2 = $pg->db->listen('dbtest'); my @notifications; Mojo::IOLoop->delay( sub { my $delay = shift; $db->once(notification => $delay->begin); $db2->once(notification => $delay->begin); Mojo::IOLoop->next_tick(sub { $db2->notify(dbtest => 'foo') }); }, sub { my ($delay, $name, $pid, $payload, $name2, $pid2, $payload2) = @_; push @notifications, [$name, $pid, $payload], [$name2, $pid2, $payload2]; $db->once(notification => $delay->begin); $db2->unlisten('dbtest'); Mojo::IOLoop->next_tick(sub { $pg->db->notify('dbtest') }); }, sub { my ($delay, $name, $pid, $payload) = @_; push @notifications, [$name, $pid, $payload]; $db2->listen('dbtest2')->once(notification => $delay->begin); Mojo::IOLoop->next_tick(sub { $db2->query("notify dbtest2, 'bar'") }); }, sub { my ($delay, $name, $pid, $payload) = @_; push @notifications, [$name, $pid, $payload]; $db2->once(notification => $delay->begin); my $tx = $db2->begin; Mojo::IOLoop->next_tick(sub { $db2->notify(dbtest2 => 'baz'); $tx->commit; }); }, sub { my ($delay, $name, $pid, $payload) = @_; push @notifications, [$name, $pid, $payload]; } )->wait; ok !$db->unlisten('dbtest')->is_listening, 'not listening'; ok !$db2->unlisten('*')->is_listening, 'not listening'; is $notifications[0][0], 'dbtest', 'right channel name'; ok $notifications[0][1], 'has process id'; is $notifications[0][2], 'foo', 'right payload'; is $notifications[1][0], 'dbtest', 'right channel name'; ok $notifications[1][1], 'has process id'; is $notifications[1][2], 'foo', 'right payload'; is $notifications[2][0], 'dbtest', 'right channel name'; ok $notifications[2][1], 'has process id'; is $notifications[2][2], '', 'no payload'; is $notifications[3][0], 'dbtest2', 'right channel name'; ok $notifications[3][1], 'has process id'; is $notifications[3][2], 'bar', 'no payload'; is $notifications[4][0], 'dbtest2', 'right channel name'; ok $notifications[4][1], 'has process id'; is $notifications[4][2], 'baz', 'no payload'; is $notifications[5], undef, 'no more notifications'; # Stop listening for all notifications ok !$db->is_listening, 'not listening'; ok $db->listen('dbtest')->listen('dbtest2')->unlisten('dbtest2')->is_listening, 'listening'; ok !$db->unlisten('*')->is_listening, 'not listening'; # Connection close while listening for notifications { ok $db->listen('dbtest')->is_listening, 'listening'; my $close = 0; $db->on(close => sub { $close++ }); local $db->dbh->{Warn} = 0; $pg->db->query('select pg_terminate_backend(?)', $db->pid); Mojo::IOLoop->start; is $close, 1, 'close event has been emitted once'; }; # Blocking error eval { $pg->db->query('does_not_exist') }; like $@, qr/does_not_exist.*database\.t/s, 'right error'; # Non-blocking error ($fail, $result) = (); $pg->db->query( 'does_not_exist' => sub { my ($db, $err, $results) = @_; ($fail, $result) = ($err, $results); Mojo::IOLoop->stop; } ); Mojo::IOLoop->start; like $fail, qr/does_not_exist/, 'right error'; is $result->sth->errstr, $fail, 'same error'; # Non-blocking query in progress $db = $pg->db; $db->query('select 1' => sub { }); eval { $db->query('select 1' => sub { }); }; like $@, qr/Non-blocking query already in progress/, 'right error'; # CLean up non-blocking query $fail = undef; $db = $pg->db; $db->query( 'select 1' => sub { my ($db, $err, $results) = @_; $fail = $err; } ); $db->disconnect; undef $db; is $fail, 'Premature connection close', 'right error'; done_testing(); Mojo-Pg-4.18/t/results.t000644 000765 000024 00000013613 13565540164 015024 0ustar00sristaff000000 000000 use Mojo::Base -strict; BEGIN { $ENV{MOJO_REACTOR} = 'Mojo::Reactor::Poll' } use Test::More; plan skip_all => 'set TEST_ONLINE to enable this test' unless $ENV{TEST_ONLINE}; use DBD::Pg ':pg_types'; use Mojo::Pg; use Mojo::Util 'encode'; package MojoPgTest::Database; use Mojo::Base 'Mojo::Pg::Database'; sub results_class {'MojoPgTest::Results'} package MojoPgTest::Results; use Mojo::Base 'Mojo::Pg::Results'; sub array_test { shift->array } package main; # Isolate tests my $pg = Mojo::Pg->new($ENV{TEST_ONLINE})->search_path(['mojo_results_test']); $pg->db->query('drop schema if exists mojo_results_test cascade'); $pg->db->query('create schema mojo_results_test'); my $db = $pg->db; is_deeply $pg->search_path, ['mojo_results_test'], 'right search path'; $db->query( 'create table if not exists results_test ( id serial primary key, name text )' ); $db->query('insert into results_test (name) values (?)', $_) for qw(foo bar); # Tables ok !!(grep {/^mojo_results_test\.results.test$/} @{$db->tables}), 'results table exists'; ok !(grep {/^information_schema\.tables$/} @{$db->tables}), 'internal tables are hidden'; ok !(grep {/^pg_catalog\.pg_tables$/} @{$db->tables}), 'internal tables are hidden'; # Result methods is_deeply $db->query('select * from results_test')->rows, 2, 'two rows'; is_deeply $db->query('select * from results_test')->columns, ['id', 'name'], 'right structure'; is_deeply $db->query('select * from results_test')->array, [1, 'foo'], 'right structure'; is_deeply $db->query('select * from results_test')->arrays->to_array, [[1, 'foo'], [2, 'bar']], 'right structure'; is_deeply $db->query('select * from results_test')->hash, {id => 1, name => 'foo'}, 'right structure'; is_deeply $db->query('select * from results_test')->hashes->to_array, [{id => 1, name => 'foo'}, {id => 2, name => 'bar'}], 'right structure'; is $pg->db->query('select * from results_test')->text, "1 foo\n2 bar\n", 'right text'; # Custom database and results classes is ref $db, 'Mojo::Pg::Database', 'right class'; $pg->database_class('MojoPgTest::Database'); $db = $pg->db; is ref $db, 'MojoPgTest::Database', 'right class'; is ref $db->query('select 1'), 'MojoPgTest::Results', 'right class'; is_deeply $db->query('select * from results_test')->array_test, [1, 'foo'], 'right structure'; # JSON is_deeply $db->query('select ?::json as foo', {json => {bar => 'baz'}}) ->expand->hash, {foo => {bar => 'baz'}}, 'right structure'; is_deeply $db->query('select ?::json as foo', {-json => {bar => 'baz'}}) ->expand->hash, {foo => {bar => 'baz'}}, 'right structure'; is_deeply $db->query('select ?::json as foo', {json => {bar => 'baz'}}) ->expand->array, [{bar => 'baz'}], 'right structure'; my $hashes = [{foo => {one => 1}, bar => 'a'}, {foo => {two => 2}, bar => 'b'}]; is_deeply $db->query( "select 'a' as bar, ?::json as foo union all select 'b' as bar, ?::json as foo", {json => {one => 1}}, {json => {two => 2}} )->expand->hashes->to_array, $hashes, 'right structure'; my $arrays = [['a', {one => 1}], ['b', {two => 2}]]; is_deeply $db->query( "select 'a' as bar, ?::json as foo union all select 'b' as bar, ?::json as foo", {json => {one => 1}}, {json => {two => 2}} )->expand->arrays->to_array, $arrays, 'right structure'; # Iterate my $results = $db->query('select * from results_test'); is_deeply $results->array, [1, 'foo'], 'right structure'; is_deeply $results->array, [2, 'bar'], 'right structure'; is $results->array, undef, 'no more results'; # Non-blocking query where not all results have been fetched my ($fail, $result); Mojo::IOLoop->delay( sub { my $delay = shift; $db->query('select name from results_test' => $delay->begin); }, sub { my ($delay, $err, $results) = @_; $fail = $err; push @$result, $results->array; $results->finish; $db->query('select name from results_test' => $delay->begin); }, sub { my ($delay, $err, $results) = @_; $fail ||= $err; push @$result, $results->array_test; $results->finish; $db->query('select name from results_test' => $delay->begin); }, sub { my ($delay, $err, $results) = @_; $fail ||= $err; push @$result, $results->array; } )->wait; ok !$fail, 'no error'; is_deeply $result, [['foo'], ['foo'], ['foo']], 'right structure'; # Transactions { my $tx = $db->begin; $db->query("insert into results_test (name) values ('tx1')"); $db->query("insert into results_test (name) values ('tx1')"); $tx->commit; }; is_deeply $db->query('select * from results_test where name = ?', 'tx1') ->hashes->to_array, [{id => 3, name => 'tx1'}, {id => 4, name => 'tx1'}], 'right structure'; { my $tx = $db->begin; $db->query("insert into results_test (name) values ('tx2')"); $db->query("insert into results_test (name) values ('tx2')"); }; is_deeply $db->query('select * from results_test where name = ?', 'tx2') ->hashes->to_array, [], 'no results'; eval { my $tx = $db->begin; $db->query("insert into results_test (name) values ('tx3')"); $db->query("insert into results_test (name) values ('tx3')"); $db->query('does_not_exist'); $tx->commit; }; like $@, qr/does_not_exist/, 'right error'; is_deeply $db->query('select * from results_test where name = ?', 'tx3') ->hashes->to_array, [], 'no results'; # Long-lived results my $results1 = $db->query('select 1 as one'); is_deeply $results1->hashes, [{one => 1}], 'right structure'; my $results2 = $db->query('select 1 as one'); undef $results1; is_deeply $results2->hashes, [{one => 1}], 'right structure'; # Custom data types $db->query('create table if not exists results_test2 (stuff bytea)'); my $snowman = encode 'UTF-8', '☃'; $db->query( 'insert into results_test2 (stuff) values (?)', {value => $snowman, type => PG_BYTEA} ); is_deeply $db->query('select * from results_test2')->hash, {stuff => $snowman}, 'right structure'; # Clean up once we are done $pg->db->query('drop schema mojo_results_test cascade'); done_testing(); Mojo-Pg-4.18/t/pod_coverage.t000644 000765 000024 00000000677 13565540164 015766 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'; my $private = ['insert', 'new', 'puke', 'select']; my %RULES = ('SQL::Abstract::Pg' => {also_private => $private},); pod_coverage_ok($_, $RULES{$_} || {}) for all_modules(); done_testing(); Mojo-Pg-4.18/t/pg_lite_app.t000644 000765 000024 00000003643 13565540164 015610 0ustar00sristaff000000 000000 use Mojo::Base -strict; BEGIN { $ENV{MOJO_REACTOR} = 'Mojo::Reactor::Poll' } use Test::More; plan skip_all => 'set TEST_ONLINE to enable this test' unless $ENV{TEST_ONLINE}; use Mojo::Pg; use Mojolicious::Lite; use Scalar::Util 'refaddr'; use Test::Mojo; # Isolate tests my $pg = Mojo::Pg->new($ENV{TEST_ONLINE}); $pg->db->query('drop schema if exists mojo_app_test cascade'); $pg->db->query('create schema mojo_app_test'); helper pg => sub { state $pg = Mojo::Pg->new($ENV{TEST_ONLINE})->search_path(['mojo_app_test']); }; app->pg->db->query('create table if not exists app_test (stuff text)'); app->pg->db->query('insert into app_test values (?)', 'I ♥ Mojolicious!'); get '/blocking' => sub { my $c = shift; my $db = $c->pg->db; $c->res->headers->header('X-Ref' => refaddr $db->dbh); $c->render(text => $db->query('select * from app_test')->hash->{stuff}); }; get '/non-blocking' => sub { my $c = shift; $c->pg->db->query( 'select * from app_test' => sub { my ($db, $err, $results) = @_; $c->res->headers->header('X-Ref' => refaddr $db->dbh); $c->render(text => $results->hash->{stuff}); } ); }; my $t = Test::Mojo->new; # Make sure migrations are not served as static files $t->get_ok('/app_test')->status_is(404); # Blocking select (with connection reuse) $t->get_ok('/blocking')->status_is(200)->content_is('I ♥ Mojolicious!'); my $ref = $t->tx->res->headers->header('X-Ref'); $t->get_ok('/blocking')->status_is(200)->header_is('X-Ref', $ref) ->content_is('I ♥ Mojolicious!'); # Non-blocking select (with connection reuse) $t->get_ok('/non-blocking')->status_is(200)->header_is('X-Ref', $ref) ->content_is('I ♥ Mojolicious!'); $t->get_ok('/non-blocking')->status_is(200)->header_is('X-Ref', $ref) ->content_is('I ♥ Mojolicious!'); $t->app->pg->db->query('drop table app_test'); # Clean up once we are done $pg->db->query('drop schema mojo_app_test cascade'); done_testing(); Mojo-Pg-4.18/t/crud.t000644 000765 000024 00000013345 13565540164 014262 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; # 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 )' ); # Create $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'}]} ); # Read 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'; # Non-blocking read my $result; my $delay = Mojo::IOLoop->delay(sub { $result = pop->hashes->to_array }); $db->select('crud_test', $delay->begin); $delay->wait; is_deeply $result, [{id => 1, name => 'foo'}, {id => 2, name => 'baz'}], 'right structure'; $result = undef; $delay = Mojo::IOLoop->delay(sub { $result = pop->hashes->to_array }); $db->select('crud_test', undef, undef, {-desc => 'id'}, $delay->begin); $delay->wait; is_deeply $result, [{id => 2, name => 'baz'}, {id => 1, name => 'foo'}], 'right structure'; # Update $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'; # Delete $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'; # Quoting $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'; # Arrays $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'; # Promises $result = undef; $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'; # Promises (rejected) my $fail; $db->dollar_only->query_p('does_not_exist')->catch(sub { $fail = shift })->wait; like $fail, qr/does_not_exist/, 'right error'; # Join $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.18/t/migrations/test.sql000644 000765 000024 00000000422 13565540164 017004 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;