view release on metacpan or  search on metacpan

lib/Test/Mojibake.pm  view on Meta::CPAN

    $Test->exported_to($caller);
    $Test->plan(@args);

    return;
}


## no critic (ProhibitCascadingIfElse, ProhibitExcessComplexity)
sub file_encoding_ok {
    my ($file, $name) = @_;
    $name = defined($name) ? $name : "Mojibake test for $file";

    ## no critic (ProhibitFiletest_f)
    unless (-f $file) {
        $Test->ok(0, $name);
        $Test->diag("$file does not exist");
        return;
    }

    my $fh;
    unless (open($fh, '<:raw', $file)) {
        close $fh;
        $Test->ok(0, $name);
        $Test->diag("Can't open $file: $!");
        return;
    }

    my $use_utf8    = 0;
    my $pod         = 0;
    my $pod_utf8    = 0;
    my $n           = 1;
    my %pod         = ();
    while (my $line = <$fh>) {
        if (($n == 1) && $line =~ /^\x{EF}\x{BB}\x{BF}/x) {
            $Test->ok(0, $name);
            $Test->diag("UTF-8 BOM (Byte Order Mark) found in $file");
            return;
        } elsif ($line =~ /^=+cut\s*$/x) {
            $pod = 0;
        } elsif ($line =~ /^=+encoding\s+([\w\-]+)/x) {
            my $pod_encoding = lc $1;
            $pod_encoding =~ y/-//d;

            # perlpod states:
            # =encoding affects the whole document, and must occur only once.
            ++$pod{$pod_encoding};
            if (1 < scalar keys %pod) {
                $Test->ok(0, $name);
                $Test->diag("POD =encoding redeclared in $file, line $n");
                return;
            }

            $pod_utf8 = ($pod_encoding eq 'utf8') ? 1 : 0;
            $pod = 1;
        } elsif ($line =~ /^=+\w+/x) {
            $pod = 1;
        } elsif ($pod == 0) {
            # source
            $line =~ s/^\s*\#.*$//sx;  # disclaimers placed in headers frequently contain UTF-8 *before* its usage is declared.
            foreach (split m{;}x, $line) {
                # trim
                s/^\s+|\s+$//gsx;

                my @type = qw(0 0 0);
                ++$type[_detect_utf8(\$_)];
                my ($latin1, $utf8) = @type[0, 2];

                if (/^use\s+utf8(?:::all)?$/x) {
                    $use_utf8 = 1;
                } elsif (/^use\s+common::sense$/x) {
                    $use_utf8 = 1;
                } elsif (/^no\s+utf8$/x) {
                    $use_utf8 = 0;
                }

                if (($use_utf8 == 0) && $utf8) {
                    $Test->ok(0, $name);
                    $Test->diag("UTF-8 unexpected in $file, line $n (source)");
                    return;
                } elsif (($use_utf8 == 1) && $latin1) {
                    $Test->ok(0, $name);
                    $Test->diag("Non-UTF-8 unexpected in $file, line $n (source)");
                    return;
                }
            }
        } else {
            # POD
            my @type = qw(0 0 0);
            ++$type[_detect_utf8(\$line)];
            my ($latin1, $utf8) = @type[0, 2];

            if (($pod_utf8 == 0) && $utf8) {
                $Test->ok(0, $name);
                $Test->diag("UTF-8 unexpected in $file, line $n (POD)");
                return;
            } elsif (($pod_utf8 == 1) && $latin1) {
                $Test->ok(0, $name);
                $Test->diag("Non-UTF-8 unexpected in $file, line $n (POD)");
                return;
            }
        }
    } continue {
        ++$n;
    }
    close $fh;

    $Test->ok(1, $name);
    return 1;
}


sub all_files_encoding_ok {
    my (@args) = @_;
    @args = _starting_points() unless @args;

    ## no critic (ProhibitFiletest_f)
    my @files = map { -d $_ ? all_files($_) : (-f $_ ? $_ : ()) } @args;

    unless (@files) {
        $Test->plan(skip_all => 'could not find any files to test');