4 use File::Basename qw(&basename &dirname);
6 use File::Spec::Functions;
8 # List explicitly here the variables you want Configure to
9 # generate. Metaconfig only looks for shell variables, so you
10 # have to mention them as if they were shell variables, not
11 # %Config entries. Thus you write
13 # to ensure Configure will look for $Config{startperl}.
16 # This forces PL files to create target in same directory as PL file.
17 # This is so that make depend always knows where to find PL derivatives.
20 $file = basename($0, '.PL');
21 $file .= '.com' if $^O eq 'VMS';
23 open OUT, ">$file" or die "Can't create $file: $!";
25 # extract patchlevel.h information
27 open PATCH_LEVEL, "<" . catfile(updir, "patchlevel.h")
28 or die "Can't open patchlevel.h: $!";
30 my $patchlevel_date = (stat PATCH_LEVEL)[9];
32 while (<PATCH_LEVEL>) {
33 last if $_ =~ /^\s*static\s+(?:const\s+)?char.*?local_patches\[\]\s*=\s*{\s*$/;
37 warn "Warning: local_patches section not found in patchlevel.h\n";
41 while (<PATCH_LEVEL>) {
43 next if /^\s*#/; # preprocessor stuff
48 push @patches, $_ unless $_ eq 'NULL';
50 my $patch_desc = "'" . join("',\n '", @patches) . "'";
51 my $patch_tags = join "", map /(\S+)/ ? "+$1 " : (), @patches;
53 close(PATCH_LEVEL) or die "Error closing patchlevel.h: $!";
55 # TO DO (prehaps): store/embed $Config::config_sh into perlbug. When perlbug is
56 # used, compare $Config::config_sh with the stored version. If they differ then
57 # append a list of individual differences to the bug report.
60 print "Extracting $file (with variable substitutions)\n";
62 # In this section, perl variables will be expanded during extraction.
63 # You can use $Config{...} to use Configure variables.
65 my $extract_version = sprintf("%vd", $^V);
67 print OUT <<"!GROK!THIS!";
69 eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
70 if \$running_under_some_shell;
72 my \$config_tag1 = '$extract_version - $Config{cf_time}';
74 my \$patchlevel_date = $patchlevel_date;
75 my \$patch_tags = '$patch_tags';
81 # In the following, perl variables are not expanded during extraction.
83 print OUT <<'!NO!SUBS!';
86 no warnings 'once'; # Eventually, the $::opt_ stuff should get cleaned up
89 use File::Spec; # keep perlbug Perl 5.005 compatible
91 use File::Basename 'basename';
96 eval { require Mail::Send;};
97 $::HaveSend = ($@ eq "");
98 eval { require Mail::Util; } ;
99 $::HaveUtil = ($@ eq "");
100 # use secure tempfiles wherever possible
101 eval { require File::Temp; };
102 $::HaveTemp = ($@ eq "");
103 eval { require Module::CoreList; };
104 $::HaveCoreList = ($@ eq "");
107 my $Version = "1.39";
109 # Changed in 1.06 to skip Mail::Send and Mail::Util if not available.
110 # Changed in 1.07 to see more sendmail execs, and added pipe output.
111 # Changed in 1.08 to use correct address for sendmail.
112 # Changed in 1.09 to close the REP file before calling it up in the editor.
113 # Also removed some old comments duplicated elsewhere.
114 # Changed in 1.10 to run under VMS without Mail::Send; also fixed
115 # temp filename generation.
116 # Changed in 1.11 to clean up some text and removed Mail::Send deactivator.
117 # Changed in 1.12 to check for editor errors, make save/send distinction
118 # clearer and add $ENV{REPLYTO}.
119 # Changed in 1.13 to hopefully make it more difficult to accidentally
121 # Changed in 1.14 to make the prompts a little more clear on providing
122 # helpful information. Also let file read fail gracefully.
123 # Changed in 1.15 to add warnings to stop people using perlbug for non-bugs.
124 # Also report selected environment variables.
125 # Changed in 1.16 to include @INC, and allow user to re-edit if no changes.
126 # Changed in 1.17 Win32 support added. GSAR 97-04-12
127 # Changed in 1.18 add '-ok' option for reporting build success. CFR 97-06-18
128 # Changed in 1.19 '-ok' default not '-v'
129 # add local patch information
130 # warn on '-ok' if this is an old system; add '-okay'
131 # Changed in 1.20 Added patchlevel.h reading and version/config checks
132 # Changed in 1.21 Added '-nok' for reporting build failure DFD 98-05-05
133 # Changed in 1.22 Heavy reformatting & minor bugfixes HVDS 98-05-10
134 # Changed in 1.23 Restore -ok(ay): say 'success'; don't prompt
135 # Changed in 1.24 Added '-F<file>' to save report HVDS 98-07-01
136 # Changed in 1.25 Warn on failure to open save file. HVDS 98-07-12
137 # Changed in 1.26 Don't require -t STDIN for -ok. HVDS 98-07-15
138 # Changed in 1.27 Added Mac OS and File::Spec support CNANDOR 99-07-27
139 # Changed in 1.28 Additional questions for Perlbugtron RFOLEY 20.03.2000
140 # Changed in 1.29 Perlbug(tron): auto(-ok), short prompts RFOLEY 05-05-2000
141 # Changed in 1.30 Added warnings on failure to open files MSTEVENS 13-07-2000
142 # Changed in 1.31 Add checks on close().Fix my $var unless. TJENNESS 26-07-2000
143 # Changed in 1.32 Use File::Spec->tmpdir TJENNESS 20-08-2000
144 # Changed in 1.33 Don't require -t STDOUT for -ok.
145 # Changed in 1.34 Added Message-Id RFOLEY 18-06-2002
146 # Changed in 1.35 Use File::Temp (patch from Solar Designer) NWCLARK 28-02-2004
147 # Changed in 1.36 Initial Module::CoreList support Alexandr Ciornii 11-07-2007
148 # Changed in 1.37 Killed some string evals, rewrote most prose JESSE 2008-06-08
149 # Changed in 1.38 Actually enforce the CoreList check,
150 # Record the module the user enters if they do so
151 # Refactor prompts to use common code JESSE 2008-06-08
152 # Changed in 1.39 Trap mail sending failures (simple ones) so JESSE 2008-06-08
153 # users might be able to recover their bug reports
154 # Refactor mail sending routines
155 # Unify message building code
156 # Unify message header building
157 # Fix "module" prompting to not squish "category" prompting
158 # use warnings; (except 'once' warnings)
159 # Unified report fingerprint/change detection code
160 # Removed some labeled 'gotos'
162 # make sure failure (transmission-wise) of Mail::Send is accounted for.
163 # (This may work now. Unsure of the original author's issue -JESSE 2008-06-08)
166 my( $file, $usefile, $cc, $address, $bugaddress, $testaddress, $thanksaddress,
167 $filename, $messageid, $domain, $subject, $from, $verbose, $ed, $outfile,
168 $fh, $me, $body, $andcc, %REP, $ok, $thanks, $progname,
169 $Is_MacOS, $Is_MSWin32, $Is_Linux, $Is_VMS, $Is_OpenBSD,
170 $report_about_module, $category, $severity,
174 my $perl_version = $^V ? sprintf("%vd", $^V) : $];
176 my $config_tag2 = "$perl_version - $Config{cf_time}";
180 if ($::opt_h) { Help(); exit; }
181 if ($::opt_d) { Dump(*STDOUT); exit; }
182 if (!-t STDIN && !($ok and not $::opt_n)) {
184 Please use $progname interactively. If you want to
185 include a file, you can use the -f switch.
191 Edit() unless $usefile || ($ok and not $::opt_n);
194 save_message_to_disk($outfile);
197 print "\nThank you for taking the time to file a bug report!\n\n";
202 sub ask_for_alternatives { # (category|severity)
208 # Inevitably some of these will end up in RT whatever we do:
209 'thanks' => 'thanks',
210 'opts' => [qw(core docs install library utilities)], # patch, notabug
216 'opts' => [qw(critical high medium low wishlist none)], # zero
219 die "Invalid alternative ($name) requested\n" unless grep(/^$name$/, keys %alts);
221 my $what = $ok || $thanks;
223 $alt = $alts{$name}{$what};
225 my @alts = @{$alts{$name}{'opts'}};
228 Please pick a $name from the following list:
235 die "Invalid $name: aborting.\n";
237 $alt = _prompt('', "\u$name", $alts{$name}{'default'});
238 $alt ||= $alts{$name}{'default'};
239 } while !((($alt) = grep(/^$alt/i, @alts)));
245 # -------- Setup --------
247 $Is_MSWin32 = $^O eq 'MSWin32';
248 $Is_VMS = $^O eq 'VMS';
249 $Is_Linux = lc($^O) eq 'linux';
250 $Is_OpenBSD = lc($^O) eq 'openbsd';
251 $Is_MacOS = $^O eq 'MacOS';
253 @ARGV = split m/\s+/,
254 MacPerl::Ask('Provide command line args here (-h for help):')
255 if $Is_MacOS && $MacPerl::Version =~ /App/;
257 if (!getopts("Adhva:s:b:f:F:r:e:SCc:to:n:T")) { Help(); exit; };
259 # This comment is needed to notify metaconfig that we are
260 # using the $perladmin, $cf_by, and $cf_time definitions.
262 # -------- Configuration ---------
265 $bugaddress = 'perlbug@perl.org';
268 $testaddress = 'perlbug-test@perl.org';
271 $thanksaddress = 'perl-thanks@perl.org';
273 if (basename ($0) =~ /^perlthanks/i) {
274 # invoked as perlthanks
276 $::opt_C = 1; # don't send a copy to the local admin
283 $progname = $thanks ? 'perlthanks' : 'perlbug';
285 $address = $::opt_a || ($::opt_t ? $testaddress
286 : $thanks ? $thanksaddress : $bugaddress);
288 # Users address, used in message and in Reply-To header
289 $from = $::opt_r || "";
291 # Include verbose configuration information
292 $verbose = $::opt_v || 0;
294 # Subject of bug-report message
295 $subject = $::opt_s || "";
298 $usefile = ($::opt_f || 0);
300 # File to send as report
301 $file = $::opt_f || "";
304 $outfile = $::opt_F || "";
307 $body = $::opt_b || "";
310 $ed = $::opt_e || $ENV{VISUAL} || $ENV{EDITOR} || $ENV{EDIT}
311 || ($Is_VMS && "edit/tpu")
312 || ($Is_MSWin32 && "notepad")
316 # Not OK - provide build failure template by finessing OK report
318 if (substr($::opt_n, 0, 2) eq 'ok' ) {
319 $::opt_o = substr($::opt_n, 1);
326 # OK - send "OK" report for build on this system
329 if ($::opt_o eq 'k' or $::opt_o eq 'kay') {
330 my $age = time - $patchlevel_date;
331 if ($::opt_o eq 'k' and $age > 60 * 24 * 60 * 60 ) {
332 my $date = localtime $patchlevel_date;
334 "perlbug -ok" and "perlbug -nok" do not report on Perl versions which
335 are more than 60 days old. This Perl version was constructed on
336 $date. If you really want to report this, use
337 "perlbug -okay" or "perlbug -nokay".
341 # force these options
343 $::opt_S = 1; # don't prompt for send
344 $::opt_b = 1; # we have a body
345 $body = "Perl reported to build OK on this system.\n";
347 $::opt_C = 1; # don't send a copy to the local admin
348 $::opt_s = 1; # we have a subject line
349 $subject = ($::opt_n ? 'Not ' : '')
350 . "OK: perl $perl_version ${patch_tags}on"
351 ." $::Config{'archname'} $::Config{'osvers'} $subject";
359 # Possible administrator addresses, in order of confidence
360 # (Note that cf_email is not mentioned to metaconfig, since
361 # we don't really want it. We'll just take it if we have to.)
363 # This has to be after the $ok stuff above because of the way
364 # that $::opt_C is forced.
365 $cc = $::opt_C ? "" : (
366 $::opt_c || $::Config{'perladmin'}
367 || $::Config{'cf_email'} || $::Config{'cf_by'}
371 $domain = Mail::Util::maildomain();
372 } elsif ($Is_MSWin32) {
373 $domain = $ENV{'USERDOMAIN'};
375 require Sys::Hostname;
376 $domain = Sys::Hostname::hostname();
380 $messageid = "<$::Config{'version'}_${$}_".time."\@$domain>";
383 $me = $Is_MSWin32 ? $ENV{'USERNAME'}
384 : $^O eq 'os2' ? $ENV{'USER'} || $ENV{'LOGNAME'}
385 : $Is_MacOS ? $ENV{'USER'}
386 : eval { getpwuid($<) }; # May be missing
388 $from = $::Config{'cf_email'}
389 if !$from && $::Config{'cf_email'} && $::Config{'cf_by'} && $me &&
390 ($me eq $::Config{'cf_by'});
394 # Explain what perlbug is
398 This program provides an easy way to send a thank-you message back to the
399 authors and maintainers of perl.
401 If you wish to submit a bug report, please run it without the -T flag
402 (or run the program perlbug rather than perlthanks)
406 This program provides an easy way to create a message reporting a
407 bug in the core perl distribution (along with tests or patches)
408 to the volunteers who maintain perl at $address. To send a thank-you
409 note to $thanksaddress instead of a bug report, please run 'perlthanks'.
411 Please do not use $0 to send test messages, test whether perl
412 works, or to report bugs in perl modules from CPAN.
414 For help using perl, try posting to the Usenet newsgroup
420 # Prompt for subject of message, if needed
422 if ($subject && TrivialSubject($subject)) {
428 "First of all, please provide a subject for the message.\n";
431 This should be a concise description of your bug or problem
432 which will help the volunteers working to improve perl to categorize
433 and resolve the issue. Be as specific and descriptive as
434 you can. A subject like "perl bug" or "perl problem" will make it
435 much less likely that your issue gets the attention it deserves.
441 $subject = _prompt('','Subject');
444 $subject = 'Thanks for Perl';
449 } while (TrivialSubject($subject));
452 # Prompt for return address, if needed
454 # Try and guess return address
457 $guess = $ENV{'REPLY-TO'} || $ENV{'REPLYTO'} || '';
459 require Mac::InternetConfig;
460 $guess = $Mac::InternetConfig::InternetConfig{
461 Mac::InternetConfig::kICEmail()
466 # move $domain to where we can use it elsewhere
468 if ($Is_VMS && !$::Config{'d_socket'}) {
469 $guess = "$domain\:\:$me";
471 $guess = "$me\@$domain" if $domain;
479 Perl's developers may need your email address to contact you for
480 further information about your issue or to inform you when it is
481 resolved. If the default shown is not your email address, please
487 Please enter your full internet email address so that Perl's
488 developers can contact you with questions about your issue or to
489 inform you that it has been resolved.
498 $from = _prompt('','Your address',$guess);
499 $from = $guess if $from eq '';
503 if ($from eq $cc or $me eq $cc) {
504 # Try not to copy ourselves
508 # Prompt for administrator address, unless an override was given
509 if( !$::opt_C and !$::opt_c ) {
510 my $description = <<EOF;
511 $0 can send a copy of this report to your local perl
512 administrator. If the address below is wrong, please correct it,
513 or enter 'none' or 'yourself' to not send a copy.
515 my $entry = _prompt($description, "Local perl administrator", $cc);
519 $cc = '' if $me eq $cc;
523 $cc = '' if $cc =~ /^(none|yourself|me|myself|ourselves)$/i;
530 # Prompt for editor, if no override is given
532 unless ($::opt_e || $::opt_f || $::opt_b) {
536 chomp (my $common_end = <<"EOF");
537 You will probably want to use a text editor to enter the body of
538 your report. If "$ed" is the editor you want to use, then just press
539 Enter, otherwise type in the name of the editor you would like to
542 If you have already composed the body of your report, you may enter
543 "file", and $0 will prompt you to enter the name of the file
544 containing your report.
548 $description = <<"EOF";
549 It's now time to compose your thank-you message.
551 Some information about your local perl configuration will automatically
552 be included at the end of your message, because we're curious about
553 the different ways that people build and use perl. If you'd rather
554 not share this information, you're welcome to delete it.
559 $description = <<"EOF";
560 It's now time to compose your bug report. Try to make the report
561 concise but descriptive. Please include any detail which you think
562 might be relevant or might help the volunteers working to improve
563 perl. If you are reporting something that does not work as you think
564 it should, please try to include examples of the actual result and of
567 Some information about your local perl configuration will automatically
568 be included at the end of your report. If you are using an unusual
569 version of perl, it would be useful if you could confirm that you
570 can replicate the problem on a standard build of perl as well.
576 my $entry = _prompt($description, "Editor", $ed);
578 if ($entry eq "file") {
580 } elsif ($entry ne "") {
584 if ($::HaveCoreList && !$ok && !$thanks) {
585 my $description = <<EOF;
586 If your bug is about a Perl module rather than a core language
587 feature, please enter its name here. If it's not, just hit Enter
588 to skip this question.
592 while ($entry eq '') {
593 $entry = _prompt($description, 'Module');
594 my $first_release = Module::CoreList->first_release($entry);
595 if ($entry and not $first_release) {
597 $entry is not a "core" Perl module. Please check that you entered
598 its name correctly. If it is correct, quit this program, try searching
599 for $entry on http://rt.cpan.org, and report your issue there.
604 $category ||= 'library';
605 $report_about_module = $entry;
613 # Prompt for category of bug
614 $category ||= ask_for_alternatives('category');
616 # Prompt for severity of bug
617 $severity ||= ask_for_alternatives('severity');
619 # Generate scratch file to edit report in
620 $filename = filename();
622 # Prompt for file to read report from, if needed
623 if ($usefile and !$file) {
625 my $description = <<EOF;
626 What is the name of the file that contains your report?
628 my $entry = _prompt($description, "Filename");
632 It seems you didn't enter a filename. Please choose to use a text
633 editor or enter a filename.
638 unless (-f $entry and -r $entry) {
640 '$entry' doesn't seem to be a readable file. You may have mistyped
641 its name or may not have permission to read it.
643 If you don't want to use a file as the content of your report, just
644 hit Enter and you'll be able to select a text editor instead.
652 open(REP,">$filename") or die "Unable to create report file '$filename': $!\n";
653 my $reptype = !$ok ? ($thanks ? 'thank-you' : 'bug')
654 : $::opt_n ? "build failure" : "success";
657 This is a $reptype report for perl from $from,
658 generated with the help of perlbug $Version running under perl $perl_version.
666 or die "Unable to read report file from '$file': $!\n";
670 close(F) or die "Error closing '$file': $!";
675 -----------------------------------------------------------------
676 [Please enter your thank-you message here]
680 [You're welcome to delete anything below this line]
681 -----------------------------------------------------------------
686 -----------------------------------------------------------------
687 [Please describe your issue here]
691 [Please do not change anything below this line]
692 -----------------------------------------------------------------
697 close(REP) or die "Error closing report file: $!";
699 # Set up an initial report fingerprint so we can compare it later
700 _fingerprint_lines_in_report();
714 if ($report_about_module ) {
716 module=$report_about_module
727 print OUT "This perlbug was built using Perl $config_tag1\n",
728 "It is being executed now by Perl $config_tag2.\n\n"
729 if $config_tag2 ne $config_tag1;
732 Site configuration information for perl $perl_version:
735 if ($::Config{cf_by} and $::Config{cf_time}) {
736 print OUT "Configured by $::Config{cf_by} at $::Config{cf_time}.\n\n";
738 print OUT Config::myconfig;
741 print OUT join "\n ", "Locally applied patches:", @patches;
748 \@INC for perl $perl_version:
757 Environment for perl $perl_version:
760 qw(PATH LD_LIBRARY_PATH LANG PERL_BADLANG SHELL HOME LOGDIR LANGUAGE);
761 push @env, $Config{ldlibpthname} if $Config{ldlibpthname} ne '';
762 push @env, grep /^(?:PERL|LC_|LANG|CYGWIN)/, keys %ENV;
765 for my $env (sort keys %env) {
767 exists $ENV{$env} ? "=$ENV{$env}" : ' (unset)',
771 print OUT "\nComplete configuration data for perl $perl_version:\n\n";
773 foreach (sort keys %::Config) {
774 $value = $::Config{$_};
776 print OUT "$_='$value'\n";
783 if ($usefile || $body) {
784 my $description = "Please make sure that the name of the editor you want to use is correct.";
785 my $entry = _prompt($description, 'Editor', $ed);
786 $ed = $entry unless $entry eq '';
795 my $report_written = 0;
797 while ( !$report_written ) {
799 require ExtUtils::MakeMaker;
800 ExtUtils::MM_MacOS::launch_file($filename);
801 _prompt('', "Press Enter when done." );
802 } else { # we're not on oldschool mac os
803 my $exit_status = system("$editor $filename");
806 The editor you chose ('$editor') could not be run!
808 If you mistyped its name, please enter it now, otherwise just press Enter.
810 my $entry = _prompt( $desc, 'Editor', $editor );
811 if ( $entry ne "" ) {
816 You may want to save your report to a file, so you can edit and
823 return if ( $ok and not $::opt_n ) || $body;
825 # Check that we have a report that has some, eh, report in it.
827 unless ( _fingerprint_lines_in_report() ) {
828 my $description = <<EOF;
829 It looks like you didn't enter a report. You may [r]etry your edit
830 or [c]ancel this report.
832 my $action = _prompt( $description, "Action (Retry/Cancel) " );
833 if ( $action =~ /^[re]/i ) { # <R>etry <E>dit
835 } elsif ( $action =~ /^[cq]/i ) { # <C>ancel, <Q>uit
836 Cancel(); # cancel exits
839 # Ok. the user did what they needed to;
847 1 while unlink($filename); # remove all versions under VMS
848 print "\nQuitting without sending your message.\n";
853 # Report is done, prompt for further action
859 You have finished composing your message. At this point, you have
860 a few options. You can:
862 * [Se]end the message to $address$andcc,
863 * [D]isplay the message on the screen,
864 * [R]e-edit the message
865 * Display or change the message's [su]bject
866 * Save the message to a [f]ile to mail at another time
867 * [Q]uit without sending a message
872 my $action = _prompt('', "Action (Send/Display/Edit/Subject/Save to File)");;
874 if ($action =~ /^(f|sa)/i) { # <F>ile/<Sa>ve
875 if ( SaveMessage() ) { exit }
876 } elsif ($action =~ /^(d|l|sh)/i ) { # <D>isplay, <L>ist, <Sh>ow
877 # Display the message
878 open(REP, "<$filename") or die "Couldn't open file '$filename': $!\n";
879 while (<REP>) { print $_ }
880 close(REP) or die "Error closing report file '$filename': $!";
881 } elsif ($action =~ /^su/i) { # <Su>bject
882 my $reply = _prompt( "Subject: $subject", "If the above subject is fine, press Enter. Otherwise, type a replacement now\nSubject");
884 unless (TrivialSubject($reply)) {
886 print "Subject: $subject\n";
889 } elsif ($action =~ /^se/i) { # <S>end
891 my $reply = _prompt( "Are you certain you want to send this message?", 'Please type "yes" if you are','no');
892 if ($reply =~ /^yes$/) {
896 You didn't type "yes", so your message has not yet been sent.
899 } elsif ($action =~ /^[er]/i) { # <E>dit, <R>e-edit
902 } elsif ($action =~ /^[qc]/i) { # <C>ancel, <Q>uit
904 } elsif ($action =~ /^s/i) {
906 The command you entered was ambiguous. Please type "send", "save" or "subject".
916 /^(y(es)?|no?|help|perl( (bug|problem))?|bug|problem)$/i ||
917 length($subject) < 4 ||
919 print "\nThe subject you entered wasn't very descriptive. Please try again.\n\n";
927 my $file_save = $outfile || "$progname.rep";
928 my $file = _prompt( '', "Name of file to save message in", $file_save );
929 save_message_to_disk($file) || return undef;
932 A copy of your message has been saved in '$file' for you to
933 send to '$address' with your normal mail client.
939 # Message has been accepted for transmission -- Send the message
941 # on linux certain "mail" implementations won't accept the subject
942 # as "~s subject" and thus the Subject header will be corrupted
943 # so don't use Mail::Send to be safe
945 if ( $::HaveSend && !$Is_Linux && !$Is_OpenBSD ) {
946 _send_message_mailsend();
950 _send_message_sendmail();
954 if ( my $error = $@ ) {
956 $0 has detected an error while trying to send your message: $error.
958 Your message may not have been sent. You will now have a chance to save a copy to disk.
964 1 while unlink($filename); # remove all versions under VMS
970 This program is designed to help you generate and send bug reports
971 (and thank-you notes) about perl5 and the modules which ship with it.
973 In most cases, you can just run "$0" interactively from a command
974 line without any special arguments and follow the prompts.
978 $0 [-v] [-a address] [-s subject] [-b body | -f inpufile ] [ -F outputfile ]
979 [-r returnaddress] [-e editor] [-c adminaddress | -C] [-S] [-t] [-h]
980 $0 [-v] [-r returnaddress] [-A] [-ok | -okay | -nok | -nokay]
985 -v Include Verbose configuration data in the report
986 -f File containing the body of the report. Use this to
987 quickly send a prepared message.
988 -F File to output the resulting mail message to, instead of mailing.
989 -S Send without asking for confirmation.
990 -a Address to send the report to. Defaults to '$address'.
991 -c Address to send copy of report to. Defaults to '$cc'.
992 -C Don't send copy to administrator.
993 -s Subject to include with the message. You will be prompted
994 if you don't supply one on the command line.
995 -b Body of the report. If not included on the command line, or
996 in a file with -f, you will get a chance to edit the message.
997 -r Your return address. The program will ask you to confirm
998 this if you don't give it here.
1000 -t Test mode. The target address defaults to '$testaddress'.
1001 -T Thank-you mode. The target address defaults to '$thanksaddress'.
1002 -d Data mode. This prints out your configuration data, without mailing
1003 anything. You can use this with -v to get more complete data.
1004 -A Don't send a bug received acknowledgement to the return address.
1005 -ok Report successful build on this system to perl porters
1006 (use alone or with -v). Only use -ok if *everything* was ok:
1007 if there were *any* problems at all, use -nok.
1008 -okay As -ok but allow report from old builds.
1009 -nok Report unsuccessful build on this system to perl porters
1010 (use alone or with -v). You must describe what went wrong
1011 in the body of the report which you will be asked to edit.
1012 -nokay As -nok but allow report from old builds.
1013 -h Print this help message.
1020 # Good. Use a secure temp file
1021 my ($fh, $filename) = File::Temp::tempfile(UNLINK => 1);
1025 # Bah. Fall back to doing things less securely.
1026 my $dir = File::Spec->tmpdir();
1027 $filename = "bugrep0$$";
1028 $filename++ while -e File::Spec->catfile($dir, $filename);
1029 $filename = File::Spec->catfile($dir, $filename);
1034 my @paragraphs = split /\n{2,}/, "@_";
1035 for (@paragraphs) { # implicit local $_
1043 my ($explanation, $prompt, $default) = (@_);
1046 paraprint $explanation;
1048 print $prompt. ($default ? " [$default]" :''). ": ";
1049 my $result = scalar(<>);
1051 $result =~ s/^\s*(.*?)\s*$/$1/s;
1052 if ($default && $result eq '') {
1063 for my $header (keys %attr) {
1064 $head .= "$header: ".$attr{$header}."\n";
1069 sub _message_headers {
1070 my %headers = ( To => $address, Subject => $subject );
1071 $headers{'Cc'} = $cc if ($cc);
1072 $headers{'Message-Id'} = $messageid if ($messageid);
1073 $headers{'Reply-To'} = $from if ($from);
1077 sub build_complete_message {
1078 my $content = _build_header(%{_message_headers()}) . "\n\n";
1079 open( REP, "<$filename" ) or die "Couldn't open file '$filename': $!\n";
1080 while (<REP>) { $content .= $_; }
1081 close(REP) or die "Error closing report file '$filename': $!";
1085 sub save_message_to_disk {
1088 open OUTFILE, ">$file" or do { warn "Couldn't open '$file': $!\n"; return undef};
1089 print OUTFILE build_complete_message();
1090 close(OUTFILE) or do { warn "Error closing $file: $!"; return undef };
1091 print "\nMessage saved.\n";
1095 sub _send_message_vms {
1096 if ( ( $address =~ /@/ and $address !~ /^\w+%"/ )
1097 or ( $cc =~ /@/ and $cc !~ /^\w+%"/ ) ) {
1099 foreach ( qw[ IN MX SMTP UCX PONY WINS ], '' ) {
1100 $prefix = "$_%", last if $ENV{"MAIL\$PROTOCOL_$_"};
1102 $address = qq[${prefix}"$address"] unless $address =~ /^\w+%"/;
1103 $cc = qq[${prefix}"$cc"] unless !$cc || $cc =~ /^\w+%"/;
1105 $subject =~ s/"/""/g;
1106 $address =~ s/"/""/g;
1108 my $sts = system(qq[mail/Subject="$subject" $filename. "$address","$cc"]);
1110 die "Can't spawn off mail (leaving bug report in $filename): $sts";
1114 sub _send_message_mailsend {
1115 my $msg = Mail::Send->new();
1116 my %headers = %{_message_headers()};
1117 for my $key ( keys %headers) {
1118 $msg->add($key => $headers{$key});
1122 open(REP, "<$filename") or die "Couldn't open '$filename': $!\n";
1123 while (<REP>) { print $fh $_ }
1124 close(REP) or die "Error closing $filename: $!";
1127 print "\nMessage sent.\n";
1130 sub _probe_for_sendmail {
1132 for (qw(/usr/lib/sendmail /usr/sbin/sendmail /usr/ucblib/sendmail)) {
1133 $sendmail = $_, last if -e $_;
1135 if ( $^O eq 'os2' and $sendmail eq "" ) {
1136 my $path = $ENV{PATH};
1138 my @path = split /$Config{'path_sep'}/, $path;
1140 $sendmail = "$_/sendmail", last if -e "$_/sendmail";
1141 $sendmail = "$_/sendmail.exe", last if -e "$_/sendmail.exe";
1147 sub _send_message_sendmail {
1148 my $sendmail = _probe_for_sendmail();
1149 unless ($sendmail) {
1150 paraprint(<<"EOF"), die "\n";
1151 It appears that there is no program which looks like "sendmail" on
1152 your system and that the Mail::Send library from CPAN isn't available.
1153 Because of this, there's no easy way to automatically send your
1156 A copy of your message has been saved in '$filename' for you to
1157 send to '$address' with your normal mail client.
1161 open( SENDMAIL, "|$sendmail -t -oi" )
1162 || die "'|$sendmail -t -oi' failed: $!";
1163 print SENDMAIL build_complete_message();
1164 if ( close(SENDMAIL) ) {
1165 print "\nMessage sent\n";
1167 warn "\nSendmail returned status '", $? >> 8, "'\n";
1173 # a strange way to check whether any significant editing
1174 # has been done: check whether any new non-empty lines
1177 sub _fingerprint_lines_in_report {
1179 # read in the report template once so that
1180 # we can track whether the user does any editing.
1181 # yes, *all* whitespace is ignored.
1183 open(REP, "<$filename") or die "Unable to open report file '$filename': $!\n";
1184 while (my $line = <REP>) {
1186 $new_lines++ if (!$REP{$line});
1189 close(REP) or die "Error closing report file '$filename': $!";
1190 # returns the number of lines with content that wasn't there when last we looked
1197 ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
1205 perlbug - how to submit bug reports on Perl
1211 B<perlbug> S<[ B<-v> ]> S<[ B<-a> I<address> ]> S<[ B<-s> I<subject> ]>
1212 S<[ B<-b> I<body> | B<-f> I<inputfile> ]> S<[ B<-F> I<outputfile> ]>
1213 S<[ B<-r> I<returnaddress> ]>
1214 S<[ B<-e> I<editor> ]> S<[ B<-c> I<adminaddress> | B<-C> ]>
1215 S<[ B<-S> ]> S<[ B<-t> ]> S<[ B<-d> ]> S<[ B<-A> ]> S<[ B<-h> ]>
1217 B<perlbug> S<[ B<-v> ]> S<[ B<-r> I<returnaddress> ]>
1218 S<[ B<-A> ]> S<[ B<-ok> | B<-okay> | B<-nok> | B<-nokay> ]>
1223 This program is designed to help you generate and send bug reports
1224 (and thank-you notes) about perl5 and the modules which ship with it.
1226 In most cases, you can just run it interactively from a command
1227 line without any special arguments and follow the prompts.
1229 If you have found a bug with a non-standard port (one that was not
1230 part of the I<standard distribution>), a binary distribution, or a
1231 non-core module (such as Tk, DBI, etc), then please see the
1232 documentation that came with that distribution to determine the
1233 correct place to report bugs.
1235 If you are unable to send your report using B<perlbug> (most likely
1236 because your system doesn't have a way to send mail that perlbug
1237 recognizes), you may be able to use this tool to compose your report
1238 and save it to a file which you can then send to B<perlbug@perl.org>
1239 using your regular mail client.
1241 In extreme cases, B<perlbug> may not work well enough on your system
1242 to guide you through composing a bug report. In those cases, you
1243 may be able to use B<perlbug -d> to get system configuration
1244 information to include in a manually composed bug report to
1245 B<perlbug@perl.org>.
1248 When reporting a bug, please run through this checklist:
1252 =item What version of Perl you are running?
1254 Type C<perl -v> at the command line to find out.
1256 =item Are you running the latest released version of perl?
1258 Look at http://www.perl.org/ to find out. If you are not using the
1259 latest released version, please try to replicate your bug on the
1260 latest stable release.
1262 Note that reports about bugs in old versions of Perl, especially
1263 those which indicate you haven't also tested the current stable
1264 release of Perl, are likely to receive less attention from the
1265 volunteers who build and maintain Perl than reports about bugs in
1266 the current release.
1268 This tool isn't apropriate for reporting bugs in any version
1271 =item Are you sure what you have is a bug?
1273 A significant number of the bug reports we get turn out to be
1274 documented features in Perl. Make sure the issue you've run into
1275 isn't intentional by glancing through the documentation that comes
1276 with the Perl distribution.
1278 Given the sheer volume of Perl documentation, this isn't a trivial
1279 undertaking, but if you can point to documentation that suggests
1280 the behaviour you're seeing is I<wrong>, your issue is likely to
1281 receive more attention. You may want to start with B<perldoc>
1282 L<perltrap> for pointers to common traps that new (and experienced)
1283 Perl programmers run into.
1285 If you're unsure of the meaning of an error message you've run
1286 across, B<perldoc> L<perldiag> for an explanation. If the message
1287 isn't in perldiag, it probably isn't generated by Perl. You may
1288 have luck consulting your operating system documentation instead.
1290 If you are on a non-UNIX platform B<perldoc> L<perlport>, as some
1291 features may be unimplemented or work differently.
1293 You may be able to figure out what's going wrong using the Perl
1294 debugger. For information about how to use the debugger B<perldoc>
1297 =item Do you have a proper test case?
1299 The easier it is to reproduce your bug, the more likely it will be
1300 fixed -- if nobody can duplicate your problem, it probably won't be
1303 A good test case has most of these attributes: short, simple code;
1304 few dependencies on external commands, modules, or libraries; no
1305 platform-dependent code (unless it's a platform-specific bug);
1306 clear, simple documentation.
1308 A good test case is almost always a good candidate to be included in
1309 Perl's test suite. If you have the time, consider writing your test case so
1310 that it can be easily included into the standard test suite.
1312 =item Have you included all relevant information?
1314 Be sure to include the B<exact> error messages, if any.
1315 "Perl gave an error" is not an exact error message.
1317 If you get a core dump (or equivalent), you may use a debugger
1318 (B<dbx>, B<gdb>, etc) to produce a stack trace to include in the bug
1321 NOTE: unless your Perl has been compiled with debug info
1322 (often B<-g>), the stack trace is likely to be somewhat hard to use
1323 because it will most probably contain only the function names and not
1324 their arguments. If possible, recompile your Perl with debug info and
1325 reproduce the crash and the stack trace.
1327 =item Can you describe the bug in plain English?
1329 The easier it is to understand a reproducible bug, the more likely
1330 it will be fixed. Any insight you can provide into the problem
1331 will help a great deal. In other words, try to analyze the problem
1332 (to the extent you can) and report your discoveries.
1334 =item Can you fix the bug yourself?
1336 A bug report which I<includes a patch to fix it> will almost
1337 definitely be fixed. When sending a patch, please use the C<diff>
1338 program with the C<-u> option to generate "unified" diff files.
1339 Bug reports with patches are likely to receive significantly more
1340 attention and interest than those without patches.
1342 Your patch may be returned with requests for changes, or requests for more
1343 detailed explanations about your fix.
1345 Here are a few hints for creating high-quality patches:
1347 Make sure the patch is not reversed (the first argument to diff is
1348 typically the original file, the second argument your changed file).
1349 Make sure you test your patch by applying it with the C<patch>
1350 program before you send it on its way. Try to follow the same style
1351 as the code you are trying to patch. Make sure your patch really
1352 does work (C<make test>, if the thing you're patching is covered
1353 by Perl's test suite).
1355 =item Can you use C<perlbug> to submit the report?
1357 B<perlbug> will, amongst other things, ensure your report includes
1358 crucial information about your version of perl. If C<perlbug> is
1359 unable to mail your report after you have typed it in, you may have
1360 to compose the message yourself, add the output produced by C<perlbug
1361 -d> and email it to B<perlbug@perl.org>. If, for some reason, you
1362 cannot run C<perlbug> at all on your system, be sure to include the
1363 entire output produced by running C<perl -V> (note the uppercase V).
1365 Whether you use C<perlbug> or send the email manually, please make
1366 your Subject line informative. "a bug" is not informative. Neither
1367 is "perl crashes" nor is "HELP!!!". These don't help. A compact
1368 description of what's wrong is fine.
1372 Having done your bit, please be prepared to wait, to be told the
1373 bug is in your code, or possibly to get no reply at all. The
1374 volunteers who maintain Perl are busy folks, so if your problem is
1375 an obvious bug in your own code, is difficult to understand or is
1376 a duplicate of an existing report, you may not receive a personal
1379 If it is important to you that your bug be fixed, do monitor the
1380 perl5-porters@perl.org mailing list and the commit logs to development
1381 versions of Perl, and encourage the maintainers with kind words or
1382 offers of frosty beverages. (Please do be kind to the maintainers.
1383 Harassing or flaming them is likely to have the opposite effect of
1386 Feel free to update the ticket about your bug on http://rt.perl.org
1387 if a new version of Perl is released and your bug is still present.
1395 Address to send the report to. Defaults to B<perlbug@perl.org>.
1399 Don't send a bug received acknowledgement to the reply address.
1400 Generally it is only a sensible to use this option if you are a
1401 perl maintainer actively watching perl porters for your message to
1406 Body of the report. If not included on the command line, or
1407 in a file with B<-f>, you will get a chance to edit the message.
1411 Don't send copy to administrator.
1415 Address to send copy of report to. Defaults to the address of the
1416 local perl administrator (recorded when perl was built).
1420 Data mode (the default if you redirect or pipe output). This prints out
1421 your configuration data, without mailing anything. You can use this
1422 with B<-v> to get more complete data.
1430 File containing the body of the report. Use this to quickly send a
1435 File to output the results to instead of sending as an email. Useful
1436 particularly when running perlbug on a machine with no direct internet
1441 Prints a brief summary of the options.
1445 Report successful build on this system to perl porters. Forces B<-S>
1446 and B<-C>. Forces and supplies values for B<-s> and B<-b>. Only
1447 prompts for a return address if it cannot guess it (for use with
1448 B<make>). Honors return address specified with B<-r>. You can use this
1449 with B<-v> to get more complete data. Only makes a report if this
1450 system is less than 60 days old.
1454 As B<-ok> except it will report on older systems.
1458 Report unsuccessful build on this system. Forces B<-C>. Forces and
1459 supplies a value for B<-s>, then requires you to edit the report
1460 and say what went wrong. Alternatively, a prepared report may be
1461 supplied using B<-f>. Only prompts for a return address if it
1462 cannot guess it (for use with B<make>). Honors return address
1463 specified with B<-r>. You can use this with B<-v> to get more
1464 complete data. Only makes a report if this system is less than 60
1469 As B<-nok> except it will report on older systems.
1473 Your return address. The program will ask you to confirm its default
1474 if you don't use this option.
1478 Send without asking for confirmation.
1482 Subject to include with the message. You will be prompted if you don't
1483 supply one on the command line.
1487 Test mode. The target address defaults to B<perlbug-test@perl.org>.
1491 Include verbose configuration data in the report.
1497 Kenneth Albanowski (E<lt>kjahds@kjahds.comE<gt>), subsequently
1498 I<doc>tored by Gurusamy Sarathy (E<lt>gsar@activestate.comE<gt>),
1499 Tom Christiansen (E<lt>tchrist@perl.comE<gt>), Nathan Torkington
1500 (E<lt>gnat@frii.comE<gt>), Charles F. Randall (E<lt>cfr@pobox.comE<gt>),
1501 Mike Guy (E<lt>mjtg@cam.a.ukE<gt>), Dominic Dunlop
1502 (E<lt>domo@computer.orgE<gt>), Hugo van der Sanden (E<lt>hv@crypt.org<gt>),
1503 Jarkko Hietaniemi (E<lt>jhi@iki.fiE<gt>), Chris Nandor
1504 (E<lt>pudge@pobox.comE<gt>), Jon Orwant (E<lt>orwant@media.mit.eduE<gt>,
1505 Richard Foley (E<lt>richard.foley@rfi.netE<gt>), and Jesse Vincent
1506 (E<lt>jesse@bestpractical.com<gt>).
1510 perl(1), perldebug(1), perldiag(1), perlport(1), perltrap(1),
1511 diff(1), patch(1), dbx(1), gdb(1)
1515 None known (guess what must have been used to report them?)
1521 close OUT or die "Can't close $file: $!";
1522 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
1523 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';