File Coverage

blib/lib/App/SCM/Digest.pm

Criterion	Covered	Total	%
statement	95	229	41.4
branch	10	50	20.0
condition	0	13	0.0
subroutine	23	29	79.3
pod	3	3	100.0
total	131	324	40.4

package App::SCM::Digest;

use strict;
use warnings;

use App::SCM::Digest::Utils qw(system_ad slurp);
use App::SCM::Digest::SCM::Factory;

use autodie;
use DateTime;
use DateTime::Format::Strptime;
use Getopt::Long;
use Email::MIME;
use File::ReadBackwards;
use File::Temp;
use List::Util qw(first);
use POSIX qw();

use constant PATTERN => '%FT%T';
use constant EMAIL_ATTRIBUTES => (
    content_type => 'text/plain',
    disposition  => 'attachment',
    charset      => 'UTF-8',
    encoding     => 'quoted-printable',
);

our $VERSION = '0.08';

sub new
{
    my ($class, $config) = @_;
    my $self = { config => $config };
    bless $self, $class;
    return $self;
}

sub _strftime
{
    my ($time) = @_;

    return POSIX::strftime(PATTERN, gmtime($time));
}

sub _impl
{
    my ($name) = @_;

    return App::SCM::Digest::SCM::Factory->new($name);
}

sub _load_repository
{
    my ($repository) = @_;

    my ($name, $url, $type) = @{$repository}{qw(name url type)};
    my $impl = _impl($type);

    return ($name, $impl);
}

sub _load_and_open_repository
{
    my ($repository) = @_;

    my ($name, $impl) = _load_repository($repository);
    eval { $impl->open_repository($name) };
    if (my $error = $@) {
        die "Unable to open repository '$name': $error";
    }

    return ($name, $impl);
}

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

    chdir $repo_path;
    my ($name, $impl) = _load_repository($repository);
    my $pre_existing = (-e $name);
    if (not $pre_existing) {
        if (not -e "$db_path/$name") {
            mkdir "$db_path/$name";
        }
        $impl->clone($repository->{'url'}, $name);
    }
    $impl->open_repository($name);
    if (not $impl->is_usable()) {
        return;
    }
    if ($pre_existing) {
        $impl->pull();
    }
    my @branches = @{$impl->branches()};
    for my $branch (@branches) {
        my ($branch_name, $commit) = @{$branch};
        my $branch_db_path = "$db_path/$name/$branch_name";
        if (-e $branch_db_path) {
            next;
        }
        my @branch_db_segments = split /\//, $branch_db_path;
        pop @branch_db_segments;
        my $branch_db_parent = join '/', @branch_db_segments;
        if (not -e $branch_db_parent) {
            system_ad("mkdir -p $branch_db_parent");
        }
        open my $fh, '>', $branch_db_path;
        print $fh _strftime(time()).".$commit\n";
        close $fh;
    }

    return 1;
}

sub _update_repository
{
    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 = $branch_db_file->readline() || '';
        chomp $last;
        my (undef, $commit) = split /\./, $last;
        if (not $commit) {
            die "Unable to find commit ID in database.";
        }
        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}) {
        if ($config->{'ignore_errors'}) {
            eval {
                $method->($repo_path, $db_path, $repository);
            };
            if (my $error = $@) {
                warn $error;
            }
        } else {
            $method->($repo_path, $db_path, $repository);
        }
    }
}

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

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

    my $dt = $strp->parse_datetime($datetime);
    $dt->set_time_zone($tz);
    return $dt->strftime(PATTERN);
}

sub _load_commits
{
    my ($branch_db_path, $from, $to) = @_;

    if (not -e $branch_db_path) {
        die "Unable to find branch database ($branch_db_path).";
    }
    open my $fh, '<', $branch_db_path;
    my @commits;
    while (my $entry = <$fh>) {
        chomp $entry;
        my ($time, $id) = split /\./, $entry;
        if (($time ge $from) and ($time le $to)) {
            push @commits, [ $time, $id ];
        }
    }

    return @commits;
}

sub _make_email_mime
{
    my ($ft, $filename) = @_;

    return
        Email::MIME->create(
            attributes => { EMAIL_ATTRIBUTES,
                            filename => $filename },
            body_str   => slurp($ft)
        );
}

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

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

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

    ($from, $to) = $self->_process_bounds($from, $to);

    my $output_ft = File::Temp->new();
    my @commit_data;

    for my $repository (@{$repositories}) {
        chdir $repo_path;
        my ($name, $impl) = _load_and_open_repository($repository);
        if (not $impl->is_usable()) {
            next;
        }
        my $current_branch = $impl->branch_name();

        my @branches = @{$impl->branches()};
        for my $branch (@branches) {
            my ($branch_name, $commit) = @{$branch};
            my $branch_db_path = "$db_path/$name/$branch_name";
            my @commits = _load_commits($branch_db_path, $from, $to);
            if (not @commits) {
                next;
            }
            print $output_ft "Repository: $name\n".
                             "Branch:     $branch_name\n\n";
            for my $commit (@commits) {
                my ($time, $id) = @{$commit};
                $time = $self->_utc_to_tz($time);
                $time =~ s/T/ /;
                print $output_ft "Pulled at: $time\n".
                                 (join '', @{$impl->show($id)}).
                                 "\n";

                my $att_ft = File::Temp->new();
                print $att_ft @{$impl->show_all($id)};
                $att_ft->flush();

                push @commit_data, [$name, $branch_name, $id, $att_ft];
            }
            print $output_ft "\n";
        }
        $impl->checkout($current_branch);
    }

    $output_ft->flush();

    if (not @commit_data) {
        return;
    }

    my $email = Email::MIME->create(
        header_str => [ %{$config->{'headers'} || {}} ],
        parts => [
            _make_email_mime($output_ft, 'log.txt'),
            map {
                my ($name, $branch_name, $id, $att_ft) = @{$_};
                _make_email_mime($att_ft,
                                 "$name-$branch_name-$id.diff"),
            } @commit_data
        ]
    );

    return $email;
}

1;

__END__