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