This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perlbug -d,-v: fix uninit value warnings
[perl5.git] / utils / perlbug.PL
1 #!/usr/local/bin/perl
2
3 use Config;
4 use File::Basename qw(&basename &dirname);
5 use Cwd;
6 use File::Spec::Functions;
7
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
12 #  $startperl
13 # to ensure Configure will look for $Config{startperl}.
14 #  $perlpath
15
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.
18 $origdir = cwd;
19 chdir dirname($0);
20 $file = basename($0, '.PL');
21 $file .= '.com' if $^O eq 'VMS';
22
23 open OUT, ">$file" or die "Can't create $file: $!";
24
25 # extract patchlevel.h information
26
27 open PATCH_LEVEL, "<" . catfile(updir, "patchlevel.h")
28     or die "Can't open patchlevel.h: $!";
29
30 my $patchlevel_date = (stat PATCH_LEVEL)[9];
31
32 while (<PATCH_LEVEL>) {
33     last if $_ =~ /^\s*static\s+(?:const\s+)?char.*?local_patches\[\]\s*=\s*{\s*$/;
34 }
35
36 if (! defined($_)) {
37     warn "Warning: local_patches section not found in patchlevel.h\n";
38 }
39
40 my @patches;
41 while (<PATCH_LEVEL>) {
42     last if /^\s*}/;
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
46     chomp;
47     s/^\s+,?\s*"?//;
48     s/"?\s*,?$//;
49     s/(['\\])/\\$1/g;
50     push @patches, $_ unless $_ eq 'NULL';
51 }
52 my $patch_desc = "'" . join("',\n    '", @patches) . "'";
53 my $patch_tags = join "", map /(\S+)/ ? "+$1 " : (), @patches;
54
55 close(PATCH_LEVEL) or die "Error closing patchlevel.h: $!";
56
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.
60
61
62 print "Extracting $file (with variable substitutions)\n";
63
64 # In this section, perl variables will be expanded during extraction.
65 # You can use $Config{...} to use Configure variables.
66
67 my $extract_version = sprintf("%vd", $^V);
68
69 print OUT <<"!GROK!THIS!";
70 $Config{startperl}
71     eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
72         if \$running_under_some_shell;
73
74 my \$config_tag1 = '$extract_version - $Config{cf_time}';
75
76 my \$patchlevel_date = $patchlevel_date;
77 my \$patch_tags = '$patch_tags';
78 my \@patches = (
79     $patch_desc
80 );
81 !GROK!THIS!
82
83 # In the following, perl variables are not expanded during extraction.
84
85 print OUT <<'!NO!SUBS!';
86
87 use warnings;
88 no warnings 'once'; # Eventually, the $::opt_ stuff should get cleaned up
89 use strict;
90 use Config;
91 use File::Spec;         # keep perlbug Perl 5.005 compatible
92 use Getopt::Std;
93 use File::Basename 'basename';
94
95 sub paraprint;
96
97 BEGIN {
98     eval { require Mail::Send;};
99     $::HaveSend = ($@ eq "");
100     eval { require Mail::Util; } ;
101     $::HaveUtil = ($@ eq "");
102     # use secure tempfiles wherever possible
103     eval { require File::Temp; };
104     $::HaveTemp = ($@ eq "");
105     eval { require Module::CoreList; };
106     $::HaveCoreList = ($@ eq "");
107 };
108
109 my $Version = "1.39";
110
111 # Changed in 1.06 to skip Mail::Send and Mail::Util if not available.
112 # Changed in 1.07 to see more sendmail execs, and added pipe output.
113 # Changed in 1.08 to use correct address for sendmail.
114 # Changed in 1.09 to close the REP file before calling it up in the editor.
115 #                 Also removed some old comments duplicated elsewhere.
116 # Changed in 1.10 to run under VMS without Mail::Send; also fixed
117 #                 temp filename generation.
118 # Changed in 1.11 to clean up some text and removed Mail::Send deactivator.
119 # Changed in 1.12 to check for editor errors, make save/send distinction
120 #                 clearer and add $ENV{REPLYTO}.
121 # Changed in 1.13 to hopefully make it more difficult to accidentally
122 #                 send mail
123 # Changed in 1.14 to make the prompts a little more clear on providing
124 #                 helpful information. Also let file read fail gracefully.
125 # Changed in 1.15 to add warnings to stop people using perlbug for non-bugs.
126 #                 Also report selected environment variables.
127 # Changed in 1.16 to include @INC, and allow user to re-edit if no changes.
128 # Changed in 1.17 Win32 support added.  GSAR 97-04-12
129 # Changed in 1.18 add '-ok' option for reporting build success. CFR 97-06-18
130 # Changed in 1.19 '-ok' default not '-v'
131 #                 add local patch information
132 #                 warn on '-ok' if this is an old system; add '-okay'
133 # Changed in 1.20 Added patchlevel.h reading and version/config checks
134 # Changed in 1.21 Added '-nok' for reporting build failure DFD 98-05-05
135 # Changed in 1.22 Heavy reformatting & minor bugfixes HVDS 98-05-10
136 # Changed in 1.23 Restore -ok(ay): say 'success'; don't prompt
137 # Changed in 1.24 Added '-F<file>' to save report HVDS 98-07-01
138 # Changed in 1.25 Warn on failure to open save file. HVDS 98-07-12
139 # Changed in 1.26 Don't require -t STDIN for -ok. HVDS 98-07-15
140 # Changed in 1.27 Added Mac OS and File::Spec support CNANDOR 99-07-27
141 # Changed in 1.28 Additional questions for Perlbugtron RFOLEY 20.03.2000
142 # Changed in 1.29 Perlbug(tron): auto(-ok), short prompts RFOLEY 05-05-2000
143 # Changed in 1.30 Added warnings on failure to open files MSTEVENS 13-07-2000
144 # Changed in 1.31 Add checks on close().Fix my $var unless. TJENNESS 26-07-2000
145 # Changed in 1.32 Use File::Spec->tmpdir TJENNESS 20-08-2000
146 # Changed in 1.33 Don't require -t STDOUT for -ok.
147 # Changed in 1.34 Added Message-Id RFOLEY 18-06-2002 
148 # Changed in 1.35 Use File::Temp (patch from Solar Designer) NWCLARK 28-02-2004
149 # Changed in 1.36 Initial Module::CoreList support Alexandr Ciornii 11-07-2007
150 # Changed in 1.37 Killed some string evals, rewrote most prose JESSE 2008-06-08
151 # Changed in 1.38 Actually enforce the CoreList check,
152 #                 Record the module the user enters if they do so
153 #                 Refactor prompts to use common code           JESSE 2008-06-08
154 # Changed in 1.39 Trap mail sending failures (simple ones) so   JESSE 2008-06-08
155 #                 users might be able to recover their bug reports
156 #                 Refactor mail sending routines
157 #                 Unify message building code
158 #                 Unify message header building
159 #                 Fix "module" prompting to not squish "category" prompting 
160 #                 use warnings; (except 'once' warnings)
161 #                 Unified report fingerprint/change detection code
162 #                 Removed some labeled 'gotos'
163 #TODO:
164 #       make sure failure (transmission-wise) of Mail::Send is accounted for.
165 #       (This may work now. Unsure of the original author's issue -JESSE 2008-06-08)
166 #       - Test -b option
167
168 my( $file, $usefile, $cc, $address, $bugaddress, $testaddress, $thanksaddress,
169     $filename, $messageid, $domain, $subject, $from, $verbose, $ed, $outfile,
170     $fh, $me, $body, $andcc, %REP, $ok, $thanks, $progname,
171     $Is_MacOS, $Is_MSWin32, $Is_Linux, $Is_VMS, $Is_OpenBSD,
172     $report_about_module, $category, $severity,
173
174 );
175
176 my $perl_version = $^V ? sprintf("%vd", $^V) : $];
177
178 my $config_tag2 = "$perl_version - $Config{cf_time}";
179
180 Init();
181
182 if ($::opt_h) { Help(); exit; }
183 if ($::opt_d) { Dump(*STDOUT); exit; }
184 if (!-t STDIN && !($ok and not $::opt_n)) {
185     paraprint <<"EOF";
186 Please use $progname interactively. If you want to
187 include a file, you can use the -f switch.
188 EOF
189     die "\n";
190 }
191
192 Query();
193 Edit() unless $usefile || ($ok and not $::opt_n);
194 NowWhat();
195 if ($outfile) {
196     save_message_to_disk($outfile);
197 } else {
198     Send();
199     if ($thanks) {
200         print "\nThank you for taking the time to send a thank-you message!\n\n";
201     } else {
202         print "\nThank you for taking the time to file a bug report!\n\n";
203     }
204 }
205
206 exit;
207
208 sub ask_for_alternatives { # (category|severity)
209     my $name = shift;
210     my %alts = (
211         'category' => {
212             'default' => 'core',
213             'ok'      => 'install',
214             # Inevitably some of these will end up in RT whatever we do:
215             'thanks'  => 'thanks',
216             'opts'    => [qw(core docs install library utilities)], # patch, notabug
217         },
218         'severity' => {
219             'default' => 'low',
220             'ok'      => 'none',
221             'thanks'  => 'none',
222             'opts'    => [qw(critical high medium low wishlist none)], # zero
223         },
224     );
225     die "Invalid alternative ($name) requested\n" unless grep(/^$name$/, keys %alts);
226     my $alt = "";
227     my $what = $ok || $thanks;
228     if ($what) {
229         $alt = $alts{$name}{$what};
230     } else {
231         my @alts = @{$alts{$name}{'opts'}};
232     print "\n\n";
233         paraprint <<EOF;
234 Please pick a $name from the following list:
235
236     @alts
237 EOF
238         my $err = 0;
239         do {
240             if ($err++ > 5) {
241                 die "Invalid $name: aborting.\n";
242             }
243         $alt = _prompt('', "\u$name", $alts{$name}{'default'});
244                 $alt ||= $alts{$name}{'default'};
245         } while !((($alt) = grep(/^$alt/i, @alts)));
246     }
247     lc $alt;
248 }
249
250 sub Init {
251     # -------- Setup --------
252
253     $Is_MSWin32 = $^O eq 'MSWin32';
254     $Is_VMS = $^O eq 'VMS';
255     $Is_Linux = lc($^O) eq 'linux';
256     $Is_OpenBSD = lc($^O) eq 'openbsd';
257     $Is_MacOS = $^O eq 'MacOS';
258
259     @ARGV = split m/\s+/,
260         MacPerl::Ask('Provide command line args here (-h for help):')
261         if $Is_MacOS && $MacPerl::Version =~ /App/;
262
263     if (!getopts("Adhva:s:b:f:F:r:e:SCc:to:n:T")) { Help(); exit; };
264
265     # This comment is needed to notify metaconfig that we are
266     # using the $perladmin, $cf_by, and $cf_time definitions.
267
268     # -------- Configuration ---------
269
270     # perlbug address
271     $bugaddress = 'perlbug@perl.org';
272
273     # Test address
274     $testaddress = 'perlbug-test@perl.org';
275
276     # Thanks address
277     $thanksaddress = 'perl-thanks@perl.org';
278
279     if (basename ($0) =~ /^perlthanks/i) {
280         # invoked as perlthanks
281         $::opt_T = 1;
282         $::opt_C = 1; # don't send a copy to the local admin
283     }
284
285     if ($::opt_T) {
286         $thanks = 'thanks';
287     }
288     
289     $progname = $thanks ? 'perlthanks' : 'perlbug';
290     # Target address
291     $address = $::opt_a || ($::opt_t ? $testaddress
292                             : $thanks ? $thanksaddress : $bugaddress);
293
294     # Users address, used in message and in Reply-To header
295     $from = $::opt_r || "";
296
297     # Include verbose configuration information
298     $verbose = $::opt_v || 0;
299
300     # Subject of bug-report message
301     $subject = $::opt_s || "";
302
303     # Send a file
304     $usefile = ($::opt_f || 0);
305
306     # File to send as report
307     $file = $::opt_f || "";
308
309     # File to output to
310     $outfile = $::opt_F || "";
311
312     # Body of report
313     $body = $::opt_b || "";
314         
315     # Editor
316     $ed = $::opt_e || $ENV{VISUAL} || $ENV{EDITOR} || $ENV{EDIT}
317         || ($Is_VMS && "edit/tpu")
318         || ($Is_MSWin32 && "notepad")
319         || ($Is_MacOS && '')
320         || "vi";
321
322     # Not OK - provide build failure template by finessing OK report
323     if ($::opt_n) {
324         if (substr($::opt_n, 0, 2) eq 'ok' )    {
325             $::opt_o = substr($::opt_n, 1);
326         } else {
327             Help();
328             exit();
329         }
330     }
331
332     # OK - send "OK" report for build on this system
333     $ok = '';
334     if ($::opt_o) {
335         if ($::opt_o eq 'k' or $::opt_o eq 'kay') {
336             my $age = time - $patchlevel_date;
337             if ($::opt_o eq 'k' and $age > 60 * 24 * 60 * 60 ) {
338                 my $date = localtime $patchlevel_date;
339                 print <<"EOF";
340 "perlbug -ok" and "perlbug -nok" do not report on Perl versions which
341 are more than 60 days old.  This Perl version was constructed on
342 $date.  If you really want to report this, use
343 "perlbug -okay" or "perlbug -nokay".
344 EOF
345                 exit();
346             }
347             # force these options
348             unless ($::opt_n) {
349                 $::opt_S = 1; # don't prompt for send
350                 $::opt_b = 1; # we have a body
351                 $body = "Perl reported to build OK on this system.\n";
352             }
353             $::opt_C = 1; # don't send a copy to the local admin
354             $::opt_s = 1; # we have a subject line
355             $subject = ($::opt_n ? 'Not ' : '')
356                     . "OK: perl $perl_version ${patch_tags}on"
357                     ." $::Config{'archname'} $::Config{'osvers'} $subject";
358             $ok = 'ok';
359         } else {
360             Help();
361             exit();
362         }
363     }
364
365     # Possible administrator addresses, in order of confidence
366     # (Note that cf_email is not mentioned to metaconfig, since
367     # we don't really want it. We'll just take it if we have to.)
368     #
369     # This has to be after the $ok stuff above because of the way
370     # that $::opt_C is forced.
371     $cc = $::opt_C ? "" : (
372         $::opt_c || $::Config{'perladmin'}
373         || $::Config{'cf_email'} || $::Config{'cf_by'}
374     );
375
376     if ($::HaveUtil) {
377                 $domain = Mail::Util::maildomain();
378     } elsif ($Is_MSWin32) {
379                 $domain = $ENV{'USERDOMAIN'};
380     } else {
381                 require Sys::Hostname;
382                 $domain = Sys::Hostname::hostname();
383     }
384
385     # Message-Id - rjsf
386     $messageid = "<$::Config{'version'}_${$}_".time."\@$domain>"; 
387
388     # My username
389     $me = $Is_MSWin32 ? $ENV{'USERNAME'}
390             : $^O eq 'os2' ? $ENV{'USER'} || $ENV{'LOGNAME'}
391             : $Is_MacOS ? $ENV{'USER'}
392             : eval { getpwuid($<) };    # May be missing
393
394     $from = $::Config{'cf_email'}
395        if !$from && $::Config{'cf_email'} && $::Config{'cf_by'} && $me &&
396                ($me eq $::Config{'cf_by'});
397 } # sub Init
398
399 sub Query {
400     # Explain what perlbug is
401     unless ($ok) {
402         if ($thanks) {
403             paraprint <<'EOF';
404 This program provides an easy way to send a thank-you message back to the
405 authors and maintainers of perl.
406
407 If you wish to submit a bug report, please run it without the -T flag
408 (or run the program perlbug rather than perlthanks)
409 EOF
410         } else {
411             paraprint <<"EOF";
412 This program provides an easy way to create a message reporting a
413 bug in the core perl distribution (along with tests or patches)
414 to the volunteers who maintain perl at $address.  To send a thank-you
415 note to $thanksaddress instead of a bug report, please run 'perlthanks'.
416
417 Please do not use $0 to send test messages, test whether perl
418 works, or to report bugs in perl modules from CPAN.
419
420 For help using perl, try posting to the Usenet newsgroup 
421 comp.lang.perl.misc.
422 EOF
423         }
424     }
425
426     # Prompt for subject of message, if needed
427     
428     if ($subject && TrivialSubject($subject)) {
429         $subject = '';
430     }
431
432     unless ($subject) {
433             print 
434 "First of all, please provide a subject for the message.\n";
435         if ( not $thanks)  {
436             paraprint <<EOF;
437 This should be a concise description of your bug or problem
438 which will help the volunteers working to improve perl to categorize
439 and resolve the issue.  Be as specific and descriptive as
440 you can. A subject like "perl bug" or "perl problem" will make it
441 much less likely that your issue gets the attention it deserves.
442 EOF
443         }
444
445         my $err = 0;
446         do {
447         $subject = _prompt('','Subject');
448             if ($err++ == 5) {
449                 if ($thanks) {
450                     $subject = 'Thanks for Perl';
451                 } else {
452                     die "Aborting.\n";
453                 }
454             }
455         } while (TrivialSubject($subject));
456     }
457
458     # Prompt for return address, if needed
459     unless ($from) {
460         # Try and guess return address
461         my $guess;
462
463         $guess = $ENV{'REPLY-TO'} || $ENV{'REPLYTO'} || $ENV{'EMAIL'} || '';
464         if ($Is_MacOS) {
465             require Mac::InternetConfig;
466             $guess = $Mac::InternetConfig::InternetConfig{
467                 Mac::InternetConfig::kICEmail()
468             };
469         }
470
471         unless ($guess) {
472                 # move $domain to where we can use it elsewhere 
473         if ($domain) {
474                 if ($Is_VMS && !$::Config{'d_socket'}) {
475                     $guess = "$domain\:\:$me";
476                 } else {
477                     $guess = "$me\@$domain" if $domain;
478                 }
479             }
480         }
481
482         if ($guess) {
483             unless ($ok) {
484                 paraprint <<EOF;
485 Perl's developers may need your email address to contact you for
486 further information about your issue or to inform you when it is
487 resolved.  If the default shown is not your email address, please
488 correct it.
489 EOF
490             }
491         } else {
492             paraprint <<EOF;
493 Please enter your full internet email address so that Perl's
494 developers can contact you with questions about your issue or to
495 inform you that it has been resolved.
496 EOF
497         }
498
499         if ($ok && $guess) {
500             # use it
501             $from = $guess;
502         } else {
503             # verify it
504         $from = _prompt('','Your address',$guess);
505             $from = $guess if $from eq '';
506         }
507     }
508
509     if ($from eq $cc or $me eq $cc) {
510         # Try not to copy ourselves
511         $cc = "yourself";
512     }
513
514     # Prompt for administrator address, unless an override was given
515     if( !$::opt_C and !$::opt_c ) {
516         my $description =  <<EOF;
517 $0 can send a copy of this report to your local perl
518 administrator.  If the address below is wrong, please correct it,
519 or enter 'none' or 'yourself' to not send a copy.
520 EOF
521         my $entry = _prompt($description, "Local perl administrator", $cc);
522
523         if ($entry ne "") {
524             $cc = $entry;
525             $cc = '' if $me eq $cc;
526         }
527     }
528
529     $cc = '' if $cc =~ /^(none|yourself|me|myself|ourselves)$/i;
530     if ($cc) { 
531         $andcc = " and $cc" 
532     } else {
533         $andcc = ''
534     }
535
536     # Prompt for editor, if no override is given
537 editor:
538     unless ($::opt_e || $::opt_f || $::opt_b) {
539
540     my $description;
541
542         chomp (my $common_end = <<"EOF");
543 You will probably want to use a text editor to enter the body of
544 your report. If "$ed" is the editor you want to use, then just press
545 Enter, otherwise type in the name of the editor you would like to
546 use.
547
548 If you have already composed the body of your report, you may enter
549 "file", and $0 will prompt you to enter the name of the file
550 containing your report.
551 EOF
552
553         if ($thanks) {
554             $description = <<"EOF";
555 It's now time to compose your thank-you message.
556
557 Some information about your local perl configuration will automatically
558 be included at the end of your message, because we're curious about
559 the different ways that people build and use perl. If you'd rather
560 not share this information, you're welcome to delete it.
561
562 $common_end
563 EOF
564         } else {
565             $description =  <<"EOF";
566 It's now time to compose your bug report. Try to make the report
567 concise but descriptive. Please include any detail which you think
568 might be relevant or might help the volunteers working to improve
569 perl. If you are reporting something that does not work as you think
570 it should, please try to include examples of the actual result and of
571 what you expected.
572
573 Some information about your local perl configuration will automatically
574 be included at the end of your report. If you are using an unusual
575 version of perl, it would be useful if you could confirm that you
576 can replicate the problem on a standard build of perl as well.
577
578 $common_end
579 EOF
580         }
581
582     my $entry = _prompt($description, "Editor", $ed);
583         $usefile = 0;
584         if ($entry eq "file") {
585             $usefile = 1;
586         } elsif ($entry ne "") {
587             $ed = $entry;
588         }
589     }
590     if ($::HaveCoreList && !$ok && !$thanks) {
591         my $description =  <<EOF;
592 If your bug is about a Perl module rather than a core language
593 feature, please enter its name here. If it's not, just hit Enter
594 to skip this question.
595 EOF
596
597     my $entry = '';
598         while ($entry eq '') {
599         $entry = _prompt($description, 'Module');
600             my $first_release = Module::CoreList->first_release($entry);
601             if ($entry and not $first_release) {
602                 paraprint <<EOF;
603 $entry is not a "core" Perl module. Please check that you entered
604 its name correctly. If it is correct, quit this program, try searching
605 for $entry on http://rt.cpan.org, and report your issue there.
606 EOF
607
608             $entry = '';
609         } elsif (my $bug_tracker = $Module::CoreList::bug_tracker{$entry}) {
610                 paraprint <<"EOF";
611 $entry included with core Perl is copied directly from the CPAN distribution.
612 Please report bugs in $entry directly to its maintainers using $bug_tracker
613 EOF
614             $entry = '';
615         } elsif ($entry) {
616                 $category ||= 'library';
617                 $report_about_module = $entry;
618             last;
619         } else {
620             last;
621         }
622         }
623     }
624
625     # Prompt for category of bug
626     $category ||= ask_for_alternatives('category');
627
628     # Prompt for severity of bug
629     $severity ||= ask_for_alternatives('severity');
630
631     # Generate scratch file to edit report in
632     $filename = filename();
633
634     # Prompt for file to read report from, if needed
635     if ($usefile and !$file) {
636 filename:
637         my $description = <<EOF;
638 What is the name of the file that contains your report?
639 EOF
640         my $entry = _prompt($description, "Filename");
641
642         if ($entry eq "") {
643             paraprint <<EOF;
644 It seems you didn't enter a filename. Please choose to use a text
645 editor or enter a filename.
646 EOF
647             goto editor;
648         }
649
650         unless (-f $entry and -r $entry) {
651             paraprint <<EOF;
652 '$entry' doesn't seem to be a readable file.  You may have mistyped
653 its name or may not have permission to read it.
654
655 If you don't want to use a file as the content of your report, just
656 hit Enter and you'll be able to select a text editor instead.
657 EOF
658             goto filename;
659         }
660         $file = $entry;
661     }
662
663     # Generate report
664     open(REP,">$filename") or die "Unable to create report file '$filename': $!\n";
665     my $reptype = !$ok ? ($thanks ? 'thank-you' : 'bug')
666         : $::opt_n ? "build failure" : "success";
667
668     print REP <<EOF;
669 This is a $reptype report for perl from $from,
670 generated with the help of perlbug $Version running under perl $perl_version.
671
672 EOF
673
674     if ($body) {
675         print REP $body;
676     } elsif ($usefile) {
677         open(F, "<$file")
678                 or die "Unable to read report file from '$file': $!\n";
679         while (<F>) {
680             print REP $_
681         }
682         close(F) or die "Error closing '$file': $!";
683     } else {
684         if ($thanks) {
685             print REP <<'EOF';
686
687 -----------------------------------------------------------------
688 [Please enter your thank-you message here]
689
690
691
692 [You're welcome to delete anything below this line]
693 -----------------------------------------------------------------
694 EOF
695         } else {
696             print REP <<'EOF';
697
698 -----------------------------------------------------------------
699 [Please describe your issue here]
700
701
702
703 [Please do not change anything below this line]
704 -----------------------------------------------------------------
705 EOF
706         }
707     }
708     Dump(*REP);
709     close(REP) or die "Error closing report file: $!";
710
711     # Set up an initial report fingerprint so we can compare it later
712     _fingerprint_lines_in_report();
713
714 } # sub Query
715
716 sub Dump {
717     local(*OUT) = @_;
718
719     # these won't have been set if run with -d
720     $category ||= 'core';
721     $severity ||= 'low';
722
723     print OUT <<EFF;
724 ---
725 Flags:
726     category=$category
727     severity=$severity
728 EFF
729
730     if ($report_about_module ) { 
731         print OUT <<EFF;
732     module=$report_about_module
733 EFF
734     }
735     if ($::opt_A) {
736         print OUT <<EFF;
737     ack=no
738 EFF
739     }
740     print OUT <<EFF;
741 ---
742 EFF
743     print OUT "This perlbug was built using Perl $config_tag1\n",
744             "It is being executed now by  Perl $config_tag2.\n\n"
745         if $config_tag2 ne $config_tag1;
746
747     print OUT <<EOF;
748 Site configuration information for perl $perl_version:
749
750 EOF
751     if ($::Config{cf_by} and $::Config{cf_time}) {
752         print OUT "Configured by $::Config{cf_by} at $::Config{cf_time}.\n\n";
753     }
754     print OUT Config::myconfig;
755
756     if (@patches) {
757         print OUT join "\n    ", "Locally applied patches:", @patches;
758         print OUT "\n";
759     };
760
761     print OUT <<EOF;
762
763 ---
764 \@INC for perl $perl_version:
765 EOF
766     for my $i (@INC) {
767         print OUT "    $i\n";
768     }
769
770     print OUT <<EOF;
771
772 ---
773 Environment for perl $perl_version:
774 EOF
775     my @env =
776         qw(PATH LD_LIBRARY_PATH LANG PERL_BADLANG SHELL HOME LOGDIR LANGUAGE);
777     push @env, $Config{ldlibpthname} if $Config{ldlibpthname} ne '';
778     push @env, grep /^(?:PERL|LC_|LANG|CYGWIN)/, keys %ENV;
779     my %env;
780     @env{@env} = @env;
781     for my $env (sort keys %env) {
782         print OUT "    $env",
783                 exists $ENV{$env} ? "=$ENV{$env}" : ' (unset)',
784                 "\n";
785     }
786     if ($verbose) {
787         print OUT "\nComplete configuration data for perl $perl_version:\n\n";
788         my $value;
789         foreach (sort keys %::Config) {
790             $value = $::Config{$_};
791             $value = '' unless defined $value;
792             $value =~ s/'/\\'/g;
793             print OUT "$_='$value'\n";
794         }
795     }
796 } # sub Dump
797
798 sub Edit {
799     # Edit the report
800     if ($usefile || $body) {
801         my $description = "Please make sure that the name of the editor you want to use is correct.";
802         my $entry = _prompt($description, 'Editor', $ed);
803         $ed = $entry unless $entry eq '';
804     }
805
806     _edit_file($ed);
807 }
808
809 sub _edit_file {
810     my $editor = shift;
811
812     my $report_written = 0;
813
814     while ( !$report_written ) {
815         if ($Is_MacOS) {
816             require ExtUtils::MakeMaker;
817             ExtUtils::MM_MacOS::launch_file($filename);
818             _prompt('', "Press Enter when done." );
819         } else {    # we're not on oldschool mac os
820             my $exit_status = system("$editor $filename");
821             if ($exit_status) {
822                 my $desc = <<EOF;
823 The editor you chose ('$editor') could not be run!
824
825 If you mistyped its name, please enter it now, otherwise just press Enter.
826 EOF
827                 my $entry = _prompt( $desc, 'Editor', $editor );
828                 if ( $entry ne "" ) {
829                     $editor = $entry;
830                     next;
831                 } else {
832                     paraprint <<EOF;
833 You may want to save your report to a file, so you can edit and
834 mail it later.
835 EOF
836                     return;
837                 }
838             }
839         }
840         return if ( $ok and not $::opt_n ) || $body;
841
842         # Check that we have a report that has some, eh, report in it.
843
844         unless ( _fingerprint_lines_in_report() ) {
845             my $description = <<EOF;
846 It looks like you didn't enter a report. You may [r]etry your edit
847 or [c]ancel this report.
848 EOF
849             my $action = _prompt( $description, "Action (Retry/Cancel) " );
850             if ( $action =~ /^[re]/i ) {    # <R>etry <E>dit
851                 next;
852             } elsif ( $action =~ /^[cq]/i ) {    # <C>ancel, <Q>uit
853                 Cancel();                        # cancel exits
854             }
855         }
856         # Ok. the user did what they needed to;
857         return;
858
859     }
860 }
861
862
863 sub Cancel {
864     1 while unlink($filename);  # remove all versions under VMS
865     print "\nQuitting without sending your message.\n";
866     exit(0);
867 }
868
869 sub NowWhat {
870     # Report is done, prompt for further action
871     if( !$::opt_S ) {
872         while(1) {
873             my $menu = <<EOF;
874
875
876 You have finished composing your message. At this point, you have 
877 a few options. You can:
878
879     * [Se]nd the message to $address$andcc, 
880     * [D]isplay the message on the screen,
881     * [R]e-edit the message
882     * Display or change the message's [su]bject
883     * Save the message to a [f]ile to mail at another time
884     * [Q]uit without sending a message
885
886 EOF
887       retry:
888         print $menu;
889             my $action =  _prompt('', "Action (Send/Display/Edit/Subject/Save to File)");;
890         print "\n";
891             if ($action =~ /^(f|sa)/i) { # <F>ile/<Sa>ve
892             if ( SaveMessage() ) { exit }
893             } elsif ($action =~ /^(d|l|sh)/i ) { # <D>isplay, <L>ist, <Sh>ow
894                 # Display the message
895                 open(REP, "<$filename") or die "Couldn't open file '$filename': $!\n";
896                 while (<REP>) { print $_ }
897                 close(REP) or die "Error closing report file '$filename': $!";
898             } elsif ($action =~ /^su/i) { # <Su>bject
899                 my $reply = _prompt( "Subject: $subject", "If the above subject is fine, press Enter. Otherwise, type a replacement now\nSubject");
900                 if ($reply ne '') {
901                     unless (TrivialSubject($reply)) {
902                         $subject = $reply;
903                         print "Subject: $subject\n";
904                     }
905                 }
906             } elsif ($action =~ /^se/i) { # <S>end
907                 # Send the message
908                 my $reply =  _prompt( "Are you certain you want to send this message?", 'Please type "yes" if you are','no');
909                 if ($reply =~ /^yes$/) {
910                     last;
911                 } else {
912                     paraprint <<EOF;
913 You didn't type "yes", so your message has not yet been sent.
914 EOF
915                 }
916             } elsif ($action =~ /^[er]/i) { # <E>dit, <R>e-edit
917                 # edit the message
918                 Edit();
919             } elsif ($action =~ /^[qc]/i) { # <C>ancel, <Q>uit
920                 Cancel();
921             } elsif ($action =~ /^s/i) {
922                 paraprint <<EOF;
923 The command you entered was ambiguous. Please type "send", "save" or "subject".
924 EOF
925             }
926         }
927     }
928 } # sub NowWhat
929
930 sub TrivialSubject {
931     my $subject = shift;
932     if ($subject =~
933         /^(y(es)?|no?|help|perl( (bug|problem))?|bug|problem)$/i ||
934         length($subject) < 4 ||
935         $subject !~ /\s/) {
936         print "\nThe subject you entered wasn't very descriptive. Please try again.\n\n";
937         return 1;
938     } else {
939         return 0;
940     }
941 }
942
943 sub SaveMessage {
944     my $file_save = $outfile || "$progname.rep";
945     my $file = _prompt( '', "Name of file to save message in", $file_save );
946     save_message_to_disk($file) || return undef;
947     print "\n";
948     paraprint <<EOF;
949 A copy of your message has been saved in '$file' for you to
950 send to '$address' with your normal mail client.
951 EOF
952 }
953
954 sub Send {
955
956     # Message has been accepted for transmission -- Send the message
957
958     # on linux certain "mail" implementations won't accept the subject
959     # as "~s subject" and thus the Subject header will be corrupted
960     # so don't use Mail::Send to be safe
961     eval {
962         if ( $::HaveSend && !$Is_Linux && !$Is_OpenBSD ) {
963             _send_message_mailsend();
964         } elsif ($Is_VMS) {
965             _send_message_vms();
966         } else {
967             _send_message_sendmail();
968         }
969     };
970
971     if ( my $error = $@ ) {
972         paraprint <<EOF;
973 $0 has detected an error while trying to send your message: $error.
974
975 Your message may not have been sent. You will now have a chance to save a copy to disk.
976 EOF
977         SaveMessage();
978         return;
979     }
980
981     1 while unlink($filename);    # remove all versions under VMS
982 }    # sub Send
983
984 sub Help {
985     print <<EOF;
986
987 This program is designed to help you generate and send bug reports
988 (and thank-you notes) about perl5 and the modules which ship with it.
989
990 In most cases, you can just run "$0" interactively from a command
991 line without any special arguments and follow the prompts.
992
993 Advanced usage:
994
995 $0  [-v] [-a address] [-s subject] [-b body | -f inpufile ] [ -F outputfile ]
996     [-r returnaddress] [-e editor] [-c adminaddress | -C] [-S] [-t] [-h]
997 $0  [-v] [-r returnaddress] [-A] [-ok | -okay | -nok | -nokay]
998
999
1000 Options:
1001
1002   -v    Include Verbose configuration data in the report
1003   -f    File containing the body of the report. Use this to
1004         quickly send a prepared message.
1005   -F    File to output the resulting mail message to, instead of mailing.
1006   -S    Send without asking for confirmation.
1007   -a    Address to send the report to. Defaults to '$address'.
1008   -c    Address to send copy of report to. Defaults to '$cc'.
1009   -C    Don't send copy to administrator.
1010   -s    Subject to include with the message. You will be prompted
1011         if you don't supply one on the command line.
1012   -b    Body of the report. If not included on the command line, or
1013         in a file with -f, you will get a chance to edit the message.
1014   -r    Your return address. The program will ask you to confirm
1015         this if you don't give it here.
1016   -e    Editor to use.
1017   -t    Test mode. The target address defaults to '$testaddress'.
1018   -T    Thank-you mode. The target address defaults to '$thanksaddress'.
1019   -d    Data mode.  This prints out your configuration data, without mailing
1020         anything. You can use this with -v to get more complete data.
1021   -A    Don't send a bug received acknowledgement to the return address.
1022   -ok   Report successful build on this system to perl porters
1023         (use alone or with -v). Only use -ok if *everything* was ok:
1024         if there were *any* problems at all, use -nok.
1025   -okay As -ok but allow report from old builds.
1026   -nok  Report unsuccessful build on this system to perl porters
1027         (use alone or with -v). You must describe what went wrong
1028         in the body of the report which you will be asked to edit.
1029   -nokay As -nok but allow report from old builds.
1030   -h    Print this help message.
1031
1032 EOF
1033 }
1034
1035 sub filename {
1036     if ($::HaveTemp) {
1037         # Good. Use a secure temp file
1038         my ($fh, $filename) = File::Temp::tempfile(UNLINK => 1);
1039         close($fh);
1040         return $filename;
1041     } else {
1042         # Bah. Fall back to doing things less securely.
1043         my $dir = File::Spec->tmpdir();
1044         $filename = "bugrep0$$";
1045         $filename++ while -e File::Spec->catfile($dir, $filename);
1046         $filename = File::Spec->catfile($dir, $filename);
1047     }
1048 }
1049
1050 sub paraprint {
1051     my @paragraphs = split /\n{2,}/, "@_";
1052     for (@paragraphs) {   # implicit local $_
1053         s/(\S)\s*\n/$1 /g;
1054         write;
1055         print "\n";
1056     }
1057 }
1058
1059 sub _prompt {
1060     my ($explanation, $prompt, $default) = (@_);
1061     if ($explanation) {
1062         print "\n\n";
1063         paraprint $explanation;
1064     }
1065     print $prompt. ($default ? " [$default]" :''). ": ";
1066         my $result = scalar(<>);
1067     chomp($result);
1068         $result =~ s/^\s*(.*?)\s*$/$1/s;
1069     if ($default && $result eq '') {
1070         return $default;
1071     } else {
1072         return $result;
1073     }
1074 }
1075
1076 sub _build_header {
1077     my %attr = (@_);
1078
1079     my $head = '';
1080     for my $header (keys %attr) {
1081         $head .= "$header: ".$attr{$header}."\n";
1082     }
1083     return $head;
1084 }
1085
1086 sub _message_headers {
1087     my %headers = ( To => $address, Subject => $subject );
1088     $headers{'Cc'}         = $cc        if ($cc);
1089     $headers{'Message-Id'} = $messageid if ($messageid);
1090     $headers{'Reply-To'}   = $from      if ($from);
1091     return \%headers;
1092 }
1093
1094 sub build_complete_message {
1095     my $content = _build_header(%{_message_headers()}) . "\n\n";
1096     open( REP, "<$filename" ) or die "Couldn't open file '$filename': $!\n";
1097     while (<REP>) { $content .= $_; }
1098     close(REP) or die "Error closing report file '$filename': $!";
1099     return $content;
1100 }
1101
1102 sub save_message_to_disk {
1103     my $file = shift;
1104
1105             open OUTFILE, ">$file" or do { warn  "Couldn't open '$file': $!\n"; return undef};
1106         print OUTFILE build_complete_message();
1107         close(OUTFILE) or do { warn  "Error closing $file: $!"; return undef };
1108             print "\nMessage saved.\n";
1109         return 1;
1110 }
1111
1112 sub _send_message_vms {
1113     if (   ( $address =~ /@/ and $address !~ /^\w+%"/ )
1114         or ( $cc =~ /@/ and $cc !~ /^\w+%"/ ) ) {
1115         my $prefix;
1116         foreach ( qw[ IN MX SMTP UCX PONY WINS ], '' ) {
1117             $prefix = "$_%", last if $ENV{"MAIL\$PROTOCOL_$_"};
1118         }
1119         $address = qq[${prefix}"$address"] unless $address =~ /^\w+%"/;
1120         $cc = qq[${prefix}"$cc"] unless !$cc || $cc =~ /^\w+%"/;
1121     }
1122     $subject =~ s/"/""/g;
1123     $address =~ s/"/""/g;
1124     $cc      =~ s/"/""/g;
1125     my $sts = system(qq[mail/Subject="$subject" $filename. "$address","$cc"]);
1126     if ($sts) {
1127         die "Can't spawn off mail (leaving bug report in $filename): $sts";
1128     }
1129 }
1130
1131 sub _send_message_mailsend {
1132     my $msg = Mail::Send->new();
1133     my %headers = %{_message_headers()};
1134     for my $key ( keys %headers) {
1135         $msg->add($key => $headers{$key});
1136     }
1137
1138     $fh = $msg->open;
1139     open(REP, "<$filename") or die "Couldn't open '$filename': $!\n";
1140     while (<REP>) { print $fh $_ }
1141     close(REP) or die "Error closing $filename: $!";
1142     $fh->close or die "Error sending mail: $!";
1143
1144     print "\nMessage sent.\n";
1145 }
1146
1147 sub _probe_for_sendmail {
1148     my $sendmail = "";
1149     for (qw(/usr/lib/sendmail /usr/sbin/sendmail /usr/ucblib/sendmail)) {
1150         $sendmail = $_, last if -e $_;
1151     }
1152     if ( $^O eq 'os2' and $sendmail eq "" ) {
1153         my $path = $ENV{PATH};
1154         $path =~ s:\\:/:;
1155         my @path = split /$Config{'path_sep'}/, $path;
1156         for (@path) {
1157             $sendmail = "$_/sendmail",     last if -e "$_/sendmail";
1158             $sendmail = "$_/sendmail.exe", last if -e "$_/sendmail.exe";
1159         }
1160     }
1161     return $sendmail;
1162 }
1163
1164 sub _send_message_sendmail {
1165     my $sendmail = _probe_for_sendmail();
1166     unless ($sendmail) {
1167         my $message_start = !$Is_Linux && !$Is_OpenBSD ? <<'EOT' : <<'EOT';
1168 It appears that there is no program which looks like "sendmail" on
1169 your system and that the Mail::Send library from CPAN isn't available.
1170 EOT
1171 It appears that there is no program which looks like "sendmail" on
1172 your system.
1173 EOT
1174         paraprint(<<"EOF"), die "\n";
1175 $message_start
1176 Because of this, there's no easy way to automatically send your
1177 message.
1178
1179 A copy of your message has been saved in '$filename' for you to
1180 send to '$address' with your normal mail client.
1181 EOF
1182     }
1183
1184     open( SENDMAIL, "|$sendmail -t -oi" )
1185         || die "'|$sendmail -t -oi' failed: $!";
1186     print SENDMAIL build_complete_message();
1187     if ( close(SENDMAIL) ) {
1188         print "\nMessage sent\n";
1189     } else {
1190         warn "\nSendmail returned status '", $? >> 8, "'\n";
1191     }
1192 }
1193
1194
1195
1196 # a strange way to check whether any significant editing
1197 # has been done: check whether any new non-empty lines
1198 # have been added.
1199
1200 sub _fingerprint_lines_in_report {
1201     my $new_lines = 0;
1202     # read in the report template once so that
1203     # we can track whether the user does any editing.
1204     # yes, *all* whitespace is ignored.
1205
1206     open(REP, "<$filename") or die "Unable to open report file '$filename': $!\n";
1207     while (my $line = <REP>) {
1208         $line =~ s/\s+//g;
1209         $new_lines++ if (!$REP{$line});
1210
1211     }
1212     close(REP) or die "Error closing report file '$filename': $!";
1213     # returns the number of lines with content that wasn't there when last we looked
1214     return $new_lines;
1215 }
1216
1217
1218
1219 format STDOUT =
1220 ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
1221 $_
1222 .
1223
1224 __END__
1225
1226 =head1 NAME
1227
1228 perlbug - how to submit bug reports on Perl
1229
1230 =head1 SYNOPSIS
1231
1232 B<perlbug>
1233
1234 B<perlbug> S<[ B<-v> ]> S<[ B<-a> I<address> ]> S<[ B<-s> I<subject> ]>
1235 S<[ B<-b> I<body> | B<-f> I<inputfile> ]> S<[ B<-F> I<outputfile> ]>
1236 S<[ B<-r> I<returnaddress> ]>
1237 S<[ B<-e> I<editor> ]> S<[ B<-c> I<adminaddress> | B<-C> ]>
1238 S<[ B<-S> ]> S<[ B<-t> ]>  S<[ B<-d> ]>  S<[ B<-A> ]>  S<[ B<-h> ]> S<[ B<-T> ]>
1239
1240 B<perlbug> S<[ B<-v> ]> S<[ B<-r> I<returnaddress> ]>
1241  S<[ B<-A> ]> S<[ B<-ok> | B<-okay> | B<-nok> | B<-nokay> ]>
1242
1243 B<perlthanks>
1244
1245 =head1 DESCRIPTION
1246
1247
1248 This program is designed to help you generate and send bug reports
1249 (and thank-you notes) about perl5 and the modules which ship with it.
1250
1251 In most cases, you can just run it interactively from a command
1252 line without any special arguments and follow the prompts.
1253
1254 If you have found a bug with a non-standard port (one that was not
1255 part of the I<standard distribution>), a binary distribution, or a
1256 non-core module (such as Tk, DBI, etc), then please see the
1257 documentation that came with that distribution to determine the
1258 correct place to report bugs.
1259
1260 If you are unable to send your report using B<perlbug> (most likely
1261 because your system doesn't have a way to send mail that perlbug
1262 recognizes), you may be able to use this tool to compose your report
1263 and save it to a file which you can then send to B<perlbug@perl.org>
1264 using your regular mail client.
1265
1266 In extreme cases, B<perlbug> may not work well enough on your system
1267 to guide you through composing a bug report. In those cases, you
1268 may be able to use B<perlbug -d> to get system configuration
1269 information to include in a manually composed bug report to
1270 B<perlbug@perl.org>.
1271
1272
1273 When reporting a bug, please run through this checklist:
1274
1275 =over 4
1276
1277 =item What version of Perl you are running?
1278
1279 Type C<perl -v> at the command line to find out.
1280
1281 =item Are you running the latest released version of perl?
1282
1283 Look at http://www.perl.org/ to find out.  If you are not using the
1284 latest released version, please try to replicate your bug on the
1285 latest stable release.
1286
1287 Note that reports about bugs in old versions of Perl, especially
1288 those which indicate you haven't also tested the current stable
1289 release of Perl, are likely to receive less attention from the
1290 volunteers who build and maintain Perl than reports about bugs in
1291 the current release.
1292
1293 This tool isn't apropriate for reporting bugs in any version
1294 prior to Perl 5.0.
1295
1296 =item Are you sure what you have is a bug?
1297
1298 A significant number of the bug reports we get turn out to be
1299 documented features in Perl.  Make sure the issue you've run into
1300 isn't intentional by glancing through the documentation that comes
1301 with the Perl distribution.
1302
1303 Given the sheer volume of Perl documentation, this isn't a trivial
1304 undertaking, but if you can point to documentation that suggests
1305 the behaviour you're seeing is I<wrong>, your issue is likely to
1306 receive more attention. You may want to start with B<perldoc>
1307 L<perltrap> for pointers to common traps that new (and experienced)
1308 Perl programmers run into.
1309
1310 If you're unsure of the meaning of an error message you've run
1311 across, B<perldoc> L<perldiag> for an explanation.  If the message
1312 isn't in perldiag, it probably isn't generated by Perl.  You may
1313 have luck consulting your operating system documentation instead.
1314
1315 If you are on a non-UNIX platform B<perldoc> L<perlport>, as some
1316 features may be unimplemented or work differently.
1317
1318 You may be able to figure out what's going wrong using the Perl
1319 debugger.  For information about how to use the debugger B<perldoc>
1320 L<perldebug>.
1321
1322 =item Do you have a proper test case?
1323
1324 The easier it is to reproduce your bug, the more likely it will be
1325 fixed -- if nobody can duplicate your problem, it probably won't be 
1326 addressed.
1327
1328 A good test case has most of these attributes: short, simple code;
1329 few dependencies on external commands, modules, or libraries; no
1330 platform-dependent code (unless it's a platform-specific bug);
1331 clear, simple documentation.
1332
1333 A good test case is almost always a good candidate to be included in
1334 Perl's test suite.  If you have the time, consider writing your test case so
1335 that it can be easily included into the standard test suite.
1336
1337 =item Have you included all relevant information?
1338
1339 Be sure to include the B<exact> error messages, if any.
1340 "Perl gave an error" is not an exact error message.
1341
1342 If you get a core dump (or equivalent), you may use a debugger
1343 (B<dbx>, B<gdb>, etc) to produce a stack trace to include in the bug
1344 report.  
1345
1346 NOTE: unless your Perl has been compiled with debug info
1347 (often B<-g>), the stack trace is likely to be somewhat hard to use
1348 because it will most probably contain only the function names and not
1349 their arguments.  If possible, recompile your Perl with debug info and
1350 reproduce the crash and the stack trace.
1351
1352 =item Can you describe the bug in plain English?
1353
1354 The easier it is to understand a reproducible bug, the more likely
1355 it will be fixed.  Any insight you can provide into the problem
1356 will help a great deal.  In other words, try to analyze the problem
1357 (to the extent you can) and report your discoveries.
1358
1359 =item Can you fix the bug yourself?
1360
1361 A bug report which I<includes a patch to fix it> will almost
1362 definitely be fixed.  When sending a patch, please use the C<diff>
1363 program with the C<-u> option to generate "unified" diff files.
1364 Bug reports with patches are likely to receive significantly more
1365 attention and interest than those without patches.
1366
1367 Your patch may be returned with requests for changes, or requests for more
1368 detailed explanations about your fix.
1369
1370 Here are a few hints for creating high-quality patches:
1371
1372 Make sure the patch is not reversed (the first argument to diff is
1373 typically the original file, the second argument your changed file).
1374 Make sure you test your patch by applying it with the C<patch>
1375 program before you send it on its way.  Try to follow the same style
1376 as the code you are trying to patch.  Make sure your patch really
1377 does work (C<make test>, if the thing you're patching is covered
1378 by Perl's test suite).
1379
1380 =item Can you use C<perlbug> to submit the report?
1381
1382 B<perlbug> will, amongst other things, ensure your report includes
1383 crucial information about your version of perl.  If C<perlbug> is
1384 unable to mail your report after you have typed it in, you may have
1385 to compose the message yourself, add the output produced by C<perlbug
1386 -d> and email it to B<perlbug@perl.org>.  If, for some reason, you
1387 cannot run C<perlbug> at all on your system, be sure to include the
1388 entire output produced by running C<perl -V> (note the uppercase V).
1389
1390 Whether you use C<perlbug> or send the email manually, please make
1391 your Subject line informative.  "a bug" is not informative.  Neither
1392 is "perl crashes" nor is "HELP!!!".  These don't help.  A compact
1393 description of what's wrong is fine.
1394
1395 =item Can you use C<perlbug> to submit a thank-you note?
1396
1397 Yes, you can do this by either using the C<-T> option, or by invoking
1398 the program as C<perlthanks>. Thank-you notes are good. It makes people
1399 smile. 
1400
1401 =back
1402
1403 Having done your bit, please be prepared to wait, to be told the
1404 bug is in your code, or possibly to get no reply at all.  The
1405 volunteers who maintain Perl are busy folks, so if your problem is
1406 an obvious bug in your own code, is difficult to understand or is
1407 a duplicate of an existing report, you may not receive a personal
1408 reply.
1409
1410 If it is important to you that your bug be fixed, do monitor the
1411 perl5-porters@perl.org mailing list and the commit logs to development
1412 versions of Perl, and encourage the maintainers with kind words or
1413 offers of frosty beverages.  (Please do be kind to the maintainers.
1414 Harassing or flaming them is likely to have the opposite effect of
1415 the one you want.)
1416
1417 Feel free to update the ticket about your bug on http://rt.perl.org
1418 if a new version of Perl is released and your bug is still present.
1419
1420 =head1 OPTIONS
1421
1422 =over 8
1423
1424 =item B<-a>
1425
1426 Address to send the report to.  Defaults to B<perlbug@perl.org>.
1427
1428 =item B<-A>
1429
1430 Don't send a bug received acknowledgement to the reply address.
1431 Generally it is only a sensible to use this option if you are a
1432 perl maintainer actively watching perl porters for your message to
1433 arrive.
1434
1435 =item B<-b>
1436
1437 Body of the report.  If not included on the command line, or
1438 in a file with B<-f>, you will get a chance to edit the message.
1439
1440 =item B<-C>
1441
1442 Don't send copy to administrator.
1443
1444 =item B<-c>
1445
1446 Address to send copy of report to.  Defaults to the address of the
1447 local perl administrator (recorded when perl was built).
1448
1449 =item B<-d>
1450
1451 Data mode (the default if you redirect or pipe output).  This prints out
1452 your configuration data, without mailing anything.  You can use this
1453 with B<-v> to get more complete data.
1454
1455 =item B<-e>
1456
1457 Editor to use.
1458
1459 =item B<-f>
1460
1461 File containing the body of the report.  Use this to quickly send a
1462 prepared message.
1463
1464 =item B<-F>
1465
1466 File to output the results to instead of sending as an email. Useful
1467 particularly when running perlbug on a machine with no direct internet
1468 connection.
1469
1470 =item B<-h>
1471
1472 Prints a brief summary of the options.
1473
1474 =item B<-ok>
1475
1476 Report successful build on this system to perl porters. Forces B<-S>
1477 and B<-C>. Forces and supplies values for B<-s> and B<-b>. Only
1478 prompts for a return address if it cannot guess it (for use with
1479 B<make>). Honors return address specified with B<-r>.  You can use this
1480 with B<-v> to get more complete data.   Only makes a report if this
1481 system is less than 60 days old.
1482
1483 =item B<-okay>
1484
1485 As B<-ok> except it will report on older systems.
1486
1487 =item B<-nok>
1488
1489 Report unsuccessful build on this system.  Forces B<-C>.  Forces and
1490 supplies a value for B<-s>, then requires you to edit the report
1491 and say what went wrong.  Alternatively, a prepared report may be
1492 supplied using B<-f>.  Only prompts for a return address if it
1493 cannot guess it (for use with B<make>). Honors return address
1494 specified with B<-r>.  You can use this with B<-v> to get more
1495 complete data.  Only makes a report if this system is less than 60
1496 days old.
1497
1498 =item B<-nokay>
1499
1500 As B<-nok> except it will report on older systems.
1501
1502 =item B<-r>
1503
1504 Your return address.  The program will ask you to confirm its default
1505 if you don't use this option.
1506
1507 =item B<-S>
1508
1509 Send without asking for confirmation.
1510
1511 =item B<-s>
1512
1513 Subject to include with the message.  You will be prompted if you don't
1514 supply one on the command line.
1515
1516 =item B<-t>
1517
1518 Test mode.  The target address defaults to B<perlbug-test@perl.org>.
1519
1520 =item B<-T>
1521
1522 Send a thank-you note instead of a bug report. 
1523
1524 =item B<-v>
1525
1526 Include verbose configuration data in the report.
1527
1528 =back
1529
1530 =head1 AUTHORS
1531
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.a.ukE<gt>), Dominic Dunlop
1537 (E<lt>domo@computer.orgE<gt>), Hugo van der Sanden (E<lt>hv@crypt.org<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>), and Jesse Vincent
1541 (E<lt>jesse@bestpractical.com<gt>).
1542
1543 =head1 SEE ALSO
1544
1545 perl(1), perldebug(1), perldiag(1), perlport(1), perltrap(1),
1546 diff(1), patch(1), dbx(1), gdb(1)
1547
1548 =head1 BUGS
1549
1550 None known (guess what must have been used to report them?)
1551
1552 =cut
1553
1554 !NO!SUBS!
1555
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 ':';
1559 chdir $origdir;