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