App-MBUtiny

 view release on metacpan or  search on metacpan

lib/App/MBUtiny.pm  view on Meta::CPAN

__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;
    }

lib/App/MBUtiny.pm  view on Meta::CPAN

            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, "";

lib/App/MBUtiny.pm  view on Meta::CPAN

        # 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);

lib/App/MBUtiny.pm  view on Meta::CPAN

        #    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);

lib/App/MBUtiny.pm  view on Meta::CPAN

        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) {

lib/App/MBUtiny.pm  view on Meta::CPAN

        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(

lib/App/MBUtiny.pm  view on Meta::CPAN

        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");