##---------------------------------------------------------------------------##
## $Id: mhamain.pl,v 2.50.2.1 2002/12/22 00:43:56 ehood Exp $
## Earl Hood mhonarc@mhonarc.org
## Main library for MHonArc.
##---------------------------------------------------------------------------##
## MHonArc -- Internet mail-to-HTML converter
## Copyright (C) 1995-2002 Earl Hood, mhonarc@mhonarc.org
## This program is free software; you can redistribute it and/or modify
## it under the terms of the GNU General Public License as published by
## the Free Software Foundation; either version 2 of the License, or
## (at your option) any later version.
## This program is distributed in the hope that it will be useful,
## but WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
## GNU General Public License for more details.
## You should have received a copy of the GNU General Public License
## along with this program; if not, write to the Free Software
## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
##---------------------------------------------------------------------------##
MHonArc v$VERSION (Perl $] $^O)
Copyright (C) 1995-2002 Earl Hood, mhonarc\@mhonarc.org
MHonArc comes with ABSOLUTELY NO WARRANTY and MHonArc may be copied only
under the terms of the GNU General Public License, which may be found in
the MHonArc distribution.
ABRT ALRM BUS FPE HUP ILL INT IOT PIPE POLL PROF QUIT SEGV
TERM TRAP USR1 USR2 VTALRM XCPU XFSZ
###############################################################################
###############################################################################
##---------------------------------------------------------------------------
## initialize() does some initialization stuff. Should be called
## right after mhamain.pl is called.
## Turn off buffered I/O to terminal
my($curfh) = select(STDOUT
); $| = 1; select($curfh);
## Check what system we are executing under
require 'osinit.pl'; &OSinit
();
## Require essential libraries
$ISLOCK = 0; # Database lock flag
$StartTime = 0; # CPU start time of processing
$EndTime = 0; # CPU end time of processing
##---------------------------------------------------------------------------
## open_archive opens the archive
eval { $StartTime = (times)[0]; };
## Set @ARGV if options passed in
if (@_) { @OrgARGV = @ARGV; @ARGV = @_; }
$optstatus = get_resources
();
if ($@
|| $optstatus <= 0) {
if ($@
=~ /signal caught/) {
$CODE = int($!) ?
int($!) : 255;
$ERROR = "ERROR: Problem loading resources\n";
##---------------------------------------------------------------------------
## close_archive closes the archive.
&$UnlockFunc() if defined(&$UnlockFunc);
reset_handler
() if $reset_sigs;
eval { $EndTime = (times)[0]; };
my $cputime = $EndTime - $StartTime;
## Output time (if specified)
printf(STDERR
"\nTime: %.2f CPU seconds\n", $cputime);
if (@OrgARGV) { @ARGV = @OrgARGV; }
##---------------------------------------------------------------------------
## Routine to process input. If no errors, routine returns the
## CPU time taken. If an error, returns undef.
# archive already open, so doit
# open archive first (implictely pass @_ to open_archive)
if ($@
=~ /signal caught/) {
$CODE = (int($!) ?
int($!) : 255) unless $CODE;
###############################################################################
###############################################################################
##---------------------------------------------------------------------------
## Routine that does the work
## Check for non-archive modification modes.
## Just converting a single message to HTML
## Text message listing of archive to standard output.
print STDOUT
"Annotating messages in $OUTDIR ...\n" unless $QUIET;
if (!defined($NoteText)) {
print STDOUT
"Please enter note text (terminated with EOF char):\n"
$NoteText = join("", <$MhaStdin>);
return annotate
(@ARGV, $NoteText);
print STDOUT
"Removing messages from $OUTDIR ...\n"
## HTML message listing to standard output.
if ($IdxPageNum && $MULTIIDX) {
if ($IdxPageNum =~ /first/i) {
if ($IdxPageNum =~ /last/i) {
$IdxPageNum = $NumOfPages;
$IdxPageNum = int($IdxPageNum);
last IDXPAGE
if $IdxPageNum;
write_thread_index
($IdxPageNum);
write_main_index
($IdxPageNum);
## Get here, we are processing mail folders
my($index, $fields, $fh, $i);
print STDOUT
"Editing $OUTDIR layout ...\n" unless $QUIET;
## Adding a single message
print STDOUT
"Adding message to $OUTDIR\n" unless $QUIET;
($index, $fields) = read_mail_header
($handle);
$IndexNum{$index} = &getNewMsgNum
();
$Message{$index} = &read_mail_body
(
## Adding/converting mail{boxes,folders}
print STDOUT
($ADD ?
"Adding" : "Converting"), " messages to $OUTDIR"
my($mbox, $mesgfile, @files);
MAILFOLDER
: foreach $mbox (@ARGV) {
## MH mail folder (a directory)
if (!opendir(MAILDIR
, $mbox)) {
warn "\nWarning: Unable to open $mbox\n";
print STDOUT
"\nReading $mbox " unless $QUIET;
@files = sort { $a <=> $b } grep(/$MHPATTERN/o,
MHFILE
: foreach (@files) {
$mesgfile = "${mbox}${DIRSEP}${_}";
$fh = file_open
($mesgfile);
qq/...Skipping "$mesgfile"\n/;
print STDOUT
"." unless $QUIET;
($index, $fields) = read_mail_header
($fh);
# Process message if valid
if ($ADD && !$SLOW) { $AddIndex{$index} = 1; }
$IndexNum{$index} = &getNewMsgNum
();
$Message{$index} = &read_mail_body
(
# Check if conserving memory
if ($SLOW && $DoArchive) {
output_mail
($index, 1, 1);
if (defined($IndexNum{$index})) {
$Update{$IndexNum{$index}} = 1;
if ($SLOW || !$DoArchive) {
qq/...Skipping "$mbox"\n/;
print STDOUT
"\nReading $mbox " unless $QUIET;
# while (<$fh>) { last if /$FROM/o; }
MBOX
: while (!eof($fh)) {
print STDOUT
"." unless $QUIET;
($index, $fields) = read_mail_header
($fh);
if ($ADD && !$SLOW) { $AddIndex{$index} = 1; }
$IndexNum{$index} = &getNewMsgNum
();
$Message{$index} = read_mail_body
(
if ($SLOW && $DoArchive) {
output_mail
($index, 1, 1);
if (defined($IndexNum{$index})) {
$Update{$IndexNum{$index}} = 1;
if ($SLOW || !$DoArchive) {
read_mail_body
($fh, $index, $fields, 1);
} # END: else UUCP mailbox
} # END: Else converting mailboxes
print "\n" unless $QUIET;
## All done if not creating an archive
## Check if there are any new messages
if (!$EDITIDX && ($i == $NumOfMsgs)) {
print STDOUT
"No new messages\n" unless $QUIET;
$NewMsgCnt = $NumOfMsgs - $i;
##---------------------------------------------------------------------------
## write_pages writes out all archive pages and db
my($i, $j, $key, $index, $tmp, $tmp2);
## Remove old message if hit maximum size or expiration
if (($MAXSIZE && ($NumOfMsgs > $MAXSIZE)) ||
## Set @MListOrder and %Index2MLoc for properly marking messages
## to be updated when a related messages are removed. Thread
## data should be around from db.
@MListOrder = sort_messages
();
@Index2MLoc{@MListOrder} = (0 .. $#MListOrder);
# Ignore termination signals
## Expiration based upon time
foreach $index (sort_messages
(0,0,0,0)) {
($MAXSIZE && ($NumOfMsgs > $MAXSIZE)) ||
(&expired_time
(&get_time_from_index
($index)));
# Mark messages that need to be updated
$mloc = $Index2MLoc{$index}; $tloc = $Index2TLoc{$index};
$Update{$IndexNum{$MListOrder[$mloc-1]}} = 1
$Update{$IndexNum{$MListOrder[$mloc+1]}} = 1
if $mloc+1 <= $#MListOrder;
$Update{$IndexNum{$TListOrder[$tloc-1]}} = 1
$Update{$IndexNum{$TListOrder[$tloc+1]}} = 1
if $tloc+1 <= $#TListOrder;
for ($i=2; $i <= $TSliceNBefore; ++$i) {
$Update{$IndexNum{$TListOrder[$tloc-$i]}} = 1
for ($i=2; $i <= $TSliceNAfter; ++$i) {
$Update{$IndexNum{$TListOrder[$tloc+$i]}} = 1
if $tloc-$i >= $#TListOrder;
foreach (@
{$FollowOld{$index}}) {
$Update{$IndexNum{$_}} = 1;
# Mark where index page updates start
$tmp = int($Index2MLoc{$index}/$IDXSIZE)+1;
if ($tmp < $IdxMinPg || $IdxMinPg < 0);
$tmp = int($Index2TLoc{$index}/$IDXSIZE)+1;
if ($tmp < $TIdxMinPg || $TIdxMinPg < 0);
@MListOrder = sort_messages
();
@Index2MLoc{@MListOrder} = (0 .. $#MListOrder);
## Compute follow up messages
compute_follow_ups
(\
@MListOrder);
## Compute thread information (sets ThreadList, TListOrder, Index2TLoc)
## Check for which messages to update when adding to archive
foreach $index (@MListOrder) { $Update{$IndexNum{$index}} = 1; }
foreach $index (@MListOrder) {
## Check for New follow-up links
if (is_follow_ups_diff
($index)) {
$Update{$IndexNum{$index}} = 1;
## Check if new message; must update links in prev/next msgs
# Mark where main index page updates start
$tmp = int($Index2MLoc{$index}/$IDXSIZE)+1;
if ($tmp < $IdxMinPg || $IdxMinPg < 0);
# Mark previous/next messages
$Update{$IndexNum{$MListOrder[$i-1]}} = 1
$Update{$IndexNum{$MListOrder[$i+1]}} = 1
## Check for New reference links
foreach (@
{$Refs{$index}}) {
if (defined($IndexNum{$tmp}) && $AddIndex{$tmp}) {
$Update{$IndexNum{$index}} = 1;
foreach $index (@TListOrder) {
## Check if new message; must update links in prev/next msgs
# Mark where thread index page updates start
$tmp = int($Index2TLoc{$index}/$IDXSIZE)+1;
if ($tmp < $TIdxMinPg || $TIdxMinPg < 0);
# Mark previous/next message in thread
$Update{$IndexNum{$TListOrder[$i-1]}} = 1
$Update{$IndexNum{$TListOrder[$i+1]}} = 1
$tloc = $Index2TLoc{$index};
for ($j=2; $j <= $TSliceNBefore; ++$j) {
$Update{$IndexNum{$TListOrder[$tloc-$j]}} = 1
for ($j=2; $j <= $TSliceNAfter; ++$j) {
$Update{$IndexNum{$TListOrder[$tloc+$j]}} = 1
if $tloc-$j >= $#TListOrder;
## Compute total number of pages
## Update all pages for $LASTPG$
if ($UsingLASTPG && ($i != $NumOfPages)) {
ign_signals
(); # Ignore termination signals
print STDOUT
"\n" unless $QUIET;
## Write indexes and mail
write_mail
() unless $NoMsgPgs;
write_main_index
() if $MAIN;
write_thread_index
() if $THREAD;
print STDOUT
"Writing database ...\n" unless $QUIET;
## Write any alternate indexes
$IdxMinPg = 0; $TIdxMinPg = 0;
OTHERIDX
: foreach $rc (@OtherIdxs) {
## find other index resource file
# in current working directory
if (defined $MainRcDir) {
# check if located with main resource file
$rcfile = join($DIRSEP, $MainRcDir, $rc);
last IDXFIND
if -e
$rcfile;
if (defined $ENV{'HOME'}) {
# check if in home directory
$rcfile = join($DIRSEP, $ENV{'HOME'}, $rc);
last IDXFIND
if -e
$rcfile;
# check if in archive directory
$rcfile = join($DIRSEP, $OUTDIR, $rc);
last IDXFIND
if -e
$rcfile;
# look thru @INC to find file
$rcfile = join($DIRSEP, $_, $rc);
warn qq/Warning: Unable to find resource file "$rc"\n/;
## read resource file and print index
if (read_fmt_file
($rcfile)) {
print STDOUT
"$NewMsgCnt new messages\n" if $NewMsgCnt > 0;
print STDOUT
"$NumOfMsgs total messages\n";
##---------------------------------------------------------------------------
foreach $index (@
$idxlst) {
$FolCnt{$index} = 0 unless $FolCnt{$index};
if (defined($Refs{$index}) && scalar(@
{$Refs{$index}})) {
$tmp2 = $Refs{$index}->[-1];
next unless defined($MsgId{$tmp2}) &&
defined($IndexNum{$MsgId{$tmp2}});
if ($Follow{$tmp}) { push(@
{$Follow{$tmp}}, $index); }
else { $Follow{$tmp} = [ $index ]; }
##---------------------------------------------------------------------------
## Compute total number of pages
if ($MULTIIDX && $IDXSIZE) {
$NumOfPages = int($NumOfMsgs/$IDXSIZE);
++$NumOfPages if ($NumOfMsgs/$IDXSIZE) > $NumOfPages;
$NumOfPages = 1 if $NumOfPages == 0;
##---------------------------------------------------------------------------
## write_mail outputs converted mail. It takes a reference to an
## array containing indexes of messages to output.
print STDOUT
"Writing mail " unless $QUIET;
foreach $index (@MListOrder) {
print STDOUT
"." unless $QUIET;
output_mail
($index, $AddIndex{$index}, 0);
print STDOUT
"\n" unless $QUIET;
##---------------------------------------------------------------------------
## read_mail_header() is responsible for parsing the header of
## a mail message and loading message information into hash
## ($index, $header_fields_ref) = read_mail_header($filehandle);
my($index, $date, $tmp, $i, $field, $value);
my($from, $sub, $msgid, $ctype);
my($fields, $header) = readmail
::MAILread_file_header
($handle);
##---------------------------##
## Check for no archive flag ##
##---------------------------##
((defined($fields->{'restrict'}) &&
grep { /no-external-archive/i } @
{$fields->{'restrict'}}) ||
(defined($fields->{'x-no-archive'}) &&
grep { /yes/i } @
{$fields->{'x-no-archive'}})) ) {
##----------------------------------##
## Check for user-defined exclusion ##
##----------------------------------##
return undef if mhonarc
::message_exclude
($header);
$msgid = $fields->{'message-id'}[0] || $fields->{'msg-id'}[0] ||
$fields->{'content-id'}[0];
if ($msgid =~ /<([^>]*)>/) {
# create bogus ID if none exists
# create message-id using md5 digest of header;
# can potentially skip over already archived messages w/o id
$msgid = join("", Digest
::MD5
::md5_hex
($header),
'@NO-ID-FOUND.mhonarc.org');
# unable to require, so create arbitary message-id
$msgid = join("", $$,'.',time,'.',$_msgid_cnt++,
'@NO-ID-FOUND.mhonarc.org');
## Return if message already exists in archive
if ($msgid && defined($MsgId{$msgid})) {
($field, $i) = @
{$_}[0,1];
next unless defined($fields->{$field}) &&
defined($value = $fields->{$field}[$i]);
## Treat received field specially
if ($field eq 'received') {
@array = split(/;/, $value);
# if ((scalar(@array) <= 1) || (scalar(@array) > 2)) {
# warn qq/\nWarning: Received header field looks improper:\n/,
# qq/ Received: $value\n/,
# qq/ Message-Id: <$msgid>\n/;
## Any other field should just be a date
$date =~ s/^\s+//; $date =~ s/\s+$//;
## See if time_t can be determined.
if (($date =~ /\w/) && (@array = parse_date
($date))) {
$index = get_time_from_date
(@array[1..$#array]);
warn qq/\nWarning: Could not parse date for message\n/,
qq/ Message-Id: <$msgid>\n/;
# Set date string to local date if not defined
$date = &time2str
("", $index, 1) unless $date =~ /\S/;
## Return if message too old to add (note, $index just contains time).
if (&expired_time
($index)) {
if (defined($fields->{'subject'}) && ($fields->{'subject'}[0] =~ /\S/)) {
($sub = $fields->{'subject'}[0]) =~ s/\s+$//;
$sub = subject_strip
($sub) if $SubStripCode;
next unless defined $fields->{$_};
$from = $fields->{$_}[0];
$from = 'Unknown' unless $from;
if (defined($fields->{'references'})) {
$tmp = $fields->{'references'}[0];
while ($tmp =~ s/<([^<>]+)>//) {
if (defined($fields->{'in-reply-to'})) {
foreach (@
{$fields->{'in-reply-to'}}) {
while ($tmp =~ s/<([^<>]+)>//) { $irtoid = $1 };
push(@refs, $irtoid) if $irtoid;
@refs = remove_dups
(\
@refs); # Remove duplicate msg-ids
if (defined($fields->{'content-type'})) {
($ctype = $fields->{'content-type'}[0]) =~ m
%^\s
*([\w\
-\
./]+)%;
$ctype = lc ($1 || 'text/plain');
## Insure uniqueness of index
$index .= $X . sprintf("%d",$LastMsgNum+1);
## Set mhonarc fields. Note how values are NOT arrays.
$fields->{'x-mha-index'} = $index;
$fields->{'x-mha-message-id'} = $msgid;
$fields->{'x-mha-from'} = $from;
$fields->{'x-mha-subject'} = $sub;
$fields->{'x-mha-content-type'} = $ctype;
## Invoke callback if defined
if (defined($CBMessageHeadRead) && defined(&$CBMessageHeadRead)) {
return undef unless &$CBMessageHeadRead($fields, $header);
$MsgHead{$index} = htmlize_header
($fields);
$ContentType{$index} = $ctype;
$NewMsgId{$msgid} = $index; # Track new message-ids
$Index2MsgId{$index} = $msgid;
$Refs{$index} = [ @refs ] if (@refs);
##---------------------------------------------------------------------------
## read_mail_body() reads in the body of a message. The returned
## filtered body is in $ret.
## $html = read_mail_body($fh, $index, $fields_hash_ref,
my($handle, $index, $fields, $skip) = @_;
my($ret, $data) = ('', '');
if ($CONLEN && defined($fields->{"content-length"})) {
my($len, $cnt) = ($fields->{"content-length"}[0], 0);
$cnt += length($_); # Increment byte count
$data .= $_ unless $skip; # Save data
last if $cnt >= $len # Last if hit length
# Slurp up bogus data if required (should I do this?)
while (!/$FROM/o && !eof($handle)) {
} else { # No content-length
$data .= $_ unless $skip;
## Invoke callback if defined
if (defined($CBRawMessageBodyRead) && defined(&$CBRawMessageBodyRead)) {
&$CBRawMessageBodyRead($fields, \
$data);
## Define "globals" for use by filters
## NOTE: This stuff can be handled better, and will be done
## when/if I get around to rewriting mhonarc in (OO) Perl 5.
$MHAmsgnum = &fmt_msgnum
($IndexNum{$index});
$MHAmsgid = $Index2MsgId{$index};
($ret, @files) = &readmail
::MAILread_body
($fields, \
$data);
$ret = '' unless defined $ret;
@files = ( ) unless @files;
## Invoke callback if defined
if (defined($CBMessageBodyRead) && defined(&$CBMessageBodyRead)) {
&$CBMessageBodyRead($fields, \
$ret, \
@files);
if (!defined($ret) || $ret eq "") {
"<dt><strong>Warning</strong></dt>\n",
"<dd>Unable to process data: \n",
htmlize
($fields->{'content-type'}[0] || 'text/plain'),
$Derived{$index} = [ @files ];
##---------------------------------------------------------------------------
## Output/edit a mail message.
## $index => current index (== $array[$i])
## $force => flag if mail is written and not editted, regardless
## $nocustom => ignore sections with user customization
## This function returns ($msgnum, $filename) if everything went
## okay, but no calls to this routine check the return values.
my($index, $force, $nocustom) = @_;
my($msgi, $tmp, $tmp2, $template, @array2);
my($msghandle, $msginfh, $drvfh);
my $msgnum = $IndexNum{$index};
if (!$SINGLE && !defined($msgnum)) {
# Something bad must have happened to message, so we just
my $adding = ($ADD && !$force && !$SINGLE);
my $i_p0 = fmt_msgnum
($msgnum);
my $filename = msgnum_filename
($msgnum);
my $filepathname = join($DIRSEP, $OUTDIR, $filename);
my $tmppathname = join($DIRSEP, $OUTDIR, "msgtmp.$$");
return ($i_p0, $filename) unless $Update{$msgnum};
#&file_rename($filepathname, $tmppathname);
$msginfh = file_open
($filepathname);
# Something is screwed up with archive: We try to delete
# message from database since message file appears to have
qq/...Will attempt to remove message and continue on\n/;
# Nothing else to do, so return.
$msghandle = file_create
($tmppathname, $GzipFiles);
last if /<!--X-Body-Begin/;
$template = ($MSGPGSSMARKUP ne '') ?
$MSGPGSSMARKUP : $SSMARKUP;
$template =~ s/$VarExp/&replace_li_var($1,$index)/geo;
print $msghandle $template;
# Output comments -- more informative, but can be used for
"<!-- ", commentize
("MHonArc v$VERSION"), " -->\n",
"<!--X-Subject: ", commentize
($Subject{$index}), " -->\n",
"<!--X-From-R13: ", commentize
(mrot13
($From{$index})), " -->\n",
"<!--X-Date: ", commentize
($Date{$index}), " -->\n",
"<!--X-Message-Id: ", commentize
($Index2MsgId{$index}), " -->\n",
"<!--X-Content-Type: ", commentize
($ContentType{$index}), " -->\n";
if (defined($Refs{$index})) {
foreach (@
{$Refs{$index}}) {
"<!--X-Reference: ", commentize
($_), " -->\n";
if (defined($Derived{$index})) {
foreach (@
{$Derived{$index}}) {
print $msghandle "<!--X-Derived: ", commentize
($_), " -->\n";
print $msghandle "<!--X-Head-End-->\n";
# Add in user defined markup
($template = $MSGPGBEG) =~ s/$VarExp/&replace_li_var($1,$index)/geo;
print $msghandle $template;
print $msghandle "<!--X-Body-Begin-->\n";
last if /<!--X-User-Header-End/ || /<!--X-TopPNI--/;
print $msghandle "<!--X-User-Header-->\n";
($template = $MSGHEAD) =~ s/$VarExp/&replace_li_var($1,$index)/geo;
print $msghandle $template;
print $msghandle "<!--X-User-Header-End-->\n";
## Output Prev/Next/Index links at top
while (<$msginfh>) { last if /<!--X-TopPNI-End/; }
print $msghandle "<!--X-TopPNI-->\n";
if (!$nocustom && !$SINGLE) {
($template = $TOPLINKS) =~ s/$VarExp/&replace_li_var($1,$index)/geo;
print $msghandle $template;
print $msghandle "\n<!--X-TopPNI-End-->\n";
# check if subject header delimited
if (/<!--X-Subject-Header-Begin/) {
$tmp2 =~ s
%($AddrExp)%&link_refmsgid
($1,1)%geo;
while (<$msginfh>) { last if /<!--X-Subject-Header-End/; }
print $msghandle "<!--X-Subject-Header-Begin-->\n";
($template = $SUBJECTHEADER) =~
s/$VarExp/&replace_li_var($1,$index)/geo;
print $msghandle $template;
print $msghandle "<!--X-Subject-Header-End-->\n";
# check if head/body separator delimited
if (/<!--X-Head-Body-Sep-Begin/) {
$tmp2 =~ s
%($AddrExp)%&link_refmsgid
($1,1)%geo;
while (<$msginfh>) { last if /<!--X-Head-Body-Sep-End/; }
print $msghandle "<!--X-Head-Body-Sep-Begin-->\n";
($template = $HEADBODYSEP) =~
s/$VarExp/&replace_li_var($1,$index)/geo;
print $msghandle $template;
print $msghandle "<!--X-Head-Body-Sep-End-->\n";
last if /<!--X-MsgBody-End/;
$tmp2 =~ s
%($AddrExp)%&link_refmsgid
($1,1)%geo;
print $msghandle "<!--X-MsgBody-->\n";
print $msghandle "<!--X-Subject-Header-Begin-->\n";
($template = $SUBJECTHEADER) =~
s/$VarExp/&replace_li_var($1,$index)/geo;
print $msghandle $template;
print $msghandle "<!--X-Subject-Header-End-->\n";
$MsgHead{$index} =~ s
%($AddrExp)%&link_refmsgid
($1)%geo;
$Message{$index} =~ s
%($AddrExp)%&link_refmsgid
($1)%geo;
print $msghandle "<!--X-Head-of-Message-->\n";
print $msghandle $MsgHead{$index};
print $msghandle "<!--X-Head-of-Message-End-->\n";
print $msghandle "<!--X-Head-Body-Sep-Begin-->\n";
($template = $HEADBODYSEP) =~
s/$VarExp/&replace_li_var($1,$index)/geo;
print $msghandle $template;
print $msghandle "<!--X-Head-Body-Sep-End-->\n";
print $msghandle "<!--X-Body-of-Message-->\n";
print $msghandle $Message{$index}, "\n";
print $msghandle "<!--X-Body-of-Message-End-->\n";
print $msghandle "<!--X-MsgBody-End-->\n";
## Output any followup messages
while (<$msginfh>) { last if /<!--X-Follow-Ups-End/; }
print $msghandle "<!--X-Follow-Ups-->\n";
($template = $MSGBODYEND) =~ s/$VarExp/&replace_li_var($1,$index)/geo;
print $msghandle $template;
if (!$nocustom && $DoFolRefs && defined($Follow{$index})) {
if (scalar(@
{$Follow{$index}})) {
($template = $FOLUPBEGIN) =~
s/$VarExp/&replace_li_var($1,$index)/geo;
print $msghandle $template;
foreach (@
{$Follow{$index}}) {
($template = $FOLUPLITXT) =~
s/$VarExp/&replace_li_var($1,$_)/geo;
print $msghandle $template;
($template = $FOLUPEND) =~
s/$VarExp/&replace_li_var($1,$index)/geo;
print $msghandle $template;
print $msghandle "<!--X-Follow-Ups-End-->\n";
while (<$msginfh>) { last if /<!--X-References-End/; }
print $msghandle "<!--X-References-->\n";
if (!$nocustom && $DoFolRefs && defined($Refs{$index})) {
$tmp2 = 0; # flag for when first ref printed
if (scalar(@
{$Refs{$index}})) {
foreach (@
{$Refs{$index}}) {
next unless defined($MsgId{$_});
next unless defined($IndexNum{$MsgId{$_}});
($template = $REFSBEGIN) =~
s/$VarExp/&replace_li_var($1,$index)/geo;
print $msghandle $template;
($template = $REFSLITXT) =~
s/$VarExp/&replace_li_var($1,$MsgId{$_})/geo;
print $msghandle $template;
($template = $REFSEND) =~
s/$VarExp/&replace_li_var($1,$index)/geo;
print $msghandle $template;
print $msghandle "<!--X-References-End-->\n";
## Output verbose links to prev/next message in list
while (<$msginfh>) { last if /<!--X-BotPNI-End/; }
print $msghandle "<!--X-BotPNI-->\n";
if (!$nocustom && !$SINGLE) {
($template = $BOTLINKS) =~ s/$VarExp/&replace_li_var($1,$index)/geo;
print $msghandle $template;
print $msghandle "\n<!--X-BotPNI-End-->\n";
last if /<!--X-User-Footer-End/;
print $msghandle "<!--X-User-Footer-->\n";
($template = $MSGFOOT) =~ s/$VarExp/&replace_li_var($1,$index)/geo;
print $msghandle $template;
print $msghandle "<!--X-User-Footer-End-->\n";
($template = $MSGPGEND) =~ s/$VarExp/&replace_li_var($1,$index)/geo;
print $msghandle $template;
close($msghandle) if (!$SINGLE);
#&file_remove($tmppathname);
file_rename
($tmppathname, $filepathname) unless $SINGLE;
## Create user defined files
foreach (keys %UDerivedFile) {
($tmp = $_) =~ s/$VarExp/&replace_li_var($1,$index)/geo;
$tmp2 = join($DIRSEP, $OUTDIR, $tmp);
if ($drvfh = file_create
($tmp2, $GzipFiles)) {
($template = $UDerivedFile{$_}) =~
s/$VarExp/&replace_li_var($1,$index)/geo;
if (defined($Derived{$index})) {
push(@
{$Derived{$index}}, $tmp);
$Derived{$index} = [ $tmp ];
warn "Warning: Unable to create $tmp2\n";
if (defined($Derived{$index})) {
$Derived{$index} = [ remove_dups
($Derived{$index}) ];
## Set modification times -- Use eval incase OS does not support utime.
if ($MODTIME && !$SINGLE) {
$tmp = get_time_from_index
($index);
if (defined($Derived{$index})) {
@array2 = @
{$Derived{$index}};
grep($_ = $OUTDIR . $DIRSEP . $_, @array2);
unshift(@array2, $filepathname);
file_utime
($tmp, $tmp, @array2);
warn qq/\nWarning: Your platform does not support setting file/,
qq/ modification times\n/;
#############################################################################
## Miscellaneous routines
#############################################################################
##---------------------------------------------------------------------------
## delmsg delets a message from the archive.
my $msgnum = $IndexNum{$key}; return 0 if ($msgnum eq '');
my $filename = join($DIRSEP, $OUTDIR, &msgnum_filename
($msgnum));
delete $ContentType{$key};
delete $MsgId{$Index2MsgId{$key}};
file_remove
($filename) unless $KeepOnRmm;
foreach $filename (@
{$Derived{$key}}) {
$pathname = (OSis_absolute_path
($filename)) ?
$filename : join($DIRSEP, $OUTDIR, $filename);
dir_remove
($pathname) unless $KeepOnRmm;
file_remove
($pathname) unless $KeepOnRmm;
##---------------------------------------------------------------------------
## Routine to convert a msgid to an anchor
my($refmsgid, $onlynew) = @_;
if (defined($MsgId{$refmsgid}) &&
defined($IndexNum{$MsgId{$refmsgid}}) &&
(!$onlynew || $NewMsgId{$refmsgid})) {
my($lreftmpl) = $MSGIDLINK;
$lreftmpl =~ s/$VarExp/&replace_li_var($1,$MsgId{$refmsgid})/geo;
##---------------------------------------------------------------------------
## Retrieve next available message number. Should only be used
## when an archive is locked.
$NumOfMsgs++; $LastMsgNum++;
##---------------------------------------------------------------------------
## ign_signals() sets mhonarc to ignore termination signals. This
## routine is called right before an archive is written/edited to
## help prevent archive corruption.
@SIG{@_term_sigs} = ('IGNORE') x
scalar(@_term_sigs);
##---------------------------------------------------------------------------
## set_handler() sets up the signal_catch() routine to be called when
## termination signals are sent to mhonarc.
@_sig_org{@_term_sigs} = @SIG{@_term_sigs};
@SIG{@_term_sigs} = (\
&mhonarc
::signal_catch
) x
scalar(@_term_sigs);
##---------------------------------------------------------------------------
## reset_handler() resets the original signal handlers.
@SIG{@_term_sigs} = @_sig_org{@_term_sigs};
##---------------------------------------------------------------------------
## signal_catch(): Function for handling signals that would cause
&{$_sig_org{$signame}}($signame) if defined(&{$_sig_org{$signame}});
die qq/Processing stopped, signal caught: SIG$signame\n/;
##---------------------------------------------------------------------------
## Create Index2MsgId if not defined
if (!defined(%Index2MsgId)) {
$Index2MsgId{$MsgId{$_}} = $_;
##---------------------------------------------------------------------------