File Coverage

blib/lib/Module/Changes/Parser/Free.pm

Criterion	Covered	Total	%
statement	21	49	42.8
branch	0	2	0.0
condition			n/a
subroutine	7	8	87.5
pod	1	1	100.0
total	29	60	48.3

package Module::Changes::Parser::Free;

use warnings;
use strict;
use DateTime::Format::DateParse;
use DateTime::Format::W3CDTF;
use Module::Changes;
use Perl::Version;


our $VERSION = '0.05';


use base 'Module::Changes::Parser';


sub parse_string {
    my ($self, $content) = @_;

    my $changes = Module::Changes->make_object_for_type('entire');

    my @parts = split /\n\n(?=\w)/ => $content;
    for (@parts) { 1 while chomp }

    (my $name = shift @parts) =~ s/.*\s//;
    $changes->name($name);

    for my $part (@parts) {
        my ($version_line, $rel_change_lines) = split /\n/, $part, 2;

        my ($version, $date_str) = split /\s+/, $version_line, 2;

        # rudimentary support for german dates; a bit arbitrary, I know...

        my %map = (
            Mo  => 'Mon',
            Di  => 'Tue',
            Mi  => 'Wed',
            Do  => 'Thu',
            Fr  => 'Fri',
            Sa  => 'Sat',
            So  => 'Sun',
            Mai => 'May',
            Okt => 'Oct',
            Dez => 'Dec',
        );

        while (my ($orig, $replacement) = each %map) {
            $date_str =~ s/\b\Q$orig\E\b/$replacement/g;
        }

        my $date = DateTime::Format::DateParse->parse_datetime($date_str);

        my $release = Module::Changes->make_object_for_type('release');
        $release->version(Perl::Version->new($version));
        $release->date($date);

        my @rel_changes = split /^(?=\s+- )/m, $rel_change_lines;

        for my $rel_change (@rel_changes) {
            1 while chomp $rel_change;
            if ($rel_change =~ /^(\s+-\s+)/) {

                # take off an equal amount of indenting from each line

                my $indent = length $1;
                my @lines = split /\n/ => $rel_change;
                substr($_, 0, $indent, '') for @lines;
                $release->changes_push(join ' ' => @lines);
            } else {
                die "can't determine indent from\n$rel_change\n";
            }
        }

        $changes->releases_push($release);
    }

    $changes;
}


1;


__END__