Subversion Repositories sysadmin_scripts

Rev

Go to most recent revision | Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
14 rodolico 1
package Mail::IMAPClient::MessageSet;
2
#$Id: MessageSet.pm,v 1.3 2002/12/13 18:08:49 dkernen Exp $
3
 
4
=head1 NAME
5
 
6
Mail::IMAPClient::MessageSet -- an extension to Mail::IMAPClient that
7
expresses lists of message sequence numbers or message UID's in the shortest
8
way permissable by RFC2060.
9
 
10
=cut
11
 
12
sub str { 
13
	# print "Overloaded ", overload::StrVal(${$_[0]}),"\n";
14
	return overload::StrVal(${$_[0]}); 
15
}
16
sub rem {
17
	my $self = shift;
18
	my $minus = ref($self)->new(@_);
19
	my %deleted = map { $_ => 1 } @{$minus->unfold} ;
20
	${$self} = $self->range(
21
		map { exists $deleted{$_} ? () : $_ } @{$self->unfold}
22
	);
23
	return $self;	
24
}
25
sub cat {
26
	my $self = shift;
27
	my @a = ("$self",@_);
28
	${$self} = $self->range(@a);
29
	return $self;	
30
}
31
use overload 	qq/""/ => "str" ,
32
		qq/.=/=>"cat", 
33
		qq/+=/=>"cat", 
34
		qq/-=/=>"rem", 
35
		q/@{}/=>"unfold", 
36
		fallback => "TRUE";
37
 
38
sub new {
39
	my $class = shift;
40
	my $range = $class->range(@_);
41
	my $object = \$range;
42
	bless $object, $class;
43
	return $object ;	
44
}
45
 
46
sub range {
47
	my $class = shift;	
48
	if ( 	scalar(@_) == 1 and 
49
		ref($_[0]) =~ /Mail::IMAPClient::MessageSet/
50
	) {
51
		return $_[0] ;
52
	}
53
 
54
	my @msgs = ();
55
	for my $m (@_) {
56
		next if !defined($m) or $m eq "";
57
		if ( ref($m) ) {
58
		   foreach my $mm (@$m) {
59
			foreach my $c ( split(/,/,$mm) ) {
60
			 	if ( $c =~ /:/ ) {
61
					my($l,$h) = split(/:/,$c) ;
62
					push @msgs,$l .. $h ;
63
				} else {
64
					push @msgs,$c;
65
				}
66
			}
67
		   }
68
		} else {
69
			#print STDERR "m=$m\n";
70
			foreach my $c ( split(/,/,$m) ) {
71
			 	if ( $c =~ /:/ ) {
72
					my($l,$h) = split(/:/,$c) ;
73
					push @msgs,$l .. $h ;
74
				} else {
75
					push @msgs,$c;
76
				}
77
			}
78
		}
79
	} 
80
	return undef unless @msgs;
81
	my @range = ();
82
	my $high = $low = "";
83
	for my $m (sort {$a<=>$b} @msgs) {
84
		$low = $m if $low eq "";
85
		next if $high ne "" and $high == $m ; # been here, done this
86
		if ( $high eq "" ) { 
87
			$high = $m ;
88
		} elsif ( $m == $high + 1 ) {
89
			$high = $m ;
90
		} else {
91
			push @range, $low == $high ? "$low," : "$low:$high," ;
92
			$low = $m ;
93
			$high = $m ;
94
		}
95
	}
96
	push @range, $low == $high ? "$low" : "$low:$high" ;
97
	my $range = join("",@range);
98
	return $range;
99
}
100
 
101
sub unfold {
102
	my $self = $_[0];
103
	return wantarray ? 
104
		(	map { my($l,$h)= split(/:/,$_) ; $h?($l..$h):$l }
105
			split(/,/,$$self) 	
106
		) : 
107
		[	map { my($l,$h)= split(/:/,$_) ; $h?($l..$h):$l }
108
			split(/,/,$$self) 	
109
		]
110
	;
111
}
112
 
113
=head2 DESCRIPTION
114
 
115
The B<Mail::IMAPClient::MessageSet> module is designed to make life easier
116
for programmers who need to manipulate potentially large sets of IMAP
117
message UID's or sequence numbers.
118
 
