view release on metacpan or  search on metacpan

lib/App/SCM/Digest.pm  view on Meta::CPAN

{
    my ($self, $method) = @_;

    my $config = $self->{'config'};

    my ($repo_path, $db_path, $repositories) =
        @{$config}{qw(repository_path db_path repositories)};

    for my $repository (@{$repositories}) {
        eval {
            $method->($repo_path, $db_path, $repository);
        };
        if (my $error = $@) {
            chdir $repo_path;
            my ($name, $impl) = _load_repository($repository);
            my $backup_dir = tempdir(CLEANUP => 1);
            my $backup_path = $backup_dir.'/temporary';
            my $do_backup = (-e $name);
            if ($do_backup) {
                my $res = move($name, $backup_path);
                if (not $res) {
                    warn "Unable to backup repository for re-clone: $!";
                }
            }
            eval {
                $impl->clone($repository->{'url'}, $name);
                $method->($repo_path, $db_path, $repository);
            };
            if (my $sub_error = $@) {
                if ($do_backup) {
                    my $rm_error;
                    rmtree($name, { error => \$rm_error });
                    if ($rm_error and @{$rm_error}) {
                        my $info =
                            join ', ',
                            map { join ':', %{$_} }
                                @{$rm_error};
                        warn "Unable to restore repository: ".$info;
                    } else {
                        my $res = move($backup_path, $name);
                        if (not $res) {
                            warn "Unable to restore repository on ".
                                 "failed rerun: $!";
                        }
                    }
                }
                my $error_msg = "Re-clone or nested operation failed: ".
                                "$sub_error (original error was $error)";
                if ($config->{'ignore_errors'}) {
                    warn $error_msg;
                } else {
                    die $error_msg;
                }
            } else {
                warn "Re-cloned '$name' due to error: $error";
            }
        }
    }
}

sub update
{
    my ($self) = @_;

    $self->_repository_map(\&_init_repository);
    $self->_repository_map(\&_update_repository);

    return 1;
}

sub _process_bounds
{
    my ($self, $from, $to) = @_;

    my $config = $self->{'config'};
    my $tz = $config->{'timezone'} || 'UTC';

    if (not defined $from and not defined $to) {
        $from = DateTime->now(time_zone => $tz)
                        ->subtract(days => 1)
                        ->strftime(PATTERN);
        $to   = DateTime->now(time_zone => $tz)
                        ->strftime(PATTERN);
    } elsif (not defined $from) {
        $from = '0000-01-01T00:00:00';
    } elsif (not defined $to) {
        $to   = '9999-12-31T23:59:59';
    }

    my $strp =
        DateTime::Format::Strptime->new(pattern   => PATTERN,
                                        time_zone => $tz);

    my ($from_dt, $to_dt) =
        map { $strp->parse_datetime($_) }
            ($from, $to);
    if (not $from_dt) {
        die "Invalid 'from' time provided.";
    }
    if (not $to_dt) {
        die "Invalid 'to' time provided.";
    }

    ($from, $to) =
        map { $_->set_time_zone('UTC');
              $_->strftime(PATTERN) }
            ($from_dt, $to_dt);

    return ($from, $to);
}

sub _utc_to_tz
{
    my ($self, $datetime) = @_;

    my $config = $self->{'config'};
    my $tz = $config->{'timezone'};
    if ((not $tz) or ($tz eq 'UTC')) {
        return $datetime;
    }