Showing posts with label Perl. Show all posts
Showing posts with label Perl. Show all posts

Monday, March 01, 2010

Perl: conditional use and scope

A reader asks

If I conditionally load a perl module, do those module variables get passed to the whole perl script.

if ( some_test ) {
  use "perlmodule_001";
}
else {
  use "perlmodule_002";
}
Are the elements of either perl module available outside the if statement?

The main program from the question has a syntax error:

syntax error at prog0 line 2, near "use "perlmodule_001""

Perl's documentation for use explains:

use Module

Imports some semantics into the current package from the named module, generally by aliasing certain subroutine or variable names into your package. It is exactly equivalent to

BEGIN { require Module; Module->import( LIST ); }
except that Module must be a bareword.

Note the bareword constraint at the end: the compiler doesn't like the double quotes around the argument to use. Our friend was likely thinking of the older require operator that does accept strings and arbitrary expressions in general.

Say we have two modules with alternative definitions of $Foo and $Bar:

package Perlmodule_001;

use Exporter 'import';
our @EXPORT = qw/ $Foo $Bar /;

our $Foo = "apple";
our $Bar = "orange";

1;

and

package Perlmodule_002;

use Exporter 'import';
our @EXPORT = qw/ $Foo $Bar /;

our $Foo = 42;
our $Bar = "w00t!";

1;

Note the use of Perlmodule_001, for example, rather than perlmodule_001: the perlmodlib documentation notes, “Perl informally reserves lowercase module names for 'pragma' modules like integer and strict.”

Consider the following simple driver:

#! /usr/bin/perl

use warnings;
use strict;

if (@ARGV && $ARGV[0] eq "two") {
  use Perlmodule_002;
}
else {
  use Perlmodule_001;
}

sub maybeUndef {
  defined $_[0] ? $_[0] : "<undefined>";
  # got 5.10?
  # $_[0] // "<undefined>";
}

print "Foo = ", maybeUndef($Foo),  "\n",
      "Bar = ", maybeUndef($Bar),  "\n";

It uses maybeUndef to explicitly show when a value is undefined and also to silence potential undefined-value warnings.

The program seems to run as intended

$ ./prog1
Foo = apple
Bar = orange

but the output is the same even when an argument of two is supplied on the command line!

$ ./prog1 two
Foo = apple
Bar = orange

The good news is that the imported variables are in scope for the rest of the program, as indicated in the above documentation for use (with emphasis added):

Imports some semantics into the current package from the named module …

To understand why we never see Perlmodule_002's $Foo and $Bar, note that use “is exactly equivalent to” require at BEGIN time, and the perlmod documentation explains exactly when that is (with added emphasis):

A BEGIN code block is executed as soon as possible, that is, the moment it is completely defined, even before the rest of the containing file (or string) is parsed.

So the compiler sees use Perlmodule_002 and processes it. Then it sees use Perlmodule_001 and processes it. When the compiler finishes digesting the rest of the code, it's time for the execution phase, when the @ARGV check finally takes place. As written, Perlmodule_001 will always win!

Because ordinary modules affect the current package, useing an ordinary module inside a conditional block is entirely misleading. I was careful to qualify the previous statement for ordinary modules because the effects of some pragmatic modules (e.g., strict and integer—note the lowercase names!) are limited tightly to the enclosing block only.

The fix is to process @ARGV at BEGIN time and conditionalize the module imports with the equivalent require and import:

#! /usr/bin/perl

use warnings;
use strict;

BEGIN {
  if (@ARGV && $ARGV[0] eq "two") {
    require Perlmodule_002;
    Perlmodule_002->import;
  }
  else {
    require Perlmodule_001;
    Perlmodule_001->import;
  }
}

sub maybeUndef {
  defined $_[0] ? $_[0] : "<undefined>";
  # got 5.10?
  # $_[0] // "<undefined>";
}

print "Foo  = ", maybeUndef($Foo),  "\n",
      "Bar  = ", maybeUndef($Bar),  "\n";

An alternative is protecting use with eval as in

