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