remove seemingly old useless ed
[mharc.git] / bin / mh-month-pack
1 #!/usr/bin/perl
2 ##--------------------------------------------------------------------------##
3 ##  File:
4 ##      $Id: mh-month-pack,v 1.5 2002/10/11 23:52:28 ehood Exp $
5 ##  Description:
6 ##      See POD below or run program with -man option.
7 ##--------------------------------------------------------------------------##
8 ##  Copyright (C) 2002      Earl Hood <earl@earlhood.com>
9 ##
10 ##  This program is free software; you can redistribute it and/or modify
11 ##  it under the terms of the GNU General Public License as published by
12 ##  the Free Software Foundation; either version 2 of the License, or
13 ##  (at your option) any later version.
14 ##
15 ##  This program is distributed in the hope that it will be useful,
16 ##  but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 ##  GNU General Public License for more details.
19 ##
20 ##  You should have received a copy of the GNU General Public License
21 ##  along with this program; if not, write to the Free Software
22 ##  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
23 ##  02111-1307, USA
24 ##--------------------------------------------------------------------------##
25
26 package MHArc::mh_month_pack;
27
28 BEGIN { die qq/CGI use FORBIDDEN!\n/ if (defined($ENV{'GATEWAY_INTERFACE'})); }
29
30 use Getopt::Long;
31
32 use constant SCAN_FORMAT_STR =>
33     '%(msg) %<{x-mharc-packed}*%>%(year{date})-%02(mon{date})-%02(mday{date})';
34
35 my $debug = 0;
36 my $verbose = 0;
37 my $noop = 0;
38 my $noanno = 0;
39 my $all = 0;
40
41 my $outdir = '.';
42 my $yearly = 0;
43
44 MAIN: {
45   # Grap command-line options
46   GetOptions(
47     "all!"        => \$all,
48     "debug!"      => \$debug,
49     "n!"          => \$noop,
50     "noanno!"     => \$noanno,
51     "outdir=s"    => \$outdir,
52     "verbose!"    => \$verbose,
53     "yearly!"     => \$yearly,
54
55     "help"        => \$help,
56     "man"         => \$man
57   ) || usage(0);
58   usage(1) if $help;
59   usage(2) if $man;
60
61   $verbose = 1  if $noop;
62   $verbose = 1  if $debug;
63
64   my @folders = @ARGV;
65   if (@folders <= 0) {
66     die qq/Error: No folders specified\n/;
67   }
68
69   # Trim in leading +'s specified
70   foreach (@folders) {
71     s/^\+//;
72   }
73
74   # Save off current folder
75   my $curfolder = `folder -fast`;
76   chomp $curfolder;
77   print qq/Current folder is "$curfolder"\n"/  if $verbose;
78
79   local(*SCAN);
80   my $folder;
81   foreach $folder (@folders) {
82     print qq/Processing folder "$folder"...\n/  if $verbose;
83
84     # Open read pipe to scan to get message number and date for each
85     # message.
86     if (!open(SCAN, qq/scan +$folder -format '/.SCAN_FORMAT_STR.qq/'|/)) {
87       warn qq/Warning: Non-zero exit status from "scan": $?\n/;
88       next;
89     }
90
91     my($msg, $date, $rest);
92     my($year, $mon, $day);
93     my($mbox, $packed);
94
95     # Read scan output and copy messages into mailbox files
96     while (<SCAN>) {
97       next  unless /^\s*\d/;
98
99       print $_  if $debug;
100       chomp;
101
102       ($msg, $date, $rest) = split(' ', $_, 3);
103       $packed = $date =~ s/\*//;
104
105       if (!$all && $packed) {
106         print qq/Skipping message "$msg", already packed.\n/;
107         next;
108       }
109
110       $date += 1900  if $date < 1900;   # just incase
111       ($year, $mon, $day) = split('-', $date, 3);
112
113       if ($yearly) {
114         $mbox = $year;
115       } else {
116         $mbox = "$year-$mon";
117       }
118
119       # Pre-create the mbox file if it does not exist: prevents
120       # packf from prompting to create.
121       if (! -e $mbox) {
122         run_cmd("touch $outdir/$mbox");
123       }
124
125       # Have packf actually append message to mailbox file.
126       if (run_cmd("packf -mbox -file $outdir/$mbox $msg")) {
127         warn qq/Warning: Non-zero exit status from "packf": $?\n/;
128         next;
129       }
130
131       # Annotate message that it has been processed.
132       if (!$noanno) {
133         if (run_cmd("anno -component x-mharc-packed -inplace -nodate ".
134                     "-text '1' $msg")) {
135           warn qq/Warning: Non-zero exit status from "anno": $?\n/;
136           next;
137         }
138       }
139     }
140
141     close(SCAN);
142   }
143
144   # Restore current folder
145   run_cmd("folder +$curfolder");
146
147 } # End: MAIN
148
149
150 sub run_cmd {
151   if ($verbose) {
152     print @_, "\n";
153   }
154   return 0  if ($noop);
155   system(@_);
156 }
157
158 sub usage {
159   require Pod::Usage;
160   my $verbose = shift;
161   if ($verbose == 0) {
162     Pod::Usage::pod2usage(-verbose => $verbose);
163   } else {
164     my $pager = $ENV{'PAGER'} || 'more';
165     local(*PAGER);
166     my $fh = (-t STDOUT && open(PAGER, "|$pager")) ? \*PAGER : \*STDOUT;
167     Pod::Usage::pod2usage(-verbose => $verbose,
168                           -output  => $fh);
169   }
170 }
171
172
173 ##--------------------------------------------------------------------------##
174 __END__
175
176 =head1 NAME
177
178 mh-month-pack - Copy MH/nmh messages into monthly mailbox files.
179
180 =head1 SYNOPSIS
181
182   mh-month-pack [options] folder ...
183
184 =head1 DESCRIPTION
185
186 This program copies MH/nmh messages into mailbox files.  By default,
187 monthly mailbox files are created with filenames of I<YYYY-MM> format.
188 If the C<-yearly> option is specified, than messages will be split
189 into yearly, I<YYYY>, files.  If a mailbox file already exists,
190 messages will be appended to it.
191
192 Each MH/nmh process will be annotated inorder to mark the message as
193 having been processed, unless the C<-noanno> option is specified.
194 The annotation allows this program to reprocess folders multiple
195 times and to skip messages that have been packed before.
196
197 This program is provided as part of mharc to provide the ability
198 to import MH/nmh messages into mharc archives.  This program could
199 be used for sites that have an existing MH/nmh filtering system
200 inplace and want to usage mharc to generate web-based archives.
201 This program can be used instead of L<filter-spool|filter-spool> to
202 move incoming messages into the raw message archive before calling
203 L<web-archive|web-archive>.
204
205 =head1 OPTIONS
206
207 Any non-option argument is treated as an MH/nmh folder to process.
208 Folders are specified in the same manner as in MH/nmh commands.
209
210 =over
211
212 =item C<-all>
213
214 Force packing of all messages, even if some messages are marked as
215 processed.
216
217 =item C<-debug>
218
219 Like C<-verbose>, but prints out more.
220
221 =item C<-help>
222
223 Print out help message.
224
225 =item C<-man>
226
227 Print out the manpage.
228
229 =item C<-n>
230
231 Just echo what would be done, but do not do it.  This is handy
232 to verify what will be done before actually doing it for real.
233
234 =item C<-noanno>
235
236 Do not annotate messages that have been processed.  By default, this
237 program will annotate the messages via the anno(1) command to mark
238 messages as being processed.  Therefore, if the folder is processed
239 again in the future, the message will be skipped.
240
241 =item C<-outdir> I<directory>
242
243 Directory to place mailbox files.  If not specified, the
244 current working directory is used.
245
246 =item C<-verbose>
247
248 Print status of what is going on.
249
250 =item C<-yearly>
251
252 Generate yearly-based mailbox files instead of monthly-based.
253
254 =back
255
256 =head1 DEPENDENCIES
257
258 This program requires that the following MH/nmh commands are in
259 your search path: C<anno(1)>, C<folder(1)>, C<scan(1)>, C<packf(1)>.
260
261 =head1 LIMITATIONS
262
263 =over
264
265 =item *
266
267 Pre-existing gzipped mailbox files are not recognized.
268
269 =back
270
271 =head1 VERSION
272
273 $Id: mh-month-pack,v 1.5 2002/10/11 23:52:28 ehood Exp $
274
275 =head1 AUTHOR
276
277 Earl Hood, earl@earlhood.com
278
279 This program is part of the mharc archiving system and comes with
280 ABSOLUTELY NO WARRANTY and may be copied only under the terms of
281 the GNU General Public License, which may be found in the mharc
282 distribution.
283
284 =cut
285