1# -*-Perl-*-
2################################################################
3###
4###			      Folder.pm
5###
6### Author:  Internet Message Group <img@mew.org>
7### Created: Apr 23, 1997
8### Revised: Apr 23, 2007
9###
10
11my $PM_VERSION = "IM::Folder.pm version 20161010(IM153)";
12
13package IM::Folder;
14require 5.003;
15require Exporter;
16
17use IM::Config qw(expand_path context_file inbox_folder folder_mode usetouchfile touchfile);
18use IM::Util;
19use integer;
20use strict;
21use vars qw(@ISA @EXPORT);
22
23@ISA = qw(Exporter);
24@EXPORT = qw(cur_folder set_cur_folder folder_info
25	message_list message_number message_range message_name
26	get_message_paths create_folder touch_folder
27        chk_folder_existance chk_msg_existance get_impath);
28
29#
30# Mail folder related routines.
31#
32
33sub cur_folder() {
34    my $folder;
35    local(*IN);
36
37    return inbox_folder() if (! -f context_file());
38
39    $folder = '';
40    im_open(\*IN, '< ' . context_file()) || im_die("can't open context file.\n");
41    while (<IN>) {
42	chomp;
43	if (/^CurrentFolder[:=]\s*(\S+)$/) {
44	    $folder = $1;
45	}
46    }
47    close(IN);
48    return $folder;
49}
50
51sub set_cur_folder($) {
52    my($folder) = @_;
53    local(*IN, *OUT);
54    my($buf);
55
56    $buf = '';
57
58    if (-f context_file()) {
59	im_open(\*IN, '<' . context_file()) || im_die("can't open context file.\n");
60	while (<IN>) {
61	    chomp;
62	    next if (/^CurrentFolder[:=]\s*(\S+)$/);
63	    $buf .= $_ . "\n";
64	}
65	close(IN);
66    }
67
68    im_open(\*OUT, '>' . context_file()) || im_die("can't open context file.\n");
69    print OUT $buf;
70    print OUT "CurrentFolder=$folder\n";
71    close(OUT);
72}
73
74sub folder_info($) {
75    my($folder) = @_;
76    local(*DIR);
77    my(@allfiles, $filecnt, $numfilecnt, $min, $max);
78
79    opendir(DIR, &expand_path($folder)) || im_die("can't open $folder.\n");
80    @allfiles = grep(!/^\./, readdir(DIR));
81    $filecnt = scalar(@allfiles);
82    @allfiles = grep(/^\d+$/, @allfiles);
83    $numfilecnt = scalar(@allfiles);
84    $min = (sort {$a <=> $b} @allfiles)[0];
85    $max = (sort {$b <=> $a} @allfiles)[0];
86    closedir(DIR);
87
88    return ($filecnt, $numfilecnt, $min, $max);
89}
90
91sub message_list($) {
92    my($folder_dir) = @_;
93    my @filesinfolder;
94
95    opendir(DIR, $folder_dir) || im_die("can't open $folder_dir.\n");
96    @filesinfolder = sort {$a <=> $b} grep(/^\d+$/, readdir(DIR));
97    closedir(DIR);
98
99    return @filesinfolder;
100}
101
102sub message_number($$;@) {
103    my($folder, $number, @filesinfolder) = @_;
104    my($folder_dir, $offset, $max, $min);
105
106    # simple case: digits
107    if ($number !~ /\D/) {
108	return $number;
109    }
110
111    # get folder
112    $folder = cur_folder if ($folder eq '');
113    $folder_dir = expand_path($folder);
114    return '' if (! -d $folder_dir);
115
116    @filesinfolder = message_list($folder_dir) if (scalar(@_) == 2);
117
118    if (scalar(@filesinfolder) == 0) {
119	if ($number eq 'new') {
120	    $number = '1';
121	    while (-e "$folder_dir/$number" || -e "$folder_dir/.$number.dir") {
122		$number++;
123	    }
124	    return $number;
125	} else {
126	    return '';
127	}
128    }
129
130    $min = $filesinfolder[0];
131    $max = $filesinfolder[$#filesinfolder];
132
133    # items that need reverse ordered list
134    if ($number eq 'last') {
135	return $max;
136    }
137    if ($number eq 'first') {
138	return $min;
139    }
140    if ($number eq 'new') {
141	$number = $max + 1;
142	while (-e "$folder_dir/$number" || -e "$folder_dir/.$number.dir") {
143	    $number++;
144	}
145	return $number;
146    }
147    if ($number eq 'next' || $number eq 'prev') {
148	$offset = ($number eq 'prev') ?  -1 : +1;
149
150	$number += $offset;
151	while ($min <= $number && $number <= $max) {
152	    return $number if (-f "$folder_dir/$number");
153	    $number += $offset;
154	}
155    }
156    return '';
157}
158
159sub message_range($$@) {
160    my($folder, $range, @filesinfolder) = @_;
161    my $range_regexp = '\d+|first|last|next|prev';
162
163    $folder = cur_folder if ($folder eq '');
164    my $folder_dir = expand_path($folder);
165
166    if ($range eq 'all') {
167	$range = 'first-last';
168    }
169
170    if ($range =~ /^($range_regexp|new)-($range_regexp|new)$/) {
171	my($start, $end) = ($1, $2);
172
173	$start = message_number($folder, $start, @filesinfolder);
174	$end = message_number($folder, $end, @filesinfolder);
175
176	if ($start eq '' || $end eq '' || $start > $end) {
177	    return ();
178	} else {
179	    return grep($start <= $_ && $_ <= $end, @filesinfolder);
180	}
181    } elsif ($range =~ /^($range_regexp):([+-]?)(\d+)$/) {
182	my($start, $dir, $n) = ($1, $2, $3);
183	if ($dir eq '') {
184	    $dir = ($start eq 'last') ? '-' : '+';
185	}
186	$start = message_number($folder, $start, @filesinfolder);
187	return $range if ($start eq '');
188
189	if ($dir eq '+') {
190	    @filesinfolder = grep($start <= $_, @filesinfolder);
191	    splice(@filesinfolder, $n) if $n < scalar(@filesinfolder);
192	} else {
193	    @filesinfolder = grep($_ <= $start, @filesinfolder);
194	    splice(@filesinfolder, 0, @filesinfolder - $n)
195		if $n < scalar(@filesinfolder);
196	}
197	return @filesinfolder;
198    } else {
199	return message_number($folder, $range);
200    }
201}
202
203sub message_name($$) {
204    my($folder, $number) = @_;
205
206    $number = &message_number($folder, $number);
207    if ($number eq '') {
208	return '';
209    } else {
210	return &expand_path($folder) . '/' . $number;
211    }
212}
213
214sub get_message_paths($@) {
215    my($folder, @messages0) = @_; # local @messages0?
216    my($i, @messages, @x); # local(@messages, @x);?
217
218    my $folder_dir = &expand_path($folder);
219
220    # no message specified:
221    # just print the path to the folder, and quit.
222    if (scalar(@messages0) == 0) {
223	return ($folder_dir);
224    }
225
226    # messages specified.
227    # print the path to the message.
228    if (! -d $folder_dir) {
229	$@ = "no such folder $folder";
230	return ();
231    }
232
233    # ad hoc but fast
234    if (scalar(@messages0) == 1 && $messages0[0] eq 'new') {
235	local(*MDIR);
236	my($i);
237	my $max = "0";
238	opendir(MDIR, $folder_dir) || im_die("can't open $folder.\n");
239	while (defined($i = readdir(MDIR))) {
240	    $max = $i if ($max < $i and $i =~ /^\d+$/);
241	}
242	$max++;
243	closedir(MDIR);
244	return "$folder_dir/$max";
245    }
246
247    my @filesinfolder = message_list($folder_dir);
248
249    @messages = @x = ();
250    foreach $i (@messages0) {
251	if ((@x = &message_range($folder, $i, @filesinfolder)) eq '') {
252	    $@ = "message $i out of range";
253	    return ();
254	}
255	push(@messages, @x);
256    }
257
258    grep($_ = "$folder_dir/$_", @messages);
259}
260
261sub create_folder($) {
262    my $folder = shift;
263    my $path = &expand_path($folder);
264    return 0 if (-d $path);
265    my $p = '';
266    my $subdir;
267    foreach $subdir (split('/', $path)) {
268	if ($p eq '' && $subdir =~ /^\w:$/) {
269	    $p = $subdir;
270	    next;
271	}
272	$p .= "/$subdir";
273	if ($> != 0) {
274	    $p =~ /(.+)/;	# may be tainted
275	    $p = $1;	# clean up
276	}
277	unless (-d $p) {
278#	    im_debug("Creating directory: $p\n")
279#	      if (&debug('folder'));
280	    unless (mkdir($p, &folder_mode(0))) {
281		im_err("can't create directory $p ($!)\n");
282		return -1;
283	    }
284	}
285    }
286    return 0;
287}
288
289sub touch_folder($) {
290    if (&usetouchfile()) {
291 	my($dir) = shift;
292 	$dir =~ s/\/\d+$//;
293 	$dir = &expand_path($dir);
294 	my($file) = ($dir . "/" . &touchfile());
295	im_open(\*OF,">$file");
296	print OF "touched by IM.";
297	close(OF);
298    } elsif (&os2p) {
299	my($dir) = shift;
300	$dir =~ s/\/\d+$//;
301	$dir = &expand_path($dir);
302	my $now = time;	# XXX
303	utime ($now, $now, $dir);
304    }
305}
306
307##
308## Check folder existance.
309##
310sub chk_folder_existance(@) {
311    my @folders = @_;
312    my $path;
313
314    im_debug("chk_folder_existance: folder: @folders\n") if (&debug('all'));
315
316    foreach (@folders) {
317	next if /^[%-]/;		# skip IMAP and News folders
318	$path = get_impath($_);
319
320	if (-e $path) {
321	    im_die "folder $_ is not writable. (Nothing was refiled.)\n"
322		if (! -w $path);
323	} else {
324	    if (create_folder($path) == 0) {
325		im_warn "created folder $_.\n";
326	    } else {
327		im_die "cannot create folder $_. (Nothing was refiled.)\n";
328	    }
329	}
330    }
331    im_debug("chk_folder_existance: OK.\n") if (&debug('all'));
332}
333
334sub chk_msg_existance($@) {
335    my $folder = shift;
336    my @paths  = get_impath($folder, @_);
337
338    im_debug("chk_msg_existance: folder: $folder msg: @_\n") if (&debug('all'));
339
340    foreach (@paths) {
341	if (! -f $_) {
342	    im_die "message specification error in $folder. (Nothing was refiled.)\n";
343	}
344    }
345    im_debug("chk_msg_existance: OK.\n") if (&debug('all'));;
346}
347
348sub get_impath($@) {
349    my $folder = shift;
350    my @msgs  = @_;
351    my @paths;
352
353    im_debug("impath: folder: $folder msgs: @msgs\n") if (&debug('all'));;
354    @paths = get_message_paths($folder, @msgs);
355    im_debug("impath: paths: @paths\n") if (&debug('all'));;
356
357    return wantarray ? @paths : $paths[0];
358}
359
3601;
361
362__END__
363
364=head1 NAME
365
366IM::Folder - mail/news folder handler
367
368=head1 SYNOPSIS
369
370 use IM::Folder;
371
372 $current_folder_name = &cur_folder();
373
374 &set_cur_folder($new_current_folder_name);
375
376 ($number_of_files,
377  $number_of_message_files,
378  $minimum_message_number,
379  $maximum_message_number) = &folder_info($folder_name);
380
381 $message_number = &message_number($message_number_or_name);
382
383 @message_number_array = &message_range($message_range_string);
384
385 $message_file_path = &message_name($folder_name, $message_number);
386
387=head1 DESCRIPTION
388
389The I<IM::Folder> module handles mail/news message folders.
390
391This modules is provided by IM (Internet Message).
392
393=head1 EXAMPLES
394
395 &cur_folder();
396     results "+inbox"
397
398 &set_cur_folder("+inbox");
399
400 ($a, $b, $c, $d) = &folder_info("+inbox");
401     results (10, 3, 1, 3)
402
403 &message_number("+inbox", "cur");
404     results 3
405
406 &message_range("+inbox", "1-3");
407     results (1, 2, 3)
408
409 &message_name("+inbox", "3");
410     results "/usr/home/itojun/Mail/inbox/3"
411
412=head1 COPYRIGHT
413
414IM (Internet Message) is copyrighted by IM developing team.
415You can redistribute it and/or modify it under the modified BSD
416license.  See the copyright file for more details.
417
418=cut
419
420### Copyright (C) 1997, 1998, 1999 IM developing team
421### All rights reserved.
422###
423### Redistribution and use in source and binary forms, with or without
424### modification, are permitted provided that the following conditions
425### are met:
426###
427### 1. Redistributions of source code must retain the above copyright
428###    notice, this list of conditions and the following disclaimer.
429### 2. Redistributions in binary form must reproduce the above copyright
430###    notice, this list of conditions and the following disclaimer in the
431###    documentation and/or other materials provided with the distribution.
432### 3. Neither the name of the team nor the names of its contributors
433###    may be used to endorse or promote products derived from this software
434###    without specific prior written permission.
435###
436### THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
437### ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
438### IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
439### PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE
440### LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
441### CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
442### SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
443### BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
444### WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
445### OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
446### IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
447