File Coverage

blib/lib/Darcs/Inventory/Patch.pm

Criterion	Covered	Total	%
statement	42	58	72.4
branch	6	16	37.5
condition	2	5	40.0
subroutine	11	16	68.7
pod	5	8	62.5
total	66	103	64.0

# Copyright (c) 2007-2012 David Caldwell,  All Rights Reserved. -*- perl -*-

package Darcs::Inventory::Patch; use base qw(Class::Accessor::Fast); use warnings; use strict;

use Digest::SHA qw(sha1_hex);
use Time::Local qw(timegm);
use POSIX qw(strftime);
use IPC::Run qw(run);

Darcs::Inventory::Patch->mk_accessors(qw(date raw_date author undo name long hash file raw));

sub darcs_date_str($) { strftime "%a %b %e %H:%M:%S %Z %Y", localtime $_[0] }

sub date_from_darcs($) {
    $_[0] =~ /(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})/ or die "Couldn't parse date: $_[0]";
    my ($y,$m,$d,$h,$min,$s) = ($1,$2,$3,$4,$5,$6);
    timegm($s,$min,$h,$d,$m-1,$y);
}

sub parse_patch($) {
    my @line = split /\n/, $_[0];
    my %patch;
    ($patch{file} = $1, pop @line) if $line[-1] =~ /^hash: ([0-9]{10}-[0-9a-f]{64})$/;
    @patch{qw(name meta long)} = (shift @line, shift @line, join "", map substr("$_\n",1), @line);
    chomp $patch{long};
    # Jim Radford **20061013045032]
    $patch{meta} =~ /^(.*)\*([-*])(\d{14})/ or die __PACKAGE__.": Internal Error--Couldn't parse patch:\n$_[0]\n";
    @patch{qw(author undo date raw_date raw)} = ($1, !!($2 eq '-'), date_from_darcs($3), $3, $_[0]);

    # This hash code comes from reading this: http://wiki.darcs.net/DarcsWiki/NamedPatch
    # Which roughly documents the make_filename function in darcs' src/Darcs/Patch/Info.lhs file.
    my $hashee = join('', @patch{qw(name author raw_date long)}).($patch{undo} ? 't' : 'f');
    $hashee =~ s/\n//g;
    #$patch{computed} = $hashee;
    $patch{hash} = $patch{raw_date}. '-' .substr(sha1_hex($patch{author}), 0, 5). '-' . sha1_hex($hashee).'.gz';
    $patch{file} ||= $patch{hash};
    %patch;
}

sub new($$) {
    my ($class, $patch_string) = @_;
    my %patch = parse_patch($patch_string);
    return bless { %patch }, $class;
}

sub darcs_date($) {
    darcs_date_str $_[0]->date
}

sub as_string($) {
    my ($p) = @_;
    my $s = sprintf("%s %s\n  %s %s\n%s\n", $p->darcs_date, $p->author, $p->undo ? 'UNDO:' : '*', $p->name, $p->long);
    $s =~ s/^Ignore-this:\s+[0-9a-f]+\n//m;
    $s;
}

sub diff($) {
    my ($self) = @_;
    my $error;
    run([qw(darcs diff -u --match), "hash ".$self->hash], '>', \$self->{diff}, '2>', \$error) or die "$error\n"
        unless defined $self->{diff};
    return $self->{diff};
}

sub diffstat($) {
    my ($self) = @_;
    unless ($self->{diffstat}) {
        my $diff = $self->diff;
        my $error;
        run([qw(diffstat)], '<', \$diff, '>', \$self->{diffstat}, '2>', \$error) or die "$error\n";
    }
    $self->{diffstat};
}

use overload '""' => \&as_string;

1;
__END__