[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 ($Config{'osname'} eq 'VMS' or
	    $Config{'osname'} 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.12";

# 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}.

# 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($::opt_d or !-t STDOUT) { Dump(*STDOUT); exit; }

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

exit;

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

	$Is_VMS = $::Config{'osname'} 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|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 =~ /^s/i ) { # <S>end
				# Send the message
				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);
			}
		
		}
	}
}


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