#!/usr/bin/perl # # $Id: maildates,v 1.6 1998/04/15 23:03:40 vogelke Exp $ # # NAME: # maildates # # SYNOPSIS: # maildates [-v] # # DESCRIPTION: # "maildates" reads a series of mail messages in individual files, # and tries to write the date as a set of sortable fields # followed by the pathname. # # If we find a date, write an entry with the following # tab-separated fields: # # 1 - seconds since epoch # 2 - 4-digit year # 3 - 2-digit month # 4 - 2-digit day of month # 5 - day of year # 6 - week number, starting on Sunday # 7 - day of week (0 = Sunday) # 8,9,10 - time of day, UTC # 11 - filename # # EXAMPLE: # Input date from file "in": # Sat, 19 Apr 1997 10:28:30 -0400 # # Output: # 861460110:1997:04:19:109:15:6:14:28:30 in # # OPTIONS: # "-v" prints the current version and exits. # # AUTHOR: # Karl Vogel # Sumaria Systems, Inc. use Date::Parse; use Date::Format qw(time2str); $ENV{"PATH"} = "/bin:/usr/sbin:/usr/local/bin"; $tmp = "./maildates.tmp.$$"; ($myname) = split (/\//, reverse ($0)); $myname = reverse ($myname); # script basename. &usage unless &Getopts ('v'); &version if $opt_v; # # Expect filenames via stdin. # If we see a date we can read in the header, parse it and # write a sortable entry followed by the pathname. # &maildate; &exit (0); #--------------------------------------------------------------------- # Replace date strings in file headers. sub maildate { @files = <>; foreach $path (@files) { # # Check the file header for a date. # chomp ($path); next unless -T "$path"; open (IN, "$path") || die "$path"; while () { chomp; $save = $_; last if /^$/; last if /^\s+$/; if (/^date: /i) { $date = substr ($_, 6); last; } } close (IN); # # If we find a date, parse it and write it. # $t = str2time ($date); if (defined $t) { $x = time2str ("%s:%Y:%m:%d:%j:%U:%w:%T", $t, "UTC"); print "$x\t$path\n"; } else { print "ERROR: $save\t$path\n"; } } } #--------------------------------------------------------------------- # Print a short usage message from the comment header and exit. sub usage { if (open (PROG, "$myname")) { while () { last if /^# NAME:/; } print STDERR " NAME:\n"; while () { last if /^\s*$/; last if /^# AUTHOR:/; s/^#//; print STDERR; } close (PROG); } else { print STDERR "No usage information available.\n" ; } &exit (1); } #--------------------------------------------------------------------- # Print the current version and exit. sub version { $_ = '$RCSfile: maildates,v $ $Revision: 1.6 $ ' . '$Date: 1998/04/15 23:03:40 $'; s/RCSfile: //; s/.Date: //; s/,v . .Revision: / v/; s/\$//g; print "$_\n"; exit (0); } #--------------------------------------------------------------------- # Clean up. sub exit { local($code, $msg) = @_; unlink ($tmp); warn "$myname: $msg\n" if $msg; exit ($code); }