6 use Pod::Usage; |
6 use Pod::Usage; |
7 use Getopt::Long; |
7 use Getopt::Long; |
8 use File::Basename; |
8 use File::Basename; |
9 use File::Spec::Functions; |
9 use File::Spec::Functions; |
10 |
10 |
11 use Data::Dumper; |
11 use Data::Dumper; |
12 |
12 |
13 my $opt_tasks; |
13 my $opt_tasks; |
14 my $opt_dry; |
14 my $opt_dry; |
15 my $opt_keep = undef; |
15 my $opt_keep = undef; |
16 my $opt_basedir = '.'; |
16 my $opt_basedir = '.'; |
17 my $opt_min_age = txt2days('1d'); |
17 my $opt_min_age = txt2days('1d'); |
18 |
18 |
19 my $dir_template = '$version-$cluster-$date'; # do not change! |
19 my $dir_template = '$version-$cluster-$date'; # do not change! |
20 |
20 |
21 delete @ENV{grep /^LC_/ => keys %ENV}; |
21 delete @ENV{ grep /^LC_/ => keys %ENV }; |
22 |
22 |
23 exit main() if not caller; |
23 exit main() if not caller; |
24 |
24 |
25 sub main { |
25 sub main { |
26 |
26 |
27 GetOptions( |
27 GetOptions( |
28 'k|keep=i' => \$opt_keep, |
28 'k|keep=i' => \$opt_keep, |
29 'd|basedir=s' => \$opt_basedir, |
29 'd|basedir=s' => \$opt_basedir, |
30 'dry' => \$opt_dry, |
30 'dry' => \$opt_dry, |
31 'min-age=s' => sub { $opt_min_age = txt2days($_[1]) }, |
31 'min-age=s' => sub { $opt_min_age = txt2days($_[1]) }, |
32 'h|help' => sub { pod2usage(-verbose => 1, -exit => 0) }, |
32 'h|help' => sub { pod2usage(-verbose => 1, -exit => 0) }, |
33 'm|man' => sub { pod2usage(-verbose => 2, -exit => 0, |
33 'm|man' => sub { |
34 -noperldoc => system('perldoc -V >/dev/null 2>&1')) }, |
34 pod2usage( |
35 ); |
35 -verbose => 2, |
36 |
36 -exit => 0, |
37 my @clusters = ls_clusters(); |
37 -noperldoc => system('perldoc -V >/dev/null 2>&1') |
38 |
38 ); |
39 # process the command line and get a list of tasks to do |
39 }, |
40 my @tasks = map { |
40 ); |
41 state $date = date(); |
41 |
42 my $version = $_->{version}; |
42 my @clusters = ls_clusters(); |
43 my $cluster = $_->{cluster}; |
43 |
44 my $dirname = eval "\"$dir_template\""; |
44 # process the command line and get a list of tasks to do |
45 $_->{dirname} = catfile($opt_basedir, $dirname); |
45 my @tasks = map { |
46 $_; |
46 state $date = date(); |
47 } sort do { |
47 my $version = $_->{version}; |
48 if (@ARGV) { |
48 my $cluster = $_->{cluster}; |
49 my $v = $ARGV[0]; |
49 my $dirname = eval "\"$dir_template\""; |
50 if (@ARGV > 1) { |
50 $_->{dirname} = catfile($opt_basedir, $dirname); |
51 my %h = map { $_->{cluster} => $_ } grep { $_->{version} eq $v } @clusters; |
51 $_; |
52 @h{@ARGV[1..$#ARGV]}; |
52 } sort do { |
53 } |
53 if (@ARGV) { |
54 else { |
54 my $v = $ARGV[0]; |
55 grep { $_->{version} eq $v } @clusters; |
55 if (@ARGV > 1) { |
56 } |
56 my %h = |
57 } |
57 map { $_->{cluster} => $_ } |
58 else { |
58 grep { $_->{version} eq $v } @clusters; |
59 grep { $_->{status} eq 'online' } @clusters; |
59 @h{ @ARGV[1 .. $#ARGV] }; |
60 } |
60 } |
61 }; |
61 else { |
62 |
62 grep { $_->{version} eq $v } @clusters; |
63 # now get the real jobe done |
63 } |
64 # run for all tasks, regardless of errors |
64 } |
65 |
65 else { |
66 foreach my $task (@tasks) { |
66 grep { $_->{status} eq 'online' } @clusters; |
67 |
67 } |
68 rmdir glob("$opt_basedir/*"); |
68 }; |
69 mkdir $task->{dirname} |
69 |
70 or die "$0: Can't mkdir $task->{dirname}: $!\n"; |
70 # now get the real jobe done |
71 |
71 # run for all tasks, regardless of errors |
72 my @cmd = (pg_basebackup => |
72 |
73 '--format' => 't', |
73 foreach my $task (@tasks) { |
74 '--xlog', |
74 |
75 '--cluster' => $task->{name}, |
75 rmdir glob("$opt_basedir/*"); |
76 '--pgdata' => $task->{dirname}, |
76 mkdir $task->{dirname} |
77 '--gzip', |
77 or die "$0: Can't mkdir $task->{dirname}: $!\n"; |
78 -t 0 ? '--progress' : ()); |
78 |
79 |
79 my @cmd = ( |
80 if ($opt_dry) { |
80 pg_basebackup => '--format' => 't', |
81 print sprintf "%s %s\n", $task->{name}, "@cmd"; |
81 '--xlog', |
82 $task->{exit} = 0; |
82 '--cluster' => $task->{name}, |
83 next; |
83 '--pgdata' => $task->{dirname}, |
84 } |
84 '--gzip', |
85 |
85 -t 0 ? '--progress' : () |
86 system @cmd; |
86 ); |
87 warn "$0: `@cmd` failed\n" if $?; |
87 |
88 $task->{exit} = $?; |
88 if ($opt_dry) { |
89 } |
89 print sprintf "%s %s\n", $task->{name}, "@cmd"; |
90 |
90 $task->{exit} = 0; |
91 # check the results |
91 next; |
92 |
92 } |
93 foreach my $task (@tasks) { |
93 |
94 printf "%-10s %-20s %s\n", |
94 system @cmd; |
95 $task->{exit} ? "FAIL:$task->{exit}" : 'OK', |
95 warn "$0: `@cmd` failed\n" if $?; |
96 $task->{cluster}, |
96 $task->{exit} = $?; |
97 $task->{dirname}; |
97 } |
98 } |
98 |
99 |
99 # check the results |
100 return 0 if not $opt_keep; |
100 |
101 |
101 foreach my $task (@tasks) { |
102 # care about the backups to keep, if everything went fine so far |
102 printf "%-10s %-20s %s\n", |
103 rmdir glob "$opt_basedir/*"; # remove empty directories |
103 $task->{exit} ? "FAIL:$task->{exit}" : 'OK', |
104 |
104 $task->{cluster}, |
105 foreach my $task (grep { !$_->{exit} } @tasks) { |
105 $task->{dirname}; |
106 # sorted list, from oldest to youngest backup |
106 } |
107 my @old = grep { -M > $opt_min_age } glob catfile $opt_basedir, do { |
107 |
108 my $version = $task->{version}; |
108 return 0 if not $opt_keep; |
109 my $cluster = $task->{cluster}; |
109 |
110 my $date = '*'; |
110 # care about the backups to keep, if everything went fine so far |
111 eval "\"$dir_template\""; |
111 rmdir glob "$opt_basedir/*"; # remove empty directories |
112 }; |
112 |
113 |
113 foreach my $task (grep { !$_->{exit} } @tasks) { |
114 if ($opt_keep <= @old) { |
114 |
115 splice @old, -1 * $opt_keep; |
115 # sorted list, from oldest to youngest backup |
116 foreach (@old) { |
116 my @old = grep { -M > $opt_min_age } glob catfile $opt_basedir, do { |
117 if ($opt_dry) { |
117 my $version = $task->{version}; |
118 print "would unlink $_\n"; |
118 my $cluster = $task->{cluster}; |
119 next; |
119 my $date = '*'; |
120 } |
120 eval "\"$dir_template\""; |
121 unlink glob "$_/*.tar.gz"; |
121 }; |
122 rmdir $_; |
122 |
123 } |
123 if ($opt_keep <= @old) { |
124 } |
124 splice @old, -1 * $opt_keep; |
125 |
125 foreach (@old) { |
126 } |
126 if ($opt_dry) { |
127 |
127 print "would unlink $_\n"; |
|
128 next; |
|
129 } |
|
130 unlink glob "$_/*.tar.gz"; |
|
131 rmdir $_; |
|
132 } |
|
133 } |
|
134 |
|
135 } |
|
136 |
128 } |
137 } |
129 |
138 |
130 sub date { |
139 sub date { |
131 my @now = localtime; |
140 my @now = localtime; |
132 sprintf '%4d-%02d-%02dT%02d-%02d-%02d', |
141 sprintf '%4d-%02d-%02dT%02d-%02d-%02d', |
133 $now[5]+1900, |
142 $now[5] + 1900, |
134 $now[4]+1, |
143 $now[4] + 1, |
135 $now[3], |
144 $now[3], |
136 @now[reverse 0..2]; |
145 @now[reverse 0 .. 2]; |
137 } |
146 } |
138 |
147 |
139 sub ls_clusters { |
148 sub ls_clusters { |
140 my @clusters; |
149 my @clusters; |
141 |
150 |
142 foreach ( map { [(split)[0..3]]} `pg_lsclusters -h` ) { |
151 foreach (map { [(split)[0 .. 3]] } `pg_lsclusters -h`) { |
143 push @clusters, { |
152 push @clusters, |
144 name => "$_->[0]/$_->[1]", |
153 { |
145 version => $_->[0], |
154 name => "$_->[0]/$_->[1]", |
146 cluster => $_->[1], |
155 version => $_->[0], |
147 port => $_->[2], |
156 cluster => $_->[1], |
148 status => $_->[3], |
157 port => $_->[2], |
149 }; |
158 status => $_->[3], |
150 } |
159 }; |
151 return @clusters; |
160 } |
152 }; |
161 return @clusters; |
|
162 } |
153 |
163 |
154 sub txt2days { |
164 sub txt2days { |
155 local $_ = shift; |
165 local $_ = shift; |
156 my $seconds; |
166 my $seconds; |
157 if (/(\d+)w/) { $seconds += $1 * 604800; } |
167 if (/(\d+)w/) { $seconds += $1 * 604800; } |
158 if (/(\d+)d/) { $seconds += $1 * 86400; } |
168 if (/(\d+)d/) { $seconds += $1 * 86400; } |
159 if (/(\d+)h/) { $seconds += $1 * 3600; } |
169 if (/(\d+)h/) { $seconds += $1 * 3600; } |
160 if (/(\d+)m/) { $seconds += $1 * 60; } |
170 if (/(\d+)m/) { $seconds += $1 * 60; } |
161 if (/(\d+)s?$/) { $seconds += $1; } |
171 if (/(\d+)s?$/) { $seconds += $1; } |
162 return $seconds/86400; |
172 return $seconds / 86400; |
163 } |
173 } |
164 |
174 |
165 exit main() if not caller; |
175 exit main() if not caller; |
166 |
|
167 |
176 |
168 __END__ |
177 __END__ |
169 |
178 |
170 =head1 NAME |
179 =head1 NAME |
171 |
180 |