[p5sagit/p5-mst-13.2.git] / utils / perlbug.PL

#!/usr/local/bin/perl

use Config;
use File::Basename qw(&basename &dirname);

# List explicitly here the variables you want Configure to
# generate.  Metaconfig only looks for shell variables, so you
# have to mention them as if they were shell variables, not
# %Config entries.  Thus you write
#  $startperl
# to ensure Configure will look for $Config{startperl}.

# This forces PL files to create target in same directory as PL file.
# This is so that make depend always knows where to find PL derivatives.
chdir(dirname($0));
($file = basename($0)) =~ s/\.PL$//;
$file =~ s/\.pl$//
	if ($^O eq 'VMS' or $^O eq 'os2');  # "case-forgiving"

open OUT,">$file" or die "Can't create $file: $!";

print "Extracting $file (with variable substitutions)\n";

# In this section, perl variables will be expanded during extraction.
# You can use $Config{...} to use Configure variables.

print OUT <<"!GROK!THIS!";
$Config{'startperl'}
    eval 'exec perl -S \$0 "\$@"'
	if 0;
!GROK!THIS!

# In the following, perl variables are not expanded during extraction.

print OUT <<'!NO!SUBS!';

use Config;
use Getopt::Std;

BEGIN {
	eval "use Mail::Send;";
	$::HaveSend = ($@ eq "");
	eval "use Mail::Util;";
	$::HaveUtil = ($@ eq "");
};


use strict;

sub paraprint;


my($Version) = "1.13";

# Changed in 1.06 to skip Mail::Send and Mail::Util if not available.
# Changed in 1.07 to see more sendmail execs, and added pipe output.
# Changed in 1.08 to use correct address for sendmail.
# Changed in 1.09 to close the REP file before calling it up in the editor.
#                 Also removed some old comments duplicated elsewhere.
# Changed in 1.10 to run under VMS without Mail::Send; also fixed
#                 temp filename generation.
# Changed in 1.11 to clean up some text and removed Mail::Send deactivator.
# Changed in 1.12 to check for editor errors, make save/send distinction
#                 clearer and add $ENV{REPLYTO}.
# Changed in 1.13 to hopefully make it more difficult to accidentally
#                 send mail

# TODO: Allow the user to re-name the file on mail failure, and
#       make sure failure (transmission-wise) of Mail::Send is 
#       accounted for.

my( $file, $cc, $address, $perlbug, $testaddress, $filename,
    $subject, $from, $verbose, $ed, 
    $fh, $me, $Is_VMS, $msg, $body, $andcc );

Init();

if($::opt_h) { Help(); exit; }

if(!-t STDIN) {
	paraprint <<EOF;
Please use perlbug interactively. If you want to 
include a file, you can use the -f switch.
EOF
	die "\n";
}

if($::opt_d or !-t STDOUT) { Dump(*STDOUT); exit; }

Query();
Edit();
NowWhat();
Send();

exit;

sub Init {
 
	# -------- Setup --------

	$Is_VMS = $^O eq 'VMS';

	getopts("dhva:s:b:f:r:e:SCc:t");
	

	# This comment is needed to notify metaconfig that we are
	# using the $perladmin, $cf_by, and $cf_time definitions.


	# -------- Configuration ---------
	
	# perlbug address
	$perlbug = 'perlbug@perl.com';
	
	# Test address
	$testaddress = 'perlbug-test@perl.com';
	
	# Target address
	$address = $::opt_a || ($::opt_t ? $testaddress : $perlbug);

	# Possible administrator addresses, in order of confidence
	# (Note that cf_email is not mentioned to metaconfig, since
	# we don't really want it. We'll just take it if we have to.)
	$cc = ($::opt_C ? "" : (
		$::opt_c || $::Config{perladmin} || $::Config{cf_email} || $::Config{cf_by}
		));
	
	# Users address, used in message and in Reply-To header
	$from = $::opt_r || "";

	# Include verbose configuration information
	$verbose = $::opt_v || 0;

	# Subject of bug-report message
	$subject = $::opt_s || "";

	# File to send as report
	$file = $::opt_f || "";

	# Body of report
	$body = $::opt_b || "";

	# Editor
	$ed = ($::opt_f ? "file" : (
			$::opt_e || $ENV{VISUAL} || $ENV{EDITOR} || $ENV{EDIT} || 
		      ($Is_VMS ? "edit/tpu" : "vi")
	      ));
      
	# My username
	$me = getpwuid($<);

}


