22

✏️ Editing: build_dist.pl

#!/usr/bin/perl
#$Id$

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;

=head1 AUTHOR 
	
David J. Kernen

The Kernen Group, Inc.

imap@kernengroup.com

=head1 COPYRIGHT

This example is distributed with Mail::IMAPClient and 
subject to the same licensing requirements as Mail::IMAPClient.

=cut

# $Id$
# $Log: build_dist.pl,v $
# Revision 19991216.7  2003/06/12 21:38:29  dkernen
#
# Preparing 2.2.8
# Added Files: COPYRIGHT
# Modified Files: Parse.grammar
# Added Files: Makefile.old
# 	Makefile.PL Todo sample.perldb
# 	BodyStructure.pm
# 	Parse.grammar Parse.pod
#  	range.t
#  	Thread.grammar
#  	draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt
#  	rfc2221.txt rfc2359.txt rfc2683.txt
#
# 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
#

MR SKB