1# -*-Perl-*- 2################################################################ 3### 4### File.pm 5### 6### Author: Internet Message Group <img@mew.org> 7### Created: Jul 7, 1997 8### Revised: Apr 23, 2007 9### 10 11my $PM_VERSION = "IM::File.pm version 20161010(IM153)"; 12 13package IM::File; 14require 5.003; 15require Exporter; 16 17use IM::Config qw(expand_path mail_path news_path msgdbfile); 18use IM::Util; 19use File::Copy; 20use integer; 21use strict; 22use vars qw(@ISA @EXPORT); 23 24@ISA = qw(Exporter); 25@EXPORT = qw(im_rename im_link im_unlink); 26 27use vars qw($CHECKED $USE_DB); 28 29sub im_rename($$) { 30 my($p1, $p2) = @_; 31 my($m1, $m2); 32 my($ret); 33 ($p1, $m1) = expand_path_and_msg($p1); 34 ($p2, $m2) = expand_path_and_msg($p2); 35 36 #my($id) = get_msg_info($p1) if (!defined $id && !$main::opt_noharm); 37 #XXX??? 38 my($id); 39 if (defined($main::id) || $main::opt_noharm) { 40 $id = $main::id; 41 } else { 42 $id = get_msg_info($p1); 43 } 44 45 if ($main::opt_noharm) { 46 print "mv $p1 $p2\n"; 47 $ret = 1; 48 } else { 49 if (!($ret = rename($p1, $p2))) { 50 $ret = copy($p1, $p2) && unlink($p1); 51 } 52 history_rename($id, $m1, $m2) 53 if (USE_DB() && $ret && $id); 54 } 55 return $ret; 56} 57 58sub im_link($$) { 59 my($p1, $p2) = @_; 60 my($m1, $m2); 61 my($ret); 62 ($p1, $m1) = expand_path_and_msg($p1); 63 ($p2, $m2) = expand_path_and_msg($p2); 64 65 #my($id) = get_msg_info($p1) if (!defined $id && !$main::opt_noharm); 66 my($id); 67 if (defined($main::id) || $main::opt_noharm) { 68 $id = $main::id; 69 } else { 70 $id = get_msg_info($p1); 71 } 72 73 if ($main::opt_noharm) { 74 print "ln $p1 $p2\n"; 75 $ret = 1; 76 } else { 77 if (win95p() || os2p() || wntp() || !($ret = link($p1, $p2))) { 78 $ret = copy($p1, $p2); 79 } 80 history_link($id, $m1, $m2) 81 if (USE_DB() && $ret && $id); 82 } 83 return $ret; 84} 85 86sub im_unlink($) { 87 my($p1) = @_; 88 my($m1, $ret); 89 90 ($p1, $m1) = expand_path_and_msg($p1); 91 92 # my($id) = get_msg_info($p1) if (!defined $id && !$main::opt_noharm); 93 my($id); 94 if (defined($main::id) || $main::opt_noharm) { 95 $id = $main::id; 96 } else { 97 $id = get_msg_info($p1); 98 } 99 100 if ($main::opt_noharm || $main::opt_verbose) { 101 print "unlink $p1\n"; 102 $ret = 1; 103 } 104 if (!$main::opt_noharm) { 105 $ret = unlink($p1); 106 history_delete($id, $m1) 107 if (USE_DB() && $ret && $id); 108 } 109 return $ret; 110} 111 112################################################################# 113## 114## Private. 115## 116sub get_msg_info($) { 117 my($p, $m) = expand_path_and_msg(shift); 118 my($id, $date, $hdr); 119 local $/ = ''; 120 121 if (im_open(\*MSG, "<$p")) { 122 $hdr = <MSG>; close(MSG); 123 } else { 124 im_warn("no message id in $m.\n"); 125 return undef; 126 } 127 ($id) = ($hdr =~ /^message-id:\s*(<[^>\n]*>)/mi); 128 im_warn("no message-id in $m.\n") if (!$id); 129 130# ($date) = ($hdr =~ /^date:\s*([^\n]*)/mi); 131# im_warn("no date field $m.\n") if (!$date); 132 133# return ($id, $date|| gmtime((stat($p))[9]) . " +0000"); 134 return ($id); 135} 136 137sub unexpand_path($) { 138 my $path = shift; 139 my($mail_path, $news_path) = (mail_path(), news_path()); 140 141 $path =~ s!^$mail_path/*!\+!; 142 $path =~ s!^$news_path/*!\=!; 143 144 return $path; 145} 146 147sub expand_path_and_msg($) { 148 my $path_or_msg = shift; 149 return (expand_path($path_or_msg), unexpand_path($path_or_msg)); 150} 151 152sub USE_DB() { 153 if (!$CHECKED) { 154 $CHECKED = 1; 155 if ($USE_DB = msgdbfile()) { 156 require IM::History; 157 import IM::History qw(history_open history_delete 158 history_rename history_link); 159 history_open(1); 160 } 161 } 162 return $USE_DB; 163} 164 1651; 166 167__END__ 168 169=head1 NAME 170 171IM::File - mail/news file handler 172 173=head1 SYNOPSIS 174 175 use IM::File; 176 177 im_rename(path1, path2); 178 im_link(path1, path2); 179 im_unlink(path1); 180 181Paths may be full-path or [+=]folder../../message. 182 183=head1 DESCRIPTION 184 185The I<IM::File> module handles mail/news message files. 186 187This modules is provided by IM (Internet Message). 188 189=head1 COPYRIGHT 190 191IM (Internet Message) is copyrighted by IM developing team. 192You can redistribute it and/or modify it under the modified BSD 193license. See the copyright file for more details. 194 195=cut 196 197### Copyright (C) 1997, 1998, 1999 IM developing team 198### All rights reserved. 199### 200### Redistribution and use in source and binary forms, with or without 201### modification, are permitted provided that the following conditions 202### are met: 203### 204### 1. Redistributions of source code must retain the above copyright 205### notice, this list of conditions and the following disclaimer. 206### 2. Redistributions in binary form must reproduce the above copyright 207### notice, this list of conditions and the following disclaimer in the 208### documentation and/or other materials provided with the distribution. 209### 3. Neither the name of the team nor the names of its contributors 210### may be used to endorse or promote products derived from this software 211### without specific prior written permission. 212### 213### THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND 214### ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 215### IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 216### PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE 217### LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 218### CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 219### SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR 220### BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 221### WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE 222### OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN 223### IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 224