sub Query {

	# Explain what perlbug is
	
	paraprint <<EOF;
This program allows you to create a bug report,
which will be sent as an e-mail message to $address
once you have filled in the report.

EOF


	# Prompt for subject of message, if needed
	if(! $subject) {
		paraprint <<EOF;
First of all, please provide a subject for the 
message. It should be as a concise description of 
the bug as is possible.

EOF
		print "Subject: ";
	
		$subject = <>;
		chop $subject;
	
		my($err)=0;
		while( $subject =~ /^\s*$/ ) {
			print "\nPlease enter a subject: ";
			$subject = <>;
			chop $subject;
			if($err++>5) {
				die "Aborting.\n";
			}
		}
	}
	

	# Prompt for return address, if needed
	if( !$from) {

		# Try and guess return address
		my($domain);
		
		if($::HaveUtil) {
			$domain = Mail::Util::maildomain();
		} elsif ($Is_VMS) {
			require Sys::Hostname;
			$domain = Sys::Hostname::hostname();
		} else {
			$domain = `hostname`.".".`domainname`;
			$domain =~ s/[\r\n]+//g;
		}
	    
	    my($guess);
	                     
	        if( !$domain) {
	        	$guess = "";
	        } elsif ($Is_VMS && !$::Config{'d_has_sockets'}) { 
	        	$guess = "$domain\:\:$me";
	        } else {
		    	$guess = "$me\@$domain" if $domain;
		    	$guess = "$me\@unknown.addresss" unless $domain;
			}
			
		$guess = $ENV{'REPLYTO'} if defined($ENV{'REPLYTO'});
		$guess = $ENV{"REPLY-TO"} if defined($ENV{'REPLY-TO'});
	
		if( $guess ) {
			paraprint <<EOF;


Your e-mail address will be useful if you need to be contacted. If the
default shown is not your full internet e-mail address, please correct it.

EOF
		} else {
			paraprint <<EOF;

So that you may be contacted if necessary, please enter 
your full internet e-mail address here.

EOF
		}
		print "Your address [$guess]: ";
	
		$from = <>;
		chop $from;
	
		if($from eq "") { $from = $guess }
	
	}
	
	#if( $from =~ /^(.*)\@(.*)$/ ) {
	#	$mailname = $1;
	#	$maildomain = $2;
	#}

	if( $from eq $cc or $me eq $cc ) {
		# Try not to copy ourselves
		$cc = "yourself";
	}


	# Prompt for administrator address, unless an override was given
	if( !$::opt_C and !$::opt_c ) {
		paraprint <<EOF;


A copy of this report can be sent to your local
perl administrator. If the address is wrong, please 
correct it, or enter 'none' or 'yourself' to not send
a copy.

EOF

		print "Local perl administrator [$cc]: ";
	
		my($entry) = scalar(<>);
		chop $entry;
	
		if($entry ne "") {
			$cc = $entry;
			if($me eq $cc) { $cc = "" }
		}
	
	}

	if($cc =~ /^(none|yourself|me|myself|ourselves)$/i) { $cc = "" }

	$andcc = " and $cc" if $cc;


	# Prompt for editor, if no override is given
	if(! $::opt_e and ! $::opt_f and ! $::opt_b) {
		paraprint <<EOF;


Now you need to supply the bug report. Try to make
the report concise but descriptive. Include any 
relevant detail. Some information about your local
perl configuration will automatically be included 
at the end of the report. 

You will probably want to use an editor to enter
the report. If "$ed" is the editor you want
to use, then just press Enter, otherwise type in
the name of the editor you would like to use.

If you would like to use a prepared file, type
"file", and you will be asked for the filename.

EOF

		print "Editor [$ed]: ";
	
		my($entry) =scalar(<>);
		chop $entry;
	
		if($entry ne "") {
			$ed = $entry;
		} 
	}


	# Generate scratch file to edit report in
	
	{
	my($dir) = $Is_VMS ? 'sys$scratch:' : '/tmp/';
	$filename = "bugrep0$$";
	$filename++ while -e "$dir$filename";
	$filename = "$dir$filename";
	}
	
	
	# Prompt for file to read report from, if needed
	
	if( $ed eq "file" and ! $file) {
		paraprint <<EOF;


What is the name of the file that contains your report?

EOF

		print "Filename: ";
	
		my($entry) = scalar(<>);
		chop($entry);

		if(!-f $entry or !-r $entry) {
			print "\n\nUnable to read from `$entry'.\nExiting.\n";
			exit;
		}
		$file = $entry;

	}


	# Generate report

	open(REP,">$filename");

	print REP <<EOF;
This is a bug report for perl from $from,
generated with the help of perlbug $Version running under perl $].

EOF

	if($body) {
		print REP $body;
	} elsif($file) {
		open(F,"<$file") or die "Unable to read report file: $!\n";
		while(<F>) {
		print REP $_
		}
		close(F);
	} else {
		print REP "[Please enter your report here]\n";
	}
	
	Dump(*REP);
	close(REP);

}

sub Dump {
	local(*OUT) = @_;
	
	print OUT <<EOF;


Site configuration information for perl $]:

