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
44 next if /PERL_GIT_UNPUSHED_COMMITS/; # XXX expand instead
45 next if /"uncommitted-changes"/; # XXX determine if active instead
50 push @patches, $_ unless $_ eq 'NULL';
52 my $patch_desc = "'" . join("',\n '", @patches) . "'";
53 my $patch_tags = join "", map /(\S+)/ ? "+$1 " : (), @patches;
55 close(PATCH_LEVEL) or die "Error closing patchlevel.h: $!";
57 # TO DO (prehaps): store/embed $Config::config_sh into perlbug. When perlbug is
58 # used, compare $Config::config_sh with the stored version. If they differ then
59 # append a list of individual differences to the bug report.
62 print "Extracting $file (with variable substitutions)\n";
64 # In this section, perl variables will be expanded during extraction.
65 # You can use $Config{...} to use Configure variables.
67 my $extract_version = sprintf("%vd", $^V);
69 print OUT <<"!GROK!THIS!";
71 eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
72 if \$running_under_some_shell;
74 my \$config_tag1 = '$extract_version - $Config{cf_time}';
76 my \$patchlevel_date = $patchlevel_date;
77 my \$patch_tags = '$patch_tags';
83 # In the following, perl variables are not expanded during extraction.
85 print OUT <<'!NO!SUBS!';
90 use File::Spec; # keep perlbug Perl 5.005 compatible
92 use File::Basename 'basename';
97 eval { require Mail::Send;};
98 $::HaveSend = ($@ eq "");
99 eval { require Mail::Util; } ;
100 $::HaveUtil = ($@ eq "");
101 # use secure tempfiles wherever possible
102 eval { require File::Temp; };
103 $::HaveTemp = ($@ eq "");
104 eval { require Module::CoreList; };
105 $::HaveCoreList = ($@ eq "");
108 my $Version = "1.39";
111 # make sure failure (transmission-wise) of Mail::Send is accounted for.
112 # (This may work now. Unsure of the original author's issue -JESSE 2008-06-08)
115 my( $file, $usefile, $cc, $address, $bugaddress, $testaddress, $thanksaddress,
116 $filename, $messageid, $domain, $subject, $from, $verbose, $ed, $outfile,
117 $fh, $me, $body, $andcc, %REP, $ok, $thanks, $progname,
118 $Is_MSWin32, $Is_Linux, $Is_VMS, $Is_OpenBSD,
119 $report_about_module, $category, $severity,
123 my $perl_version = $^V ? sprintf("%vd", $^V) : $];
125 my $config_tag2 = "$perl_version - $Config{cf_time}";
129 if ($opt{h}) { Help(); exit; }
130 if ($opt{d}) { Dump(*STDOUT); exit; }
131 if (!-t STDIN && !($ok and not $opt{n})) {
133 Please use $progname interactively. If you want to
134 include a file, you can use the -f switch.
140 Edit() unless $usefile || ($ok and not $opt{n});
143 save_message_to_disk($outfile);
147 print "\nThank you for taking the time to send a thank-you message!\n\n";
149 print "\nThank you for taking the time to file a bug report!\n\n";
155 sub ask_for_alternatives { # (category|severity)
161 # Inevitably some of these will end up in RT whatever we do:
162 'thanks' => 'thanks',
163 'opts' => [qw(core docs install library utilities)], # patch, notabug
169 'opts' => [qw(critical high medium low wishlist none)], # zero
172 die "Invalid alternative ($name) requested\n" unless grep(/^$name$/, keys %alts);
174 my $what = $ok || $thanks;
176 $alt = $alts{$name}{$what};
178 my @alts = @{$alts{$name}{'opts'}};
181 Please pick a $name from the following list:
188 die "Invalid $name: aborting.\n";
190 $alt = _prompt('', "\u$name", $alts{$name}{'default'});
191 $alt ||= $alts{$name}{'default'};
192 } while !((($alt) = grep(/^$alt/i, @alts)));
198 # -------- Setup --------
200 $Is_MSWin32 = $^O eq 'MSWin32';
201 $Is_VMS = $^O eq 'VMS';
202 $Is_Linux = lc($^O) eq 'linux';
203 $Is_OpenBSD = lc($^O) eq 'openbsd';
205 if (!getopts("Adhva:s:b:f:F:r:e:SCc:to:n:T", \%opt)) { Help(); exit; };
207 # This comment is needed to notify metaconfig that we are
208 # using the $perladmin, $cf_by, and $cf_time definitions.
210 # -------- Configuration ---------
213 $bugaddress = 'perlbug@perl.org';
216 $testaddress = 'perlbug-test@perl.org';
219 $thanksaddress = 'perl-thanks@perl.org';
221 if (basename ($0) =~ /^perlthanks/i) {
222 # invoked as perlthanks
224 $opt{C} = 1; # don't send a copy to the local admin
231 $progname = $thanks ? 'perlthanks' : 'perlbug';
233 $address = $opt{a} || ($opt{t} ? $testaddress
234 : $thanks ? $thanksaddress : $bugaddress);
236 # Users address, used in message and in From and Reply-To headers
237 $from = $opt{r} || "";
239 # Include verbose configuration information
240 $verbose = $opt{v} || 0;
242 # Subject of bug-report message
243 $subject = $opt{s} || "";
246 $usefile = ($opt{f} || 0);
248 # File to send as report
249 $file = $opt{f} || "";
252 $outfile = $opt{F} || "";
255 $body = $opt{b} || "";
258 $ed = $opt{e} || $ENV{VISUAL} || $ENV{EDITOR} || $ENV{EDIT}
259 || ($Is_VMS && "edit/tpu")
260 || ($Is_MSWin32 && "notepad")
263 # Not OK - provide build failure template by finessing OK report
265 if (substr($opt{n}, 0, 2) eq 'ok' ) {
266 $opt{o} = substr($opt{n}, 1);
273 # OK - send "OK" report for build on this system
276 if ($opt{o} eq 'k' or $opt{o} eq 'kay') {
277 my $age = time - $patchlevel_date;
278 if ($opt{o} eq 'k' and $age > 60 * 24 * 60 * 60 ) {
279 my $date = localtime $patchlevel_date;
281 "perlbug -ok" and "perlbug -nok" do not report on Perl versions which
282 are more than 60 days old. This Perl version was constructed on
283 $date. If you really want to report this, use
284 "perlbug -okay" or "perlbug -nokay".
288 # force these options
290 $opt{S} = 1; # don't prompt for send
291 $opt{b} = 1; # we have a body
292 $body = "Perl reported to build OK on this system.\n";
294 $opt{C} = 1; # don't send a copy to the local admin
295 $opt{s} = 1; # we have a subject line
296 $subject = ($opt{n} ? 'Not ' : '')
297 . "OK: perl $perl_version ${patch_tags}on"
298 ." $::Config{'archname'} $::Config{'osvers'} $subject";
306 # Possible administrator addresses, in order of confidence
307 # (Note that cf_email is not mentioned to metaconfig, since
308 # we don't really want it. We'll just take it if we have to.)
310 # This has to be after the $ok stuff above because of the way
311 # that $opt{C} is forced.
312 $cc = $opt{C} ? "" : (
313 $opt{c} || $::Config{'perladmin'}
314 || $::Config{'cf_email'} || $::Config{'cf_by'}
318 $domain = Mail::Util::maildomain();
319 } elsif ($Is_MSWin32) {
320 $domain = $ENV{'USERDOMAIN'};
322 require Sys::Hostname;
323 $domain = Sys::Hostname::hostname();
327 $messageid = "<$::Config{'version'}_${$}_".time."\@$domain>";
330 $me = $Is_MSWin32 ? $ENV{'USERNAME'}
331 : $^O eq 'os2' ? $ENV{'USER'} || $ENV{'LOGNAME'}
332 : eval { getpwuid($<) }; # May be missing
334 $from = $::Config{'cf_email'}
335 if !$from && $::Config{'cf_email'} && $::Config{'cf_by'} && $me &&
336 ($me eq $::Config{'cf_by'});
340 # Explain what perlbug is
344 This program provides an easy way to send a thank-you message back to the
345 authors and maintainers of perl.
347 If you wish to submit a bug report, please run it without the -T flag
348 (or run the program perlbug rather than perlthanks)
352 This program provides an easy way to create a message reporting a
353 bug in the core perl distribution (along with tests or patches)
354 to the volunteers who maintain perl at $address. To send a thank-you
355 note to $thanksaddress instead of a bug report, please run 'perlthanks'.
357 Please do not use $0 to send test messages, test whether perl
358 works, or to report bugs in perl modules from CPAN.
360 Suggestions for how to find help using Perl can be found at
361 http://perldoc.perl.org/perlcommunity.html
366 # Prompt for subject of message, if needed
368 if ($subject && TrivialSubject($subject)) {
374 "First of all, please provide a subject for the message.\n";
377 This should be a concise description of your bug or problem
378 which will help the volunteers working to improve perl to categorize
379 and resolve the issue. Be as specific and descriptive as
380 you can. A subject like "perl bug" or "perl problem" will make it
381 much less likely that your issue gets the attention it deserves.
387 $subject = _prompt('','Subject');
390 $subject = 'Thanks for Perl';
395 } while (TrivialSubject($subject));
398 # Prompt for return address, if needed
400 # Try and guess return address
403 $guess = $ENV{'REPLY-TO'} || $ENV{'REPLYTO'} || $ENV{'EMAIL'}
407 # move $domain to where we can use it elsewhere
409 if ($Is_VMS && !$::Config{'d_socket'}) {
410 $guess = "$domain\:\:$me";
412 $guess = "$me\@$domain" if $domain;
420 Perl's developers may need your email address to contact you for
421 further information about your issue or to inform you when it is
422 resolved. If the default shown is not your email address, please
428 Please enter your full internet email address so that Perl's
429 developers can contact you with questions about your issue or to
430 inform you that it has been resolved.
439 $from = _prompt('','Your address',$guess);
440 $from = $guess if $from eq '';
444 if ($from eq $cc or $me eq $cc) {
445 # Try not to copy ourselves
449 # Prompt for administrator address, unless an override was given
450 if( !$opt{C} and !$opt{c} ) {
451 my $description = <<EOF;
452 $0 can send a copy of this report to your local perl
453 administrator. If the address below is wrong, please correct it,
454 or enter 'none' or 'yourself' to not send a copy.
456 my $entry = _prompt($description, "Local perl administrator", $cc);
460 $cc = '' if $me eq $cc;
464 $cc = '' if $cc =~ /^(none|yourself|me|myself|ourselves)$/i;
471 # Prompt for editor, if no override is given
473 unless ($opt{e} || $opt{f} || $opt{b}) {
477 chomp (my $common_end = <<"EOF");
478 You will probably want to use a text editor to enter the body of
479 your report. If "$ed" is the editor you want to use, then just press
480 Enter, otherwise type in the name of the editor you would like to
483 If you have already composed the body of your report, you may enter
484 "file", and $0 will prompt you to enter the name of the file
485 containing your report.
489 $description = <<"EOF";
490 It's now time to compose your thank-you message.
492 Some information about your local perl configuration will automatically
493 be included at the end of your message, because we're curious about
494 the different ways that people build and use perl. If you'd rather
495 not share this information, you're welcome to delete it.
500 $description = <<"EOF";
501 It's now time to compose your bug report. Try to make the report
502 concise but descriptive. Please include any detail which you think
503 might be relevant or might help the volunteers working to improve
504 perl. If you are reporting something that does not work as you think
505 it should, please try to include examples of the actual result and of
508 Some information about your local perl configuration will automatically
509 be included at the end of your report. If you are using an unusual
510 version of perl, it would be useful if you could confirm that you
511 can replicate the problem on a standard build of perl as well.
517 my $entry = _prompt($description, "Editor", $ed);
519 if ($entry eq "file") {
521 } elsif ($entry ne "") {
525 if ($::HaveCoreList && !$ok && !$thanks) {
526 my $description = <<EOF;
527 If your bug is about a Perl module rather than a core language
528 feature, please enter its name here. If it's not, just hit Enter
529 to skip this question.
533 while ($entry eq '') {
534 $entry = _prompt($description, 'Module');
535 my $first_release = Module::CoreList->first_release($entry);
536 if ($entry and not $first_release) {
538 $entry is not a "core" Perl module. Please check that you entered
539 its name correctly. If it is correct, quit this program, try searching
540 for $entry on http://rt.cpan.org, and report your issue there.
544 } elsif (my $bug_tracker = $Module::CoreList::bug_tracker{$entry}) {
546 $entry included with core Perl is copied directly from the CPAN distribution.
547 Please report bugs in $entry directly to its maintainers using $bug_tracker
551 $category ||= 'library';
552 $report_about_module = $entry;
560 # Prompt for category of bug
561 $category ||= ask_for_alternatives('category');
563 # Prompt for severity of bug
564 $severity ||= ask_for_alternatives('severity');
566 # Generate scratch file to edit report in
567 $filename = filename();
569 # Prompt for file to read report from, if needed
570 if ($usefile and !$file) {
572 my $description = <<EOF;
573 What is the name of the file that contains your report?
575 my $entry = _prompt($description, "Filename");
579 It seems you didn't enter a filename. Please choose to use a text
580 editor or enter a filename.
585 unless (-f $entry and -r $entry) {
587 '$entry' doesn't seem to be a readable file. You may have mistyped
588 its name or may not have permission to read it.
590 If you don't want to use a file as the content of your report, just
591 hit Enter and you'll be able to select a text editor instead.
599 open(REP,">$filename") or die "Unable to create report file '$filename': $!\n";
600 my $reptype = !$ok ? ($thanks ? 'thank-you' : 'bug')
601 : $opt{n} ? "build failure" : "success";
604 This is a $reptype report for perl from $from,
605 generated with the help of perlbug $Version running under perl $perl_version.
613 or die "Unable to read report file from '$file': $!\n";
617 close(F) or die "Error closing '$file': $!";
622 -----------------------------------------------------------------
623 [Please enter your thank-you message here]
627 [You're welcome to delete anything below this line]
628 -----------------------------------------------------------------
633 -----------------------------------------------------------------
634 [Please describe your issue here]
638 [Please do not change anything below this line]
639 -----------------------------------------------------------------
644 close(REP) or die "Error closing report file: $!";
646 # Set up an initial report fingerprint so we can compare it later
647 _fingerprint_lines_in_report();
654 # these won't have been set if run with -d
655 $category ||= 'core';
665 if ($report_about_module ) {
667 module=$report_about_module
678 print OUT "This perlbug was built using Perl $config_tag1\n",
679 "It is being executed now by Perl $config_tag2.\n\n"
680 if $config_tag2 ne $config_tag1;
683 Site configuration information for perl $perl_version:
686 if ($::Config{cf_by} and $::Config{cf_time}) {
687 print OUT "Configured by $::Config{cf_by} at $::Config{cf_time}.\n\n";
689 print OUT Config::myconfig;
692 print OUT join "\n ", "Locally applied patches:", @patches;
699 \@INC for perl $perl_version:
708 Environment for perl $perl_version:
711 qw(PATH LD_LIBRARY_PATH LANG PERL_BADLANG SHELL HOME LOGDIR LANGUAGE);
712 push @env, $Config{ldlibpthname} if $Config{ldlibpthname} ne '';
713 push @env, grep /^(?:PERL|LC_|LANG|CYGWIN)/, keys %ENV;
716 for my $env (sort keys %env) {
718 exists $ENV{$env} ? "=$ENV{$env}" : ' (unset)',
722 print OUT "\nComplete configuration data for perl $perl_version:\n\n";
724 foreach (sort keys %::Config) {
725 $value = $::Config{$_};
726 $value = '' unless defined $value;
728 print OUT "$_='$value'\n";
735 if ($usefile || $body) {
736 my $description = "Please make sure that the name of the editor you want to use is correct.";
737 my $entry = _prompt($description, 'Editor', $ed);
738 $ed = $entry unless $entry eq '';
747 my $report_written = 0;
749 while ( !$report_written ) {
750 my $exit_status = system("$editor $filename");
753 The editor you chose ('$editor') could not be run!
755 If you mistyped its name, please enter it now, otherwise just press Enter.
757 my $entry = _prompt( $desc, 'Editor', $editor );
758 if ( $entry ne "" ) {
763 You may want to save your report to a file, so you can edit and
769 return if ( $ok and not $opt{n} ) || $body;
771 # Check that we have a report that has some, eh, report in it.
773 unless ( _fingerprint_lines_in_report() ) {
774 my $description = <<EOF;
775 It looks like you didn't enter a report. You may [r]etry your edit
776 or [c]ancel this report.
778 my $action = _prompt( $description, "Action (Retry/Cancel) " );
779 if ( $action =~ /^[re]/i ) { # <R>etry <E>dit
781 } elsif ( $action =~ /^[cq]/i ) { # <C>ancel, <Q>uit
782 Cancel(); # cancel exits
785 # Ok. the user did what they needed to;
793 1 while unlink($filename); # remove all versions under VMS
794 print "\nQuitting without sending your message.\n";
799 # Report is done, prompt for further action
805 You have finished composing your message. At this point, you have
806 a few options. You can:
808 * [Se]nd the message to $address$andcc,
809 * [D]isplay the message on the screen,
810 * [R]e-edit the message
811 * Display or change the message's [su]bject
812 * Save the message to a [f]ile to mail at another time
813 * [Q]uit without sending a message
818 my $action = _prompt('', "Action (Send/Display/Edit/Subject/Save to File)");;
820 if ($action =~ /^(f|sa)/i) { # <F>ile/<Sa>ve
821 if ( SaveMessage() ) { exit }
822 } elsif ($action =~ /^(d|l|sh)/i ) { # <D>isplay, <L>ist, <Sh>ow
823 # Display the message
824 open(REP, "<$filename") or die "Couldn't open file '$filename': $!\n";
825 while (<REP>) { print $_ }
826 close(REP) or die "Error closing report file '$filename': $!";
827 } elsif ($action =~ /^su/i) { # <Su>bject
828 my $reply = _prompt( "Subject: $subject", "If the above subject is fine, press Enter. Otherwise, type a replacement now\nSubject");
830 unless (TrivialSubject($reply)) {
832 print "Subject: $subject\n";
835 } elsif ($action =~ /^se/i) { # <S>end
837 my $reply = _prompt( "Are you certain you want to send this message?", 'Please type "yes" if you are','no');
838 if ($reply =~ /^yes$/) {
842 You didn't type "yes", so your message has not yet been sent.
845 } elsif ($action =~ /^[er]/i) { # <E>dit, <R>e-edit
848 } elsif ($action =~ /^[qc]/i) { # <C>ancel, <Q>uit
850 } elsif ($action =~ /^s/i) {
852 The command you entered was ambiguous. Please type "send", "save" or "subject".
862 /^(y(es)?|no?|help|perl( (bug|problem))?|bug|problem)$/i ||
863 length($subject) < 4 ||
865 print "\nThe subject you entered wasn't very descriptive. Please try again.\n\n";
873 my $file_save = $outfile || "$progname.rep";
874 my $file = _prompt( '', "Name of file to save message in", $file_save );
875 save_message_to_disk($file) || return undef;
878 A copy of your message has been saved in '$file' for you to
879 send to '$address' with your normal mail client.
885 # Message has been accepted for transmission -- Send the message
887 # on linux certain "mail" implementations won't accept the subject
888 # as "~s subject" and thus the Subject header will be corrupted
889 # so don't use Mail::Send to be safe
891 if ( $::HaveSend && !$Is_Linux && !$Is_OpenBSD ) {
892 _send_message_mailsend();
896 _send_message_sendmail();
900 if ( my $error = $@ ) {
902 $0 has detected an error while trying to send your message: $error.
904 Your message may not have been sent. You will now have a chance to save a copy to disk.
910 1 while unlink($filename); # remove all versions under VMS
916 This program is designed to help you generate and send bug reports
917 (and thank-you notes) about perl5 and the modules which ship with it.
919 In most cases, you can just run "$0" interactively from a command
920 line without any special arguments and follow the prompts.
924 $0 [-v] [-a address] [-s subject] [-b body | -f inpufile ] [ -F outputfile ]
925 [-r returnaddress] [-e editor] [-c adminaddress | -C] [-S] [-t] [-h]
926 $0 [-v] [-r returnaddress] [-A] [-ok | -okay | -nok | -nokay]
931 -v Include Verbose configuration data in the report
932 -f File containing the body of the report. Use this to
933 quickly send a prepared message.
934 -F File to output the resulting mail message to, instead of mailing.
935 -S Send without asking for confirmation.
936 -a Address to send the report to. Defaults to '$address'.
937 -c Address to send copy of report to. Defaults to '$cc'.
938 -C Don't send copy to administrator.
939 -s Subject to include with the message. You will be prompted
940 if you don't supply one on the command line.
941 -b Body of the report. If not included on the command line, or
942 in a file with -f, you will get a chance to edit the message.
943 -r Your return address. The program will ask you to confirm
944 this if you don't give it here.
946 -t Test mode. The target address defaults to '$testaddress'.
947 -T Thank-you mode. The target address defaults to '$thanksaddress'.
948 -d Data mode. This prints out your configuration data, without mailing
949 anything. You can use this with -v to get more complete data.
950 -A Don't send a bug received acknowledgement to the return address.
951 -ok Report successful build on this system to perl porters
952 (use alone or with -v). Only use -ok if *everything* was ok:
953 if there were *any* problems at all, use -nok.
954 -okay As -ok but allow report from old builds.
955 -nok Report unsuccessful build on this system to perl porters
956 (use alone or with -v). You must describe what went wrong
957 in the body of the report which you will be asked to edit.
958 -nokay As -nok but allow report from old builds.
959 -h Print this help message.
966 # Good. Use a secure temp file
967 my ($fh, $filename) = File::Temp::tempfile(UNLINK => 1);
971 # Bah. Fall back to doing things less securely.
972 my $dir = File::Spec->tmpdir();
973 $filename = "bugrep0$$";
974 $filename++ while -e File::Spec->catfile($dir, $filename);
975 $filename = File::Spec->catfile($dir, $filename);
980 my @paragraphs = split /\n{2,}/, "@_";
981 for (@paragraphs) { # implicit local $_
989 my ($explanation, $prompt, $default) = (@_);
992 paraprint $explanation;
994 print $prompt. ($default ? " [$default]" :''). ": ";
995 my $result = scalar(<>);
997 $result =~ s/^\s*(.*?)\s*$/$1/s;
998 if ($default && $result eq '') {
1009 for my $header (keys %attr) {
1010 $head .= "$header: ".$attr{$header}."\n";
1015 sub _message_headers {
1016 my %headers = ( To => $address, Subject => $subject );
1017 $headers{'Cc'} = $cc if ($cc);
1018 $headers{'Message-Id'} = $messageid if ($messageid);
1019 $headers{'Reply-To'} = $from if ($from);
1020 $headers{'From'} = $from if ($from);
1024 sub build_complete_message {
1025 my $content = _build_header(%{_message_headers()}) . "\n\n";
1026 open( REP, "<$filename" ) or die "Couldn't open file '$filename': $!\n";
1027 while (<REP>) { $content .= $_; }
1028 close(REP) or die "Error closing report file '$filename': $!";
1032 sub save_message_to_disk {
1035 open OUTFILE, ">$file" or do { warn "Couldn't open '$file': $!\n"; return undef};
1036 print OUTFILE build_complete_message();
1037 close(OUTFILE) or do { warn "Error closing $file: $!"; return undef };
1038 print "\nMessage saved.\n";
1042 sub _send_message_vms {
1043 if ( ( $address =~ /@/ and $address !~ /^\w+%"/ )
1044 or ( $cc =~ /@/ and $cc !~ /^\w+%"/ ) ) {
1046 foreach ( qw[ IN MX SMTP UCX PONY WINS ], '' ) {
1047 $prefix = "$_%", last if $ENV{"MAIL\$PROTOCOL_$_"};
1049 $address = qq[${prefix}"$address"] unless $address =~ /^\w+%"/;
1050 $cc = qq[${prefix}"$cc"] unless !$cc || $cc =~ /^\w+%"/;
1052 $subject =~ s/"/""/g;
1053 $address =~ s/"/""/g;
1055 my $sts = system(qq[mail/Subject="$subject" $filename. "$address","$cc"]);
1057 die "Can't spawn off mail (leaving bug report in $filename): $sts";
1061 sub _send_message_mailsend {
1062 my $msg = Mail::Send->new();
1063 my %headers = %{_message_headers()};
1064 for my $key ( keys %headers) {
1065 $msg->add($key => $headers{$key});
1069 open(REP, "<$filename") or die "Couldn't open '$filename': $!\n";
1070 while (<REP>) { print $fh $_ }
1071 close(REP) or die "Error closing $filename: $!";
1072 $fh->close or die "Error sending mail: $!";
1074 print "\nMessage sent.\n";
1077 sub _probe_for_sendmail {
1079 for (qw(/usr/lib/sendmail /usr/sbin/sendmail /usr/ucblib/sendmail)) {
1080 $sendmail = $_, last if -e $_;
1082 if ( $^O eq 'os2' and $sendmail eq "" ) {
1083 my $path = $ENV{PATH};
1085 my @path = split /$Config{'path_sep'}/, $path;
1087 $sendmail = "$_/sendmail", last if -e "$_/sendmail";
1088 $sendmail = "$_/sendmail.exe", last if -e "$_/sendmail.exe";
1094 sub _send_message_sendmail {
1095 my $sendmail = _probe_for_sendmail();
1096 unless ($sendmail) {
1097 my $message_start = !$Is_Linux && !$Is_OpenBSD ? <<'EOT' : <<'EOT';
1098 It appears that there is no program which looks like "sendmail" on
1099 your system and that the Mail::Send library from CPAN isn't available.
1101 It appears that there is no program which looks like "sendmail" on
1104 paraprint(<<"EOF"), die "\n";
1106 Because of this, there's no easy way to automatically send your
1109 A copy of your message has been saved in '$filename' for you to
1110 send to '$address' with your normal mail client.
1114 open( SENDMAIL, "|-", $sendmail, "-t", "-oi", "-f", $from )
1115 || die "'|$sendmail -t -oi -f $from' failed: $!";
1116 print SENDMAIL build_complete_message();
1117 if ( close(SENDMAIL) ) {
1118 print "\nMessage sent\n";
1120 warn "\nSendmail returned status '", $? >> 8, "'\n";
1126 # a strange way to check whether any significant editing
1127 # has been done: check whether any new non-empty lines
1130 sub _fingerprint_lines_in_report {
1132 # read in the report template once so that
1133 # we can track whether the user does any editing.
1134 # yes, *all* whitespace is ignored.
1136 open(REP, "<$filename") or die "Unable to open report file '$filename': $!\n";
1137 while (my $line = <REP>) {
1139 $new_lines++ if (!$REP{$line});
1142 close(REP) or die "Error closing report file '$filename': $!";
1143 # returns the number of lines with content that wasn't there when last we looked
1150 ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
1158 perlbug - how to submit bug reports on Perl
1164 B<perlbug> S<[ B<-v> ]> S<[ B<-a> I<address> ]> S<[ B<-s> I<subject> ]>
1165 S<[ B<-b> I<body> | B<-f> I<inputfile> ]> S<[ B<-F> I<outputfile> ]>
1166 S<[ B<-r> I<returnaddress> ]>
1167 S<[ B<-e> I<editor> ]> S<[ B<-c> I<adminaddress> | B<-C> ]>
1168 S<[ B<-S> ]> S<[ B<-t> ]> S<[ B<-d> ]> S<[ B<-A> ]> S<[ B<-h> ]> S<[ B<-T> ]>
1170 B<perlbug> S<[ B<-v> ]> S<[ B<-r> I<returnaddress> ]>
1171 S<[ B<-A> ]> S<[ B<-ok> | B<-okay> | B<-nok> | B<-nokay> ]>
1178 This program is designed to help you generate and send bug reports
1179 (and thank-you notes) about perl5 and the modules which ship with it.
1181 In most cases, you can just run it interactively from a command
1182 line without any special arguments and follow the prompts.
1184 If you have found a bug with a non-standard port (one that was not
1185 part of the I<standard distribution>), a binary distribution, or a
1186 non-core module (such as Tk, DBI, etc), then please see the
1187 documentation that came with that distribution to determine the
1188 correct place to report bugs.
1190 If you are unable to send your report using B<perlbug> (most likely
1191 because your system doesn't have a way to send mail that perlbug
1192 recognizes), you may be able to use this tool to compose your report
1193 and save it to a file which you can then send to B<perlbug@perl.org>
1194 using your regular mail client.
1196 In extreme cases, B<perlbug> may not work well enough on your system
1197 to guide you through composing a bug report. In those cases, you
1198 may be able to use B<perlbug -d> to get system configuration
1199 information to include in a manually composed bug report to
1200 B<perlbug@perl.org>.
1203 When reporting a bug, please run through this checklist:
1207 =item What version of Perl you are running?
1209 Type C<perl -v> at the command line to find out.
1211 =item Are you running the latest released version of perl?
1213 Look at http://www.perl.org/ to find out. If you are not using the
1214 latest released version, please try to replicate your bug on the
1215 latest stable release.
1217 Note that reports about bugs in old versions of Perl, especially
1218 those which indicate you haven't also tested the current stable
1219 release of Perl, are likely to receive less attention from the
1220 volunteers who build and maintain Perl than reports about bugs in
1221 the current release.
1223 This tool isn't appropriate for reporting bugs in any version
1226 =item Are you sure what you have is a bug?
1228 A significant number of the bug reports we get turn out to be
1229 documented features in Perl. Make sure the issue you've run into
1230 isn't intentional by glancing through the documentation that comes
1231 with the Perl distribution.
1233 Given the sheer volume of Perl documentation, this isn't a trivial
1234 undertaking, but if you can point to documentation that suggests
1235 the behaviour you're seeing is I<wrong>, your issue is likely to
1236 receive more attention. You may want to start with B<perldoc>
1237 L<perltrap> for pointers to common traps that new (and experienced)
1238 Perl programmers run into.
1240 If you're unsure of the meaning of an error message you've run
1241 across, B<perldoc> L<perldiag> for an explanation. If the message
1242 isn't in perldiag, it probably isn't generated by Perl. You may
1243 have luck consulting your operating system documentation instead.
1245 If you are on a non-UNIX platform B<perldoc> L<perlport>, as some
1246 features may be unimplemented or work differently.
1248 You may be able to figure out what's going wrong using the Perl
1249 debugger. For information about how to use the debugger B<perldoc>
1252 =item Do you have a proper test case?
1254 The easier it is to reproduce your bug, the more likely it will be
1255 fixed -- if nobody can duplicate your problem, it probably won't be
1258 A good test case has most of these attributes: short, simple code;
1259 few dependencies on external commands, modules, or libraries; no
1260 platform-dependent code (unless it's a platform-specific bug);
1261 clear, simple documentation.
1263 A good test case is almost always a good candidate to be included in
1264 Perl's test suite. If you have the time, consider writing your test case so
1265 that it can be easily included into the standard test suite.
1267 =item Have you included all relevant information?
1269 Be sure to include the B<exact> error messages, if any.
1270 "Perl gave an error" is not an exact error message.
1272 If you get a core dump (or equivalent), you may use a debugger
1273 (B<dbx>, B<gdb>, etc) to produce a stack trace to include in the bug
1276 NOTE: unless your Perl has been compiled with debug info
1277 (often B<-g>), the stack trace is likely to be somewhat hard to use
1278 because it will most probably contain only the function names and not
1279 their arguments. If possible, recompile your Perl with debug info and
1280 reproduce the crash and the stack trace.
1282 =item Can you describe the bug in plain English?
1284 The easier it is to understand a reproducible bug, the more likely
1285 it will be fixed. Any insight you can provide into the problem
1286 will help a great deal. In other words, try to analyze the problem
1287 (to the extent you can) and report your discoveries.
1289 =item Can you fix the bug yourself?
1291 A bug report which I<includes a patch to fix it> will almost
1292 definitely be fixed. When sending a patch, please use the C<diff>
1293 program with the C<-u> option to generate "unified" diff files.
1294 Bug reports with patches are likely to receive significantly more
1295 attention and interest than those without patches.
1297 Your patch may be returned with requests for changes, or requests for more
1298 detailed explanations about your fix.
1300 Here are a few hints for creating high-quality patches:
1302 Make sure the patch is not reversed (the first argument to diff is
1303 typically the original file, the second argument your changed file).
1304 Make sure you test your patch by applying it with the C<patch>
1305 program before you send it on its way. Try to follow the same style
1306 as the code you are trying to patch. Make sure your patch really
1307 does work (C<make test>, if the thing you're patching is covered
1308 by Perl's test suite).
1310 =item Can you use C<perlbug> to submit the report?
1312 B<perlbug> will, amongst other things, ensure your report includes
1313 crucial information about your version of perl. If C<perlbug> is
1314 unable to mail your report after you have typed it in, you may have
1315 to compose the message yourself, add the output produced by C<perlbug
1316 -d> and email it to B<perlbug@perl.org>. If, for some reason, you
1317 cannot run C<perlbug> at all on your system, be sure to include the
1318 entire output produced by running C<perl -V> (note the uppercase V).
1320 Whether you use C<perlbug> or send the email manually, please make
1321 your Subject line informative. "a bug" is not informative. Neither
1322 is "perl crashes" nor is "HELP!!!". These don't help. A compact
1323 description of what's wrong is fine.
1325 =item Can you use C<perlbug> to submit a thank-you note?
1327 Yes, you can do this by either using the C<-T> option, or by invoking
1328 the program as C<perlthanks>. Thank-you notes are good. It makes people
1333 Having done your bit, please be prepared to wait, to be told the
1334 bug is in your code, or possibly to get no reply at all. The
1335 volunteers who maintain Perl are busy folks, so if your problem is
1336 an obvious bug in your own code, is difficult to understand or is
1337 a duplicate of an existing report, you may not receive a personal
1340 If it is important to you that your bug be fixed, do monitor the
1341 perl5-porters@perl.org mailing list and the commit logs to development
1342 versions of Perl, and encourage the maintainers with kind words or
1343 offers of frosty beverages. (Please do be kind to the maintainers.
1344 Harassing or flaming them is likely to have the opposite effect of
1347 Feel free to update the ticket about your bug on http://rt.perl.org
1348 if a new version of Perl is released and your bug is still present.
1356 Address to send the report to. Defaults to B<perlbug@perl.org>.
1360 Don't send a bug received acknowledgement to the reply address.
1361 Generally it is only a sensible to use this option if you are a
1362 perl maintainer actively watching perl porters for your message to
1367 Body of the report. If not included on the command line, or
1368 in a file with B<-f>, you will get a chance to edit the message.
1372 Don't send copy to administrator.
1376 Address to send copy of report to. Defaults to the address of the
1377 local perl administrator (recorded when perl was built).
1381 Data mode (the default if you redirect or pipe output). This prints out
1382 your configuration data, without mailing anything. You can use this
1383 with B<-v> to get more complete data.
1391 File containing the body of the report. Use this to quickly send a
1396 File to output the results to instead of sending as an email. Useful
1397 particularly when running perlbug on a machine with no direct internet
1402 Prints a brief summary of the options.
1406 Report successful build on this system to perl porters. Forces B<-S>
1407 and B<-C>. Forces and supplies values for B<-s> and B<-b>. Only
1408 prompts for a return address if it cannot guess it (for use with
1409 B<make>). Honors return address specified with B<-r>. You can use this
1410 with B<-v> to get more complete data. Only makes a report if this
1411 system is less than 60 days old.
1415 As B<-ok> except it will report on older systems.
1419 Report unsuccessful build on this system. Forces B<-C>. Forces and
1420 supplies a value for B<-s>, then requires you to edit the report
1421 and say what went wrong. Alternatively, a prepared report may be
1422 supplied using B<-f>. Only prompts for a return address if it
1423 cannot guess it (for use with B<make>). Honors return address
1424 specified with B<-r>. You can use this with B<-v> to get more
1425 complete data. Only makes a report if this system is less than 60
1430 As B<-nok> except it will report on older systems.
1434 Your return address. The program will ask you to confirm its default
1435 if you don't use this option.
1439 Send without asking for confirmation.
1443 Subject to include with the message. You will be prompted if you don't
1444 supply one on the command line.
1448 Test mode. The target address defaults to B<perlbug-test@perl.org>.
1452 Send a thank-you note instead of a bug report.
1456 Include verbose configuration data in the report.
1462 Kenneth Albanowski (E<lt>kjahds@kjahds.comE<gt>), subsequently
1463 I<doc>tored by Gurusamy Sarathy (E<lt>gsar@activestate.comE<gt>),
1464 Tom Christiansen (E<lt>tchrist@perl.comE<gt>), Nathan Torkington
1465 (E<lt>gnat@frii.comE<gt>), Charles F. Randall (E<lt>cfr@pobox.comE<gt>),
1466 Mike Guy (E<lt>mjtg@cam.ac.ukE<gt>), Dominic Dunlop
1467 (E<lt>domo@computer.orgE<gt>), Hugo van der Sanden (E<lt>hv@crypt.orgE<gt>),
1468 Jarkko Hietaniemi (E<lt>jhi@iki.fiE<gt>), Chris Nandor
1469 (E<lt>pudge@pobox.comE<gt>), Jon Orwant (E<lt>orwant@media.mit.eduE<gt>,
1470 Richard Foley (E<lt>richard.foley@rfi.netE<gt>), and Jesse Vincent
1471 (E<lt>jesse@bestpractical.comE<gt>).
1475 perl(1), perldebug(1), perldiag(1), perlport(1), perltrap(1),
1476 diff(1), patch(1), dbx(1), gdb(1)
1480 None known (guess what must have been used to report them?)
1486 close OUT or die "Can't close $file: $!";
1487 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
1488 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';