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