[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, '.PL');

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 $Config{perlpath} -S \$0 \${1+"\$@"}'
	if \$running_under_some_shell;
!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.15";

# 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
# Changed in 1.14 to make the prompts a little more clear on providing
#                 helpful information. Also let file read fail gracefully.
# Changed in 1.15 to add warnings to stop people using perlbug for non-bugs.
#                 Also report selected environment variables.

# 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, $usefile, $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() unless $usefile;
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 || "";

	# Send a file
	$usefile = ($::opt_f || 0);
	
	# File to send as report
	$file = $::opt_f || "";

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

	# Editor
	$ed = (	$::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 provides an easy way to create a message reporting a bug
in perl, and e-mail it to $address.  It is *NOT* intended for
sending test messages or simply verifying that perl works.  It is *ONLY*
a means of reporting verifiable problems with perl, and any solutions to
such problems, to the people who maintain perl.

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 a concise description of 
the bug or problem.

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_socket'}) { 
	        	$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;

editor:
	
	# 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. If you are reporting something
that does not work as you think it should, please
try to include example of both the actual 
result, and what you expected.

Some information about your local
perl configuration will automatically be included 
at the end of the report. If you are using any
unusual version of perl, please try and confirm
exactly which versions are relevant.

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;
		
		$usefile = 0;
		if($entry eq "file") {
			$usefile = 1;
		} elsif($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( $usefile and ! $file) {
filename:
		paraprint <<EOF;

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

EOF

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

		if($entry eq "") {
			paraprint <<EOF;
			
No filename? I'll let you go back and choose an editor again.			

EOF
			goto editor;
		}
		
		if(!-f $entry or !-r $entry) {
			paraprint <<EOF;
			
I'm sorry, but I can't read from `$entry'. Maybe you mistyped the name of
the file? If you don't want to send a file, just enter a blank line and you
can get back to the editor selection.

EOF
			goto filename;
		}
		$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($usefile) {
		open(F,"<$file") or die "Unable to read report file from `$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";
		}
	}
	print OUT <<EOF;


Environment for perl $]:
EOF
        for my $env (qw(PATH LD_LIBRARY_PATH
		    PERL5LIB PERLLIB PERL5DB
		    LC_ALL LC_COLLATE LC_CTYPE LC_MONETARY LC_NUMERIC LC_TIME
		    LANG PERL_BADLANG
		    SHELL HOME LOGDIR)) {
	    print OUT "    $env",
                      exists $ENV{$env} ? "=$ENV{$env}" : ' (unset)',
	              "\n";
	}
}

sub Edit {
	# Edit the report

	if($usefile) {
		$usefile = 0;
		paraprint <<EOF;

Please make sure that the name of the editor you want to use is correct.

EOF
		print "Editor [$ed]: ";
		
		my($entry) =scalar(<>);
		chop $entry;
	
		if($entry ne "") {
			$ed = $entry;
		} 
	}
	
tryagain:
	if(!$usefile 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;
				} else {
					paraprint <<EOF;

That wasn't a clear "yes", so I won't send your message. If you are sure
your message should be sent, type in "yes" (without the quotes) at the
confirmation prompt.

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