1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134
|
#!/usr/local/bin/perl
#$Id: build_dist.pl,v 19991216.6 2000/12/11 21:58:50 dkernen Exp $
use Mail::IMAPClient;
=head1 DESCRIPTION
B<build_dist.pl> accepts the name of a target folder as an argument. It
then opens that folder and rummages through all the mail files in it, looking
for "Reply-to:" headers (or "From:" headers, where there is no "Reply-to:").
It then appends a message into the folder containing all of the addresses in
thus found as a list of recipients. This message can be used to conveniently
drag and drop names into an address book, distribution list, or e-mail message,
using the GUI client of choice.
The email appended to the folder specified in the I<-f> option will have the
subject "buid_dist.pl I<folder> Output".
=head1 SYNTAX
b<build_dist.pl> I<-h>
b<build_dist.pl> I<-s servername -u username -p password -f folder [ -d ]>
=over 4
=item -f The folder name to process.
=item -s The servername of the IMAP server
=item -u The user to log in as
=item -p The password for the user specified in the I<-u> option
=item -d Tells the IMAP client to turn on debugging info
=item -h Prints out this document
=back
B<NOTE:> You can supply defaults for the above options by updating the script.
=cut
use Getopt::Std;
getopts('s:u:p:f:d');
# Update the following to supply defaults:
$opt_f ||= "default folder";
$opt_s ||= "default server";
$opt_u ||= "default user";
$opt_p ||= "default password"; # security risk: use with caution!
# Let the compiler know we're serious about these two variables:
$opt_h = $opt_h or $opt_d = $opt_d ;
exec "perldoc $0" if $opt_h;
my $imap = Mail::IMAPClient->new(
Server => $opt_s ,
User => $opt_u ,
Password=> $opt_p ,
Debug => $opt_d||0 ,
) or die "can't connect to server\n";
$imap->select($opt_f);
my @msgs = $imap->search("NOT SUBJECT",qq("buid_dist.pl $opt_f Output"));
my %list;
foreach my $m (@msgs) {
my $ref = $imap->parse_headers($m,"Reply-to","From");
warn "Couldn't get recipient address from msg#$m\n"
unless scalar(@{$ref->{'Reply-to'}}) ||
scalar(@{$ref->{'From'}}) ;
my $from = scalar(@{$ref->{'Reply-to'}}) ?
$ref->{'Reply-to'}[0] :
$ref->{'From'}[0] ;
my $addr = $from;
$addr =~ s/.*<//;
$addr =~ s/[\<\>]//g;
$list{$addr} = $from unless exists $list{$addr};
}
$append = <<"EOMSG";
To: ${\(join(",",values %list))}
From: $opt_u\@$opt_s
Date: ${\($imap->Rfc822_date(time))}
Subject: build_dist.pl $opt_f Output
The above note was never actually sent to the following people:
${\(join("\n",keys %list))}
Interesting, eh?
Love,
$opt_u
EOMSG
$imap->append($opt_f,$append) or warn "Couldn't append the message.";
$imap->logout;
# $Id: build_dist.pl,v 19991216.6 2000/12/11 21:58:50 dkernen Exp $
# $Log: build_dist.pl,v $
# Revision 19991216.6 2000/12/11 21:58:50 dkernen
#
# Modified Files:
# build_dist.pl build_ldif.pl copy_folder.pl find_dup_msgs.pl
# imap_to_mbox.pl populate_mailbox.pl
# to add CVS data
#
# Revision 19991216.5 1999/12/16 17:19:09 dkernen
# Bring up to same level
#
# Revision 19991124.3 1999/12/16 17:14:22 dkernen
# Incorporate changes for exists method performance enhancement
#
# Revision 19991124.02 1999/11/24 17:46:16 dkernen
# More fixes to t/basic.t
#
# Revision 19991124.01 1999/11/24 16:51:46 dkernen
# Changed t/basic.t to test for UIDPLUS before trying UID cmds
#
# Revision 1.8 1999/11/23 17:51:05 dkernen
# Committing version 1.06 distribution copy
#
|