1# Utilities to twinkle default mail message 2 3;# $Id$ 4;# 5;# Copyright (c) 1990-2006, Raphael Manfredi 6;# 7;# You may redistribute only under the terms of the Artistic License, 8;# as specified in the README file that comes with the distribution. 9;# You may reuse parts of this distribution only within the terms of 10;# that same Artistic License; a copy of which may be found at the root 11;# of the source tree for mailagent 3.0. 12;# 13;# $Log: mail.pl,v $ 14;# Revision 3.0.1.2 1997/09/15 15:19:30 ram 15;# patch57: forgot to unlink mail.lock in cp_mail() 16;# 17;# Revision 3.0.1.1 1994/07/01 15:11:46 ram 18;# patch8: fixed RCS leading comment string 19;# patch8: now defines the cp_mail routine 20;# patch8: the replace_header routine can now supersede header lines 21;# 22;# Revision 3.0 1993/11/29 13:50:25 ram 23;# Baseline for mailagent 3.0 netwide release. 24;# 25 26# Add header line within message 27sub add_header { 28 local($header, $file) = @_; 29 $file = 'mail' unless $file; 30 local($_); 31 open(NEW, ">$file.x"); 32 open(OLD, "$file"); 33 while (<OLD>) { 34 print NEW $header, "\n" if (1../^$/) && /^$/; 35 print NEW; 36 } 37 close NEW; 38 close OLD; 39 rename("$file.x", "$file"); 40} 41 42# Change first matching header with new value. If $supersede is given, then 43# the it is used instead. This enables: 44# &replace_header('To:', 'xxx', 'Cc: me') 45# to replace the whole first To: line by a Cc: header. If this third argument 46# is not supplied, then the first one is used verbatim, which is the case in 47# most calls to this routine. 48sub replace_header { 49 local($header, $file, $supersede) = @_; 50 $supersede = $header unless defined $supersede; 51 $file = 'mail' unless $file; 52 local($field) = $header =~ /^(\S+):/; 53 local($_); 54 open(NEW, ">$file.x"); 55 open(OLD, "$file"); 56 while (<OLD>) { 57 if ((1../^$/) && eval "/^$field:/") { 58 print NEW $supersede, "\n"; 59 next; 60 } 61 print NEW; 62 } 63 close NEW; 64 close OLD; 65 rename("$file.x", "$file"); 66} 67 68# Add line at the end of the mail message 69sub add_body { 70 local($line, $file) = @_; 71 $file = 'mail' unless $file; 72 open(NEW, ">>$file"); 73 print NEW $line, "\n"; 74 close NEW; 75} 76 77# Copy mail in out/ 78sub cp_mail { 79 my ($file) = @_; 80 $file = "../mail" unless defined $file; 81 local($_); 82 open(MAIL, $file) || die "Can't open $file: $!"; 83 open(HERE, '>mail'); 84 print HERE while <MAIL>; 85 close MAIL; 86 close HERE; 87 unlink 'mail.lock'; 88} 89 90