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