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;
}
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.