Category Archives: Languages

Programming Languages

Perl, Testing

Private Regression Tests

11 Comments 

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
Perl

PAR: Packaging for Perl applications

1 Comment 

#!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%

Apple, General, Perl

iTunes Music Store contest

5 Comments 

<?xml version="1.0" encoding="utf-8"?>
<root>
<count name="curCount" timestamp="Thu, 07 Jul 2005 23:16:00 GMT">485066974</count>
<count name="preCount" timestamp="Thu, 07 Jul 2005 23:11:00 GMT">485060489</count>
</root>


Retrieving http://www.apple.com/itunes/external_counter.xml...
Rate: 23.19 songs/sec
Predicted count right now: 485173522 (Thu Jul  7 19:35:14 2005 CDT)
485,200,000   Thu Jul  7 19:54:15 2005 CDT
485,300,000   Thu Jul  7 21:06:07 2005 CDT
485,400,000   Thu Jul  7 22:17:58 2005 CDT
485,500,000   Thu Jul  7 23:29:50 2005 CDT
485,600,000   Fri Jul  8 00:41:41 2005 CDT
485,700,000   Fri Jul  8 01:53:33 2005 CDT
485,800,000   Fri Jul  8 03:05:25 2005 CDT
485,900,000   Fri Jul  8 04:17:16 2005 CDT
486,000,000   Fri Jul  8 05:29:08 2005 CDT
486,100,000   Fri Jul  8 06:40:59 2005 CDT
486,200,000   Fri Jul  8 07:52:51 2005 CDT
486,300,000   Fri Jul  8 09:04:43 2005 CDT
486,400,000   Fri Jul  8 10:16:34 2005 CDT
486,500,000   Fri Jul  8 11:28:26 2005 CDT
486,600,000   Fri Jul  8 12:40:17 2005 CDT
486,700,000   Fri Jul  8 13:52:09 2005 CDT
486,800,000   Fri Jul  8 15:04:00 2005 CDT
486,900,000   Fri Jul  8 16:15:52 2005 CDT
487,000,000   Fri Jul  8 17:27:44 2005 CDT
487,100,000   Fri Jul  8 18:39:35 2005 CDT
487,200,000   Fri Jul  8 19:51:27 2005 CDT
487,300,000   Fri Jul  8 21:03:18 2005 CDT
487,400,000   Fri Jul  8 22:15:10 2005 CDT
487,500,000   Fri Jul  8 23:27:02 2005 CDT
487,600,000   Sat Jul  9 00:38:53 2005 CDT
487,700,000   Sat Jul  9 01:50:45 2005 CDT
487,800,000   Sat Jul  9 03:02:36 2005 CDT
487,900,000   Sat Jul  9 04:14:28 2005 CDT
488,000,000   Sat Jul  9 05:26:19 2005 CDT
488,100,000   Sat Jul  9 06:38:11 2005 CDT
488,200,000   Sat Jul  9 07:50:03 2005 CDT
488,300,000   Sat Jul  9 09:01:54 2005 CDT
488,400,000   Sat Jul  9 10:13:46 2005 CDT
488,500,000   Sat Jul  9 11:25:37 2005 CDT
488,600,000   Sat Jul  9 12:37:29 2005 CDT
488,700,000   Sat Jul  9 13:49:21 2005 CDT
488,800,000   Sat Jul  9 15:01:12 2005 CDT
488,900,000   Sat Jul  9 16:13:04 2005 CDT
489,000,000   Sat Jul  9 17:24:55 2005 CDT
489,100,000   Sat Jul  9 18:36:47 2005 CDT
489,200,000   Sat Jul  9 19:48:38 2005 CDT
489,300,000   Sat Jul  9 21:00:30 2005 CDT
489,400,000   Sat Jul  9 22:12:22 2005 CDT
489,500,000   Sat Jul  9 23:24:13 2005 CDT
489,600,000   Sun Jul 10 00:36:05 2005 CDT
489,700,000   Sun Jul 10 01:47:56 2005 CDT
489,800,000   Sun Jul 10 02:59:48 2005 CDT
489,900,000   Sun Jul 10 04:11:40 2005 CDT
490,000,000   Sun Jul 10 05:23:31 2005 CDT
490,100,000   Sun Jul 10 06:35:23 2005 CDT
490,200,000   Sun Jul 10 07:47:14 2005 CDT
490,300,000   Sun Jul 10 08:59:06 2005 CDT
490,400,000   Sun Jul 10 10:10:57 2005 CDT
490,500,000   Sun Jul 10 11:22:49 2005 CDT
490,600,000   Sun Jul 10 12:34:41 2005 CDT
490,700,000   Sun Jul 10 13:46:32 2005 CDT
490,800,000   Sun Jul 10 14:58:24 2005 CDT
490,900,000   Sun Jul 10 16:10:15 2005 CDT
491,000,000   Sun Jul 10 17:22:07 2005 CDT
491,100,000   Sun Jul 10 18:33:59 2005 CDT
491,200,000   Sun Jul 10 19:45:50 2005 CDT
491,300,000   Sun Jul 10 20:57:42 2005 CDT
491,400,000   Sun Jul 10 22:09:33 2005 CDT
491,500,000   Sun Jul 10 23:21:25 2005 CDT
491,600,000   Mon Jul 11 00:33:16 2005 CDT
491,700,000   Mon Jul 11 01:45:08 2005 CDT
491,800,000   Mon Jul 11 02:57:00 2005 CDT
491,900,000   Mon Jul 11 04:08:51 2005 CDT
492,000,000   Mon Jul 11 05:20:43 2005 CDT
492,100,000   Mon Jul 11 06:32:34 2005 CDT
492,200,000   Mon Jul 11 07:44:26 2005 CDT
492,300,000   Mon Jul 11 08:56:18 2005 CDT
492,400,000   Mon Jul 11 10:08:09 2005 CDT
492,500,000   Mon Jul 11 11:20:01 2005 CDT
492,600,000   Mon Jul 11 12:31:52 2005 CDT
492,700,000   Mon Jul 11 13:43:44 2005 CDT
492,800,000   Mon Jul 11 14:55:35 2005 CDT
492,900,000   Mon Jul 11 16:07:27 2005 CDT
493,000,000   Mon Jul 11 17:19:19 2005 CDT
493,100,000   Mon Jul 11 18:31:10 2005 CDT
493,200,000   Mon Jul 11 19:43:02 2005 CDT
493,300,000   Mon Jul 11 20:54:53 2005 CDT
493,400,000   Mon Jul 11 22:06:45 2005 CDT
493,500,000   Mon Jul 11 23:18:37 2005 CDT
493,600,000   Tue Jul 12 00:30:28 2005 CDT
493,700,000   Tue Jul 12 01:42:20 2005 CDT
493,800,000   Tue Jul 12 02:54:11 2005 CDT
493,900,000   Tue Jul 12 04:06:03 2005 CDT
494,000,000   Tue Jul 12 05:17:54 2005 CDT
494,100,000   Tue Jul 12 06:29:46 2005 CDT
494,200,000   Tue Jul 12 07:41:38 2005 CDT
494,300,000   Tue Jul 12 08:53:29 2005 CDT
494,400,000   Tue Jul 12 10:05:21 2005 CDT
494,500,000   Tue Jul 12 11:17:12 2005 CDT
494,600,000   Tue Jul 12 12:29:04 2005 CDT
494,700,000   Tue Jul 12 13:40:56 2005 CDT
494,800,000   Tue Jul 12 14:52:47 2005 CDT
494,900,000   Tue Jul 12 16:04:39 2005 CDT
495,000,000   Tue Jul 12 17:16:30 2005 CDT
495,100,000   Tue Jul 12 18:28:22 2005 CDT
495,200,000   Tue Jul 12 19:40:13 2005 CDT
495,300,000   Tue Jul 12 20:52:05 2005 CDT
495,400,000   Tue Jul 12 22:03:57 2005 CDT
495,500,000   Tue Jul 12 23:15:48 2005 CDT
495,600,000   Wed Jul 13 00:27:40 2005 CDT
495,700,000   Wed Jul 13 01:39:31 2005 CDT
495,800,000   Wed Jul 13 02:51:23 2005 CDT
495,900,000   Wed Jul 13 04:03:15 2005 CDT
496,000,000   Wed Jul 13 05:15:06 2005 CDT
496,100,000   Wed Jul 13 06:26:58 2005 CDT
496,200,000   Wed Jul 13 07:38:49 2005 CDT
496,300,000   Wed Jul 13 08:50:41 2005 CDT
496,400,000   Wed Jul 13 10:02:32 2005 CDT
496,500,000   Wed Jul 13 11:14:24 2005 CDT
496,600,000   Wed Jul 13 12:26:16 2005 CDT
496,700,000   Wed Jul 13 13:38:07 2005 CDT
496,800,000   Wed Jul 13 14:49:59 2005 CDT
496,900,000   Wed Jul 13 16:01:50 2005 CDT
497,000,000   Wed Jul 13 17:13:42 2005 CDT
497,100,000   Wed Jul 13 18:25:34 2005 CDT
497,200,000   Wed Jul 13 19:37:25 2005 CDT
497,300,000   Wed Jul 13 20:49:17 2005 CDT
497,400,000   Wed Jul 13 22:01:08 2005 CDT
497,500,000   Wed Jul 13 23:13:00 2005 CDT
497,600,000   Thu Jul 14 00:24:51 2005 CDT
497,700,000   Thu Jul 14 01:36:43 2005 CDT
497,800,000   Thu Jul 14 02:48:35 2005 CDT
497,900,000   Thu Jul 14 04:00:26 2005 CDT
498,000,000   Thu Jul 14 05:12:18 2005 CDT
498,100,000   Thu Jul 14 06:24:09 2005 CDT
498,200,000   Thu Jul 14 07:36:01 2005 CDT
498,300,000   Thu Jul 14 08:47:53 2005 CDT
498,400,000   Thu Jul 14 09:59:44 2005 CDT
498,500,000   Thu Jul 14 11:11:36 2005 CDT
498,600,000   Thu Jul 14 12:23:27 2005 CDT
498,700,000   Thu Jul 14 13:35:19 2005 CDT
498,800,000   Thu Jul 14 14:47:10 2005 CDT
498,900,000   Thu Jul 14 15:59:02 2005 CDT
499,000,000   Thu Jul 14 17:10:54 2005 CDT
499,100,000   Thu Jul 14 18:22:45 2005 CDT
499,200,000   Thu Jul 14 19:34:37 2005 CDT
499,300,000   Thu Jul 14 20:46:28 2005 CDT
499,400,000   Thu Jul 14 21:58:20 2005 CDT
499,500,000   Thu Jul 14 23:10:12 2005 CDT
499,600,000   Fri Jul 15 00:22:03 2005 CDT
499,700,000   Fri Jul 15 01:33:55 2005 CDT
499,800,000   Fri Jul 15 02:45:46 2005 CDT
499,900,000   Fri Jul 15 03:57:38 2005 CDT
500,000,000   Fri Jul 15 05:09:29 2005 CDT


