utils/perlbug.PL

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