initial dump

.gitignore

@@ -14,3 +14,4 @@ META.yml
 MYMETA.yml
 nytprof.out
 pm_to_blib
+base

Build.PL

@@ -0,0 +1,23 @@
+use 5.012;
+use Module::Build;
+
+my $build = Module::Build->new(
+    module_name       => 'PostgresTools',
+    dist_abstract     => 'Backup and Restore scripts for PostgreSQL',
+    dist_author       => 'Robert Abraham <[email protected]>',
+    dist_version_from => 'lib/PostgresTools.pm',
+    license           => 'mit',
+    build_requires    => { 'Module::Build' => 0.38, },
+    requires          => {
+        'Moo'                        => 0,
+        'DBD::Pg'                    => 0,
+        'Getopt::Long'               => 0,
+        'File::Path'                 => 0,
+        'DateTime'                   => 0,
+        'DateTime::Format::Strptime' => 0,
+        'Parallel::ForkManager'      => 0,
+    },
+    script_files => ['bin/dump.pl'],
+);
+
+$build->create_build_script;

MANIFEST

@@ -0,0 +1,8 @@
+bin/dump.pl
+Build.PL
+lib/PostgresTools.pm
+lib/PostgresTools/Database.pm
+lib/PostgresTools/Date.pm
+LICENSE
+MANIFEST			This list of files
+README.md

MANIFEST.SKIP.bak

@@ -0,0 +1,15 @@
+#!include_default
+# Avoid configuration metadata file
+^MYMETA\.
+
+# Avoid Module::Build generated and utility files.
+\bBuild$
+\bBuild.bat$
+\b_build
+\bBuild.COM$
+\bBUILD.COM$
+\bbuild.com$
+^MANIFEST\.SKIP
+
+# Avoid archives of this distribution
+\bPostgresTools-[\d\.\_]+

bin/dump.pl

@@ -0,0 +1,49 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use 5.012;
+
+use lib 'lib';
+
+use PostgresTools;
+use File::Basename;
+use Getopt::Long;
+
+our $PROGNAME = basename($0);
+
+my $host = 'localhost';
+my $user = 'postgres';
+my $db;
+my $pretend = 0;
+my $jobs    = 1;
+my $offset  = 35;
+
+GetOptions(
+    "host|h=s"   => \$host,
+    "user|U=s"   => \$user,
+    "db=s"       => \$db,
+    "jobs|j=i"   => \$jobs,
+    "offset|o=i" => \$offset,
+    "pretend|p"  => \$pretend,
+);
+
+unless ( defined($db) ) {
+    say "usage: $PROGNAME --host <host> --user <user> --db <db> -p\n";
+    say "\thost|h => PostgreSQL host to connect to ( default: \'localhost\' )";
+    say "\tuser|U => PostgreSQL user to use for connection ( default: \'postgres\' )";
+    say "\tdb     => PostgreSQL database to connect to ( required )";
+    say "\tpretend|p => boolean, if set only print commands";
+    exit(1);
+}
+
+my $tools = PostgresTools->new(
+    host    => $host,
+    user    => $user,
+    db      => $db,
+    pretend => $pretend,
+    offset  => $offset,
+    forks   => $jobs,
+);
+
+$tools->dump;

lib/PostgresTools.pm

@@ -0,0 +1,123 @@
+package PostgresTools;
+
+use strict;
+use warnings;
+use 5.012;
+
+use Moo;
+use Parallel::ForkManager;
+use File::Path qw(make_path);
+use DateTime::Format::Strptime;
+
+use PostgresTools::Database;
+use PostgresTools::Date;
+
+has user     => ( is => 'rw' );
+has host     => ( is => 'rw' );
+has db       => ( is => 'ro', required => 1 );
+has dbh      => ( is => 'rw' );
+has base_dir => ( is => 'rw' );
+has dump_dir => ( is => 'rw' );
+has forks    => ( is => 'rw' );
+has offset   => ( is => 'rw' );
+has exclude  => ( is => 'rw' );
+has excludes => ( is => 'rw' );
+has pretend  => ( is => 'rw' );
+
+sub BUILD {
+    my $self = shift;
+    $self->user('postgres')  unless $self->user;
+    $self->host('localhost') unless $self->host;
+    my $dbh = PostgresTools::Database->new(
+        db   => $self->{db},
+        host => $self->{host},
+        user => $self->{user},
+    );
+    $self->base_dir('./base') unless $self->base_dir;
+    $self->_make_base;
+    $self->dbh($dbh);
+    $self->forks(1)   unless $self->forks;
+    $self->offset(1)  unless $self->offset;
+    $self->pretend(0) unless $self->pretend;
+    $self->_create_excludes;
+}
+
+sub dump {
+    my $self = shift;
+    $self->_dump_partitions;
+    $self->_dump_tables;
+    $self->_dump_sequences;
+}
+
+sub _dump_partitions {
+    my $self  = shift;
+    my $parts = $self->dbh->partitions;
+    my $date  = PostgresTools::Date->new;
+    my $pm    = new Parallel::ForkManager( $self->forks );
+    for my $part (@$parts) {
+        next if $self->excludes->{$part};
+        $pm->start and next;
+        if ( $date->older_than_from_string( $part, $self->offset ) ) {
+            $self->_make_dump($part);
+        }
+        $pm->finish;
+    }
+    $pm->wait_all_children;
+}
+
+sub _dump_tables {
+    my $self   = shift;
+    my $tables = $self->dbh->tables;
+    my $pm     = new Parallel::ForkManager( $self->forks );
+    for my $table (@$tables) {
+        next if $self->excludes->{$table};
+        $pm->start and next;
+        $self->_make_dump($table);
+        $pm->finish;
+    }
+    $pm->wait_all_children;
+}
+
+sub _dump_sequences {
+    my $self = shift;
+    my $seqs = $self->dbh->sequences;
+    my $pm   = new Parallel::ForkManager( $self->forks );
+    for my $seq (@$seqs) {
+        next if $self->excludes->{$seq};
+        $pm->start and next;
+        $self->_make_dump($seq);
+        $pm->finish;
+    }
+    $pm->wait_all_children;
+}
+
+sub _create_excludes {
+    my $self = shift;
+    $self->exclude( [] ) unless $self->exclude;
+    my %excludes = map { $_ => 1 } @{ $self->exclude };
+    $self->excludes( \%excludes );
+    use Data::Dumper;
+    print Dumper $self->excludes;
+}
+
+sub _make_base {
+    my $self      = shift;
+    my $formatter = DateTime::Format::Strptime->new( pattern => '%Y_%m_%d' );
+    my $now       = DateTime->now( formatter => $formatter );
+    $self->dump_dir( $self->{base_dir} . "/$now" );
+    make_path( $self->{dump_dir} );
+}
+
+sub _make_dump {
+    my $self    = shift;
+    my $to_dump = shift;
+    my $cmd = "pg_dump -U $self->{user} -h $self->{host} -c -F c -f $self->{dump_dir}/$to_dump $self->{db}";
+    say $cmd;
+    if ( !$self->pretend ) {
+        eval {
+            system($cmd) == 0 or die $!;
+        };
+    }
+}
+
+1;