119
This module presents an object-oriented interface into handling your message
120
sets. The object reference returned by the L<new> method is an overloaded 
121
reference to a scalar variable that contains the message set's compact
122
RFC2060 representation. The object is overloaded so that using it like a string
123
returns this compact message set representation. You can also add messages to
124
the set (using either a '.=' operator or a '+=' operator) or remove messages
125
(with the '-=' operator). And if you use it as an array reference, it will 
126
humor you and act like one by calling L<unfold> for you. (But you need perl 5.6
127
or above to do this.)
128
 
129
RFC2060 specifies that multiple messages can be provided to certain IMAP
130
commands by separating them with commas. For example, "1,2,3,4,5" would 
131
specify messages 1, 2, 3, 4, and (you guessed it!) 5. However, if you are
132
performing an operation on lots of messages, this string can get quite long.
133
So long that it may slow down your transaction, and perhaps even cause the
134
server to reject it. So RFC2060 also permits you to specifiy a range of
135
messages, so that messages 1, 2, 3, 4 and 5 can also be specified as
136
"1:5". 
137
 
138
This is where B<Mail::IMAPClient::MessageSet> comes in. It will convert your
139
message set into the shortest correct syntax. This could potentially save you 
140
tons of network I/O, as in the case where you want to fetch the flags for
141
all messages in a 10000 message folder, where the messages are all numbered
142
sequentially. Delimited as commas, and making the best-case assumption that 
143
the first message is message "1", it would take 48893 bytes to specify the 
144
whole message set using the comma-delimited method. To specify it as a range, 
145
it takes just seven bytes (1:10000). 
146
 
147
=head2 SYNOPSIS
148
 
149
To illustrate, let's take the trivial example of a search that returns these
150
message uids: 1,3,4,5,6,9,10, as follows:
151
 
152
	@msgs = $imap->search("SUBJECT","Virus"); # returns 1,3,4,5,6,9,10
153
	my $msgset = Mail::IMAPClient::MessageSet->new(@msgs);
154
	print "$msgset\n";  # prints "1,3:6,9:10\n"
155
	# add message 14 to the set:
156
	$msgset += 14;	
157
	print "$msgset\n";  # prints "1,3:6,9:10,14\n"
158
	# add messages 16,17,18,19, and 20 to the set:
159
	$msgset .= "16,17,18:20";	
160
	print "$msgset\n";  # prints "1,3:6,9:10,14,16:20\n"
161
	# Hey, I didn't really want message 17 in there; let's take it out:
162
	$msgset -= 17;
163
	print "$msgset\n";  # prints "1,3:6,9:10,14,16,18:20\n"
164
	# Now let's iterate over each message:
165
	for my $msg (@$msgset) {
166
		print "$msg\n";
167
	}       # Prints: "1\n3\n4\n5\n6\n9\n10\n14\n16\n18\n19\n20"
168
 
169
(Note that the L<Mail::IMAPClient> B<Range> method can be used as 
170
a short-cut to specifying C<Mail::IMAPClient::MessageSet-E<gt>new(@etc)>.) 
171
 
172
=cut
173
 
174
=head1 CLASS METHODS
175
 
176
The only class method you need to worry about is B<new>. And if you create
177
your B<Mail::IMAPClient::MessageSet> objects via L<Mail::IMAPClient>'s 
178
B<Range> method then you don't even need to worry about B<new>.
179
 
180
=head2 new
181
 
182
Example:
183
 
184
	my $msgset = Mail::IMAPClient::MessageSet->new(@msgs);
185
 
186
The B<new> method requires at least one argument. That argument can be 
187
either a message, a comma-separated list of messages, a colon-separated 
188
range of messages, or a combination of comma-separated messages and 
189
colon-separated ranges. It can also be a reference to an array of messages,
190
comma-separated message lists, and colon separated ranges.
191
 
192
If more then one argument is supplied to B<new>, then those arguments should
193
be more message numbers, lists, and ranges (or references to arrays of them)
194
just as in the first argument.
195
 
196
The message numbers passed to B<new> can really be any kind of number at
197
all but to be useful in a L<Mail::IMAPClient> session they should be either
198
message UID's (if your I<Uid> parameter is true) or message sequence numbers.
199
 
