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