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