utils/perlbug.PL

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