Commit | Line | Data |
---|---|---|
01c223d0 BOFG |
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 |