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