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