File Coverage

blib/lib/Parse/Sums.pm

Criterion	Covered	Total	%
statement	50	60	83.3
branch	25	36	69.4
condition	5	6	83.3
subroutine	6	6	100.0
pod	1	1	100.0
total	87	109	79.8

package Parse::Sums;

our $DATE = '2016-11-23'; # DATE
our $VERSION = '0.001'; # VERSION

use 5.010001;
use strict;
use warnings;

use Exporter qw(import);
our @EXPORT_OK = qw(parse_sums);

our %SPEC;

sub _guess_algo {
    my $str = shift;
    my $len = length($str);
    if ($len == 8) {
        return ('crc32', 0);
    } elsif ($len == 32) {
        return ('md5', 0);
    } elsif ($len == 40) {
        return ('sha1', 0);
    } elsif ($len == 56) {
        return ('sha224', 1); # or sha512224
    } elsif ($len == 64) {
        return ('sha256', 1); # or sha512256
    } elsif ($len == 96) {
        return ('sha384', 0);
    } elsif ($len == 128) {
        return ('sha512', 0);
    } else {
        return '';
    }
}

$SPEC{parse_sums} = {
    v => 1.1,
    summary => 'Parse checksums file (e.g. MD5SUMS, SHA1SUMS)',
    args => {
        filename => {
            summary => 'Checksums filename',
            schema => 'filename*',
        },
        content => {
            summary => 'Content of checksums file',
            schema => 'str*',
            description => <<'_',

If specified, then `filename` contents will not be read.

_
        },
    },
    examples => [
    ],
};
sub parse_sums {
    my %args = @_;

    my $filename = $args{filename};
    my $content  = $args{content};
    unless (defined $content) {
        open my($fh), "<", $filename
            or return [500, "Can't read '$filename': $!"];
        local $/;
        $content = <$fh>;
    }

    my $algo;
    if (defined $filename) {
        if ($filename =~ /(crc32|md5|sha[_-]?(?:512224|512256|224|256|384|512|1))/i) {
            $algo = lc($1);
        }
    }

    my @res;
    my $num_invalid_lines = 0;
    my $linenum = 0;
    for my $line (split /^/, $content) {
        $linenum++;
        next unless $line =~ /\S/;
        my ($digest, $line_algo, $multiple, $file);
        if ($line =~ /\A([0-9A-Fa-f]+)\s+\*?(.+)$/) {
            $digest = $1;
            ($line_algo, $multiple) = _guess_algo($1);
            $file = $2;
        } elsif ($line =~ /\A(\w+) \((.+)\) = ([0-9A-Fa-f]+)$/) {
            $digest = $3;
            (undef, $multiple) = _guess_algo($3);
            $file = $2;
            $line_algo = lc($1); $line_algo =~ s/-//g;
        } else {
            $num_invalid_lines++;
            next;
        }
        if ($algo && !$multiple && $algo ne $line_algo) {
            $num_invalid_lines++;
            next;
        }
        $line_algo = $algo if $algo;
        if (!$line_algo) {
            $num_invalid_lines++;
            next;
        }
        push @res, {algorithm=>$line_algo, file=>$file, digest=>$digest, linenum=>$linenum};
    }
    [200, "OK", \@res, {
        ('func.warning' => ($num_invalid_lines > 1 ? "$num_invalid_lines lines are" : "1 line is")." improperly formatted") x !!$num_invalid_lines,
    }];
}

1;
# ABSTRACT: Parse checksums file (e.g. MD5SUMS, SHA1SUMS)

__END__