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