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 # get patchlevel.h timestamp
27 -e catfile(updir, "patchlevel.h")
28 or die "Can't find patchlevel.h: $!";
30 my $patchlevel_date = (stat _)[9];
32 # TO DO (perhaps): store/embed $Config::config_sh into perlbug. When perlbug is
33 # used, compare $Config::config_sh with the stored version. If they differ then
34 # append a list of individual differences to the bug report.
37 print "Extracting $file (with variable substitutions)\n";
39 # In this section, perl variables will be expanded during extraction.
40 # You can use $Config{...} to use Configure variables.
42 my $extract_version = sprintf("%vd", $^V);
44 print OUT <<"!GROK!THIS!";
46 eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
47 if \$running_under_some_shell;
49 my \$config_tag1 = '$extract_version - $Config{cf_time}';
51 my \$patchlevel_date = $patchlevel_date;
54 # In the following, perl variables are not expanded during extraction.
56 print OUT <<'!NO!SUBS!';
57 my @patches = Config::local_patches();
58 my $patch_tags = join "", map /(\S+)/ ? "+$1 " : (), @patches;
60 BEGIN { pop @INC if $INC[-1] eq '.' }
64 use File::Spec; # keep perlbug Perl 5.005 compatible
66 use File::Basename 'basename';
68 $Getopt::Std::STANDARD_HELP_VERSION = 1;
73 eval { require Mail::Send;};
74 $::HaveSend = ($@ eq "");
75 eval { require Mail::Util; } ;
76 $::HaveUtil = ($@ eq "");
77 # use secure tempfiles wherever possible
78 eval { require File::Temp; };
79 $::HaveTemp = ($@ eq "");
80 eval { require Module::CoreList; };
81 $::HaveCoreList = ($@ eq "");
82 eval { require Text::Wrap; };
83 $::HaveWrap = ($@ eq "");
86 our $VERSION = "1.41";
89 # make sure failure (transmission-wise) of Mail::Send is accounted for.
90 # (This may work now. Unsure of the original author's issue -JESSE 2008-06-08)
93 my( $file, $usefile, $cc, $address, $bugaddress, $testaddress, $thanksaddress,
94 $filename, $messageid, $domain, $subject, $from, $verbose, $ed, $outfile,
95 $fh, $me, $body, $andcc, %REP, $ok, $thanks, $progname,
96 $Is_MSWin32, $Is_Linux, $Is_VMS, $Is_OpenBSD,
97 $report_about_module, $category, $severity,
98 %opt, $have_attachment, $attachments, $has_patch, $mime_boundary
101 my $running_noninteractively = !-t STDIN;
103 my $perl_version = $^V ? sprintf("%vd", $^V) : $];
105 my $config_tag2 = "$perl_version - $Config{cf_time}";
109 if ($opt{h}) { Help(); exit; }
110 if ($opt{d}) { Dump(*STDOUT); exit; }
111 if ($running_noninteractively && !$opt{t} && !($ok and not $opt{n})) {
113 Please use $progname interactively. If you want to
114 include a file, you can use the -f switch.
120 Edit() unless $usefile || ($ok and not $opt{n});
123 save_message_to_disk($outfile);
127 print "\nThank you for taking the time to send a thank-you message!\n\n";
130 Please note that mailing lists are moderated, your message may take a while to
134 print "\nThank you for taking the time to file a bug report!\n\n";
137 Please note that mailing lists are moderated, your message may take a while to
138 show up. If you do not receive an automated response acknowledging your message
139 within a few hours (check your SPAM folder and outgoing mail) please consider
140 sending an email directly from your mail client to perlbug\@perl.org.
148 sub ask_for_alternatives { # (category|severity)
154 # Inevitably some of these will end up in RT whatever we do:
155 'thanks' => 'thanks',
156 'opts' => [qw(core docs install library utilities)], # patch, notabug
162 'opts' => [qw(critical high medium low wishlist none)], # zero
165 die "Invalid alternative ($name) requested\n" unless grep(/^$name$/, keys %alts);
167 my $what = $ok || $thanks;
169 $alt = $alts{$name}{$what};
171 my @alts = @{$alts{$name}{'opts'}};
174 Please pick a $name from the following list:
181 die "Invalid $name: aborting.\n";
183 $alt = _prompt('', "\u$name", $alts{$name}{'default'});
184 $alt ||= $alts{$name}{'default'};
185 } while !((($alt) = grep(/^$alt/i, @alts)));
190 sub HELP_MESSAGE { Help(); exit; }
191 sub VERSION_MESSAGE { print "perlbug version $VERSION\n"; }
194 # -------- Setup --------
196 $Is_MSWin32 = $^O eq 'MSWin32';
197 $Is_VMS = $^O eq 'VMS';
198 $Is_Linux = lc($^O) eq 'linux';
199 $Is_OpenBSD = lc($^O) eq 'openbsd';
202 $bugaddress = 'perlbug@perl.org';
205 $testaddress = 'perlbug-test@perl.org';
208 $thanksaddress = 'perl-thanks@perl.org';
210 # Defaults if getopts fails.
211 $address = (basename ($0) =~ /^perlthanks/i) ? $thanksaddress : $bugaddress;
212 $cc = $::Config{'perladmin'} || $::Config{'cf_email'} || $::Config{'cf_by'} || '';
214 HELP_MESSAGE() unless getopts("Adhva:s:b:f:F:r:e:SCc:to:n:T:p:", \%opt);
216 # This comment is needed to notify metaconfig that we are
217 # using the $perladmin, $cf_by, and $cf_time definitions.
218 # -------- Configuration ---------
220 if (basename ($0) =~ /^perlthanks/i) {
221 # invoked as perlthanks
223 $opt{C} = 1; # don't send a copy to the local admin
230 $progname = $thanks ? 'perlthanks' : 'perlbug';
232 $address = $opt{a} || ($opt{t} ? $testaddress
233 : $thanks ? $thanksaddress : $bugaddress);
235 # Users address, used in message and in From and Reply-To headers
236 $from = $opt{r} || "";
238 # Include verbose configuration information
239 $verbose = $opt{v} || 0;
241 # Subject of bug-report message
242 $subject = $opt{s} || "";
245 $usefile = ($opt{f} || 0);
247 # File to send as report
248 $file = $opt{f} || "";
250 # We have one or more attachments
251 $have_attachment = ($opt{p} || 0);
252 $mime_boundary = ('-' x 12) . "$VERSION.perlbug" if $have_attachment;
254 # Comma-separated list of attachments
255 $attachments = $opt{p} || "";
256 $has_patch = 0; # TBD based on file type
258 for my $attachment (split /\s*,\s*/, $attachments) {
259 unless (-f $attachment && -r $attachment) {
260 die "The attachment $attachment is not a readable file: $!\n";
262 $has_patch = 1 if $attachment =~ m/\.(patch|diff)$/;
266 $outfile = $opt{F} || "";
269 $body = $opt{b} || "";
272 $ed = $opt{e} || $ENV{VISUAL} || $ENV{EDITOR} || $ENV{EDIT}
273 || ($Is_VMS && "edit/tpu")
274 || ($Is_MSWin32 && "notepad")
277 # Not OK - provide build failure template by finessing OK report
279 if (substr($opt{n}, 0, 2) eq 'ok' ) {
280 $opt{o} = substr($opt{n}, 1);
287 # OK - send "OK" report for build on this system
290 if ($opt{o} eq 'k' or $opt{o} eq 'kay') {
291 my $age = time - $patchlevel_date;
292 if ($opt{o} eq 'k' and $age > 60 * 24 * 60 * 60 ) {
293 my $date = localtime $patchlevel_date;
295 "perlbug -ok" and "perlbug -nok" do not report on Perl versions which
296 are more than 60 days old. This Perl version was constructed on
297 $date. If you really want to report this, use
298 "perlbug -okay" or "perlbug -nokay".
302 # force these options
304 $opt{S} = 1; # don't prompt for send
305 $opt{b} = 1; # we have a body
306 $body = "Perl reported to build OK on this system.\n";
308 $opt{C} = 1; # don't send a copy to the local admin
309 $opt{s} = 1; # we have a subject line
310 $subject = ($opt{n} ? 'Not ' : '')
311 . "OK: perl $perl_version ${patch_tags}on"
312 ." $::Config{'archname'} $::Config{'osvers'} $subject";
320 # Possible administrator addresses, in order of confidence
321 # (Note that cf_email is not mentioned to metaconfig, since
322 # we don't really want it. We'll just take it if we have to.)
324 # This has to be after the $ok stuff above because of the way
325 # that $opt{C} is forced.
326 $cc = $opt{C} ? "" : (
327 $opt{c} || $::Config{'perladmin'}
328 || $::Config{'cf_email'} || $::Config{'cf_by'}
332 $domain = Mail::Util::maildomain();
333 } elsif ($Is_MSWin32) {
334 $domain = $ENV{'USERDOMAIN'};
336 require Sys::Hostname;
337 $domain = Sys::Hostname::hostname();
341 $messageid = "<$::Config{'version'}_${$}_".time."\@$domain>";
344 $me = $Is_MSWin32 ? $ENV{'USERNAME'}
345 : $^O eq 'os2' ? $ENV{'USER'} || $ENV{'LOGNAME'}
346 : eval { getpwuid($<) }; # May be missing
348 $from = $::Config{'cf_email'}
349 if !$from && $::Config{'cf_email'} && $::Config{'cf_by'} && $me &&
350 ($me eq $::Config{'cf_by'});
354 # Explain what perlbug is
358 This program provides an easy way to send a thank-you message back to the
359 authors and maintainers of perl.
361 If you wish to submit a bug report, please run it without the -T flag
362 (or run the program perlbug rather than perlthanks)
366 This program provides an easy way to create a message reporting a
367 bug in the core perl distribution (along with tests or patches)
368 to the volunteers who maintain perl at $address. To send a thank-you
369 note to $thanksaddress instead of a bug report, please run 'perlthanks'.
371 Please do not use $0 to send test messages, test whether perl
372 works, or to report bugs in perl modules from CPAN.
374 Suggestions for how to find help using Perl can be found at
375 https://perldoc.perl.org/perlcommunity.html
380 # Prompt for subject of message, if needed
382 if ($subject && TrivialSubject($subject)) {
388 "First of all, please provide a subject for the message.\n";
391 This should be a concise description of your bug or problem
392 which will help the volunteers working to improve perl to categorize
393 and resolve the issue. Be as specific and descriptive as
394 you can. A subject like "perl bug" or "perl problem" will make it
395 much less likely that your issue gets the attention it deserves.
401 $subject = _prompt('','Subject');
404 $subject = 'Thanks for Perl';
409 } while (TrivialSubject($subject));
411 $subject = '[PATCH] ' . $subject
412 if $has_patch && ($subject !~ m/^\[PATCH/i);
414 # Prompt for return address, if needed
416 # Try and guess return address
419 $guess = $ENV{'REPLY-TO'} || $ENV{'REPLYTO'} || $ENV{'EMAIL'}
423 # move $domain to where we can use it elsewhere
425 if ($Is_VMS && !$::Config{'d_socket'}) {
426 $guess = "$domain\:\:$me";
428 $guess = "$me\@$domain" if $domain;
436 Perl's developers may need your email address to contact you for
437 further information about your issue or to inform you when it is
438 resolved. If the default shown is not your email address, please
444 Please enter your full internet email address so that Perl's
445 developers can contact you with questions about your issue or to
446 inform you that it has been resolved.
455 $from = _prompt('','Your address',$guess);
456 $from = $guess if $from eq '';
460 if ($from eq $cc or $me eq $cc) {
461 # Try not to copy ourselves
465 # Prompt for administrator address, unless an override was given
466 if( !$opt{C} and !$opt{c} ) {
467 my $description = <<EOF;
468 $0 can send a copy of this report to your local perl
469 administrator. If the address below is wrong, please correct it,
470 or enter 'none' or 'yourself' to not send a copy.
472 my $entry = _prompt($description, "Local perl administrator", $cc);
476 $cc = '' if $me eq $cc;
480 $cc = '' if $cc =~ /^(none|yourself|me|myself|ourselves)$/i;
487 # Prompt for editor, if no override is given
489 unless ($opt{e} || $opt{f} || $opt{b}) {
493 chomp (my $common_end = <<"EOF");
494 You will probably want to use a text editor to enter the body of
495 your report. If "$ed" is the editor you want to use, then just press
496 Enter, otherwise type in the name of the editor you would like to
499 If you have already composed the body of your report, you may enter
500 "file", and $0 will prompt you to enter the name of the file
501 containing your report.
505 $description = <<"EOF";
506 It's now time to compose your thank-you message.
508 Some information about your local perl configuration will automatically
509 be included at the end of your message, because we're curious about
510 the different ways that people build and use perl. If you'd rather
511 not share this information, you're welcome to delete it.
516 $description = <<"EOF";
517 It's now time to compose your bug report. Try to make the report
518 concise but descriptive. Please include any detail which you think
519 might be relevant or might help the volunteers working to improve
520 perl. If you are reporting something that does not work as you think
521 it should, please try to include examples of the actual result and of
524 Some information about your local perl configuration will automatically
525 be included at the end of your report. If you are using an unusual
526 version of perl, it would be useful if you could confirm that you
527 can replicate the problem on a standard build of perl as well.
533 my $entry = _prompt($description, "Editor", $ed);
535 if ($entry eq "file") {
537 } elsif ($entry ne "") {
541 if ($::HaveCoreList && !$ok && !$thanks) {
542 my $description = <<EOF;
543 If your bug is about a Perl module rather than a core language
544 feature, please enter its name here. If it's not, just hit Enter
545 to skip this question.
549 while ($entry eq '') {
550 $entry = _prompt($description, 'Module');
551 my $first_release = Module::CoreList->first_release($entry);
552 if ($entry and not $first_release) {
554 $entry is not a "core" Perl module. Please check that you entered
555 its name correctly. If it is correct, quit this program, try searching
556 for $entry on https://rt.cpan.org, and report your issue there.
560 } elsif (my $bug_tracker = $Module::CoreList::bug_tracker{$entry}) {
562 $entry included with core Perl is copied directly from the CPAN distribution.
563 Please report bugs in $entry directly to its maintainers using $bug_tracker
567 $category ||= 'library';
568 $report_about_module = $entry;
576 # Prompt for category of bug
577 $category ||= ask_for_alternatives('category');
579 # Prompt for severity of bug
580 $severity ||= ask_for_alternatives('severity');
582 # Generate scratch file to edit report in
583 $filename = filename();
585 # Prompt for file to read report from, if needed
586 if ($usefile and !$file) {
588 my $description = <<EOF;
589 What is the name of the file that contains your report?
591 my $entry = _prompt($description, "Filename");
595 It seems you didn't enter a filename. Please choose to use a text
596 editor or enter a filename.
601 unless (-f $entry and -r $entry) {
603 '$entry' doesn't seem to be a readable file. You may have mistyped
604 its name or may not have permission to read it.
606 If you don't want to use a file as the content of your report, just
607 hit Enter and you'll be able to select a text editor instead.
615 open(REP, '>:raw', $filename) or die "Unable to create report file '$filename': $!\n";
616 binmode(REP, ':raw :crlf') if $Is_MSWin32;
618 my $reptype = !$ok ? ($thanks ? 'thank-you' : 'bug')
619 : $opt{n} ? "build failure" : "success";
622 This is a $reptype report for perl from $from,
623 generated with the help of perlbug $VERSION running under perl $perl_version.
630 open(F, '<:raw', $file)
631 or die "Unable to read report file from '$file': $!\n";
632 binmode(F, ':raw :crlf') if $Is_MSWin32;
636 close(F) or die "Error closing '$file': $!";
641 -----------------------------------------------------------------
642 [Please enter your thank-you message here]
646 [You're welcome to delete anything below this line]
647 -----------------------------------------------------------------
652 -----------------------------------------------------------------
653 [Please describe your issue here]
657 [Please do not change anything below this line]
658 -----------------------------------------------------------------
663 close(REP) or die "Error closing report file: $!";
665 # Set up an initial report fingerprint so we can compare it later
666 _fingerprint_lines_in_report();
673 # these won't have been set if run with -d
674 $category ||= 'core';
691 if ($report_about_module ) {
693 module=$report_about_module
704 print OUT "This perlbug was built using Perl $config_tag1\n",
705 "It is being executed now by Perl $config_tag2.\n\n"
706 if $config_tag2 ne $config_tag1;
709 Site configuration information for perl $perl_version:
712 if ($::Config{cf_by} and $::Config{cf_time}) {
713 print OUT "Configured by $::Config{cf_by} at $::Config{cf_time}.\n\n";
715 print OUT Config::myconfig;
718 print OUT join "\n ", "Locally applied patches:", @patches;
725 \@INC for perl $perl_version:
734 Environment for perl $perl_version:
737 qw(PATH LD_LIBRARY_PATH LANG PERL_BADLANG SHELL HOME LOGDIR LANGUAGE);
738 push @env, $Config{ldlibpthname} if $Config{ldlibpthname} ne '';
739 push @env, grep /^(?:PERL|LC_|LANG|CYGWIN)/, keys %ENV;
742 for my $env (sort keys %env) {
744 exists $ENV{$env} ? "=$ENV{$env}" : ' (unset)',
748 print OUT "\nComplete configuration data for perl $perl_version:\n\n";
750 foreach (sort keys %::Config) {
751 $value = $::Config{$_};
752 $value = '' unless defined $value;
754 print OUT "$_='$value'\n";
761 if ($usefile || $body) {
762 my $description = "Please make sure that the name of the editor you want to use is correct.";
763 my $entry = _prompt($description, 'Editor', $ed);
764 $ed = $entry unless $entry eq '';
767 _edit_file($ed) unless $running_noninteractively;
773 my $report_written = 0;
775 while ( !$report_written ) {
776 my $exit_status = system("$editor $filename");
779 The editor you chose ('$editor') could not be run!
781 If you mistyped its name, please enter it now, otherwise just press Enter.
783 my $entry = _prompt( $desc, 'Editor', $editor );
784 if ( $entry ne "" ) {
789 You may want to save your report to a file, so you can edit and
795 return if ( $ok and not $opt{n} ) || $body;
797 # Check that we have a report that has some, eh, report in it.
799 unless ( _fingerprint_lines_in_report() ) {
800 my $description = <<EOF;
801 It looks like you didn't enter a report. You may [r]etry your edit
802 or [c]ancel this report.
804 my $action = _prompt( $description, "Action (Retry/Cancel) " );
805 if ( $action =~ /^[re]/i ) { # <R>etry <E>dit
807 } elsif ( $action =~ /^[cq]/i ) { # <C>ancel, <Q>uit
808 Cancel(); # cancel exits
811 # Ok. the user did what they needed to;
819 1 while unlink($filename); # remove all versions under VMS
820 print "\nQuitting without sending your message.\n";
825 # Report is done, prompt for further action
831 You have finished composing your message. At this point, you have
832 a few options. You can:
834 * [Se]nd the message to $address$andcc,
835 * [D]isplay the message on the screen,
836 * [R]e-edit the message
837 * Display or change the message's [su]bject
838 * Save the message to a [f]ile to mail at another time
839 * [Q]uit without sending a message
844 my $action = _prompt('', "Action (Send/Display/Edit/Subject/Save to File)",
847 if ($action =~ /^(f|sa)/i) { # <F>ile/<Sa>ve
848 if ( SaveMessage() ) { exit }
849 } elsif ($action =~ /^(d|l|sh)/i ) { # <D>isplay, <L>ist, <Sh>ow
850 # Display the message
851 print _read_report($filename);
852 if ($have_attachment) {
853 print "\n\n---\nAttachment(s):\n";
854 for my $att (split /\s*,\s*/, $attachments) { print " $att\n"; }
856 } elsif ($action =~ /^su/i) { # <Su>bject
857 my $reply = _prompt( "Subject: $subject", "If the above subject is fine, press Enter. Otherwise, type a replacement now\nSubject");
859 unless (TrivialSubject($reply)) {
861 print "Subject: $subject\n";
864 } elsif ($action =~ /^se/i) { # <S>end
866 my $reply = _prompt( "Are you certain you want to send this message?", 'Please type "yes" if you are','no');
867 if ($reply =~ /^yes$/) {
871 You didn't type "yes", so your message has not yet been sent.
874 } elsif ($action =~ /^[er]/i) { # <E>dit, <R>e-edit
877 } elsif ($action =~ /^[qc]/i) { # <C>ancel, <Q>uit
879 } elsif ($action =~ /^s/i) {
881 The command you entered was ambiguous. Please type "send", "save" or "subject".
891 /^(y(es)?|no?|help|perl( (bug|problem))?|bug|problem)$/i ||
892 length($subject) < 4 ||
893 ($subject !~ /\s/ && ! $opt{t})) { # non-whitespace is accepted in test mode
894 print "\nThe subject you entered wasn't very descriptive. Please try again.\n\n";
902 my $file_save = $outfile || "$progname.rep";
903 my $file = _prompt( '', "Name of file to save message in", $file_save );
904 save_message_to_disk($file) || return undef;
907 A copy of your message has been saved in '$file' for you to
908 send to '$address' with your normal mail client.
914 # Message has been accepted for transmission -- Send the message
916 # on linux certain "mail" implementations won't accept the subject
917 # as "~s subject" and thus the Subject header will be corrupted
918 # so don't use Mail::Send to be safe
920 if ( $::HaveSend && !$Is_Linux && !$Is_OpenBSD ) {
921 _send_message_mailsend();
925 _send_message_sendmail();
929 if ( my $error = $@ ) {
931 $0 has detected an error while trying to send your message: $error.
933 Your message may not have been sent. You will now have a chance to save a copy to disk.
939 1 while unlink($filename); # remove all versions under VMS
945 This program is designed to help you generate and send bug reports
946 (and thank-you notes) about perl5 and the modules which ship with it.
948 In most cases, you can just run "$0" interactively from a command
949 line without any special arguments and follow the prompts.
953 $0 [-v] [-a address] [-s subject] [-b body | -f inpufile ] [ -F outputfile ]
954 [-r returnaddress] [-e editor] [-c adminaddress | -C] [-S] [-t] [-h]
956 $0 [-v] [-r returnaddress] [-A] [-ok | -okay | -nok | -nokay]
961 -v Include Verbose configuration data in the report
962 -f File containing the body of the report. Use this to
963 quickly send a prepared message.
964 -p File containing a patch or other text attachment. Separate
965 multiple files with commas.
966 -F File to output the resulting mail message to, instead of mailing.
967 -S Send without asking for confirmation.
968 -a Address to send the report to. Defaults to '$address'.
969 -c Address to send copy of report to. Defaults to '$cc'.
970 -C Don't send copy to administrator.
971 -s Subject to include with the message. You will be prompted
972 if you don't supply one on the command line.
973 -b Body of the report. If not included on the command line, or
974 in a file with -f, you will get a chance to edit the message.
975 -r Your return address. The program will ask you to confirm
976 this if you don't give it here.
978 -t Test mode. The target address defaults to '$testaddress'.
979 -T Thank-you mode. The target address defaults to '$thanksaddress'.
980 -d Data mode. This prints out your configuration data, without mailing
981 anything. You can use this with -v to get more complete data.
982 -A Don't send a bug received acknowledgement to the return address.
983 -ok Report successful build on this system to perl porters
984 (use alone or with -v). Only use -ok if *everything* was ok:
985 if there were *any* problems at all, use -nok.
986 -okay As -ok but allow report from old builds.
987 -nok Report unsuccessful build on this system to perl porters
988 (use alone or with -v). You must describe what went wrong
989 in the body of the report which you will be asked to edit.
990 -nokay As -nok but allow report from old builds.
991 -h Print this help message.
998 # Good. Use a secure temp file
999 my ($fh, $filename) = File::Temp::tempfile(UNLINK => 1);
1003 # Bah. Fall back to doing things less securely.
1004 my $dir = File::Spec->tmpdir();
1005 $filename = "bugrep0$$";
1006 $filename++ while -e File::Spec->catfile($dir, $filename);
1007 $filename = File::Spec->catfile($dir, $filename);
1012 my @paragraphs = split /\n{2,}/, "@_";
1013 for (@paragraphs) { # implicit local $_
1021 my ($explanation, $prompt, $default) = (@_);
1024 paraprint $explanation;
1026 print $prompt. ($default ? " [$default]" :''). ": ";
1027 my $result = scalar(<>);
1028 return $default if !defined $result; # got eof
1030 $result =~ s/^\s*(.*?)\s*$/$1/s;
1031 if ($default && $result eq '') {
1042 for my $header (keys %attr) {
1043 $head .= "$header: ".$attr{$header}."\n";
1048 sub _message_headers {
1049 my %headers = ( To => $address, Subject => $subject );
1050 $headers{'Cc'} = $cc if ($cc);
1051 $headers{'Message-Id'} = $messageid if ($messageid);
1052 $headers{'Reply-To'} = $from if ($from);
1053 $headers{'From'} = $from if ($from);
1054 if ($have_attachment) {
1055 $headers{'MIME-Version'} = '1.0';
1056 $headers{'Content-Type'} = qq{multipart/mixed; boundary=\"$mime_boundary\"};
1061 sub _add_body_start {
1062 my $body_start = <<"BODY_START";
1063 This is a multi-part message in MIME format.
1065 Content-Type: text/plain; format=fixed
1066 Content-Transfer-Encoding: 8bit
1072 sub _add_attachments {
1074 for my $attachment (split /\s*,\s*/, $attachments) {
1075 my $attach_file = basename($attachment);
1076 $attach .= <<"ATTACHMENT";
1079 Content-Type: text/x-patch; name="$attach_file"
1080 Content-Transfer-Encoding: 8bit
1081 Content-Disposition: attachment; filename="$attach_file"
1085 open my $attach_fh, '<:raw', $attachment
1086 or die "Couldn't open attachment '$attachment': $!\n";
1087 while (<$attach_fh>) { $attach .= $_; }
1088 close($attach_fh) or die "Error closing attachment '$attachment': $!";
1091 $attach .= "\n--$mime_boundary--\n";
1098 open( REP, "<:raw", $fname ) or die "Couldn't open file '$fname': $!\n";
1099 binmode(REP, ':raw :crlf') if $Is_MSWin32;
1100 # wrap long lines to make sure the report gets delivered
1101 local $Text::Wrap::columns = 900;
1102 local $Text::Wrap::huge = 'overflow';
1104 if ($::HaveWrap && /\S/) { # wrap() would remove empty lines
1105 $content .= Text::Wrap::wrap(undef, undef, $_);
1110 close(REP) or die "Error closing report file '$fname': $!";
1114 sub build_complete_message {
1115 my $content = _build_header(%{_message_headers()}) . "\n\n";
1116 $content .= _add_body_start() if $have_attachment;
1117 $content .= _read_report($filename);
1118 $content .= _add_attachments() if $have_attachment;
1122 sub save_message_to_disk {
1126 my $response = _prompt( '', "Overwrite existing '$file'", 'n' );
1127 return undef unless $response =~ / yes | y /xi;
1129 open OUTFILE, '>:raw', $file or do { warn "Couldn't open '$file': $!\n"; return undef};
1130 binmode(OUTFILE, ':raw :crlf') if $Is_MSWin32;
1132 print OUTFILE build_complete_message();
1133 close(OUTFILE) or do { warn "Error closing $file: $!"; return undef };
1134 print "\nMessage saved.\n";
1138 sub _send_message_vms {
1140 my $mail_from = $from;
1141 my $rcpt_to_to = $address;
1142 my $rcpt_to_cc = $cc;
1144 map { $_ =~ s/^[^<]*<//;
1145 $_ =~ s/>[^>]*//; } ($mail_from, $rcpt_to_to, $rcpt_to_cc);
1147 if ( open my $sff_fh, '|-:raw', 'MCR TCPIP$SYSTEM:TCPIP$SMTP_SFF.EXE SYS$INPUT:' ) {
1148 print $sff_fh "MAIL FROM:<$mail_from>\n";
1149 print $sff_fh "RCPT TO:<$rcpt_to_to>\n";
1150 print $sff_fh "RCPT TO:<$rcpt_to_cc>\n" if $rcpt_to_cc;
1151 print $sff_fh "DATA\n";
1152 print $sff_fh build_complete_message();
1153 my $success = close $sff_fh;
1155 print "\nMessage sent\n";
1159 die "Mail transport failed (leaving bug report in $filename): $^E\n";
1162 sub _send_message_mailsend {
1163 my $msg = Mail::Send->new();
1164 my %headers = %{_message_headers()};
1165 for my $key ( keys %headers) {
1166 $msg->add($key => $headers{$key});
1170 binmode($fh, ':raw');
1171 print $fh _add_body_start() if $have_attachment;
1172 print $fh _read_report($filename);
1173 print $fh _add_attachments() if $have_attachment;
1174 $fh->close or die "Error sending mail: $!";
1176 print "\nMessage sent.\n";
1179 sub _probe_for_sendmail {
1181 for (qw(/usr/lib/sendmail /usr/sbin/sendmail /usr/ucblib/sendmail)) {
1182 $sendmail = $_, last if -e $_;
1184 if ( $^O eq 'os2' and $sendmail eq "" ) {
1185 my $path = $ENV{PATH};
1187 my @path = split /$Config{'path_sep'}/, $path;
1189 $sendmail = "$_/sendmail", last if -e "$_/sendmail";
1190 $sendmail = "$_/sendmail.exe", last if -e "$_/sendmail.exe";
1196 sub _send_message_sendmail {
1197 my $sendmail = _probe_for_sendmail();
1198 unless ($sendmail) {
1199 my $message_start = !$Is_Linux && !$Is_OpenBSD ? <<'EOT' : <<'EOT';
1200 It appears that there is no program which looks like "sendmail" on
1201 your system and that the Mail::Send library from CPAN isn't available.
1203 It appears that there is no program which looks like "sendmail" on
1206 paraprint(<<"EOF"), die "\n";
1208 Because of this, there's no easy way to automatically send your
1211 A copy of your message has been saved in '$filename' for you to
1212 send to '$address' with your normal mail client.
1216 open( SENDMAIL, "|-:raw", $sendmail, "-t", "-oi", "-f", $from )
1217 || die "'|$sendmail -t -oi -f $from' failed: $!";
1218 print SENDMAIL build_complete_message();
1219 if ( close(SENDMAIL) ) {
1220 print "\nMessage sent\n";
1222 warn "\nSendmail returned status '", $? >> 8, "'\n";
1228 # a strange way to check whether any significant editing
1229 # has been done: check whether any new non-empty lines
1232 sub _fingerprint_lines_in_report {
1234 # read in the report template once so that
1235 # we can track whether the user does any editing.
1236 # yes, *all* whitespace is ignored.
1238 open(REP, '<:raw', $filename) or die "Unable to open report file '$filename': $!\n";
1239 binmode(REP, ':raw :crlf') if $Is_MSWin32;
1240 while (my $line = <REP>) {
1242 $new_lines++ if (!$REP{$line});
1245 close(REP) or die "Error closing report file '$filename': $!";
1246 # returns the number of lines with content that wasn't there when last we looked
1253 ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
1261 perlbug - how to submit bug reports on Perl
1267 B<perlbug> S<[ B<-v> ]> S<[ B<-a> I<address> ]> S<[ B<-s> I<subject> ]>
1268 S<[ B<-b> I<body> | B<-f> I<inputfile> ]> S<[ B<-F> I<outputfile> ]>
1269 S<[ B<-r> I<returnaddress> ]>
1270 S<[ B<-e> I<editor> ]> S<[ B<-c> I<adminaddress> | B<-C> ]>
1271 S<[ B<-S> ]> S<[ B<-t> ]> S<[ B<-d> ]> S<[ B<-A> ]> S<[ B<-h> ]> S<[ B<-T> ]>
1273 B<perlbug> S<[ B<-v> ]> S<[ B<-r> I<returnaddress> ]>
1274 S<[ B<-A> ]> S<[ B<-ok> | B<-okay> | B<-nok> | B<-nokay> ]>
1281 This program is designed to help you generate bug reports
1282 (and thank-you notes) about perl5 and the modules which ship with it.
1284 In most cases, you can just run it interactively from a command
1285 line without any special arguments and follow the prompts.
1287 If you have found a bug with a non-standard port (one that was not
1288 part of the I<standard distribution>), a binary distribution, or a
1289 non-core module (such as Tk, DBI, etc), then please see the
1290 documentation that came with that distribution to determine the
1291 correct place to report bugs.
1293 Bug reports should be submitted to the GitHub issue tracker at
1294 L<https://github.com/Perl/perl5/issues>. The B<perlbug@perl.org>
1295 address no longer automatically opens tickets. You can use this tool
1296 to compose your report and save it to a file which you can then submit
1297 to the issue tracker.
1299 In extreme cases, B<perlbug> may not work well enough on your system
1300 to guide you through composing a bug report. In those cases, you
1301 may be able to use B<perlbug -d> or B<perl -V> to get system
1302 configuration information to include in your issue report.
1305 When reporting a bug, please run through this checklist:
1309 =item What version of Perl you are running?
1311 Type C<perl -v> at the command line to find out.
1313 =item Are you running the latest released version of perl?
1315 Look at L<http://www.perl.org/> to find out. If you are not using the
1316 latest released version, please try to replicate your bug on the
1317 latest stable release.
1319 Note that reports about bugs in old versions of Perl, especially
1320 those which indicate you haven't also tested the current stable
1321 release of Perl, are likely to receive less attention from the
1322 volunteers who build and maintain Perl than reports about bugs in
1323 the current release.
1325 This tool isn't appropriate for reporting bugs in any version
1328 =item Are you sure what you have is a bug?
1330 A significant number of the bug reports we get turn out to be
1331 documented features in Perl. Make sure the issue you've run into
1332 isn't intentional by glancing through the documentation that comes
1333 with the Perl distribution.
1335 Given the sheer volume of Perl documentation, this isn't a trivial
1336 undertaking, but if you can point to documentation that suggests
1337 the behaviour you're seeing is I<wrong>, your issue is likely to
1338 receive more attention. You may want to start with B<perldoc>
1339 L<perltrap> for pointers to common traps that new (and experienced)
1340 Perl programmers run into.
1342 If you're unsure of the meaning of an error message you've run
1343 across, B<perldoc> L<perldiag> for an explanation. If the message
1344 isn't in perldiag, it probably isn't generated by Perl. You may
1345 have luck consulting your operating system documentation instead.
1347 If you are on a non-UNIX platform B<perldoc> L<perlport>, as some
1348 features may be unimplemented or work differently.
1350 You may be able to figure out what's going wrong using the Perl
1351 debugger. For information about how to use the debugger B<perldoc>
1354 =item Do you have a proper test case?
1356 The easier it is to reproduce your bug, the more likely it will be
1357 fixed -- if nobody can duplicate your problem, it probably won't be
1360 A good test case has most of these attributes: short, simple code;
1361 few dependencies on external commands, modules, or libraries; no
1362 platform-dependent code (unless it's a platform-specific bug);
1363 clear, simple documentation.
1365 A good test case is almost always a good candidate to be included in
1366 Perl's test suite. If you have the time, consider writing your test case so
1367 that it can be easily included into the standard test suite.
1369 =item Have you included all relevant information?
1371 Be sure to include the B<exact> error messages, if any.
1372 "Perl gave an error" is not an exact error message.
1374 If you get a core dump (or equivalent), you may use a debugger
1375 (B<dbx>, B<gdb>, etc) to produce a stack trace to include in the bug
1378 NOTE: unless your Perl has been compiled with debug info
1379 (often B<-g>), the stack trace is likely to be somewhat hard to use
1380 because it will most probably contain only the function names and not
1381 their arguments. If possible, recompile your Perl with debug info and
1382 reproduce the crash and the stack trace.
1384 =item Can you describe the bug in plain English?
1386 The easier it is to understand a reproducible bug, the more likely
1387 it will be fixed. Any insight you can provide into the problem
1388 will help a great deal. In other words, try to analyze the problem
1389 (to the extent you can) and report your discoveries.
1391 =item Can you fix the bug yourself?
1393 If so, that's great news; bug reports with patches are likely to
1394 receive significantly more attention and interest than those without
1395 patches. Please submit your patch via the GitHub Pull Request workflow
1396 as described in B<perldoc> L<perlhack>. You may also send patches to
1397 B<perl5-porters@perl.org>. When sending a patch, create it using
1398 C<git format-patch> if possible, though a unified diff created with
1399 C<diff -pu> will do nearly as well.
1401 Your patch may be returned with requests for changes, or requests for more
1402 detailed explanations about your fix.
1404 Here are a few hints for creating high-quality patches:
1406 Make sure the patch is not reversed (the first argument to diff is
1407 typically the original file, the second argument your changed file).
1408 Make sure you test your patch by applying it with C<git am> or the
1409 C<patch> program before you send it on its way. Try to follow the
1410 same style as the code you are trying to patch. Make sure your patch
1411 really does work (C<make test>, if the thing you're patching is covered
1412 by Perl's test suite).
1414 =item Can you use C<perlbug> to submit a thank-you note?
1416 Yes, you can do this by either using the C<-T> option, or by invoking
1417 the program as C<perlthanks>. Thank-you notes are good. It makes people
1422 Please make your issue title informative. "a bug" is not informative.
1423 Neither is "perl crashes" nor is "HELP!!!". These don't help. A compact
1424 description of what's wrong is fine.
1426 Having done your bit, please be prepared to wait, to be told the
1427 bug is in your code, or possibly to get no reply at all. The
1428 volunteers who maintain Perl are busy folks, so if your problem is
1429 an obvious bug in your own code, is difficult to understand or is
1430 a duplicate of an existing report, you may not receive a personal
1433 If it is important to you that your bug be fixed, do monitor the
1434 issue tracker (you will be subscribed to notifications for issues you
1435 submit or comment on) and the commit logs to development
1436 versions of Perl, and encourage the maintainers with kind words or
1437 offers of frosty beverages. (Please do be kind to the maintainers.
1438 Harassing or flaming them is likely to have the opposite effect of the
1441 Feel free to update the ticket about your bug on
1442 L<https://github.com/Perl/perl5/issues>
1443 if a new version of Perl is released and your bug is still present.
1451 Address to send the report to. Defaults to B<perlbug@perl.org>.
1455 Don't send a bug received acknowledgement to the reply address.
1456 Generally it is only a sensible to use this option if you are a
1457 perl maintainer actively watching perl porters for your message to
1462 Body of the report. If not included on the command line, or
1463 in a file with B<-f>, you will get a chance to edit the message.
1467 Don't send copy to administrator.
1471 Address to send copy of report to. Defaults to the address of the
1472 local perl administrator (recorded when perl was built).
1476 Data mode (the default if you redirect or pipe output). This prints out
1477 your configuration data, without mailing anything. You can use this
1478 with B<-v> to get more complete data.
1486 File containing the body of the report. Use this to quickly send a
1491 File to output the results to instead of sending as an email. Useful
1492 particularly when running perlbug on a machine with no direct internet
1497 Prints a brief summary of the options.
1501 Report successful build on this system to perl porters. Forces B<-S>
1502 and B<-C>. Forces and supplies values for B<-s> and B<-b>. Only
1503 prompts for a return address if it cannot guess it (for use with
1504 B<make>). Honors return address specified with B<-r>. You can use this
1505 with B<-v> to get more complete data. Only makes a report if this
1506 system is less than 60 days old.
1510 As B<-ok> except it will report on older systems.
1514 Report unsuccessful build on this system. Forces B<-C>. Forces and
1515 supplies a value for B<-s>, then requires you to edit the report
1516 and say what went wrong. Alternatively, a prepared report may be
1517 supplied using B<-f>. Only prompts for a return address if it
1518 cannot guess it (for use with B<make>). Honors return address
1519 specified with B<-r>. You can use this with B<-v> to get more
1520 complete data. Only makes a report if this system is less than 60
1525 As B<-nok> except it will report on older systems.
1529 The names of one or more patch files or other text attachments to be
1530 included with the report. Multiple files must be separated with commas.
1534 Your return address. The program will ask you to confirm its default
1535 if you don't use this option.
1539 Send without asking for confirmation.
1543 Subject to include with the message. You will be prompted if you don't
1544 supply one on the command line.
1548 Test mode. The target address defaults to B<perlbug-test@perl.org>.
1549 Also makes it possible to command perlbug from a pipe or file, for
1554 Send a thank-you note instead of a bug report.
1558 Include verbose configuration data in the report.
1564 Kenneth Albanowski (E<lt>kjahds@kjahds.comE<gt>), subsequently
1565 I<doc>tored by Gurusamy Sarathy (E<lt>gsar@activestate.comE<gt>),
1566 Tom Christiansen (E<lt>tchrist@perl.comE<gt>), Nathan Torkington
1567 (E<lt>gnat@frii.comE<gt>), Charles F. Randall (E<lt>cfr@pobox.comE<gt>),
1568 Mike Guy (E<lt>mjtg@cam.ac.ukE<gt>), Dominic Dunlop
1569 (E<lt>domo@computer.orgE<gt>), Hugo van der Sanden (E<lt>hv@crypt.orgE<gt>),
1570 Jarkko Hietaniemi (E<lt>jhi@iki.fiE<gt>), Chris Nandor
1571 (E<lt>pudge@pobox.comE<gt>), Jon Orwant (E<lt>orwant@media.mit.eduE<gt>,
1572 Richard Foley (E<lt>richard.foley@rfi.netE<gt>), Jesse Vincent
1573 (E<lt>jesse@bestpractical.comE<gt>), and Craig A. Berry (E<lt>craigberry@mac.comE<gt>).
1577 perl(1), perldebug(1), perldiag(1), perlport(1), perltrap(1),
1578 diff(1), patch(1), dbx(1), gdb(1)
1582 None known (guess what must have been used to report them?)
1588 close OUT or die "Can't close $file: $!";
1589 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
1590 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';