EOF

	if( $::Config{cf_by} and $::Config{cf_time}) {
		print OUT "Configured by $::Config{cf_by} at $::Config{cf_time}.\n\n";
	}

	print OUT Config::myconfig;

	if($verbose) {
		print OUT "\nComplete configuration data for perl $]:\n\n";
		my($value);
		foreach (sort keys %::Config) {
			$value = $::Config{$_};
			$value =~ s/'/\\'/g;
			print OUT "$_='$value'\n";
		}
	}
}

sub Edit {
	# Edit the report
	
tryagain:	
	if(!$file and !$body) {
		my($sts) = system("$ed $filename");
		if( $Is_VMS ? !($sts & 1) : $sts ) {
			#print "\nUnable to run editor!\n";
			paraprint <<EOF;

The editor you chose (`$ed') could apparently not be run!
Did you mistype the name of your editor? If so, please
correct it here, otherwise just press Enter. 

EOF
			print "Editor [$ed]: ";
		
			my($entry) =scalar(<>);
			chop $entry;
	
			if($entry ne "") {
				$ed = $entry;
				goto tryagain;
			} else {
			
			paraprint <<EOF;

You may want to save your report to a file, so you can edit and mail it
yourself.
EOF
			}
		} 
	}
}

sub NowWhat {

	# Report is done, prompt for further action
	if( !$::opt_S ) {
		while(1) {

			paraprint <<EOF;


Now that you have completed your report, would you like to send 
the message to $address$andcc, display the message on 
the screen, re-edit it, or cancel without sending anything?
You may also save the message as a file to mail at another time.

EOF

			print "Action (Send/Display/Edit/Cancel/Save to File): ";
			my($action) = scalar(<>);
			chop $action;

			if( $action =~ /^(f|sa)/i ) { # <F>ile/<Sa>ve
				print "\n\nName of file to save message in [perlbug.rep]: ";
				my($file) = scalar(<>);
				chop $file;
				if($file eq "") { $file = "perlbug.rep" }
			
				open(FILE,">$file");
				open(REP,"<$filename");
				print FILE "To: $address\nSubject: $subject\n";
				print FILE "Cc: $cc\n" if $cc;
				print FILE "Reply-To: $from\n" if $from;
				print FILE "\n";
				while(<REP>) { print FILE }
				close(REP);
				close(FILE);
	
				print "\nMessage saved in `$file'.\n";
				exit;

			} elsif( $action =~ /^(d|l|sh)/i ) { # <D>isplay, <L>ist, <Sh>ow
				# Display the message
				open(REP,"<$filename");
				while(<REP>) { print $_ }
				close(REP);
			} elsif( $action =~ /^se/i ) { # <S>end
				# Send the message
				print "\
Are you certain you want to send this message?
Please type \"yes\" if you are: ";
				my($reply) = scalar(<STDIN>);
				chop($reply);
				if( $reply eq "yes" ) {
					last;
				}
			} elsif( $action =~ /^[er]/i ) { # <E>dit, <R>e-edit
				# edit the message
				Edit();
				#system("$ed $filename");
			} elsif( $action =~ /^[qc]/i ) { # <C>ancel, <Q>uit
				1 while unlink($filename);  # remove all versions under VMS
				print "\nCancelling.\n";
				exit(0);
			} elsif( $action =~ /^s/ ) {
				paraprint <<EOF;

I'm sorry, but I didn't understand that. Please type "send" or "save".
EOF
			}
		
		}
	}
}


sub Send {

	# Message has been accepted for transmission -- Send the message
	
	if($::HaveSend) {

		$msg = new Mail::Send Subject => $subject, To => $address;
	
		$msg->cc($cc) if $cc;
		$msg->add("Reply-To",$from) if $from;
	    
		$fh = $msg->open;

		open(REP,"<$filename");
		while(<REP>) { print $fh $_ }
		close(REP);
	
		$fh->close;  
	
	} else {
		if ($Is_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 & 1)) { die "Can't spawn off mail\n\t(leaving bug report in $filename): $sts\n;" }
		} else {
			my($sendmail) = "";
			
			foreach (qw(/usr/lib/sendmail /usr/sbin/sendmail /usr/ucblib/sendmail))
			{
				$sendmail = $_, last if -e $_;
			}
			
			paraprint <<"EOF" and die "\n" if $sendmail eq "";
			
I am terribly sorry, but I cannot find sendmail, or a close equivalent, and
the perl package Mail::Send has not been installed, so I can't send your bug
report. We apologize for the inconveniencence.

So you may attempt to find some way of sending your message, it has
been left in the file `$filename'.

EOF
			
			open(SENDMAIL,"|$sendmail -t");
			print SENDMAIL "To: $address\n";
			print SENDMAIL "Subject: $subject\n";
			print SENDMAIL "Cc: $cc\n" if $cc;
			print SENDMAIL "Reply-To: $from\n" if $from;
			print SENDMAIL "\n\n";
			open(REP,"<$filename");
			while(<REP>) { print SENDMAIL $_ }
			close(REP);
			
			close(SENDMAIL);
		}
	
	}
	
	print "\nMessage sent.\n";

	1 while unlink($filename);  # remove all versions under VMS

}

sub Help {
	print <<EOF; 

A program to help generate bug reports about perl5, and mail them. 
It is designed to be used interactively. Normally no arguments will
be needed.
	
Usage:
$0  [-v] [-a address] [-s subject] [-b body | -f file ]
    [-r returnaddress] [-e editor] [-c adminaddress | -C] [-S] [-t]
    
Simplest usage:  run "$0", and follow the prompts.

Options:

  -v    Include Verbose configuration data in the report
  -f    File containing the body of the report. Use this to 
        quickly send a prepared message.
  -S    Send without asking for confirmation.
  -a    Address to send the report to. Defaults to `$address'.
  -c    Address to send copy of report to. Defaults to `$cc'.
  -C    Don't send copy to administrator.
  -s    Subject to include with the message. You will be prompted 
        if you don't supply one on the command line.
  -b    Body of the report. If not included on the command line, or
        in a file with -f, you will get a chance to edit the message.
  -r    Your return address. The program will ask you to confirm
        this if you don't give it here.
  -e    Editor to use. 
  -t    Test mode. The target address defaults to `$testaddress'.
  -d	Data mode (the default if you redirect or pipe output.) 
        This prints out your configuration data, without mailing
        anything. You can use this with -v to get more complete data.
  
EOF
}

