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;
63 use File::Spec; # keep perlbug Perl 5.005 compatible
65 use File::Basename 'basename';
70 eval { require Mail::Send;};
71 $::HaveSend = ($@ eq "");
72 eval { require Mail::Util; } ;
73 $::HaveUtil = ($@ eq "");
74 # use secure tempfiles wherever possible
75 eval { require File::Temp; };
76 $::HaveTemp = ($@ eq "");
77 eval { require Module::CoreList; };
78 $::HaveCoreList = ($@ eq "");
84 # make sure failure (transmission-wise) of Mail::Send is accounted for.
85 # (This may work now. Unsure of the original author's issue -JESSE 2008-06-08)
88 my( $file, $usefile, $cc, $address, $bugaddress, $testaddress, $thanksaddress,
89 $filename, $messageid, $domain, $subject, $from, $verbose, $ed, $outfile,
90 $fh, $me, $body, $andcc, %REP, $ok, $thanks, $progname,
91 $Is_MSWin32, $Is_Linux, $Is_VMS, $Is_OpenBSD,
92 $report_about_module, $category, $severity,
93 %opt, $have_attachment, $attachments, $has_patch, $mime_boundary
96 my $perl_version = $^V ? sprintf("%vd", $^V) : $];
98 my $config_tag2 = "$perl_version - $Config{cf_time}";
102 if ($opt{h}) { Help(); exit; }
103 if ($opt{d}) { Dump(*STDOUT); exit; }
104 if (!-t STDIN && !($ok and not $opt{n})) {
106 Please use $progname interactively. If you want to
107 include a file, you can use the -f switch.
113 Edit() unless $usefile || ($ok and not $opt{n});
116 save_message_to_disk($outfile);
120 print "\nThank you for taking the time to send a thank-you message!\n\n";
123 Please note that mailing lists are moderated, your message may take a while to
127 print "\nThank you for taking the time to file a bug report!\n\n";
130 Please note that mailing lists are moderated, your message may take a while to
131 show up. If you do not receive an automated response acknowledging your message
132 within a few hours (check your SPAM folder and outgoing mail) please consider
133 sending an email directly from your mail client to perlbug\@perl.org.
141 sub ask_for_alternatives { # (category|severity)
147 # Inevitably some of these will end up in RT whatever we do:
148 'thanks' => 'thanks',
149 'opts' => [qw(core docs install library utilities)], # patch, notabug
155 'opts' => [qw(critical high medium low wishlist none)], # zero
158 die "Invalid alternative ($name) requested\n" unless grep(/^$name$/, keys %alts);
160 my $what = $ok || $thanks;
162 $alt = $alts{$name}{$what};
164 my @alts = @{$alts{$name}{'opts'}};
167 Please pick a $name from the following list:
174 die "Invalid $name: aborting.\n";
176 $alt = _prompt('', "\u$name", $alts{$name}{'default'});
177 $alt ||= $alts{$name}{'default'};
178 } while !((($alt) = grep(/^$alt/i, @alts)));
184 # -------- Setup --------
186 $Is_MSWin32 = $^O eq 'MSWin32';
187 $Is_VMS = $^O eq 'VMS';
188 $Is_Linux = lc($^O) eq 'linux';
189 $Is_OpenBSD = lc($^O) eq 'openbsd';
191 if (!getopts("Adhva:s:b:f:F:r:e:SCc:to:n:T:p:", \%opt)) { Help(); exit; };
193 # This comment is needed to notify metaconfig that we are
194 # using the $perladmin, $cf_by, and $cf_time definitions.
196 # -------- Configuration ---------
199 $bugaddress = 'perlbug@perl.org';
202 $testaddress = 'perlbug-test@perl.org';
205 $thanksaddress = 'perl-thanks@perl.org';
207 if (basename ($0) =~ /^perlthanks/i) {
208 # invoked as perlthanks
210 $opt{C} = 1; # don't send a copy to the local admin
217 $progname = $thanks ? 'perlthanks' : 'perlbug';
219 $address = $opt{a} || ($opt{t} ? $testaddress
220 : $thanks ? $thanksaddress : $bugaddress);
222 # Users address, used in message and in From and Reply-To headers
223 $from = $opt{r} || "";
225 # Include verbose configuration information
226 $verbose = $opt{v} || 0;
228 # Subject of bug-report message
229 $subject = $opt{s} || "";
232 $usefile = ($opt{f} || 0);
234 # File to send as report
235 $file = $opt{f} || "";
237 # We have one or more attachments
238 $have_attachment = ($opt{p} || 0);
239 $mime_boundary = ('-' x 12) . "$Version.perlbug" if $have_attachment;
241 # Comma-separated list of attachments
242 $attachments = $opt{p} || "";
243 $has_patch = 0; # TBD based on file type
245 for my $attachment (split /\s*,\s*/, $attachments) {
246 unless (-f $attachment && -r $attachment) {
247 die "The attachment $attachment is not a readable file: $!\n";
249 $has_patch = 1 if $attachment =~ m/\.(patch|diff)$/;
253 $outfile = $opt{F} || "";
256 $body = $opt{b} || "";
259 $ed = $opt{e} || $ENV{VISUAL} || $ENV{EDITOR} || $ENV{EDIT}
260 || ($Is_VMS && "edit/tpu")
261 || ($Is_MSWin32 && "notepad")
264 # Not OK - provide build failure template by finessing OK report
266 if (substr($opt{n}, 0, 2) eq 'ok' ) {
267 $opt{o} = substr($opt{n}, 1);
274 # OK - send "OK" report for build on this system
277 if ($opt{o} eq 'k' or $opt{o} eq 'kay') {
278 my $age = time - $patchlevel_date;
279 if ($opt{o} eq 'k' and $age > 60 * 24 * 60 * 60 ) {
280 my $date = localtime $patchlevel_date;
282 "perlbug -ok" and "perlbug -nok" do not report on Perl versions which
283 are more than 60 days old. This Perl version was constructed on
284 $date. If you really want to report this, use
285 "perlbug -okay" or "perlbug -nokay".
289 # force these options
291 $opt{S} = 1; # don't prompt for send
292 $opt{b} = 1; # we have a body
293 $body = "Perl reported to build OK on this system.\n";
295 $opt{C} = 1; # don't send a copy to the local admin
296 $opt{s} = 1; # we have a subject line
297 $subject = ($opt{n} ? 'Not ' : '')
298 . "OK: perl $perl_version ${patch_tags}on"
299 ." $::Config{'archname'} $::Config{'osvers'} $subject";
307 # Possible administrator addresses, in order of confidence
308 # (Note that cf_email is not mentioned to metaconfig, since
309 # we don't really want it. We'll just take it if we have to.)
311 # This has to be after the $ok stuff above because of the way
312 # that $opt{C} is forced.
313 $cc = $opt{C} ? "" : (
314 $opt{c} || $::Config{'perladmin'}
315 || $::Config{'cf_email'} || $::Config{'cf_by'}
319 $domain = Mail::Util::maildomain();
320 } elsif ($Is_MSWin32) {
321 $domain = $ENV{'USERDOMAIN'};
323 require Sys::Hostname;
324 $domain = Sys::Hostname::hostname();
328 $messageid = "<$::Config{'version'}_${$}_".time."\@$domain>";
331 $me = $Is_MSWin32 ? $ENV{'USERNAME'}
332 : $^O eq 'os2' ? $ENV{'USER'} || $ENV{'LOGNAME'}
333 : eval { getpwuid($<) }; # May be missing
335 $from = $::Config{'cf_email'}
336 if !$from && $::Config{'cf_email'} && $::Config{'cf_by'} && $me &&
337 ($me eq $::Config{'cf_by'});
341 # Explain what perlbug is
345 This program provides an easy way to send a thank-you message back to the
346 authors and maintainers of perl.
348 If you wish to submit a bug report, please run it without the -T flag
349 (or run the program perlbug rather than perlthanks)
353 This program provides an easy way to create a message reporting a
354 bug in the core perl distribution (along with tests or patches)
355 to the volunteers who maintain perl at $address. To send a thank-you
356 note to $thanksaddress instead of a bug report, please run 'perlthanks'.
358 Please do not use $0 to send test messages, test whether perl
359 works, or to report bugs in perl modules from CPAN.
361 Suggestions for how to find help using Perl can be found at
362 http://perldoc.perl.org/perlcommunity.html
367 # Prompt for subject of message, if needed
369 if ($subject && TrivialSubject($subject)) {
375 "First of all, please provide a subject for the message.\n";
378 This should be a concise description of your bug or problem
379 which will help the volunteers working to improve perl to categorize
380 and resolve the issue. Be as specific and descriptive as
381 you can. A subject like "perl bug" or "perl problem" will make it
382 much less likely that your issue gets the attention it deserves.
388 $subject = _prompt('','Subject');
391 $subject = 'Thanks for Perl';
396 } while (TrivialSubject($subject));
398 $subject = '[PATCH] ' . $subject
399 if $has_patch && ($subject !~ m/^\[PATCH/i);
401 # Prompt for return address, if needed
403 # Try and guess return address
406 $guess = $ENV{'REPLY-TO'} || $ENV{'REPLYTO'} || $ENV{'EMAIL'}
410 # move $domain to where we can use it elsewhere
412 if ($Is_VMS && !$::Config{'d_socket'}) {
413 $guess = "$domain\:\:$me";
415 $guess = "$me\@$domain" if $domain;
423 Perl's developers may need your email address to contact you for
424 further information about your issue or to inform you when it is
425 resolved. If the default shown is not your email address, please
431 Please enter your full internet email address so that Perl's
432 developers can contact you with questions about your issue or to
433 inform you that it has been resolved.
442 $from = _prompt('','Your address',$guess);
443 $from = $guess if $from eq '';
447 if ($from eq $cc or $me eq $cc) {
448 # Try not to copy ourselves
452 # Prompt for administrator address, unless an override was given
453 if( !$opt{C} and !$opt{c} ) {
454 my $description = <<EOF;
455 $0 can send a copy of this report to your local perl
456 administrator. If the address below is wrong, please correct it,
457 or enter 'none' or 'yourself' to not send a copy.
459 my $entry = _prompt($description, "Local perl administrator", $cc);
463 $cc = '' if $me eq $cc;
467 $cc = '' if $cc =~ /^(none|yourself|me|myself|ourselves)$/i;
474 # Prompt for editor, if no override is given
476 unless ($opt{e} || $opt{f} || $opt{b}) {
480 chomp (my $common_end = <<"EOF");
481 You will probably want to use a text editor to enter the body of
482 your report. If "$ed" is the editor you want to use, then just press
483 Enter, otherwise type in the name of the editor you would like to
486 If you have already composed the body of your report, you may enter
487 "file", and $0 will prompt you to enter the name of the file
488 containing your report.
492 $description = <<"EOF";
493 It's now time to compose your thank-you message.
495 Some information about your local perl configuration will automatically
496 be included at the end of your message, because we're curious about
497 the different ways that people build and use perl. If you'd rather
498 not share this information, you're welcome to delete it.
503 $description = <<"EOF";
504 It's now time to compose your bug report. Try to make the report
505 concise but descriptive. Please include any detail which you think
506 might be relevant or might help the volunteers working to improve
507 perl. If you are reporting something that does not work as you think
508 it should, please try to include examples of the actual result and of
511 Some information about your local perl configuration will automatically
512 be included at the end of your report. If you are using an unusual
513 version of perl, it would be useful if you could confirm that you
514 can replicate the problem on a standard build of perl as well.
520 my $entry = _prompt($description, "Editor", $ed);
522 if ($entry eq "file") {
524 } elsif ($entry ne "") {
528 if ($::HaveCoreList && !$ok && !$thanks) {
529 my $description = <<EOF;
530 If your bug is about a Perl module rather than a core language
531 feature, please enter its name here. If it's not, just hit Enter
532 to skip this question.
536 while ($entry eq '') {
537 $entry = _prompt($description, 'Module');
538 my $first_release = Module::CoreList->first_release($entry);
539 if ($entry and not $first_release) {
541 $entry is not a "core" Perl module. Please check that you entered
542 its name correctly. If it is correct, quit this program, try searching
543 for $entry on http://rt.cpan.org, and report your issue there.
547 } elsif (my $bug_tracker = $Module::CoreList::bug_tracker{$entry}) {
549 $entry included with core Perl is copied directly from the CPAN distribution.
550 Please report bugs in $entry directly to its maintainers using $bug_tracker
554 $category ||= 'library';
555 $report_about_module = $entry;
563 # Prompt for category of bug
564 $category ||= ask_for_alternatives('category');
566 # Prompt for severity of bug
567 $severity ||= ask_for_alternatives('severity');
569 # Generate scratch file to edit report in
570 $filename = filename();
572 # Prompt for file to read report from, if needed
573 if ($usefile and !$file) {
575 my $description = <<EOF;
576 What is the name of the file that contains your report?
578 my $entry = _prompt($description, "Filename");
582 It seems you didn't enter a filename. Please choose to use a text
583 editor or enter a filename.
588 unless (-f $entry and -r $entry) {
590 '$entry' doesn't seem to be a readable file. You may have mistyped
591 its name or may not have permission to read it.
593 If you don't want to use a file as the content of your report, just
594 hit Enter and you'll be able to select a text editor instead.
602 open(REP,">$filename") or die "Unable to create report file '$filename': $!\n";
603 my $reptype = !$ok ? ($thanks ? 'thank-you' : 'bug')
604 : $opt{n} ? "build failure" : "success";
607 This is a $reptype report for perl from $from,
608 generated with the help of perlbug $Version running under perl $perl_version.
616 or die "Unable to read report file from '$file': $!\n";
620 close(F) or die "Error closing '$file': $!";
625 -----------------------------------------------------------------
626 [Please enter your thank-you message here]
630 [You're welcome to delete anything below this line]
631 -----------------------------------------------------------------
636 -----------------------------------------------------------------
637 [Please describe your issue here]
641 [Please do not change anything below this line]
642 -----------------------------------------------------------------
647 close(REP) or die "Error closing report file: $!";
649 # Set up an initial report fingerprint so we can compare it later
650 _fingerprint_lines_in_report();
657 # these won't have been set if run with -d
658 $category ||= 'core';
675 if ($report_about_module ) {
677 module=$report_about_module
688 print OUT "This perlbug was built using Perl $config_tag1\n",
689 "It is being executed now by Perl $config_tag2.\n\n"
690 if $config_tag2 ne $config_tag1;
693 Site configuration information for perl $perl_version:
696 if ($::Config{cf_by} and $::Config{cf_time}) {
697 print OUT "Configured by $::Config{cf_by} at $::Config{cf_time}.\n\n";
699 print OUT Config::myconfig;
702 print OUT join "\n ", "Locally applied patches:", @patches;
709 \@INC for perl $perl_version:
718 Environment for perl $perl_version:
721 qw(PATH LD_LIBRARY_PATH LANG PERL_BADLANG SHELL HOME LOGDIR LANGUAGE);
722 push @env, $Config{ldlibpthname} if $Config{ldlibpthname} ne '';
723 push @env, grep /^(?:PERL|LC_|LANG|CYGWIN)/, keys %ENV;
726 for my $env (sort keys %env) {
728 exists $ENV{$env} ? "=$ENV{$env}" : ' (unset)',
732 print OUT "\nComplete configuration data for perl $perl_version:\n\n";
734 foreach (sort keys %::Config) {
735 $value = $::Config{$_};
736 $value = '' unless defined $value;
738 print OUT "$_='$value'\n";
745 if ($usefile || $body) {
746 my $description = "Please make sure that the name of the editor you want to use is correct.";
747 my $entry = _prompt($description, 'Editor', $ed);
748 $ed = $entry unless $entry eq '';
757 my $report_written = 0;
759 while ( !$report_written ) {
760 my $exit_status = system("$editor $filename");
763 The editor you chose ('$editor') could not be run!
765 If you mistyped its name, please enter it now, otherwise just press Enter.
767 my $entry = _prompt( $desc, 'Editor', $editor );
768 if ( $entry ne "" ) {
773 You may want to save your report to a file, so you can edit and
779 return if ( $ok and not $opt{n} ) || $body;
781 # Check that we have a report that has some, eh, report in it.
783 unless ( _fingerprint_lines_in_report() ) {
784 my $description = <<EOF;
785 It looks like you didn't enter a report. You may [r]etry your edit
786 or [c]ancel this report.
788 my $action = _prompt( $description, "Action (Retry/Cancel) " );
789 if ( $action =~ /^[re]/i ) { # <R>etry <E>dit
791 } elsif ( $action =~ /^[cq]/i ) { # <C>ancel, <Q>uit
792 Cancel(); # cancel exits
795 # Ok. the user did what they needed to;
803 1 while unlink($filename); # remove all versions under VMS
804 print "\nQuitting without sending your message.\n";
809 # Report is done, prompt for further action
815 You have finished composing your message. At this point, you have
816 a few options. You can:
818 * [Se]nd the message to $address$andcc,
819 * [D]isplay the message on the screen,
820 * [R]e-edit the message
821 * Display or change the message's [su]bject
822 * Save the message to a [f]ile to mail at another time
823 * [Q]uit without sending a message
828 my $action = _prompt('', "Action (Send/Display/Edit/Subject/Save to File)");;
830 if ($action =~ /^(f|sa)/i) { # <F>ile/<Sa>ve
831 if ( SaveMessage() ) { exit }
832 } elsif ($action =~ /^(d|l|sh)/i ) { # <D>isplay, <L>ist, <Sh>ow
833 # Display the message
834 open(REP, "<$filename") or die "Couldn't open file '$filename': $!\n";
835 while (<REP>) { print $_ }
836 close(REP) or die "Error closing report file '$filename': $!";
837 if ($have_attachment) {
838 print "\n\n---\nAttachment(s):\n";
839 for my $att (split /\s*,\s*/, $attachments) { print " $att\n"; }
841 } elsif ($action =~ /^su/i) { # <Su>bject
842 my $reply = _prompt( "Subject: $subject", "If the above subject is fine, press Enter. Otherwise, type a replacement now\nSubject");
844 unless (TrivialSubject($reply)) {
846 print "Subject: $subject\n";
849 } elsif ($action =~ /^se/i) { # <S>end
851 my $reply = _prompt( "Are you certain you want to send this message?", 'Please type "yes" if you are','no');
852 if ($reply =~ /^yes$/) {
856 You didn't type "yes", so your message has not yet been sent.
859 } elsif ($action =~ /^[er]/i) { # <E>dit, <R>e-edit
862 } elsif ($action =~ /^[qc]/i) { # <C>ancel, <Q>uit
864 } elsif ($action =~ /^s/i) {
866 The command you entered was ambiguous. Please type "send", "save" or "subject".
876 /^(y(es)?|no?|help|perl( (bug|problem))?|bug|problem)$/i ||
877 length($subject) < 4 ||
879 print "\nThe subject you entered wasn't very descriptive. Please try again.\n\n";
887 my $file_save = $outfile || "$progname.rep";
888 my $file = _prompt( '', "Name of file to save message in", $file_save );
889 save_message_to_disk($file) || return undef;
892 A copy of your message has been saved in '$file' for you to
893 send to '$address' with your normal mail client.
899 # Message has been accepted for transmission -- Send the message
901 # on linux certain "mail" implementations won't accept the subject
902 # as "~s subject" and thus the Subject header will be corrupted
903 # so don't use Mail::Send to be safe
905 if ( $::HaveSend && !$Is_Linux && !$Is_OpenBSD ) {
906 _send_message_mailsend();
910 _send_message_sendmail();
914 if ( my $error = $@ ) {
916 $0 has detected an error while trying to send your message: $error.
918 Your message may not have been sent. You will now have a chance to save a copy to disk.
924 1 while unlink($filename); # remove all versions under VMS
930 This program is designed to help you generate and send bug reports
931 (and thank-you notes) about perl5 and the modules which ship with it.
933 In most cases, you can just run "$0" interactively from a command
934 line without any special arguments and follow the prompts.
938 $0 [-v] [-a address] [-s subject] [-b body | -f inpufile ] [ -F outputfile ]
939 [-r returnaddress] [-e editor] [-c adminaddress | -C] [-S] [-t] [-h]
941 $0 [-v] [-r returnaddress] [-A] [-ok | -okay | -nok | -nokay]
946 -v Include Verbose configuration data in the report
947 -f File containing the body of the report. Use this to
948 quickly send a prepared message.
949 -p File containing a patch or other text attachment. Separate
950 multiple files with commas.
951 -F File to output the resulting mail message to, instead of mailing.
952 -S Send without asking for confirmation.
953 -a Address to send the report to. Defaults to '$address'.
954 -c Address to send copy of report to. Defaults to '$cc'.
955 -C Don't send copy to administrator.
956 -s Subject to include with the message. You will be prompted
957 if you don't supply one on the command line.
958 -b Body of the report. If not included on the command line, or
959 in a file with -f, you will get a chance to edit the message.
960 -r Your return address. The program will ask you to confirm
961 this if you don't give it here.
963 -t Test mode. The target address defaults to '$testaddress'.
964 -T Thank-you mode. The target address defaults to '$thanksaddress'.
965 -d Data mode. This prints out your configuration data, without mailing
966 anything. You can use this with -v to get more complete data.
967 -A Don't send a bug received acknowledgement to the return address.
968 -ok Report successful build on this system to perl porters
969 (use alone or with -v). Only use -ok if *everything* was ok:
970 if there were *any* problems at all, use -nok.
971 -okay As -ok but allow report from old builds.
972 -nok Report unsuccessful build on this system to perl porters
973 (use alone or with -v). You must describe what went wrong
974 in the body of the report which you will be asked to edit.
975 -nokay As -nok but allow report from old builds.
976 -h Print this help message.
983 # Good. Use a secure temp file
984 my ($fh, $filename) = File::Temp::tempfile(UNLINK => 1);
988 # Bah. Fall back to doing things less securely.
989 my $dir = File::Spec->tmpdir();
990 $filename = "bugrep0$$";
991 $filename++ while -e File::Spec->catfile($dir, $filename);
992 $filename = File::Spec->catfile($dir, $filename);
997 my @paragraphs = split /\n{2,}/, "@_";
998 for (@paragraphs) { # implicit local $_
1006 my ($explanation, $prompt, $default) = (@_);
1009 paraprint $explanation;
1011 print $prompt. ($default ? " [$default]" :''). ": ";
1012 my $result = scalar(<>);
1014 $result =~ s/^\s*(.*?)\s*$/$1/s;
1015 if ($default && $result eq '') {
1026 for my $header (keys %attr) {
1027 $head .= "$header: ".$attr{$header}."\n";
1032 sub _message_headers {
1033 my %headers = ( To => $address, Subject => $subject );
1034 $headers{'Cc'} = $cc if ($cc);
1035 $headers{'Message-Id'} = $messageid if ($messageid);
1036 $headers{'Reply-To'} = $from if ($from);
1037 $headers{'From'} = $from if ($from);
1038 if ($have_attachment) {
1039 $headers{'MIME-Version'} = '1.0';
1040 $headers{'Content-Type'} = qq{multipart/mixed; boundary=\"$mime_boundary\"};
1045 sub _add_body_start {
1046 my $body_start = <<"BODY_START";
1047 This is a multi-part message in MIME format.
1049 Content-Type: text/plain; charset=UTF-8; format=fixed
1050 Content-Transfer-Encoding: 8bit
1056 sub _add_attachments {
1058 for my $attachment (split /\s*,\s*/, $attachments) {
1059 my $attach_file = basename($attachment);
1060 $attach .= <<"ATTACHMENT";
1063 Content-Type: text/x-patch; name="$attach_file"
1064 Content-Transfer-Encoding: 8bit
1065 Content-Disposition: attachment; filename="$attach_file"
1069 open my $attach_fh, '<', $attachment
1070 or die "Couldn't open attachment '$attachment': $!\n";
1071 while (<$attach_fh>) { $attach .= $_; }
1072 close($attach_fh) or die "Error closing attachment '$attachment': $!";
1075 $attach .= "\n--$mime_boundary--\n";
1079 sub build_complete_message {
1080 my $content = _build_header(%{_message_headers()}) . "\n\n";
1081 $content .= _add_body_start() if $have_attachment;
1082 open( REP, "<$filename" ) or die "Couldn't open file '$filename': $!\n";
1083 while (<REP>) { $content .= $_; }
1084 close(REP) or die "Error closing report file '$filename': $!";
1085 $content .= _add_attachments() if $have_attachment;
1089 sub save_message_to_disk {
1092 open OUTFILE, ">$file" or do { warn "Couldn't open '$file': $!\n"; return undef};
1093 print OUTFILE build_complete_message();
1094 close(OUTFILE) or do { warn "Error closing $file: $!"; return undef };
1095 print "\nMessage saved.\n";
1099 sub _send_message_vms {
1101 my $mail_from = $from;
1102 my $rcpt_to_to = $address;
1103 my $rcpt_to_cc = $cc;
1105 map { $_ =~ s/^[^<]*<//;
1106 $_ =~ s/>[^>]*//; } ($mail_from, $rcpt_to_to, $rcpt_to_cc);
1108 if ( open my $sff_fh, '|-', 'MCR TCPIP$SYSTEM:TCPIP$SMTP_SFF.EXE SYS$INPUT:' ) {
1109 print $sff_fh "MAIL FROM:<$mail_from>\n";
1110 print $sff_fh "RCPT TO:<$rcpt_to_to>\n";
1111 print $sff_fh "RCPT TO:<$rcpt_to_cc>\n" if $rcpt_to_cc;
1112 print $sff_fh "DATA\n";
1113 print $sff_fh build_complete_message();
1114 my $success = close $sff_fh;
1116 print "\nMessage sent\n";
1120 die "Mail transport failed (leaving bug report in $filename): $^E\n";
1123 sub _send_message_mailsend {
1124 my $msg = Mail::Send->new();
1125 my %headers = %{_message_headers()};
1126 for my $key ( keys %headers) {
1127 $msg->add($key => $headers{$key});
1131 print $fh _add_body_start() if $have_attachment;
1132 open(REP, "<$filename") or die "Couldn't open '$filename': $!\n";
1133 while (<REP>) { print $fh $_ }
1134 close(REP) or die "Error closing $filename: $!";
1135 print $fh _add_attachments() if $have_attachment;
1136 $fh->close or die "Error sending mail: $!";
1138 print "\nMessage sent.\n";
1141 sub _probe_for_sendmail {
1143 for (qw(/usr/lib/sendmail /usr/sbin/sendmail /usr/ucblib/sendmail)) {
1144 $sendmail = $_, last if -e $_;
1146 if ( $^O eq 'os2' and $sendmail eq "" ) {
1147 my $path = $ENV{PATH};
1149 my @path = split /$Config{'path_sep'}/, $path;
1151 $sendmail = "$_/sendmail", last if -e "$_/sendmail";
1152 $sendmail = "$_/sendmail.exe", last if -e "$_/sendmail.exe";
1158 sub _send_message_sendmail {
1159 my $sendmail = _probe_for_sendmail();
1160 unless ($sendmail) {
1161 my $message_start = !$Is_Linux && !$Is_OpenBSD ? <<'EOT' : <<'EOT';
1162 It appears that there is no program which looks like "sendmail" on
1163 your system and that the Mail::Send library from CPAN isn't available.
1165 It appears that there is no program which looks like "sendmail" on
1168 paraprint(<<"EOF"), die "\n";
1170 Because of this, there's no easy way to automatically send your
1173 A copy of your message has been saved in '$filename' for you to
1174 send to '$address' with your normal mail client.
1178 open( SENDMAIL, "|-", $sendmail, "-t", "-oi", "-f", $from )
1179 || die "'|$sendmail -t -oi -f $from' failed: $!";
1180 print SENDMAIL build_complete_message();
1181 if ( close(SENDMAIL) ) {
1182 print "\nMessage sent\n";
1184 warn "\nSendmail returned status '", $? >> 8, "'\n";
1190 # a strange way to check whether any significant editing
1191 # has been done: check whether any new non-empty lines
1194 sub _fingerprint_lines_in_report {
1196 # read in the report template once so that
1197 # we can track whether the user does any editing.
1198 # yes, *all* whitespace is ignored.
1200 open(REP, "<$filename") or die "Unable to open report file '$filename': $!\n";
1201 while (my $line = <REP>) {
1203 $new_lines++ if (!$REP{$line});
1206 close(REP) or die "Error closing report file '$filename': $!";
1207 # returns the number of lines with content that wasn't there when last we looked
1214 ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
1222 perlbug - how to submit bug reports on Perl
1228 B<perlbug> S<[ B<-v> ]> S<[ B<-a> I<address> ]> S<[ B<-s> I<subject> ]>
1229 S<[ B<-b> I<body> | B<-f> I<inputfile> ]> S<[ B<-F> I<outputfile> ]>
1230 S<[ B<-r> I<returnaddress> ]>
1231 S<[ B<-e> I<editor> ]> S<[ B<-c> I<adminaddress> | B<-C> ]>
1232 S<[ B<-S> ]> S<[ B<-t> ]> S<[ B<-d> ]> S<[ B<-A> ]> S<[ B<-h> ]> S<[ B<-T> ]>
1234 B<perlbug> S<[ B<-v> ]> S<[ B<-r> I<returnaddress> ]>
1235 S<[ B<-A> ]> S<[ B<-ok> | B<-okay> | B<-nok> | B<-nokay> ]>
1242 This program is designed to help you generate and send bug reports
1243 (and thank-you notes) about perl5 and the modules which ship with it.
1245 In most cases, you can just run it interactively from a command
1246 line without any special arguments and follow the prompts.
1248 If you have found a bug with a non-standard port (one that was not
1249 part of the I<standard distribution>), a binary distribution, or a
1250 non-core module (such as Tk, DBI, etc), then please see the
1251 documentation that came with that distribution to determine the
1252 correct place to report bugs.
1254 If you are unable to send your report using B<perlbug> (most likely
1255 because your system doesn't have a way to send mail that perlbug
1256 recognizes), you may be able to use this tool to compose your report
1257 and save it to a file which you can then send to B<perlbug@perl.org>
1258 using your regular mail client.
1260 In extreme cases, B<perlbug> may not work well enough on your system
1261 to guide you through composing a bug report. In those cases, you
1262 may be able to use B<perlbug -d> to get system configuration
1263 information to include in a manually composed bug report to
1264 B<perlbug@perl.org>.
1267 When reporting a bug, please run through this checklist:
1271 =item What version of Perl you are running?
1273 Type C<perl -v> at the command line to find out.
1275 =item Are you running the latest released version of perl?
1277 Look at http://www.perl.org/ to find out. If you are not using the
1278 latest released version, please try to replicate your bug on the
1279 latest stable release.
1281 Note that reports about bugs in old versions of Perl, especially
1282 those which indicate you haven't also tested the current stable
1283 release of Perl, are likely to receive less attention from the
1284 volunteers who build and maintain Perl than reports about bugs in
1285 the current release.
1287 This tool isn't appropriate for reporting bugs in any version
1290 =item Are you sure what you have is a bug?
1292 A significant number of the bug reports we get turn out to be
1293 documented features in Perl. Make sure the issue you've run into
1294 isn't intentional by glancing through the documentation that comes
1295 with the Perl distribution.
1297 Given the sheer volume of Perl documentation, this isn't a trivial
1298 undertaking, but if you can point to documentation that suggests
1299 the behaviour you're seeing is I<wrong>, your issue is likely to
1300 receive more attention. You may want to start with B<perldoc>
1301 L<perltrap> for pointers to common traps that new (and experienced)
1302 Perl programmers run into.
1304 If you're unsure of the meaning of an error message you've run
1305 across, B<perldoc> L<perldiag> for an explanation. If the message
1306 isn't in perldiag, it probably isn't generated by Perl. You may
1307 have luck consulting your operating system documentation instead.
1309 If you are on a non-UNIX platform B<perldoc> L<perlport>, as some
1310 features may be unimplemented or work differently.
1312 You may be able to figure out what's going wrong using the Perl
1313 debugger. For information about how to use the debugger B<perldoc>
1316 =item Do you have a proper test case?
1318 The easier it is to reproduce your bug, the more likely it will be
1319 fixed -- if nobody can duplicate your problem, it probably won't be
1322 A good test case has most of these attributes: short, simple code;
1323 few dependencies on external commands, modules, or libraries; no
1324 platform-dependent code (unless it's a platform-specific bug);
1325 clear, simple documentation.
1327 A good test case is almost always a good candidate to be included in
1328 Perl's test suite. If you have the time, consider writing your test case so
1329 that it can be easily included into the standard test suite.
1331 =item Have you included all relevant information?
1333 Be sure to include the B<exact> error messages, if any.
1334 "Perl gave an error" is not an exact error message.
1336 If you get a core dump (or equivalent), you may use a debugger
1337 (B<dbx>, B<gdb>, etc) to produce a stack trace to include in the bug
1340 NOTE: unless your Perl has been compiled with debug info
1341 (often B<-g>), the stack trace is likely to be somewhat hard to use
1342 because it will most probably contain only the function names and not
1343 their arguments. If possible, recompile your Perl with debug info and
1344 reproduce the crash and the stack trace.
1346 =item Can you describe the bug in plain English?
1348 The easier it is to understand a reproducible bug, the more likely
1349 it will be fixed. Any insight you can provide into the problem
1350 will help a great deal. In other words, try to analyze the problem
1351 (to the extent you can) and report your discoveries.
1353 =item Can you fix the bug yourself?
1355 If so, that's great news; bug reports with patches are likely to
1356 receive significantly more attention and interest than those without
1357 patches. Please attach your patch to the report using the C<-p> option.
1358 When sending a patch, create it using C<git format-patch> if possible,
1359 though a unified diff created with C<diff -pu> will do nearly as well.
1361 Your patch may be returned with requests for changes, or requests for more
1362 detailed explanations about your fix.
1364 Here are a few hints for creating high-quality patches:
1366 Make sure the patch is not reversed (the first argument to diff is
1367 typically the original file, the second argument your changed file).
1368 Make sure you test your patch by applying it with C<git am> or the
1369 C<patch> program before you send it on its way. Try to follow the
1370 same style as the code you are trying to patch. Make sure your patch
1371 really does work (C<make test>, if the thing you're patching is covered
1372 by Perl's test suite).
1374 =item Can you use C<perlbug> to submit the report?
1376 B<perlbug> will, amongst other things, ensure your report includes
1377 crucial information about your version of perl. If C<perlbug> is
1378 unable to mail your report after you have typed it in, you may have
1379 to compose the message yourself, add the output produced by C<perlbug
1380 -d> and email it to B<perlbug@perl.org>. If, for some reason, you
1381 cannot run C<perlbug> at all on your system, be sure to include the
1382 entire output produced by running C<perl -V> (note the uppercase V).
1384 Whether you use C<perlbug> or send the email manually, please make
1385 your Subject line informative. "a bug" is not informative. Neither
1386 is "perl crashes" nor is "HELP!!!". These don't help. A compact
1387 description of what's wrong is fine.
1389 =item Can you use C<perlbug> to submit a thank-you note?
1391 Yes, you can do this by either using the C<-T> option, or by invoking
1392 the program as C<perlthanks>. Thank-you notes are good. It makes people
1397 Having done your bit, please be prepared to wait, to be told the
1398 bug is in your code, or possibly to get no reply at all. The
1399 volunteers who maintain Perl are busy folks, so if your problem is
1400 an obvious bug in your own code, is difficult to understand or is
1401 a duplicate of an existing report, you may not receive a personal
1404 If it is important to you that your bug be fixed, do monitor the
1405 perl5-porters@perl.org mailing list (mailing lists are moderated, your
1406 message may take a while to show up) and the commit logs to development
1407 versions of Perl, and encourage the maintainers with kind words or
1408 offers of frosty beverages. (Please do be kind to the maintainers.
1409 Harassing or flaming them is likely to have the opposite effect of the
1412 Feel free to update the ticket about your bug on http://rt.perl.org
1413 if a new version of Perl is released and your bug is still present.
1421 Address to send the report to. Defaults to B<perlbug@perl.org>.
1425 Don't send a bug received acknowledgement to the reply address.
1426 Generally it is only a sensible to use this option if you are a
1427 perl maintainer actively watching perl porters for your message to
1432 Body of the report. If not included on the command line, or
1433 in a file with B<-f>, you will get a chance to edit the message.
1437 Don't send copy to administrator.
1441 Address to send copy of report to. Defaults to the address of the
1442 local perl administrator (recorded when perl was built).
1446 Data mode (the default if you redirect or pipe output). This prints out
1447 your configuration data, without mailing anything. You can use this
1448 with B<-v> to get more complete data.
1456 File containing the body of the report. Use this to quickly send a
1461 File to output the results to instead of sending as an email. Useful
1462 particularly when running perlbug on a machine with no direct internet
1467 Prints a brief summary of the options.
1471 Report successful build on this system to perl porters. Forces B<-S>
1472 and B<-C>. Forces and supplies values for B<-s> and B<-b>. Only
1473 prompts for a return address if it cannot guess it (for use with
1474 B<make>). Honors return address specified with B<-r>. You can use this
1475 with B<-v> to get more complete data. Only makes a report if this
1476 system is less than 60 days old.
1480 As B<-ok> except it will report on older systems.
1484 Report unsuccessful build on this system. Forces B<-C>. Forces and
1485 supplies a value for B<-s>, then requires you to edit the report
1486 and say what went wrong. Alternatively, a prepared report may be
1487 supplied using B<-f>. Only prompts for a return address if it
1488 cannot guess it (for use with B<make>). Honors return address
1489 specified with B<-r>. You can use this with B<-v> to get more
1490 complete data. Only makes a report if this system is less than 60
1495 As B<-nok> except it will report on older systems.
1499 The names of one or more patch files or other text attachments to be
1500 included with the report. Multiple files must be separated with commas.
1504 Your return address. The program will ask you to confirm its default
1505 if you don't use this option.
1509 Send without asking for confirmation.
1513 Subject to include with the message. You will be prompted if you don't
1514 supply one on the command line.
1518 Test mode. The target address defaults to B<perlbug-test@perl.org>.
1522 Send a thank-you note instead of a bug report.
1526 Include verbose configuration data in the report.
1532 Kenneth Albanowski (E<lt>kjahds@kjahds.comE<gt>), subsequently
1533 I<doc>tored by Gurusamy Sarathy (E<lt>gsar@activestate.comE<gt>),
1534 Tom Christiansen (E<lt>tchrist@perl.comE<gt>), Nathan Torkington
1535 (E<lt>gnat@frii.comE<gt>), Charles F. Randall (E<lt>cfr@pobox.comE<gt>),
1536 Mike Guy (E<lt>mjtg@cam.ac.ukE<gt>), Dominic Dunlop
1537 (E<lt>domo@computer.orgE<gt>), Hugo van der Sanden (E<lt>hv@crypt.orgE<gt>),
1538 Jarkko Hietaniemi (E<lt>jhi@iki.fiE<gt>), Chris Nandor
1539 (E<lt>pudge@pobox.comE<gt>), Jon Orwant (E<lt>orwant@media.mit.eduE<gt>,
1540 Richard Foley (E<lt>richard.foley@rfi.netE<gt>), Jesse Vincent
1541 (E<lt>jesse@bestpractical.comE<gt>), and Craig A. Berry (E<lt>craigberry@mac.comE<gt>).
1545 perl(1), perldebug(1), perldiag(1), perlport(1), perltrap(1),
1546 diff(1), patch(1), dbx(1), gdb(1)
1550 None known (guess what must have been used to report them?)
1556 close OUT or die "Can't close $file: $!";
1557 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
1558 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';