X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/4935d2c2574073146066c5d9b654a47d71a2cc2a..e5e1ee61c50f938a3a8b7487d29d5128d4f9a909:/utils/perlbug.PL diff --git a/utils/perlbug.PL b/utils/perlbug.PL index 2b11012..885785a 100644 --- a/utils/perlbug.PL +++ b/utils/perlbug.PL @@ -2,6 +2,8 @@ use Config; use File::Basename qw(&basename &dirname); +use Cwd; +use File::Spec::Functions; # List explicitly here the variables you want Configure to # generate. Metaconfig only looks for shell variables, so you @@ -9,457 +11,633 @@ use File::Basename qw(&basename &dirname); # %Config entries. Thus you write # $startperl # to ensure Configure will look for $Config{startperl}. +# $perlpath # 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. +$origdir = cwd; chdir dirname($0); $file = basename($0, '.PL'); $file .= '.com' if $^O eq 'VMS'; -open OUT,">$file" or die "Can't create $file: $!"; +open OUT, ">$file" or die "Can't create $file: $!"; + +# get patchlevel.h timestamp + +-e catfile(updir, "patchlevel.h") + or die "Can't find patchlevel.h: $!"; + +my $patchlevel_date = (stat _)[9]; + +# TO DO (perhaps): store/embed $Config::config_sh into perlbug. When perlbug is +# used, compare $Config::config_sh with the stored version. If they differ then +# append a list of individual differences to the bug report. + 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. +my $extract_version = sprintf("%vd", $^V); + print OUT <<"!GROK!THIS!"; $Config{startperl} eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}' if \$running_under_some_shell; + +my \$config_tag1 = '$extract_version - $Config{cf_time}'; + +my \$patchlevel_date = $patchlevel_date; !GROK!THIS! # In the following, perl variables are not expanded during extraction. print OUT <<'!NO!SUBS!'; +my @patches = Config::local_patches(); +my $patch_tags = join "", map /(\S+)/ ? "+$1 " : (), @patches; +use warnings; +use strict; use Config; +use File::Spec; # keep perlbug Perl 5.005 compatible use Getopt::Std; +use File::Basename 'basename'; + +sub paraprint; BEGIN { - eval "use Mail::Send;"; - $::HaveSend = ($@ eq ""); - eval "use Mail::Util;"; - $::HaveUtil = ($@ eq ""); + eval { require Mail::Send;}; + $::HaveSend = ($@ eq ""); + eval { require Mail::Util; } ; + $::HaveUtil = ($@ eq ""); + # use secure tempfiles wherever possible + eval { require File::Temp; }; + $::HaveTemp = ($@ eq ""); + eval { require Module::CoreList; }; + $::HaveCoreList = ($@ eq ""); }; +my $Version = "1.40"; -use strict; - -sub paraprint; +#TODO: +# make sure failure (transmission-wise) of Mail::Send is accounted for. +# (This may work now. Unsure of the original author's issue -JESSE 2008-06-08) +# - Test -b option +my( $file, $usefile, $cc, $address, $bugaddress, $testaddress, $thanksaddress, + $filename, $messageid, $domain, $subject, $from, $verbose, $ed, $outfile, + $fh, $me, $body, $andcc, %REP, $ok, $thanks, $progname, + $Is_MSWin32, $Is_Linux, $Is_VMS, $Is_OpenBSD, + $report_about_module, $category, $severity, + %opt, $have_attachment, $attachments, $has_patch, $mime_boundary +); -my($Version) = "1.18"; - -# 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. -# Changed in 1.16 to include @INC, and allow user to re-edit if no changes. -# Changed in 1.17 Win32 support added. GSAR 97-04-12 -# Changed in 1.18 add '-ok' option for reporting build success. CFR 97-06-18 - -# TODO: - Allow the user to re-name the file on mail failure, and -# make sure failure (transmission-wise) of Mail::Send is -# accounted for. -# - Test -b option +my $perl_version = $^V ? sprintf("%vd", $^V) : $]; -my( $file, $usefile, $cc, $address, $perlbug, $testaddress, $filename, - $subject, $from, $verbose, $ed, - $fh, $me, $Is_MSWin32, $Is_VMS, $msg, $body, $andcc, %REP, $ok); +my $config_tag2 = "$perl_version - $Config{cf_time}"; Init(); -if($::opt_h) { Help(); exit; } - -if(!-t STDIN) { - paraprint < { + 'default' => 'core', + 'ok' => 'install', + # Inevitably some of these will end up in RT whatever we do: + 'thanks' => 'thanks', + 'opts' => [qw(core docs install library utilities)], # patch, notabug + }, + 'severity' => { + 'default' => 'low', + 'ok' => 'none', + 'thanks' => 'none', + 'opts' => [qw(critical high medium low wishlist none)], # zero + }, + ); + die "Invalid alternative ($name) requested\n" unless grep(/^$name$/, keys %alts); + my $alt = ""; + my $what = $ok || $thanks; + if ($what) { + $alt = $alts{$name}{$what}; + } else { + my @alts = @{$alts{$name}{'opts'}}; + print "\n\n"; + paraprint < 5) { + die "Invalid $name: aborting.\n"; + } + $alt = _prompt('', "\u$name", $alts{$name}{'default'}); + $alt ||= $alts{$name}{'default'}; + } while !((($alt) = grep(/^$alt/i, @alts))); + } + lc $alt; +} + sub Init { - - # -------- Setup -------- + # -------- Setup -------- - $Is_MSWin32 = $^O eq 'MSWin32'; - $Is_VMS = $^O eq 'VMS'; + $Is_MSWin32 = $^O eq 'MSWin32'; + $Is_VMS = $^O eq 'VMS'; + $Is_Linux = lc($^O) eq 'linux'; + $Is_OpenBSD = lc($^O) eq 'openbsd'; - getopts("dhva:s:b:f:r:e:SCc:to:"); - + if (!getopts("Adhva:s:b:f:F:r:e:SCc:to:n:T:p:", \%opt)) { Help(); exit; }; - # This comment is needed to notify metaconfig that we are - # using the $perladmin, $cf_by, and $cf_time definitions. + # This comment is needed to notify metaconfig that we are + # using the $perladmin, $cf_by, and $cf_time definitions. + # -------- Configuration --------- - # -------- Configuration --------- - - # perlbug address - $perlbug = 'perlbug@perl.com'; + # perlbug address + $bugaddress = 'perlbug@perl.org'; - - # Test address - $testaddress = 'perlbug-test@perl.com'; - - # Target address - $address = $::opt_a || ($::opt_t ? $testaddress : $perlbug); + # Test address + $testaddress = 'perlbug-test@perl.org'; - # Users address, used in message and in Reply-To header - $from = $::opt_r || ""; + # Thanks address + $thanksaddress = 'perl-thanks@perl.org'; - # Include verbose configuration information - $verbose = $::opt_v || 0; + if (basename ($0) =~ /^perlthanks/i) { + # invoked as perlthanks + $opt{T} = 1; + $opt{C} = 1; # don't send a copy to the local admin + } - # Subject of bug-report message - $subject = $::opt_s || ""; + if ($opt{T}) { + $thanks = 'thanks'; + } + + $progname = $thanks ? 'perlthanks' : 'perlbug'; + # Target address + $address = $opt{a} || ($opt{t} ? $testaddress + : $thanks ? $thanksaddress : $bugaddress); - # 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" : $Is_MSWin32 ? "notepad" : "vi") - ); - - # OK - send "OK" report for build on this system - $ok = 0; - if ( $::opt_o ) { - if ( $::opt_o eq 'k' ) { - # force these options - $::opt_S = 1; # don't prompt for send - $::opt_C = 1; # don't send a copy to the local admin - $::opt_v = 1; $verbose = 1; - $::opt_s = 1; $subject = "OK: perl $] on " - . $::Config{'osname'} . ' ' - . $::Config{'osvers'}; - $::opt_b = 1; $body = "Perl reported to build OK on this system\n"; - $ok = 1; - } - else { - Help(); - exit(); - } - } - - # 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.) - # - # This has to be after the $ok stuff above because of the way - # that $::opt_C is forced. - $cc = ($::opt_C ? "" : ( - $::opt_c || $::Config{perladmin} || $::Config{cf_email} || $::Config{cf_by} - )); - - # My username - $me = ( $Is_MSWin32 - ? $ENV{'USERNAME'} - : ( $^O eq 'os2' - ? $ENV{'USER'} || $ENV{'LOGNAME'} - : eval { getpwuid($<) }) ); # May be missing + # Users address, used in message and in From and Reply-To headers + $from = $opt{r} || ""; -} + # Include verbose configuration information + $verbose = $opt{v} || 0; + # Subject of bug-report message + $subject = $opt{s} || ""; -sub Query { + # Send a file + $usefile = ($opt{f} || 0); - # Explain what perlbug is - if ( ! $ok ) { - paraprint < 60 * 24 * 60 * 60 ) { + my $date = localtime $patchlevel_date; + print <<"EOF"; +"perlbug -ok" and "perlbug -nok" do not report on Perl versions which +are more than 60 days old. This Perl version was constructed on +$date. If you really want to report this, use +"perlbug -okay" or "perlbug -nokay". 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"; - } - } + exit(); + } + # force these options + unless ($opt{n}) { + $opt{S} = 1; # don't prompt for send + $opt{b} = 1; # we have a body + $body = "Perl reported to build OK on this system.\n"; + } + $opt{C} = 1; # don't send a copy to the local admin + $opt{s} = 1; # we have a subject line + $subject = ($opt{n} ? 'Not ' : '') + . "OK: perl $perl_version ${patch_tags}on" + ." $::Config{'archname'} $::Config{'osvers'} $subject"; + $ok = 'ok'; + } else { + Help(); + exit(); } - + } - # Prompt for return address, if needed - if( !$from) { - - # Try and guess return address - my($domain); - - if($::HaveUtil) { - $domain = Mail::Util::maildomain(); - } elsif ($Is_MSWin32) { - $domain = $ENV{'USERDOMAIN'}; - } 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 ) { - if ( ! $ok ) { - paraprint <"; + # My username + $me = $Is_MSWin32 ? $ENV{'USERNAME'} + : $^O eq 'os2' ? $ENV{'USER'} || $ENV{'LOGNAME'} + : eval { getpwuid($<) }; # May be missing -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. + $from = $::Config{'cf_email'} + if !$from && $::Config{'cf_email'} && $::Config{'cf_by'} && $me && + ($me eq $::Config{'cf_by'}); +} # sub Init +sub Query { + # Explain what perlbug is + unless ($ok) { + if ($thanks) { + paraprint <<'EOF'; +This program provides an easy way to send a thank-you message back to the +authors and maintainers of perl. + +If you wish to submit a bug report, please run it without the -T flag +(or run the program perlbug rather than perlthanks) EOF - } - } else { - paraprint <; - chop $from; - - if($from eq "") { $from = $guess } + } + } while (TrivialSubject($subject)); + } + $subject = '[PATCH] ' . $subject + if $has_patch && ($subject !~ m/^\[PATCH/i); + + # Prompt for return address, if needed + unless ($opt{r}) { + # Try and guess return address + my $guess; + + $guess = $ENV{'REPLY-TO'} || $ENV{'REPLYTO'} || $ENV{'EMAIL'} + || $from || ''; + + unless ($guess) { + # move $domain to where we can use it elsewhere + if ($domain) { + if ($Is_VMS && !$::Config{'d_socket'}) { + $guess = "$domain\:\:$me"; + } else { + $guess = "$me\@$domain" if $domain; } - - } - - #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 ) { + if ($guess) { + unless ($ok) { paraprint <); - chop $entry; - - if($entry ne "") { - $cc = $entry; - if($me eq $cc) { $cc = "" } - } - + if ($entry ne "") { + $cc = $entry; + $cc = '' if $me eq $cc; } + } - if($cc =~ /^(none|yourself|me|myself|ourselves)$/i) { $cc = "" } - - $andcc = " and $cc" if $cc; + $cc = '' if $cc =~ /^(none|yourself|me|myself|ourselves)$/i; + if ($cc) { + $andcc = " and $cc" + } else { + $andcc = '' + } + # Prompt for editor, if no override is given editor: - - # Prompt for editor, if no override is given - if(! $::opt_e and ! $::opt_f and ! $::opt_b) { - paraprint <); - chop $entry; - - $usefile = 0; - if($entry eq "file") { - $usefile = 1; - } elsif($entry ne "") { - $ed = $entry; - } + my $entry = _prompt($description, "Editor", $ed); + $usefile = 0; + if ($entry eq "file") { + $usefile = 1; + } elsif ($entry ne "") { + $ed = $entry; } + } + if ($::HaveCoreList && !$ok && !$thanks) { + my $description = <first_release($entry); + if ($entry and not $first_release) { + paraprint <); - chop($entry); + if ($entry eq "") { + paraprint <:raw', $filename) or die "Unable to create report file '$filename': $!\n"; + binmode(REP, ':raw :crlf') if $Is_MSWin32; + + my $reptype = !$ok ? ($thanks ? 'thank-you' : 'bug') + : $opt{n} ? "build failure" : "success"; + + print REP <) { + print REP $_ } + close(F) or die "Error closing '$file': $!"; + } else { + if ($thanks) { + print REP <<'EOF'; +----------------------------------------------------------------- +[Please enter your thank-you message here] - # Generate report - - open(REP,">$filename"); - print REP <) { - print REP $_ - } - close(F); } else { - print REP <) { - s/\s+//g; - $REP{$_}++; - } - close(REP); + } + Dump(*REP); + close(REP) or die "Error closing report file: $!"; -} + # Set up an initial report fingerprint so we can compare it later + _fingerprint_lines_in_report(); + +} # sub Query sub Dump { - local(*OUT) = @_; - - print OUT <); - chop $entry; - - if($entry ne "") { - $ed = $entry; - } - } - -tryagain: - if(!$usefile and !$body) { - my $sts = system("$ed $filename"); - if($sts) { - #print "\nUnable to run editor!\n"; - paraprint <); - chop $entry; - - if($entry ne "") { - $ed = $entry; - goto tryagain; - } else { - - paraprint <) { - s/\s+//g; - $unseen++ if ($_ ne '' and not exists $REP{$_}); - } - - while ($unseen == 0) { - paraprint <); - if ($action =~ /^[re]/i) { # etry dit - goto tryagain; - } elsif ($action =~ /^[cq]/i) { # ancel, uit - Cancel(); - } + my $action = _prompt( $description, "Action (Retry/Cancel) " ); + if ( $action =~ /^[re]/i ) { # etry dit + next; + } elsif ( $action =~ /^[cq]/i ) { # ancel, uit + Cancel(); # cancel exits + } } + # Ok. the user did what they needed to; + return; + } } + sub Cancel { 1 while unlink($filename); # remove all versions under VMS - print "\nCancelling.\n"; + print "\nQuitting without sending your message.\n"; exit(0); } sub NowWhat { + # Report is done, prompt for further action + if( !$opt{S} ) { + while(1) { + my $menu = <); - chop $action; - - if( $action =~ /^(f|sa)/i ) { # ile/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() { print FILE } - close(REP); - close(FILE); - - print "\nMessage saved in `$file'.\n"; - exit; - - } elsif( $action =~ /^(d|l|sh)/i ) { # isplay, ist, ow - # Display the message - open(REP,"<$filename"); - while() { print $_ } - close(REP); - } elsif( $action =~ /^se/i ) { # end - # Send the message - print "\ -Are you certain you want to send this message? -Please type \"yes\" if you are: "; - my($reply) = scalar(); - chop($reply); - if( $reply eq "yes" ) { - last; - } else { - paraprint <dit, e-edit - # edit the message - Edit(); - #system("$ed $filename"); - } elsif( $action =~ /^[qc]/i ) { # ancel, uit - Cancel(); - } elsif( $action =~ /^s/ ) { - paraprint <ile/ve + if ( SaveMessage() ) { exit } + } elsif ($action =~ /^(d|l|sh)/i ) { # isplay, ist, ow + # Display the message + open(REP, '<:raw', $filename) or die "Couldn't open file '$filename': $!\n"; + binmode(REP, ':raw :crlf') if $Is_MSWin32; + while () { print $_ } + close(REP) or die "Error closing report file '$filename': $!"; + if ($have_attachment) { + print "\n\n---\nAttachment(s):\n"; + for my $att (split /\s*,\s*/, $attachments) { print " $att\n"; } + } + } elsif ($action =~ /^su/i) { # bject + my $reply = _prompt( "Subject: $subject", "If the above subject is fine, press Enter. Otherwise, type a replacement now\nSubject"); + if ($reply ne '') { + unless (TrivialSubject($reply)) { + $subject = $reply; + print "Subject: $subject\n"; + } + } + } elsif ($action =~ /^se/i) { # end + # Send the message + my $reply = _prompt( "Are you certain you want to send this message?", 'Please type "yes" if you are','no'); + if ($reply =~ /^yes$/) { + last; + } else { + paraprint <dit, e-edit + # edit the message + Edit(); + } elsif ($action =~ /^[qc]/i) { # ancel, uit + Cancel(); + } elsif ($action =~ /^s/i) { + paraprint < $subject, To => $address; - - $msg->cc($cc) if $cc; - $msg->add("Reply-To",$from) if $from; - - $fh = $msg->open; - - open(REP,"<$filename"); - while() { print $fh $_ } - close(REP); - - $fh->close; - - print "\nMessage sent.\n"; - } 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) { 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 $_; - } - - if ($^O eq 'os2' and $sendmail eq "") { - my $path = $ENV{PATH}; - $path =~ s:\\:/: ; - my @path = split /$Config{path_sep}/, $path; - for (@path) { - $sendmail = "$_/sendmail", last - if -e "$_/sendmail"; - $sendmail = "$_/sendmail.exe", last - if -e "$_/sendmail.exe"; - } - } - - paraprint <<"EOF", 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 inconvenience. - -So you may attempt to find some way of sending your message, it has -been left in the file `$filename'. + if ( my $error = $@ ) { + paraprint <) { print SENDMAIL $_ } - close(REP); - - if (close(SENDMAIL)) { - print "\nMessage sent.\n"; - } else { - warn "\nSendmail returned status '",$?>>8,"'\n"; - } - } - - } - - 1 while unlink($filename); # remove all versions under VMS + SaveMessage(); + return; + } -} + 1 while unlink($filename); # remove all versions under VMS +} # sub Send sub Help { - print < 1); + close($fh); + return $filename; + } else { + # Bah. Fall back to doing things less securely. + my $dir = File::Spec->tmpdir(); + $filename = "bugrep0$$"; + $filename++ while -e File::Spec->catfile($dir, $filename); + $filename = File::Spec->catfile($dir, $filename); + } +} + sub paraprint { my @paragraphs = split /\n{2,}/, "@_"; - print "\n\n"; for (@paragraphs) { # implicit local $_ - s/(\S)\s*\n/$1 /g; - write; - print "\n"; + s/(\S)\s*\n/$1 /g; + write; + print "\n"; + } +} + +sub _prompt { + my ($explanation, $prompt, $default) = (@_); + if ($explanation) { + print "\n\n"; + paraprint $explanation; + } + print $prompt. ($default ? " [$default]" :''). ": "; + my $result = scalar(<>); + chomp($result); + $result =~ s/^\s*(.*?)\s*$/$1/s; + if ($default && $result eq '') { + return $default; + } else { + return $result; + } +} + +sub _build_header { + my %attr = (@_); + + my $head = ''; + for my $header (keys %attr) { + $head .= "$header: ".$attr{$header}."\n"; + } + return $head; +} + +sub _message_headers { + my %headers = ( To => $address, Subject => $subject ); + $headers{'Cc'} = $cc if ($cc); + $headers{'Message-Id'} = $messageid if ($messageid); + $headers{'Reply-To'} = $from if ($from); + $headers{'From'} = $from if ($from); + if ($have_attachment) { + $headers{'MIME-Version'} = '1.0'; + $headers{'Content-Type'} = qq{multipart/mixed; boundary=\"$mime_boundary\"}; } - + return \%headers; } - + +sub _add_body_start { + my $body_start = <<"BODY_START"; +This is a multi-part message in MIME format. +--$mime_boundary +Content-Type: text/plain; format=fixed +Content-Transfer-Encoding: 8bit + +BODY_START + return $body_start; +} + +sub _add_attachments { + my $attach = ''; + for my $attachment (split /\s*,\s*/, $attachments) { + my $attach_file = basename($attachment); + $attach .= <<"ATTACHMENT"; + +--$mime_boundary +Content-Type: text/x-patch; name="$attach_file" +Content-Transfer-Encoding: 8bit +Content-Disposition: attachment; filename="$attach_file" + +ATTACHMENT + + open my $attach_fh, '<:raw', $attachment + or die "Couldn't open attachment '$attachment': $!\n"; + while (<$attach_fh>) { $attach .= $_; } + close($attach_fh) or die "Error closing attachment '$attachment': $!"; + } + + $attach .= "\n--$mime_boundary--\n"; + return $attach; +} + +sub build_complete_message { + my $content = _build_header(%{_message_headers()}) . "\n\n"; + $content .= _add_body_start() if $have_attachment; + open( REP, "<:raw", $filename ) or die "Couldn't open file '$filename': $!\n"; + binmode(REP, ':raw :crlf') if $Is_MSWin32; + while () { $content .= $_; } + close(REP) or die "Error closing report file '$filename': $!"; + $content .= _add_attachments() if $have_attachment; + return $content; +} + +sub save_message_to_disk { + my $file = shift; + + open OUTFILE, '>:raw', $file or do { warn "Couldn't open '$file': $!\n"; return undef}; + binmode(OUTFILE, ':raw :crlf') if $Is_MSWin32; + + print OUTFILE build_complete_message(); + close(OUTFILE) or do { warn "Error closing $file: $!"; return undef }; + print "\nMessage saved.\n"; + return 1; +} + +sub _send_message_vms { + + my $mail_from = $from; + my $rcpt_to_to = $address; + my $rcpt_to_cc = $cc; + + map { $_ =~ s/^[^<]*[^>]*//; } ($mail_from, $rcpt_to_to, $rcpt_to_cc); + + if ( open my $sff_fh, '|-:raw', 'MCR TCPIP$SYSTEM:TCPIP$SMTP_SFF.EXE SYS$INPUT:' ) { + print $sff_fh "MAIL FROM:<$mail_from>\n"; + print $sff_fh "RCPT TO:<$rcpt_to_to>\n"; + print $sff_fh "RCPT TO:<$rcpt_to_cc>\n" if $rcpt_to_cc; + print $sff_fh "DATA\n"; + print $sff_fh build_complete_message(); + my $success = close $sff_fh; + if ($success ) { + print "\nMessage sent\n"; + return; + } + } + die "Mail transport failed (leaving bug report in $filename): $^E\n"; +} + +sub _send_message_mailsend { + my $msg = Mail::Send->new(); + my %headers = %{_message_headers()}; + for my $key ( keys %headers) { + $msg->add($key => $headers{$key}); + } + + $fh = $msg->open; + binmode($fh, ':raw'); + print $fh _add_body_start() if $have_attachment; + open(REP, "<:raw", $filename) or die "Couldn't open '$filename': $!\n"; + binmode(REP, ':raw :crlf') if $Is_MSWin32; + while () { print $fh $_ } + close(REP) or die "Error closing $filename: $!"; + print $fh _add_attachments() if $have_attachment; + $fh->close or die "Error sending mail: $!"; + + print "\nMessage sent.\n"; +} + +sub _probe_for_sendmail { + my $sendmail = ""; + for (qw(/usr/lib/sendmail /usr/sbin/sendmail /usr/ucblib/sendmail)) { + $sendmail = $_, last if -e $_; + } + if ( $^O eq 'os2' and $sendmail eq "" ) { + my $path = $ENV{PATH}; + $path =~ s:\\:/:; + my @path = split /$Config{'path_sep'}/, $path; + for (@path) { + $sendmail = "$_/sendmail", last if -e "$_/sendmail"; + $sendmail = "$_/sendmail.exe", last if -e "$_/sendmail.exe"; + } + } + return $sendmail; +} + +sub _send_message_sendmail { + my $sendmail = _probe_for_sendmail(); + unless ($sendmail) { + my $message_start = !$Is_Linux && !$Is_OpenBSD ? <<'EOT' : <<'EOT'; +It appears that there is no program which looks like "sendmail" on +your system and that the Mail::Send library from CPAN isn't available. +EOT +It appears that there is no program which looks like "sendmail" on +your system. +EOT + paraprint(<<"EOF"), die "\n"; +$message_start +Because of this, there's no easy way to automatically send your +message. + +A copy of your message has been saved in '$filename' for you to +send to '$address' with your normal mail client. +EOF + } + + open( SENDMAIL, "|-:raw", $sendmail, "-t", "-oi", "-f", $from ) + || die "'|$sendmail -t -oi -f $from' failed: $!"; + print SENDMAIL build_complete_message(); + if ( close(SENDMAIL) ) { + print "\nMessage sent\n"; + } else { + warn "\nSendmail returned status '", $? >> 8, "'\n"; + } +} + + + +# a strange way to check whether any significant editing +# has been done: check whether any new non-empty lines +# have been added. + +sub _fingerprint_lines_in_report { + my $new_lines = 0; + # read in the report template once so that + # we can track whether the user does any editing. + # yes, *all* whitespace is ignored. + + open(REP, '<:raw', $filename) or die "Unable to open report file '$filename': $!\n"; + binmode(REP, ':raw :crlf') if $Is_MSWin32; + while (my $line = ) { + $line =~ s/\s+//g; + $new_lines++ if (!$REP{$line}); + + } + close(REP) or die "Error closing report file '$filename': $!"; + # returns the number of lines with content that wasn't there when last we looked + return $new_lines; +} + + format STDOUT = ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~ @@ -855,124 +1233,194 @@ perlbug - how to submit bug reports on Perl =head1 SYNOPSIS +B + B S<[ B<-v> ]> S<[ B<-a> I
]> S<[ B<-s> I ]> -S<[ B<-b> I | B<-f> I ]> S<[ B<-r> I ]> +S<[ B<-b> I | B<-f> I ]> S<[ B<-F> I ]> +S<[ B<-r> I ]> S<[ B<-e> I ]> S<[ B<-c> I | B<-C> ]> -S<[ B<-S> ]> S<[ B<-t> ]> S<[ B<-d> ]> S<[ B<-h> ]> +S<[ B<-S> ]> S<[ B<-t> ]> S<[ B<-d> ]> S<[ B<-A> ]> S<[ B<-h> ]> S<[ B<-T> ]> -B S<[ B<-r> I ]> B<-ok> +B S<[ B<-v> ]> S<[ B<-r> I ]> + S<[ B<-A> ]> S<[ B<-ok> | B<-okay> | B<-nok> | B<-nokay> ]> + +B =head1 DESCRIPTION -A program to help generate bug reports about perl or the modules that -come with it, and mail them. -If you have found a bug with a non-standard port (one that was not part -of the I), a binary distribution, or a -non-standard module (such as Tk, CGI, etc), then please see the -documentation that came with that distribution to determine the correct -place to report bugs. +This program is designed to help you generate and send bug reports +(and thank-you notes) about perl5 and the modules which ship with it. + +In most cases, you can just run it interactively from a command +line without any special arguments and follow the prompts. + +If you have found a bug with a non-standard port (one that was not +part of the I), a binary distribution, or a +non-core module (such as Tk, DBI, etc), then please see the +documentation that came with that distribution to determine the +correct place to report bugs. -C is designed to be used interactively. Normally no arguments -will be needed. Simply run it, and follow the prompts. +If you are unable to send your report using B (most likely +because your system doesn't have a way to send mail that perlbug +recognizes), you may be able to use this tool to compose your report +and save it to a file which you can then send to B +using your regular mail client. -If you are unable to run B (most likely because you don't have -a working setup to send mail that perlbug recognizes), you may have to -compose your own report, and email it to B. You might -find the B<-d> option useful to get summary information in that case. +In extreme cases, B may not work well enough on your system +to guide you through composing a bug report. In those cases, you +may be able to use B to get system configuration +information to include in a manually composed bug report to +B. -In any case, when reporting a bug, please make sure you have run through -this checklist: + +When reporting a bug, please run through this checklist: =over 4 -=item What version of perl you are running? +=item What version of Perl you are running? Type C at the command line to find out. =item Are you running the latest released version of perl? -Look at http://www.perl.com/ to find out. If it is not the latest -released version, get that one and see whether your bug has been -fixed. Note that bug reports about old versions of perl, especially -those prior to the 5.0 release, are likely to fall upon deaf ears. -You are on your own if you continue to use perl1 .. perl4. +Look at http://www.perl.org/ to find out. If you are not using the +latest released version, please try to replicate your bug on the +latest stable release. + +Note that reports about bugs in old versions of Perl, especially +those which indicate you haven't also tested the current stable +release of Perl, are likely to receive less attention from the +volunteers who build and maintain Perl than reports about bugs in +the current release. + +This tool isn't appropriate for reporting bugs in any version +prior to Perl 5.0. =item Are you sure what you have is a bug? -A significant number of the bug reports we get turn out to be documented -features in perl. Make sure the behavior you are witnessing doesn't fall -under that category, by glancing through the documentation that comes -with perl (we'll admit this is no mean task, given the sheer volume of -it all, but at least have a look at the sections that I relevant). +A significant number of the bug reports we get turn out to be +documented features in Perl. Make sure the issue you've run into +isn't intentional by glancing through the documentation that comes +with the Perl distribution. + +Given the sheer volume of Perl documentation, this isn't a trivial +undertaking, but if you can point to documentation that suggests +the behaviour you're seeing is I, your issue is likely to +receive more attention. You may want to start with B +L for pointers to common traps that new (and experienced) +Perl programmers run into. + +If you're unsure of the meaning of an error message you've run +across, B L for an explanation. If the message +isn't in perldiag, it probably isn't generated by Perl. You may +have luck consulting your operating system documentation instead. -Be aware of the familiar traps that perl programmers of various hues -fall into. See L. +If you are on a non-UNIX platform B L, as some +features may be unimplemented or work differently. -Try to study the problem under the perl debugger, if necessary. -See L. +You may be able to figure out what's going wrong using the Perl +debugger. For information about how to use the debugger B +L. =item Do you have a proper test case? The easier it is to reproduce your bug, the more likely it will be -fixed, because if no one can duplicate the problem, no one can fix it. -A good test case has most of these attributes: fewest possible number -of lines; few dependencies on external commands, modules, or -libraries; runs on most platforms unimpeded; and is self-documenting. +fixed -- if nobody can duplicate your problem, it probably won't be +addressed. + +A good test case has most of these attributes: short, simple code; +few dependencies on external commands, modules, or libraries; no +platform-dependent code (unless it's a platform-specific bug); +clear, simple documentation. + +A good test case is almost always a good candidate to be included in +Perl's test suite. If you have the time, consider writing your test case so +that it can be easily included into the standard test suite. -A good test case is almost always a good candidate to be on the perl -test suite. If you have the time, consider making your test case so -that it will readily fit into the standard test suite. +=item Have you included all relevant information? + +Be sure to include the B error messages, if any. +"Perl gave an error" is not an exact error message. + +If you get a core dump (or equivalent), you may use a debugger +(B, B, etc) to produce a stack trace to include in the bug +report. + +NOTE: unless your Perl has been compiled with debug info +(often B<-g>), the stack trace is likely to be somewhat hard to use +because it will most probably contain only the function names and not +their arguments. If possible, recompile your Perl with debug info and +reproduce the crash and the stack trace. =item Can you describe the bug in plain English? -The easier it is to understand a reproducible bug, the more likely it -will be fixed. Anything you can provide by way of insight into the -problem helps a great deal. In other words, try to analyse the -problem to the extent you feel qualified and report your discoveries. +The easier it is to understand a reproducible bug, the more likely +it will be fixed. Any insight you can provide into the problem +will help a great deal. In other words, try to analyze the problem +(to the extent you can) and report your discoveries. =item Can you fix the bug yourself? -A bug report which I will almost -definitely be fixed. Use the C program to generate your patches -(C is being maintained by the GNU folks as part of the B -package, so you should be able to get it from any of the GNU software -repositories). If you do submit a patch, the cool-dude counter at -perlbug@perl.com will register you as a savior of the world. Your -patch may be returned with requests for changes, or requests for more +If so, that's great news; bug reports with patches are likely to +receive significantly more attention and interest than those without +patches. Please attach your patch to the report using the C<-p> option. +When sending a patch, create it using C if possible, +though a unified diff created with C will do nearly as well. + +Your patch may be returned with requests for changes, or requests for more detailed explanations about your fix. -Here are some clues for creating quality patches: Use the B<-c> or -B<-u> switches to the diff program (to create a so-called context or -unified diff). Make sure the patch is not reversed (the first -argument to diff is typically the original file, the second argument -your changed file). Make sure you test your patch by applying it with -the C program before you send it on its way. Try to follow the +Here are a few hints for creating high-quality patches: + +Make sure the patch is not reversed (the first argument to diff is +typically the original file, the second argument your changed file). +Make sure you test your patch by applying it with C or the +C program before you send it on its way. Try to follow the same style as the code you are trying to patch. Make sure your patch -really does work (C, if the thing you're patching supports -it). +really does work (C, if the thing you're patching is covered +by Perl's test suite). =item Can you use C to submit the report? B will, amongst other things, ensure your report includes -crucial information about your version of perl. If C is unable -to mail your report after you have typed it in, you may have to compose -the message yourself, add the output produced by C and email -it to B. If, for some reason, you cannot run -C at all on your system, be sure to include the entire output -produced by running C (note the uppercase V). +crucial information about your version of perl. If C is +unable to mail your report after you have typed it in, you may have +to compose the message yourself, add the output produced by C and email it to B. If, for some reason, you +cannot run C at all on your system, be sure to include the +entire output produced by running C (note the uppercase V). + +Whether you use C or send the email manually, please make +your Subject line informative. "a bug" is not informative. Neither +is "perl crashes" nor is "HELP!!!". These don't help. A compact +description of what's wrong is fine. + +=item Can you use C to submit a thank-you note? + +Yes, you can do this by either using the C<-T> option, or by invoking +the program as C. Thank-you notes are good. It makes people +smile. =back -Having done your bit, please be prepared to wait, to be told the bug -is in your code, or even to get no reply at all. The perl maintainers -are busy folks, so if your problem is a small one or if it is -difficult to understand, they may not respond with a personal reply. +Having done your bit, please be prepared to wait, to be told the +bug is in your code, or possibly to get no reply at all. The +volunteers who maintain Perl are busy folks, so if your problem is +an obvious bug in your own code, is difficult to understand or is +a duplicate of an existing report, you may not receive a personal +reply. + If it is important to you that your bug be fixed, do monitor the -C file in any development releases since the time you submitted -the bug, and encourage the maintainers with kind words (but never any -flames!). Feel free to resend your bug report if the next released -version of perl comes out and your bug is still present. +perl5-porters@perl.org mailing list (mailing lists are moderated, your +message may take a while to show up) and the commit logs to development +versions of Perl, and encourage the maintainers with kind words or +offers of frosty beverages. (Please do be kind to the maintainers. +Harassing or flaming them is likely to have the opposite effect of the +one you want.) + +Feel free to update the ticket about your bug on http://rt.perl.org +if a new version of Perl is released and your bug is still present. =head1 OPTIONS @@ -980,7 +1428,14 @@ version of perl comes out and your bug is still present. =item B<-a> -Address to send the report to. Defaults to `perlbug@perl.com'. +Address to send the report to. Defaults to B. + +=item B<-A> + +Don't send a bug received acknowledgement to the reply address. +Generally it is only a sensible to use this option if you are a +perl maintainer actively watching perl porters for your message to +arrive. =item B<-b> @@ -1004,23 +1459,55 @@ with B<-v> to get more complete data. =item B<-e> -Editor to use. +Editor to use. =item B<-f> File containing the body of the report. Use this to quickly send a prepared message. +=item B<-F> + +File to output the results to instead of sending as an email. Useful +particularly when running perlbug on a machine with no direct internet +connection. + =item B<-h> Prints a brief summary of the options. =item B<-ok> -Report successful build on this system to perl porters. Forces B<-S>, -B<-C>, and B<-v>. Forces and supplies values for B<-s> and B<-b>. Only +Report successful build on this system to perl porters. Forces B<-S> +and B<-C>. Forces and supplies values for B<-s> and B<-b>. Only prompts for a return address if it cannot guess it (for use with -B). Honors return address specified with B<-r>. +B). Honors return address specified with B<-r>. You can use this +with B<-v> to get more complete data. Only makes a report if this +system is less than 60 days old. + +=item B<-okay> + +As B<-ok> except it will report on older systems. + +=item B<-nok> + +Report unsuccessful build on this system. Forces B<-C>. Forces and +supplies a value for B<-s>, then requires you to edit the report +and say what went wrong. Alternatively, a prepared report may be +supplied using B<-f>. Only prompts for a return address if it +cannot guess it (for use with B). Honors return address +specified with B<-r>. You can use this with B<-v> to get more +complete data. Only makes a report if this system is less than 60 +days old. + +=item B<-nokay> + +As B<-nok> except it will report on older systems. + +=item B<-p> + +The names of one or more patch files or other text attachments to be +included with the report. Multiple files must be separated with commas. =item B<-r> @@ -1038,7 +1525,11 @@ supply one on the command line. =item B<-t> -Test mode. The target address defaults to `perlbug-test@perl.com'. +Test mode. The target address defaults to B. + +=item B<-T> + +Send a thank-you note instead of a bug report. =item B<-v> @@ -1048,14 +1539,21 @@ Include verbose configuration data in the report. =head1 AUTHORS -Kenneth Albanowski (Ekjahds@kjahds.comE), subsequently Itored -by Gurusamy Sarathy (Egsar@umich.eduE), Tom Christiansen -(Etchrist@perl.comE), Nathan Torkington (Egnat@frii.comE), -and Charles F. Randall (Ecfr@pobox.comE). +Kenneth Albanowski (Ekjahds@kjahds.comE), subsequently +Itored by Gurusamy Sarathy (Egsar@activestate.comE), +Tom Christiansen (Etchrist@perl.comE), Nathan Torkington +(Egnat@frii.comE), Charles F. Randall (Ecfr@pobox.comE), +Mike Guy (Emjtg@cam.ac.ukE), Dominic Dunlop +(Edomo@computer.orgE), Hugo van der Sanden (Ehv@crypt.orgE), +Jarkko Hietaniemi (Ejhi@iki.fiE), Chris Nandor +(Epudge@pobox.comE), Jon Orwant (Eorwant@media.mit.eduE, +Richard Foley (Erichard.foley@rfi.netE), Jesse Vincent +(Ejesse@bestpractical.comE), and Craig A. Berry (Ecraigberry@mac.comE). =head1 SEE ALSO -perl(1), perldebug(1), perltrap(1), diff(1), patch(1) +perl(1), perldebug(1), perldiag(1), perlport(1), perltrap(1), +diff(1), patch(1), dbx(1), gdb(1) =head1 BUGS @@ -1068,4 +1566,4 @@ None known (guess what must have been used to report them?) 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 ':'; - +chdir $origdir;