sub paraprint {
    my @paragraphs = split /\n{2,}/, "@_";
    print "\n\n";
    for (@paragraphs) {   # implicit local $_
    	s/(\S)\s*\n/$1 /g;
	    write;
	    print "\n";
    }
                       
}
                            

format STDOUT =
^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
$_
.
!NO!SUBS!

close OUT or die "Can't close $file: $!";
chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
Commit	Line	Data
37fa004c	1	#!/usr/local/bin/perl
	2
	3	use Config;
	4	use File::Basename qw(&basename &dirname);
	5
	6	# List explicitly here the variables you want Configure to
	7	# generate. Metaconfig only looks for shell variables, so you
	8	# have to mention them as if they were shell variables, not
	9	# %Config entries. Thus you write
	10	# $startperl
	11	# to ensure Configure will look for $Config{startperl}.
	12
	13	# This forces PL files to create target in same directory as PL file.
	14	# This is so that make depend always knows where to find PL derivatives.
	15	chdir(dirname($0));
	16	($file = basename($0)) =~ s/\.PL$//;
	17	$file =~ s/\.pl$//
84478119	18	if ($^O eq 'VMS' or $^O eq 'os2'); # "case-forgiving"
37fa004c	19
	20	open OUT,">$file" or die "Can't create $file: $!";
	21
	22	print "Extracting $file (with variable substitutions)\n";
	23
	24	# In this section, perl variables will be expanded during extraction.
	25	# You can use $Config{...} to use Configure variables.
	26
	27	print OUT <<"!GROK!THIS!";
	28	$Config{'startperl'}
	29	eval 'exec perl -S \$0 "\$@"'
	30	if 0;
	31	!GROK!THIS!
	32
	33	# In the following, perl variables are not expanded during extraction.
	34
	35	print OUT <<'!NO!SUBS!';
	36
	37	use Config;
37fa004c	38	use Getopt::Std;
37fa004c	39
c07a80fd	40	BEGIN {
	41	eval "use Mail::Send;";
	42	$::HaveSend = ($@ eq "");
	43	eval "use Mail::Util;";
	44	$::HaveUtil = ($@ eq "");
	45	};
	46
	47
37fa004c	48	use strict;
	49
	50	sub paraprint;
	51
c07a80fd	52
84478119	53	my($Version) = "1.13";
c07a80fd	54
c07a80fd	55	# Changed in 1.06 to skip Mail::Send and Mail::Util if not available.
a5f75d66	56	# Changed in 1.07 to see more sendmail execs, and added pipe output.
a5f75d66	57	# Changed in 1.08 to use correct address for sendmail.
c07a80fd	58	# Changed in 1.09 to close the REP file before calling it up in the editor.
	59	# Also removed some old comments duplicated elsewhere.
	60	# Changed in 1.10 to run under VMS without Mail::Send; also fixed
a5f75d66	61	# temp filename generation.
c07a80fd	62	# Changed in 1.11 to clean up some text and removed Mail::Send deactivator.
a5f75d66	63	# Changed in 1.12 to check for editor errors, make save/send distinction
a5f75d66	64	# clearer and add $ENV{REPLYTO}.
84478119	65	# Changed in 1.13 to hopefully make it more difficult to accidentally
84478119	66	# send mail
c07a80fd	67
	68	# TODO: Allow the user to re-name the file on mail failure, and
	69	# make sure failure (transmission-wise) of Mail::Send is
	70	# accounted for.
