+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);
+ $headers{'From'} = $from if ($from);
+ if ($have_attachment) {
+ $headers{'MIME-Version'} = '1.0';
+ $headers{'Content-Type'} = qq{multipart/mixed; boundary=\"$mime_boundary\"};
+ }
+ return \%headers;
+}
+
+sub _add_body_start {
+ my $body_start = <<"BODY_START";
+This is a multi-part message in MIME format.
+--$mime_boundary
+Content-Type: text/plain; format=fixed
+Content-Transfer-Encoding: 8bit
+
+BODY_START
+ return $body_start;
+}
+
+sub _add_attachments {
+ my $attach = '';
+ for my $attachment (split /\s*,\s*/, $attachments) {
+ my $attach_file = basename($attachment);
+ $attach .= <<"ATTACHMENT";
+
+--$mime_boundary
+Content-Type: text/x-patch; name="$attach_file"
+Content-Transfer-Encoding: 8bit
+Content-Disposition: attachment; filename="$attach_file"
+
+ATTACHMENT
+
+ open my $attach_fh, '<:raw', $attachment
+ or die "Couldn't open attachment '$attachment': $!\n";
+ while (<$attach_fh>) { $attach .= $_; }
+ close($attach_fh) or die "Error closing attachment '$attachment': $!";
+ }
+
+ $attach .= "\n--$mime_boundary--\n";
+ return $attach;
+}
+
+sub build_complete_message {
+ my $content = _build_header(%{_message_headers()}) . "\n\n";
+ $content .= _add_body_start() if $have_attachment;
+ open( REP, "<:raw", $filename ) or die "Couldn't open file '$filename': $!\n";
+ binmode(REP, ':raw :crlf') if $Is_MSWin32;
+ while (<REP>) { $content .= $_; }
+ close(REP) or die "Error closing report file '$filename': $!";
+ $content .= _add_attachments() if $have_attachment;
+ return $content;
+}
+
+sub save_message_to_disk {
+ my $file = shift;
+
+ open OUTFILE, '>:raw', $file or do { warn "Couldn't open '$file': $!\n"; return undef};
+ binmode(OUTFILE, ':raw :crlf') if $Is_MSWin32;
+
+ 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 {
+
+ my $mail_from = $from;
+ my $rcpt_to_to = $address;
+ my $rcpt_to_cc = $cc;
+
+ map { $_ =~ s/^[^<]*<//;
+ $_ =~ s/>[^>]*//; } ($mail_from, $rcpt_to_to, $rcpt_to_cc);
+
+ if ( open my $sff_fh, '|-:raw', 'MCR TCPIP$SYSTEM:TCPIP$SMTP_SFF.EXE SYS$INPUT:' ) {
+ print $sff_fh "MAIL FROM:<$mail_from>\n";
+ print $sff_fh "RCPT TO:<$rcpt_to_to>\n";
+ print $sff_fh "RCPT TO:<$rcpt_to_cc>\n" if $rcpt_to_cc;
+ print $sff_fh "DATA\n";
+ print $sff_fh build_complete_message();
+ my $success = close $sff_fh;
+ if ($success ) {
+ print "\nMessage sent\n";
+ return;
+ }
+ }
+ die "Mail transport failed (leaving bug report in $filename): $^E\n";
+}
+
+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;
+ binmode($fh, ':raw');
+ print $fh _add_body_start() if $have_attachment;
+ open(REP, "<:raw", $filename) or die "Couldn't open '$filename': $!\n";
+ binmode(REP, ':raw :crlf') if $Is_MSWin32;
+ while (<REP>) { print $fh $_ }
+ close(REP) or die "Error closing $filename: $!";
+ print $fh _add_attachments() if $have_attachment;
+ $fh->close or die "Error sending mail: $!";
+
+ 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) {
+ my $message_start = !$Is_Linux && !$Is_OpenBSD ? <<'EOT' : <<'EOT';
+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.
+EOT
+It appears that there is no program which looks like "sendmail" on
+your system.
+EOT
+ paraprint(<<"EOF"), die "\n";
+$message_start
+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, "|-:raw", $sendmail, "-t", "-oi", "-f", $from )
+ || die "'|$sendmail -t -oi -f $from' 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, '<:raw', $filename) or die "Unable to open report file '$filename': $!\n";
+ binmode(REP, ':raw :crlf') if $Is_MSWin32;
+ 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;
+}
+
+
+