view release on metacpan or  search on metacpan

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

    my ($repo_path, $db_path, $repository) = @_;

    chdir $repo_path;
    my ($name, $impl) = _load_and_open_repository($repository);
    if (not $impl->is_usable()) {
        return;
    }
    $impl->pull();
    my $current_branch = $impl->branch_name();
    my @branches = @{$impl->branches()};
    for my $branch (@branches) {
        my ($branch_name, undef) = @{$branch};
        my $branch_db_path = "$db_path/$name/$branch_name";
        if (not -e $branch_db_path) {
            die "Unable to find branch database ($branch_db_path).";
        }
        my $branch_db_file =
            File::ReadBackwards->new($branch_db_path)
                or die "Unable to load branch database ".
                        "($branch_db_path).";

        my ($last, $commit);
        do {
            $last = $branch_db_file->readline() || '';
            chomp $last;
            (undef, $commit) = split /\./, $last;
            if (not $commit) {
                die "Unable to find commit ID in database.";
            }
        } while (not $impl->has($commit));

        my @new_commits = @{$impl->commits_from($branch_name, $commit)};
        my $time = _strftime(time());
        open my $fh, '>>', $branch_db_path;
        for my $new_commit (@new_commits) {
            print $fh "$time.$new_commit\n";
        }
        close $fh;
    }
    $impl->checkout($current_branch);

    return 1;
}

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