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