Category Archives: Perl

Private Regression Tests

use warnings;
use strict;
use Test::More;
use Test::Spelling;
set_spell_cmd('aspell -l');
add_stopwords(<DATA>);
all_pod_files_spelling_ok();
__DATA__
CGI
CPAN
GPL
Dolan
STDIN
STDOUT

% perl Build test test_files=t/00_local_spelling.t verbose=1
...
#   Failed test 'POD spelling for blib/lib/Perl/Critic/Config.pm'
not ok 3 - POD spelling for blib/lib/Perl/Critic/Config.pm
#   in /Users/chris/perl/lib/perl5/site_perl/Test/Spelling.pm at line 72.
# Errors:
#     PBP
#     PERLCRITIC
#     Thalhammer
#     inlucde
#     ommit
...
Failed 1/1 test scripts, 0.00% okay. 55/56 subtests failed, 1.79% okay.

...
__DATA__
CGI
CPAN
GPL
Dolan
STDIN
STDOUT
Thalhammer

...
1;
__END__

=pod

=head1 NAME

Perl::Critic::Config - Load Perl::Critic user-preferences

=head1 DESCRIPTION
...

...
1;
__END__

=pod

=for stopwords PBP PERLCRITIC

=head1 NAME

Perl::Critic::Config - Load Perl::Critic user-preferences

=head1 DESCRIPTION
...

% perl Build test test_files=t/00_local_spelling.t verbose=1
...
ok 3 - POD spelling for blib/lib/Perl/Critic/Config.pm
...
Failed 1/1 test scripts, 0.00% okay. 33/56 subtests failed, 41.07% okay.

...
my $tests = 2 + @testdocs * 33 + @testpages * 4 + @impages * 4;
plan tests => $tests;
...

use Test::More;
eval { require Test::Distribution; };
plan skip_all => 'Optional Test::Distribution not installed' if ($@);
import Test::Distribution;

use warnings;
use strict;
use File::Find;
use File::Slurp;
use Test::More qw(no_plan);

my $last_version = undef;
find({wanted => \&check_version, no_chdir => 1}, 'blib');
if (! defined $last_version) {
    fail('Failed to find any files with $VERSION');
}

sub check_version {
    # $_ is the full path to the file
    return if (! m{blib/script/}xms && ! m{\.pm \z}xms);

    my $content = read_file($_);

    # only look at perl scripts, not sh scripts
    return if (m{blib/script/}xms && $content !~ m/\A \#![^\r\n]+?perl/xms);

    my @version_lines = $content =~ m/ ( [^\n]* \$VERSION [^\n]* ) /gxms;
    if (@version_lines == 0) {
       fail($_);
    }
    for my $line (@version_lines) {
        if (!defined $last_version) {
            $last_version = shift @version_lines;
            pass($_);
        }
        else {
            is($line, $last_version, $_);
        }
    }
}

#!perl -w

use warnings;
use strict;
use File::Find;
use File::Slurp;
use Test::More qw(no_plan);

my $this_year = [localtime]->[5]+1900;
my $copyrights_found = 0;
find({wanted => \&check_file, no_chdir => 1}, 'blib');
for (grep {/^readme/i} read_dir('.')) {
    check_file();
}
ok($copyrights_found != 0, 'found a copyright statement');

sub check_file {
    # $_ is the path to a filename, relative to the root of the
    # distribution

    # Only test plain files
    return if (! -f $_);

    # Filter the list of filenames
    return if (! m,^(?: README.*         # docs
                     |  .*/scripts/[^/]+ # programs
                     |  .*/script/[^/]+  # programs
                     |  .*/bin/[^/]+     # programs
                     |  .*\.(?: pl       # program ext
                             |  pm       # module ext
                             |  html     # doc ext
                             |  3pm      # doc ext
                             |  3        # doc ext
                             |  1        # doc ext
                            )
                    )$,xms);

    my $content = read_file($_);
    my @copyright_years = $content =~ m/
                                       (?: copyright | \(c\) )
                                       \s+
                                       (?: \d{4} \- )?
                                       (\d{4})
                                       /gixms;
    if (0 < grep {$_ ne $this_year} @copyright_years) {
        fail("$_ copyrights: @copyright_years");
    }
    elsif (0 == @copyright_years) {
        pass("$_, no copyright found");
    }
    else {
        pass($_);
    }
    $copyrights_found += @copyright_years;
}

use warnings;
use strict;

our @pcargs;
BEGIN
{
   my $rc = 't/perlcriticrc';
   @pcargs = -f $rc ? (-profile => $rc) : ();
}
use Test::Perl::Critic (@pcargs);
all_critic_ok();

[-NamingConventions::ProhibitMixedCaseSubs]

t/author.t..........1..16
ok 1 - Test::Pod
ok 2 - Test::Pod::Coverage
ok 3 - Devel::Cover 100%
ok 4 - Test::Spelling
ok 5 - Test::Perl::Critic, 57 policies in effect
ok 6 - Test::Distribution
ok 8 - Version numbers all match
ok 9 - Copyright date is 2005
ok 10 - Works on darwin
ok 11 - Works on linux
nok 12 - Works on win32 # TODO needs some Windows lovin'!
ok 13 - Works on Perl 5.005
ok 14 - Works on Perl 5.6.1
ok 15 - Works on Perl 5.8.7
ok 16 - Works under mod_perl 1.x

PAR: Packaging for Perl applications

#!perl -w
use PAR 'foo.par';
use Foo;
...

#!perl -w
use PAR 'http://www.example.com/foo.par';
use Foo;
...

---- hello.pl ----
#!perl -w
use strict;
use Tk;
my $mw = MainWindow->new;
$mw->Label(-text => 'Hello, world!')->pack;
$mw->Button(-text => 'Quit', -command => sub { exit })->pack;
MainLoop;

/sw/bin/pp -o hello hello.pl

% zipinfo hello
Archive:  hello   3013468 bytes   689 files
drwxr-xr-x  2.0 unx        0 b- stor 23-Oct-05 14:21 lib/
drwxr-xr-x  2.0 unx        0 b- stor 23-Oct-05 14:21 script/
-rw-r--r--  2.0 unx    20016 b- defN 23-Oct-05 14:21 MANIFEST
-rw-r--r--  2.0 unx      210 b- defN 23-Oct-05 14:21 META.yml
-rw-r--r--  2.0 unx     4971 b- defN 23-Oct-05 14:21 lib/AutoLoader.pm
-rw-r--r--  2.0 unx     4145 b- defN 23-Oct-05 14:21 lib/Carp.pm
... [snipped 679 lines] ...
-rw-r--r--  2.0 unx    12966 b- defN 23-Oct-05 14:21 lib/warnings.pm
-rw-r--r--  2.0 unx      787 b- defN 23-Oct-05 14:21 lib/warnings/register.pm
-rw-r--r--  2.0 unx      186 t- defN 23-May-05 22:22 script/hello.pl
-rw-r--r--  2.0 unx      262 b- defN 23-Oct-05 14:21 script/main.pl
689 files, 2742583 bytes uncompressed, 1078413 bytes compressed:  60.7%