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