#!/usr/bin/perl -w

use strict;
use LWP::Simple qw(get);
use CAM::XML;
use DateTime::Format::Strptime;

# Constants
my $url = "http://www.apple.com/itunes/external_counter.xml";

# Fetch, parse and extract tags from the XML
print "Retrieving $url...\n";
my $xmlstr = get($url) || die "Failed to retrive the XML";
my $xml = CAM::XML->parse(-string => $xmlstr) || die "Failed to parse the XML";
my @nodes = $xml->getNodes(-tag => "count");
die "Not enough data in the XML\n" unless (@nodes >= 2);

# Parse the times and counts out of the XML data
my $parser = DateTime::Format::Strptime->new(pattern => '%a, %d %b %Y %H:%M:%S %Z');
my ($count1, $count2, $time1, $time2);
foreach my $node (@nodes)
{
   my $timestr = $node->getAttribute("timestamp");
   my $timestamp = $parser->parse_datetime($timestr)->epoch;
   my $count = $node->getInnerText();
   if ($node->getAttribute("name") =~ /cur/)
   {
      $time2 = $timestamp;
      $count2 = $count;
   }
   else
   {
      $time1 = $timestamp;
      $count1 = $count;
   }
}
die "Failed to understand the XML\n" unless ($count1 && $count2 && $time1 && $time2);

# Compute the songs per second
my $rate = ($count2-$count1)/($time2-$time1);
printf "    Rate: %.2f songs/sec\n", $rate;

# Extrapolate to now
my $now = int($rate * (time()-$time2) + $count2);
print "    Predicted count right now: $now (".localtime()." CDT)\n";

# Extrapolate to other prize times
for (my $c=485000000; $c<=500000000; $c+=100000)
{
   next if ($c < $count2); # these have already passed...
   my $t = ($c-$count2)/$rate + $time2;
   # Insert commas
   my $cstr = $c;
   1 while ($cstr =~ s/(\d)(\d{3}(?:,.*|))$/$1,$2/);
   print "    $cstr   ".localtime($t)." CDT\n";
}