File: build_dist.pl

package info (click to toggle)
libmail-imapclient-perl 2.1.4-1
  • links: PTS
  • area: main
  • in suites: woody
  • size: 1,236 kB
  • ctags: 231
  • sloc: perl: 11,273; makefile: 56
file content (134 lines) | stat: -rwxr-xr-x 3,459 bytes parent folder | download
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
#