utils/perlbug.PL

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