37fa004c	71
	72	my( $file, $cc, $address, $perlbug, $testaddress, $filename,
	73	$subject, $from, $verbose, $ed,
	74	$fh, $me, $Is_VMS, $msg, $body, $andcc );
	75
	76	Init();
	77
	78	if($::opt_h) { Help(); exit; }
	79
84478119	80	if(!-t STDIN) {
	81	paraprint <<EOF;
	82	Please use perlbug interactively. If you want to
	83	include a file, you can use the -f switch.
	84	EOF
	85	die "\n";
	86	}
	87
c07a80fd	88	if($::opt_d or !-t STDOUT) { Dump(*STDOUT); exit; }
c07a80fd	89
37fa004c	90	Query();
	91	Edit();
	92	NowWhat();
	93	Send();
	94
	95	exit;
	96
	97	sub Init {
	98
	99	# -------- Setup --------
	100
84478119	101	$Is_VMS = $^O eq 'VMS';
37fa004c	102
c07a80fd	103	getopts("dhva:s:b:f:r:e:SCc:t");
37fa004c	104
	105
	106	# This comment is needed to notify metaconfig that we are
	107	# using the $perladmin, $cf_by, and $cf_time definitions.
	108
	109
	110	# -------- Configuration ---------
	111
	112	# perlbug address
	113	$perlbug = 'perlbug@perl.com';
	114
	115	# Test address
	116	$testaddress = 'perlbug-test@perl.com';
	117
	118	# Target address
	119	$address = $::opt_a \|\| ($::opt_t ? $testaddress : $perlbug);
	120
	121	# Possible administrator addresses, in order of confidence
	122	# (Note that cf_email is not mentioned to metaconfig, since
	123	# we don't really want it. We'll just take it if we have to.)
	124	$cc = ($::opt_C ? "" : (
	125	$::opt_c \|\| $::Config{perladmin} \|\| $::Config{cf_email} \|\| $::Config{cf_by}
	126	));
	127
	128	# Users address, used in message and in Reply-To header
	129	$from = $::opt_r \|\| "";
	130
	131	# Include verbose configuration information
	132	$verbose = $::opt_v \|\| 0;
	133
	134	# Subject of bug-report message
	135	$subject = $::opt_s \|\| "";
	136
	137	# File to send as report
	138	$file = $::opt_f \|\| "";
	139
	140	# Body of report
	141	$body = $::opt_b \|\| "";
	142
	143	# Editor
	144	$ed = ($::opt_f ? "file" : (
	145	$::opt_e \|\| $ENV{VISUAL} \|\| $ENV{EDITOR} \|\| $ENV{EDIT} \|\|
	146	($Is_VMS ? "edit/tpu" : "vi")
	147	));
	148
	149	# My username
	150	$me = getpwuid($<);
	151
	152	}
	153
	154
	155	sub Query {
	156
	157	# Explain what perlbug is
	158
	159	paraprint <<EOF;
c07a80fd	160	This program allows you to create a bug report,
37fa004c	161	which will be sent as an e-mail message to $address
	162	once you have filled in the report.
	163
	164	EOF
	165
	166
	167	# Prompt for subject of message, if needed
	168	if(! $subject) {
	169	paraprint <<EOF;
	170	First of all, please provide a subject for the
c07a80fd	171	message. It should be as a concise description of
c07a80fd	172	the bug as is possible.
37fa004c	173
	174	EOF
	175	print "Subject: ";
	176
	177	$subject = <>;
	178	chop $subject;
	179
	180	my($err)=0;
	181	while( $subject =~ /^\s*$/ ) {
	182	print "\nPlease enter a subject: ";
	183	$subject = <>;
	184	chop $subject;
	185	if($err++>5) {
	186	die "Aborting.\n";
	187	}
	188	}
	189	}
	190
	191
	192	# Prompt for return address, if needed
	193	if( !$from) {
	194
	195	# Try and guess return address
c07a80fd	196	my($domain);
	197
	198	if($::HaveUtil) {
	199	$domain = Mail::Util::maildomain();
	200	} elsif ($Is_VMS) {
	201	require Sys::Hostname;
	202	$domain = Sys::Hostname::hostname();
	203	} else {
	204	$domain = `hostname`.".".`domainname`;
	205	$domain =~ s/[\r\n]+//g;
	206	}
37fa004c	207
	208	my($guess);
	209
	210	if( !$domain) {
	211	$guess = "";
	212	} elsif ($Is_VMS && !$::Config{'d_has_sockets'}) {
c07a80fd	213	$guess = "$domain\:\:$me";
37fa004c	214	} else {
c07a80fd	215	$guess = "$me\@$domain" if $domain;
c07a80fd	216	$guess = "$me\@unknown.addresss" unless $domain;
37fa004c	217	}
a5f75d66	218
	219	$guess = $ENV{'REPLYTO'} if defined($ENV{'REPLYTO'});
	220	$guess = $ENV{"REPLY-TO"} if defined($ENV{'REPLY-TO'});
37fa004c	221
	222	if( $guess ) {
	223	paraprint <<EOF;
	224
	225
a5f75d66	226	Your e-mail address will be useful if you need to be contacted. If the
a5f75d66	227	default shown is not your full internet e-mail address, please correct it.
37fa004c	228
	229	EOF
	230	} else {
	231	paraprint <<EOF;
	232
	233	So that you may be contacted if necessary, please enter
a5f75d66	234	your full internet e-mail address here.
37fa004c	235
	236	EOF
	237	}
	238	print "Your address [$guess]: ";
	239
	240	$from = <>;
	241	chop $from;
	242
	243	if($from eq "") { $from = $guess }
	244
	245	}
	246
	247	#if( $from =~ /^(.)\@(.)$/ ) {
	248	# $mailname = $1;
	249	# $maildomain = $2;
	250	#}
	251
	252	if( $from eq $cc or $me eq $cc ) {
	253	# Try not to copy ourselves
c07a80fd	254	$cc = "yourself";
37fa004c	255	}
	256
	257
	258	# Prompt for administrator address, unless an override was given
	259	if( !$::opt_C and !$::opt_c ) {
	260	paraprint <<EOF;
	261
	262
	263	A copy of this report can be sent to your local
	264	perl administrator. If the address is wrong, please
c07a80fd	265	correct it, or enter 'none' or 'yourself' to not send
c07a80fd	266	a copy.
37fa004c	267
	268	EOF
	269
	270	print "Local perl administrator [$cc]: ";
	271
	272	my($entry) = scalar(<>);
	273	chop $entry;
	274
	275	if($entry ne "") {
	276	$cc = $entry;
	277	if($me eq $cc) { $cc = "" }
	278	}
	279
	280	}
	281
84478119	282	if($cc =~ /^(none\|yourself\|me\|myself\|ourselves)$/i) { $cc = "" }
37fa004c	283
	284	$andcc = " and $cc" if $cc;
	285
	286
	287	# Prompt for editor, if no override is given
	288	if(! $::opt_e and ! $::opt_f and ! $::opt_b) {
	289	paraprint <<EOF;
	290
	291
c07a80fd	292	Now you need to supply the bug report. Try to make
37fa004c	293	the report concise but descriptive. Include any
	294	relevant detail. Some information about your local
	295	perl configuration will automatically be included
	296	at the end of the report.
	297
	298	You will probably want to use an editor to enter
	299	the report. If "$ed" is the editor you want
	300	to use, then just press Enter, otherwise type in
	301	the name of the editor you would like to use.
	302
c07a80fd	303	If you would like to use a prepared file, type
37fa004c	304	"file", and you will be asked for the filename.
	305
	306	EOF
	307
	308	print "Editor [$ed]: ";
	309
	310	my($entry) =scalar(<>);
	311	chop $entry;
	312
	313	if($entry ne "") {
	314	$ed = $entry;
	315	}
	316	}
	317
	318
	319	# Generate scratch file to edit report in
	320
c07a80fd	321	{
	322	my($dir) = $Is_VMS ? 'sys$scratch:' : '/tmp/';
	323	$filename = "bugrep0$$";
	324	$filename++ while -e "$dir$filename";
	325	$filename = "$dir$filename";
	326	}
37fa004c	327
	328
	329	# Prompt for file to read report from, if needed
	330
	331	if( $ed eq "file" and ! $file) {
	332	paraprint <<EOF;
	333
	334
	335	What is the name of the file that contains your report?
	336
	337	EOF
	338
	339	print "Filename: ";
	340
	341	my($entry) = scalar(<>);
	342	chop($entry);
	343
	344	if(!-f $entry or !-r $entry) {
c07a80fd	345	print "\n\nUnable to read from `$entry'.\nExiting.\n";
37fa004c	346	exit;
	347	}
	348	$file = $entry;
	349
	350	}
	351
	352
	353	# Generate report
	354
	355	open(REP,">$filename");
	356
	357	print REP <<EOF;
	358	This is a bug report for perl from $from,
	359	generated with the help of perlbug $Version running under perl $].
	360
	361	EOF
	362
	363	if($body) {
	364	print REP $body;
	365	} elsif($file) {
	366	open(F,"<$file") or die "Unable to read report file: $!\n";
	367	while(<F>) {
	368	print REP $_
	369	}
	370	close(F);
	371	} else {
	372	print REP "[Please enter your report here]\n";
	373	}
