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