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