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