[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.11";

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

# 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;
			}
	
		if( $guess ) {
			paraprint <<EOF;


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

EOF
		} else {
			paraprint <<EOF;

So that you may be contacted if necessary, please enter 
your 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
	
	if(!$file and !$body) {
		my($sts) = system("$ed $filename");
		if( $Is_VMS ? !($sts & 1) : $sts ) {
			print "\nUnable to run editor!\n";
		} 
	}
}

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/File): ";
			my($action) = scalar(<>);
			chop $action;

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