Example 3.1: hopdelta

#!/usr/bin/perl
# hopdelta - feed mail header, produce lines
#            showing delay at each hop.
use strict;
use Date::Manip qw (ParseDate UnixDate);

# print header; this should really use format/write due to
# printf complexities
printf "%-20.20s %-20.20s %-20.20s   %s\n", 
        "Sender", "Recipient", "Time", "Delta";

$/ = '';                # paragraph mode
$_ = <>;                # read header
s/\n\s+/ /g;            # join continuation lines

# calculate when and where this started
my($start_from) = /^From.*\@([^\s>]*)/m;
my($start_date) = /^Date:\s+(.*)/m;
my $then = getdate($start_date);
printf "%-20.20s %-20.20s %s\n", 'Start', $start_from, fmtdate($then);

my $prevfrom = $start_from;

# now process the headers lines from the bottom up
for (reverse split(/\n/)) {
    my ($delta, $now, $from, $by, $when);
    next unless /^Received:/;
    s/\bon (.*?) (id.*)/; $1/s;         # qmail header, I think
    unless (($when) = /;\s+(.*)$/) {    # where the date falls
        warn "bad received line: $_";
        next;
    }
    ($from) = /from\s+(\S+)/;           
    ($from) = /\((.*?)\)/ unless $from; # some put it here
    $from =~ s/\)$//;                   # someone was too greedy
    ($by)   = /by\s+(\S+\.\S+)/;        # who sent it on this hop

    # now random mungings to get their string parsable
    for ($when) {
        s/ (for|via) .*$//;
        s/([+-]\d\d\d\d) \(\S+\)/$1/;
        s/id \S+;\s*//;
    }
    next unless $now = getdate($when);          # convert to Epoch
    $delta = $now - $then;

    printf "%-20.20s %-20.20s %s  ", $from, $by, fmtdate($now);
    $prevfrom = $by;
    puttime($delta);
    $then = $now;               
}

exit;

# convert random date strings into Epoch seconds
sub getdate {
    my $string     =  shift;
    $string        =~ s/\s+\(.*\)\s*$//;        # remove nonstd tz
    my $date       =  ParseDate($string);
    my $epoch_secs =  UnixDate($date,"%s");
    return $epoch_secs;
}

# convert Epoch seconds into a particular date string
sub fmtdate {
    my $epoch = shift;
    my($sec,$min,$hour,$mday,$mon,$year) = localtime($epoch);
    return sprintf "%02d:%02d:%02d %04d/%02d/%02d",
        $hour, $min, $sec,
        $year + 1900, $mon + 1, $mday,
}

# take seconds and print in pleasant-to-read format
sub puttime {
    my($seconds) = shift;
    my($days, $hours, $minutes);

    $days    = pull_count($seconds, 24 * 60 * 60);
    $hours   = pull_count($seconds, 60 * 60);
    $minutes = pull_count($seconds, 60);

    put_field('s', $seconds);
    put_field('m', $minutes);
    put_field('h', $hours);
    put_field('d', $days);

    print "\n";
}

# usage: $count = pull_count(seconds, amount)
# remove from seconds the amount quantity, altering caller's version.
# return the integral number of those amounts so removed.
sub pull_count {
    my($answer) = int($_[0] / $_[1]);
    $_[0] -= $answer * $_[1];
    return $answer;
}

# usage: put_field(char, number)
# output number field in 3-place decimal format, with trailing char
# suppress output unless char is 's' for seconds
sub put_field {
    my ($char, $number) = @_;
    printf " %3d%s", $number, $char if $number || $char eq 's';
}