BEGIN {
  if (@ARGV && $ARGV[0] eq "two") {
    eval "use Perlmodule_002";
  }
  # ...

so a particular use runs only when control reaches its eval but is ignored otherwise. This is a safe, sensible use of eval.

Either way, the program now does what we expect!

$ ./prog2
Foo  = apple
Bar  = orange
$ ./prog2 two
Foo  = 42
Bar  = w00t!

You might wonder why the code has to be inside a BEGIN block after the uses are conditionalized. If you have the strict pragma enabled—and you should!—it wants variables to be imported and declared before execution begins. Otherwise, compilation will fail because for all it knows, $Foo and $Bar in the main package were typos.

Tuesday, November 24, 2009

GMT crontab

Dealing with time is a problem domain where everything seems like it ought to be dead-simple, but getting all the fiddly details correct is never trivial.

Below is a sketch at converting simple crontabs whose times are expressed in GMT to the host's local time. This blog post wishes it were a literate Haskell program.

In general, if you care about timezones, represent times internally in some universal format and convert times for display purposes only.

Front matter:

#! /usr/bin/perl

use warnings;
use strict;

use feature qw/ switch /;

use Time::Local qw/ timegm /;

Given a five-field job time in GMT, gmtoday returns the hour in the local timezone and the day offset. The function's name comes from its implementation, nearly always a terrible practice. It uses the time the program started ($^T), decomposes it with gmtime, substitutes the hour from cron, and goes the other direction with timegm.

Now that I think about it, this probably doesn't handle the day-of-week wraparound: Sunday is 0 and Saturday is 6, but the days are adjacent.

sub gmtoday {
  my($gmmin,$gmhr,$gmmday,$gmmon,$gmwday) = @_;

  my @gmtime = gmtime $^T;
  my(undef,undef,$hour,$mday,$mon,$year,$wday) = @gmtime;

  my @args = (
    0,  # sec
    $gmmin eq "*" ? "0" : $gmmin,
    $gmhr,
    $mday,                        
    $mon,
    $year,
  );

  my($lhour,$lwday) = (localtime timegm @args)[2,6];

  ($lhour, $lwday - $wday);
}

Given the five-field time specification from the current cronjob, localcron converts it from GMT to local time. Note that a fully general implementation would support 32 (i.e., 2 ** 5) cases.

This is a nice use of given-when, new in perl-5.10, and resembles a familiar shell idiom.

sub localcron {
  my($gmmin,$gmhr,$gmmday,$gmmon,$gmwday) = @_;

  given ("$gmmin,$gmhr,$gmmday,$gmmon,$gmwday") {
    # trivial case: no adjustment necessary
    when (/^\d+,\*,\*,\*,\*$/) {
      return ($gmmin,$gmhr,$gmmday,$gmmon,$gmwday);
    }

    # hour and maybe minute
    when (/^(\d+|\*),\d+,\*,\*,\*$/) {
      my($lhour) = gmtoday @_;
      return ($gmmin,$lhour,$gmmday,$gmmon,$gmwday);
    }

    # day of week, hour, and maybe minute
    when (/^(\d+|\*),\d+,\*,\*,\d+$/) {
      my($lhour,$wdoff) = gmtoday @_;
      return ($gmmin,$lhour,$gmmday,$gmmon,$gmwday+$wdoff);
    }

    default {
      warn "$0: unhandled case: $gmmin $gmhr $gmmday $gmmon $gmwday";
      return;
    }
  }
}

Finally, the main loop reads each line from the input and generates the appropriate output. Note that we do not throw away unhandled times: they instead appear in the output as comments.

while (<>) {
  if (/^\s*(?:#.*)?$/) {
    print;
    next;
  }

  chomp;
  my @gmcron = split " ", $_, 6;

  my $cmd = pop @gmcron;
  my @localcron = localcron @gmcron;

  if (@localcron) {
    print join(" " => @localcron), "\t", $cmd, "\n"
  }
  else {
    print "# ", $_, "\n";
  }
}

For this sorta-crontab

33  * * * * minute only
 0  0 * * * minute and hour
 0 10 * * 1 minute, hour, and wday (same day)
 0  2 * * 1 minute, hour, and wday (cross day)
the output is the following when run in the US Central timezone:
33 * * * *  minute only
0 18 * * *  minute and hour
0 4 * * 1   minute, hour, and wday (same day)
0 20 * * 0  minute, hour, and wday (cross day)

Tuesday, September 15, 2009

Don't repeat yourself!

Jose Rey demonstrates a few features of Perl 5.10, but all the nearly identical actions scream for smart matching!

# ...

my %func;
@func{qw( count   geometric_mean  harmonic_mean
          max     maxdex          mean
          median  min             mindex
          mode    sample_range    standard_deviation
          sum     trimmed_mean    variance           )} = ();

my $s = Statistics::Descriptive::Full->new();
while (1) {
    print "Listo> ";
    my $command = readline(STDIN) // last;
    $command =~ s/^\s+//; $command =~ s/\s+$//;
    given ($command) {
        when ( looks_like_number($_) ) { $s->add_data($command) }
        when (%func)                   { say "$command = " . $s->$command() }
        when (/^(exit|quit)$/)         {last}
        default                        { say SYNTAX_ERROR }
    }
}

As the smart-match table shows, $scalar ~~ %hash tests for hash-key existence. In this case, given ($command) followed by when (%func) checks whether the current command is a builtin and, when it is, invokes the method with the same name.

Monday, August 31, 2009

Finding duplicates with Perl and Haskell

A coworker wanted to check a family of log files to be sure that a given task never appeared on multiple nodes at the same time. Log entries are on single, whitespace-separated lines, and the last field records a task's start time, e.g.,
1251475056672590000_1732248586_4
Of the three underscore-separated fields, the first is a timestamp, the second we don't care about, and the third is a task identifier.

This task is straightforward with Perl. The diamond operator (or null filehandle, as described in the "I/O Operators" section of the perlop manpage) takes care of the boilerplate for iterating over the paths on the command line, opening them, and reading each line. The scalar $ARGV contains the name of the current file.

By default, split separates fields by whitespace, so (split)[-1] gives us the last field, from which we then grab the time and task with a regular expression and record its presence by pushing the entry's path and line number onto an array associated with that time/task pair. After we've processed the logs, these arrays should all be singletons.

The continue clause is a little weird but necessary because the special variable $., the current line number, does not reset on <>'s implicit opens. ARGV is a handle on the file being read.

With this data structure, detecting duplicates is a search for time/task pairs with multiple hits. We count duplicates and let the user know what we found.

#! /usr/bin/perl

use warnings;
use strict;

# e.g., $hits = @{ $seen{$time}{$task} };
my %seen;

sub num { $a <=> $b }

while (<>) {
  if ((split)[-1] =~ /^(\d+)_\d+_(\d+)$/) {
    my($time,$task) = ($1,$2);
    push @{ $seen{$time}{$task} } => "$ARGV:$.";
  }
  else {
    die "$0: $ARGV:$.: bad timestamp/task field\n";
  }
}
continue {
  close ARGV if eof;
}

my $duplicates = 0;
foreach my $time (sort num keys %seen) {
  foreach my $task (sort num keys %{ $seen{$time} }) {
    my @hits = @{ $seen{$time}{$task} };
    next if @hits == 1;

    $duplicates += @hits - 1;
    warn "$0: duplicates for time=$time, task=$task:\n",
         map "    - $_\n", @hits;
  }
}

my $s = $duplicates == 1 ? "" : "s";
print "$0: $duplicates duplicate$s detected.\n";

exit $duplicates == 0 ? 0 : 1;

For comparison, I implemented the same log checker in Haskell. The function allInputs emulates Perl's diamond operator, and instead of a multi-level hash, the association is more direct: time/task pair to a list of hits.

module Main where

import Control.Monad (liftM)
import Data.List (sort)
import Data.Map (empty,filter,fromListWith,toList,unionWith)
import Prelude hiding (filter)
import System.Environment (getArgs,getProgName)
import System.Exit (ExitCode(..),exitWith)
import Text.Printf (printf)

type Time = String
type Task = String
data Duplicates =
  Duplicates { timestamp :: Time
             , taskId    :: Task
             , locations :: [(FilePath, Int)]
             }

main :: IO ()
main = do
  logs <- allInputs
  let multi = dups logs
      n = sum $ map (subtract 1 . length . locations) multi
  mapM_ (msg . lines . dupmsg) multi
  msg $ ndups n
  exitWith $ if n == 0
               then ExitSuccess
               else ExitFailure 1
  where
    msg info = do me <- getProgName
                  putStrLn $ me ++ ": " ++ head info
                  mapM_ putStrLn (tail info)

    ndups 1 = ["1 duplicate detected"]
    ndups n = [show n ++ " duplicates detected"]

    dupmsg (Duplicates tm task ls) = unlines $
      printf "duplicates for time=%s, task=%s:" tm task :
      map (\(path,n) -> printf "    - %s:%d" path n) ls

allInputs :: IO [(FilePath, String)]
allInputs = getArgs >>= go
  where go [] = ((:[]) . (,) "-"`liftM` getContents
        go fs = mapM readFile fs >>= return . zip fs

dups :: [(FilePath, String)] -> [Duplicates]
dups = map (\((tm,task),ds) -> Duplicates tm task ds) .
       sort .
       toList .
       filter ((> 1. length) .
       foldl (unionWith (++)) empty .
       map (\(path, contents) ->
              fromListWith (++$
              map (wrap path . getTimeTask) $
              zip [1..$ lines contents)
  where
    wrap path (tm,task,n) = ((tm,task), [(path,n)])

getTimeTask :: (Int,String) -> (Time,Task,Int)
getTimeTask (n,line) = (tm,tsk,n)
  where
    [tm,_,tsk] = splitBy '_' (last $ words line)

    splitBy :: Eq a => a -> [a] -> [[a]]
    splitBy _ [] = []
    splitBy x xs = h : splitBy x t
      where (h,rest) = break (== x) xs
            t = drop 1 rest

Friday, June 05, 2009

Waiting for Go-done

A coworker called this morning wanting to know how to get a list of files that do not contain the text 'Program complete' on any line. They run jobs in big batches, and each process writes its output to a separate file. The running times vary, and they wanted an easy way to see at a glance which processes are still running.

Running grep -v will print all lines that don't match the given pattern, but that doesn't help in this case because we want to treat the output files as though each contained a single line.

With the -c option, grep outputs the number of lines that matched. Say we have outputs named output1 through output4, and the odd-numbered jobs are finished. This would give us

$ grep -c 'Program complete' output*
output1:1
output2:0
output3:1
output4:0
The pattern requires quotes because it contains a space. Without the quotes, grep would search for Program in files named complete, output1, and so on.

The outputs for the processes still running are the ones containing zero matches, so let's look for those:

$ grep -c 'Program complete' output* | grep ':0$'
output2:0
output4:0
Remember that a dollar sign in a regular expression anchors the match to the end.

Quick cleanup with sed gives us the names of the outputs (backslash is the shell's line-continuation marker that lets us split long lines):

$ grep -c 'Program complete' output* | \
  grep ':0$' | \
  sed -e 's/:0$//'
output2
output4

UPDATE: Turns out there's a much easier way to do it. GNU grep has a --files-without-match option (aka -L), so the command is the simple

$ grep -L 'Program complete' output*
output2
output4

Wednesday, February 18, 2009

Scraping data from a program's output

Consider a (truncated) output from vmstat on AIX:
  2031616 memory pages
  1953185 lruable pages
   935166 free pages
        1 memory pools
   170943 pinned pages
     80.0 maxpin percentage
  ...
Say you want to grab the values for memory pages and free pages. Below, I explain a couple of ways to do it.
#! /usr/bin/perl

use warnings;
use strict;

no warnings "exec";

open my $fh, "vmstat -v |"
  or die "$0: can't execute vmstat: $!\n";

my %vmstat;

while () {
  chomp;
  my($n,$desc) = split " ", $_, 2;

  $vmstat{$desc} = $n;
}

print "Memory pages: $vmstat{'memory pages'}\n",
      "Free pages:   $vmstat{'free pages'}\n";
When the filename argument to open ends with a pipe, Perl runs the named command and makes its output available on the returned filehandle. I turn off the autogenerated error (no warnings "exec") because I like my format better.

Looking at vmstat's output, each line has a value and a description, so the plan is to read each line and stash the parameters where we can find them later. A hash is a perfect data structure for this task.

Most of the time, the pattern to the split operator is a regular expression, but with no arguments (or a pattern of a lone space) it acts like awk, throwing away leading whitespace. Because the descriptions contain spaces, we don't want to split on them and tell Perl to give us back exactly two fields. Because we've limited the number of splits, we have to remove the trailing newline with chomp.

The output is straightforward: print the desired values.

You can of course be more clever:

#! /usr/bin/perl

%vmstat = reverse `vmstat -v` =~ /(\S+) (.+)/g;

print "Memory pages: $vmstat{'memory pages'}\n",
      "Free pages:   $vmstat{'free pages'}\n";
Instead of a piped open, this time we use backticks (``) to capture vmstat's output and from the output extract the values and descriptions.

The regular expression \S+ means a sequence of one or more non-whitespace characters, and this matches the numbers in the output. You might be tempted to use \d+ (one or more digits), but this will give you surprising results on the floating-point numbers.

By default, dot does not match newline, so the (.+) subpattern matches through the rest of the current line — the description in this case.

The /g regular-expression switch means we get all possible non-overlapping matches.

The list returned from the match will look like (2031616, "memory pages", 1953185, "lruable pages", ...), but that's the opposite order from hash initialization, i.e., key then value. The reverse operator fixes this problem.

Friday, February 13, 2009

25 random songs

Bo hit me with the 25 random songs meme. Who wants to push buttons when you can write a program?
#! /usr/bin/perl

use warnings;
use strict;

use File::Find;

use constant CHOOSE_N => 25;

@ARGV = "." unless @ARGV;

my @mp3;
my $matches = sub {
  push @mp3 => $File::Find::name
    if /\.mp3$/i;
};

find $matches => @ARGV;

# Fisher-Yates-Knuth
for (my $n = $#mp3; $n >= 1; $n--) {
  my $k = int rand($n+1);
  @mp3[$k,$n] = @mp3[$n,$k];
}

for (1 .. CHOOSE_N) {
  last unless @mp3;
  my $song = shift @mp3;

  # e.g., .../Music/Bob Marley/Kaya/08 - Crisis.mp3
  if ($song =~ m!^.*/([^/]+)/[^/]+/\d+\s+-\s+(.+)\.!) {
    my($artist,$title) = ($1,$2);
    print qq{$_. "$title," $artist\n};
  }
}

The output:
  1. "The End," The Doors
  2. "Misty Morning," Bob Marley
  3. "My Mood Swings," Elvis Costello
  4. "Concerto Emperor: II. Adagio un poco moto," Ludwig van Beethoven
  5. "What's the Matter Here?," 10,000 Maniacs
  6. "Trench Town Rock," Bob Marley
  7. "Final Hour," Lauryn Hill
  8. "These Are Days," 10,000 Maniacs
  9. "Want-Ad Blues," John Lee Hooker
  10. "Loser," Beck
  11. "Sonata Pathétique: II. Adagio cantabile" Ludwig van Beethoven
  12. "Peer Gynt Suite No. 2: Ingrid's Lament," Edvard Grieg
  13. "4 Better or 4 Worse (interlude)," The Pharcyde
  14. "Bonita Applebum," A Tribe Called Quest
  15. "Hard Hearted Woman," John Lee Hooker
  16. "Jeremy," Pearl Jam
  17. "Toccata and Fugue in D minor," Johann Sebastian Bach
  18. "Ya Mama," The Pharcyde
  19. "Pennyroyal Tea," Nirvana
  20. "Concerto in C minor for Violin and Oboe," Johann Sebastian Bach
  21. "Sex Type Thing," Stone Temple Pilots
  22. "Drive," R.E.M.
  23. "People Are Strange," The Doors
  24. "Vivrant Thing - Violator (feat. Q-Tip)," A Tribe Called Quest
  25. "The New Pollution," Beck