view release on metacpan or  search on metacpan

t/002-main.t  view on Meta::CPAN

    #     same-as     -v --walk

    my @records ;
    my %results;

    {
        local $/ = ""; # paragraph mode

        open my $fh, '<', $filename
            or die "Cannot open '$filename': $!\n";

        @records = map { [ split "\n", $_ ] }
                   <$fh>;

        close $fh;
    }

    for my $record (@records)
    {
        my @lines = grep { ! /^\s*$/ && ! /^\s*#/ }
                    @$record;

        my $type = shift @lines;
        $type =~ s/\s+//g;
        $type = ''
            if lc $type eq 'default';

        for my $line (@lines)
        {
            next if $line =~ /^\s*$/;
            $line =~ /^\s*(\S+)\s+(.+)/;
            my $keyword = lc $1;
            my $value = $2;

            $value = ''
                if lc $value eq 'null';

            die "Invalid keyword '$keyword' in $filename\n"
                unless $keywords->{$keyword} ;

            $results{$type}{$keyword} = $value;
        }
    }

    return %results;

}


sub getNativeLocale
{
    state $enc;

    if (! $enc)
    {
        $enc = 'unknown';

        eval
        {
            require encoding ;
            my $encoding = encoding::_get_locale_encoding() // 'cp437';
            $enc = Encode::find_encoding($encoding) ;
        } ;

        $enc = $enc->name()
            if $enc;
    }

    return $enc;
}


sub getUTF8String
{
    state $string ;

    if (! defined $string)
    {
        use Encode;
        my $latin1 = "\x{61}\x{E5}\x{61}" ;
        eval { my $name = Encode::decode('utf-8-strict', $latin1, Encode::FB_CROAK) };

        $@ =~ /^(\S+) "\\xE5" does not map to Unicode/;

        $string = $1;
    }

    # warn "GOT [$Perl][$]][$string]\n";
    return $string ;
}

sub zapGolden
{
    my $locale_charset = getNativeLocale();
    $_[0] =~ s<^(#\s*System Default Encoding:\s*)('.+?')><$1'$locale_charset'>mg ;

    # # Encode changed from using utf8 to UTF-8 at some point
    my $UTF = getUTF8String();
    $_[0] =~ s<\S+ (\S+) does not map to Unicode><$UTF $1 does not map to Unicode>g ;
}