c07a80fd	374
	375	Dump(*REP);
	376	close(REP);
37fa004c	377
c07a80fd	378	}
	379
	380	sub Dump {
	381	local(*OUT) = @_;
	382
	383	print OUT <<EOF;
37fa004c	384
	385
	386
	387	Site configuration information for perl $]:
	388
	389	EOF
	390
	391	if( $::Config{cf_by} and $::Config{cf_time}) {
c07a80fd	392	print OUT "Configured by $::Config{cf_by} at $::Config{cf_time}.\n\n";
37fa004c	393	}
37fa004c	394
c07a80fd	395	print OUT Config::myconfig;
37fa004c	396
37fa004c	397	if($verbose) {
c07a80fd	398	print OUT "\nComplete configuration data for perl $]:\n\n";
37fa004c	399	my($value);
	400	foreach (sort keys %::Config) {
	401	$value = $::Config{$_};
	402	$value =~ s/'/\\'/g;
c07a80fd	403	print OUT "$_='$value'\n";
37fa004c	404	}
37fa004c	405	}
37fa004c	406	}
	407
	408	sub Edit {
	409	# Edit the report
	410
a5f75d66	411	tryagain:
37fa004c	412	if(!$file and !$body) {
c07a80fd	413	my($sts) = system("$ed $filename");
c07a80fd	414	if( $Is_VMS ? !($sts & 1) : $sts ) {
a5f75d66	415	#print "\nUnable to run editor!\n";
	416	paraprint <<EOF;
	417
	418	The editor you chose (`$ed') could apparently not be run!
	419	Did you mistype the name of your editor? If so, please
	420	correct it here, otherwise just press Enter.
	421
	422	EOF
	423	print "Editor [$ed]: ";
	424
	425	my($entry) =scalar(<>);
	426	chop $entry;
	427
	428	if($entry ne "") {
	429	$ed = $entry;
	430	goto tryagain;
	431	} else {
	432
	433	paraprint <<EOF;
	434
	435	You may want to save your report to a file, so you can edit and mail it
	436	yourself.
	437	EOF
	438	}
37fa004c	439	}
	440	}
	441	}
	442
	443	sub NowWhat {
	444
	445	# Report is done, prompt for further action
	446	if( !$::opt_S ) {
	447	while(1) {
	448
	449	paraprint <<EOF;
	450
	451
	452	Now that you have completed your report, would you like to send
	453	the message to $address$andcc, display the message on
	454	the screen, re-edit it, or cancel without sending anything?
	455	You may also save the message as a file to mail at another time.
	456
	457	EOF
	458
a5f75d66	459	print "Action (Send/Display/Edit/Cancel/Save to File): ";
37fa004c	460	my($action) = scalar(<>);
	461	chop $action;
	462
a5f75d66	463	if( $action =~ /^(f\|sa)/i ) { # <F>ile/<Sa>ve
37fa004c	464	print "\n\nName of file to save message in [perlbug.rep]: ";
	465	my($file) = scalar(<>);
	466	chop $file;
	467	if($file eq "") { $file = "perlbug.rep" }
	468
	469	open(FILE,">$file");
	470	open(REP,"<$filename");
	471	print FILE "To: $address\nSubject: $subject\n";
	472	print FILE "Cc: $cc\n" if $cc;
	473	print FILE "Reply-To: $from\n" if $from;
	474	print FILE "\n";
	475	while(<REP>) { print FILE }
	476	close(REP);
	477	close(FILE);
	478
	479	print "\nMessage saved in `$file'.\n";
	480	exit;
	481
a5f75d66	482	} elsif( $action =~ /^(d\|l\|sh)/i ) { # <D>isplay, <L>ist, <Sh>ow
37fa004c	483	# Display the message
	484	open(REP,"<$filename");
	485	while(<REP>) { print $_ }
	486	close(REP);
84478119	487	} elsif( $action =~ /^se/i ) { # <S>end
a5f75d66	488	# Send the message
84478119	489	print "\
	490	Are you certain you want to send this message?
	491	Please type \"yes\" if you are: ";
	492	my($reply) = scalar(<STDIN>);
	493	chop($reply);
	494	if( $reply eq "yes" ) {
	495	last;
	496	}
a5f75d66	497	} elsif( $action =~ /^[er]/i ) { # <E>dit, <R>e-edit
37fa004c	498	# edit the message
a5f75d66	499	Edit();
	500	#system("$ed $filename");
	501	} elsif( $action =~ /^[qc]/i ) { # <C>ancel, <Q>uit
37fa004c	502	1 while unlink($filename); # remove all versions under VMS
	503	print "\nCancelling.\n";
	504	exit(0);
84478119	505	} elsif( $action =~ /^s/ ) {
	506	paraprint <<EOF;
	507
	508	I'm sorry, but I didn't understand that. Please type "send" or "save".
	509	EOF
37fa004c	510	}
	511
	512	}
	513	}
	514	}
	515
	516
	517	sub Send {
	518
	519	# Message has been accepted for transmission -- Send the message
c07a80fd	520
c07a80fd	521	if($::HaveSend) {
37fa004c	522
c07a80fd	523	$msg = new Mail::Send Subject => $subject, To => $address;
37fa004c	524
c07a80fd	525	$msg->cc($cc) if $cc;
c07a80fd	526	$msg->add("Reply-To",$from) if $from;
37fa004c	527
c07a80fd	528	$fh = $msg->open;
	529
	530	open(REP,"<$filename");
	531	while(<REP>) { print $fh $_ }
	532	close(REP);
37fa004c	533
c07a80fd	534	$fh->close;
	535
	536	} else {
	537	if ($Is_VMS) {
	538	if ( ($address =~ /@/ and $address !~ /^\w+%"/) or
	539	($cc =~ /@/ and $cc !~ /^\w+%"/) ){
	540	my($prefix);
	541	foreach (qw[ IN MX SMTP UCX PONY WINS ],'') {
	542	$prefix = "$_%",last if $ENV{"MAIL\$PROTOCOL_$_"};
	543	}
	544	$address = qq[${prefix}"$address"] unless $address =~ /^\w+%"/;
	545	$cc = qq[${prefix}"$cc"] unless !$cc \|\| $cc =~ /^\w+%"/;
	546	}
	547	$subject =~ s/"/""/g; $address =~ s/"/""/g; $cc =~ s/"/""/g;
	548	my($sts) = system(qq[mail/Subject="$subject" $filename. "$address","$cc"]);
	549	if (!($sts & 1)) { die "Can't spawn off mail\n\t(leaving bug report in $filename): $sts\n;" }
	550	} else {
	551	my($sendmail) = "";
	552
	553	foreach (qw(/usr/lib/sendmail /usr/sbin/sendmail /usr/ucblib/sendmail))
	554	{
	555	$sendmail = $_, last if -e $_;
	556	}
	557
	558	paraprint <<"EOF" and die "\n" if $sendmail eq "";
	559
	560	I am terribly sorry, but I cannot find sendmail, or a close equivalent, and
	561	the perl package Mail::Send has not been installed, so I can't send your bug
	562	report. We apologize for the inconveniencence.
	563
	564	So you may attempt to find some way of sending your message, it has
	565	been left in the file `$filename'.
	566
	567	EOF
	568
	569	open(SENDMAIL,"\|$sendmail -t");
	570	print SENDMAIL "To: $address\n";
	571	print SENDMAIL "Subject: $subject\n";
	572	print SENDMAIL "Cc: $cc\n" if $cc;
	573	print SENDMAIL "Reply-To: $from\n" if $from;
	574	print SENDMAIL "\n\n";
	575	open(REP,"<$filename");
	576	while(<REP>) { print SENDMAIL $_ }
	577	close(REP);
	578
	579	close(SENDMAIL);
	580	}
37fa004c	581
c07a80fd	582	}
37fa004c	583
	584	print "\nMessage sent.\n";
	585
	586	1 while unlink($filename); # remove all versions under VMS
	587
	588	}
	589
	590	sub Help {
	591	print <<EOF;
	592
	593	A program to help generate bug reports about perl5, and mail them.
	594	It is designed to be used interactively. Normally no arguments will
	595	be needed.
	596
	597	Usage:
	598	$0 [-v] [-a address] [-s subject] [-b body \| -f file ]
	599	[-r returnaddress] [-e editor] [-c adminaddress \| -C] [-S] [-t]
	600
c07a80fd	601	Simplest usage: run "$0", and follow the prompts.
37fa004c	602
	603	Options:
	604
	605	-v Include Verbose configuration data in the report
	606	-f File containing the body of the report. Use this to
	607	quickly send a prepared message.
	608	-S Send without asking for confirmation.
	609	-a Address to send the report to. Defaults to `$address'.
	610	-c Address to send copy of report to. Defaults to `$cc'.
	611	-C Don't send copy to administrator.
	612	-s Subject to include with the message. You will be prompted
	613	if you don't supply one on the command line.
	614	-b Body of the report. If not included on the command line, or
	615	in a file with -f, you will get a chance to edit the message.
	616	-r Your return address. The program will ask you to confirm
	617	this if you don't give it here.
	618	-e Editor to use.
	619	-t Test mode. The target address defaults to `$testaddress'.
c07a80fd	620	-d Data mode (the default if you redirect or pipe output.)
	621	This prints out your configuration data, without mailing
	622	anything. You can use this with -v to get more complete data.
37fa004c	623
	624	EOF
	625	}
	626
	627	sub paraprint {
	628	my @paragraphs = split /\n{2,}/, "@_";
c07a80fd	629	print "\n\n";
37fa004c	630	for (@paragraphs) { # implicit local $_
	631	s/(\S)\s*\n/$1 /g;
	632	write;
	633	print "\n";
	634	}
	635
	636	}
	637
	638
	639	format STDOUT =
	640	^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
	641	$_
	642	.
	643	!NO!SUBS!
	644
	645	close OUT or die "Can't close $file: $!";
	646	chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
	647	exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';