Support Build.PL
authorHeiko <hs@schlittermann.de>
Wed, 29 Jul 2015 14:51:46 +0200
changeset 3 a9147d0306dd
parent 2 0d56836fdddc
child 4 265aec94f00b
Support Build.PL
.hgignore
Build.PL
MANIFEST
MANIFEST.SKIP
pg-backup
scripts/pg-backup
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/.hgignore	Wed Jul 29 14:51:46 2015 +0200
@@ -0,0 +1,7 @@
+blib/
+_build
+Build
+MANIFEST.SKIP.bak
+MANIFEST.bak
+MYMETA.json
+MYMETA.yml
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Build.PL	Wed Jul 29 14:51:46 2015 +0200
@@ -0,0 +1,16 @@
+use strict;
+use warnings;
+
+use Module::Build;
+
+Module::Build->new(
+	dist_name => 'pg-backup',
+	dist_author => 'Heiko Schlittermann <hs@schlittermann.de>',
+	dist_version_from => 'scripts/pg-backup',
+	dist_abstract => 'Backup all PG databases on the local host',
+
+	script_files => 'scripts/pg-backup',
+	requires => {
+		perl => '5.10.0',
+	},
+)->create_build_script;
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/MANIFEST	Wed Jul 29 14:51:46 2015 +0200
@@ -0,0 +1,4 @@
+.hgignore
+Build.PL
+MANIFEST			This list of files
+scripts/pg-backup
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/MANIFEST.SKIP	Wed Jul 29 14:51:46 2015 +0200
@@ -0,0 +1,75 @@
+
+#!start included /usr/share/perl/5.20/ExtUtils/MANIFEST.SKIP
+# Avoid version control files.
+\bRCS\b
+\bCVS\b
+\bSCCS\b
+,v$
+\B\.svn\b
+\B\.git\b
+\B\.gitignore\b
+\b_darcs\b
+\B\.cvsignore$
+
+# Avoid VMS specific MakeMaker generated files
+\bDescrip.MMS$
+\bDESCRIP.MMS$
+\bdescrip.mms$
+
+# Avoid Makemaker generated and utility files.
+\bMANIFEST\.bak
+\bMakefile$
+\bblib/
+\bMakeMaker-\d
+\bpm_to_blib\.ts$
+\bpm_to_blib$
+\bblibdirs\.ts$         # 6.18 through 6.25 generated this
+
+# Avoid Module::Build generated and utility files.
+\bBuild$
+\b_build/
+\bBuild.bat$
+\bBuild.COM$
+\bBUILD.COM$
+\bbuild.com$
+
+# Avoid temp and backup files.
+~$
+\.old$
+\#$
+\b\.#
+\.bak$
+\.tmp$
+\.#
+\.rej$
+
+# Avoid OS-specific files/dirs
+# Mac OSX metadata
+\B\.DS_Store
+# Mac OSX SMB mount metadata files
+\B\._
+
+# Avoid Devel::Cover and Devel::CoverX::Covered files.
+\bcover_db\b
+\bcovered\b
+
+# Avoid MYMETA files
+^MYMETA\.
+#!end included /usr/share/perl/5.20/ExtUtils/MANIFEST.SKIP
+
+# 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
+^\.hg/
+
+# Avoid archives of this distribution
+\bpg-backup-[\d\.\_]+
+\.sw.$
--- a/pg-backup	Tue Jul 28 18:10:37 2015 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,225 +0,0 @@
-#! /usr/bin/perl
-# (c) 2015 Heiko Schlittermann <hs@schlittermann.de>
-use strict;
-use 5.10.0;
-use warnings;
-use Pod::Usage;
-use Getopt::Long;
-use File::Basename;
-use File::Spec::Functions;
-
-use Data::Dumper;
-
-my $opt_tasks;
-my $opt_dry;
-my $opt_keep    = undef;
-my $opt_basedir = '.';
-my $opt_min_age = txt2days('1d');
-
-my $dir_template = '$version-$cluster-$date';    # do not change!
-
-delete @ENV{ grep /^LC_/ => keys %ENV };
-
-exit main() if not caller;
-
-sub main {
-
-    GetOptions(
-        'k|keep=i'    => \$opt_keep,
-        'd|basedir=s' => \$opt_basedir,
-        'dry'         => \$opt_dry,
-        'min-age=s'   => sub { $opt_min_age = txt2days($_[1]) },
-        'h|help'      => sub { pod2usage(-verbose => 1, -exit => 0) },
-        'm|man'       => sub {
-            pod2usage(
-                -verbose   => 2,
-                -exit      => 0,
-                -noperldoc => system('perldoc -V >/dev/null 2>&1')
-            );
-        },
-    );
-
-    my @clusters = ls_clusters();
-
-    # process the command line and get a list of tasks to do
-    my @tasks = map {
-        state $date = date();
-        my $version = $_->{version};
-        my $cluster = $_->{cluster};
-        my $dirname = eval "\"$dir_template\"";
-        $_->{dirname} = catfile($opt_basedir, $dirname);
-        $_;
-      } sort do {
-        if (@ARGV) {
-            my $v = $ARGV[0];
-            if (@ARGV > 1) {
-                my %h =
-                  map { $_->{cluster} => $_ }
-                  grep { $_->{version} eq $v } @clusters;
-                @h{ @ARGV[1 .. $#ARGV] };
-            }
-            else {
-                grep { $_->{version} eq $v } @clusters;
-            }
-        }
-        else {
-            grep { $_->{status} eq 'online' } @clusters;
-        }
-      };
-
-    # now get the real jobe done
-    # run for all tasks, regardless of errors
-
-    foreach my $task (@tasks) {
-
-        rmdir glob("$opt_basedir/*");
-        mkdir $task->{dirname}
-          or die "$0: Can't mkdir $task->{dirname}: $!\n";
-
-        my @cmd = (
-            pg_basebackup => '--format' => 't',
-            '--xlog',
-            '--cluster' => $task->{name},
-            '--pgdata'  => $task->{dirname},
-            '--gzip',
-            -t 0 ? '--progress' : ()
-        );
-
-        if ($opt_dry) {
-            print sprintf "%s %s\n", $task->{name}, "@cmd";
-            $task->{exit} = 0;
-            next;
-        }
-
-        system @cmd;
-        warn "$0: `@cmd` failed\n" if $?;
-        $task->{exit} = $?;
-    }
-
-    # check the results
-
-    foreach my $task (@tasks) {
-        printf "%-10s %-20s %s\n",
-          $task->{exit} ? "FAIL:$task->{exit}" : 'OK',
-          $task->{cluster},
-          $task->{dirname};
-    }
-
-    return 0 if not $opt_keep;
-
-    # care about the backups to keep, if everything went fine so far
-    rmdir glob "$opt_basedir/*";    # remove empty directories
-
-    foreach my $task (grep { !$_->{exit} } @tasks) {
-
-        # sorted list, from oldest to youngest backup
-        my @old = grep { -M > $opt_min_age } glob catfile $opt_basedir, do {
-            my $version = $task->{version};
-            my $cluster = $task->{cluster};
-            my $date    = '*';
-            eval "\"$dir_template\"";
-        };
-
-        if ($opt_keep <= @old) {
-            splice @old, -1 * $opt_keep;
-            foreach (@old) {
-                if ($opt_dry) {
-                    print "would unlink $_\n";
-                    next;
-                }
-                unlink glob "$_/*.tar.gz";
-                rmdir $_;
-            }
-        }
-
-    }
-
-}
-
-sub date {
-    my @now = localtime;
-    sprintf '%4d-%02d-%02dT%02d-%02d-%02d',
-      $now[5] + 1900,
-      $now[4] + 1,
-      $now[3],
-      @now[reverse 0 .. 2];
-}
-
-sub ls_clusters {
-    my @clusters;
-
-    foreach (map { [(split)[0 .. 3]] } `pg_lsclusters -h`) {
-        push @clusters,
-          {
-            name    => "$_->[0]/$_->[1]",
-            version => $_->[0],
-            cluster => $_->[1],
-            port    => $_->[2],
-            status  => $_->[3],
-          };
-    }
-    return @clusters;
-}
-
-sub txt2days {
-    local $_ = shift;
-    my $seconds;
-    if (/(\d+)w/)   { $seconds += $1 * 604800; }
-    if (/(\d+)d/)   { $seconds += $1 * 86400; }
-    if (/(\d+)h/)   { $seconds += $1 * 3600; }
-    if (/(\d+)m/)   { $seconds += $1 * 60; }
-    if (/(\d+)s?$/) { $seconds += $1; }
-    return $seconds / 86400;
-}
-
-exit main() if not caller;
-
-__END__
-
-=head1 NAME
- 
- pg-backup - backup all active PostgreSQL clusters
-
-=head1 SYNOPSIS
-
- pg-backup [options] [<version> [<cluster>]...]
-
-=head1 DESCRIPTION
-
-for all active PostgreSQL clusters and writes the backups as TAR archives.
-
-If a I<version> and optionally I<cluster>s are specified on the command line,
-all clusters (or the specified clusters) of the I<version> are saved.
-
-Without any I<version>/I<cluster> specification all B<online> clusters are backed up.
-
-=head1 OPTIONS
-
-=over
-
-=item B<-d>|B<--basedir> I<dir>
-
-The directory where the subdirectories for the backups will be placed. (default: F<.>)
-
-=item B<-k>|B<--keep> I<n>
-
-The number of generations to keep. Old backups will be only removed if B<all>
-specified backups succeed. (no default)
-
-=item B<--dry>
-
-Dry run, show what will be done. (default: undef)
-
-=item B<--min-age> I<time>
-
-The minimum age of old backups before the B<--keep> option tries to cleanup. 
-The timestamp of the directory with the tar archive is relevant. Nothing else!
-(default: 1d)
-
-=back
-
-=head1 AUTHOR
-
-Heiko Schlittermann L<mailto:hs@schlittermann.de>
-
-=cut
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/scripts/pg-backup	Wed Jul 29 14:51:46 2015 +0200
@@ -0,0 +1,234 @@
+#! /usr/bin/perl
+# (c) 2015 Heiko Schlittermann <hs@schlittermann.de>
+use strict;
+use 5.10.0;
+use warnings;
+use Pod::Usage;
+use Getopt::Long;
+use File::Basename;
+use File::Spec::Functions;
+
+our $VERSION = '0.1.0';
+
+my $opt_tasks;
+my $opt_dry;
+my $opt_keep;
+my $opt_basedir = '.';
+my $opt_min_age = txt2days('1d');
+
+my $dir_template = '$version-$cluster-$date';    # do not change!
+
+delete @ENV{ grep /^LC_/ => keys %ENV };
+
+exit main() if not caller;
+
+sub main {
+
+    GetOptions(
+        'k|keep=i'    => \$opt_keep,
+        'd|basedir=s' => \$opt_basedir,
+        'dry'         => \$opt_dry,
+        'min-age=s'   => sub { $opt_min_age = txt2days($_[1]) },
+        'h|help'      => sub { pod2usage(-verbose => 1, -exit => 0) },
+        'm|man'       => sub {
+            pod2usage(
+                -verbose   => 2,
+                -exit      => 0,
+                -noperldoc => system('perldoc -V >/dev/null 2>&1')
+            );
+        },
+    );
+
+    my @clusters = ls_clusters();
+
+    # process the command line and get a list of tasks to do
+    my @tasks = sort { $a->{name} cmp $b->{name} } map {
+        state $date = date();
+        my $version = $_->{version};
+        my $cluster = $_->{cluster};
+        my $dirname = eval "\"$dir_template\"";
+        $_->{dirname} = catfile($opt_basedir, $dirname);
+        $_;
+      } grep { defined and $_->{status} eq 'online' } do {
+        if (@ARGV) {
+            my $v = $ARGV[0];
+            if (@ARGV > 1) {
+                my %h =
+                  map { $_->{cluster} => $_ }
+                  grep { $_->{version} eq $v } @clusters;
+                @h{ @ARGV[1 .. $#ARGV] };
+            }
+            else {
+                grep { $_->{version} eq $v } @clusters;
+            }
+        }
+        else {
+			@clusters;
+		}
+      };
+
+	# check for consistency
+	if (@ARGV == 1 and !@tasks) {
+		die "$0: no tasks for version $ARGV[0]\n";
+	}
+	elsif (@ARGV > 1 and @tasks < @ARGV - 1) {
+		die "$0: no tasks for version $ARGV[0] and clusters @ARGV[1..$#ARGV]\n";
+	}
+
+    # now get the real jobe done
+    # run for all tasks, regardless of errors
+
+    foreach my $task (@tasks) {
+
+        rmdir glob("$opt_basedir/*");
+        mkdir $task->{dirname}
+          or die "$0: Can't mkdir $task->{dirname}: $!\n"
+	  	  unless $opt_dry;
+
+        my @cmd = (
+            pg_basebackup => '--format' => 't',
+            '--xlog',
+            '--cluster' => $task->{name},
+            '--pgdata'  => $task->{dirname},
+            '--gzip',
+            -t 0 ? '--progress' : ()
+        );
+
+        if ($opt_dry) {
+            print sprintf "%s %s\n", $task->{name}, "@cmd";
+            $task->{exit} = 0;
+            next;
+        }
+
+        system @cmd;
+        warn "$0: `@cmd` failed\n" if $?;
+        $task->{exit} = $?;
+    }
+
+    # check the results
+
+    foreach my $task (@tasks) {
+        printf "%-10s %-20s %s\n",
+          $task->{exit} ? "FAIL:$task->{exit}" : 'OK',
+          $task->{cluster},
+          $task->{dirname};
+    }
+
+    return 0 if not $opt_keep;
+
+    # care about the backups to keep, if everything went fine so far
+    rmdir glob "$opt_basedir/*";    # remove empty directories
+
+    foreach my $task (grep { !$_->{exit} } @tasks) {
+
+        # sorted list, from oldest to youngest backup
+        my @old = grep { -M > $opt_min_age } glob catfile $opt_basedir, do {
+            my $version = $task->{version};
+            my $cluster = $task->{cluster};
+            my $date    = '*';
+            eval "\"$dir_template\"";
+        };
+
+        if ($opt_keep <= @old) {
+            splice @old, -1 * $opt_keep;
+            foreach (@old) {
+                if ($opt_dry) {
+                    print "would unlink $_\n";
+                    next;
+                }
+                unlink glob "$_/*.tar.gz";
+                rmdir $_;
+            }
+        }
+
+    }
+
+}
+
+sub date {
+    my @now = localtime;
+    sprintf '%4d-%02d-%02dT%02d-%02d-%02d',
+      $now[5] + 1900,
+      $now[4] + 1,
+      $now[3],
+      @now[reverse 0 .. 2];
+}
+
+sub ls_clusters {
+    my @clusters;
+
+    foreach (map { [(split)[0 .. 3]] } `pg_lsclusters -h`) {
+        push @clusters,
+          {
+            name    => "$_->[0]/$_->[1]",
+            version => $_->[0],
+            cluster => $_->[1],
+            port    => $_->[2],
+            status  => $_->[3],
+          };
+    }
+    return @clusters;
+}
+
+sub txt2days {
+    local $_ = shift;
+    my $seconds;
+    if (/(\d+)w/)   { $seconds += $1 * 604800; }
+    if (/(\d+)d/)   { $seconds += $1 * 86400; }
+    if (/(\d+)h/)   { $seconds += $1 * 3600; }
+    if (/(\d+)m/)   { $seconds += $1 * 60; }
+    if (/(\d+)s?$/) { $seconds += $1; }
+    return $seconds / 86400;
+}
+
+exit main() if not caller;
+
+__END__
+
+=head1 NAME
+ 
+ pg-backup - backup all active PostgreSQL clusters
+
+=head1 SYNOPSIS
+
+ pg-backup [options] [<version> [<cluster>]...]
+
+=head1 DESCRIPTION
+
+for all active PostgreSQL clusters and writes the backups as TAR archives.
+
+If a I<version> and optionally I<cluster>s are specified on the command line,
+all clusters (or the specified clusters) of the I<version> are saved.
+
+Without any I<version>/I<cluster> specification all B<online> clusters are backed up.
+
+=head1 OPTIONS
+
+=over
+
+=item B<-d>|B<--basedir> I<dir>
+
+The directory where the subdirectories for the backups will be placed. (default: F<.>)
+
+=item B<-k>|B<--keep> I<n>
+
+The number of generations to keep. Old backups will be only removed if B<all>
+specified backups succeed. (no default)
+
+=item B<--dry>
+
+Dry run, show what will be done. (default: undef)
+
+=item B<--min-age> I<time>
+
+The minimum age of old backups before the B<--keep> option tries to cleanup. 
+The timestamp of the directory with the tar archive is relevant. Nothing else!
+(default: 1d)
+
+=back
+
+=head1 AUTHOR
+
+Heiko Schlittermann L<mailto:hs@schlittermann.de>
+
+=cut