+sub _prompt {
+ my ($explanation, $prompt, $default) = (@_);
+ if ($explanation) {
+ print "\n\n";
+ paraprint $explanation;
+ }
+ print $prompt. ($default ? " [$default]" :''). ": ";
+ my $result = scalar(<>);
+ chomp($result);
+ $result =~ s/^\s*(.*?)\s*$/$1/s;
+ if ($default && $result eq '') {
+ return $default;
+ } else {
+ return $result;
+ }
+}
+
+sub _build_header {
+ my %attr = (@_);
+
+ my $head = '';
+ for my $header (keys %attr) {
+ $head .= "$header: ".$attr{$header}."\n";
+ }
+ return $head;
+}
+
+sub _message_headers {
+ my %headers = ( To => $address, Subject => $subject );
+ $headers{'Cc'} = $cc if ($cc);
+ $headers{'Message-Id'} = $messageid if ($messageid);
+ $headers{'Reply-To'} = $from if ($from);
+ return \%headers;
+}
+
+sub build_complete_message {
+ my $content = _build_header(%{_message_headers()}) . "\n\n";
+ open( REP, "<$filename" ) or die "Couldn't open file '$filename': $!\n";
+ while (<REP>) { $content .= $_; }
+ close(REP) or die "Error closing report file '$filename': $!";
+ return $content;
+}
+
+sub save_message_to_disk {
+ my $file = shift;
+
+ open OUTFILE, ">$file" or do { warn "Couldn't open '$file': $!\n"; return undef};
+ print OUTFILE build_complete_message();
+ close(OUTFILE) or do { warn "Error closing $file: $!"; return undef };
+ print "\nMessage saved.\n";
+ return 1;
+}
+
+sub _send_message_vms {
+ if ( ( $address =~ /@/ and $address !~ /^\w+%"/ )
+ or ( $cc =~ /@/ and $cc !~ /^\w+%"/ ) ) {
+ my $prefix;
+ foreach ( qw[ IN MX SMTP UCX PONY WINS ], '' ) {
+ $prefix = "$_%", last if $ENV{"MAIL\$PROTOCOL_$_"};
+ }
+ $address = qq[${prefix}"$address"] unless $address =~ /^\w+%"/;
+ $cc = qq[${prefix}"$cc"] unless !$cc || $cc =~ /^\w+%"/;
+ }
+ $subject =~ s/"/""/g;
+ $address =~ s/"/""/g;
+ $cc =~ s/"/""/g;
+ my $sts = system(qq[mail/Subject="$subject" $filename. "$address","$cc"]);
+ if ($sts) {
+ die "Can't spawn off mail (leaving bug report in $filename): $sts";
+ }
+}
+
+sub _send_message_mailsend {
+ my $msg = Mail::Send->new();
+ my %headers = %{_message_headers()};
+ for my $key ( keys %headers) {
+ $msg->add($key => $headers{$key});
+ }
+
+ $fh = $msg->open;
+ open(REP, "<$filename") or die "Couldn't open '$filename': $!\n";
+ while (<REP>) { print $fh $_ }
+ close(REP) or die "Error closing $filename: $!";
+ $fh->close;
+
+ print "\nMessage sent.\n";
+}
+
+sub _probe_for_sendmail {
+ my $sendmail = "";
+ for (qw(/usr/lib/sendmail /usr/sbin/sendmail /usr/ucblib/sendmail)) {
+ $sendmail = $_, last if -e $_;
+ }
+ if ( $^O eq 'os2' and $sendmail eq "" ) {
+ my $path = $ENV{PATH};
+ $path =~ s:\\:/:;
+ my @path = split /$Config{'path_sep'}/, $path;
+ for (@path) {
+ $sendmail = "$_/sendmail", last if -e "$_/sendmail";
+ $sendmail = "$_/sendmail.exe", last if -e "$_/sendmail.exe";
+ }
+ }
+ return $sendmail;
+}
+
+sub _send_message_sendmail {
+ my $sendmail = _probe_for_sendmail();
+ unless ($sendmail) {
+ paraprint(<<"EOF"), die "\n";
+It appears that there is no program which looks like "sendmail" on
+your system and that the Mail::Send library from CPAN isn't available.
+Because of this, there's no easy way to automatically send your
+message.
+
+A copy of your message has been saved in '$filename' for you to
+send to '$address' with your normal mail client.
+EOF
+ }
+
+ open( SENDMAIL, "|$sendmail -t -oi" )
+ || die "'|$sendmail -t -oi' failed: $!";
+ print SENDMAIL build_complete_message();
+ if ( close(SENDMAIL) ) {
+ print "\nMessage sent\n";
+ } else {
+ warn "\nSendmail returned status '", $? >> 8, "'\n";
+ }
+}
+
+
+
+# a strange way to check whether any significant editing
+# has been done: check whether any new non-empty lines
+# have been added.
+
+sub _fingerprint_lines_in_report {
+ my $new_lines = 0;
+ # read in the report template once so that
+ # we can track whether the user does any editing.
+ # yes, *all* whitespace is ignored.
+
+ open(REP, "<$filename") or die "Unable to open report file '$filename': $!\n";
+ while (my $line = <REP>) {
+ $line =~ s/\s+//g;
+ $new_lines++ if (!$REP{$line});
+
+ }
+ close(REP) or die "Error closing report file '$filename': $!";
+ # returns the number of lines with content that wasn't there when last we looked
+ return $new_lines;
+}
+
+
+