#!/usr/bin/perl
#
# HURL: http://impressive.net/software/hurl/
# Copyright 1998 Gerald Oskoboiny <gerald@impressive.net>
#
# funcs.pl: misc functions to do useful things (header parsing, ...)
#
# $Id: funcs.pl,v 1.16 2003/01/06 21:31:48 gerald Exp $
@short_months = ( "",
"Jan", "Feb", "Mar", "Apr", "May", "Jun",
"Jul", "Aug", "Sep", "Oct", "Nov", "Dec" );
%short_month_hash = (
"Jan" => "01", "Feb" => "02", "Mar" => "03",
"Apr" => "04", "May" => "05", "Jun" => "06",
"Jul" => "07", "Aug" => "08", "Sep" => "09",
"Oct" => "10", "Nov" => "11", "Dec" => "12" );
@long_months = ( "",
"January", "February", "March", "April",
"May", "June", "July", "August",
"September", "October", "November", "December" );
$doctype = qq{<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">};
sub parse_header {
my (@header) = @_;
my (%header) = undef;
$prev = "";
for (@header) {
chomp;
# handle "folded" header lines (see RFC 822, secs. 3.1.1, 3.4.8)
if ( /^\s/ ) {
# $header{$prev} .= "\n"; # this screws up headers/foo
s/^\s+//; # remove space(s) from the front
$header{$prev} .= " " . $_; # append it to the previous header
next;
}
next unless /^[a-z]/i; # ignore messed-up header lines
s/^From /from_:/; # berkeley mbox separators
($type,$data) = split( /:/, $_, 2 );
$type =~ tr/A-Z/a-z/; # convert to lower case
$data =~ s/^\s+//g; # remove leading whitespace
$header{$type} = $data;
$prev = $type;
}
# is 'Date' in pre-great-renaming format?
if ( $header{Date} =~ /[0-9]-[A-Z][a-z][a-z]-[0-9]/o ) {
# yes, so we kludge it so it's not
$header{Date} =~ s/([0-9]*)-([A-Z][a-z][a-z])-/$1 $2 /o;
# there's probably a better / less-expensive way to do this.
}
$header{"message-id"} =~ s/ /./g;
return %header;
}
sub log {
my $name = $name; # name of the running script
my $message = shift; # the message to be logged
my $pid = $$; # current pid
my $time = time;
my ($sec,$min,$hours,$mday,$month,$year,$wday,$yday,$isdst) = localtime;
my $nicetime = sprintf("%04d-%02d-%02d %02d:%02d:%02d",
$year+1900, $month+1, $mday, $hours, $min, $sec );
print STDERR "$nicetime ${name}[$pid]: $message\n";
}
#
# day_of_week($year, $month, $date)
#
# provided by Tkil, http://slinky.scrye.com/~tkil/
# on #perl, Dec 13, 1998 -- gerald
#
# Return the day of the week (0 == Sunday ... 6 == Saturday) for the
# given date. $year should have four digits; $month and $date
# both start at 1, not zero.
#
# Algorithm is from the CRC Handbook of Mathematics, 30th Ed, page 738.
#
# see also: appendix B of RFC 3339, http://www.ietf.org/rfc/rfc3339.txt
#
sub day_of_week {
my ($year, $month, $date) = @_;
$month -= 2;
if ($month <= 0) {
-- $year;
$month += 12;
}
my $cent = int($year/100);
$year %= 100;
# print STDERR "year=$year, cent=$cent, date=$date, month=$month\n";
my $dow = ($date
+ int(2.6*$month - 0.2)
- 2*$cent
+ $year
+ int($year/4)
+ int($cent/4));
$dow += 7 while $dow < 0;
$dow %= 7;
return $dow;
}
1;