├── t
├── migrations
│ ├── tree
│ │ ├── 1
│ │ │ ├── down.sql
│ │ │ └── up.sql
│ │ ├── 2
│ │ │ ├── down.sql
│ │ │ └── up.sql
│ │ ├── 36
│ │ │ └── up.sql
│ │ ├── 55
│ │ │ └── upgrade.sql
│ │ └── 99
│ │ │ └── up.sql
│ ├── tree2
│ │ ├── 8
│ │ │ └── up.sql
│ │ └── subtree
│ │ │ └── 9
│ │ │ └── up.sql
│ └── test.sql
├── pod.t
├── pod_coverage.t
├── pg_lite_app.t
├── connection.t
├── results.t
├── crud.t
├── pubsub.t
├── migrations.t
└── database.t
├── .gitattributes
├── examples
├── blog
│ ├── blog.conf
│ ├── templates
│ │ ├── posts
│ │ │ ├── create.html.ep
│ │ │ ├── show.html.ep
│ │ │ ├── edit.html.ep
│ │ │ ├── index.html.ep
│ │ │ └── _form.html.ep
│ │ └── layouts
│ │ │ └── blog.html.ep
│ ├── migrations
│ │ └── blog.sql
│ ├── script
│ │ └── blog
│ ├── lib
│ │ ├── Blog
│ │ │ ├── Model
│ │ │ │ └── Posts.pm
│ │ │ └── Controller
│ │ │ │ └── Posts.pm
│ │ └── Blog.pm
│ └── t
│ │ └── blog.t
└── chat.pl
├── MANIFEST.SKIP
├── .github
├── CONTRIBUTING.md
├── PULL_REQUEST_TEMPLATE.md
├── ISSUE_TEMPLATE.md
└── workflows
│ ├── rebuild-website.yml
│ ├── perltidy.yml
│ └── linux.yml
├── .gitignore
├── .perltidyrc
├── .mergify
└── config.yml
├── Makefile.PL
├── README.md
├── lib
└── Mojo
│ ├── Pg
│ ├── Transaction.pm
│ ├── Results.pm
│ ├── PubSub.pm
│ ├── Migrations.pm
│ └── Database.pm
│ └── Pg.pm
├── LICENSE
└── Changes
/t/migrations/tree/2/down.sql:
--------------------------------------------------------------------------------
1 |
--------------------------------------------------------------------------------
/t/migrations/tree/36/up.sql:
--------------------------------------------------------------------------------
1 |
--------------------------------------------------------------------------------
/t/migrations/tree/1/down.sql:
--------------------------------------------------------------------------------
1 | DROP TABLE IF EXISTS migration_test_three;
2 |
--------------------------------------------------------------------------------
/t/migrations/tree/1/up.sql:
--------------------------------------------------------------------------------
1 | CREATE TABLE IF NOT EXISTS migration_test_three (baz VARCHAR(255));
2 |
--------------------------------------------------------------------------------
/t/migrations/tree2/8/up.sql:
--------------------------------------------------------------------------------
1 | CREATE TABLE IF NOT EXISTS mojo_migrations_test8 (foo VARCHAR(255));
2 |
--------------------------------------------------------------------------------
/t/migrations/tree/99/up.sql:
--------------------------------------------------------------------------------
1 | CREATE TABLE IF NOT EXISTS migration_test_luft_balloons (baz VARCHAR(255));
2 |
--------------------------------------------------------------------------------
/t/migrations/tree2/subtree/9/up.sql:
--------------------------------------------------------------------------------
1 | CREATE TABLE IF NOT EXISTS mojo_migrations_test9 (foo VARCHAR(255));
2 |
--------------------------------------------------------------------------------
/.gitattributes:
--------------------------------------------------------------------------------
1 | *.pl linguist-language=Perl
2 | *.pm linguist-language=Perl
3 | *.t linguist-language=Perl
4 |
--------------------------------------------------------------------------------
/t/migrations/tree/55/upgrade.sql:
--------------------------------------------------------------------------------
1 | CREATE TABLE IF NOT EXISTS mojo_migrations_upgrading (baz VARCHAR(255));
2 |
--------------------------------------------------------------------------------
/examples/blog/blog.conf:
--------------------------------------------------------------------------------
1 | {
2 | pg => 'postgresql://postgres@127.0.0.1:5432/postgres',
3 | secrets => ['s3cret']
4 | }
5 |
--------------------------------------------------------------------------------
/MANIFEST.SKIP:
--------------------------------------------------------------------------------
1 | ^\.(?!perltidyrc)
2 | .*\.old$
3 | \.tar\.gz$
4 | ^Makefile$
5 | ^MYMETA\.
6 | ^blib
7 | ^pm_to_blib
8 | \B\.DS_Store
9 |
--------------------------------------------------------------------------------
/t/migrations/tree/2/up.sql:
--------------------------------------------------------------------------------
1 | INSERT INTO migration_test_three VALUES ('just');
2 | INSERT INTO migration_test_three VALUES ('works ♥');
3 |
--------------------------------------------------------------------------------
/examples/blog/templates/posts/create.html.ep:
--------------------------------------------------------------------------------
1 | % layout 'blog', title => 'New post';
2 | New post
3 | %= include 'posts/_form', caption => 'Create', target => 'store_post'
4 |
--------------------------------------------------------------------------------
/.github/CONTRIBUTING.md:
--------------------------------------------------------------------------------
1 | Please read the guide for [contributing to Mojolicious](http://mojolicious.org/perldoc/Mojolicious/Guides/Contributing), Mojo::Pg is a spin-off project and follows the same rules.
2 |
--------------------------------------------------------------------------------
/examples/blog/templates/posts/show.html.ep:
--------------------------------------------------------------------------------
1 | % layout 'blog', title => $post->{title};
2 | <%= $post->{title} %>
3 | <%= $post->{body} %>
4 | %= link_to 'Edit' => edit_post => {id => $post->{id}}
5 |
--------------------------------------------------------------------------------
/examples/blog/migrations/blog.sql:
--------------------------------------------------------------------------------
1 | -- 1 up
2 | create table if not exists posts (
3 | id serial primary key,
4 | title text,
5 | body text
6 | );
7 |
8 | -- 1 down
9 | drop table if exists posts;
10 |
--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
1 | .*
2 | *~
3 | !.gitignore
4 | !.appveyor.cmd
5 | !.appveyor.yml
6 | !.perltidyrc
7 | !.travis.yml
8 | /blib
9 | /pm_to_blib
10 | /Makefile
11 | /Makefile.old
12 | /MANIFEST*
13 | !MANIFEST.SKIP
14 | /META.*
15 | /MYMETA.*
16 |
--------------------------------------------------------------------------------
/examples/blog/templates/posts/edit.html.ep:
--------------------------------------------------------------------------------
1 | % layout 'blog', title => 'Edit post';
2 | Edit post
3 | %= include 'posts/_form', caption => 'Update', target => 'update_post'
4 | %= button_to Remove => remove_post => {id => $post->{id}}
5 |
--------------------------------------------------------------------------------
/.github/PULL_REQUEST_TEMPLATE.md:
--------------------------------------------------------------------------------
1 | ### Summary
2 | DESCRIBE THE BIG PICTURE OF YOUR CHANGES HERE
3 |
4 | ### Motivation
5 | EXPLAIN WHY YOU BELIEVE THESE CHANGES ARE NECESSARY HERE
6 |
7 | ### References
8 | LIST RELEVANT ISSUES, PULL REQUESTS AND FORUM DISCUSSIONS HERE
9 |
--------------------------------------------------------------------------------
/examples/blog/templates/posts/index.html.ep:
--------------------------------------------------------------------------------
1 | % layout 'blog', title => 'Blog';
2 | % for my $post (@$posts) {
3 | <%= link_to $post->{title} => show_post => {id => $post->{id}} %>
4 |
5 | %= $post->{body}
6 |
7 | % }
8 | %= link_to 'New post' => 'create_post'
9 |
--------------------------------------------------------------------------------
/t/pod.t:
--------------------------------------------------------------------------------
1 | use Mojo::Base -strict;
2 |
3 | use Test::More;
4 |
5 | plan skip_all => 'set TEST_POD to enable this test (developer only!)' unless $ENV{TEST_POD};
6 | plan skip_all => 'Test::Pod 1.14+ required for this test!' unless eval 'use Test::Pod 1.14; 1';
7 |
8 | all_pod_files_ok();
9 |
--------------------------------------------------------------------------------
/examples/blog/script/blog:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | use strict;
4 | use warnings;
5 |
6 | use FindBin;
7 | BEGIN { unshift @INC, "$FindBin::Bin/../lib" }
8 |
9 | # Start command line interface for application
10 | require Mojolicious::Commands;
11 | Mojolicious::Commands->start_app('Blog');
12 |
--------------------------------------------------------------------------------
/t/pod_coverage.t:
--------------------------------------------------------------------------------
1 | use Mojo::Base -strict;
2 |
3 | use Test::More;
4 |
5 | plan skip_all => 'set TEST_POD to enable this test (developer only!)' unless $ENV{TEST_POD};
6 | plan skip_all => 'Test::Pod::Coverage 1.04+ required for this test!' unless eval 'use Test::Pod::Coverage 1.04; 1';
7 |
8 | all_pod_coverage_ok();
9 |
--------------------------------------------------------------------------------
/examples/blog/templates/posts/_form.html.ep:
--------------------------------------------------------------------------------
1 | %= form_for $target => begin
2 | %= label_for title => 'Title'
3 |
4 | %= text_field title => $post->{title}
5 |
6 | %= label_for body => 'Body'
7 |
8 | %= text_area body => $post->{body}
9 |
10 | %= submit_button $caption
11 | % end
12 |
--------------------------------------------------------------------------------
/t/migrations/test.sql:
--------------------------------------------------------------------------------
1 | -- 1 up
2 | CREATE TABLE IF NOT EXISTS migration_test_three (baz VARCHAR(255));
3 | -- 1 down
4 | DROP TABLE IF EXISTS migration_test_three;
5 | -- 2 up
6 | INSERT INTO migration_test_three VALUES ('just');
7 | INSERT INTO migration_test_three VALUES ('works ♥');
8 | -- 3 up
9 | -- 4 up
10 | does_not_exist;
11 |
--------------------------------------------------------------------------------
/.github/ISSUE_TEMPLATE.md:
--------------------------------------------------------------------------------
1 | * Mojo::Pg version: VERSION HERE
2 | * Perl version: VERSION HERE
3 | * Operating system: NAME AND VERSION HERE
4 |
5 | ### Steps to reproduce the behavior
6 | EXPLAIN WHAT HAPPENED HERE, PREFERABLY WITH CODE EXAMPLES
7 |
8 | ### Expected behavior
9 | EXPLAIN WHAT SHOULD HAPPEN HERE
10 |
11 | ### Actual behavior
12 | EXPLAIN WHAT HAPPENED INSTEAD HERE
13 |
--------------------------------------------------------------------------------
/examples/blog/templates/layouts/blog.html.ep:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 | <%= title %>
5 |
14 |
15 |
16 | <%= link_to 'Blog' => 'posts' %>
17 | %= content
18 |
19 |
20 |
--------------------------------------------------------------------------------
/.perltidyrc:
--------------------------------------------------------------------------------
1 | -pbp # Start with Perl Best Practices
2 | -w # Show all warnings
3 | -iob # Ignore old breakpoints
4 | -l=120 # 120 characters per line
5 | -mbl=2 # No more than 2 blank lines
6 | -i=2 # Indentation is 2 columns
7 | -ci=2 # Continuation indentation is 2 columns
8 | -vt=0 # Less vertical tightness
9 | -pt=2 # High parenthesis tightness
10 | -bt=2 # High brace tightness
11 | -sbt=2 # High square bracket tightness
12 | -wn # Weld nested containers
13 | -isbc # Don't indent comments without leading space
14 | -nst # Don't output to STDOUT
15 |
--------------------------------------------------------------------------------
/.mergify/config.yml:
--------------------------------------------------------------------------------
1 | pull_request_rules:
2 | - name: automatic merge
3 | conditions:
4 | - "#approved-reviews-by>=2"
5 | - "#changes-requested-reviews-by=0"
6 | - base=main
7 | actions:
8 | merge:
9 | method: merge
10 | - name: remove outdated reviews
11 | conditions:
12 | - base=main
13 | actions:
14 | dismiss_reviews: {}
15 | - name: ask to resolve conflict
16 | conditions:
17 | - conflict
18 | actions:
19 | comment:
20 | message: This pull request is now in conflicts. Could you fix it @{{author}}? 🙏
21 |
--------------------------------------------------------------------------------
/.github/workflows/rebuild-website.yml:
--------------------------------------------------------------------------------
1 | name: Rebuild Website
2 | on:
3 | push:
4 | branches:
5 | - main
6 | jobs:
7 | rebuild_website:
8 | runs-on: ubuntu-latest
9 | steps:
10 | - name: Trigger website workflow
11 | run: |
12 | curl \
13 | -X POST \
14 | -u "${{ secrets.WORKFLOW_DISPATCH_USERINFO }}" \
15 | -H "Accept: application/vnd.github.everest-preview+json" \
16 | -H "Content-Type: application/json" \
17 | --data '{"ref": "main"}' \
18 | https://api.github.com/repos/mojolicious/mojolicious.org/actions/workflows/publish-website.yml/dispatches
19 |
--------------------------------------------------------------------------------
/examples/blog/lib/Blog/Model/Posts.pm:
--------------------------------------------------------------------------------
1 | package Blog::Model::Posts;
2 | use Mojo::Base -base, -signatures;
3 |
4 | has 'pg';
5 |
6 | sub add ($self, $post) {
7 | return $self->pg->db->insert('posts', $post, {returning => 'id'})->hash->{id};
8 | }
9 |
10 | sub all ($self) {
11 | return $self->pg->db->select('posts')->hashes->to_array;
12 | }
13 |
14 | sub find ($self, $id) {
15 | return $self->pg->db->select('posts', '*', {id => $id})->hash;
16 | }
17 |
18 | sub remove ($self, $id) {
19 | $self->pg->db->delete('posts', {id => $id});
20 | }
21 |
22 | sub save ($self, $id, $post) {
23 | $self->pg->db->update('posts', $post, {id => $id});
24 | }
25 |
26 | 1;
27 |
--------------------------------------------------------------------------------
/.github/workflows/perltidy.yml:
--------------------------------------------------------------------------------
1 | name: perltidy
2 | on:
3 | push:
4 | branches:
5 | - '*'
6 | tags-ignore:
7 | - '*'
8 | pull_request:
9 | jobs:
10 | perltidy:
11 | runs-on: ubuntu-latest
12 | container:
13 | image: perl:5.32
14 | steps:
15 | - uses: actions/checkout@v2
16 | - name: Fix git permissions
17 | # work around https://github.com/actions/checkout/issues/766
18 | run: git config --global --add safe.directory "$GITHUB_WORKSPACE"
19 | - name: perl -V
20 | run: perl -V
21 | - name: Install dependencies
22 | run: cpanm -n Perl::Tidy
23 | - name: perltidy --version
24 | run: perltidy --version
25 | - name: Run perltidy
26 | shell: bash
27 | run: |
28 | shopt -s extglob globstar nullglob
29 | perltidy --pro=.../.perltidyrc -b -bext='/' **/*.p[lm] **/*.t && git diff --exit-code
30 |
--------------------------------------------------------------------------------
/examples/chat.pl:
--------------------------------------------------------------------------------
1 | use Mojolicious::Lite -signatures;
2 | use Mojo::Pg;
3 |
4 | helper pg => sub { state $pg = Mojo::Pg->new('postgresql://postgres@/test') };
5 |
6 | get '/' => 'chat';
7 |
8 | websocket '/channel' => sub ($c) {
9 | $c->inactivity_timeout(3600);
10 |
11 | # Forward messages from the browser to PostgreSQL
12 | $c->on(message => sub ($c, $message) { $c->pg->pubsub->notify(mojochat => $message) });
13 |
14 | # Forward messages from PostgreSQL to the browser
15 | my $cb = $c->pg->pubsub->listen(mojochat => sub ($pubsub, $message) { $c->send($message) });
16 | $c->on(finish => sub ($c) { $c->pg->pubsub->unlisten(mojochat => $cb) });
17 | };
18 |
19 | app->start;
20 | __DATA__
21 |
22 | @@ chat.html.ep
23 |
24 |
25 |
32 |
--------------------------------------------------------------------------------
/.github/workflows/linux.yml:
--------------------------------------------------------------------------------
1 | name: linux
2 | on:
3 | push:
4 | branches:
5 | - '*'
6 | tags-ignore:
7 | - '*'
8 | pull_request:
9 | jobs:
10 | perl:
11 | runs-on: ubuntu-latest
12 | strategy:
13 | matrix:
14 | codename:
15 | - buster
16 | perl-version:
17 | - '5.16'
18 | - '5.18'
19 | - '5.20'
20 | - '5.22'
21 | - '5.30'
22 | container:
23 | image: perl:${{ matrix.perl-version }}-${{ matrix.codename }}
24 | services:
25 | postgres:
26 | image: postgres
27 | env:
28 | POSTGRES_PASSWORD: postgres
29 | POSTGRES_INITDB_ARGS: --auth-host=md5
30 | steps:
31 | - uses: actions/checkout@v2
32 | - name: perl -V
33 | run: perl -V
34 | - name: Fix ExtUtils::MakeMaker (for Perl 5.16 and 5.18)
35 | run: cpanm -n App::cpanminus ExtUtils::MakeMaker
36 | - name: Install dependencies
37 | run: |
38 | cpanm -n --installdeps .
39 | cpanm -n Test::Deep
40 | - name: Run tests
41 | env:
42 | TEST_ONLINE: postgresql://postgres:postgres@postgres:5432/postgres
43 | run: prove -l t
44 |
--------------------------------------------------------------------------------
/examples/blog/lib/Blog.pm:
--------------------------------------------------------------------------------
1 | package Blog;
2 | use Mojo::Base 'Mojolicious', -signatures;
3 |
4 | use Blog::Model::Posts;
5 | use Mojo::Pg;
6 |
7 | sub startup ($self) {
8 |
9 | # Configuration
10 | $self->plugin('Config');
11 | $self->secrets($self->config('secrets'));
12 |
13 | # Model
14 | $self->helper(pg => sub { state $pg = Mojo::Pg->new(shift->config('pg')) });
15 | $self->helper(posts => sub { state $posts = Blog::Model::Posts->new(pg => shift->pg) });
16 |
17 | # Migrate to latest version if necessary
18 | my $path = $self->home->child('migrations', 'blog.sql');
19 | $self->pg->auto_migrate(1)->migrations->name('blog')->from_file($path);
20 |
21 | # Controller
22 | my $r = $self->routes;
23 | $r->get('/' => sub { shift->redirect_to('posts') });
24 | $r->get('/posts')->to('posts#index');
25 | $r->get('/posts/create')->to('posts#create')->name('create_post');
26 | $r->post('/posts')->to('posts#store')->name('store_post');
27 | $r->get('/posts/:id')->to('posts#show')->name('show_post');
28 | $r->get('/posts/:id/edit')->to('posts#edit')->name('edit_post');
29 | $r->put('/posts/:id')->to('posts#update')->name('update_post');
30 | $r->delete('/posts/:id')->to('posts#remove')->name('remove_post');
31 | }
32 |
33 | 1;
34 |
--------------------------------------------------------------------------------
/Makefile.PL:
--------------------------------------------------------------------------------
1 | use 5.016;
2 |
3 | use strict;
4 | use warnings;
5 | use utf8;
6 |
7 | use ExtUtils::MakeMaker;
8 |
9 | WriteMakefile(
10 | NAME => 'Mojo::Pg',
11 | VERSION_FROM => 'lib/Mojo/Pg.pm',
12 | ABSTRACT => 'Mojolicious ♥ PostgreSQL',
13 | AUTHOR => 'Sebastian Riedel ',
14 | LICENSE => 'artistic_2',
15 | META_MERGE => {
16 | dynamic_config => 0,
17 | 'meta-spec' => {version => 2},
18 | no_index => {directory => ['examples', 't']},
19 | prereqs => {runtime => {requires => {perl => '5.016'}}},
20 | resources => {
21 | bugtracker => {web => 'https://github.com/mojolicious/mojo-pg/issues'},
22 | homepage => 'https://mojolicious.org',
23 | license => ['http://www.opensource.org/licenses/artistic-license-2.0'],
24 | repository => {
25 | type => 'git',
26 | url => 'https://github.com/mojolicious/mojo-pg.git',
27 | web => 'https://github.com/mojolicious/mojo-pg',
28 | },
29 | x_IRC => {url => 'irc://irc.libera.chat/#mojo', web => 'https://web.libera.chat/#mojo'}
30 | },
31 | },
32 | PREREQ_PM => {'DBD::Pg' => 3.007004, Mojolicious => '8.50', 'SQL::Abstract::Pg' => '1.0'},
33 | test => {TESTS => 't/*.t t/*/*.t'}
34 | );
35 |
--------------------------------------------------------------------------------
/examples/blog/lib/Blog/Controller/Posts.pm:
--------------------------------------------------------------------------------
1 | package Blog::Controller::Posts;
2 | use Mojo::Base 'Mojolicious::Controller', -signatures;
3 |
4 | sub create ($self) {
5 | $self->render(post => {});
6 | }
7 |
8 | sub edit ($self) {
9 | $self->render(post => $self->posts->find($self->param('id')));
10 | }
11 |
12 | sub index ($self) {
13 | $self->render(posts => $self->posts->all);
14 | }
15 |
16 | sub remove ($self) {
17 | $self->posts->remove($self->param('id'));
18 | $self->redirect_to('posts');
19 | }
20 |
21 | sub show ($self) {
22 | $self->render(post => $self->posts->find($self->param('id')));
23 | }
24 |
25 | sub store ($self) {
26 | my $v = $self->_validation;
27 | return $self->render(action => 'create', post => {}) if $v->has_error;
28 |
29 | my $id = $self->posts->add({title => $v->param('title'), body => $v->param('body')});
30 | $self->redirect_to('show_post', id => $id);
31 | }
32 |
33 | sub update ($self) {
34 | my $v = $self->_validation;
35 | return $self->render(action => 'edit', post => {}) if $v->has_error;
36 |
37 | my $id = $self->param('id');
38 | $self->posts->save($id, {title => $v->param('title'), body => $v->param('body')});
39 | $self->redirect_to('show_post', id => $id);
40 | }
41 |
42 | sub _validation ($self) {
43 | my $v = $self->validation;
44 | $v->required('title', 'not_empty');
45 | $v->required('body', 'not_empty');
46 | return $v;
47 | }
48 |
49 | 1;
50 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 |
2 | # Mojo::Pg [](https://github.com/mojolicious/mojo-pg/actions)
3 |
4 | A tiny wrapper around [DBD::Pg](https://metacpan.org/pod/DBD::Pg) that makes [PostgreSQL](https://www.postgresql.org)
5 | a lot of fun to use with the [Mojolicious](https://mojolicious.org) real-time web framework.
6 |
7 | ```perl
8 | use Mojolicious::Lite -signatures;
9 | use Mojo::Pg;
10 |
11 | helper pg => sub { state $pg = Mojo::Pg->new('postgresql://postgres@/test') };
12 |
13 | # Use migrations to create a table during startup
14 | app->pg->migrations->from_data->migrate;
15 |
16 | get '/' => sub ($c) {
17 |
18 | my $db = $c->pg->db;
19 | my $ip = $c->tx->remote_address;
20 |
21 | # Store information about current visitor blocking
22 | $db->query('INSERT INTO visitors VALUES (NOW(), ?)', $ip);
23 |
24 | # Retrieve information about previous visitors non-blocking
25 | $db->query('SELECT * FROM visitors LIMIT 50' => sub ($db, $err, $results) {
26 |
27 | return $c->reply->exception($err) if $err;
28 |
29 | $c->render(json => $results->hashes->to_array);
30 | });
31 | };
32 |
33 | app->start;
34 | __DATA__
35 |
36 | @@ migrations
37 | -- 1 up
38 | CREATE TABLE visitors (at TIMESTAMP WITH TIME ZONE, ip TEXT);
39 | -- 1 down
40 | DROP TABLE visitors;
41 | ```
42 |
43 | ## Installation
44 |
45 | All you need is a one-liner, it takes less than a minute.
46 |
47 | $ curl -L https://cpanmin.us | perl - -M https://cpan.metacpan.org -n Mojo::Pg
48 |
49 | We recommend the use of a [Perlbrew](http://perlbrew.pl) environment.
50 |
51 | ## Want to know more?
52 |
53 | Take a look at our excellent
54 | [documentation](https://mojolicious.org/perldoc/Mojo/Pg)!
55 |
--------------------------------------------------------------------------------
/lib/Mojo/Pg/Transaction.pm:
--------------------------------------------------------------------------------
1 | package Mojo::Pg::Transaction;
2 | use Mojo::Base -base;
3 |
4 | has db => undef, weak => 1;
5 |
6 | sub DESTROY {
7 | my $self = shift;
8 | if ($self->{rollback} && (my $dbh = $self->{dbh})) { $dbh->rollback }
9 | }
10 |
11 | sub commit {
12 | my $self = shift;
13 | $self->{dbh}->commit if delete $self->{rollback};
14 | if (my $db = $self->db) { $db->_notifications }
15 | }
16 |
17 | sub new {
18 | my $self = shift->SUPER::new(@_, rollback => 1);
19 | my $dbh = $self->{dbh} = $self->db->dbh;
20 | $dbh->begin_work;
21 | return $self;
22 | }
23 |
24 | 1;
25 |
26 | =encoding utf8
27 |
28 | =head1 NAME
29 |
30 | Mojo::Pg::Transaction - Transaction
31 |
32 | =head1 SYNOPSIS
33 |
34 | use Mojo::Pg::Transaction;
35 |
36 | my $tx = Mojo::Pg::Transaction->new(db => $db);
37 | $tx->commit;
38 |
39 | =head1 DESCRIPTION
40 |
41 | L is a scope guard for L transactions used by L.
42 |
43 | =head1 ATTRIBUTES
44 |
45 | L implements the following attributes.
46 |
47 | =head2 db
48 |
49 | my $db = $tx->db;
50 | $tx = $tx->db(Mojo::Pg::Database->new);
51 |
52 | L object this transaction belongs to. Note that this attribute is weakened.
53 |
54 | =head1 METHODS
55 |
56 | L inherits all methods from L and implements the following new ones.
57 |
58 | =head2 commit
59 |
60 | $tx->commit;
61 |
62 | Commit transaction.
63 |
64 | =head2 new
65 |
66 | my $tx = Mojo::Pg::Transaction->new;
67 | my $tx = Mojo::Pg::Transaction->new(db => Mojo::Pg::Database->new);
68 | my $tx = Mojo::Pg::Transaction->new({db => Mojo::Pg::Database->new});
69 |
70 | Construct a new L object.
71 |
72 | =head1 SEE ALSO
73 |
74 | L, L, L.
75 |
76 | =cut
77 |
--------------------------------------------------------------------------------
/t/pg_lite_app.t:
--------------------------------------------------------------------------------
1 | use Mojo::Base -strict;
2 |
3 | BEGIN { $ENV{MOJO_REACTOR} = 'Mojo::Reactor::Poll' }
4 |
5 | use Test::More;
6 |
7 | plan skip_all => 'set TEST_ONLINE to enable this test' unless $ENV{TEST_ONLINE};
8 |
9 | use Mojo::Pg;
10 | use Mojolicious::Lite;
11 | use Scalar::Util qw(refaddr);
12 | use Test::Mojo;
13 |
14 | # Isolate tests
15 | my $pg = Mojo::Pg->new($ENV{TEST_ONLINE});
16 | $pg->db->query('DROP SCHEMA IF EXISTS mojo_app_test CASCADE');
17 | $pg->db->query('CREATE SCHEMA mojo_app_test');
18 |
19 | helper pg => sub {
20 | state $pg = Mojo::Pg->new($ENV{TEST_ONLINE})->search_path(['mojo_app_test']);
21 | };
22 |
23 | app->pg->db->query('CREATE TABLE IF NOT EXISTS app_test (stuff TEXT)');
24 | app->pg->db->query('INSERT INTO app_test VALUES (?)', 'I ♥ Mojolicious!');
25 |
26 | get '/blocking' => sub {
27 | my $c = shift;
28 | my $db = $c->pg->db;
29 | $c->res->headers->header('X-Ref' => refaddr $db->dbh);
30 | $c->render(text => $db->query('SELECT * FROM app_test')->hash->{stuff});
31 | };
32 |
33 | get '/non-blocking' => sub {
34 | my $c = shift;
35 | $c->pg->db->query(
36 | 'SELECT * FROM app_test' => sub {
37 | my ($db, $err, $results) = @_;
38 | $c->res->headers->header('X-Ref' => refaddr $db->dbh);
39 | $c->render(text => $results->hash->{stuff});
40 | }
41 | );
42 | };
43 |
44 | my $t = Test::Mojo->new;
45 |
46 | subtest 'Make sure migrations are not served as static files' => sub {
47 | $t->get_ok('/app_test')->status_is(404);
48 | };
49 |
50 | subtest 'Blocking select (with connection reuse)' => sub {
51 | $t->get_ok('/blocking')->status_is(200)->content_is('I ♥ Mojolicious!');
52 | my $ref = $t->tx->res->headers->header('X-Ref');
53 | $t->get_ok('/blocking')->status_is(200)->header_is('X-Ref', $ref)->content_is('I ♥ Mojolicious!');
54 | $t->get_ok('/blocking')->status_is(200)->header_is('X-Ref', $ref)->content_is('I ♥ Mojolicious!');
55 | };
56 |
57 | subtest 'Non-blocking select (with connection reuse)' => sub {
58 | $t->get_ok('/non-blocking')->status_is(200)->content_is('I ♥ Mojolicious!');
59 | my $ref = $t->tx->res->headers->header('X-Ref');
60 | $t->get_ok('/non-blocking')->status_is(200)->header_is('X-Ref', $ref)->content_is('I ♥ Mojolicious!');
61 | $t->get_ok('/non-blocking')->status_is(200)->header_is('X-Ref', $ref)->content_is('I ♥ Mojolicious!');
62 | };
63 |
64 | # Clean up once we are done
65 | $pg->db->query('DROP SCHEMA mojo_app_test CASCADE');
66 |
67 | done_testing();
68 |
--------------------------------------------------------------------------------
/examples/blog/t/blog.t:
--------------------------------------------------------------------------------
1 | use Mojo::Base -strict;
2 |
3 | use Test::More;
4 |
5 | # This test requires a PostgreSQL connection string for an existing database
6 | #
7 | # TEST_ONLINE=postgres://tester:testing@/test script/blog test
8 | #
9 | plan skip_all => 'set TEST_ONLINE to enable this test' unless $ENV{TEST_ONLINE};
10 |
11 | use Mojo::Pg;
12 | use Mojo::URL;
13 | use Test::Mojo;
14 |
15 | # Isolate tests
16 | my $url = Mojo::URL->new($ENV{TEST_ONLINE})->query([search_path => 'mojo_blog_test']);
17 | my $pg = Mojo::Pg->new($url);
18 | $pg->db->query('DROP SCHEMA IF EXISTS mojo_blog_test CASCADE');
19 | $pg->db->query('CREATE SCHEMA mojo_blog_test');
20 |
21 | # Override configuration for testing
22 | my $t = Test::Mojo->new(Blog => {pg => $url, secrets => ['test_s3cret']});
23 | $t->ua->max_redirects(10);
24 |
25 | # No posts yet
26 | $t->get_ok('/')
27 | ->status_is(200)
28 | ->text_is('title' => 'Blog')
29 | ->text_is('body > a' => 'New post')
30 | ->element_exists_not('h2');
31 |
32 | # Create a new post
33 | $t->get_ok('/posts/create')
34 | ->status_is(200)
35 | ->text_is('title' => 'New post')
36 | ->element_exists('form input[name=title]')
37 | ->element_exists('form textarea[name=body]');
38 | $t->post_ok('/posts' => form => {title => 'Testing', body => 'This is a test.'})
39 | ->status_is(200)
40 | ->text_is('title' => 'Testing')
41 | ->text_is('h2' => 'Testing')
42 | ->text_like('p' => qr/This is a test/);
43 |
44 | # Read the post
45 | $t->get_ok('/')
46 | ->status_is(200)
47 | ->text_is('title' => 'Blog')
48 | ->text_is('h2 a' => 'Testing')
49 | ->text_like('p' => qr/This is a test/);
50 | $t->get_ok('/posts/1')
51 | ->status_is(200)
52 | ->text_is('title' => 'Testing')
53 | ->text_is('h2' => 'Testing')
54 | ->text_like('p' => qr/This is a test/)
55 | ->text_is('body > a' => 'Edit');
56 |
57 | # Update the post
58 | $t->get_ok('/posts/1/edit')
59 | ->status_is(200)
60 | ->text_is('title' => 'Edit post')
61 | ->element_exists('form input[name=title][value=Testing]')
62 | ->text_like('form textarea[name=body]' => qr/This is a test/)
63 | ->element_exists('form input[value=Remove]');
64 | $t->post_ok('/posts/1?_method=PUT' => form => {title => 'Again', body => 'It works.'})
65 | ->status_is(200)
66 | ->text_is('title' => 'Again')
67 | ->text_is('h2' => 'Again')
68 | ->text_like('p' => qr/It works/);
69 | $t->get_ok('/posts/1')
70 | ->status_is(200)
71 | ->text_is('title' => 'Again')
72 | ->text_is('h2' => 'Again')
73 | ->text_like('p' => qr/It works/);
74 |
75 | # Delete the post
76 | $t->post_ok('/posts/1?_method=DELETE')->status_is(200)->text_is('title' => 'Blog')->element_exists_not('h2');
77 |
78 | # Clean up once we are done
79 | $pg->db->query('DROP SCHEMA mojo_blog_test CASCADE');
80 |
81 | done_testing();
82 |
--------------------------------------------------------------------------------
/lib/Mojo/Pg/Results.pm:
--------------------------------------------------------------------------------
1 | package Mojo::Pg::Results;
2 | use Mojo::Base -base;
3 |
4 | use Mojo::Collection;
5 | use Mojo::JSON qw(from_json);
6 | use Mojo::Util qw(tablify);
7 |
8 | has [qw(db sth)];
9 |
10 | sub DESTROY {
11 | my $self = shift;
12 | return unless my $sth = $self->{sth};
13 | $self->finish unless --$sth->{private_mojo_results};
14 | }
15 |
16 | sub array { ($_[0]->_expand($_[0]->sth->fetchrow_arrayref))[0] }
17 |
18 | sub arrays { _collect($_[0]->_expand(@{$_[0]->sth->fetchall_arrayref})) }
19 |
20 | sub columns { shift->sth->{NAME} }
21 |
22 | sub hash { ($_[0]->_expand($_[0]->sth->fetchrow_hashref))[0] }
23 |
24 | sub expand { ++$_[0]{expand} and return $_[0] }
25 |
26 | sub finish { $_[0]->db->_finish_when_safe($_[0]->sth) }
27 |
28 | sub hashes { _collect($_[0]->_expand(@{$_[0]->sth->fetchall_arrayref({})})) }
29 |
30 | sub new {
31 | my $self = shift->SUPER::new(@_);
32 | ($self->{sth}{private_mojo_results} //= 0)++;
33 | return $self;
34 | }
35 |
36 | sub rows { shift->sth->rows }
37 |
38 | sub text { tablify shift->arrays }
39 |
40 | sub _collect { Mojo::Collection->new(@_) }
41 |
42 | sub _expand {
43 | my ($self, @rows) = @_;
44 |
45 | return @rows unless $self->{expand} && $rows[0];
46 | my ($idx, $name) = @$self{qw(idx name)};
47 | unless ($idx) {
48 | my $types = $self->sth->{pg_type};
49 | my @idx = grep { $types->[$_] eq 'json' || $types->[$_] eq 'jsonb' } 0 .. $#$types;
50 | ($idx, $name) = @$self{qw(idx name)} = (\@idx, [@{$self->columns}[@idx]]);
51 | }
52 |
53 | return @rows unless @$idx;
54 | if (ref $rows[0] eq 'HASH') {
55 | for my $r (@rows) { $r->{$_} && ($r->{$_} = from_json $r->{$_}) for @$name }
56 | }
57 | else {
58 | for my $r (@rows) { $r->[$_] && ($r->[$_] = from_json $r->[$_]) for @$idx }
59 | }
60 |
61 | return @rows;
62 | }
63 |
64 | 1;
65 |
66 | =encoding utf8
67 |
68 | =head1 NAME
69 |
70 | Mojo::Pg::Results - Results
71 |
72 | =head1 SYNOPSIS
73 |
74 | use Mojo::Pg::Results;
75 |
76 | my $results = Mojo::Pg::Results->new(sth => $sth);
77 | $results->hashes->map(sub { $_->{foo} })->shuffle->join("\n")->say;
78 |
79 | =head1 DESCRIPTION
80 |
81 | L is a container for L statement handles used by L.
82 |
83 | =head1 ATTRIBUTES
84 |
85 | L implements the following attributes.
86 |
87 | =head2 db
88 |
89 | my $db = $results->db;
90 | $results = $results->db(Mojo::Pg::Database->new);
91 |
92 | L object these results belong to.
93 |
94 | =head2 sth
95 |
96 | my $sth = $results->sth;
97 | $results = $results->sth($sth);
98 |
99 | L statement handle results are fetched from.
100 |
101 | =head1 METHODS
102 |
103 | L inherits all methods from L and implements the following new ones.
104 |
105 | =head2 array
106 |
107 | my $array = $results->array;
108 |
109 | Fetch one row from L and return it as an array reference.
110 |
111 | =head2 arrays
112 |
113 | my $collection = $results->arrays;
114 |
115 | Fetch all rows from L and return them as a L object containing array references.
116 |
117 | # Process all rows at once
118 | say $results->arrays->reduce(sub { $a + $b->[3] }, 0);
119 |
120 | =head2 columns
121 |
122 | my $columns = $results->columns;
123 |
124 | Return column names as an array reference.
125 |
126 | # Names of all columns
127 | say for @{$results->columns};
128 |
129 | =head2 expand
130 |
131 | $results = $results->expand;
132 |
133 | Decode C and C fields automatically to Perl values for all rows.
134 |
135 | # Expand JSON
136 | $results->expand->hashes->map(sub { $_->{foo}{bar} })->join("\n")->say;
137 |
138 | =head2 finish
139 |
140 | $results->finish;
141 |
142 | Indicate that you are finished with L and will not be fetching all the remaining rows.
143 |
144 | =head2 hash
145 |
146 | my $hash = $results->hash;
147 |
148 | Fetch one row from L and return it as a hash reference.
149 |
150 | =head2 hashes
151 |
152 | my $collection = $results->hashes;
153 |
154 | Fetch all rows from L and return them as a L object containing hash references.
155 |
156 | # Process all rows at once
157 | say $results->hashes->reduce(sub { $a + $b->{money} }, 0);
158 |
159 | =head2 new
160 |
161 | my $results = Mojo::Pg::Results->new;
162 | my $results = Mojo::Pg::Results->new(sth => $sth);
163 | my $results = Mojo::Pg::Results->new({sth => $sth});
164 |
165 | Construct a new L object.
166 |
167 | =head2 rows
168 |
169 | my $num = $results->rows;
170 |
171 | Number of rows.
172 |
173 | =head2 text
174 |
175 | my $text = $results->text;
176 |
177 | Fetch all rows from L and turn them into a table with L.
178 |
179 | =head1 SEE ALSO
180 |
181 | L, L, L.
182 |
183 | =cut
184 |
--------------------------------------------------------------------------------
/t/connection.t:
--------------------------------------------------------------------------------
1 | use Mojo::Base -strict;
2 |
3 | use Test::More;
4 | use Mojo::Pg;
5 |
6 | subtest 'Defaults' => sub {
7 | my $pg = Mojo::Pg->new;
8 | is $pg->dsn, 'dbi:Pg:', 'right data source';
9 | is $pg->username, '', 'no username';
10 | is $pg->password, '', 'no password';
11 | my $options = {AutoCommit => 1, AutoInactiveDestroy => 1, PrintError => 0, PrintWarn => 0, RaiseError => 1};
12 | is_deeply $pg->options, $options, 'right options';
13 | is $pg->search_path, undef, 'no search_path';
14 | };
15 |
16 | subtest 'Minimal connection string with database' => sub {
17 | my $pg = Mojo::Pg->new('postgresql:///test1');
18 | is $pg->dsn, 'dbi:Pg:dbname=test1', 'right data source';
19 | is $pg->username, '', 'no username';
20 | is $pg->password, '', 'no password';
21 | my $options = {AutoCommit => 1, AutoInactiveDestroy => 1, PrintError => 0, PrintWarn => 0, RaiseError => 1};
22 | is_deeply $pg->options, $options, 'right options';
23 | };
24 |
25 | subtest 'Minimal connection string with service and option' => sub {
26 | my $pg = Mojo::Pg->new('postgres://?service=foo&PrintError=1&PrintWarn=1');
27 | is $pg->dsn, 'dbi:Pg:service=foo', 'right data source';
28 | is $pg->username, '', 'no username';
29 | is $pg->password, '', 'no password';
30 | my $options = {AutoCommit => 1, AutoInactiveDestroy => 1, PrintError => 1, PrintWarn => 1, RaiseError => 1};
31 | is_deeply $pg->options, $options, 'right options';
32 | };
33 |
34 | subtest 'Connection string with service and search_path' => sub {
35 | my $pg = Mojo::Pg->new('postgres://?service=foo&search_path=test_schema');
36 | is $pg->dsn, 'dbi:Pg:service=foo', 'right data source';
37 | is $pg->username, '', 'no username';
38 | is $pg->password, '', 'no password';
39 | my $options = {AutoCommit => 1, AutoInactiveDestroy => 1, PrintError => 0, PrintWarn => 0, RaiseError => 1};
40 | is_deeply $pg->options, $options, 'right options';
41 | is_deeply $pg->search_path, ['test_schema'], 'right search_path';
42 | };
43 |
44 | subtest 'Connection string with multiple search_path values' => sub {
45 | my $pg = Mojo::Pg->new('postgres://a:b@/c?search_path=test1&search_path=test2');
46 | is $pg->dsn, 'dbi:Pg:dbname=c', 'right data source';
47 | is $pg->username, 'a', 'no username';
48 | is $pg->password, 'b', 'no password';
49 | my $options = {AutoCommit => 1, AutoInactiveDestroy => 1, PrintError => 0, PrintWarn => 0, RaiseError => 1};
50 | is_deeply $pg->options, $options, 'right options';
51 | is_deeply $pg->search_path, ['test1', 'test2'], 'right search_path';
52 | };
53 |
54 | subtest 'Connection string with host and port' => sub {
55 | my $pg = Mojo::Pg->new('postgresql://127.0.0.1:8080/test2');
56 | is $pg->dsn, 'dbi:Pg:dbname=test2;host=127.0.0.1;port=8080', 'right data source';
57 | is $pg->username, '', 'no username';
58 | is $pg->password, '', 'no password';
59 | my $options = {AutoCommit => 1, AutoInactiveDestroy => 1, PrintError => 0, PrintWarn => 0, RaiseError => 1};
60 | is_deeply $pg->options, $options, 'right options';
61 | };
62 |
63 | subtest 'Connection string username but without host' => sub {
64 | my $pg = Mojo::Pg->new('postgres://postgres@/test3');
65 | is $pg->dsn, 'dbi:Pg:dbname=test3', 'right data source';
66 | is $pg->username, 'postgres', 'right username';
67 | is $pg->password, '', 'no password';
68 | my $options = {AutoCommit => 1, AutoInactiveDestroy => 1, PrintError => 0, PrintWarn => 0, RaiseError => 1};
69 | is_deeply $pg->options, $options, 'right options';
70 | };
71 |
72 | subtest 'Connection string with unix domain socket and options' => sub {
73 | my $pg = Mojo::Pg->new('postgresql://x1:y2@%2ftmp%2fpg.sock/test4?PrintError=1&RaiseError=0');
74 | is $pg->dsn, 'dbi:Pg:dbname=test4;host=/tmp/pg.sock', 'right data source';
75 | is $pg->username, 'x1', 'right username';
76 | is $pg->password, 'y2', 'right password';
77 | my $options = {AutoCommit => 1, AutoInactiveDestroy => 1, PrintError => 1, PrintWarn => 0, RaiseError => 0};
78 | is_deeply $pg->options, $options, 'right options';
79 | };
80 |
81 | subtest 'Connection string with lots of zeros' => sub {
82 | my $pg = Mojo::Pg->new('postgresql://0:0@/0?RaiseError=0');
83 | is $pg->dsn, 'dbi:Pg:dbname=0', 'right data source';
84 | is $pg->username, '0', 'right username';
85 | is $pg->password, '0', 'right password';
86 | my $options = {AutoCommit => 1, AutoInactiveDestroy => 1, PrintError => 0, PrintWarn => 0, RaiseError => 0};
87 | is_deeply $pg->options, $options, 'right options';
88 | };
89 |
90 | subtest 'Invalid connection string' => sub {
91 | eval { Mojo::Pg->new('http://localhost:3000/test') };
92 | like $@, qr/Invalid PostgreSQL connection string/, 'right error';
93 | };
94 |
95 | done_testing();
96 |
--------------------------------------------------------------------------------
/lib/Mojo/Pg/PubSub.pm:
--------------------------------------------------------------------------------
1 | package Mojo::Pg::PubSub;
2 | use Mojo::Base 'Mojo::EventEmitter';
3 |
4 | use Mojo::JSON qw(from_json to_json);
5 | use Scalar::Util qw(weaken);
6 |
7 | has pg => undef, weak => 1;
8 | has reconnect_interval => 1;
9 |
10 | sub db {
11 | my $self = shift;
12 |
13 | return $self->{db} if $self->{db};
14 |
15 | my $db = $self->{db} = $self->pg->db;
16 | weaken $self;
17 | $db->on(
18 | notification => sub {
19 | my ($db, $name, $pid, $payload) = @_;
20 | return unless my $cbs = $self->{chans}{$name};
21 | $payload = eval { from_json $payload } if $self->{json}{$name};
22 | for my $cb (@$cbs) { $self->$cb($payload) }
23 | }
24 | );
25 |
26 | $db->once(close => sub { $self->emit(disconnect => delete $self->{db}) });
27 | $db->listen($_) for keys %{$self->{chans}}, 'mojo.pubsub';
28 | delete $self->{reconnecting};
29 | $self->emit(reconnect => $db);
30 |
31 | return $db;
32 | }
33 |
34 | sub DESTROY { shift->reset unless ${^GLOBAL_PHASE} eq 'DESTRUCT' }
35 |
36 | sub json { ++$_[0]{json}{$_[1]} and return $_[0] }
37 |
38 | sub listen {
39 | my ($self, $name, $cb) = @_;
40 | $self->db->listen($name) if !@{$self->{chans}{$name} ||= []} && !$self->{reconnecting};
41 | push @{$self->{chans}{$name}}, $cb;
42 | return $cb;
43 | }
44 |
45 | sub new {
46 | my $self = shift->SUPER::new(@_);
47 | $self->on(disconnect => \&_disconnect);
48 | return $self;
49 | }
50 |
51 | sub notify { $_[0]->db->notify(_json(@_)) and return $_[0] }
52 |
53 | sub reset {
54 | my $self = shift;
55 | delete @$self{qw(chans json pid)};
56 | return unless my $db = delete $self->{db};
57 | ++$db->dbh->{private_mojo_no_reuse} and $db->_unwatch;
58 | }
59 |
60 | sub unlisten {
61 | my ($self, $name, $cb) = @_;
62 |
63 | my $chan = $self->{chans}{$name};
64 | unless (@$chan = $cb ? grep { $cb ne $_ } @$chan : ()) {
65 | $self->db->unlisten($name) unless $self->{reconnecting};
66 | delete $self->{chans}{$name};
67 | }
68 |
69 | return $self;
70 | }
71 |
72 | sub _disconnect {
73 | my $self = shift;
74 |
75 | $self->{reconnecting} = 1;
76 |
77 | weaken $self;
78 | my $r;
79 | $r = Mojo::IOLoop->recurring(
80 | $self->reconnect_interval => sub {
81 | Mojo::IOLoop->remove($r) if eval { $self->db };
82 | }
83 | );
84 | }
85 |
86 | sub _json { $_[1], $_[0]{json}{$_[1]} ? to_json $_[2] : $_[2] }
87 |
88 | 1;
89 |
90 | =encoding utf8
91 |
92 | =head1 NAME
93 |
94 | Mojo::Pg::PubSub - Publish/Subscribe
95 |
96 | =head1 SYNOPSIS
97 |
98 | use Mojo::Pg::PubSub;
99 |
100 | my $pubsub = Mojo::Pg::PubSub->new(pg => $pg);
101 | my $cb = $pubsub->listen(foo => sub ($pubsub, $payload) {
102 | say "Received: $payload";
103 | });
104 | $pubsub->notify(foo => 'I ♥ Mojolicious!');
105 | $pubsub->unlisten(foo => $cb);
106 |
107 | =head1 DESCRIPTION
108 |
109 | L is a scalable implementation of the publish/subscribe pattern used by L. It is based on
110 | PostgreSQL notifications and allows many consumers to share the same database connection, to avoid many common
111 | scalability problems.
112 |
113 | =head1 EVENTS
114 |
115 | L inherits all events from L and can emit the following new ones.
116 |
117 | =head2 disconnect
118 |
119 | $pubsub->on(disconnect => sub ($pubsub, $db) {
120 | ...
121 | });
122 |
123 | Emitted after the current database connection is lost.
124 |
125 | =head2 reconnect
126 |
127 | $pubsub->on(reconnect => sub ($pubsub, $db) {
128 | ...
129 | });
130 |
131 | Emitted after switching to a new database connection for sending and receiving notifications.
132 |
133 | =head1 ATTRIBUTES
134 |
135 | L implements the following attributes.
136 |
137 | =head2 pg
138 |
139 | my $pg = $pubsub->pg;
140 | $pubsub = $pubsub->pg(Mojo::Pg->new);
141 |
142 | L object this publish/subscribe container belongs to. Note that this attribute is weakened.
143 |
144 | =head2 reconnect_interval
145 |
146 | my $interval = $pubsub->reconnect_interval;
147 | $pubsub = $pubsub->reconnect_interval(0.1);
148 |
149 | Amount of time in seconds to wait to reconnect after disconnecting, defaults to C<1>.
150 |
151 | =head1 METHODS
152 |
153 | L inherits all methods from L and implements the following new ones.
154 |
155 | =head2 db
156 |
157 | my $db = $pubsub->db;
158 |
159 | Build and cache or get cached L connection from L. Used to reconnect if disconnected.
160 |
161 | # Reconnect immediately
162 | $pubsub->unsubscribe('disconnect')->on(disconnect => sub ($pubsub, $db) { pubsub->db });
163 |
164 | =head2 json
165 |
166 | $pubsub = $pubsub->json('foo');
167 |
168 | Activate automatic JSON encoding and decoding with L and L for a channel.
169 |
170 | # Send and receive data structures
171 | $pubsub->json('foo')->listen(foo => sub ($pubsub, $payload) {
172 | say $payload->{bar};
173 | });
174 | $pubsub->notify(foo => {bar => 'I ♥ Mojolicious!'});
175 |
176 | =head2 listen
177 |
178 | my $cb = $pubsub->listen(foo => sub {...});
179 |
180 | Subscribe to a channel, there is no limit on how many subscribers a channel can have. Automatic decoding of JSON text
181 | to Perl values can be activated with L.
182 |
183 | # Subscribe to the same channel twice
184 | $pubsub->listen(foo => sub ($pubsub, $payload) {
185 | say "One: $payload";
186 | });
187 | $pubsub->listen(foo => sub ($pubsub, $payload) {
188 | say "Two: $payload";
189 | });
190 |
191 | =head2 new
192 |
193 | my $pubsub = Mojo::Pg::PubSub->new;
194 | my $pubsub = Mojo::Pg::PubSub->new(pg => Mojo::Pg->new);
195 | my $pubsub = Mojo::Pg::PubSub->new({pg => Mojo::Pg->new});
196 |
197 | Construct a new L object and subscribe to the L event with default reconnect logic.
198 |
199 | =head2 notify
200 |
201 | $pubsub = $pubsub->notify('foo');
202 | $pubsub = $pubsub->notify(foo => 'I ♥ Mojolicious!');
203 | $pubsub = $pubsub->notify(foo => {bar => 'baz'});
204 |
205 | Notify a channel. Automatic encoding of Perl values to JSON text can be activated with L.
206 |
207 | =head2 reset
208 |
209 | $pubsub->reset;
210 |
211 | Reset all subscriptions and the database connection. This is usually done after a new process has been forked, to
212 | prevent the child process from stealing notifications meant for the parent process.
213 |
214 | =head2 unlisten
215 |
216 | $pubsub = $pubsub->unlisten('foo');
217 | $pubsub = $pubsub->unlisten(foo => $cb);
218 |
219 | Unsubscribe from a channel.
220 |
221 | =head1 SEE ALSO
222 |
223 | L, L, L.
224 |
225 | =cut
226 |
--------------------------------------------------------------------------------
/t/results.t:
--------------------------------------------------------------------------------
1 | use Mojo::Base -strict;
2 |
3 | BEGIN { $ENV{MOJO_REACTOR} = 'Mojo::Reactor::Poll' }
4 |
5 | use Test::More;
6 |
7 | plan skip_all => 'set TEST_ONLINE to enable this test' unless $ENV{TEST_ONLINE};
8 |
9 | use DBD::Pg qw(:pg_types);
10 | use Mojo::Pg;
11 | use Mojo::Promise;
12 | use Mojo::Util qw(encode);
13 |
14 | package MojoPgTest::Database;
15 | use Mojo::Base 'Mojo::Pg::Database';
16 |
17 | sub results_class {'MojoPgTest::Results'}
18 |
19 | package MojoPgTest::Results;
20 | use Mojo::Base 'Mojo::Pg::Results';
21 |
22 | sub array_test { shift->array }
23 |
24 | package main;
25 |
26 | # Isolate tests
27 | my $pg = Mojo::Pg->new($ENV{TEST_ONLINE})->search_path(['mojo_results_test']);
28 | $pg->db->query('DROP SCHEMA IF EXISTS mojo_results_test CASCADE');
29 | $pg->db->query('CREATE SCHEMA mojo_results_test');
30 |
31 | my $db = $pg->db;
32 | is_deeply $pg->search_path, ['mojo_results_test'], 'right search path';
33 | $db->query(
34 | 'CREATE TABLE IF NOT EXISTS results_test (
35 | id SERIAL PRIMARY KEY,
36 | name TEXT
37 | )'
38 | );
39 | $db->query('INSERT INTO results_test (name) VALUES (?)', $_) for qw(foo bar);
40 |
41 | subtest 'Tables' => sub {
42 | ok !!(grep {/^mojo_results_test\.results.test$/} @{$db->tables}), 'results table exists';
43 | ok !(grep {/^information_schema\.tables$/} @{$db->tables}), 'internal tables are hidden';
44 | ok !(grep {/^pg_catalog\.pg_tables$/} @{$db->tables}), 'internal tables are hidden';
45 | };
46 |
47 | subtest 'Result methods' => sub {
48 | is_deeply $db->query('SELECT * FROM results_test')->rows, 2, 'two rows';
49 | is_deeply $db->query('SELECT * FROM results_test')->columns, ['id', 'name'], 'right structure';
50 | is_deeply $db->query('SELECT * FROM results_test')->array, [1, 'foo'], 'right structure';
51 | is_deeply $db->query('SELECT * FROM results_test')->arrays->to_array, [[1, 'foo'], [2, 'bar']], 'right structure';
52 | is_deeply $db->query('SELECT * FROM results_test')->hash, {id => 1, name => 'foo'}, 'right structure';
53 | is_deeply $db->query('SELECT * FROM results_test')->hashes->to_array,
54 | [{id => 1, name => 'foo'}, {id => 2, name => 'bar'}], 'right structure';
55 | is $pg->db->query('SELECT * FROM results_test')->text, "1 foo\n2 bar\n", 'right text';
56 | };
57 |
58 | subtest 'Custom database and results classes' => sub {
59 | is ref $db, 'Mojo::Pg::Database', 'right class';
60 | $pg->database_class('MojoPgTest::Database');
61 | $db = $pg->db;
62 | is ref $db, 'MojoPgTest::Database', 'right class';
63 | is ref $db->query('SELECT 1'), 'MojoPgTest::Results', 'right class';
64 | is_deeply $db->query('SELECT * from results_test')->array_test, [1, 'foo'], 'right structure';
65 | };
66 |
67 | subtest 'JSON' => sub {
68 | is_deeply $db->query('SELECT ?::JSON AS foo', {json => {bar => 'baz'}})->expand->hash, {foo => {bar => 'baz'}},
69 | 'right structure';
70 | is_deeply $db->query('SELECT ?::JSON AS foo', {-json => {bar => 'baz'}})->expand->hash, {foo => {bar => 'baz'}},
71 | 'right structure';
72 | is_deeply $db->query('SELECT ?::JSON AS foo', {json => {bar => 'baz'}})->expand->array, [{bar => 'baz'}],
73 | 'right structure';
74 | my $hashes = [{foo => {one => 1}, bar => 'a'}, {foo => {two => 2}, bar => 'b'}];
75 | is_deeply $db->query(
76 | "SELECT 'a' AS bar, ?::JSON AS foo
77 | UNION ALL
78 | SELECT 'b' AS bar, ?::JSON AS foo", {json => {one => 1}}, {json => {two => 2}}
79 | )->expand->hashes->to_array, $hashes, 'right structure';
80 | my $arrays = [['a', {one => 1}], ['b', {two => 2}]];
81 | is_deeply $db->query(
82 | "SELECT 'a' AS bar, ?::JSON AS foo
83 | UNION ALL
84 | SELECT 'b' AS bar, ?::JSON AS foo", {json => {one => 1}}, {json => {two => 2}}
85 | )->expand->arrays->to_array, $arrays, 'right structure';
86 | };
87 |
88 | subtest 'Iterate' => sub {
89 | my $results = $db->query('SELECT * FROM results_test');
90 | is_deeply $results->array, [1, 'foo'], 'right structure';
91 | is_deeply $results->array, [2, 'bar'], 'right structure';
92 | is $results->array, undef, 'no more results';
93 | };
94 |
95 | subtest 'Non-blocking query where not all results have been fetched' => sub {
96 | my ($fail, $result);
97 | $db->query_p('SELECT name FROM results_test')->then(sub {
98 | my $results = shift;
99 | push @$result, $results->array;
100 | $results->finish;
101 | return $db->query_p('SELECT name FROM results_test');
102 | })->then(sub {
103 | my $results = shift;
104 | push @$result, $results->array_test;
105 | $results->finish;
106 | return $db->query_p('SELECT name FROM results_test');
107 | })->then(sub {
108 | my $results = shift;
109 | push @$result, $results->array;
110 | })->catch(sub { $fail = shift })->wait;
111 | ok !$fail, 'no error';
112 | is_deeply $result, [['foo'], ['foo'], ['foo']], 'right structure';
113 | };
114 |
115 | subtest 'Transactions' => sub {
116 | {
117 | my $tx = $db->begin;
118 | $db->query("INSERT INTO results_test (name) VALUES ('tx1')");
119 | $db->query("INSERT INTO results_test (name) VALUES ('tx1')");
120 | $tx->commit;
121 | };
122 | is_deeply $db->query('SELECT * FROM results_test WHERE name = ?', 'tx1')->hashes->to_array,
123 | [{id => 3, name => 'tx1'}, {id => 4, name => 'tx1'}], 'right structure';
124 | {
125 | my $tx = $db->begin;
126 | $db->query("INSERT INTO results_test (name) VALUES ('tx2')");
127 | $db->query("INSERT INTO results_test (name) VALUES ('tx2')");
128 | };
129 | is_deeply $db->query('SELECT * FROM results_test WHERE name = ?', 'tx2')->hashes->to_array, [], 'no results';
130 | eval {
131 | my $tx = $db->begin;
132 | $db->query("INSERT INTO results_test (name) VALUES ('tx3')");
133 | $db->query("INSERT INTO results_test (name) VALUES ('tx3')");
134 | $db->query('does_not_exist');
135 | $tx->commit;
136 | };
137 | like $@, qr/does_not_exist/, 'right error';
138 | is_deeply $db->query('SELECT * FROM results_test WHERE name = ?', 'tx3')->hashes->to_array, [], 'no results';
139 | };
140 |
141 | subtest 'Long-lived results' => sub {
142 | my $results1 = $db->query('SELECT 1 AS one');
143 | is_deeply $results1->hashes, [{one => 1}], 'right structure';
144 | my $results2 = $db->query('SELECT 1 AS one');
145 | undef $results1;
146 | is_deeply $results2->hashes, [{one => 1}], 'right structure';
147 | };
148 |
149 | subtest 'Custom data types' => sub {
150 | $db->query('CREATE TABLE IF NOT EXISTS results_test2 (stuff BYTEA)');
151 | my $snowman = encode 'UTF-8', '☃';
152 | $db->query('INSERT INTO results_test2 (stuff) VALUES (?)', {value => $snowman, type => PG_BYTEA});
153 | is_deeply $db->query('SELECT * FROM results_test2')->hash, {stuff => $snowman}, 'right structure';
154 | };
155 |
156 | # Clean up once we are done
157 | $pg->db->query('DROP SCHEMA mojo_results_test CASCADE');
158 |
159 | done_testing();
160 |
--------------------------------------------------------------------------------
/t/crud.t:
--------------------------------------------------------------------------------
1 | use Mojo::Base -strict;
2 |
3 | BEGIN { $ENV{MOJO_REACTOR} = 'Mojo::Reactor::Poll' }
4 |
5 | use Test::More;
6 |
7 | plan skip_all => 'set TEST_ONLINE to enable this test' unless $ENV{TEST_ONLINE};
8 |
9 | use Mojo::IOLoop;
10 | use Mojo::Pg;
11 | use Mojo::Promise;
12 |
13 | # Isolate tests
14 | my $pg = Mojo::Pg->new($ENV{TEST_ONLINE})->search_path(['mojo_crud_test']);
15 | $pg->db->query('DROP SCHEMA IF EXISTS mojo_crud_test CASCADE');
16 | $pg->db->query('CREATE SCHEMA mojo_crud_test');
17 |
18 | my $db = $pg->db;
19 | $db->query(
20 | 'CREATE TABLE IF NOT EXISTS crud_test (
21 | id SERIAL PRIMARY KEY,
22 | name TEXT
23 | )'
24 | );
25 |
26 | subtest 'Create' => sub {
27 | $db->insert('crud_test', {name => 'foo'});
28 | is_deeply $db->select('crud_test')->hashes->to_array, [{id => 1, name => 'foo'}], 'right structure';
29 | is $db->insert('crud_test', {name => 'bar'}, {returning => 'id'})->hash->{id}, 2, 'right value';
30 | is_deeply $db->select('crud_test')->hashes->to_array, [{id => 1, name => 'foo'}, {id => 2, name => 'bar'}],
31 | 'right structure';
32 | $db->insert('crud_test', {id => 1, name => 'foo'}, {on_conflict => undef});
33 | $db->insert('crud_test', {id => 2, name => 'bar'}, {on_conflict => [id => {name => 'baz'}]});
34 | };
35 |
36 | subtest 'Read' => sub {
37 | is_deeply $db->select('crud_test')->hashes->to_array, [{id => 1, name => 'foo'}, {id => 2, name => 'baz'}],
38 | 'right structure';
39 | is_deeply $db->select('crud_test', ['name'])->hashes->to_array, [{name => 'foo'}, {name => 'baz'}], 'right structure';
40 | is_deeply $db->select('crud_test', ['name'], {name => 'foo'})->hashes->to_array, [{name => 'foo'}], 'right structure';
41 | is_deeply $db->select('crud_test', ['name'], undef, {-desc => 'id'})->hashes->to_array,
42 | [{name => 'baz'}, {name => 'foo'}], 'right structure';
43 | is_deeply $db->select('crud_test', undef, undef, {offset => 1})->hashes->to_array, [{id => 2, name => 'baz'}],
44 | 'right structure';
45 | is_deeply $db->select('crud_test', undef, undef, {limit => 1})->hashes->to_array, [{id => 1, name => 'foo'}],
46 | 'right structure';
47 | };
48 |
49 | subtest 'Non-blocking read' => sub {
50 | my $result;
51 | my $promise = Mojo::Promise->new;
52 | $db->select(
53 | 'crud_test',
54 | sub {
55 | $result = pop->hashes->to_array;
56 | $promise->resolve;
57 | }
58 | );
59 | $promise->wait;
60 | is_deeply $result, [{id => 1, name => 'foo'}, {id => 2, name => 'baz'}], 'right structure';
61 |
62 | $result = undef;
63 | $promise = Mojo::Promise->new;
64 | $db->select(
65 | 'crud_test',
66 | undef, undef,
67 | {-desc => 'id'},
68 | sub {
69 | $result = pop->hashes->to_array;
70 | $promise->resolve;
71 | }
72 | );
73 | $promise->wait;
74 | is_deeply $result, [{id => 2, name => 'baz'}, {id => 1, name => 'foo'}], 'right structure';
75 | };
76 |
77 | subtest 'Update' => sub {
78 | $db->update('crud_test', {name => 'yada'}, {name => 'foo'});
79 | is_deeply $db->select('crud_test', undef, undef, {-asc => 'id'})->hashes->to_array,
80 | [{id => 1, name => 'yada'}, {id => 2, name => 'baz'}], 'right structure';
81 | };
82 |
83 | subtest 'Delete' => sub {
84 | $db->delete('crud_test', {name => 'yada'});
85 | is_deeply $db->select('crud_test', undef, undef, {-asc => 'id'})->hashes->to_array, [{id => 2, name => 'baz'}],
86 | 'right structure';
87 | $db->delete('crud_test');
88 | is_deeply $db->select('crud_test')->hashes->to_array, [], 'right structure';
89 | };
90 |
91 | subtest 'Quoting' => sub {
92 | $db->query(
93 | 'CREATE TABLE IF NOT EXISTS crud_test2 (
94 | id SERIAL PRIMARY KEY,
95 | "t e s t" TEXT
96 | )'
97 | );
98 | $db->insert('crud_test2', {'t e s t' => 'foo'});
99 | $db->insert('mojo_crud_test.crud_test2', {'t e s t' => 'bar'});
100 | is_deeply $db->select('mojo_crud_test.crud_test2')->hashes->to_array,
101 | [{id => 1, 't e s t' => 'foo'}, {id => 2, 't e s t' => 'bar'}], 'right structure';
102 | };
103 |
104 | subtest 'Arrays' => sub {
105 | $db->query(
106 | 'CREATE TABLE IF NOT EXISTS crud_test3 (
107 | id SERIAL PRIMARY KEY,
108 | names TEXT[]
109 | )'
110 | );
111 | $db->insert('crud_test3', {names => ['foo', 'bar']});
112 | is_deeply $db->select('crud_test3')->hashes->to_array, [{id => 1, names => ['foo', 'bar']}], 'right structure';
113 | $db->update('crud_test3', {names => ['foo', 'bar', 'baz', 'yada']}, {id => 1});
114 | is_deeply $db->select('crud_test3')->hashes->to_array, [{id => 1, names => ['foo', 'bar', 'baz', 'yada']}],
115 | 'right structure';
116 | };
117 |
118 | subtest 'Promises' => sub {
119 | my $result;
120 | $pg->db->insert_p('crud_test', {name => 'promise'}, {returning => '*'})->then(sub { $result = shift->hash })->wait;
121 | is $result->{name}, 'promise', 'right result';
122 | $result = undef;
123 | $db->select_p('crud_test', '*', {name => 'promise'})->then(sub { $result = shift->hash })->wait;
124 | is $result->{name}, 'promise', 'right result';
125 |
126 | $result = undef;
127 | my $first = $pg->db->query_p("SELECT * FROM crud_test WHERE name = 'promise'");
128 | my $second = $pg->db->query_p("SELECT * FROM crud_test WHERE name = 'promise'");
129 | Mojo::Promise->all($first, $second)->then(sub {
130 | my ($first, $second) = @_;
131 | $result = [$first->[0]->hash, $second->[0]->hash];
132 | })->wait;
133 | is $result->[0]{name}, 'promise', 'right result';
134 | is $result->[1]{name}, 'promise', 'right result';
135 |
136 | $result = undef;
137 | $db->update_p('crud_test', {name => 'promise_two'}, {name => 'promise'}, {returning => '*'})
138 | ->then(sub { $result = shift->hash })
139 | ->wait;
140 | is $result->{name}, 'promise_two', 'right result';
141 | $db->delete_p('crud_test', {name => 'promise_two'}, {returning => '*'})->then(sub { $result = shift->hash })->wait;
142 | is $result->{name}, 'promise_two', 'right result';
143 | };
144 |
145 | subtest 'Promises (rejected)' => sub {
146 | my $fail;
147 | $db->dollar_only->query_p('does_not_exist')->catch(sub { $fail = shift })->wait;
148 | like $fail, qr/does_not_exist/, 'right error';
149 | };
150 |
151 | subtest 'Join' => sub {
152 | $db->query(
153 | 'CREATE TABLE IF NOT EXISTS crud_test4 (
154 | id SERIAL PRIMARY KEY,
155 | test1 TEXT
156 | )'
157 | );
158 | $db->query(
159 | 'CREATE TABLE IF NOT EXISTS crud_test5 (
160 | id SERIAL PRIMARY KEY,
161 | test2 TEXT
162 | )'
163 | );
164 | $db->insert('crud_test4', {test1 => 'hello'});
165 | $db->insert('crud_test5', {test2 => 'world'});
166 | is_deeply $db->select(['crud_test4', ['crud_test5', id => 'id']],
167 | ['crud_test4.id', 'test1', 'test2', ['crud_test4.test1' => 'test3']])->hashes->to_array,
168 | [{id => 1, test1 => 'hello', test2 => 'world', test3 => 'hello'}], 'right structure';
169 | };
170 |
171 | # Clean up once we are done
172 | $pg->db->query('DROP SCHEMA mojo_crud_test CASCADE');
173 |
174 | done_testing();
175 |
--------------------------------------------------------------------------------
/lib/Mojo/Pg/Migrations.pm:
--------------------------------------------------------------------------------
1 | package Mojo::Pg::Migrations;
2 | use Mojo::Base -base;
3 |
4 | use Carp qw(croak);
5 | use Mojo::File qw(path);
6 | use Mojo::Loader qw(data_section);
7 | use Mojo::Util qw(decode);
8 |
9 | use constant DEBUG => $ENV{MOJO_MIGRATIONS_DEBUG} || 0;
10 |
11 | has name => 'migrations';
12 | has pg => undef, weak => 1;
13 |
14 | sub active { $_[0]->_active($_[0]->pg->db) }
15 |
16 | sub from_data {
17 | my ($self, $class, $name) = @_;
18 | return $self->from_string(data_section($class //= caller, $name // $self->name));
19 | }
20 |
21 | sub from_dir {
22 | my ($self, $dir) = @_;
23 |
24 | my $migrations = $self->{migrations} = {up => {}, down => {}};
25 | for my $file (path($dir)->list_tree({max_depth => 2})->each) {
26 | next unless my ($way) = ($file->basename =~ /^(up|down)\.sql$/);
27 | next unless my ($version) = ($file->dirname->basename =~ /^(\d+)$/);
28 | $migrations->{$way}{$version} = decode 'UTF-8', $file->slurp;
29 | }
30 |
31 | return $self;
32 | }
33 |
34 | sub from_file { shift->from_string(decode 'UTF-8', path(pop)->slurp) }
35 |
36 | sub from_string {
37 | my ($self, $sql) = @_;
38 |
39 | my ($version, $way);
40 | my $migrations = $self->{migrations} = {up => {}, down => {}};
41 | for my $line (split "\n", $sql // '') {
42 | ($version, $way) = ($1, lc $2) if $line =~ /^\s*--\s*(\d+)\s*(up|down)/i;
43 | $migrations->{$way}{$version} .= "$line\n" if $version;
44 | }
45 |
46 | return $self;
47 | }
48 |
49 | sub latest {
50 | (sort { $a <=> $b } keys %{shift->{migrations}{up}})[-1] || 0;
51 | }
52 |
53 | sub migrate {
54 | my ($self, $target) = @_;
55 |
56 | # Unknown version
57 | my $latest = $self->latest;
58 | $target //= $latest;
59 | my ($up, $down) = @{$self->{migrations}}{qw(up down)};
60 | croak "Version $target has no migration" if $target != 0 && !$up->{$target};
61 |
62 | # Already the right version (make sure migrations table exists)
63 | my $db = $self->pg->db;
64 | return $self if $self->_active($db) == $target;
65 |
66 | # Lock migrations table and check version again
67 | $db->query(
68 | 'CREATE TABLE IF NOT EXISTS mojo_migrations (
69 | name TEXT PRIMARY KEY,
70 | version BIGINT NOT NULL CHECK (version >= 0)
71 | )'
72 | );
73 | my $tx = $db->begin;
74 | $db->query('LOCK TABLE mojo_migrations IN EXCLUSIVE MODE');
75 | return $self if (my $active = $self->_active($db)) == $target;
76 |
77 | # Newer version
78 | croak "Active version $active is greater than the latest version $latest" if $active > $latest;
79 |
80 | my $sql = $self->sql_for($active, $target);
81 | warn "-- Migrate ($active -> $target)\n$sql\n" if DEBUG;
82 | $sql .= ';INSERT INTO mojo_migrations (name, version) VALUES ($2, $1)';
83 | $sql .= ' ON CONFLICT (name) DO UPDATE SET version = $1;';
84 | $db->query($sql, $target, $self->name) and $tx->commit;
85 |
86 | return $self;
87 | }
88 |
89 | sub sql_for {
90 | my ($self, $from, $to) = @_;
91 |
92 | # Up
93 | my ($up, $down) = @{$self->{migrations}}{qw(up down)};
94 | if ($from < $to) {
95 | my @up = grep { $_ <= $to && $_ > $from } keys %$up;
96 | return join '', @$up{sort { $a <=> $b } @up};
97 | }
98 |
99 | # Down
100 | my @down = grep { $_ > $to && $_ <= $from } keys %$down;
101 | return join '', @$down{reverse sort { $a <=> $b } @down};
102 | }
103 |
104 | sub _active {
105 | my ($self, $db) = @_;
106 |
107 | my $name = $self->name;
108 | my $results;
109 | {
110 | local $db->dbh->{RaiseError} = 0;
111 | my $sql = 'SELECT version FROM mojo_migrations WHERE name = $1';
112 | $results = $db->query($sql, $name);
113 | };
114 | if (my $next = $results->array) { return $next->[0] || 0 }
115 | return 0;
116 | }
117 |
118 | 1;
119 |
120 | =encoding utf8
121 |
122 | =head1 NAME
123 |
124 | Mojo::Pg::Migrations - Migrations
125 |
126 | =head1 SYNOPSIS
127 |
128 | use Mojo::Pg::Migrations;
129 |
130 | my $migrations = Mojo::Pg::Migrations->new(pg => $pg);
131 | $migrations->from_file('/home/sri/migrations.sql')->migrate;
132 |
133 | =head1 DESCRIPTION
134 |
135 | L is used by L to allow database schemas to evolve easily over time. A migration file
136 | is just a collection of sql blocks, with one or more statements, separated by comments of the form C<-- VERSION
137 | UP/DOWN>.
138 |
139 | -- 1 up
140 | CREATE TABLE messages (message TEXT);
141 | INSERT INTO messages VALUES ('I ♥ Mojolicious!');
142 | -- 1 down
143 | DROP TABLE messages;
144 |
145 | -- 2 up (...you can comment freely here...)
146 | CREATE TABLE stuff (whatever INT);
147 | -- 2 down
148 | DROP TABLE stuff;
149 |
150 | The idea is to let you migrate from any version, to any version, up and down. Migrations are very safe, because they
151 | are performed in transactions and only one can be performed at a time. If a single statement fails, the whole migration
152 | will fail and get rolled back. Every set of migrations has a L, which is stored together with the currently
153 | active version in an automatically created table named C.
154 |
155 | =head1 ATTRIBUTES
156 |
157 | L implements the following attributes.
158 |
159 | =head2 name
160 |
161 | my $name = $migrations->name;
162 | $migrations = $migrations->name('foo');
163 |
164 | Name for this set of migrations, defaults to C.
165 |
166 | =head2 pg
167 |
168 | my $pg = $migrations->pg;
169 | $migrations = $migrations->pg(Mojo::Pg->new);
170 |
171 | L object these migrations belong to. Note that this attribute is weakened.
172 |
173 | =head1 METHODS
174 |
175 | L inherits all methods from L and implements the following new ones.
176 |
177 | =head2 active
178 |
179 | my $version = $migrations->active;
180 |
181 | Currently active version.
182 |
183 | =head2 from_data
184 |
185 | $migrations = $migrations->from_data;
186 | $migrations = $migrations->from_data('main');
187 | $migrations = $migrations->from_data('main', 'file_name');
188 |
189 | Extract migrations from a file in the DATA section of a class with L, defaults to using
190 | the caller class and L.
191 |
192 | __DATA__
193 | @@ migrations
194 | -- 1 up
195 | CREATE TABLE messages (message TEXT);
196 | INSERT INTO messages VALUES ('I ♥ Mojolicious!');
197 | -- 1 down
198 | DROP TABLE messages;
199 |
200 | =head2 from_dir
201 |
202 | $migrations = $migrations->from_dir('/home/sri/migrations');
203 |
204 | Extract migrations from a directory tree where each versioned migration is in a directory, named for the version, and
205 | each migration has one or both of the files named C or C.
206 |
207 | migrations/1/up.sql
208 | migrations/1/down.sql
209 | migrations/2/up.sql
210 | migrations/3/up.sql
211 | migrations/3/down.sql
212 |
213 | =head2 from_file
214 |
215 | $migrations = $migrations->from_file('/home/sri/migrations.sql');
216 |
217 | Extract migrations from a file.
218 |
219 | =head2 from_string
220 |
221 | $migrations = $migrations->from_string(
222 | '-- 1 up
223 | CREATE TABLE foo (bar INT);
224 | -- 1 down
225 | DROP TABLE foo;'
226 | );
227 |
228 | Extract migrations from string.
229 |
230 | =head2 latest
231 |
232 | my $version = $migrations->latest;
233 |
234 | Latest version available.
235 |
236 | =head2 migrate
237 |
238 | $migrations = $migrations->migrate;
239 | $migrations = $migrations->migrate(3);
240 |
241 | Migrate from L to a different version, up or down, defaults to using L. All version numbers need
242 | to be positive, with version C<0> representing an empty database.
243 |
244 | # Reset database
245 | $migrations->migrate(0)->migrate;
246 |
247 | =head2 sql_for
248 |
249 | my $sql = $migrations->sql_for(5, 10);
250 |
251 | Get SQL to migrate from one version to another, up or down.
252 |
253 | =head1 DEBUGGING
254 |
255 | You can set the C environment variable to get some advanced diagnostics information printed to
256 | C.
257 |
258 | MOJO_MIGRATIONS_DEBUG=1
259 |
260 | =head1 SEE ALSO
261 |
262 | L, L, L.
263 |
264 | =cut
265 |
--------------------------------------------------------------------------------
/t/pubsub.t:
--------------------------------------------------------------------------------
1 | use Mojo::Base -strict;
2 |
3 | BEGIN { $ENV{MOJO_REACTOR} = 'Mojo::Reactor::Poll' }
4 |
5 | use Test::More;
6 |
7 | plan skip_all => 'set TEST_ONLINE to enable this test' unless $ENV{TEST_ONLINE};
8 |
9 | use Mojo::IOLoop;
10 | use Mojo::JSON qw(true);
11 | use Mojo::Pg;
12 |
13 | subtest 'Notifications with event loop' => sub {
14 | my $pg = Mojo::Pg->new($ENV{TEST_ONLINE});
15 | my ($db, @all, @test);
16 | $pg->pubsub->on(reconnect => sub { $db = pop });
17 | $pg->pubsub->listen(
18 | pstest => sub {
19 | my ($pubsub, $payload) = @_;
20 | push @test, $payload;
21 | Mojo::IOLoop->next_tick(sub { $pubsub->pg->db->notify(pstest => 'stop') });
22 | Mojo::IOLoop->stop if $payload eq 'stop';
23 | }
24 | );
25 | $db->on(notification => sub { push @all, [@_[1, 3]] });
26 | $pg->db->notify(pstest => '♥test♥');
27 | Mojo::IOLoop->start;
28 | is_deeply \@test, ['♥test♥', 'stop'], 'right messages';
29 | is_deeply \@all, [['pstest', '♥test♥'], ['pstest', 'stop']], 'right notifications';
30 | };
31 |
32 | subtest 'JSON' => sub {
33 | my $pg = Mojo::Pg->new($ENV{TEST_ONLINE});
34 | my (@json, @raw);
35 | $pg->pubsub->json('pstest')->listen(
36 | pstest => sub {
37 | my ($pubsub, $payload) = @_;
38 | push @json, $payload;
39 | Mojo::IOLoop->stop if ref $payload eq 'HASH' && $payload->{msg} eq 'stop';
40 | }
41 | );
42 | $pg->pubsub->listen(
43 | pstest2 => sub {
44 | my ($pubsub, $payload) = @_;
45 | push @raw, $payload;
46 | }
47 | );
48 | Mojo::IOLoop->next_tick(sub {
49 | $pg->db->notify(pstest => 'fail');
50 | $pg->pubsub->notify('pstest')
51 | ->notify(pstest => {msg => '♥works♥'})
52 | ->notify(pstest => [1, 2, 3])
53 | ->notify(pstest => true)
54 | ->notify(pstest2 => '♥works♥')
55 | ->notify(pstest => {msg => 'stop'});
56 | });
57 | Mojo::IOLoop->start;
58 | is_deeply \@json, [undef, undef, {msg => '♥works♥'}, [1, 2, 3], true, {msg => 'stop'}], 'right data structures';
59 | is_deeply \@raw, ['♥works♥'], 'right messages';
60 | };
61 |
62 | subtest 'Unsubscribe' => sub {
63 | my $pg = Mojo::Pg->new($ENV{TEST_ONLINE});
64 | my $db;
65 | $pg->pubsub->on(reconnect => sub { $db = pop });
66 | my (@all, @test);
67 | my $first = $pg->pubsub->listen(pstest => sub { push @test, pop });
68 | my $second = $pg->pubsub->listen(pstest => sub { push @test, pop });
69 | $db->on(notification => sub { push @all, [@_[1, 3]] });
70 | $pg->pubsub->notify('pstest')->notify(pstest => 'first');
71 | is_deeply \@test, ['', '', 'first', 'first'], 'right messages';
72 | is_deeply \@all, [['pstest', ''], ['pstest', 'first']], 'right notifications';
73 | $pg->pubsub->unlisten(pstest => $first)->notify(pstest => 'second');
74 | is_deeply \@test, ['', '', 'first', 'first', 'second'], 'right messages';
75 | is_deeply \@all, [['pstest', ''], ['pstest', 'first'], ['pstest', 'second']], 'right notifications';
76 | $pg->pubsub->unlisten(pstest => $second)->notify(pstest => 'third');
77 | is_deeply \@test, ['', '', 'first', 'first', 'second'], 'right messages';
78 | is_deeply \@all, [['pstest', ''], ['pstest', 'first'], ['pstest', 'second']], 'right notifications';
79 | @all = @test = ();
80 | my $third = $pg->pubsub->listen(pstest => sub { push @test, pop });
81 | my $fourth = $pg->pubsub->listen(pstest => sub { push @test, pop });
82 | $pg->pubsub->notify(pstest => 'first');
83 | is_deeply \@test, ['first', 'first'], 'right messages';
84 | $pg->pubsub->notify(pstest => 'second');
85 | is_deeply \@test, ['first', 'first', 'second', 'second'], 'right messages';
86 | $pg->pubsub->unlisten('pstest')->notify(pstest => 'third');
87 | is_deeply \@test, ['first', 'first', 'second', 'second'], 'right messages';
88 | };
89 |
90 | subtest 'Reconnect while listening' => sub {
91 | my $pg = Mojo::Pg->new($ENV{TEST_ONLINE});
92 | my (@dbhs, @test);
93 | $pg->pubsub->on(reconnect => sub { push @dbhs, pop->dbh });
94 | $pg->pubsub->listen(pstest => sub { push @test, pop });
95 | ok $dbhs[0], 'database handle';
96 | is_deeply \@test, [], 'no messages';
97 | {
98 | local $dbhs[0]{Warn} = 0;
99 | $pg->pubsub->on(reconnect => sub { shift->notify(pstest => 'works'); Mojo::IOLoop->stop });
100 | $pg->db->query('select pg_terminate_backend(?)', $dbhs[0]{pg_pid});
101 | Mojo::IOLoop->start;
102 | ok $dbhs[1], 'database handle';
103 | isnt $dbhs[0], $dbhs[1], 'different database handles';
104 | is_deeply \@test, ['works'], 'right messages';
105 | };
106 | };
107 |
108 | subtest 'Reconnect while listening multiple retries' => sub {
109 | my $pg = Mojo::Pg->new($ENV{TEST_ONLINE});
110 | my (@dbhs, @test, @test3, @test4);
111 | $pg->pubsub->reconnect_interval(0.1);
112 | $pg->pubsub->on(reconnect => sub { push @dbhs, pop->dbh });
113 | $pg->pubsub->listen(pstest => sub { push @test, pop });
114 | $pg->pubsub->listen(pstest4 => sub { push @test4, pop });
115 | ok $dbhs[0], 'database handle';
116 | is_deeply \@test, [], 'no messages';
117 | {
118 | local $dbhs[0]{Warn} = 0;
119 | $pg->pubsub->on(
120 | reconnect => sub {
121 | shift->notify(pstest => 'works')->notify(pstest3 => 'works too')->notify(pstest4 => 'failed');
122 | Mojo::IOLoop->stop;
123 | }
124 | );
125 | my $dsn = $pg->dsn;
126 | $pg->pubsub->on(
127 | disconnect => sub {
128 | my $pubsub = shift;
129 | Mojo::IOLoop->timer(0.2 => sub { $pg->dsn($dsn) });
130 | $pubsub->listen(pstest3 => sub { push @test3, pop });
131 | $pubsub->unlisten('pstest4');
132 | }
133 | );
134 | $pg->db->query('SELECT PG_TERMINATE_BACKEND(?)', $dbhs[0]{pg_pid});
135 | $pg->dsn('dbi:Pg:badoption=1');
136 | Mojo::IOLoop->start;
137 | ok $dbhs[1], 'database handle';
138 | isnt $dbhs[0], $dbhs[1], 'different database handles';
139 | is_deeply \@test, ['works'], 'right messages';
140 | is_deeply \@test3, ['works too'], 'right messages';
141 | is_deeply \@test4, [], 'no messages';
142 | };
143 | };
144 |
145 | subtest 'Reconnect while not listening' => sub {
146 | my $pg = Mojo::Pg->new($ENV{TEST_ONLINE});
147 | my (@dbhs, @test);
148 | $pg->pubsub->on(reconnect => sub { push @dbhs, pop->dbh });
149 | $pg->pubsub->notify(pstest => 'fail');
150 | ok $dbhs[0], 'database handle';
151 | is_deeply \@test, [], 'no messages';
152 | {
153 | local $dbhs[0]{Warn} = 0;
154 | $pg->pubsub->on(reconnect => sub { Mojo::IOLoop->stop });
155 | $pg->db->query('SELECT PG_TERMINATE_BACKEND(?)', $dbhs[0]{pg_pid});
156 | Mojo::IOLoop->start;
157 | ok $dbhs[1], 'database handle';
158 | isnt $dbhs[0], $dbhs[1], 'different database handles';
159 | $pg->pubsub->listen(pstest => sub { push @test, pop });
160 | $pg->pubsub->notify(pstest => 'works too');
161 | is_deeply \@test, ['works too'], 'right messages';
162 | };
163 | };
164 |
165 | subtest 'Reset' => sub {
166 | my $pg = Mojo::Pg->new($ENV{TEST_ONLINE});
167 | my (@dbhs, @test);
168 | $pg->pubsub->on(reconnect => sub { push @dbhs, pop->dbh });
169 | $pg->pubsub->listen(pstest => sub { push @test, pop });
170 | ok $dbhs[0], 'database handle';
171 | $pg->pubsub->notify(pstest => 'first');
172 | is_deeply \@test, ['first'], 'right messages';
173 | {
174 | $pg->pubsub->reset;
175 | $pg->pubsub->notify(pstest => 'second');
176 | ok $dbhs[1], 'database handle';
177 | isnt $dbhs[0], $dbhs[1], 'different database handles';
178 | is_deeply \@test, ['first'], 'right messages';
179 | $pg->pubsub->listen(pstest => sub { push @test, pop });
180 | $pg->pubsub->notify(pstest => 'third');
181 | ok !$dbhs[2], 'no database handle';
182 | is_deeply \@test, ['first', 'third'], 'right messages';
183 | };
184 | };
185 |
186 | subtest 'Call listen/unlisten immediately after notify' => sub {
187 | my $pg = Mojo::Pg->new($ENV{TEST_ONLINE});
188 | my @test;
189 | $pg->pubsub->listen(pstest => sub { push @test, pop });
190 | $pg->db->notify(pstest => 'works');
191 | $pg->pubsub->listen(pstest2 => sub { });
192 | is_deeply \@test, ['works'], 'right messages';
193 | $pg->db->notify(pstest => 'works too');
194 | $pg->pubsub->unlisten(pstest3 => sub { });
195 | is_deeply \@test, ['works', 'works too'], 'right messages';
196 | };
197 |
198 | done_testing();
199 |
--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
1 | The Artistic License 2.0
2 |
3 | Copyright (c) 2000-2006, The Perl Foundation.
4 |
5 | Everyone is permitted to copy and distribute verbatim copies
6 | of this license document, but changing it is not allowed.
7 |
8 | Preamble
9 |
10 | This license establishes the terms under which a given free software
11 | Package may be copied, modified, distributed, and/or redistributed.
12 | The intent is that the Copyright Holder maintains some artistic
13 | control over the development of that Package while still keeping the
14 | Package available as open source and free software.
15 |
16 | You are always permitted to make arrangements wholly outside of this
17 | license directly with the Copyright Holder of a given Package. If the
18 | terms of this license do not permit the full use that you propose to
19 | make of the Package, you should contact the Copyright Holder and seek
20 | a different licensing arrangement.
21 |
22 | Definitions
23 |
24 | "Copyright Holder" means the individual(s) or organization(s)
25 | named in the copyright notice for the entire Package.
26 |
27 | "Contributor" means any party that has contributed code or other
28 | material to the Package, in accordance with the Copyright Holder's
29 | procedures.
30 |
31 | "You" and "your" means any person who would like to copy,
32 | distribute, or modify the Package.
33 |
34 | "Package" means the collection of files distributed by the
35 | Copyright Holder, and derivatives of that collection and/or of
36 | those files. A given Package may consist of either the Standard
37 | Version, or a Modified Version.
38 |
39 | "Distribute" means providing a copy of the Package or making it
40 | accessible to anyone else, or in the case of a company or
41 | organization, to others outside of your company or organization.
42 |
43 | "Distributor Fee" means any fee that you charge for Distributing
44 | this Package or providing support for this Package to another
45 | party. It does not mean licensing fees.
46 |
47 | "Standard Version" refers to the Package if it has not been
48 | modified, or has been modified only in ways explicitly requested
49 | by the Copyright Holder.
50 |
51 | "Modified Version" means the Package, if it has been changed, and
52 | such changes were not explicitly requested by the Copyright
53 | Holder.
54 |
55 | "Original License" means this Artistic License as Distributed with
56 | the Standard Version of the Package, in its current version or as
57 | it may be modified by The Perl Foundation in the future.
58 |
59 | "Source" form means the source code, documentation source, and
60 | configuration files for the Package.
61 |
62 | "Compiled" form means the compiled bytecode, object code, binary,
63 | or any other form resulting from mechanical transformation or
64 | translation of the Source form.
65 |
66 |
67 | Permission for Use and Modification Without Distribution
68 |
69 | (1) You are permitted to use the Standard Version and create and use
70 | Modified Versions for any purpose without restriction, provided that
71 | you do not Distribute the Modified Version.
72 |
73 |
74 | Permissions for Redistribution of the Standard Version
75 |
76 | (2) You may Distribute verbatim copies of the Source form of the
77 | Standard Version of this Package in any medium without restriction,
78 | either gratis or for a Distributor Fee, provided that you duplicate
79 | all of the original copyright notices and associated disclaimers. At
80 | your discretion, such verbatim copies may or may not include a
81 | Compiled form of the Package.
82 |
83 | (3) You may apply any bug fixes, portability changes, and other
84 | modifications made available from the Copyright Holder. The resulting
85 | Package will still be considered the Standard Version, and as such
86 | will be subject to the Original License.
87 |
88 |
89 | Distribution of Modified Versions of the Package as Source
90 |
91 | (4) You may Distribute your Modified Version as Source (either gratis
92 | or for a Distributor Fee, and with or without a Compiled form of the
93 | Modified Version) provided that you clearly document how it differs
94 | from the Standard Version, including, but not limited to, documenting
95 | any non-standard features, executables, or modules, and provided that
96 | you do at least ONE of the following:
97 |
98 | (a) make the Modified Version available to the Copyright Holder
99 | of the Standard Version, under the Original License, so that the
100 | Copyright Holder may include your modifications in the Standard
101 | Version.
102 |
103 | (b) ensure that installation of your Modified Version does not
104 | prevent the user installing or running the Standard Version. In
105 | addition, the Modified Version must bear a name that is different
106 | from the name of the Standard Version.
107 |
108 | (c) allow anyone who receives a copy of the Modified Version to
109 | make the Source form of the Modified Version available to others
110 | under
111 |
112 | (i) the Original License or
113 |
114 | (ii) a license that permits the licensee to freely copy,
115 | modify and redistribute the Modified Version using the same
116 | licensing terms that apply to the copy that the licensee
117 | received, and requires that the Source form of the Modified
118 | Version, and of any works derived from it, be made freely
119 | available in that license fees are prohibited but Distributor
120 | Fees are allowed.
121 |
122 |
123 | Distribution of Compiled Forms of the Standard Version
124 | or Modified Versions without the Source
125 |
126 | (5) You may Distribute Compiled forms of the Standard Version without
127 | the Source, provided that you include complete instructions on how to
128 | get the Source of the Standard Version. Such instructions must be
129 | valid at the time of your distribution. If these instructions, at any
130 | time while you are carrying out such distribution, become invalid, you
131 | must provide new instructions on demand or cease further distribution.
132 | If you provide valid instructions or cease distribution within thirty
133 | days after you become aware that the instructions are invalid, then
134 | you do not forfeit any of your rights under this license.
135 |
136 | (6) You may Distribute a Modified Version in Compiled form without
137 | the Source, provided that you comply with Section 4 with respect to
138 | the Source of the Modified Version.
139 |
140 |
141 | Aggregating or Linking the Package
142 |
143 | (7) You may aggregate the Package (either the Standard Version or
144 | Modified Version) with other packages and Distribute the resulting
145 | aggregation provided that you do not charge a licensing fee for the
146 | Package. Distributor Fees are permitted, and licensing fees for other
147 | components in the aggregation are permitted. The terms of this license
148 | apply to the use and Distribution of the Standard or Modified Versions
149 | as included in the aggregation.
150 |
151 | (8) You are permitted to link Modified and Standard Versions with
152 | other works, to embed the Package in a larger work of your own, or to
153 | build stand-alone binary or bytecode versions of applications that
154 | include the Package, and Distribute the result without restriction,
155 | provided the result does not expose a direct interface to the Package.
156 |
157 |
158 | Items That are Not Considered Part of a Modified Version
159 |
160 | (9) Works (including, but not limited to, modules and scripts) that
161 | merely extend or make use of the Package, do not, by themselves, cause
162 | the Package to be a Modified Version. In addition, such works are not
163 | considered parts of the Package itself, and are not subject to the
164 | terms of this license.
165 |
166 |
167 | General Provisions
168 |
169 | (10) Any use, modification, and distribution of the Standard or
170 | Modified Versions is governed by this Artistic License. By using,
171 | modifying or distributing the Package, you accept this license. Do not
172 | use, modify, or distribute the Package, if you do not accept this
173 | license.
174 |
175 | (11) If your Modified Version has been derived from a Modified
176 | Version made by someone other than you, you are nevertheless required
177 | to ensure that your Modified Version complies with the requirements of
178 | this license.
179 |
180 | (12) This license does not grant you the right to use any trademark,
181 | service mark, tradename, or logo of the Copyright Holder.
182 |
183 | (13) This license includes the non-exclusive, worldwide,
184 | free-of-charge patent license to make, have made, use, offer to sell,
185 | sell, import and otherwise transfer the Package with respect to any
186 | patent claims licensable by the Copyright Holder that are necessarily
187 | infringed by the Package. If you institute patent litigation
188 | (including a cross-claim or counterclaim) against any party alleging
189 | that the Package constitutes direct or contributory patent
190 | infringement, then this Artistic License to you shall terminate on the
191 | date that such litigation is filed.
192 |
193 | (14) Disclaimer of Warranty:
194 | THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS
195 | IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED
196 | WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR
197 | NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL
198 | LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL
199 | BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL
200 | DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF
201 | ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
202 |
--------------------------------------------------------------------------------
/t/migrations.t:
--------------------------------------------------------------------------------
1 | use Mojo::Base -strict;
2 |
3 | BEGIN { $ENV{MOJO_REACTOR} = 'Mojo::Reactor::Poll' }
4 |
5 | use Test::More;
6 |
7 | plan skip_all => 'set TEST_ONLINE to enable this test' unless $ENV{TEST_ONLINE};
8 |
9 | use Mojo::File qw(curfile);
10 | use Mojo::Pg;
11 |
12 | # Isolate tests
13 | my $pg = Mojo::Pg->new($ENV{TEST_ONLINE})->search_path(['mojo_migrations_test']);
14 | $pg->db->query('DROP SCHEMA IF EXISTS mojo_migrations_test CASCADE');
15 | $pg->db->query('CREATE SCHEMA mojo_migrations_test');
16 |
17 | subtest 'Defaults' => sub {
18 | is $pg->migrations->name, 'migrations', 'right name';
19 | is $pg->migrations->latest, 0, 'latest version is 0';
20 | is $pg->migrations->active, 0, 'active version is 0';
21 | };
22 |
23 | subtest 'Create migrations table' => sub {
24 | ok !(grep {/^mojo_migrations_test\.mojo_migrations$/} @{$pg->db->tables}), 'migrations table does not exist';
25 | is $pg->migrations->migrate->active, 0, 'active version is 0';
26 | ok !(grep {/^mojo_migrations_test\.mojo_migrations$/} @{$pg->db->tables}), 'migrations table does not exist';
27 | is $pg->migrations->from_string("-- 1 up\n\n")->migrate->active, 1, 'active version is 1';
28 | ok !!(grep {/^mojo_migrations_test\.mojo_migrations$/} @{$pg->db->tables}), 'migrations table exists';
29 | is $pg->migrations->migrate(0)->active, 0, 'active version is 0';
30 | };
31 |
32 | subtest 'Migrations from DATA section' => sub {
33 | is $pg->migrations->from_data->latest, 0, 'latest version is 0';
34 | is $pg->migrations->from_data(__PACKAGE__)->latest, 0, 'latest version is 0';
35 | is $pg->migrations->name('test1')->from_data->latest, 10, 'latest version is 10';
36 | is $pg->migrations->name('test2')->from_data->latest, 2, 'latest version is 2';
37 | is $pg->migrations->name('migrations')->from_data(__PACKAGE__, 'test1')->latest, 10, 'latest version is 10';
38 | is $pg->migrations->name('test2')->from_data(__PACKAGE__)->latest, 2, 'latest version is 2';
39 | };
40 |
41 | subtest 'Different syntax variations' => sub {
42 | $pg->migrations->name('migrations_test')->from_string(<migrations->latest, 10, 'latest version is 10';
69 | is $pg->migrations->active, 0, 'active version is 0';
70 | is $pg->migrations->migrate->active, 10, 'active version is 10';
71 | ok !!(grep {/^mojo_migrations_test\.migration_test_one$/} @{$pg->db->tables}), 'first table exists';
72 | ok !!(grep {/^mojo_migrations_test\.migration_test_two$/} @{$pg->db->tables}), 'second table exists';
73 | is_deeply $pg->db->query('SELECT * FROM migration_test_one')->hash, {foo => 'works ♥'}, 'right structure';
74 | is $pg->migrations->migrate->active, 10, 'active version is 10';
75 | is $pg->migrations->migrate(1)->active, 1, 'active version is 1';
76 | is $pg->db->query('SELECT * FROM migration_test_one')->hash, undef, 'no result';
77 | is $pg->migrations->migrate(3)->active, 3, 'active version is 3';
78 | is $pg->db->query('SELECT * FROM migration_test_two')->hash, undef, 'no result';
79 | is $pg->migrations->migrate->active, 10, 'active version is 10';
80 | is_deeply $pg->db->query('SELECT * FROM migration_test_two')->hash, {bar => 'works too'}, 'right structure';
81 | is $pg->migrations->migrate(0)->active, 0, 'active version is 0';
82 | };
83 |
84 | subtest 'Bad and concurrent migrations' => sub {
85 | my $pg2 = Mojo::Pg->new($ENV{TEST_ONLINE})->search_path(['mojo_migrations_test']);
86 | $pg2->migrations->name('migrations_test2')->from_file(curfile->sibling('migrations', 'test.sql'));
87 | is $pg2->migrations->latest, 4, 'latest version is 4';
88 | is $pg2->migrations->active, 0, 'active version is 0';
89 | eval { $pg2->migrations->migrate };
90 | like $@, qr/does_not_exist/, 'right error';
91 | is $pg2->migrations->migrate(3)->active, 3, 'active version is 3';
92 | is $pg2->migrations->migrate(2)->active, 2, 'active version is 2';
93 | is $pg->migrations->active, 0, 'active version is still 0';
94 | is $pg->migrations->migrate->active, 10, 'active version is 10';
95 | is_deeply $pg2->db->query('select * from migration_test_three')->hashes->to_array,
96 | [{baz => 'just'}, {baz => 'works ♥'}], 'right structure';
97 | is $pg->migrations->migrate(0)->active, 0, 'active version is 0';
98 | is $pg2->migrations->migrate(0)->active, 0, 'active version is 0';
99 | };
100 |
101 | subtest 'Migrate automatically' => sub {
102 | my $pg3 = Mojo::Pg->new($ENV{TEST_ONLINE})->search_path(['mojo_migrations_test']);
103 | $pg3->migrations->name('migrations_test')->from_string(<auto_migrate(1)->db;
114 | is $pg3->migrations->active, 6, 'active version is 6';
115 | is_deeply $pg3->db->query('SELECT * FROM migration_test_six')->hashes, [{foo => 'works!'}], 'right structure';
116 | is $pg3->migrations->migrate(5)->active, 5, 'active version is 5';
117 | is_deeply $pg3->db->query('SELECT * FROM migration_test_six')->hashes, [], 'right structure';
118 | is $pg3->migrations->migrate(0)->active, 0, 'active version is 0';
119 | is $pg3->migrations->sql_for(0, 5), <migrations->sql_for(6, 0), <migrations->sql_for(6, 5), <migrations->sql_for(6, 6), '', 'right SQL';
134 | is $pg3->migrations->sql_for(2, 3), '', 'right SQL';
135 | };
136 |
137 | subtest 'Migrate automatically with shared connection cache' => sub {
138 | my $pg4 = Mojo::Pg->new($ENV{TEST_ONLINE})->search_path(['mojo_migrations_test']);
139 | my $pg5 = Mojo::Pg->new($pg4);
140 | $pg4->auto_migrate(1)->migrations->name('test1')->from_data;
141 | $pg5->auto_migrate(1)->migrations->name('test3')->from_data;
142 | is_deeply $pg5->db->query('SELECT * FROM migration_test_four')->hashes->to_array, [{test => 10}], 'right structure';
143 | is_deeply $pg5->db->query('SELECT * FROM migration_test_six')->hashes->to_array, [], 'right structure';
144 | };
145 |
146 | subtest 'Unknown version' => sub {
147 | eval { $pg->migrations->migrate(23) };
148 | like $@, qr/Version 23 has no migration/, 'right error';
149 | };
150 |
151 | subtest 'Version mismatch' => sub {
152 | my $newer = <migrations->name('migrations_test3')->from_string($newer);
159 | is $pg->migrations->migrate->active, 2, 'active version is 2';
160 | $pg->migrations->from_string(<migrations->migrate };
165 | like $@, qr/Active version 2 is greater than the latest version 1/, 'right error';
166 | eval { $pg->migrations->migrate(0) };
167 | like $@, qr/Active version 2 is greater than the latest version 1/, 'right error';
168 | is $pg->migrations->from_string($newer)->migrate(0)->active, 0, 'active version is 0';
169 | };
170 |
171 | subtest 'Migration directory' => sub {
172 | my $pg = Mojo::Pg->new($ENV{TEST_ONLINE})->search_path(['mojo_migrations_test']);
173 | $pg->migrations->name('directory tree')->from_dir(curfile->sibling('migrations', 'tree'));
174 | is $pg->migrations->migrate(0)->migrate(2)->active, 2, 'migrate table with unicode';
175 | is_deeply $pg->db->query('SELECT * FROM migration_test_three')->hashes, [{baz => 'just'}, {baz => 'works ♥'}],
176 | 'right structure';
177 |
178 | eval { $pg->migrations->migrate(36) };
179 | like $@, qr/^Version 36 has no migration/, 'empty file has no version';
180 | eval { $pg->migrations->migrate(54) };
181 | like $@, qr/^Version 54 has no migration/, 'sparse directory has no version';
182 | eval { $pg->migrations->migrate(55) };
183 | like $@, qr/^Version 55 has no migration/, 'upgrade.sql is not up.sql, so no version';
184 |
185 | is $pg->migrations->migrate->active, 99, 'active version is 99';
186 | is $pg->migrations->latest, 99, 'latest version is 99';
187 | ok !!(grep {/^mojo_migrations_test\.migration_test_luft_balloons$/} @{$pg->db->tables}), 'last table exists';
188 |
189 | $pg->migrations->name('directory tree')->from_dir(curfile->sibling('migrations', 'tree2'));
190 | is $pg->migrations->latest, 8, 'latest version is 8';
191 |
192 | is $pg->migrations->name('directory tree')->from_dir(curfile->sibling('migrations', 'tree3'))->latest, 0,
193 | 'latest version is 0';
194 | };
195 |
196 | # Clean up once we are done
197 | $pg->db->query('DROP SCHEMA mojo_migrations_test CASCADE');
198 |
199 | done_testing();
200 |
201 | __DATA__
202 | @@ test1
203 | -- 7 up
204 | CREATE TABLE migration_test_four (test INT);
205 |
206 | -- 10 up
207 | INSERT INTO migration_test_four VALUES (10);
208 |
209 | @@ test2
210 | -- 2 up
211 | CREATE TABLE migration_test_five (test INT);
212 |
213 | @@ test3
214 | -- 2 up
215 | CREATE TABLE migration_test_six (test INT);
216 |
--------------------------------------------------------------------------------
/Changes:
--------------------------------------------------------------------------------
1 |
2 | 4.29 2025-08-30
3 |
4 | 4.28 2025-08-29
5 | - Fixed DBD:Pg bug with a workaround (https://github.com/bucardo/dbdpg/issues/105). (TFBW)
6 |
7 | 4.27 2022-03-10
8 | - Fixed a race condition in Mojo::Pg::Migrations that could result in two processes trying to create the same
9 | migration.
10 |
11 | 4.26 2021-09-08
12 | - Fixed a bug in Mojo::Pg::PubSub would sometimes miss notifications. (akarelas)
13 |
14 | 4.25 2021-02-20
15 | - Moved SQL::Abstract::Pg into a separate distribution.
16 |
17 | 4.24 2021-01-27
18 | - Fixed Mojolicious 8.72 support.
19 |
20 | 4.23 2020-12-20
21 | - Updated examples to use signatures.
22 | - Improved Mojo::Pg::PubSub to handle unknown notifications more gracefully.
23 |
24 | 4.22 2020-11-06
25 | - Added from_dir method to Mojo::Pg::Migrations. (kiwiroy)
26 | - Improved Mojo::Pg::Database to handle connection errors more gracefully.
27 |
28 | 4.21 2020-10-25
29 | - Added reset method to Mojo::Pg.
30 | - Changed SQL style to use uppercase keywords.
31 |
32 | 4.20 2020-10-01
33 | - Fixed fork-safety feature to work with more than one fork.
34 |
35 | 4.19 2020-05-30
36 | - Improved .perltidyrc with more modern settings.
37 | - Fixed validation problem in blog example.
38 |
39 | 4.18 2020-01-30
40 | - Improved support for -json values to be a little more consistent.
41 |
42 | 4.17 2019-10-07
43 | - Reverted connection cache optimization from 4.14, because it caused problems with some connections closed by the
44 | PostgreSQL server.
45 | - Updated mojo_migrations table created by Mojo::Pg::Migrations to use a primary key.
46 |
47 | 4.16 2019-09-04
48 | - Updated DBD::Pg requirement to 3.7.4 due to certain JSON features not working with older versions.
49 |
50 | 4.15 2019-07-24
51 | - Improved compatibility with older versions of DBI.
52 |
53 | 4.14 2019-07-22
54 | - Improved connection cache to be more than an order of magnitude faster for blocking queries.
55 | - Fixed a bug in Mojo::Pg::PubSub where listen/unlisten did not work while reconnecting.
56 |
57 | 4.13 2019-01-20
58 | - Added support for multi-column joins to SQL::Abstract::Pg. (rsindlin)
59 |
60 | 4.12 2018-11-24
61 | - Added reconnect_interval attribute to Mojo::Pg::PubSub. (jberger)
62 | - Added db method to Mojo::Pg::PubSub. (jberger)
63 | - Fixed reconnect logic in Mojo::Pg::PubSub. (jberger)
64 |
65 | 4.11 2018-10-18
66 | - Improved various attributes to use new Mojolicious 8.03 features to avoid memory leaks.
67 |
68 | 4.10 2018-09-15
69 | - Updated project metadata.
70 |
71 | 4.09 2018-08-02
72 | - Added support for -json unary op to SQL::Abstract::Pg.
73 | - Added support for multi-column unique constraints in upserts to SQL::Abstract::Pg.
74 | - Added support for literal SQL with bind values in select fields to SQL::Abstract::Pg.
75 |
76 | 4.08 2018-01-29
77 | - Improved on_conflict option of insert and insert_p methods in Mojo::Pg::Database with a shortcut for simple conflict
78 | targets.
79 |
80 | 4.07 2018-01-28
81 | - Added support for "JOIN" to select and select_p methods in Mojo::Pg::Database.
82 | - Added support for field aliases to select and select_p methods in Mojo::Pg::Database.
83 | - Added support for having option to select and select_p methods in Mojo::Pg::Database.
84 | - Improved on_conflict option of insert and insert_p methods in Mojo::Pg::Database with shortcuts for
85 | "ON CONFLICT DO UPDATE SET" and "ON CONFLICT DO NOTHING".
86 | - Improved for option of select and select_p methods in Mojo::Pg::Database with a shortcut for "FOR UPDATE".
87 |
88 | 4.06 2018-01-27
89 | - Added support for on_conflict option to insert and insert_p methods in Mojo::Pg::Database.
90 | - Updated SQL::Abstract requirement to 1.84.
91 | - Improved error messages generated by SQL::Abstract::Pg to be compatible with SQL::Abstract.
92 |
93 | 4.05 2018-01-26
94 | - Added support for for, group_by, limit, offset and order_by options to select and select_p methods in
95 | Mojo::Pg::Database.
96 | - Added module SQL::Abstract::Pg.
97 |
98 | 4.04 2017-12-16
99 | - Added db attribute to Mojo::Pg::Results.
100 | - Added sql_for method to Mojo::Pg::Migrations.
101 | - Fixed a bug that could cause connections to be cached for reuse too early.
102 |
103 | 4.03 2017-11-04
104 | - Improved Mojo::Pg::Database to use Mojo::Promise.
105 |
106 | 4.02 2017-11-02
107 | - Added delete_p, insert_p, query_p, select_p and update_p methods to Mojo::Pg::Database.
108 |
109 | 4.01 2017-07-20
110 | - Decreased default max_connections from 5 to 1 in Mojo::Pg.
111 |
112 | 4.0 2017-07-06
113 | - Added support for sharing the database connection cache between multiple Mojo::Pg objects.
114 | - Added parent attribute to Mojo::Pg.
115 | - Fixed a bug where automatic migrations would leak database connections.
116 |
117 | 3.06 2017-06-01
118 | - Updated example application with tests.
119 | - Improved Mojo::Pg to be a little less noisy by deactivating PrintWarn by default.
120 |
121 | 3.05 2017-03-12
122 | - Improved from_string method in Mojo::Pg with search_path support.
123 |
124 | 3.04 2017-03-08
125 | - Fixed array reference handling in queries generated with SQL::Abstract.
126 |
127 | 3.03 2017-03-07
128 | - Added reset method to Mojo::Pg::PubSub.
129 |
130 | 3.02 2017-02-18
131 | - Fixed quoting bugs in queries generated with SQL::Abstract.
132 |
133 | 3.01 2017-02-12
134 | - Fixed bug in examples where migrations would not be handled correctly.
135 |
136 | 3.0 2017-02-11
137 | - Added support for generating queries with SQL::Abstract.
138 | - Added abstract attribute to Mojo::Pg.
139 | - Added delete, insert, select and update methods to Mojo::Pg::Database.
140 |
141 | 2.35 2017-01-11
142 | - Updated for Mojolicious 7.15.
143 |
144 | 2.34 2017-01-02
145 | - Removed with_temp_schema method from Mojo::Pg.
146 |
147 | 2.33 2017-01-01
148 | - Fixed a few fork-safety bugs in Mojo::Pg.
149 |
150 | 2.32 2017-01-01
151 | - Added with_temp_schema method to Mojo::Pg.
152 |
153 | 2.31 2016-10-09
154 | - Improved from_string method in Mojo::Pg to accept the "postgres://" scheme as well. (polettix)
155 | - Improved examples to use new Mojolicious 7.12 features.
156 |
157 | 2.30 2016-09-02
158 | - Improved query method in Mojo::Pg::Database to allow binding of specific DBD::Pg data types to placeholders.
159 |
160 | 2.29 2016-08-10
161 | - Added database_class attribute to Mojo::Pg.
162 | - Added results_class attribute to Mojo::Pg::Database.
163 | - Fixed a few fork-safety bugs and memory leaks in Mojo::Pg::PubSub.
164 |
165 | 2.28 2016-06-14
166 | - Updated for Mojolicious 6.65.
167 |
168 | 2.27 2016-05-21
169 | - Improved query method in Mojo::Pg::Database to include caller information in error messages.
170 |
171 | 2.26 2016-04-25
172 | - Improved expand performance slightly.
173 |
174 | 2.25 2016-03-26
175 | - Added support for encoding and decoding of JSON notifications.
176 | - Added json method to Mojo::Pg::PubSub.
177 |
178 | 2.24 2016-03-23
179 | - Fixed copyright notice.
180 |
181 | 2.23 2016-02-13
182 | - Improved tables method in Mojo::Pg::Database to list all tables and views that are visible to the current user and
183 | not internal.
184 |
185 | 2.22 2016-02-13
186 | - Fixed bug where views would be included in the list of table names.
187 |
188 | 2.21 2016-02-13
189 | - Added tables method to Mojo::Pg::Database.
190 |
191 | 2.20 2016-02-12
192 | - Fixed schema bugs in tests.
193 |
194 | 2.19 2016-02-12
195 | - Improved tests to use custom schemas.
196 |
197 | 2.18 2016-01-23
198 | - Added auto_migrate attribute to Mojo::Pg.
199 | - Updated example applications.
200 |
201 | 2.17 2016-01-03
202 | - Updated links to Mojolicious website.
203 |
204 | 2.16 2015-11-25
205 | - Added finish method to Mojo::Pg::Results.
206 |
207 | 2.15 2015-10-30
208 | - Improved Mojo::Pg::Migrations to detect if the currently active version is greater than the latest version.
209 |
210 | 2.14 2015-10-25
211 | - Improved unlisten method in Mojo::Pg::PubSub with support for removing all subscribers of a channel at once.
212 |
213 | 2.13 2015-10-23
214 | - Added search_path attribute to Mojo::Pg.
215 |
216 | 2.12 2015-10-05
217 | - Updated example applications.
218 |
219 | 2.11 2015-09-29
220 | - Improved notification performance slightly.
221 |
222 | 2.10 2015-09-16
223 | - Updated DBD::Pg requirement to 3.5.1 due to certain JSON features not working with older versions.
224 |
225 | 2.09 2015-08-29
226 | - Fixed Makefile.PL to be compliant with version 2 of the CPAN distribution metadata specification.
227 |
228 | 2.08 2015-08-14
229 | - Improved support for long-lived Mojo::Pg::Results objects. (Grinnz, sri)
230 |
231 | 2.07 2015-06-17
232 | - Fixed a few JSON encoding and decoding issues.
233 |
234 | 2.06 2015-06-07
235 | - Fixed bug in Mojo::Pg::Database where sequential non-blocking queries would not work correctly.
236 |
237 | 2.05 2015-04-06
238 | - Fixed bug in Mojo::Pg::Migrations where migrations would sometimes be executed in the wrong order.
239 |
240 | 2.04 2015-04-05
241 | - Fixed bug in Mojo::Pg::Migrations where the latest version could not always be determined correctly. (Hernan Lopes)
242 |
243 | 2.03 2015-04-02
244 | - Updated example applications.
245 |
246 | 2.02 2015-03-30
247 | - Improved fork-safety of Mojo::Pg::PubSub.
248 |
249 | 2.01 2015-03-25
250 | - Fixed bug where Perl would close the DBD::Pg file descriptor unexpectedly.
251 |
252 | 2.0 2015-03-25
253 | - Removed support for sequential non-blocking queries, because they are currently incompatible with DBD::Pg.
254 | - Removed max_statements attribute from Mojo::Pg.
255 | - Removed db attribute from Mojo::Pg::Results.
256 | - Removed backlog method from Mojo::Pg::Database.
257 | - Removed deprecated do method from Mojo::Pg::Database.
258 | - Improved performance by using prepare_cached from DBI to cache statement handles.
259 |
260 | 1.17 2015-03-20
261 | - Improved Mojo::Pg::Migrations to make no changes to the database when checking the currently active version.
262 |
263 | 1.16 2015-03-18
264 | - Added max_statements attribute to Mojo::Pg.
265 | - Added db attribute to Mojo::Pg::Results.
266 | - Improved performance for many different queries significantly with a statement handle cache.
267 |
268 | 1.15 2015-03-17
269 | - Improved portability of some tests.
270 |
271 | 1.14 2015-03-12
272 | - Fixed bug where non-blocking queries could get lost after the database connection got closed unexpectedly.
273 |
274 | 1.13 2015-03-11
275 | - Improved notify performance significantly.
276 |
277 | 1.12 2015-03-09
278 | - Fixed Mojo::Pg::Migrations to handle UTF-8 encoded files correctly.
279 |
280 | 1.11 2015-03-04
281 | - Removed experimental status from Mojo::Pg::PubSub.
282 | - Removed experimental status from pubsub attribute in Mojo::Pg.
283 |
284 | 1.10 2015-02-20
285 | - Updated for Mojolicious 5.81.
286 |
287 | 1.09 2015-02-15
288 | - Added EXPERIMENTAL module Mojo::Pg::PubSub.
289 | - Added EXPERIMENTAL pubsub attribute to Mojo::Pg.
290 | - Improved fork-safety by activating AutoInactiveDestroy by default.
291 |
292 | 1.08 2015-02-12
293 | - Deprecated Mojo::Pg::Database::do in favor of Mojo::Pg::Database::query.
294 |
295 | 1.07 2015-01-03
296 | - Added support for encoding and decoding of JSON values.
297 | - Added expand method to Mojo::Pg::Results.
298 |
299 | 1.06 2014-12-28
300 | - Added dollar_only method to Mojo::Pg::Database.
301 |
302 | 1.05 2014-12-27
303 | - Improved Mojo::Pg::Migrations to create a mojo_migrations table with stricter constraints.
304 |
305 | 1.04 2014-12-22
306 | - Improved all methods not to use question marks in queries.
307 |
308 | 1.03 2014-12-21
309 | - Fixed bug where Perl would close the DBD::Pg file descriptor after it had been used with the event loop.
310 |
311 | 1.02 2014-11-22
312 | - Improved performance for many different queries significantly by deactivating pg_server_prepare by default.
313 |
314 | 1.01 2014-11-20
315 | - Improved documentation.
316 |
317 | 1.0 2014-11-19
318 | - Removed experimental status from distribution.
319 |
320 | 0.11 2014-11-13
321 | - Added pid method to Mojo::Pg::Database.
322 | - Added close event to Mojo::Pg::Database.
323 |
324 | 0.10 2014-11-12
325 | - Removed dbh attribute from Mojo::Pg::Transaction.
326 | - Added db attribute to Mojo::Pg::Transaction.
327 | - Fixed bug where notifications did not get delivered immediately to the process that sent them.
328 |
329 | 0.09 2014-11-02
330 | - Updated Mojolicious requirement to 5.57.
331 |
332 | 0.08 2014-10-13
333 | - Changed default data source name in Mojo::Pg to allow more DBD::Pg environment variables to work correctly.
334 | - Improved Mojo::Pg to allow service names in connection strings.
335 |
336 | 0.07 2014-10-13
337 | - Removed commit and rollback methods from Mojo::Pg::Database.
338 | - Added Mojo::Pg::Transaction.
339 | - Added connection event to Mojo::Pg.
340 |
341 | 0.06 2014-10-12
342 | - Added notify method to Mojo::Pg::Database.
343 |
344 | 0.05 2014-10-11
345 | - Updated Mojolicious requirement to 5.49 to ensure migrations in the DATA section are not served as static files.
346 |
347 | 0.04 2014-10-10
348 | - Added support for migrations.
349 | - Added Mojo::Pg::Migrations.
350 | - Added migrations attribute to Mojo::Pg.
351 |
352 | 0.03 2014-10-06
353 | - Improved non-blocking queries to be able to introspect the statement handle.
354 |
355 | 0.02 2014-10-03
356 | - Added support for PostgreSQL connection strings.
357 | - Added from_string method to Mojo::Pg.
358 |
359 | 0.01 2014-10-03
360 | - First release.
361 |
--------------------------------------------------------------------------------
/t/database.t:
--------------------------------------------------------------------------------
1 | use Mojo::Base -strict;
2 |
3 | BEGIN { $ENV{MOJO_REACTOR} = 'Mojo::Reactor::Poll' }
4 |
5 | use Test::More;
6 |
7 | plan skip_all => 'set TEST_ONLINE to enable this test' unless $ENV{TEST_ONLINE};
8 |
9 | use Mojo::IOLoop;
10 | use Mojo::JSON qw(true);
11 | use Mojo::Pg;
12 | use Mojo::Promise;
13 | use Scalar::Util qw(refaddr);
14 |
15 | my $pg = Mojo::Pg->new($ENV{TEST_ONLINE});
16 |
17 | subtest 'Connected' => sub {
18 | ok $pg->db->ping, 'connected';
19 | };
20 |
21 | subtest 'Custom search_path' => sub {
22 | $pg = Mojo::Pg->new($ENV{TEST_ONLINE})->search_path(['$user', 'foo', 'bar']);
23 | is_deeply $pg->db->query('SHOW search_path')->hash, {search_path => '"$user", foo, bar'}, 'right structure';
24 | $pg = Mojo::Pg->new($ENV{TEST_ONLINE});
25 | };
26 |
27 | subtest 'Blocking select' => sub {
28 | is_deeply $pg->db->query('SELECT 1 AS one, 2 AS two, 3 AS three')->hash, {one => 1, two => 2, three => 3},
29 | 'right structure';
30 | };
31 |
32 | subtest 'Non-blocking select' => sub {
33 | my ($fail, $result);
34 | my $same;
35 | my $db = $pg->db;
36 | $db->query(
37 | 'SELECT 1 AS one, 2 AS two, 3 AS three' => sub {
38 | my ($db, $err, $results) = @_;
39 | $fail = $err;
40 | $result = $results->hash;
41 | $same = $db->dbh eq $results->db->dbh;
42 | Mojo::IOLoop->stop;
43 | }
44 | );
45 | Mojo::IOLoop->start;
46 | ok $same, 'same database handles';
47 | ok !$fail, 'no error';
48 | is_deeply $result, {one => 1, two => 2, three => 3}, 'right structure';
49 | };
50 |
51 | subtest 'Concurrent non-blocking selects' => sub {
52 | my ($fail, $result);
53 | Mojo::Promise->all(
54 | $pg->db->query_p('SELECT 1 AS one'),
55 | $pg->db->query_p('SELECT 2 AS two'),
56 | $pg->db->query_p('SELECT 2 AS two')
57 | )->then(sub {
58 | my ($one, $two, $three) = @_;
59 | $result = [$one->[0]->hashes->first, $two->[0]->hashes->first, $three->[0]->hashes->first];
60 | })->catch(sub { $fail = shift })->wait;
61 | ok !$fail, 'no error';
62 | is_deeply $result, [{one => 1}, {two => 2}, {two => 2}], 'right structure';
63 | };
64 |
65 | subtest 'Sequential non-blocking selects' => sub {
66 | my ($fail, $result);
67 | my $db = $pg->db;
68 | $db->query_p('SELECT 1 AS one')->then(sub {
69 | push @$result, shift->hashes->first;
70 | return $db->query_p('SELECT 1 AS one');
71 | })->then(sub {
72 | push @$result, shift->hashes->first;
73 | return $db->query_p('SELECT 2 AS two');
74 | })->then(sub {
75 | push @$result, shift->hashes->first;
76 | })->catch(sub { $fail = shift })->wait;
77 | ok !$fail, 'no error';
78 | is_deeply $result, [{one => 1}, {one => 1}, {two => 2}], 'right structure';
79 | };
80 |
81 | subtest 'Connection cache' => sub {
82 | is $pg->max_connections, 1, 'right default';
83 | $pg->max_connections(5);
84 | my @dbhs = map { refaddr $_->dbh } $pg->db, $pg->db, $pg->db, $pg->db, $pg->db;
85 | is_deeply \@dbhs, [reverse map { refaddr $_->dbh } $pg->db, $pg->db, $pg->db, $pg->db, $pg->db],
86 | 'same database handles';
87 | @dbhs = ();
88 | my $dbh = $pg->max_connections(1)->db->dbh;
89 | is $pg->db->dbh, $dbh, 'same database handle';
90 | isnt $pg->db->dbh, $pg->db->dbh, 'different database handles';
91 | is $pg->db->dbh, $dbh, 'different database handles';
92 | $dbh = $pg->db->dbh;
93 | is $pg->db->dbh, $dbh, 'same database handle';
94 | $pg->db->disconnect;
95 | isnt $pg->db->dbh, $dbh, 'different database handles';
96 | };
97 |
98 | subtest 'Statement cache' => sub {
99 | my $db = $pg->db;
100 | my $sth = $db->query('SELECT 3 AS three')->sth;
101 | is $db->query('SELECT 3 AS three')->sth, $sth, 'same statement handle';
102 | isnt $db->query('SELECT 4 AS four')->sth, $sth, 'different statement handles';
103 | is $db->query('SELECT 3 AS three')->sth, $sth, 'same statement handle';
104 | undef $db;
105 | $db = $pg->db;
106 | my $results = $db->query('SELECT 3 AS three');
107 | is $results->sth, $sth, 'same statement handle';
108 | isnt $db->query('SELECT 3 AS three')->sth, $sth, 'different statement handles';
109 | $sth = $db->query('SELECT 3 AS three')->sth;
110 | is $db->query('SELECT 3 AS three')->sth, $sth, 'same statement handle';
111 | isnt $db->query('SELECT 5 AS five')->sth, $sth, 'different statement handles';
112 | isnt $db->query('SELECT 6 AS six')->sth, $sth, 'different statement handles';
113 | is $db->query('SELECT 3 AS three')->sth, $sth, 'same statement handle';
114 | };
115 |
116 | subtest 'Connection reuse' => sub {
117 | my $db = $pg->db;
118 | my $dbh = $db->dbh;
119 | my $results = $db->query('select 1');
120 | undef $db;
121 | my $db2 = $pg->db;
122 | isnt $db2->dbh, $dbh, 'new database handle';
123 | undef $results;
124 | my $db3 = $pg->db;
125 | is $db3->dbh, $dbh, 'same database handle';
126 | $results = $db3->query('SELECT 2');
127 | is $results->db->dbh, $dbh, 'same database handle';
128 | is $results->array->[0], 2, 'right result';
129 | };
130 |
131 | subtest 'Dollar only' => sub {
132 | my $db = $pg->db;
133 | is $db->dollar_only->query('SELECT $1::INT AS test', 23)->hash->{test}, 23, 'right result';
134 | eval { $db->dollar_only->query('SELECT ?::INT AS test', 23) };
135 | like $@, qr/Statement has no placeholders to bind/, 'right error';
136 | is $db->query('SELECT ?::INT AS test', 23)->hash->{test}, 23, 'right result';
137 | };
138 |
139 | subtest 'JSON' => sub {
140 | my $db = $pg->db;
141 | is_deeply $db->query('SELECT ?::JSON AS foo', {json => {bar => 'baz'}})->expand->hash, {foo => {bar => 'baz'}},
142 | 'right structure';
143 | is_deeply $db->query('SELECT ?::JSONB AS foo', {json => {bar => 'baz'}})->expand->hash, {foo => {bar => 'baz'}},
144 | 'right structure';
145 | is_deeply $db->query('SELECT ?::JSON AS foo', {json => {bar => 'baz'}})->expand->array, [{bar => 'baz'}],
146 | 'right structure';
147 | is_deeply $db->query('SELECT ?::JSON AS foo', {json => {bar => 'baz'}})->expand->hashes->first,
148 | {foo => {bar => 'baz'}}, 'right structure';
149 | is_deeply $db->query('SELECT ?::JSON AS foo', {json => {bar => 'baz'}})->expand->arrays->first, [{bar => 'baz'}],
150 | 'right structure';
151 | is_deeply $db->query('SELECT ?::JSON AS foo', {json => {bar => 'baz'}})->hash, {foo => '{"bar":"baz"}'},
152 | 'right structure';
153 | is_deeply $db->query('SELECT ?::JSON AS foo', {json => \1})->expand->hashes->first, {foo => true}, 'right structure';
154 | is_deeply $db->query('SELECT ?::JSON AS foo', undef)->expand->hash, {foo => undef}, 'right structure';
155 | is_deeply $db->query('SELECT ?::JSON AS foo', undef)->expand->array, [undef], 'right structure';
156 | my $results = $db->query('SELECT ?::json', undef);
157 | is_deeply $results->expand->array, [undef], 'right structure';
158 | is_deeply $results->expand->array, undef, 'no more results';
159 | is_deeply $db->query('SELECT ?::JSON AS unicode', {json => {'☃' => '♥'}})->expand->hash, {unicode => {'☃' => '♥'}},
160 | 'right structure';
161 | is_deeply $db->query("SELECT JSON_BUILD_OBJECT('☃', ?::TEXT) AS unicode", '♥')->expand->hash,
162 | {unicode => {'☃' => '♥'}}, 'right structure';
163 | };
164 |
165 | subtest 'Fork-safety' => sub {
166 | my $dbh = $pg->db->dbh;
167 | my ($connections, $current) = @_;
168 | $pg->on(
169 | connection => sub {
170 | my ($pg, $dbh) = @_;
171 | $connections++;
172 | $current = $dbh;
173 | }
174 | );
175 | is $pg->db->dbh, $dbh, 'same database handle';
176 | ok !$connections, 'no new connections';
177 | {
178 | local $$ = -23;
179 | my $dbh2 = $pg->db->dbh;
180 | isnt $dbh2, $dbh, 'different database handles';
181 | is $dbh2, $current, 'same database handle';
182 | is $connections, 1, 'one new connection';
183 | {
184 | local $$ = -24;
185 | isnt $pg->db->dbh, $dbh, 'different database handles';
186 | isnt $pg->db->dbh, $dbh2, 'different database handles';
187 | is $pg->db->dbh, $current, 'same database handle';
188 | is $connections, 2, 'two new connections';
189 | };
190 | };
191 | $pg->unsubscribe('connection');
192 | };
193 |
194 | subtest 'Shared connection cache' => sub {
195 | my $pg2 = Mojo::Pg->new($pg);
196 | is $pg2->parent, $pg, 'right parent';
197 | my $dbh = $pg->db->dbh;
198 | is $pg->db->dbh, $dbh, 'same database handle';
199 | is $pg2->db->dbh, $dbh, 'same database handle';
200 | is $pg->db->dbh, $dbh, 'same database handle';
201 | is $pg2->db->dbh, $dbh, 'same database handle';
202 | my $db = $pg->db;
203 | is_deeply $db->query('SELECT 1 AS one')->hashes->to_array, [{one => 1}], 'right structure';
204 | $dbh = $db->dbh;
205 | $db->disconnect;
206 | $db = $pg2->db;
207 | is_deeply $db->query('SELECT 1 AS one')->hashes->to_array, [{one => 1}], 'right structure';
208 | isnt $db->dbh, $dbh, 'different database handle';
209 | };
210 |
211 | subtest 'Cache reset' => sub {
212 | my $dbh = $pg->db->dbh;
213 | is $pg->db->dbh, $dbh, 'same database handle';
214 | is $pg->db->dbh, $dbh, 'same database handle again';
215 | is $pg->db->dbh, $dbh, 'same database handle again';
216 | isnt $pg->reset->db->dbh, $dbh, 'different database handle';
217 | $dbh = $pg->db->dbh;
218 | is $pg->db->dbh, $dbh, 'same database handle';
219 | is $pg->db->dbh, $dbh, 'same database handle again';
220 | isnt $pg->reset->db->dbh, $dbh, 'different database handle';
221 | };
222 |
223 | subtest 'Notifications' => sub {
224 | my $db = $pg->db;
225 | ok !$db->is_listening, 'not listening';
226 | ok $db->listen('dbtest')->is_listening, 'listening';
227 | my $db2 = $pg->db->listen('dbtest');
228 |
229 | my @result;
230 | my $promise = Mojo::Promise->new;
231 | $db->once(notification => sub { shift; $promise->resolve(@_) });
232 | my $promise2 = Mojo::Promise->new;
233 | $db2->once(notification => sub { shift; $promise2->resolve(@_) });
234 | Mojo::IOLoop->next_tick(sub { $db2->notify(dbtest => 'foo') });
235 | Mojo::Promise->all($promise, $promise2)->then(sub {
236 | my ($one, $two) = @_;
237 | push @result, $one, $two;
238 | })->wait;
239 | is $result[0][0], 'dbtest', 'right channel name';
240 | ok $result[0][1], 'has process id';
241 | is $result[0][2], 'foo', 'right payload';
242 | is $result[1][0], 'dbtest', 'right channel name';
243 | ok $result[1][1], 'has process id';
244 | is $result[1][2], 'foo', 'right payload';
245 |
246 | @result = ();
247 | $promise = Mojo::Promise->new;
248 | $db->once(notification => sub { shift; $promise->resolve(@_) });
249 | Mojo::IOLoop->next_tick(sub { $pg->db->notify('dbtest') });
250 | $promise->then(sub { push @result, [@_] })->wait;
251 | is $result[0][0], 'dbtest', 'right channel name';
252 | ok $result[0][1], 'has process id';
253 | is $result[0][2], '', 'no payload';
254 |
255 | @result = ();
256 | $promise = Mojo::Promise->new;
257 | $db2->listen('dbtest2')->once(notification => sub { shift; $promise->resolve(@_) });
258 | Mojo::IOLoop->next_tick(sub { $db2->query("NOTIFY dbtest2, 'bar'") });
259 | $promise->then(sub { push @result, [@_] })->wait;
260 | is $result[0][0], 'dbtest2', 'right channel name';
261 | ok $result[0][1], 'has process id';
262 | is $result[0][2], 'bar', 'no payload';
263 |
264 | @result = ();
265 | $promise = Mojo::Promise->new;
266 | $db2->once(notification => sub { shift; $promise->resolve(@_) });
267 | my $tx = $db2->begin;
268 | Mojo::IOLoop->next_tick(sub {
269 | $db2->notify(dbtest2 => 'baz');
270 | $tx->commit;
271 | });
272 | $promise->then(sub { push @result, [@_] })->wait;
273 | is $result[0][0], 'dbtest2', 'right channel name';
274 | ok $result[0][1], 'has process id';
275 | is $result[0][2], 'baz', 'no payload';
276 |
277 | ok !$db->unlisten('dbtest')->is_listening, 'not listening';
278 | ok !$db2->unlisten('*')->is_listening, 'not listening';
279 | };
280 |
281 | subtest 'Stop listening for all notifications' => sub {
282 | my $db = $pg->db;
283 | ok !$db->is_listening, 'not listening';
284 | ok $db->listen('dbtest')->listen('dbtest2')->unlisten('dbtest2')->is_listening, 'listening';
285 | ok !$db->unlisten('*')->is_listening, 'not listening';
286 | };
287 |
288 | subtest 'Connection close while listening for notifications' => sub {
289 | my $db = $pg->db;
290 | ok $db->listen('dbtest')->is_listening, 'listening';
291 | my $close = 0;
292 | $db->on(close => sub { $close++ });
293 | local $db->dbh->{Warn} = 0;
294 | $pg->db->query('SELECT PG_TERMINATE_BACKEND(?)', $db->pid);
295 | Mojo::IOLoop->start;
296 | is $close, 1, 'close event has been emitted once';
297 | };
298 |
299 | subtest 'Blocking error' => sub {
300 | eval { $pg->db->query('does_not_exist') };
301 | like $@, qr/does_not_exist.*database\.t/s, 'right error';
302 | };
303 |
304 | subtest 'Non-blocking error' => sub {
305 | my ($fail, $result);
306 | $pg->db->query(
307 | 'does_not_exist' => sub {
308 | my ($db, $err, $results) = @_;
309 | ($fail, $result) = ($err, $results);
310 | Mojo::IOLoop->stop;
311 | }
312 | );
313 | Mojo::IOLoop->start;
314 | like $fail, qr/does_not_exist/, 'right error';
315 | is $result->sth->errstr, $fail, 'same error';
316 | };
317 |
318 | subtest 'Non-blocking query in progress' => sub {
319 | my $db = $pg->db;
320 | $db->query('SELECT 1' => sub { });
321 | eval {
322 | $db->query('SELECT 1' => sub { });
323 | };
324 | like $@, qr/Non-blocking query already in progress/, 'right error';
325 | };
326 |
327 | subtest 'CLean up non-blocking query' => sub {
328 | my $fail;
329 | my $db = $pg->db;
330 | $db->query(
331 | 'SELECT 1' => sub {
332 | my ($db, $err, $results) = @_;
333 | $fail = $err;
334 | }
335 | );
336 | $db->disconnect;
337 | undef $db;
338 | is $fail, 'Premature connection close', 'right error';
339 | };
340 |
341 | done_testing();
342 |
--------------------------------------------------------------------------------
/lib/Mojo/Pg.pm:
--------------------------------------------------------------------------------
1 | package Mojo::Pg;
2 | use Mojo::Base 'Mojo::EventEmitter';
3 |
4 | use Carp qw(croak);
5 | use DBI;
6 | use Mojo::Pg::Database;
7 | use Mojo::Pg::Migrations;
8 | use Mojo::Pg::PubSub;
9 | use Mojo::URL;
10 | use Scalar::Util qw(blessed);
11 | use SQL::Abstract::Pg;
12 |
13 | has abstract => sub { SQL::Abstract::Pg->new(array_datatypes => 1, name_sep => '.', quote_char => '"') };
14 | has [qw(auto_migrate parent search_path)];
15 | has database_class => 'Mojo::Pg::Database';
16 | has dsn => 'dbi:Pg:';
17 | has max_connections => 1;
18 | has migrations => sub { Mojo::Pg::Migrations->new(pg => shift) };
19 | has options => sub {
20 | {AutoCommit => 1, AutoInactiveDestroy => 1, PrintError => 0, PrintWarn => 0, RaiseError => 1};
21 | };
22 | has [qw(password username)] => '';
23 | has pubsub => sub { Mojo::Pg::PubSub->new(pg => shift) };
24 |
25 | our $VERSION = '4.29';
26 |
27 | sub db { $_[0]->database_class->new(dbh => $_[0]->_prepare, pg => $_[0]) }
28 |
29 | sub from_string {
30 | my ($self, $str) = @_;
31 |
32 | # Parent
33 | return $self unless $str;
34 | return $self->parent($str) if blessed $str && $str->isa('Mojo::Pg');
35 |
36 | # Protocol
37 | my $url = Mojo::URL->new($str);
38 | croak qq{Invalid PostgreSQL connection string "$str"} unless $url->protocol =~ /^postgres(?:ql)?$/;
39 |
40 | # Connection information
41 | my $db = $url->path->parts->[0];
42 | my $dsn = defined $db ? "dbi:Pg:dbname=$db" : 'dbi:Pg:';
43 | if (my $host = $url->host) { $dsn .= ";host=$host" }
44 | if (my $port = $url->port) { $dsn .= ";port=$port" }
45 | if (defined(my $username = $url->username)) { $self->username($username) }
46 | if (defined(my $password = $url->password)) { $self->password($password) }
47 |
48 | # Service and search_path
49 | my $hash = $url->query->to_hash;
50 | if (my $service = delete $hash->{service}) { $dsn .= "service=$service" }
51 | if (my $path = delete $hash->{search_path}) {
52 | $self->search_path(ref $path ? $path : [$path]);
53 | }
54 |
55 | # Options
56 | @{$self->options}{keys %$hash} = values %$hash;
57 |
58 | return $self->dsn($dsn);
59 | }
60 |
61 | sub new { @_ > 1 ? shift->SUPER::new->from_string(@_) : shift->SUPER::new }
62 |
63 | sub reset { ($_[0]->{queue} = []) and return $_[0] }
64 |
65 | sub _dequeue {
66 | my $self = shift;
67 |
68 | # Fork-safety
69 | delete @$self{qw(pid queue)} if $self->{pid} && $self->{pid} ne $$;
70 | $self->{pid} //= $$;
71 |
72 | while (my $dbh = shift @{$self->{queue} || []}) { return $dbh if $dbh->ping }
73 | my $dbh = DBI->connect(map { $self->$_ } qw(dsn username password options));
74 |
75 | # Search path
76 | if (my $path = $self->search_path) {
77 | my $search_path = join ', ', map { $dbh->quote_identifier($_) } @$path;
78 | $dbh->do("SET search_path TO $search_path");
79 | }
80 |
81 | $self->emit(connection => $dbh);
82 |
83 | return $dbh;
84 | }
85 |
86 | sub _enqueue {
87 | my ($self, $dbh) = @_;
88 |
89 | if (my $parent = $self->parent) { return $parent->_enqueue($dbh) }
90 |
91 | my $queue = $self->{queue} ||= [];
92 | push @$queue, $dbh if $dbh->{Active};
93 | shift @$queue while @$queue > $self->max_connections;
94 | }
95 |
96 | sub _prepare {
97 | my $self = shift;
98 |
99 | # Automatic migrations
100 | ++$self->{migrated} and $self->migrations->migrate if !$self->{migrated} && $self->auto_migrate;
101 |
102 | my $parent = $self->parent;
103 | return $parent ? $parent->_prepare : $self->_dequeue;
104 | }
105 |
106 | 1;
107 |
108 | =encoding utf8
109 |
110 | =head1 NAME
111 |
112 | Mojo::Pg - Mojolicious ♥ PostgreSQL
113 |
114 | =head1 SYNOPSIS
115 |
116 | use Mojo::Pg;
117 |
118 | # Use a PostgreSQL connection string for configuration
119 | my $pg = Mojo::Pg->new('postgresql://postgres@/test');
120 |
121 | # Select the server version
122 | say $pg->db->query('SELECT VERSION() AS version')->hash->{version};
123 |
124 | # Use migrations to create a table
125 | $pg->migrations->name('my_names_app')->from_string(<migrate;
126 | -- 1 up
127 | CREATE TABLE names (id SERIAL PRIMARY KEY, name TEXT);
128 | -- 1 down
129 | DROP TABLE names;
130 | EOF
131 |
132 | # Use migrations to drop and recreate the table
133 | $pg->migrations->migrate(0)->migrate;
134 |
135 | # Get a database handle from the cache for multiple queries
136 | my $db = $pg->db;
137 |
138 | # Use SQL::Abstract to generate simple CRUD queries for you
139 | $db->insert('names', {name => 'Isabell'});
140 | my $id = $db->select('names', ['id'], {name => 'Isabell'})->hash->{id};
141 | $db->update('names', {name => 'Belle'}, {id => $id});
142 | $db->delete('names', {name => 'Belle'});
143 |
144 | # Insert a few rows in a transaction with SQL and placeholders
145 | eval {
146 | my $tx = $db->begin;
147 | $db->query('INSERT INTO names (name) VALUES (?)', 'Sara');
148 | $db->query('INSERT INTO names (name) VALUES (?)', 'Stefan');
149 | $tx->commit;
150 | };
151 | say $@ if $@;
152 |
153 | # Insert another row with SQL::Abstract and return the generated id
154 | say $db->insert('names', {name => 'Daniel'}, {returning => 'id'})->hash->{id};
155 |
156 | # JSON roundtrip
157 | say $db->query('SELECT ?::JSON AS foo', {json => {bar => 'baz'}})
158 | ->expand->hash->{foo}{bar};
159 |
160 | # Select all rows blocking with SQL::Abstract
161 | say $_->{name} for $db->select('names')->hashes->each;
162 |
163 | # Select all rows non-blocking with SQL::Abstract
164 | $db->select('names' => sub ($db, $err, $results) {
165 | die $err if $err;
166 | say $_->{name} for $results->hashes->each;
167 | });
168 | Mojo::IOLoop->start unless Mojo::IOLoop->is_running;
169 |
170 | # Concurrent non-blocking queries (synchronized with promises)
171 | my $now = $pg->db->query_p('SELECT NOW() AS now');
172 | my $names = $pg->db->query_p('SELECT * FROM names');
173 | Mojo::Promise->all($now, $names)->then(sub ($now, $names) {
174 | say $now->[0]->hash->{now};
175 | say $_->{name} for $names->[0]->hashes->each;
176 | })->catch(sub ($err) {
177 | warn "Something went wrong: $err";
178 | })->wait;
179 |
180 | # Send and receive notifications non-blocking
181 | $pg->pubsub->listen(foo => sub ($pubsub, $payload) {
182 | say "foo: $payload";
183 | $pubsub->notify(bar => $payload);
184 | });
185 | $pg->pubsub->listen(bar => sub ($pubsub, $payload) {
186 | say "bar: $payload";
187 | });
188 | $pg->pubsub->notify(foo => 'PostgreSQL rocks!');
189 | Mojo::IOLoop->start unless Mojo::IOLoop->is_running;
190 |
191 | =head1 DESCRIPTION
192 |
193 | L is a tiny wrapper around L that makes L a lot of fun to use
194 | with the L real-time web framework. Perform queries blocking and non-blocking, use
195 | all L PostgreSQL has to offer, generate CRUD
196 | queries from data structures, manage your database schema with migrations and build scalable real-time web applications
197 | with the publish/subscribe pattern.
198 |
199 | =head1 BASICS
200 |
201 | Database and statement handles are cached automatically, and will be reused transparently to increase performance. You
202 | can handle connection timeouts gracefully by holding on to them only for short amounts of time.
203 |
204 | use Mojolicious::Lite -signatures;
205 | use Mojo::Pg;
206 |
207 | helper pg => sub { state $pg = Mojo::Pg->new('postgresql://postgres@/test') };
208 |
209 | get '/' => sub ($c) {
210 | my $db = $c->pg->db;
211 | $c->render(json => $db->query('SELECT NOW() AS now')->hash);
212 | };
213 |
214 | app->start;
215 |
216 | In this example application, we create a C helper to store a L object. Our action calls that helper and
217 | uses the method L to dequeue a L object from the connection pool. Then we use the
218 | method L to execute an L
219 | statement, which returns a L object. And finally we call the method L to
220 | retrieve the first row as a hash reference.
221 |
222 | While all I/O operations are performed blocking, you can wait for long running queries asynchronously, allowing the
223 | L event loop to perform other tasks in the meantime. Since database connections usually have a very low
224 | latency, this often results in very good performance.
225 |
226 | Every database connection can only handle one active query at a time, this includes asynchronous ones. To perform
227 | multiple queries concurrently, you have to use multiple connections.
228 |
229 | # Performed concurrently (5 seconds)
230 | $pg->db->query('SELECT PG_SLEEP(5)' => sub ($db, $err, $results) {...});
231 | $pg->db->query('SELECT PG_SLEEP(5)' => sub ($db, $err, $results) {...});
232 |
233 | All cached database handles will be reset automatically if a new process has been forked, this allows multiple
234 | processes to share the same L object safely.
235 |
236 | =head1 GROWING
237 |
238 | And as your application grows, you can move queries into model classes.
239 |
240 | package MyApp::Model::Time;
241 | use Mojo::Base -base, -signatures;
242 |
243 | has 'pg';
244 |
245 | sub now ($self) {
246 | return $self->pg->db->query('SELECT NOW() AS now')->hash;
247 | }
248 |
249 | 1;
250 |
251 | Which get integrated into your application with helpers.
252 |
253 | use Mojolicious::Lite -signatures;
254 | use Mojo::Pg;
255 | use MyApp::Model::Time;
256 |
257 | helper pg => sub { state $pg = Mojo::Pg->new('postgresql://postgres@/test') };
258 | helper time => sub { state $time = MyApp::Model::Time->new(pg => shift->pg) };
259 |
260 | get '/' => sub ($c) {
261 | $c->render(json => $c->time->now);
262 | };
263 |
264 | app->start;
265 |
266 | =head1 EXAMPLES
267 |
268 | This distribution also contains two great L you can use for inspiration. The minimal
270 | L application will show you how to scale
271 | WebSockets to multiple servers, and the well-structured
272 | L application how to apply the MVC design pattern
273 | in practice.
274 |
275 | =head1 EVENTS
276 |
277 | L inherits all events from L and can emit the following new ones.
278 |
279 | =head2 connection
280 |
281 | $pg->on(connection => sub ($pg, $dbh) {
282 | ...
283 | });
284 |
285 | Emitted when a new database connection has been established.
286 |
287 | $pg->on(connection => sub ($pg, $dbh) {
288 | $dbh->do('SET search_path TO my_schema');
289 | });
290 |
291 | =head1 ATTRIBUTES
292 |
293 | L implements the following attributes.
294 |
295 | =head2 abstract
296 |
297 | my $abstract = $pg->abstract;
298 | $pg = $pg->abstract(SQL::Abstract::Pg->new);
299 |
300 | L object used to generate CRUD queries for L, defaults to enabling
301 | C and setting C to C<.> and C to C<">.
302 |
303 | # Generate WHERE clause and bind values
304 | my($stmt, @bind) = $pg->abstract->where({foo => 'bar', baz => 'yada'});
305 |
306 | =head2 auto_migrate
307 |
308 | my $bool = $pg->auto_migrate;
309 | $pg = $pg->auto_migrate($bool);
310 |
311 | Automatically migrate to the latest database schema with L, as soon as L has been called for the
312 | first time.
313 |
314 | =head2 database_class
315 |
316 | my $class = $pg->database_class;
317 | $pg = $pg->database_class('MyApp::Database');
318 |
319 | Class to be used by L, defaults to L. Note that this class needs to have already been loaded
320 | before L is called.
321 |
322 | =head2 dsn
323 |
324 | my $dsn = $pg->dsn;
325 | $pg = $pg->dsn('dbi:Pg:dbname=foo');
326 |
327 | Data source name, defaults to C.
328 |
329 | =head2 max_connections
330 |
331 | my $max = $pg->max_connections;
332 | $pg = $pg->max_connections(3);
333 |
334 | Maximum number of idle database handles to cache for future use, defaults to C<1>.
335 |
336 | =head2 migrations
337 |
338 | my $migrations = $pg->migrations;
339 | $pg = $pg->migrations(Mojo::Pg::Migrations->new);
340 |
341 | L object you can use to change your database schema more easily.
342 |
343 | # Load migrations from file and migrate to latest version
344 | $pg->migrations->from_file('/home/sri/migrations.sql')->migrate;
345 |
346 | =head2 options
347 |
348 | my $options = $pg->options;
349 | $pg = $pg->options({AutoCommit => 1, RaiseError => 1});
350 |
351 | Options for database handles, defaults to activating C, C as well as C and
352 | deactivating C as well as C. Note that C and C are considered mandatory,
353 | so deactivating them would be very dangerous.
354 |
355 | =head2 parent
356 |
357 | my $parent = $pg->parent;
358 | $pg = $pg->parent(Mojo::Pg->new);
359 |
360 | Another L object to use for connection management, instead of establishing and caching our own database
361 | connections.
362 |
363 | =head2 password
364 |
365 | my $password = $pg->password;
366 | $pg = $pg->password('s3cret');
367 |
368 | Database password, defaults to an empty string.
369 |
370 | =head2 pubsub
371 |
372 | my $pubsub = $pg->pubsub;
373 | $pg = $pg->pubsub(Mojo::Pg::PubSub->new);
374 |
375 | L object you can use to send and receive notifications very efficiently, by sharing a single database
376 | connection with many consumers.
377 |
378 | # Subscribe to a channel
379 | $pg->pubsub->listen(news => sub ($pubsub, $payload) {
380 | say "Received: $payload";
381 | });
382 |
383 | # Notify a channel
384 | $pg->pubsub->notify(news => 'PostgreSQL rocks!');
385 |
386 | =head2 search_path
387 |
388 | my $path = $pg->search_path;
389 | $pg = $pg->search_path(['$user', 'foo', 'public']);
390 |
391 | Schema search path assigned to all new connections.
392 |
393 | # Isolate tests and avoid race conditions when running them in parallel
394 | my $pg = Mojo::Pg->new('postgresql:///test')->search_path(['test_one']);
395 | $pg->db->query('DROP SCHEMA IF EXISTS test_one CASCADE');
396 | $pg->db->query('CREATE SCHEMA test_one');
397 | ...
398 | $pg->db->query('DROP SCHEMA test_one CASCADE');
399 |
400 | =head2 username
401 |
402 | my $username = $pg->username;
403 | $pg = $pg->username('sri');
404 |
405 | Database username, defaults to an empty string.
406 |
407 | =head1 METHODS
408 |
409 | L inherits all methods from L and implements the following new ones.
410 |
411 | =head2 db
412 |
413 | my $db = $pg->db;
414 |
415 | Get a database object based on L (which is usually L) for a cached or newly
416 | established database connection. The L database handle will be automatically cached again when that object is
417 | destroyed, so you can handle problems like connection timeouts gracefully by holding on to it only for short amounts of
418 | time.
419 |
420 | # Add up all the money
421 | say $pg->db->select('accounts')->hashes->reduce(sub { $a->{money} + $b->{money} });
422 |
423 | =head2 from_string
424 |
425 | $pg = $pg->from_string('postgresql://postgres@/test');
426 | $pg = $pg->from_string(Mojo::Pg->new);
427 |
428 | Parse configuration from connection string or use another L object as L.
429 |
430 | # Just a database
431 | $pg->from_string('postgresql:///db1');
432 |
433 | # Just a service
434 | $pg->from_string('postgresql://?service=foo');
435 |
436 | # Username and database
437 | $pg->from_string('postgresql://sri@/db2');
438 |
439 | # Short scheme, username, password, host and database
440 | $pg->from_string('postgres://sri:s3cret@localhost/db3');
441 |
442 | # Username, domain socket and database
443 | $pg->from_string('postgresql://sri@%2ftmp%2fpg.sock/db4');
444 |
445 | # Username, database and additional options
446 | $pg->from_string('postgresql://sri@/db5?PrintError=1&pg_server_prepare=0');
447 |
448 | # Service and additional options
449 | $pg->from_string('postgresql://?service=foo&PrintError=1&RaiseError=0');
450 |
451 | # Username, database, an option and search_path
452 | $pg->from_string('postgres://sri@/db6?&PrintError=1&search_path=test_schema');
453 |
454 | =head2 new
455 |
456 | my $pg = Mojo::Pg->new;
457 | my $pg = Mojo::Pg->new('postgresql://postgres@/test');
458 | my $pg = Mojo::Pg->new(Mojo::Pg->new);
459 |
460 | Construct a new L object and parse connection string with L if necessary.
461 |
462 | # Customize configuration further
463 | my $pg = Mojo::Pg->new->dsn('dbi:Pg:service=foo');
464 |
465 | =head2 reset
466 |
467 | $pg = $pg->reset;
468 |
469 | Reset connection cache.
470 |
471 | =head1 DEBUGGING
472 |
473 | You can set the C environment variable to get some advanced diagnostics information printed by L.
474 |
475 | DBI_TRACE=1
476 | DBI_TRACE=15
477 | DBI_TRACE=SQL
478 |
479 | =head1 API
480 |
481 | This is the class hierarchy of the L distribution.
482 |
483 | =over 2
484 |
485 | =item * L
486 |
487 | =item * L
488 |
489 | =item * L
490 |
491 | =item * L
492 |
493 | =item * L
494 |
495 | =item * L
496 |
497 | =back
498 |
499 | =head1 AUTHOR
500 |
501 | Sebastian Riedel, C.
502 |
503 | =head1 CREDITS
504 |
505 | In alphabetical order:
506 |
507 | =over 2
508 |
509 | Brett Watson
510 |
511 | Christopher Eveland
512 |
513 | Dan Book
514 |
515 | Flavio Poletti
516 |
517 | Hernan Lopes
518 |
519 | Joel Berger
520 |
521 | Matt S Trout
522 |
523 | Peter Rabbitson
524 |
525 | William Lindley
526 |
527 | =back
528 |
529 | =head1 COPYRIGHT AND LICENSE
530 |
531 | Copyright (C) 2014-2025, Sebastian Riedel and others.
532 |
533 | This program is free software, you can redistribute it and/or modify it under the terms of the Artistic License version
534 | 2.0.
535 |
536 | =head1 SEE ALSO
537 |
538 | L, L, L.
539 |
540 | =cut
541 |
--------------------------------------------------------------------------------
/lib/Mojo/Pg/Database.pm:
--------------------------------------------------------------------------------
1 | package Mojo::Pg::Database;
2 | use Mojo::Base 'Mojo::EventEmitter';
3 |
4 | use Carp qw(croak shortmess);
5 | use DBD::Pg qw(:async);
6 | use Mojo::IOLoop;
7 | use Mojo::JSON qw(to_json);
8 | use Mojo::Pg::Results;
9 | use Mojo::Pg::Transaction;
10 | use Mojo::Promise;
11 | use Mojo::Util qw(monkey_patch);
12 |
13 | has 'dbh';
14 | has pg => undef, weak => 1;
15 | has results_class => 'Mojo::Pg::Results';
16 |
17 | for my $name (qw(delete insert select update)) {
18 | monkey_patch __PACKAGE__, $name, sub {
19 | my ($self, @cb) = (shift, ref $_[-1] eq 'CODE' ? pop : ());
20 | return $self->query($self->pg->abstract->$name(@_), @cb);
21 | };
22 | monkey_patch __PACKAGE__, "${name}_p", sub {
23 | my $self = shift;
24 | return $self->query_p($self->pg->abstract->$name(@_));
25 | };
26 | }
27 |
28 | sub DESTROY {
29 | my $self = shift;
30 |
31 | my $waiting = $self->{waiting};
32 | $waiting->{cb}($self, 'Premature connection close', undef) if $waiting->{cb};
33 |
34 | return unless (my $pg = $self->pg) && (my $dbh = $self->dbh);
35 | $pg->_enqueue($dbh) unless $dbh->{private_mojo_no_reuse};
36 | }
37 |
38 | sub begin { Mojo::Pg::Transaction->new(db => shift) }
39 |
40 | sub disconnect {
41 | my $self = shift;
42 | $self->_unwatch;
43 | $self->dbh->disconnect;
44 | }
45 |
46 | sub dollar_only { ++$_[0]{dollar_only} and return $_[0] }
47 |
48 | sub is_listening { !!keys %{shift->{listen} || {}} }
49 |
50 | sub listen {
51 | my ($self, $name) = @_;
52 |
53 | my $dbh = $self->dbh;
54 | $dbh->do('LISTEN ' . $dbh->quote_identifier($name)) unless $self->{listen}{$name}++;
55 | $self->_watch;
56 | $self->_notifications;
57 |
58 | return $self;
59 | }
60 |
61 | sub notify {
62 | my ($self, $name, $payload) = @_;
63 |
64 | my $dbh = $self->dbh;
65 | my $notify = 'NOTIFY ' . $dbh->quote_identifier($name);
66 | $notify .= ', ' . $dbh->quote($payload) if defined $payload;
67 | $dbh->do($notify);
68 | $self->_notifications;
69 |
70 | return $self;
71 | }
72 |
73 | sub pid { shift->dbh->{pg_pid} }
74 |
75 | sub ping { shift->dbh->ping }
76 |
77 | sub query {
78 | my ($self, $query) = (shift, shift);
79 | my $cb = ref $_[-1] eq 'CODE' ? pop : undef;
80 |
81 | croak 'Non-blocking query already in progress' if $self->{waiting};
82 |
83 | my %attrs;
84 | $attrs{pg_placeholder_dollaronly} = 1 if delete $self->{dollar_only};
85 | $attrs{pg_async} = PG_ASYNC if $cb;
86 | my $sth = $self->dbh->prepare_cached($query, \%attrs, 3);
87 | local $sth->{HandleError} = sub { $_[0] = shortmess $_[0]; 0 };
88 |
89 | for (my $i = 0; $#_ >= $i; $i++) {
90 | my ($param, $attrs) = ($_[$i], {});
91 | if (ref $param eq 'HASH') {
92 | if (exists $param->{-json}) { $param = to_json $param->{-json} }
93 | elsif (exists $param->{json}) { $param = to_json $param->{json} }
94 | elsif (exists $param->{type} && exists $param->{value}) {
95 | ($attrs->{pg_type}, $param) = @{$param}{qw(type value)};
96 | }
97 | }
98 | $sth->bind_param($i + 1, $param, $attrs);
99 | }
100 | $sth->execute;
101 |
102 | # Blocking
103 | unless ($cb) {
104 | $self->_notifications;
105 | return $self->results_class->new(db => $self, sth => $sth);
106 | }
107 |
108 | # Non-blocking
109 | $self->{waiting} = {cb => $cb, sth => $sth};
110 | $self->{finish} = [];
111 | $self->_watch;
112 | }
113 |
114 | sub query_p {
115 | my $self = shift;
116 | my $promise = Mojo::Promise->new;
117 | $self->query(@_ => sub { $_[1] ? $promise->reject($_[1]) : $promise->resolve($_[2]) });
118 | return $promise;
119 | }
120 |
121 | sub tables {
122 | my @tables = shift->dbh->tables('', '', '', '');
123 | return [grep { $_ !~ /^(?:pg_catalog|information_schema)\./ } @tables];
124 | }
125 |
126 | sub unlisten {
127 | my ($self, $name) = @_;
128 |
129 | my $dbh = $self->dbh;
130 | $dbh->do('UNLISTEN ' . $dbh->quote_identifier($name));
131 | $name eq '*' ? delete $self->{listen} : delete $self->{listen}{$name};
132 | $self->_notifications;
133 | $self->_unwatch unless $self->{waiting} || $self->is_listening;
134 |
135 | return $self;
136 | }
137 |
138 | sub _finish_when_safe {
139 | my $self = shift;
140 | if ($self->{finish}) { push @{$self->{finish}}, @_ }
141 | else { $_->finish for @_ }
142 | }
143 |
144 | sub _notifications {
145 | my $self = shift;
146 |
147 | my $dbh = $self->dbh;
148 | my $n;
149 | return undef unless $n = eval { $dbh->pg_notifies };
150 | while ($n) {
151 | $self->emit(notification => @$n);
152 | $n = eval { $dbh->pg_notifies };
153 | }
154 |
155 | return 1;
156 | }
157 |
158 | sub _unwatch {
159 | my $self = shift;
160 | return unless delete $self->{watching};
161 | Mojo::IOLoop->singleton->reactor->remove($self->{handle});
162 | $self->emit('close') if $self->is_listening;
163 | }
164 |
165 | sub _watch {
166 | my $self = shift;
167 |
168 | return if $self->{watching} || $self->{watching}++;
169 |
170 | my $dbh = $self->dbh;
171 | unless ($self->{handle}) {
172 | open $self->{handle}, '<&', $dbh->{pg_socket} or die "Can't dup: $!";
173 | }
174 | Mojo::IOLoop->singleton->reactor->io(
175 | $self->{handle} => sub {
176 | my $reactor = shift;
177 |
178 | return $self->_unwatch if !$self->_notifications && !$self->{waiting};
179 |
180 | return if !$self->{waiting} || !$dbh->pg_ready;
181 | my ($sth, $cb) = @{delete $self->{waiting}}{qw(sth cb)};
182 |
183 | # Do not raise exceptions inside the event loop
184 | my $result = do { local $dbh->{RaiseError} = 0; $dbh->pg_result };
185 | my $err = defined $result ? undef : $dbh->errstr;
186 |
187 | $self->$cb($err, $self->results_class->new(db => $self, sth => $sth));
188 | $self->_finish_when_safe(@{delete $self->{finish}}) if $self->{finish};
189 | $self->_unwatch unless $self->{waiting} || $self->is_listening;
190 | }
191 | )->watch($self->{handle}, 1, 0);
192 | }
193 |
194 | 1;
195 |
196 | =encoding utf8
197 |
198 | =head1 NAME
199 |
200 | Mojo::Pg::Database - Database
201 |
202 | =head1 SYNOPSIS
203 |
204 | use Mojo::Pg::Database;
205 |
206 | my $db = Mojo::Pg::Database->new(pg => $pg, dbh => $dbh);
207 | $db->query('SELECT * FROM foo') ->hashes->map(sub { $_->{bar} })->join("\n")->say;
208 |
209 | =head1 DESCRIPTION
210 |
211 | L is a container for L database handles used by L.
212 |
213 | =head1 EVENTS
214 |
215 | L inherits all events from L and can emit the following new ones.
216 |
217 | =head2 close
218 |
219 | $db->on(close => sub ($db) {
220 | ...
221 | });
222 |
223 | Emitted when the database connection gets closed while waiting for notifications.
224 |
225 | =head2 notification
226 |
227 | $db->on(notification => sub ($db, $name, $pid, $payload) {
228 | ...
229 | });
230 |
231 | Emitted when a notification has been received.
232 |
233 | =head1 ATTRIBUTES
234 |
235 | L implements the following attributes.
236 |
237 | =head2 dbh
238 |
239 | my $dbh = $db->dbh;
240 | $db = $db->dbh($dbh);
241 |
242 | L database handle used for all queries.
243 |
244 | # Use DBI utility methods
245 | my $quoted = $db->dbh->quote_identifier('foo.bar');
246 |
247 | =head2 pg
248 |
249 | my $pg = $db->pg;
250 | $db = $db->pg(Mojo::Pg->new);
251 |
252 | L object this database belongs to. Note that this attribute is weakened.
253 |
254 | =head2 results_class
255 |
256 | my $class = $db->results_class;
257 | $db = $db->results_class('MyApp::Results');
258 |
259 | Class to be used by L, defaults to L. Note that this class needs to have already been
260 | loaded before L is called.
261 |
262 | =head1 METHODS
263 |
264 | L inherits all methods from L and implements the following new ones.
265 |
266 | =head2 begin
267 |
268 | my $tx = $db->begin;
269 |
270 | Begin transaction and return L object, which will automatically roll back the transaction unless
271 | L has been called before it is destroyed.
272 |
273 | # Insert rows in a transaction
274 | eval {
275 | my $tx = $db->begin;
276 | $db->insert('frameworks', {name => 'Catalyst'});
277 | $db->insert('frameworks', {name => 'Mojolicious'});
278 | $tx->commit;
279 | };
280 | say $@ if $@;
281 |
282 | =head2 delete
283 |
284 | my $results = $db->delete($table, \%where, \%options);
285 |
286 | Generate a C statement with L (usually an L object) and execute it with
287 | L. You can also append a callback to perform operations non-blocking.
288 |
289 | $db->delete(some_table => sub ($db, $err, $results) {
290 | ...
291 | });
292 | Mojo::IOLoop->start unless Mojo::IOLoop->is_running;
293 |
294 | Use all the same argument variations you would pass to the C method of L.
295 |
296 | # "DELETE FROM some_table"
297 | $db->delete('some_table');
298 |
299 | # "DELETE FROM some_table WHERE foo = 'bar'"
300 | $db->delete('some_table', {foo => 'bar'});
301 |
302 | # "DELETE from some_table WHERE foo LIKE '%test%'"
303 | $db->delete('some_table', {foo => {-like => '%test%'}});
304 |
305 | # "DELETE FROM some_table WHERE foo = 'bar' RETURNING id"
306 | $db->delete('some_table', {foo => 'bar'}, {returning => 'id'});
307 |
308 | =head2 delete_p
309 |
310 | my $promise = $db->delete_p($table, \%where, \%options);
311 |
312 | Same as L, but performs all operations non-blocking and returns a L object instead of
313 | accepting a callback.
314 |
315 | $db->delete_p('some_table')->then(sub ($results) {
316 | ...
317 | })->catch(sub ($err) {
318 | ...
319 | })->wait;
320 |
321 | =head2 disconnect
322 |
323 | $db->disconnect;
324 |
325 | Disconnect L and prevent it from getting reused.
326 |
327 | =head2 dollar_only
328 |
329 | $db = $db->dollar_only;
330 |
331 | Activate C for next L call and allow C to be used as an operator.
332 |
333 | # Check for a key in a JSON document
334 | $db->dollar_only->query('SELECT * FROM foo WHERE bar ? $1', 'baz')
335 | ->expand->hashes->map(sub { $_->{bar}{baz} })->join("\n")->say;
336 |
337 | =head2 insert
338 |
339 | my $results = $db->insert($table, \@values || \%fieldvals, \%options);
340 |
341 | Generate an C statement with L (usually an L object) and execute it
342 | with L. You can also append a callback to perform operations non-blocking.
343 |
344 | $db->insert(some_table => {foo => 'bar'} => sub ($db, $err, $results) {
345 | ...
346 | });
347 | Mojo::IOLoop->start unless Mojo::IOLoop->is_running;
348 |
349 | Use all the same argument variations you would pass to the C method of L.
350 |
351 | # "INSERT INTO some_table (foo, baz) VALUES ('bar', 'yada')"
352 | $db->insert('some_table', {foo => 'bar', baz => 'yada'});
353 |
354 | # "INSERT INTO some_table (foo) VALUES ({1,2,3})"
355 | $db->insert('some_table', {foo => [1, 2, 3]});
356 |
357 | # "INSERT INTO some_table (foo) VALUES ('bar') RETURNING id"
358 | $db->insert('some_table', {foo => 'bar'}, {returning => 'id'});
359 |
360 | # "INSERT INTO some_table (foo) VALUES ('bar') RETURNING id, foo"
361 | $db->insert('some_table', {foo => 'bar'}, {returning => ['id', 'foo']});
362 |
363 | As well as some PostgreSQL specific extensions added by L.
364 |
365 | # "INSERT INTO some_table (foo) VALUES ('{"test":23}')"
366 | $db->insert('some_table', {foo => {-json => {test => 23}}});
367 |
368 | # "INSERT INTO some_table (foo) VALUES ('bar') ON CONFLICT DO NOTHING"
369 | $db->insert('some_table', {foo => 'bar'}, {on_conflict => undef});
370 |
371 | Including operations commonly referred to as C.
372 |
373 | # "INSERT INTO t (a) VALUES ('b') ON CONFLICT (a) DO UPDATE SET a = 'c'"
374 | $db->insert('t', {a => 'b'}, {on_conflict => [a => {a => 'c'}]});
375 |
376 | # "INSERT INTO t (a, b) VALUES ('c', 'd') ON CONFLICT (a, b) DO UPDATE SET a = 'e'"
377 | $db->insert('t', {a => 'c', b => 'd'}, {on_conflict => [['a', 'b'] => {a => 'e'}]});
378 |
379 | =head2 insert_p
380 |
381 | my $promise = $db->insert_p($table, \@values || \%fieldvals, \%options);
382 |
383 | Same as L, but performs all operations non-blocking and returns a L object instead of
384 | accepting a callback.
385 |
386 | $db->insert_p(some_table => {foo => 'bar'})->then(sub ($results) {
387 | ...
388 | })->catch(sub ($err) {
389 | ...
390 | })->wait;
391 |
392 | =head2 is_listening
393 |
394 | my $bool = $db->is_listening;
395 |
396 | Check if L is listening for notifications.
397 |
398 | =head2 listen
399 |
400 | $db = $db->listen('foo');
401 |
402 | Subscribe to a channel and receive L events when the L event loop is running.
403 |
404 | =head2 notify
405 |
406 | $db = $db->notify('foo');
407 | $db = $db->notify(foo => 'bar');
408 |
409 | Notify a channel.
410 |
411 | =head2 pid
412 |
413 | my $pid = $db->pid;
414 |
415 | Return the process id of the backend server process.
416 |
417 | =head2 ping
418 |
419 | my $bool = $db->ping;
420 |
421 | Check database connection.
422 |
423 | =head2 query
424 |
425 | my $results = $db->query('SELECT * FROM foo');
426 | my $results = $db->query('INSERT INTO foo VALUES (?, ?, ?)', @values);
427 | my $results = $db->query('SELECT ?::JSON AS foo', {-json => {bar => 'baz'}});
428 |
429 | Execute a blocking L statement and return a results object
430 | based on L (which is usually L) with the query results. The L statement
431 | handle will be automatically reused when it is not active anymore, to increase the performance of future queries. You
432 | can also append a callback to perform operations non-blocking.
433 |
434 | $db->query('INSERT INTO foo VALUES (?, ?, ?)' => @values => sub ($db, $err, $results) {
435 | ...
436 | });
437 | Mojo::IOLoop->start unless Mojo::IOLoop->is_running;
438 |
439 | Hash reference arguments containing a value named C<-json> or C will be encoded to JSON text with
440 | L. To accomplish the reverse, you can use the method L, which
441 | automatically decodes all fields of the types C and C with L to Perl values.
442 |
443 | # "I ♥ Mojolicious!"
444 | $db->query('SELECT ?::JSONB AS foo', {-json => {bar => 'I ♥ Mojolicious!'}}) ->expand->hash->{foo}{bar};
445 |
446 | Hash reference arguments containing values named C and C can be used to bind specific L data
447 | types to placeholders.
448 |
449 | # Insert binary data
450 | use DBD::Pg ':pg_types';
451 | $db->query('INSERT INTO bar VALUES (?)', {type => PG_BYTEA, value => $bytes});
452 |
453 | =head2 query_p
454 |
455 | my $promise = $db->query_p('SELECT * FROM foo');
456 |
457 | Same as L, but performs all operations non-blocking and returns a L object instead of
458 | accepting a callback.
459 |
460 | $db->query_p('INSERT INTO foo VALUES (?, ?, ?)' => @values)->then(sub ($results) {
461 | ...
462 | })->catch(sub ($err) {
463 | ...
464 | })->wait;
465 |
466 | =head2 select
467 |
468 | my $results = $db->select($source, $fields, $where, \%options);
469 |
470 | Generate a C