root/trunk/omnipitr/lib/OmniPITR/Program/Backup/Master.pm

Revision 174, 23.0 kB (checked in by depesz, 8 years ago)

First stage of refactoring

Line 
1 package OmniPITR::Program::Backup::Master;
2 use strict;
3 use warnings;
4
5 use base qw( OmniPITR::Program );
6
7 use Carp;
8 use OmniPITR::Tools qw( :all );
9 use English qw( -no_match_vars );
10 use File::Basename;
11 use Sys::Hostname;
12 use POSIX qw( strftime );
13 use File::Spec;
14 use File::Path qw( mkpath rmtree );
15 use File::Copy;
16 use Storable;
17 use Cwd;
18 use Getopt::Long qw( :config no_ignore_case );
19
20 =head1 run()
21
22 Main function wrapping all work.
23
24 Starts with getting list of compressions that have to be done, then it chooses where to compress to (important if we have remote-only destination), then it makes actual backup, and delivers to all
25 destinations.
26
27 =cut
28
29 sub run {
30     my $self = shift;
31     $self->get_list_of_all_necessary_compressions();
32     $self->choose_base_local_destinations();
33
34     $self->start_pg_backup();
35     $self->compress_pgdata();
36
37     $self->stop_pg_backup();
38     $self->wait_for_final_xlog_and_remove_dst_backup();
39     $self->compress_xlogs();
40
41     $self->deliver_to_all_destinations();
42
43     $self->log->log( 'All done%s.', $self->{ 'had_errors' } ? ' with errors' : '' );
44     exit( 1 ) if $self->{ 'had_errors' };
45
46     return;
47 }
48
49 =head1 wait_for_file()
50
51 Helper function which waits for file to appear.
52
53 It will return only if the file appeared.
54
55 Return value is name of file.
56
57 =cut
58
59 sub wait_for_file {
60     my $self = shift;
61     my ( $dir, $filename_regexp ) = @_;
62
63     my $max_wait = 3600;    # It's 1 hour. There is no technical need to wait longer.
64     for my $i ( 0 .. $max_wait ) {
65         $self->log->log( 'Waiting for file matching %s in directory %s', $filename_regexp, $dir ) if 10 == $i;
66
67         opendir( my $dh, $dir ) or $self->clean_and_die( 'Cannot open %s for scanning: %s', $dir, $OS_ERROR );
68         my @matching = grep { $_ =~ $filename_regexp } readdir $dh;
69         closedir $dh;
70
71         if ( 0 == scalar @matching ) {
72             sleep 1;
73             next;
74         }
75
76         my $reply_filename = shift @matching;
77         $self->log->log( 'File %s arrived after %u seconds.', $reply_filename, $i ) if $self->verbose;
78         return $reply_filename;
79     }
80
81     $self->clean_and_die( 'Waited 1 hour for file matching %s, but it did not appear. Something is wrong. No sense in waiting longer.', $filename_regexp );
82
83     return;
84 }
85
86 =head1 wait_for_final_xlog_and_remove_dst_backup()
87
88 In PostgreSQL < 8.4 pg_stop_backup() finishes before .backup "wal segment" is archived.
89
90 So we need to wait till it appears in backup xlog destination before we can remove symlink.
91
92 =cut
93
94 sub wait_for_final_xlog_and_remove_dst_backup {
95     my $self = shift;
96
97     my $backup_file = $self->wait_for_file( $self->{ 'xlogs' }, $self->{ 'stop_backup_filename_re' } );
98
99     my $last_file = undef;
100
101     open my $fh, '<', File::Spec->catfile( $self->{ 'xlogs' }, $backup_file ) or $self->clean_and_die( 'Cannot open backup file %s for reading: %s', $backup_file, $OS_ERROR );
102     while ( my $line = <$fh> ) {
103         next unless $line =~ m{\A STOP \s+ WAL \s+ LOCATION: .* file \s+ ( [0-9A-f]{24} ) }x;
104         $last_file = qr{\A$1\z};
105         last;
106     }
107     close $fh;
108
109     $self->clean_and_die( '.backup file (%s) does not contain STOP WAL LOCATION line in recognizable format.', $backup_file ) unless $last_file;
110
111     $self->wait_for_file( $self->{ 'xlogs' }, $last_file );
112
113     unlink( $self->{ 'xlogs' } );
114 }
115
116 =head1 deliver_to_all_destinations()
117
118 Simple wrapper to have single point to call to deliver backups to all requested backups.
119
120 =cut
121
122 sub deliver_to_all_destinations {
123     my $self = shift;
124
125     $self->deliver_to_all_local_destinations();
126
127     $self->deliver_to_all_remote_destinations();
128
129     return;
130 }
131
132 =head1 deliver_to_all_local_destinations()
133
134 Copies backups to all local destinations which are not also base destinations for their respective compressions.
135
136 =cut
137
138 sub deliver_to_all_local_destinations {
139     my $self = shift;
140     return unless $self->{ 'destination' }->{ 'local' };
141     for my $dst ( @{ $self->{ 'destination' }->{ 'local' } } ) {
142         next if $dst->{ 'path' } eq $self->{ 'base' }->{ $dst->{ 'compression' } };
143
144         my $B = $self->{ 'base' }->{ $dst->{ 'compression' } };
145
146         for my $type ( qw( data xlog ) ) {
147
148             my $filename = $self->get_archive_filename( $type, $dst->{ 'compression' } );
149             my $source_filename = File::Spec->catfile( $B, $filename );
150             my $destination_filename = File::Spec->catfile( $dst->{ 'path' }, $filename );
151
152             my $time_msg = sprintf 'Copying %s to %s', $source_filename, $destination_filename;
153             $self->log->time_start( $time_msg ) if $self->verbose;
154
155             my $rc = copy( $source_filename, $destination_filename );
156
157             $self->log->time_finish( $time_msg ) if $self->verbose;
158
159             unless ( $rc ) {
160                 $self->log->error( 'Cannot copy %s to %s : %s', $source_filename, $destination_filename, $OS_ERROR );
161                 $self->{ 'had_errors' } = 1;
162             }
163
164         }
165     }
166     return;
167 }
168
169 =head1 deliver_to_all_remote_destinations()
170
171 Delivers backups to remote destinations using rsync program.
172
173 =cut
174
175 sub deliver_to_all_remote_destinations {
176     my $self = shift;
177     return unless $self->{ 'destination' }->{ 'remote' };
178     for my $dst ( @{ $self->{ 'destination' }->{ 'remote' } } ) {
179
180         my $B = $self->{ 'base' }->{ $dst->{ 'compression' } };
181
182         for my $type ( qw( data xlog ) ) {
183
184             my $filename = $self->get_archive_filename( $type, $dst->{ 'compression' } );
185             my $source_filename = File::Spec->catfile( $B, $filename );
186             my $destination_filename = $dst->{ 'path' };
187             $destination_filename =~ s{/*\z}{/};
188             $destination_filename .= $filename;
189
190             my $time_msg = sprintf 'Copying %s to %s', $source_filename, $destination_filename;
191             $self->log->time_start( $time_msg ) if $self->verbose;
192
193             my $response = run_command( $self->{ 'temp-dir' }, $self->{ 'rsync-path' }, $source_filename, $destination_filename );
194
195             $self->log->time_finish( $time_msg ) if $self->verbose;
196
197             if ( $response->{ 'error_code' } ) {
198                 $self->log->error( 'Cannot send archive %s to %s: %s', $source_filename, $destination_filename, $response );
199                 $self->{ 'had_errors' } = 1;
200             }
201         }
202     }
203     return;
204 }
205
206 =head1 compress_xlogs()
207
208 Wrapper function which encapsulates all work required to compress xlog segments that accumulated during backup of data directory.
209
210 =cut
211
212 sub compress_xlogs {
213     my $self = shift;
214     $self->log->time_start( 'Compressing xlogs' ) if $self->verbose;
215     $self->start_writers( 'xlog' );
216
217     $self->tar_and_compress(
218         'work_dir' => $self->{ 'xlogs' } . '.real',
219         'tar_dir'  => basename( $self->{ 'data-dir' } ),
220     );
221     $self->log->time_finish( 'Compressing xlogs' ) if $self->verbose;
222     rmtree( $self->{ 'xlogs' } . '.real', 0 );
223
224     return;
225 }
226
227 =head1 compress_pgdata()
228
229 Wrapper function which encapsulates all work required to compress data directory.
230
231 =cut
232
233 sub compress_pgdata {
234     my $self = shift;
235     $self->log->time_start( 'Compressing $PGDATA' ) if $self->verbose;
236     $self->start_writers( 'data' );
237
238     my @excludes = qw( pg_log/* pg_xlog/0* pg_xlog/archive_status/* postmaster.pid );
239     for my $dir ( qw( pg_log pg_xlog ) ) {
240         push @excludes, $dir if -l File::Spec->catfile( $self->{ 'data-dir' }, $dir );
241     }
242
243     $self->tar_and_compress(
244         'work_dir' => dirname( $self->{ 'data-dir' } ),
245         'tar_dir'  => basename( $self->{ 'data-dir' } ),
246         'excludes' => \@excludes,
247     );
248
249     $self->log->time_finish( 'Compressing $PGDATA' ) if $self->verbose;
250     return;
251 }
252
253 =head1 tar_and_compress()
254
255 Worker function which does all of the actual tar, and sending data to compression filehandles.
256
257 Takes hash (not hashref) as argument, and uses following keys from it:
258
259 =over
260
261 =item * tar_dir - which directory to compress
262
263 =item * work_dir - what should be current working directory when executing tar
264
265 =item * excludes - optional key, that (if exists) is treated as arrayref of shell globs (tar dir) of items to exclude from backup
266
267 =back
268
269 If tar will print anything to STDERR it will be logged. Error status code is ignored, as it is expected that tar will generate errors (due to files modified while archiving).
270
271 =cut
272
273 sub tar_and_compress {
274     my $self = shift;
275     my %ARGS = @_;
276
277     $SIG{ 'PIPE' } = sub { $self->clean_and_die( 'Got SIGPIPE while tarring %s for %s', $ARGS{ 'tar_dir' }, $self->{ 'sigpipeinfo' } ); };
278
279     my @compression_command = ( $self->{ 'nice-path' }, $self->{ 'tar-path' }, 'cf', '-' );
280     if ( $ARGS{ 'excludes' } ) {
281         push @compression_command, map { sprintf '--exclude=%s/%s', $ARGS{ 'tar_dir' }, $_ } @{ $ARGS{ 'excludes' } };
282     }
283     push @compression_command, $ARGS{ 'tar_dir' };
284
285     my $compression_str = join ' ', map { quotemeta $_ } @compression_command;
286
287     $self->prepare_temp_directory();
288     my $tar_stderr_filename = File::Spec->catfile( $self->{ 'temp-dir' }, 'tar.stderr' );
289     $compression_str .= ' 2> ' . quotemeta( $tar_stderr_filename );
290
291     my $previous_dir = getcwd;
292     chdir $ARGS{ 'work_dir' } if $ARGS{ 'work_dir' };
293
294     my $tar;
295     unless ( open $tar, '-|', $compression_str ) {
296         $self->clean_and_die( 'Cannot start tar (%s) : %s', $compression_str, $OS_ERROR );
297     }
298
299     chdir $previous_dir if $ARGS{ 'work_dir' };
300
301     my $buffer;
302     while ( my $len = sysread( $tar, $buffer, 8192 ) ) {
303         while ( my ( $type, $fh ) = each %{ $self->{ 'writers' } } ) {
304             $self->{ 'sigpipeinfo' } = $type;
305             my $written = syswrite( $fh, $buffer, $len );
306             next if $written == $len;
307             $self->clean_and_die( "Writting %u bytes to filehandle for <%s> compression wrote only %u bytes ?!", $len, $type, $written );
308         }
309     }
310     close $tar;
311
312     for my $fh ( values %{ $self->{ 'writers' } } ) {
313         close $fh;
314     }
315
316     delete $self->{ 'writers' };
317
318     my $stderr_output;
319     my $stderr;
320     unless ( open $stderr, '<', $tar_stderr_filename ) {
321         $self->log->log( 'Cannot open tar stderr file (%s) for reading: %s', $tar_stderr_filename );
322         return;
323     }
324     {
325         local $/;
326         $stderr_output = <$stderr>;
327     };
328     close $stderr;
329     return unless $stderr_output;
330     $self->log->log( 'Tar (%s) generated these output on stderr:', $compression_str );
331     $self->log->log( '==============================================' );
332     $self->log->log( '%s', $stderr_output );
333     $self->log->log( '==============================================' );
334     unlink $tar_stderr_filename;
335     return;
336 }
337
338 =head1 start_writers()
339
340 Starts set of filehandles, which write to file, or to compression program, to create final archives.
341
342 Each compression schema gets its own filehandle, and printing data to it, will pass it to file directly or through compression program that has been chosen based on command line arguments.
343
344 =cut
345
346 sub start_writers {
347     my $self      = shift;
348     my $data_type = shift;
349
350     my %writers = ();
351
352     COMPRESSION:
353     while ( my ( $type, $dst_path ) = each %{ $self->{ 'base' } } ) {
354         my $filename = $self->get_archive_filename( $data_type, $type );
355
356         my $full_file_path = File::Spec->catfile( $dst_path, $filename );
357
358         if ( $type eq 'none' ) {
359             if ( open my $fh, '>', $full_file_path ) {
360                 $writers{ $type } = $fh;
361                 $self->log->log( "Starting \"none\" writer to $full_file_path" ) if $self->verbose;
362                 next COMPRESSION;
363             }
364             $self->clean_and_die( 'Cannot write to %s : %s', $full_file_path, $OS_ERROR );
365         }
366
367         my @command = map { quotemeta $_ } ( $self->{ 'nice-path' }, $self->{ $type . '-path' }, '--stdout', '-' );
368         push @command, ( '>', quotemeta( $full_file_path ) );
369
370         $self->log->log( "Starting \"%s\" writer to %s", $type, $full_file_path ) if $self->verbose;
371         if ( open my $fh, '|-', join( ' ', @command ) ) {
372             $writers{ $type } = $fh;
373             next COMPRESSION;
374         }
375         $self->clean_and_die( 'Cannot open command. Error: %s, Command: %s', $OS_ERROR, \@command );
376     }
377     $self->{ 'writers' } = \%writers;
378     return;
379 }
380
381 =head1 get_archive_filename()
382
383 Helper function, which takes filetype and compression schema to use, and returns generated filename (based on filename-template command line option).
384
385 =cut
386
387 sub get_archive_filename {
388     my $self = shift;
389     my ( $type, $compression ) = @_;
390
391     my $ext = $compression eq 'none' ? '' : ext_for_compression( $compression );
392
393     my $filename = $self->{ 'filename-template' };
394     $filename =~ s/__FILETYPE__/$type/g;
395     $filename =~ s/__CEXT__/$ext/g;
396
397     return $filename;
398 }
399
400 =head1 stop_pg_backup()
401
402 Runs pg_stop_backup() PostgreSQL function, which is crucial in backup process.
403
404 This happens after data directory compression, but before compression of xlogs.
405
406 This function also removes temporary destination for xlogs (dst-backup for omnipitr-archive).
407
408 =cut
409
410 sub stop_pg_backup {
411     my $self = shift;
412
413     $self->prepare_temp_directory();
414
415     my @command = ( @{ $self->{ 'psql' } }, "SELECT pg_stop_backup()" );
416
417     $self->log->time_start( 'pg_stop_backup()' ) if $self->verbose;
418     my $status = run_command( $self->{ 'temp-dir' }, @command );
419     $self->log->time_finish( 'pg_stop_backup()' ) if $self->verbose;
420
421     $self->clean_and_die( 'Running pg_stop_backup() failed: %s', $status ) if $status->{ 'error_code' };
422
423     $status->{ 'stdout' } =~ s/\s*\z//;
424     $self->log->log( q{pg_stop_backup('omnipitr') returned %s.}, $status->{ 'stdout' } );
425
426     my $subdir = basename( $self->{ 'data-dir' } );
427
428     return;
429 }
430
431 =head1 start_pg_backup()
432
433 Executes pg_start_backup() postgresql function, and (before it) creates temporary destination for xlogs (dst-backup for omnipitr-archive).
434
435 =cut
436
437 sub start_pg_backup {
438     my $self = shift;
439
440     my $subdir = basename( $self->{ 'data-dir' } );
441     $self->clean_and_die( 'Cannot create directory %s : %s', $self->{ 'xlogs' } . '.real',                 $OS_ERROR ) unless mkdir( $self->{ 'xlogs' } . '.real' );
442     $self->clean_and_die( 'Cannot create directory %s : %s', $self->{ 'xlogs' } . ".real/$subdir",         $OS_ERROR ) unless mkdir( $self->{ 'xlogs' } . ".real/$subdir" );
443     $self->clean_and_die( 'Cannot create directory %s : %s', $self->{ 'xlogs' } . ".real/$subdir/pg_xlog", $OS_ERROR ) unless mkdir( $self->{ 'xlogs' } . ".real/$subdir/pg_xlog" );
444     $self->clean_and_die( 'Cannot symlink %s to %s: %s', $self->{ 'xlogs' } . ".real/$subdir/pg_xlog", $self->{ 'xlogs' }, $OS_ERROR )
445         unless symlink( $self->{ 'xlogs' } . ".real/$subdir/pg_xlog", $self->{ 'xlogs' } );
446
447     $self->prepare_temp_directory();
448
449     my @command = ( @{ $self->{ 'psql' } }, "SELECT pg_start_backup('omnipitr')" );
450
451     $self->log->time_start( 'pg_start_backup()' ) if $self->verbose;
452     my $status = run_command( $self->{ 'temp-dir' }, @command );
453     $self->log->time_finish( 'pg_start_backup()' ) if $self->verbose;
454
455     $self->clean_and_die( 'Running pg_start_backup() failed: %s', $status ) if $status->{ 'error_code' };
456
457     $status->{ 'stdout' } =~ s/\s*\z//;
458     $self->log->log( q{pg_start_backup('omnipitr') returned %s.}, $status->{ 'stdout' } );
459     $self->clean_and_die( 'Ouput from pg_start_backup is not parseable?!' ) unless $status->{ 'stdout' } =~ m{\A([0-9A-F]+)/([0-9A-F]{1,8})\z};
460
461     my ( $part_1, $part_2 ) = ( $1, $2 );
462     $part_2 =~ s/(.{1,6})\z//;
463     my $part_3 = $1;
464
465     my $expected_filename_suffix = sprintf '%08s%08s.%08s.backup', $part_1, $part_2, $part_3;
466     my $backup_filename_re = qr{\A[0-9A-F]{8}\Q$expected_filename_suffix\E\z};
467
468     $self->{ 'stop_backup_filename_re' } = $backup_filename_re;
469     $self->{ 'pg_start_backup_done' }    = 1;
470
471     return;
472 }
473
474 =head1 clean_and_die()
475
476 Helper function called by other parts of code - removes temporary destination for xlogs, and exits program with logging passed message.
477
478 =cut
479
480 sub clean_and_die {
481     my $self          = shift;
482     my @msg_with_args = @_;
483     rmtree( [ $self->{ 'xlogs' } . '.real', $self->{ 'xlogs' } ], 0, );
484     $self->stop_pg_backup() if $self->{ 'pg_start_backup_done' };
485     $self->log->fatal( @msg_with_args );
486 }
487
488 =head1 choose_base_local_destinations()
489
490 Chooses single local destination for every compression schema required by destinations specifications.
491
492 In case some compression schema exists only for remote destination, local temp directory is created in --temp-dir location.
493
494 =cut
495
496 sub choose_base_local_destinations {
497     my $self = shift;
498
499     my $base = { map { ( $_ => undef ) } @{ $self->{ 'compressions' } } };
500     $self->{ 'base' } = $base;
501
502     for my $dst ( @{ $self->{ 'destination' }->{ 'local' } } ) {
503         my $type = $dst->{ 'compression' };
504         next if defined $base->{ $type };
505         $base->{ $type } = $dst->{ 'path' };
506     }
507
508     my @unfilled = grep { !defined $base->{ $_ } } keys %{ $base };
509
510     return if 0 == scalar @unfilled;
511     $self->log->log( 'These compression(s) were given only for remote destinations. Usually this is not desired: %s', join( ', ', @unfilled ) );
512
513     $self->prepare_temp_directory();
514     for my $type ( @unfilled ) {
515         my $tmp_dir = File::Spec->catfile( $self->{ 'temp-dir' }, $type );
516         mkpath( $tmp_dir );
517         $base->{ $type } = $tmp_dir;
518     }
519
520     return;
521 }
522
523 =head1 DESTROY()
524
525 Destroctor for object - removes temp directory on program exit.
526
527 =cut
528
529 sub DESTROY {
530     my $self = shift;
531     return unless $self->{ 'temp-dir-prepared' };
532     rmtree( [ $self->{ 'temp-dir-prepared' } ], 0 );
533     return;
534 }
535
536 =head1 read_args()
537
538 Function which does all the parsing, and transformation of command line arguments.
539
540 =cut
541
542 sub read_args {
543     my $self = shift;
544
545     my @argv_copy = @ARGV;
546
547     my %args = (
548         'temp-dir' => $ENV{ 'TMPDIR' } || '/tmp',
549         'gzip-path'         => 'gzip',
550         'bzip2-path'        => 'bzip2',
551         'lzma-path'         => 'lzma',
552         'tar-path'          => 'tar',
553         'nice-path'         => 'nice',
554         'psql-path'         => 'psql',
555         'rsync-path'        => 'rsync',
556         'database'          => 'postgres',
557         'filename-template' => '__HOSTNAME__-__FILETYPE__-^Y-^m-^d.tar__CEXT__',
558     );
559
560     croak( 'Error while reading command line arguments. Please check documentation in doc/omnipitr-backup-master.pod' )
561         unless GetOptions(
562         \%args,
563         'data-dir|D=s',
564         'database|d=s',
565         'host|h=s',
566         'port|p=i',
567         'username|U=s',
568         'xlogs|x=s',
569         'dst-local|dl=s@',
570         'dst-remote|dr=s@',
571         'temp-dir|t=s',
572         'log|l=s',
573         'filename-template|f=s',
574         'pid-file',
575         'verbose|v',
576         'gzip-path|gp=s',
577         'bzip2-path|bp=s',
578         'lzma-path|lp=s',
579         'nice-path|np=s',
580         'psql-path|pp=s',
581         'tar-path|tp=s',
582         'rsync-path|rp=s',
583         );
584
585     croak( '--log was not provided - cannot continue.' ) unless $args{ 'log' };
586     for my $key ( qw( log filename-template ) ) {
587         $args{ $key } =~ tr/^/%/;
588     }
589
590     for my $key ( grep { !/^dst-(?:local|remote)$/ } keys %args ) {
591         $self->{ $key } = $args{ $key };
592     }
593
594     for my $type ( qw( local remote ) ) {
595         my $D = [];
596         $self->{ 'destination' }->{ $type } = $D;
597
598         next unless defined $args{ 'dst-' . $type };
599
600         my %temp_for_uniq = ();
601         my @items = grep { !$temp_for_uniq{ $_ }++ } @{ $args{ 'dst-' . $type } };
602
603         for my $item ( @items ) {
604             my $current = { 'compression' => 'none', };
605             if ( $item =~ s/\A(gzip|bzip2|lzma)=// ) {
606                 $current->{ 'compression' } = $1;
607             }
608             $current->{ 'path' } = $item;
609             push @{ $D }, $current;
610         }
611     }
612
613     $self->{ 'filename-template' } = strftime( $self->{ 'filename-template' }, localtime time() );
614     $self->{ 'filename-template' } =~ s/__HOSTNAME__/hostname()/ge;
615
616     # We do it here so it will actually work for reporing problems in validation
617     $self->{ 'log_template' } = $args{ 'log' };
618     $self->{ 'log' }          = OmniPITR::Log->new( $self->{ 'log_template' } );
619
620     $self->log->log( 'Called with parameters: %s', join( ' ', @argv_copy ) ) if $self->verbose;
621
622     my @psql = ();
623     push @psql, $self->{ 'psql-path' };
624     push @psql, '-qAtX';
625     push @psql, ( '-U', $self->{ 'username' } ) if $self->{ 'username' };
626     push @psql, ( '-d', $self->{ 'database' } ) if $self->{ 'database' };
627     push @psql, ( '-h', $self->{ 'host' } )     if $self->{ 'host' };
628     push @psql, ( '-p', $self->{ 'port' } )     if $self->{ 'port' };
629     push @psql, '-c';
630     $self->{ 'psql' } = \@psql;
631
632     return;
633 }
634
635 =head1 validate_args()
636
637 Does all necessary validation of given command line arguments.
638
639 One exception is for compression programs paths - technically, it could be validated in here, but benefit would be pretty limited, and code to do so relatively complex, as compression program path
640 might, but doesn't have to be actual file path - it might be just program name (without path), which is the default.
641
642 =cut
643
644 sub validate_args {
645     my $self = shift;
646
647     $self->log->fatal( 'Data-dir was not provided!' ) unless defined $self->{ 'data-dir' };
648     $self->log->fatal( 'Provided data-dir (%s) does not exist!',   $self->{ 'data-dir' } ) unless -e $self->{ 'data-dir' };
649     $self->log->fatal( 'Provided data-dir (%s) is not directory!', $self->{ 'data-dir' } ) unless -d $self->{ 'data-dir' };
650     $self->log->fatal( 'Provided data-dir (%s) is not readable!',  $self->{ 'data-dir' } ) unless -r $self->{ 'data-dir' };
651
652     my $dst_count = scalar( @{ $self->{ 'destination' }->{ 'local' } } ) + scalar( @{ $self->{ 'destination' }->{ 'remote' } } );
653     $self->log->fatal( "No --dst-* has been provided!" ) if 0 == $dst_count;
654
655     $self->log->fatal( "Filename template does not contain __FILETYPE__ placeholder!" ) unless $self->{ 'filename-template' } =~ /__FILETYPE__/;
656     $self->log->fatal( "Filename template cannot contain / or \\ characters!" ) if $self->{ 'filename-template' } =~ m{[/\\]};
657
658     $self->log->fatal( "Xlogs dir (--xlogs) was not given! Cannot work without it" ) unless defined $self->{ 'xlogs' };
659     $self->{ 'xlogs' } =~ s{/+$}{};
660     $self->log->fatal( "Xlogs dir (%s) already exists! It shouldn't.",           $self->{ 'xlogs' } ) if -e $self->{ 'xlogs' };
661     $self->log->fatal( "Xlogs side dir (%s.real) already exists! It shouldn't.", $self->{ 'xlogs' } ) if -e $self->{ 'xlogs' } . '.real';
662
663     my $xlog_parent = dirname( $self->{ 'xlogs' } );
664     $self->log->fatal( 'Xlogs dir (%s) parent (%s) does not exist. Cannot continue.',   $self->{ 'xlogs' }, $xlog_parent ) unless -e $xlog_parent;
665     $self->log->fatal( 'Xlogs dir (%s) parent (%s) is not directory. Cannot continue.', $self->{ 'xlogs' }, $xlog_parent ) unless -d $xlog_parent;
666     $self->log->fatal( 'Xlogs dir (%s) parent (%s) is not writable. Cannot continue.',  $self->{ 'xlogs' }, $xlog_parent ) unless -w $xlog_parent;
667
668     return unless $self->{ 'destination' }->{ 'local' };
669
670     for my $d ( @{ $self->{ 'destination' }->{ 'local' } } ) {
671         my $dir = $d->{ 'path' };
672         $self->log->fatal( 'Choosen local destination dir (%s) does not exist. Cannot continue.',   $dir ) unless -e $dir;
673         $self->log->fatal( 'Choosen local destination dir (%s) is not directory. Cannot continue.', $dir ) unless -d $dir;
674         $self->log->fatal( 'Choosen local destination dir (%s) is not writable. Cannot continue.',  $dir ) unless -w $dir;
675     }
676
677     return;
678 }
679
680 1;
Note: See TracBrowser for help on using the browser.