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