lib/MHArc/MailUtil.pm

   1 ##--------------------------------------------------------------------------##
   2 ##  File:
   3 ##      $Id: MailUtil.pm,v 1.3 2002/09/13 07:24:18 ehood Exp $
   4 ##  Description:
   5 ##      POD at end of file.
   6 ##--------------------------------------------------------------------------##
   7 ##  Copyright (C) 2002  Earl Hood <earl@earlhood.com>
   8 ##
   9 ##  This program is free software; you can redistribute it and/or modify
  10 ##  it under the terms of the GNU General Public License as published by
  11 ##  the Free Software Foundation; either version 2 of the License, or
  12 ##  (at your option) any later version.
  13 ##
  14 ##  This program is distributed in the hope that it will be useful,
  15 ##  but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ##  GNU General Public License for more details.
  18 ##
  19 ##  You should have received a copy of the GNU General Public License
  20 ##  along with this program; if not, write to the Free Software
  21 ##  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  22 ##  02111-1307, USA
  23 ##--------------------------------------------------------------------------##
  24
  25 package MHArc::MailUtil;
  26
  27 use Exporter;
  28 @ISA = qw(Exporter);
  29
  30 @EXPORT_OK = qw(
  31   &extract_date
  32 );
  33
  34 ##--------------------------------------------------------------------------##
  35
  36 BEGIN {
  37   $Debug = 0;
  38 }
  39
  40 ##--------------------------------------------------------------------------##
  41
  42 sub extract_date {
  43   my $fields      = shift;
  44   my @dfs         = @_;
  45
  46   local $_;
  47   my @date_fields = ( );
  48   if (!@dfs) {
  49     @date_fields = ( ['received',0],['delivery-date',0],['date',0] );
  50   } else {
  51     foreach (@dfs) {
  52       s/\s//g;  tr/A-Z/a-z/;
  53       if (s/\[(\d+)\]//) {
  54         push(@date_fields, [ $_, $1 ]);
  55       } else {
  56         push(@date_fields, [ $_, 0 ]);
  57       }
  58     }
  59   }
  60
  61   my @date;
  62   my($field_str, $unix_time, $df, $i);
  63   foreach (@date_fields) {
  64     ($df, $i) = @$_;
  65     if (defined($field_str = $fields->{$df}[$i])) {
  66       print qq/Debug: $df: $field_str\n/  if $Debug;
  67       if ($df eq 'received') {
  68         my @ra = split(/;/, $field_str);
  69         $field_str = pop(@ra);
  70       }
  71       @date = mhonarc::parse_date($field_str);
  72       if (scalar(@date)) {
  73         print qq/Debug: \@date=/, join('|',@date), qq/\n/  if $Debug;
  74         $unix_time = mhonarc::get_time_from_date(@date[1..$#date]);
  75         last;
  76       }
  77     }
  78   }
  79   if (!defined($unix_time)) {
  80     print qq/Debug: Unable to parse date, using current time\n/  if $Debug;
  81     $unix_time = time;
  82   }
  83   $unix_time;
  84 }
  85
  86 ##--------------------------------------------------------------------------##
  87 1;
  88 __END__
  89
  90 =head1 NAME
  91
  92 MHArc::MailUtil - General mail-related utilities for mail archiving system.
  93
  94 =head1 SYNOPSIS
  95
  96   use MHArc::MailUtil;
  97
  98 =head1 DESCRIPTION
  99
 100 This module contains a collection of mail-related utility routines.
 101
 102 =head1 VARIABLES
 103
 104 The following module variables can be set to affect the behavior
 105 of the utility routines:
 106
 107 =over
 108
 109 =item C<$Debug>
 110
 111 If set to a true value, routines will print out debuging information.
 112
 113 =back
 114
 115 =head1 ROUTINES
 116
 117 By default, no routines are exported into the calling namespace.
 118 Routines in this module can be imported by explicitly listing the
 119 routines to import in the C<use> declaration:
 120
 121   use MHArc::MailUtil qw( extract_date );
 122
 123 The following routines are availale:
 124
 125 =over
 126
 127 =item C<extract_date($fields, I<@date_fields>)>
 128
 129 Extract the date from message header fields represented by C<$fields>.
 130 Any additional arguments are treated as message fields names (which
 131 should be lowercase names) to examine to find the date.  If no fields
 132 names are specified, than the following fields are checked in order:
 133 C<Received>, C<Delivery-Date>, and C<Date>.
 134
 135 The return value of this function is the date of the message in
 136 Unix time format: the same as what is returned by Perl's
 137 builtin C<time> function.
 138
 139 =back
 140
 141 =head1 DEPENDENCIES
 142
 143 Functions in this module assume that the MHonArc libraries have
 144 already been loaded.
 145
 146 =head1 VERSION
 147
 148 C<$Id: MailUtil.pm,v 1.3 2002/09/13 07:24:18 ehood Exp $>
 149
 150 =head1 AUTHOR
 151
 152 Earl Hood, earl@earlhood.com
 153
 154 This module is part of the mharc archiving system and comes with
 155 ABSOLUTELY NO WARRANTY and may be copied only under the terms of
 156 the GNU General Public License, which may be found in the mharc
 157 distribution.
 158
 159 =cut
 160