view release on metacpan or  search on metacpan

lib/CPAN/Testers/ParseReport.pm  view on Meta::CPAN

                and /Commit id:\s*([[:xdigit:]]+)/) {
                $extract{"conf:git_commit_id"} = $1;
            }
        } else {
            my $p5;
            if (0) {
            } elsif (/Summary of my perl5 \((.+)\) configuration:/) {
                $p5 = $1;
                $in_summary = 1;
                $in_env_context = 0;
            }
            if ($p5) {
                my($r,$v,$s,$p);
                if (($r,$v,$s,$p) = $p5 =~ /revision (\S+) version (\S+) subversion (\S+) patch (\S+)/) {
                    $r =~ s/\.0//; # 5.0 6 2!
                    $extract{"meta:perl"} = "$r.$v.$s\@$p";
                } elsif (($r,$v,$s) = $p5 =~ /revision (\S+) version (\S+) subversion (\S+)/) {
                    $r =~ s/\.0//;
                    $extract{"meta:perl"} = "$r.$v.$s";
                } elsif (($r,$v,$s) = $p5 =~ /(\d+\S*) patchlevel (\S+) subversion (\S+)/) {
                    $r =~ s/\.0//;
                    $extract{"meta:perl"} = "$r.$v.$s";
                } else {
                    $extract{"meta:perl"} = $p5;
                }
            }
        }
        unless ($extract{"meta:from"}) {
            if (0) {
            } elsif ($isHTML ?
                     m|<div class="h_name">From:</div> <b>(.+?)</b><br/>| :
                     m|^From:\s*(.+)|
                     or
                     m|^From:\s*(.+)|
                    ) {
                my $f = $1;
                $f = $1 if $f =~ m{<strong>(.+)</strong>};
                $extract{"meta:from"} = $f;
            }
            $extract{"meta:from"} =~ s/\.$// if $extract{"meta:from"};
        }
        unless ($extract{"meta:date"}) {
            if (0) {
            } elsif ($isHTML ?
                     m|<div class="h_name">Date:</div> (.+?)<br/>| :
                     m|^Date:\s*(.+)|
                     or
                     m|^Date:\s*(.+)|
                    ) {
                my $date = $1;
                $date = $1 if $date =~ m{<strong>(.+)</strong>};
                my($dt);
            DATEFMT: for my $pat ("%Y-%m-%dT%TZ", # 2010-07-07T14:01:40Z
                                  "%a, %d %b %Y %T %z", # Sun, 28 Sep 2008 12:23:12 +0100
                                  "%b %d, %Y %R", # July 10,...
                                  "%b  %d, %Y %R", # July  4,...
                                 ) {
                    $dt = eval {
                        my $p = DateTime::Format::Strptime->new
                            (
                             locale => "en",
                             time_zone => "UTC",
                             pattern => $pat,
                            );
                        $p->parse_datetime($date)
                    };
                    last DATEFMT if $dt;
                }
                unless ($dt) {
                    warn "Could not parse date[$date], setting to epoch 0";
                    $dt = DateTime->from_epoch( epoch => 0 );
                }
                $extract{"meta:date"} = $dt->datetime;
            }
            $extract{"meta:date"} =~ s/\.$// if $extract{"meta:date"};
        }
        unless ($extract{"meta:writer"}) {
            for ("$previous_line[-1] $_") {
                if (0) {
                } elsif (/CPANPLUS, version (\S+)/) {
                    $extract{"meta:writer"} = "CPANPLUS $1";
		} elsif (/created by (App::cpanminus::reporter \S+)/) {
		    $extract{"meta:writer"} = $1;
                } elsif (/created (?:automatically )?by (\S+)/) {
                    $extract{"meta:writer"} = $1;
                    if (/\s+on\s+perl\s+([^,]+),/) {
                        $fallback_p5 = $1;
                    }
                } elsif (/This report was machine-generated by (\S+) (\S+)/) {
                    $extract{"meta:writer"} = "$1 $2";
                }
                $extract{"meta:writer"} =~ s/[\.,]$// if $extract{"meta:writer"};
            }
        }
        if ($in_summary) {
            # we do that first three lines a bit too often
            my $qr = $Opt{dumpvars} || "";
            $qr = qr/$qr/ if $qr;
            unless (@q) {
                @q = @{$Opt{q}||[]};
                @q = qw(meta:perl conf:archname conf:usethreads conf:optimize meta:writer meta:from) unless @q;
            }

            my %conf_vars = map {($_ => 1)} grep { /^conf:/ } @q;

            if (/^\s+Platform:$/) {
                $in_summary_seen_platform=1;
            } elsif (/^\s*$/ || m|</pre>|) {
                # if not html, we have reached the end now
                if ($in_characteristics) {
                    $in_summary = 0;
                } elsif ($in_summary_seen_platform) {
                    # some perls have an empty line after the summary line
                    $expect_characteristics_libperl = 1;
                }
            } elsif ($in_characteristics) {
                if (my($date) = /Compiled at (.+)/) {
                    $date =~ s/\s+\z//;
                    # find: Apr 10 2013 16:59:47
                    # want: 2016-07-05T11:03:04
                    my($dt);
                DATEFMT: for my $pat ("%b %d %Y %T") { # Sep 28 2008 12:23:12
                        $dt = eval {
                            my $p = DateTime::Format::Strptime->new
                                (
                                 locale => "en",
                                 time_zone => "UTC",
                                 pattern => $pat,
                                );
                            $p->parse_datetime($date)
                        };
                        last DATEFMT if $dt;
                    }
                    unless ($dt) {
                        warn "Could not parse date[$date], setting to epoch 0";
                        $dt = DateTime->from_epoch( epoch => 0 );
                    }
                    $extract{"meta:perl_compiled_at"} = $dt->datetime;
                }
            } elsif ($expect_characteristics_libperl && /Characteristics of this/) {
                $in_characteristics = 1;
            } else {
                my(%kv) = m!\G,?\s*([^=]+)= # left hand side and equal sign
                            (
                                [^',\s]+(?=.+=) # use64bitint=define use64bitall=define uselongdouble=undef
                                                # (lookahead needed for left-over equal sign)
                            |
                                [^',]+$     # libpth=/usr/lib /usr/local/lib
                            |
                                '[^']+?'    # cccdlflags='-DPIC -fPIC'
                            |
                                \S+         # useshrplib=false
                            )!xgc;
                while (my($k,$v) = each %kv) {
                    my $ck = "conf:$k";
                    $ck =~ s/\s+$//;
                    $v =~ s/,$//;
                    if ($v =~ /^'(.*)'$/) {
                        $v = $1;
                    }
                    $v =~ s/^\s+//;
                    $v =~ s/\s+$//;
                    if ($qr && $ck =~ $qr) {
                        $extract{$ck} = $v;
                    } elsif ($conf_vars{$ck}) {
                        $extract{$ck} = $v;
                    }
                }
            }
        }
        if ($in_prg_output) {
            unless ($extract{"meta:output_from"}) {
                if (/Output from (.+):$/) {
                    $extract{"meta:output_from"} = $1
                }
            }

            # Parsing of Module::Versions::Report text in test output
            if (/Modules in memory:/) {
                $expect_module_versions_report = 1;
                next LINE;
            }
            elsif ($expect_module_versions_report) {
                if (/\s+(\S+)(?:\s+(v\d\S+?))?;/) {
                    $extract{"mod:$1"} = defined $2 ? $2 : 'undef';
                    next LINE;