view release on metacpan or  search on metacpan

lib/Test/Reporter/Transport/Socket.pm  view on Meta::CPAN

    $conf;
    } # _make_derived

sub plv2hash {
    my %config;

    my $pv = join "\n" => @_;

    if ($pv =~ m{^Summary of my\s+(\S+)\s+\(\s*(.*?)\s*\)}m) {
	$config{'package'} = $1;
	my $rev = $2;
	$rev =~ s/^ revision \s+ (\S+) \s*//x and $config{'revision'} = $1;
	$rev and $config{'version_patchlevel_string'} = $rev;
	my ($rel) = $config{'package'} =~ m{perl(\d)};
	my ($vers, $subvers) = $rev =~ m{version\s+(\d+)\s+subversion\s+(\d+)};
	defined $vers && defined $subvers && defined $rel and
	    $config{'version'} = "$rel.$vers.$subvers";
	}

    if ($pv =~ m{^\s+(Snapshot of:)\s+(\S+)}) {
	$config{'git_commit_id_title'} = $1;
	$config{'git_commit_id'}       = $2;
	}

    # these are always last on line and can have multiple quotation styles
    for my $k (qw( ccflags ldflags lddlflags )) {
	$pv =~ s{, \s* $k \s*=\s* (.*) \s*$}{}mx or next;
	my $v = $1;
	$v =~ s/\s*,\s*$//;
	$v =~ s/^(['"])(.*)\1$/$2/;
	$config{$k} = $v;
	}

    if (my %kv = ($pv =~ m{\b
	    (\w+)		# key
	    \s*=		# assign
	    ( '\s*[^']*?\s*'	# quoted value
	    | \S+[^=]*?\s*\n	# unquoted running till end of line
	    | \S+		# unquoted value
	    | \s*\n		# empty
	    )
	    (?:,?\s+|\s*\n)?	# separator (5.8.x reports did not have a ','
	    }gx)) {		# between every kv pair

	while (my ($k, $v) = each %kv) {
	    $k =~ s{\s+$}	{};
	    $v =~ s{\s*\n\z}	{};
	    $v =~ s{,$}		{};
	    $v =~ m{^'(.*)'$} and $v = $1;
	    $v =~ s{\s+$}	{};
	    $config{$k} = $v;
	    }
	}

    my $build = { %empty_build };

    $pv =~ m{^\s+Compiled at\s+(.*)}m
	and $build->{'stamp'}   = $1;
    $pv =~ m{^\s+Locally applied patches:(?:\s+|\n)(.*?)(?:[\s\n]+Buil[td] under)}ms
	and $build->{'patches'} = [ split m{\n+\s*}, $1 ];
    $pv =~ m{^\s+Compile-time options:(?:\s+|\n)(.*?)(?:[\s\n]+(?:Locally applied|Buil[td] under))}ms
	and map { $build->{'options'}{$_} = 1 } split m{\s+|\n} => $1;

    $build->{'osname'} = $config{'osname'};
    $pv =~ m{^\s+Built under\s+(.*)}m
	and $build->{'osname'}  = $1;
    $config{'osname'} ||= $build->{'osname'};

    return _make_derived ({
	'build'		=> $build,
	'environment'	=> {},
	'config'	=> \%config,
	'derived'	=> {},
	'inc'		=> [],
	});
    } # plv2hash

sub summary {
    my $conf = shift || myconfig ();
    ref $conf eq "HASH"
    && exists $conf->{'config'}
    && exists $conf->{'build'}
    && ref $conf->{'config'} eq "HASH"
    && ref $conf->{'build'}  eq "HASH" or return;

    my %info = map {
	exists $conf->{'config'}{$_} ? ( $_ => $conf->{'config'}{$_} ) : () }
	qw( archname osname osvers revision patchlevel subversion version
	    cc ccversion gccversion config_args inc_version_list
	    d_longdbl d_longlong use64bitall use64bitint useithreads
	    uselongdouble usemultiplicity usemymalloc useperlio useshrplib 
	    doublesize intsize ivsize nvsize longdblsize longlongsize lseeksize
	    default_inc_excludes_dot
	    );
    $info{$_}++ for grep { $conf->{'build'}{'options'}{$_} } keys %{$conf->{'build'}{'options'}};

    return \%info;
    } # summary

sub signature {
    my $no_md5 = "0" x 32;
    my $conf = summary (shift) or return $no_md5;

    eval { require Digest::MD5 };
    $@ and return $no_md5;

    $conf->{'cc'} =~ s{.*\bccache\s+}{};
    $conf->{'cc'} =~ s{.*[/\\]}{};

    delete $conf->{'config_args'};
    return Digest::MD5::md5_hex (join "\xFF" => map {
	"$_=".(defined $conf->{$_} ? $conf->{$_} : "\xFE");
	} sort keys %{$conf});
    } # signature

sub myconfig {
    my $args = shift;
    my %args = ref $args eq "HASH"  ? %{$args} :
               ref $args eq "ARRAY" ? @{$args} : ();

    my $build = { %empty_build };