summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPeter Palfrader <peter@palfrader.org>2012-09-23 09:37:49 +0000
committerweasel <weasel@bc3d92e2-beff-0310-a7cd-cc87d7ac0ede>2012-09-23 09:37:49 +0000
commit0839330461fa86d5115fe39063f926aec3bf5b71 (patch)
treea9287a4988ec5706154be95520e9c9d412b36d27
parentccd32fe9322a5b240253ebb03c54c14d8f85323a (diff)
Add awm
git-svn-id: svn+ssh://asteria.noreply.org/svn/weaselutils/trunk@550 bc3d92e2-beff-0310-a7cd-cc87d7ac0ede
-rwxr-xr-xawm235
1 files changed, 235 insertions, 0 deletions
diff --git a/awm b/awm
new file mode 100755
index 0000000..0f89936
--- /dev/null
+++ b/awm
@@ -0,0 +1,235 @@
+#!/usr/bin/perl -w
+
+# awm - Archive Weasel's Mail
+#
+# Copyright (C) 2002 Peter Palfrader <peter@palfrader.org>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+
+=pod
+
+=head1 NAME
+
+awm - Archive Weasel's Mail
+
+=head1 SYNOPSIS
+
+=over
+
+=item B<awm> [B<--help>]
+
+=item B<awm> [B<--quiet>] [B<--verbose> [B<--verbose>]] [B<--older=>I<date>] B<--base=>I<base> [I<folder> [I<folder> ...]]
+
+=back
+
+=head1 DESCRIPTION
+
+B<awm> is a simple mail archiver for MailDir style mail folders. It moves mails
+older than the specified time to I<folder>.I<yyyy.mm> folders where I<yyyy.mm>
+is the date when the mail was received (last Received header) or sent (Date
+header) if no Received header can be found.
+
+It archives the Maildir folder I<base> as well as all subfolders (Maildirs in the
+same directory as I<base> that name starts with a period (B<.>)). If you list
+one of more folders it will only archive them.
+
+=head1 OPTIONS
+
+=over
+
+=item B<--verbose>
+
+Verbose mode. Causes B<awm> to print debugging messages about its progress. May
+be used more than once to increase verbosity.
+
+=item B<--quiet>
+
+Quiet mode. Be even more quient than normally (supress some warnings).
+
+=item B<--help>
+
+Print a short help and exit sucessfully.
+
+=item B<--version>
+
+Print version number and exit sucessfully.
+
+=item B<--base>=I<base>
+
+Specify the base of B<awm>'s operation. Example: C<--base=$(HOME)/Maildir>.
+
+=item B<--older>=I<date>
+
+Archive mails older than the specified date. Example: C<--older='-2 months'>
+or C<--older='2002-01-01'>. Defaults to two months ago. See
+C<Time::ParseDate(3)> for reognised formats.
+
+=back
+
+=head1 AUTHOR
+
+Peter Palfrader E<lt>peter@palfrader.orgE<gt>
+
+=head1 BUGS
+
+Please report them to the author.
+
+=cut
+
+use strict;
+use FindBin qw{ $Bin };
+use Getopt::Long;
+use Time::ParseDate;
+use Mail::Internet;
+use English;
+
+my $VERBOSE = 0;
+my $QUIET = 0;
+my $VERSION = '0.0.1';
+my $ARCHIVE_OLDER = '-2 months';
+my $BASE;
+
+sub make_target($$$) {
+ my ($folder, $dir, $time) = @_;
+
+ my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime($time);
+ $folder .= sprintf(".%04d.%02d", $year+1900, $mon+1);
+ $folder =~ s/^\.\././;
+ unless (-d $folder) {
+ for my $d ($folder, $folder.'/cur', $folder.'/new', $folder.'/tmp') {
+ mkdir ($d) or
+ warn ("$PROGRAM_NAME: Cannot mkdir $d: $!"),
+ return undef;
+ };
+ };
+ return $folder.'/'.$dir;
+};
+
+sub readfile($) {
+ my ($file) = @_;
+ open (F, $file) or
+ warn("$PROGRAM_NAME: Cannot open $file: $!\n"),
+ return undef;
+ my @result = <F>;
+ close (F) or
+ warn("$PROGRAM_NAME: Cannot read $file: $!\n"),
+ return undef;
+ return \@result;
+};
+
+sub gettime($) {
+ my ($file) = @_;
+ my $maillines = readfile($file) or
+ warn("$PROGRAM_NAME: Cannot read $file\n"),
+ return undef;
+
+ my $mail = new Mail::Internet($maillines);
+ my $header = $mail->head();
+ my $received = $header->get('Received', 0);
+ my ($date) = $received =~ /;([^;]+)$/ if defined $received;
+ my $time = parsedate($date) if defined $date;
+ unless (defined $time) {
+ $QUIET or warn ("$PROGRAM_NAME: Falling back to date header in $file\n");
+ $date = $header->get('Date');
+ $time = parsedate($date) if defined $date;
+ warn ("$PROGRAM_NAME: Cannot get time for mail $file\n"),
+ return undef
+ unless defined $time;
+ };
+ return $time;
+};
+
+sub archive_MailDir($$) {
+ my ($older, $folder) = @_;
+ for my $dir (qw{cur new}) {
+ opendir(DIR, $folder.'/'.$dir);
+ my @files = grep { ! /^\./ } readdir(DIR);
+ closedir(DIR);
+
+ for my $file (@files) {
+ my $time = gettime($folder.'/'.$dir.'/'.$file) or
+ warn("$PROGRAM_NAME: Cannot get time from $folder/$dir/$file\n"),
+ next;
+ my $date = gmtime($time);
+ if ($time < $older) {
+ my $target = make_target($folder, $dir, $time);
+ warn ("$PROGRAM_NAME: Target not defined\n"), next unless defined $target;
+ print " Moving $folder/$dir/$file to $target/$file ($date)\n"
+ if ($VERBOSE >= 2);
+ link($folder.'/'.$dir.'/'.$file, $target.'/'.$file) or
+ warn ("$PROGRAM_NAME: Cannot move $folder/$dir/$file to $target/$file\n"),
+ next;
+ unlink($folder.'/'.$dir.'/'.$file) or
+ warn ("$PROGRAM_NAME: Cannot unlink $folder/$dir/$file\n"),
+ next;
+ } else {
+ print " Not moving $folder/$dir/$file ($date)\n"
+ if ($VERBOSE >= 2);
+ };
+ };
+ };
+};
+
+
+my $HELP = 0;
+my $PRINTVERSION = 0;
+
+
+my $USAGE = "Usage: $PROGRAM_NAME [--help] [--quiet] [--verbose [--verbose]] [--older=<date>] --base=<base> [folder [folder]]\n";
+Getopt::Long::config('bundling');
+GetOptions (
+ '--verbose+' => \$VERBOSE,
+ '--quiet' => \$QUIET,
+ '--base=s' => \$BASE,
+ '--older=s' => \$ARCHIVE_OLDER,
+ '--help' => \$HELP,
+ '--version' => \$PRINTVERSION,
+) &&
+(defined $BASE) or
+ die ($USAGE);
+$HELP and
+ print $USAGE,
+ exit(0);
+$PRINTVERSION and
+ print "$PROGRAM_NAME version $VERSION",
+ exit(0);
+if ($ARCHIVE_OLDER =~ /[^0-9]/) {
+ $ARCHIVE_OLDER = parsedate($ARCHIVE_OLDER, PREFER_PAST => 1, WHOLE => 1);
+ die ("Cannot parse timestamp\n") unless defined $ARCHIVE_OLDER;
+};
+
+
+my @files;
+
+chdir($BASE);
+umask(0007);
+if (scalar @ARGV) {
+ @files = @ARGV
+} else {
+ opendir(DIR, '.');
+ @files = grep { $_ ne '..' && $_ ne 'cur' && $_ ne 'new' && $_ ne 'tmp' && -d $_ && (! m/\.\d\d$/) } readdir(DIR);
+ closedir(DIR);
+};
+
+for my $dir (@files) {
+ print "Doing $dir\n"
+ if ($VERBOSE >= 1);
+ archive_MailDir($ARCHIVE_OLDER, $dir);
+};
+
+
+# vim:set ts=2:
+# vim:set shiftwidth=2: