I killed my head

This one should actually go under "idiotic uses for perl" or some such.

Recently, I installed LWP - and during the build it asked me if I wanted to install the GET, HEAD and POST aliases. I wasn't thinking, but I was installing system-wide on my osx laptop (never a good combination).

Shortly thereafter, I was running this great big build system that all of a sudden started failing mysteriously. Sure enough: somewhere in ./configure a call was made to head, i.e. the textutil that prints the first n lines in text files or a piped string. Because osx is case-insensitive (why, for the love of god?) and I installed LWP system-wide, /usr/bin/head (the util) was overwritten by /usr/bin/HEAD (the lwp-request alias).

What to do?

Because I didn't feel like hunting the internets for darwinports of the gnu textutils I decided to rename the lwp-request aliases HEAD, GET and POST into lwp-HEAD, lwp-GET and lwp-POST (this required some tweaking of the scripts, because they compose requests based on $0), then recreated the head util as a perl script. What it needed to do was still somewhat defined in the man page, and on another - solaris - machine I recreated the corner cases (bad options and values), so I ended up with the following (I coded it using strict and warnings and IO::File, but decided to remove all dependencies once it seemed to work):

#!/usr/bin/perl

# okay, so I messed up, whatever, I'll just rewrite the head utility :
+-P

# default lines to read
my $lines = 10;

# there might be two command line arguments -n $i, 
# which we need to remove from @ARGV
if ( @ARGV ) {

        # process args, will implement both -n 10 and -10
        if ( $ARGV[0] =~ qr/^-(.+)$/ ) {
                my $flag = $1;

                # using traditional api
                if ( $flag eq 'n' ) {
                        $lines = $ARGV[1];

                        # if it's not an integer above zero, print msg
+ and quit
                        if ( $lines !~ qr/^\d+$/ or $lines <= 0 ) {
                                print "head: Invalid \"-n $lines\" opt
+ion\n";
                                print "usage: head [-n #] [-#] [filena
+me...]\n";
                                exit 1;
                        }

                        # remove args from @ARGV
                        shift(@ARGV);
                        shift(@ARGV);
                }

                # maybe first arg is -10, not actually used by darwin,
+ though!
                elsif ( $flag =~ qr/^\d+$/ ) {
                        $lines = $flag;

                        # if it's not an integer above zero, print msg
+ and quit
                        if ( $lines <= 0 ) {
                                print "head: Invalid \"-n $lines\" opt
+ion\n";
                                print "usage: head [-n #] [-#] [filena
+me...]\n";
                                exit 1;
                        }

                        # remove arg from @ARGV
                        shift(@ARGV);
                }

                # some other flag was used!
                else {
                        print "head: illegal option -- $flag\n";
                        print "usage: head [-n #] [-#] [filename...]\n
+";
                        exit 1;

                }

        }

}

# additional arguments are file names
if ( @ARGV ) {

        # more than one file? print header
        my $more_than_one_file = $#ARGV;

        # need to add a line break before ==> XXX <== after first file
        my $files_read = 0;

        # loop over remaining args
        for my $arg ( @ARGV ) {
                open ( my $handle, '<', $arg ) or print "$arg: $!\n" a
+nd exit 1;
                print "\n" if $files_read++;
                print "==> $arg <==\n" if $more_than_one_file;
                my $counter = 0;
                PRINT_FROM_FILE: while ( defined( my $line = <$handle>
+ ) ) {
                        print $line;
                        last PRINT_FROM_FILE if ++$counter == $lines;
                }
                close $handle;
        }

        # no further behaviour
        exit 0;
}

my $counter = 0;
PRINT_FROM_STRING: while(<>){
        print;
        last PRINT_FROM_STRING if ++$counter == $lines;
}
[download]

Lessons learned:

Think before you install system-wide.
Exact command line arguments of head differ between darwin and solaris (latter also does "head -20 <file>").
Exit values are ill defined, just 0 and >0 (I did 1 for the latter).
Behavior on binary files is undefined.

In the end, though, the great big build system now works again.

Back to Cool Uses for Perl