lib/PostgresTools/Database.pm

@@ -0,0 +1,84 @@
+package PostgresTools::Database;
+
+use strict;
+use warnings;
+use 5.012;
+
+use Moo;
+use DBD::Pg;
+
+has db   => ( is => 'rw' );
+has host => ( is => 'rw' );
+has user => ( is => 'rw' );
+
+sub BUILD { }
+
+sub tables {
+    my $self   = shift;
+    my $result = [];
+    for ( @{ $self->_make_request( $self->_get_tables_sql ) } ) {
+        push( @$result, $_->[0] );
+    }
+    return $result;
+}
+
+sub sequences {
+    my $self   = shift;
+    my $result = [];
+    for ( @{ $self->_make_request( $self->_get_sequences_sql ) } ) {
+        push( @$result, $_->[0] );
+    }
+    return $result;
+}
+
+sub partitions {
+    my $self   = shift;
+    my $result = [];
+    for ( @{ $self->_make_request( $self->_get_partitions_sql ) } ) {
+        push( @$result, $_->[0] );
+    }
+    return $result;
+}
+
+sub _get_tables_sql {
+    return qq(
+      SELECT table_name
+      FROM information_schema.tables
+      WHERE table_schema = 'public'
+      ORDER BY table_schema, table_name;
+    );
+}
+
+sub _get_sequences_sql {
+    return qq(
+      SELECT c.relname
+      FROM pg_class c
+      WHERE c.relkind = 'S';
+    );
+}
+
+sub _get_partitions_sql {
+    return qq(
+    SELECT child.relname
+      AS child_schema
+    FROM pg_inherits
+      JOIN pg_class parent ON pg_inherits.inhparent = parent.oid
+      JOIN pg_class child             ON pg_inherits.inhrelid   = child.oid
+      JOIN pg_namespace nmsp_parent   ON nmsp_parent.oid  = parent.relnamespace
+      JOIN pg_namespace nmsp_child    ON nmsp_child.oid   = child.relnamespace;
+    );
+}
+
+sub _make_request {
+    my $self = shift;
+    my $dbh  = DBI->connect(
+        "dbi:Pg:dbname=$self->{'db'};host=$self->{'host'}",
+        $self->{'user'},
+        '',
+    );
+    my $resp = $dbh->selectall_arrayref(shift);
+    $dbh->disconnect;
+    return $resp;
+}
+
+1;

lib/PostgresTools/Date.pm

@@ -0,0 +1,46 @@
+package PostgresTools::Date;
+
+use strict;
+use warnings;
+use 5.012;
+
+use Moo;
+use DateTime;
+
+sub BUILD { }
+
+sub date_from_string {
+    my $self   = shift;
+    my $string = shift;
+    if ( $string =~ m/\d{4}_\d{2}_\d{2}/ ) {
+        my ( $year, $month, $day ) = split( '_', $& );
+        return DateTime->new(
+            year  => $year,
+            month => $month,
+            day   => $day,
+        );
+    } else {
+        say "could not parse date, creating epoch date";
+        return DateTime->from_epoch(
+            epoch => 0,
+        );
+    }
+}
+
+sub older_than {
+    my $self     = shift;
+    my $date     = shift;
+    my $older    = shift;
+    my $duration = DateTime::Duration->new( days => $older );
+    my $old_date = DateTime->today()->subtract_duration($duration);
+    return $date->subtract_datetime($old_date)->is_positive;
+}
+
+sub older_than_from_string {
+    my $self  = shift;
+    my $date  = $self->date_from_string(shift);
+    my $older = shift;
+    return $self->older_than( $date, $older );
+}
+
+1;