200
The B<new> method will return a reference to a B<Mail::IMAPClient::MessageSet>
201
object. That object, when double quoted, will act just like a string whose
202
value is the message set expressed in the shortest possible way, with the
203
message numbers sorted in ascending order and with duplicates removed. 
204
 
205
=head1 OBJECT METHODS
206
 
207
The only object method currently available to a B<Mail::IMAPClient::MessageSet>
208
object is the L<unfold> method.
209
 
210
=head2 unfold
211
 
212
Example:
213
 
214
	my $msgset = $imap->Range( $imap->messages ) ;
215
	my @all_messages = $msgset->unfold;
216
 
217
The B<unfold> method returns an array of messages that belong to the 
218
message set. If called in a scalar context it returns a reference to the 
219
array instead.
220
 
221
=head1 OVERRIDDEN OPERATIONS
222
 
223
B<Mail::IMAPClient::MessageSet> overrides a number of operators in order
224
to make manipulating your message sets easier. The overridden operations are:
225
 
226
=head2 stringify
227
 
228
Attempts to stringify a B<Mail::IMAPClient::MessageSet> object will result in
229
the compact message specification being returned, which is almost certainly
230
what you will want.
231
 
232
=head2 Auto-increment
233
 
234
Attempts to autoincrement a B<Mail::IMAPClient::MessageSet> object will 
235
result in a message (or messages) being added to the object's message set. 
236
 
237
Example:
238
 
239
	$msgset += 34;
240
	# Message #34 is now in the message set 
241
 
242
=head2 Concatenate
243
 
244
Attempts to concatenate to a B<Mail::IMAPClient::MessageSet> object will 
245
result in a message (or messages) being added to the object's message set. 
246
 
247
Example:
248
 
249
	$msgset .= "34,35,36,40:45";
250
	# Messages 34,35,36,40,41,42,43,44,and 45 are now in the message set 
251
 
252
The C<.=> operator and the C<+=> operator can be used interchangeably, but
253
as you can see by looking at the examples there are times when use of one
254
has an aesthetic advantage over use of the other.
255
 
256
=head2 Autodecrement
257
 
258
Attempts to autodecrement a B<Mail::IMAPClient::MessageSet> object will 
259
result in a message being removed from the object's message set. 
260
 
261
Examples:
262
 
263
	$msgset -= 34;
264
	# Message #34 is no longer in the message set 
265
	$msgset -= "1:10";
266
	# Messages 1 through 10 are no longer in the message set 
267
 
268
If you attempt to remove a message that was not in the original message set
269
then your resulting message set will be the same as the original, only more
270
expensive. However, if you attempt to remove several messages from the message
271
set and some of those messages were in the message set and some were not,
272
the additional overhead of checking for the messages that were not there
273
is negligable. In either case you get back the message set you want regardless
274
of whether it was already like that or not.
275
 
276
=cut
277
 
278
=head1 REPORTING BUGS
279
 
280
Please feel free to e-mail the author at C<bug-Mail-IMAPClient@rt.cpan.org>
281
if you encounter any strange behaviors. Don't worry about hurting my 
282
feelings or sounding like a whiner or anything like that; 
283
if there's a problem with this module you'll be doing me a favor by
284
reporting it.  However, I probably won't be able to do much about it if 
285
you don't include enough information, so please read and follow these
286
instructions carefully.
287
 
288
When reporting a bug, please be sure to include the following:
289
 
290
- As much information about your environment as possible. I especially
291
need to know B<which version of Mail::IMAPClient you are running> and the
292
B<type/version of IMAP server> to which you are connecting. Your OS and
293
perl verions would be helpful too.
294
 
295
- As detailed a description of the problem as possible. (What are you
296
doing? What happens? Have you found a work-around?)
297
 
298
- An example script that demonstrates the problem (preferably with as
299
few lines of code as possible!) and which calls the Mail::IMAPClient's
300
L<new> method with the L<Debug> parameter set to "1". (If this generates
301
a ridiculous amount of output and you're sure you know where the problem
302
is, you can create your object with debugging turned off and then 
303
turn it on later, just before you issue the commands that recreate the 
304
problem. On the other hand, if you can do this you can probably also 
305
reduce the program rather than reducing the output, and this would be 
306
the best way to go under most circumstances.)
307
 
