# -*-Perl-*-
################################################################
###
### File.pm
###
### Author: Internet Message Group
### Created: Jul 7, 1997
### Revised: Jul 4, 2004
###
my $PM_VERSION = "IM::File.pm version 20031028(IM146)";
package IM::File;
require 5.003;
require Exporter;
use IM::Config qw(expand_path mail_path news_path msgdbfile);
use IM::Util;
use File::Copy;
use integer;
use strict;
use vars qw(@ISA @EXPORT);
@ISA = qw(Exporter);
@EXPORT = qw(im_rename im_link im_unlink);
use vars qw($CHECKED $USE_DB);
sub im_rename($$) {
my($p1, $p2) = @_;
my($m1, $m2);
my($ret);
($p1, $m1) = expand_path_and_msg($p1);
($p2, $m2) = expand_path_and_msg($p2);
#my($id) = get_msg_info($p1) if (!defined $id && !$main::opt_noharm);
#XXX???
my($id);
if (defined($main::id) || $main::opt_noharm) {
$id = $main::id;
} else {
$id = get_msg_info($p1);
}
if ($main::opt_noharm) {
print "mv $p1 $p2\n";
$ret = 1;
} else {
if (!($ret = rename($p1, $p2))) {
$ret = copy($p1, $p2) && unlink($p1);
}
history_rename($id, $m1, $m2)
if (USE_DB() && $ret && $id);
}
return $ret;
}
sub im_link($$) {
my($p1, $p2) = @_;
my($m1, $m2);
my($ret);
($p1, $m1) = expand_path_and_msg($p1);
($p2, $m2) = expand_path_and_msg($p2);
#my($id) = get_msg_info($p1) if (!defined $id && !$main::opt_noharm);
my($id);
if (defined($main::id) || $main::opt_noharm) {
$id = $main::id;
} else {
$id = get_msg_info($p1);
}
if ($main::opt_noharm) {
print "ln $p1 $p2\n";
$ret = 1;
} else {
if (win95p() || os2p() || wntp() || !($ret = link($p1, $p2))) {
$ret = copy($p1, $p2);
}
history_link($id, $m1, $m2)
if (USE_DB() && $ret && $id);
}
return $ret;
}
sub im_unlink($) {
my($p1) = @_;
my($m1, $ret);
($p1, $m1) = expand_path_and_msg($p1);
# my($id) = get_msg_info($p1) if (!defined $id && !$main::opt_noharm);
my($id);
if (defined($main::id) || $main::opt_noharm) {
$id = $main::id;
} else {
$id = get_msg_info($p1);
}
if ($main::opt_noharm || $main::opt_verbose) {
print "unlink $p1\n";
$ret = 1;
}
if (!$main::opt_noharm) {
$ret = unlink($p1);
history_delete($id, $m1)
if (USE_DB() && $ret && $id);
}
return $ret;
}
#################################################################
##
## Private.
##
sub get_msg_info($) {
my($p, $m) = expand_path_and_msg(shift);
my($id, $date, $hdr);
local $/ = '';
if (im_open(\*MSG, "<$p")) {
$hdr = ; close(MSG);
} else {
im_warn("no message id in $m.\n");
return undef;
}
($id) = ($hdr =~ /^message-id:\s*(<[^>\n]*>)/mi);
im_warn("no message-id in $m.\n") if (!$id);
# ($date) = ($hdr =~ /^date:\s*([^\n]*)/mi);
# im_warn("no date field $m.\n") if (!$date);
# return ($id, $date|| gmtime((stat($p))[9]) . " +0000");
return ($id);
}
sub unexpand_path($) {
my $path = shift;
my($mail_path, $news_path) = (mail_path(), news_path());
$path =~ s!^$mail_path/*!\+!;
$path =~ s!^$news_path/*!\=!;
return $path;
}
sub expand_path_and_msg($) {
my $path_or_msg = shift;
return (expand_path($path_or_msg), unexpand_path($path_or_msg));
}
sub USE_DB() {
if (!$CHECKED) {
$CHECKED = 1;
if ($USE_DB = msgdbfile()) {
require IM::History;
import IM::History qw(history_open history_delete
history_rename history_link);
history_open(1);
}
}
return $USE_DB;
}
1;
__END__
=head1 NAME
IM::File - mail/news file handler
=head1 SYNOPSIS
use IM::File;
im_rename(path1, path2);
im_link(path1, path2);
im_unlink(path1);
Paths may be full-path or [+=]folder../../message.
=head1 DESCRIPTION
The I module handles mail/news message files.
This modules is provided by IM (Internet Message).
=head1 COPYRIGHT
IM (Internet Message) is copyrighted by IM developing team.
You can redistribute it and/or modify it under the modified BSD
license. See the copyright file for more details.
=cut
### Copyright (C) 1997, 1998, 1999 IM developing team
### All rights reserved.
###
### Redistribution and use in source and binary forms, with or without
### modification, are permitted provided that the following conditions
### are met:
###
### 1. Redistributions of source code must retain the above copyright
### notice, this list of conditions and the following disclaimer.
### 2. Redistributions in binary form must reproduce the above copyright
### notice, this list of conditions and the following disclaimer in the
### documentation and/or other materials provided with the distribution.
### 3. Neither the name of the team nor the names of its contributors
### may be used to endorse or promote products derived from this software
### without specific prior written permission.
###
### THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
### ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
### IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
### PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE
### LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
### CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
### SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
### BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
### WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
### OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
### IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.