#!/usr/bin/perl # # HURL: http://impressive.net/software/hurl/ # Copyright 1998 Gerald Oskoboiny # # 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{}; 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;