308
- Output from the example script when it's running with the Debug
309
parameter turned on. You can edit the output to remove (or preferably
310
to "X" out) sensitive data, such as hostnames, user names, and
311
passwords, but PLEASE do not remove the text that identifies the TYPE
312
of IMAP server to which you are connecting. Note that in most versions
313
of B<Mail::IMAPClient>, debugging does not print out the user or
314
password from the login command line. However, if you use some other
315
means of authenticating then you may need to edit the debugging output
316
with an eye to security.
317
 
318
- If something worked in a previous release and doesn't work now,
319
please tell me which release did work. You don't have to test every
320
intervening release; just let me know it worked in version x but
321
doesn't work in version (x+n) or whatever.
322
 
323
- Don't be surprised if I come back asking for a trace of the problem.
324
To provide this, you should create a file called I<.perldb> in your
325
current working directory and include the following line of text in
326
that file:
327
 
328
C<&parse_options("NonStop=1 LineInfo=mail_imapclient_db.out");>
329
 
330
For your debugging convenience, a sample .perldb file, which was
331
randomly assigned the name F<sample.perldb>, is provided in the
332
distribution.
333
 
334
Next, without changing your working directory, debug the example script
335
like this: C<perl -d example_script.pl [ args ]>
336
 
337
Note that in these examples, the script that demonstrates your problem
338
is named "example_script.pl" and the trace output will be saved in
339
"mail_imapclient_db.out". You should either change these values to suit
340
your needs, or change your needs to suit these values.
341
 
342
Bug reports should be mailed to: 
343
 
344
	bug-Mail-IMAPClient@rt.cpan.org
345
 
346
Please remember to place a SHORT description of the problem in the subject
347
of the message. Please try to be a bit specific; things like "Bug
348
in Mail::IMAPClient" or "Computer Problem" won't exactly expedite things
349
on my end.
350
 
351
=head1 REPORTING THINGS THAT ARE NOT BUGS
352
 
353
If you have suggestions for extending this functionality of this module, or
354
if you have a question and you can't find an answer in any of the 
355
documentation (including the RFC's, which are included in this distribution
356
for a reason), then you can e-mail me at the following address:
357
 
358
	comment-Mail-IMAPClient@rt.cpan.org
359
 
360
Please note that this address is for questions, suggestions, and other comments
361
about B<Mail::IMAPClient>. It's not for reporting bugs, it's not for general 
362
correspondence, and it's especially not for selling porn, mortgages, Viagra, 
363
or anything else.
364
 
365
=head1 AUTHOR
366
 
367
	David J. Kernen
368
	The Kernen Consulting Group, Inc
369
	DJKERNEN@cpan.org
370
 
371
=cut
372
 
373
=head1 COPYRIGHT
374
 
375
          Copyright 1999, 2000, 2001, 2002 The Kernen Group, Inc.
376
          All rights reserved.
377
 
378
This program is free software; you can redistribute it and/or modify it
379
under the terms of either:
380
 
381
=over 4
382
 
383
=item a) the "Artistic License" which comes with this Kit, or
384
 
385
=item b) the GNU General Public License as published by the Free Software 
386
Foundation; either version 1, or (at your option) any later version.
387
 
388
=back
389
 
390
This program is distributed in the hope that it will be useful, but
391
WITHOUT ANY WARRANTY; without even the implied warranty of
392
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either the GNU
393
General Public License or the Artistic License for more details. All your
394
base are belong to us.
395
 
396
=cut
397
 
398
my $not_void = 11; # This module goes all the way up to 11!
399
 
400
# History: 
401
# $Log: MessageSet.pm,v $
402
# Revision 1.3  2002/12/13 18:08:49  dkernen
403
# Made changes for version 2.2.6 (see Changes file for more info)
404
#
405
# Revision 1.2  2002/11/08 15:48:42  dkernen
406
#
407
# Modified Files: Changes
408
# 		IMAPClient.pm
409
# Modified Files: MessageSet.pm
410
#
411
# Revision 1.1  2002/10/23 20:45:55  dkernen
412
#
413
# Modified Files: Changes IMAPClient.pm MANIFEST Makefile.PL
414
# Added Files: Makefile.PL MessageSet.pm
415
#
416
#