App-MBUtiny
view release on metacpan or search on metacpan
lib/App/MBUtiny.pm view on Meta::CPAN
# Datadir & Tempdir
if ($self->option("datadir")) {
preparedir( $self->datadir() );
} else {
$self->datadir($self->tempdir());
}
preparedir( $self->tempdir() );
# Collector dir
my $dbdir = File::Spec->catdir(sharedstatedir(), PREFIX);
preparedir( $dbdir, 0777 ) unless -e $dbdir;
# Set paths
my $objdir = File::Spec->catdir($self->datadir, OBJECTS_DIR);
my $excdir = File::Spec->catdir($self->datadir, EXCLUDE_DIR);
my $rstdir = File::Spec->catdir($self->datadir, RESTORE_DIR);
$self->{objdir} = $objdir;
$self->{excdir} = $excdir;
$self->{rstdir} = $rstdir;
# Prepare dirs
preparedir({
objdir => $objdir,
excdir => $excdir,
rstdir => $rstdir,
});
# Set VoidFile
$self->{voidfile} = File::Spec->catfile($self->tempdir(), VOIDFILE);
touch($self->{voidfile});
# Set DBI
$self->{_dbi} = undef;
return $self->SUPER::again;
}
sub excdir {shift->{excdir}}
sub objdir {shift->{objdir}}
sub rstdir {shift->{rstdir}}
sub getdbi {shift->{_dbi}}
__PACKAGE__->register_handler(
handler => "configure",
description => sprintf("Configure %s", PROJECTNAME),
code => sub { shift->configure });
__PACKAGE__->register_handler(
handler => "config",
description => "Alias for configure command",
code => sub { shift->configure });
__PACKAGE__->register_handler(
handler => "test",
description => "Testing",
code => sub {
### CODE:
my ($self, $meta, @arguments) = @_;
$self->configure or return 0;
my $status = 1;
if ($self->testmode) {
say("CLI arguments: ", join("; ",@arguments) || 'none' );
say("Meta: ", explain($meta));
say("CTK object: ", explain($self));
say("App handlers: ", join(", ", $self->list_handlers));
return 1;
}
# Get host-list
my @hosts = $self->_getHosts();
unless (scalar(@hosts)) {
$self->log_warn("No enabled <Host> configuration section found");
return 1;
}
# Start
foreach my $pair (sort {(keys(%$a))[0] cmp (keys(%$b))[0]} @hosts) {
my @header;
my @errors;
my $step = '';
my $ostat = 1; # Operation status
#
# Init
#
my $name = _getName($pair); # Backup name
my $host = node($pair, $name); # Config section
my $hostskip = (!@arguments || grep {lc($name) eq lc($_)} @arguments) ? 0 : 1;
my $enabled = value($host, 'enable') ? 1 : 0;
if ($hostskip || !$enabled) {
$self->log_info("Skip testing for \"%s\" backup host section", $name);
next;
}
my $tbl = Text::SimpleTable->new(@{(TEST_HEADERS)});
$self->log_info("Start testing for \"%s\" backup host section", $name);
push @header, ["Backup name", $name];
push @errors, $self->getdbi->dsn, $self->getdbi->error, "" if $self->getdbi->error;
#
# Loading backup data
#
my $buday = (value($host, 'buday') // $self->config('buday')) || 0;
my $buweek = (value($host, 'buweek') // $self->config('buweek')) || 0;
my $bumonth = (value($host, 'bumonth') // $self->config('bumonth')) || 0;
push @header, (
["Daily backups", $buday],
["Weekly backups", $buweek],
["Monthly backups", $bumonth],
);
# Get mask vars
my $arc = $self->_getArc($host);
my $arcmask = value($host, 'arcmask') || ARC_MASK;
$arcmask =~ s/\[DEFAULT\]/ARC_MASK()/gie;
my %maskfmt = (
HOST => $name,
YEAR => '',
MONTH => '',
DAY => '',
EXT => value($arc, 'ext') || '',
);
push @header, ["Backup mask", $arcmask];
lib/App/MBUtiny.pm view on Meta::CPAN
#
# Testing storages
#
$step = "Storages testing";
$self->debug($step);
my $storage = new App::MBUtiny::Storage(
name => $name, # Backup name
host => $host, # Host config section
);
my $test = $storage->test or do {
$self->log_error($storage->error);
push @errors, $storage->error;
$ostat = 0;
};
{
my ($i, $j) = (0, 0);
foreach my $tr ($storage->test_report) {
my ($st, $vl, $er) = @$tr;
$j++ if $st && $st > 0;
$tbl->row(sprintf("Storage #%d", ++$i),
$vl, $st ? $st < 0 ? 'SKIP' : 'PASS' : 'FAIL'
);
push @errors, $er if $er;
}
$tbl->row($step,
$j ? sprintf("%d available storages found", $j) : "No available storages found",
$test ? $test < 0 ? 'SKIP' : 'PASS' : 'FAIL'
);
push @errors, "" unless $test;
}
#
# File list fetching
#
$step = "Get file list";
$self->debug($step);
my @filelist = $storage->list;
my $files_number = scalar(@filelist) || 0;
$tbl->row($step,
$files_number ? sprintf("%d files found", $files_number) : "No files found",
$storage->error ? 'FAIL' : $files_number ? 'PASS' : 'SKIP',
);
if ($storage->error) {
$self->log_error($storage->error);
push @errors, $storage->error, "";
$ostat = 0;
};
my $last_file = (sort {$b cmp $a} @filelist)[0];
if ($files_number && $last_file) {
push @header, ["Last backup file", $last_file];
my $list = hash($storage->{list});
foreach my $k (keys %$list) {
my $l = array($list, $k);
my $st = (grep {$_ eq $last_file} @$l) ? 1 : 0;
$tbl->row(sprintf("%s storage", $k),
$st ? sprintf("File %s is available", $last_file) : sprintf("File %s missing", $last_file),
$st ? 'PASS' : 'SKIP',
);
}
#say(explain($storage->{list}));
}
#
# Getting information about file on collector
#
my %info = $collector->info(name => $name, file => $last_file);
if ($collector->error) {
$self->log_error(sprintf("Collector error: %s", $collector->error));
push @errors, $collector->error, "";
}
if ($info{status}) {
push @header, (
["File size", $info{size}],
["File MD5", $info{md5}],
["File SHA1", $info{sha1}],
);
}
#
# Get SendMail config
#
my $sm = $self->_getSendmail($host);
my $to = uv2null(value($sm, "to"));
my $send_report = 1 if $to
&& ($to !~ /\@example.com$/)
&& (value($sm, "sendreport") || (value($sm, "senderrorreport") && !$ostat));
push @header, ["Send report to", $to] if $send_report;
#
# Report generate
#
$tbl->hr;
$tbl->row('RESULT',
$ostat ? 'All tests successful' : 'Errors have occurred!',
$ostat ? 'PASS' : 'FAIL'
);
push @header, ["Summary status", $ostat ? 'PASS' : 'FAIL'];
my @report;
my $report_name = $ostat ? "report" : "error report";
push @report, $self->_report_common(@header); # Common information
push @report, $self->_report_summary($ostat ? "All tests successful" : "Errors occurred while testing"); # Summary table
push @report, $tbl->draw() || ''; # Table
push @report, $self->_report_errors(@errors); # List of occurred errors
if ($TTY || $self->verbosemode) { # Draw to TTY
printf("%s\n\n", "~" x 94);
printf("The %s for %s backup host\n\n", $report_name, $name);
print join("\n", @report, "");
}
#
# SendMail (Send report)
#
if ($send_report) {
unshift @report, $self->_report_title($report_name, $name);
push @report, $self->_report_footer();
my %ma = (); foreach my $k (keys %$sm) { $ma{"-".$k} = $sm->{$k} };
lib/App/MBUtiny.pm view on Meta::CPAN
# Start
foreach my $pair (sort {(keys(%$a))[0] cmp (keys(%$b))[0]} @hosts) {
my @header;
my @errors;
my @paths_for_remove;
my $step = '';
my $ostat = 1; # Operation status
#
# Init
#
my $name = _getName($pair); # Backup name
my $host = node($pair, $name); # Config section
my $hostskip = (!@arguments || grep {lc($name) eq lc($_)} @arguments) ? 0 : 1;
my $enabled = value($host, 'enable') ? 1 : 0;
if ($hostskip || !$enabled) {
$self->log_info("Skip backup process for \"%s\" backup host section", $name);
next;
}
my $tbl = Text::SimpleTable->new(@{(TABLE_HEADERS)});
$self->log_info("Start backup process for \"%s\" backup host section", $name);
push @header, ["Backup name", $name];
push @errors, $self->getdbi->dsn, $self->getdbi->error, "" if $self->getdbi->error;
#
# Loading backup data
#
my $buday = (value($host, 'buday') // $self->config('buday')) || 0;
my $buweek = (value($host, 'buweek') // $self->config('buweek')) || 0;
my $bumonth = (value($host, 'bumonth') // $self->config('bumonth')) || 0;
push @header, (
["Daily backups", $buday],
["Weekly backups", $buweek],
["Monthly backups", $bumonth],
);
# Get mask vars
my $arc = $self->_getArc($host);
my $arcmask = value($host, 'arcmask') || ARC_MASK;
$arcmask =~ s/\[DEFAULT\]/ARC_MASK()/gie;
my %maskfmt = (
HOST => $name,
YEAR => '',
MONTH => '',
DAY => '',
EXT => value($arc, 'ext') || '',
);
push @header, ["Backup mask", $arcmask];
# Get saved dates
my @dates = $self->_getDates($buday, $buweek, $bumonth);
# Set exclusions files by dates
my %keepfiles;
foreach my $td (@dates) {
($maskfmt{YEAR}, $maskfmt{MONTH}, $maskfmt{DAY}) = ($1,$2,$3) if $td =~ /(\d{4})(\d{2})(\d{2})/;
$keepfiles{dformat($arcmask, {%maskfmt})} = $td;
}
#say(explain(\%keepfiles));
# Get objects
my $objects = array($host, 'object');
#
# Checking collectors
#
$step = "Collectors checking";
$self->debug($step);
my $collector = new App::MBUtiny::Collector(
collector_config => $self->_getCollector($host),
dbi => $self->getdbi, # For local storage only
);
my $colret = $collector->check;
if ($collector->error) {
$self->log_error(sprintf("Collector error: %s", $collector->error));
push @errors, $collector->error, "";
}
$tbl->row(dtf(DATE_FORMAT), $step,
$collector->error ? "No available collectors" : $colret,
$collector->error ? 'FAIL' : $colret ? 'PASS' : 'SKIP',
);
#
# Running triggers (commands)
# NOTE! Rundom order!
#
$step = "Triggers running";
$self->debug($step);
my $triggers = array($host, 'trigger');
my $i = 0;
foreach my $trg (@$triggers) {
my $exe_err = '';
my $exe_out = execute($trg, undef, \$exe_err);
my $exe_stt = ($? >> 8) ? 0 : 1;
if ($exe_stt) {
$self->debug(sprintf("# %s", $trg));
$self->debug(sprintf("%s\n", $exe_out))
if $self->verbosemode && defined($exe_out) && length($exe_out);
} else {
$self->log_error(sprintf("Trigger \"%s\":\n%s", $trg, $exe_err));
push @errors, sprintf("# %s", $trg), $exe_err, "";
}
$tbl->row(dtf(DATE_FORMAT), sprintf("Running trigger #%d", ++$i), $trg, $exe_stt ? 'PASS' : 'FAIL');
}
$tbl->row(dtf(DATE_FORMAT), $step, "No triggers found", 'SKIP') unless $i;
#
# Exclusion handling
#
# <Exclude ["sample"]> # -- SubDirectory name for EXCLUDE_DIR, optional
# Object /tmp/exclude1 # -- Source directory
# Target /tmp/exclude2 # -- Destination directory, optional
# Exclude file1.txt
# Exclude file2.txt
# Exclude foo/file2.txt
# </Exclude>
#
$step = "Exclusion handling";
$self->debug($step);
my $exclude_node = _node_correct(node($host, "exclude"), "object");
#say(explain($exclude_node));
$i = 0;
foreach my $exclude (@$exclude_node) {
my $sgn = sprintf("Exc copying #%d", ++$i);
my $exc_name = _getName($exclude);
my $exc_data = hash($exclude, $exc_name);
my $exc_object = uv2null(value($exc_data, "object"));
unless ($exc_object && (-e $exc_object and -d $exc_object)) {
$tbl->row(dtf(DATE_FORMAT), $sgn, sprintf("%s: %s", $exc_name, $exc_object || 'no object'), 'SKIP');
my $msg = sprintf("Object in <Exclude \"%s\"> section missing or incorrect directory \"%s\"", $exc_name, $exc_object);
$self->log_warning($msg);
push @errors, $msg, "";
next;
}
my $exc_target = value($exc_data, "target") || File::Spec->catdir($self->excdir, $exc_name);
if ($exc_target && -e $exc_target) {
$tbl->row(dtf(DATE_FORMAT), $sgn, sprintf("%s: %s", $exc_name, $exc_object), 'SKIP');
my $msg = sprintf("Target directory that specified in <Exclude \"%s\"> section already exists: \"%s\"", $exc_name, $exc_target);
$self->log_warning($msg);
push @errors, $msg, "";
next;
}
my $exc_exclude = array($exc_data, "exclude") || [];
$self->debug(sprintf("# X-Copy \"%s\" -> \"%s\"", $exc_object, $exc_target));
# Exclusive copying!
if (xcopy($exc_object, $exc_target, $exc_exclude)) {
$tbl->row(dtf(DATE_FORMAT), $sgn, sprintf("%s: %s", $exc_name, $exc_object), 'PASS');
push @$objects, $exc_target;
push @paths_for_remove, $exc_target;
} else {
$tbl->row(dtf(DATE_FORMAT), $sgn, sprintf("%s: %s", $exc_name, $exc_object), 'FAIL');
my $msg = sprintf("Copying directory \"%s\" to \"%s\" in exclusive mode failed!",
$exc_object, $exc_target
);
$self->log_error($msg);
push @errors, $msg, "";
}
}
#
# Objects checking
#
$step = "Objects checking";
$self->debug($step);
if (@$objects) {
my $j = 0; $i = 0;
foreach my $o (@$objects) {
my $st = (-e $o) ? 1 : 0;
$tbl->row(dtf(DATE_FORMAT), sprintf("Checking object #%d", ++$i), $o, $st ? 'PASS' : 'SKIP');
if ($st) { $j++ } else { $o = undef }
}
$tbl->row(dtf(DATE_FORMAT), $step,
$j ? sprintf("Will be processed %d objects", $j) : "No available objects found",
$j ? 'PASS' : 'FAIL');
} else {
$ostat = 0;
$tbl->row(dtf(DATE_FORMAT), $step, "Nothing to do! No objects found", 'FAIL');
}
lib/App/MBUtiny.pm view on Meta::CPAN
operation => $oper,
status => $stts,
error => $strg->error,
name => $name,
file => $archive_name,
size => $size,
md5 => $md5,
sha1 => $sha1,
comment => $cmnt,
);
}
if ($collector->error) {
my $msg = sprintf("Fixing error: %s", $collector->error);
$self->log_error($msg);
push @errors, $msg, "";
}
$tbl->row(dtf(DATE_FORMAT), "Fixing on collector",
$colret || "No available collectors found",
$collector->error ? 'FAIL' : $colret ? 'PASS' : 'SKIP',
);
},
);
my $test = $storage->test or do {
$self->log_error($storage->error);
push @errors, $storage->error;
$ostat = 0;
};
{
my $j = 0; $i = 0;
foreach my $tr ($storage->test_report) {
my ($st, $vl, $er) = @$tr;
$j++ if $st && $st > 0;
$tbl->row(dtf(DATE_FORMAT), sprintf("Testing storage #%d", ++$i),
$vl, $st ? $st < 0 ? 'SKIP' : 'PASS' : 'FAIL'
);
push @errors, $er if $er;
}
$tbl->row(dtf(DATE_FORMAT), $step,
$j ? sprintf("Will be used %d storages", $j) : "No available storages found",
$test ? $test < 0 ? 'SKIP' : 'PASS' : 'FAIL'
);
push @errors, "" unless $test;
}
#
# File list fetching
#
$step = "File list fetching";
$self->debug($step);
my @filelist = $storage->list;
$tbl->row(dtf(DATE_FORMAT), $step,
join("\n", @filelist) || "No files found",
$storage->error ? 'FAIL' : @filelist ? 'PASS' : 'SKIP',
);
if ($storage->error) {
$self->log_error($storage->error);
push @errors, $storage->error, "";
$ostat = 0;
};
#say(explain(\@filelist));
#
# Deleting old files
#
#say(explain(\%keepfiles));
$step = "Deleting old files";
$self->debug($step);
{
my $j = 0; $i = 0;
foreach my $f (@filelist) {
next if $keepfiles{$f};
my $st = -1; # SKIP
if ($test > 0) { # Test PASSed!
$st = $storage->del($f);
if ($st) {
$j++;
} else {
$self->log_error($storage->error);
push @errors, $storage->error, "";
$ostat = 0;
};
}
$tbl->row(dtf(DATE_FORMAT), sprintf("Deleting file #%d", ++$i),
$f,
$st ? $st < 0 ? 'SKIP' : 'PASS' : 'FAIL'
);
}
$tbl->row(dtf(DATE_FORMAT), $step,
$j ? sprintf("Were deleted %d files", $j) : "No files for delete found",
$test ? $test < 0 ? 'SKIP' : 'PASS' : 'FAIL'
);
}
#
# Backup archive
#
$step = "Backup performing";
$self->debug($step);
{
my $st = -1; # SKIP
if ($test > 0) { # Test PASSed!
$st = $storage->put(
name => $archive_name,
file => $archive_file,
size => $size,
);
unless ($st) {
$self->log_error($storage->error);
push @errors, $storage->error, "";
$ostat = 0;
};
}
$tbl->row(dtf(DATE_FORMAT), $step,
$archive_name,
$st ? $st < 0 ? 'SKIP' : 'PASS' : 'FAIL'
);
}
#
# Removing temporary data
#
$step = "Cleaning";
$self->debug($step);
lib/App/MBUtiny.pm view on Meta::CPAN
# Finish restore
$self->log_info("Finish restore process for \"%s\" backup host section", $name);
# General status
$status = 0 unless $ostat;
}
return $status;
});
__PACKAGE__->register_handler(
handler => "report",
description => "Reporting",
code => sub {
### CODE:
my ($self, $meta, @arguments) = @_;
$self->configure or return 0;
my $status = 1;
my @header;
my @errors;
my @comments;
# Get host-list
my @hosts = $self->_getHosts();
unless (scalar(@hosts)) {
$self->log_warn("No enabled <Host> configuration section found");
return 1;
}
#
# Init
#
my $tbl_report = Text::SimpleTable->new(@{(REPORT_TABLE_HEADERS)});
my $tbl_hosts = Text::SimpleTable->new(@{(REPORT_HOSTS_HEADERS)});
my $tbl_collectors = Text::SimpleTable->new(@{(REPORT_COLLECTORS_HEADERS)});
$self->log_info("Start reporting for \"%s\"", $hostname);
push @header, ["Hostname", $hostname];
push @errors, $self->getdbi->dsn, $self->getdbi->error, "" if $self->getdbi->error;
my @req_hosts = map {$_ = trim($_) } split(/\s+/, $self->config('require') || '');
#
# Hosts processing
#
my @collectors = ();
foreach my $pair (sort {(keys(%$a))[0] cmp (keys(%$b))[0]} @hosts) {
my $name = _getName($pair); # Backup name
my $host = node($pair, $name); # Config section
my $hostskip = (!@arguments || grep {lc($name) eq lc($_)} @arguments) ? 0 : 1;
my $enabled = value($host, 'enable') ? 1 : 0;
$tbl_hosts->row($name, ($hostskip || !$enabled) ? 'SKIP' : 'PASS');
if ($hostskip || !$enabled) {
$self->log_info("Skip reporting for \"%s\" backup host section", $name);
next;
}
my $lcols = $self->_getCollector($host);
push @collectors, @$lcols;
}
push @collectors, {} unless @collectors; # Default support
#say(explain(\@collectors));
#
# Select collectors
#
my %cols;
foreach my $col (@collectors) {
my $url = value($col, 'url') || 'local';
$cols{$url} = $col unless $cols{$url};
}
@collectors = values %cols;
#say(explain(\@collectors));
#
# Collectors checking
#
my @ok_collectors = ();
foreach my $col (@collectors) {
my $url = value($col, 'url') || 'local';
my $comment = value($col, 'comment');
my $collector = new App::MBUtiny::Collector(
collector_config => [$col],
dbi => $self->getdbi, # For local storage only
);
my $colret = $collector->check;
$tbl_collectors->row($colret, $collector->error ? 'FAIL' : $colret ? 'PASS' : 'SKIP');
push @comments, sprintf("%s: %s", $colret || $url, $comment), "" if $comment;
if ($collector->error) {
$self->log_error(sprintf("Collector error: %s", $collector->error));
push @errors, $collector->error, "";
next;
}
next unless $colret;
push @ok_collectors, $col
}
#
# Collectors processing
#
my @backups;
if (@ok_collectors) {
my $collector = new App::MBUtiny::Collector(
collector_config => [@ok_collectors],
dbi => $self->getdbi, # For local storage only
);
@backups = $collector->report(); # start => 1561799600;
if ($collector->error) {
$self->log_error(sprintf("Collector error: %s", $collector->error));
push @errors, $collector->error, "";
}
}
#
# Get report data about LAST backups on collector for each available host
#
my %requires;
foreach (@req_hosts) {$requires{$_} = 0};
foreach my $rec (@backups) {
push @comments, sprintf("%s: %s", uv2null($rec->{file}), $rec->{comment}), "" if $rec->{comment};
push @errors, uv2null($rec->{file}), $rec->{error}, "" if $rec->{error};
my $nm = $rec->{name} || 'virtual';
$tbl_report->row(
sprintf("%s\n%s", $nm, uv2null($rec->{addr})),
sprintf("%s\n%s (%s bytes)",
variant_stf(uv2null($rec->{file}), 32),
_fbytes(uv2zero($rec->{size})),
correct_number(uv2zero($rec->{size}))
),
uc(substr(int2type(uv2zero($rec->{type})), 0, 3)),
dtf(DATE_FORMAT, $rec->{'time'}),
$rec->{status} ? 'PASS' : 'FAIL',
lib/App/MBUtiny.pm view on Meta::CPAN
my @report;
my $report_name = $status ? "report" : "error report";
push @report, $self->_report_common(@header); # Common information
push @report, "Hosts:", $tbl_hosts->draw(); # Hosts table
push @report, "Collectors:", $tbl_collectors->draw(); # Hosts table
push @report, $self->_report_summary($status ? "All tests successful" : "Errors occurred while testing"); # Summary table
push @report, $tbl_report->draw(); # Report table
push @report, "Comments:", "", @comments, "" if @comments;
push @report, $self->_report_errors(@errors); # List of occurred errors
if ($TTY || $self->verbosemode) { # Draw to TTY
printf("%s\n\n", "~" x 106);
printf("The %s for all backup hosts on %s\n\n", $report_name, $hostname);
print join("\n", @report, "");
}
#
# SendMail (Send report)
#
if ($send_report) {
unshift @report, $self->_report_title($report_name, "last backups");
push @report, $self->_report_footer();
my %ma = (); foreach my $k (keys %$sm) { $ma{"-".$k} = $sm->{$k} };
$ma{"-subject"} = sprintf("%s %s (%s on %s)", PROJECTNAME, $report_name, "last backups", $hostname);
$ma{"-message"} = join("\n", @report);
# Send!
my $sent = sendmail(%ma);
if ($sent) { $self->debug(sprintf("Mail has been sent to: %s", $to)) }
else { $self->error(sprintf("Mail was not sent to: %s", $to)) }
}
# Finish reporting
$self->log_info("Finish reporting for \"%s\"", $hostname);
return $status;
});
sub configure {
my $self = shift;
my $config = $self->configobj;
# DBI object
my $dbi_conf = $self->config('dbi') || {};
$dbi_conf = {} unless is_hash($dbi_conf);
my $dbi = new App::MBUtiny::Collector::DBI(%$dbi_conf);
$self->{_dbi} = $dbi;
if ($config->status) {
$self->error($dbi->error) if $dbi->error;
return 1;
}
# Creting DB
if ($dbi->is_sqlite) {
printf("Creating local database %s...\n", $dbi->{file});
} else {
printf("Checking database %s...\n", $dbi->dsn);
}
if ($dbi->error) {
say "Fail.";
$self->error($dbi->error);
} else {
say "Done.";
}
# Creating configuration
my $skel = new CTK::Skel (
-name => PROJECTNAME,
-root => $self->root,
-skels => {
config => 'App::MBUtiny::ConfigSkel',
},
-vars => {
PROJECT => PROJECTNAME,
PROJECTNAME => PROJECTNAME,
PREFIX => PREFIX,
},
-debug => $self->debugmode,
);
#say("Skel object: ", explain($skel));
printf("Creating configuration to %s...\n", $self->root);
if ($skel->build("config")) {
$self->CTK::Plugin::Config::init;
$config = $self->configobj;
unless ($config->status) {
say "Fail.";
return 0;
}
say "Done.";
} else {
say "Fail.";
$self->error(sprintf("Can't %s initialize: %s", PREFIX, $self->root));
return 0;
}
return 1;
}
# Private methods
sub _getHosts { # Get host-sections as array of hashes
my $self = shift;
my $hosts = $self->config("host");
my @jobs = ();
if (ref($hosts) eq 'ARRAY') {
foreach my $r (@$hosts) {
if ((ref($r) eq 'HASH') && exists $r->{enable}) {
push @jobs, $r;
} elsif (ref($r) eq 'HASH') {
foreach my $k (keys %$r) {
push @jobs, { $k => $r->{$k} };
}
}
}
} elsif ((ref($hosts) eq 'HASH') && !exists $hosts->{enable}) {
foreach my $k (keys %$hosts) {
push @jobs, { $k => $hosts->{$k} };
}
} else {
push @jobs, $hosts;
}
return @jobs;
}
sub _getDates { # Get available dates
my $self = shift;
my $buday = shift || 0; # Dayly
my $buweek = shift || 0; # Weekly
my $bumonth = shift || 0; # Monthly
my %dates = ();
my $wcnt = 0;
my $mcnt = 0;
# Set period as maximum days to "back"
my $period = 7 * $buweek > $buday ? 7 * $buweek : $buday;
$period = 30 * $bumonth if 30 * $bumonth > $period;
for (my $i=0; $i<$period; $i++) {
my ( $y, $m, $d, $wd ) = (localtime( time - $i * 86400 ))[5,4,3,6];
my $date = sprintf( "%04d%02d%02d", ($y+1900), ($m+1), $d );
if (($i < $buday)
|| (($i < $buweek * 7) && $wd == 0) # do weekly backups on sunday
|| (($i < $bumonth * 30) && $d == 1)) # do monthly backups on 1-st day of month
{
$dates{ $date } = 1;
} else {
$dates{ $date } = 0;
}
if (($i < $buday) || (($wd == 0) && (($wcnt++) < $buweek)) || (($d == 1) && (($mcnt++) < $bumonth))) {
$dates{$date} ++;
}
( run in 1.023 second using v1.01-cache-2.11-cpan-d7a12ab2c7f )