utils/perlbug.PL

   1 #!/usr/local/bin/perl
   2
   3 use Config;
   4 use File::Basename qw(&basename &dirname);
   5 use Cwd;
   6
   7 # List explicitly here the variables you want Configure to
   8 # generate.  Metaconfig only looks for shell variables, so you
   9 # have to mention them as if they were shell variables, not
  10 # %Config entries.  Thus you write
  11 #  $startperl
  12 # to ensure Configure will look for $Config{startperl}.
  13 #  $perlpath
  14
  15 # This forces PL files to create target in same directory as PL file.
  16 # This is so that make depend always knows where to find PL derivatives.
  17 $origdir = cwd;
  18 chdir dirname($0);
  19 $file = basename($0, '.PL');
  20 $file .= '.com' if $^O eq 'VMS';
  21
  22 open OUT, ">$file" or die "Can't create $file: $!";
  23
  24 # extract patchlevel.h information
  25
  26 open PATCH_LEVEL, "<../patchlevel.h" or die "Can't open patchlevel.h: $!";
  27
  28 my $patchlevel_date = (stat PATCH_LEVEL)[9];
  29
  30 while (<PATCH_LEVEL>) {
  31     last if $_ =~ /^\s*static\s+char.*?local_patches\[\]\s*=\s*{\s*$/;
  32 }
  33
  34 my @patches;
  35 while (<PATCH_LEVEL>) {
  36     last if /^\s*}/;
  37     chomp;
  38     s/^\s+,?"?//;
  39     s/"?,?$//;
  40     s/(['\\])/\\$1/g;
  41     push @patches, $_ unless $_ eq 'NULL';
  42 }
  43 my $patch_desc = "'" . join("',\n    '", @patches) . "'";
  44 my $patch_tags = join "", map /(\S+)/ ? "+$1 " : (), @patches;
  45
  46 close PATCH_LEVEL;
  47
  48 # TO DO (prehaps): store/embed $Config::config_sh into perlbug. When perlbug is
  49 # used, compare $Config::config_sh with the stored version. If they differ then
  50 # append a list of individual differences to the bug report.
  51
  52
  53 print "Extracting $file (with variable substitutions)\n";
  54
  55 # In this section, perl variables will be expanded during extraction.
  56 # You can use $Config{...} to use Configure variables.
  57
  58 print OUT <<"!GROK!THIS!";
  59 $Config{startperl}
  60     eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
  61         if \$running_under_some_shell;
  62
  63 my \$config_tag1 = '$] - $Config{cf_time}';
  64
  65 my \$patchlevel_date = $patchlevel_date;
  66 my \$patch_tags = '$patch_tags';
  67 my \@patches = (
  68     $patch_desc
  69 );
  70 !GROK!THIS!
  71
  72 # In the following, perl variables are not expanded during extraction.
  73
  74 print OUT <<'!NO!SUBS!';
  75
  76 use Config;
  77 use Getopt::Std;
  78 use strict;
  79
  80 sub paraprint;
  81
  82 BEGIN {
  83     eval "use Mail::Send;";
  84     $::HaveSend = ($@ eq "");
  85     eval "use Mail::Util;";
  86     $::HaveUtil = ($@ eq "");
  87 };
  88
  89 my $Version = "1.23";
  90
  91 # Changed in 1.06 to skip Mail::Send and Mail::Util if not available.
  92 # Changed in 1.07 to see more sendmail execs, and added pipe output.
  93 # Changed in 1.08 to use correct address for sendmail.
  94 # Changed in 1.09 to close the REP file before calling it up in the editor.
  95 #                 Also removed some old comments duplicated elsewhere.
  96 # Changed in 1.10 to run under VMS without Mail::Send; also fixed
  97 #                 temp filename generation.
  98 # Changed in 1.11 to clean up some text and removed Mail::Send deactivator.
  99 # Changed in 1.12 to check for editor errors, make save/send distinction
 100 #                 clearer and add $ENV{REPLYTO}.
 101 # Changed in 1.13 to hopefully make it more difficult to accidentally
 102 #                 send mail
 103 # Changed in 1.14 to make the prompts a little more clear on providing
 104 #                 helpful information. Also let file read fail gracefully.
 105 # Changed in 1.15 to add warnings to stop people using perlbug for non-bugs.
 106 #                 Also report selected environment variables.
 107 # Changed in 1.16 to include @INC, and allow user to re-edit if no changes.
 108 # Changed in 1.17 Win32 support added.  GSAR 97-04-12
 109 # Changed in 1.18 add '-ok' option for reporting build success. CFR 97-06-18
 110 # Changed in 1.19 '-ok' default not '-v'
 111 #                 add local patch information
 112 #                 warn on '-ok' if this is an old system; add '-okay'
 113 # Changed in 1.20 Added patchlevel.h reading and version/config checks
 114 # Changed in 1.21 Added '-nok' for reporting build failure DFD 98-05-05
 115 # Changed in 1.22 Heavy reformatting & minor bugfixes HVDS 98-05-10
 116 # Changed in 1.23 Restore -ok(ay): say 'success'; don't prompt
 117
 118 # TODO: - Allow the user to re-name the file on mail failure, and
 119 #       make sure failure (transmission-wise) of Mail::Send is
 120 #       accounted for.
 121 #       - Test -b option
 122
 123 my( $file, $usefile, $cc, $address, $perlbug, $testaddress, $filename,
 124     $subject, $from, $verbose, $ed,
 125     $fh, $me, $Is_MSWin32, $Is_VMS, $msg, $body, $andcc, %REP, $ok);
 126
 127 my $config_tag2 = "$] - $Config{cf_time}";
 128
 129 Init();
 130
 131 if ($::opt_h) { Help(); exit; }
 132 if ($::opt_d) { Dump(*STDOUT); exit; }
 133 if (!-t STDIN) {
 134     paraprint <<EOF;
 135 Please use perlbug interactively. If you want to
 136 include a file, you can use the -f switch.
 137 EOF
 138     die "\n";
 139 }
 140 if (!-t STDOUT) { Dump(*STDOUT); exit; }
 141
 142 Query();
 143 Edit() unless $usefile || ($ok and not $::opt_n);
 144 NowWhat();
 145 Send();
 146
 147 exit;
 148
 149 sub Init {
 150     # -------- Setup --------
 151
 152     $Is_MSWin32 = $^O eq 'MSWin32';
 153     $Is_VMS = $^O eq 'VMS';
 154
 155     getopts("dhva:s:b:f:r:e:SCc:to:n:");
 156
 157     # This comment is needed to notify metaconfig that we are
 158     # using the $perladmin, $cf_by, and $cf_time definitions.
 159
 160     # -------- Configuration ---------
 161
 162     # perlbug address
 163     $perlbug = 'perlbug@perl.com';
 164
 165     # Test address
 166     $testaddress = 'perlbug-test@perl.com';
 167
 168     # Target address
 169     $address = $::opt_a || ($::opt_t ? $testaddress : $perlbug);
 170
 171     # Users address, used in message and in Reply-To header
 172     $from = $::opt_r || "";
 173
 174     # Include verbose configuration information
 175     $verbose = $::opt_v || 0;
 176
 177     # Subject of bug-report message
 178     $subject = $::opt_s || "";
 179
 180     # Send a file
 181     $usefile = ($::opt_f || 0);
 182
 183     # File to send as report
 184     $file = $::opt_f || "";
 185
 186     # Body of report
 187     $body = $::opt_b || "";
 188
 189     # Editor
 190     $ed = $::opt_e || $ENV{VISUAL} || $ENV{EDITOR} || $ENV{EDIT}
 191         || ($Is_VMS && "edit/tpu")
 192         || ($Is_MSWin32 && "notepad")
 193         || "vi";
 194
 195     # Not OK - provide build failure template by finessing OK report
 196     if ($::opt_n) {
 197         if (substr($::opt_n, 0, 2) eq 'ok' )    {
 198             $::opt_o = substr($::opt_n, 1);
 199         } else {
 200             Help();
 201             exit();
 202         }
 203     }
 204
 205     # OK - send "OK" report for build on this system
 206     $ok = 0;
 207     if ($::opt_o) {
 208         if ($::opt_o eq 'k' or $::opt_o eq 'kay') {
 209             my $age = time - $patchlevel_date;
 210             if ($::opt_o eq 'k' and $age > 60 * 24 * 60 * 60 ) {
 211                 my $date = localtime $patchlevel_date;
 212                 print <<"EOF";
 213 "perlbug -ok" and "perlbug -nok" do not report on Perl versions which
 214 are more than 60 days old.  This Perl version was constructed on
 215 $date.  If you really want to report this, use
 216 "perlbug -okay" or "perlbug -nokay".
 217 EOF
 218                 exit();
 219             }
 220             # force these options
 221             unless ($::opt_n) {
 222                 $::opt_S = 1; # don't prompt for send
 223                 $::opt_b = 1; # we have a body
 224                 $body = "Perl reported to build OK on this system.\n";
 225             }
 226             $::opt_C = 1; # don't send a copy to the local admin
 227             $::opt_s = 1; # we have a subject line
 228             $subject = ($::opt_n ? 'Not ' : '')
 229                     . "OK: perl $] ${patch_tags}on"
 230                     ." $::Config{'archname'} $::Config{'osvers'} $subject";
 231             $ok = 1;
 232         } else {
 233             Help();
 234             exit();
 235         }
 236     }
 237
 238     # Possible administrator addresses, in order of confidence
 239     # (Note that cf_email is not mentioned to metaconfig, since
 240     # we don't really want it. We'll just take it if we have to.)
 241     #
 242     # This has to be after the $ok stuff above because of the way
 243     # that $::opt_C is forced.
 244     $cc = $::opt_C ? "" : (
 245         $::opt_c || $::Config{'perladmin'}
 246         || $::Config{'cf_email'} || $::Config{'cf_by'}
 247     );
 248
 249     # My username
 250     $me = $Is_MSWin32 ? $ENV{'USERNAME'}
 251             : $^O eq 'os2' ? $ENV{'USER'} || $ENV{'LOGNAME'}
 252             : eval { getpwuid($<) };    # May be missing
 253
 254     $from = $::Config{'cf_email'}
 255        if !$from && $::Config{'cf_email'} && $::Config{'cf_by'} && $me &&
 256                ($me eq $::Config{'cf_by'});
 257 } # sub Init
 258
 259 sub Query {
 260     # Explain what perlbug is
 261     unless ($ok) {
 262         paraprint <<EOF;
 263 This program provides an easy way to create a message reporting a bug
 264 in perl, and e-mail it to $address.  It is *NOT* intended for
 265 sending test messages or simply verifying that perl works, *NOR* is it
 266 intended for reporting bugs in third-party perl modules.  It is *ONLY*
 267 a means of reporting verifiable problems with the core perl distribution,
 268 and any solutions to such problems, to the people who maintain perl.
 269
 270 If you're just looking for help with perl, try posting to the Usenet
 271 newsgroup comp.lang.perl.misc.  If you're looking for help with using
 272 perl with CGI, try posting to comp.infosystems.www.programming.cgi.
 273 EOF
 274     }
 275
 276     # Prompt for subject of message, if needed
 277     unless ($subject) {
 278         paraprint <<EOF;
 279 First of all, please provide a subject for the
 280 message. It should be a concise description of
 281 the bug or problem. "perl bug" or "perl problem"
 282 is not a concise description.
 283 EOF
 284         print "Subject: ";
 285         $subject = <>;
 286
 287         my $err = 0;
 288         while ($subject !~ /\S/) {
 289             print "\nPlease enter a subject: ";
 290             $subject = <>;
 291             if ($err++ > 5) {
 292                 die "Aborting.\n";
 293             }
 294         }
 295         chop $subject;
 296     }
 297
 298     # Prompt for return address, if needed
 299     unless ($from) {
 300         # Try and guess return address
 301         my $guess;
 302
 303         $guess = $ENV{'REPLY-TO'} || $ENV{'REPLYTO'} || '';
 304         unless ($guess) {
 305             my $domain;
 306             if ($::HaveUtil) {
 307                 $domain = Mail::Util::maildomain();
 308             } elsif ($Is_MSWin32) {
 309                 $domain = $ENV{'USERDOMAIN'};
 310             } else {
 311                 require Sys::Hostname;
 312                 $domain = Sys::Hostname::hostname();
 313             }
 314             if ($domain) {
 315                 if ($Is_VMS && !$::Config{'d_socket'}) {
 316                     $guess = "$domain\:\:$me";
 317                 } else {
 318                     $guess = "$me\@$domain" if $domain;
 319                 }
 320             }
 321         }
 322
 323         if ($guess) {
 324             unless ($ok) {
 325                 paraprint <<EOF;
 326 Your e-mail address will be useful if you need to be contacted. If the
 327 default shown is not your full internet e-mail address, please correct it.
 328 EOF
 329             }
 330         } else {
 331             paraprint <<EOF;
 332 So that you may be contacted if necessary, please enter
 333 your full internet e-mail address here.
 334 EOF
 335         }
 336
 337         if ($ok && $guess) {
 338             # use it
 339             $from = $guess;
 340         } else {
 341             # verify it
 342             print "Your address [$guess]: ";
 343             $from = <>;
 344             chop $from;
 345             $from = $guess if $from eq '';
 346         }
 347     }
 348
 349     if ($from eq $cc or $me eq $cc) {
 350         # Try not to copy ourselves
 351         $cc = "yourself";
 352     }
 353
 354     # Prompt for administrator address, unless an override was given
 355     if( !$::opt_C and !$::opt_c ) {
 356         paraprint <<EOF;
 357 A copy of this report can be sent to your local
 358 perl administrator. If the address is wrong, please
 359 correct it, or enter 'none' or 'yourself' to not send
 360 a copy.
 361 EOF
 362         print "Local perl administrator [$cc]: ";
 363         my $entry = scalar <>;
 364         chop $entry;
 365
 366         if ($entry ne "") {
 367             $cc = $entry;
 368             $cc = '' if $me eq $cc;
 369         }
 370     }
 371
 372     $cc = '' if $cc =~ /^(none|yourself|me|myself|ourselves)$/i;
 373     $andcc = " and $cc" if $cc;
 374
 375     # Prompt for editor, if no override is given
 376 editor:
 377     unless ($::opt_e || $::opt_f || $::opt_b) {
 378         paraprint <<EOF;
 379 Now you need to supply the bug report. Try to make
 380 the report concise but descriptive. Include any
 381 relevant detail. If you are reporting something
 382 that does not work as you think it should, please
 383 try to include example of both the actual
 384 result, and what you expected.
 385
 386 Some information about your local
 387 perl configuration will automatically be included
 388 at the end of the report. If you are using any
 389 unusual version of perl, please try and confirm
 390 exactly which versions are relevant.
 391
 392 You will probably want to use an editor to enter
 393 the report. If "$ed" is the editor you want
 394 to use, then just press Enter, otherwise type in
 395 the name of the editor you would like to use.
 396
 397 If you would like to use a prepared file, type
 398 "file", and you will be asked for the filename.
 399 EOF
 400         print "Editor [$ed]: ";
 401         my $entry =scalar <>;
 402         chop $entry;
 403
 404         $usefile = 0;
 405         if ($entry eq "file") {
 406             $usefile = 1;
 407         } elsif ($entry ne "") {
 408             $ed = $entry;
 409         }
 410     }
 411
 412     # Generate scratch file to edit report in
 413     $filename = filename();
 414
 415     # Prompt for file to read report from, if needed
 416     if ($usefile and !$file) {
 417 filename:
 418         paraprint <<EOF;
 419 What is the name of the file that contains your report?
 420 EOF
 421         print "Filename: ";
 422         my $entry = scalar <>;
 423         chop $entry;
 424
 425         if ($entry eq "") {
 426             paraprint <<EOF;
 427 No filename? I'll let you go back and choose an editor again.
 428 EOF
 429             goto editor;
 430         }
 431
 432         unless (-f $entry and -r $entry) {
 433             paraprint <<EOF;
 434 I'm sorry, but I can't read from `$entry'. Maybe you mistyped the name of
 435 the file? If you don't want to send a file, just enter a blank line and you
 436 can get back to the editor selection.
 437 EOF
 438             goto filename;
 439         }
 440         $file = $entry;
 441     }
 442
 443     # Generate report
 444     open(REP,">$filename");
 445     my $reptype = !$ok ? "bug" : $::opt_n ? "build failure" : "success";
 446
 447     print REP <<EOF;
 448 This is a $reptype report for perl from $from,
 449 generated with the help of perlbug $Version running under perl $].
 450
 451 EOF
 452
 453     if ($body) {
 454         print REP $body;
 455     } elsif ($usefile) {
 456         open(F, "<$file")
 457                 or die "Unable to read report file from `$file': $!\n";
 458         while (<F>) {
 459             print REP $_
 460         }
 461         close(F);
 462     } else {
 463         print REP <<EOF;
 464
 465 -----------------------------------------------------------------
 466 [Please enter your report here]
 467
 468
 469
 470 [Please do not change anything below this line]
 471 -----------------------------------------------------------------
 472 EOF
 473     }
 474     Dump(*REP);
 475     close(REP);
 476
 477     # read in the report template once so that
 478     # we can track whether the user does any editing.
 479     # yes, *all* whitespace is ignored.
 480     open(REP, "<$filename");
 481     while (<REP>) {
 482         s/\s+//g;
 483         $REP{$_}++;
 484     }
 485     close(REP);
 486 } # sub Query
 487
 488 sub Dump {
 489     local(*OUT) = @_;
 490
 491     print REP "\n---\n";
 492     print REP "This perlbug was built using Perl $config_tag1\n",
 493             "It is being executed now by  Perl $config_tag2.\n\n"
 494         if $config_tag2 ne $config_tag1;
 495
 496     print OUT <<EOF;
 497 Site configuration information for perl $]:
 498
 499 EOF
 500     if ($::Config{cf_by} and $::Config{cf_time}) {
 501         print OUT "Configured by $::Config{cf_by} at $::Config{cf_time}.\n\n";
 502     }
 503     print OUT Config::myconfig;
 504
 505     if (@patches) {
 506         print OUT join "\n    ", "Locally applied patches:", @patches;
 507         print OUT "\n";
 508     };
 509
 510     print OUT <<EOF;
 511
 512 ---
 513 \@INC for perl $]:
 514 EOF
 515     for my $i (@INC) {
 516         print OUT "    $i\n";
 517     }
 518
 519     print OUT <<EOF;
 520
 521 ---
 522 Environment for perl $]:
 523 EOF
 524     for my $env (sort
 525         (qw(PATH LD_LIBRARY_PATH LANG PERL_BADLANG SHELL HOME LOGDIR),
 526         grep /^(?:PERL|LC_)/, keys %ENV)
 527     ) {
 528         print OUT "    $env",
 529                 exists $ENV{$env} ? "=$ENV{$env}" : ' (unset)',
 530                 "\n";
 531     }
 532     if ($verbose) {
 533         print OUT "\nComplete configuration data for perl $]:\n\n";
 534         my $value;
 535         foreach (sort keys %::Config) {
 536             $value = $::Config{$_};
 537             $value =~ s/'/\\'/g;
 538             print OUT "$_='$value'\n";
 539         }
 540     }
 541 } # sub Dump
 542
 543 sub Edit {
 544     # Edit the report
 545     if ($usefile || $body) {
 546         paraprint <<EOF;
 547 Please make sure that the name of the editor you want to use is correct.
 548 EOF
 549         print "Editor [$ed]: ";
 550         my $entry =scalar <>;
 551         chop $entry;
 552         $ed = $entry unless $entry eq '';
 553     }
 554
 555 tryagain:
 556     my $sts = system("$ed $filename");
 557     if ($sts) {
 558         paraprint <<EOF;
 559 The editor you chose (`$ed') could apparently not be run!
 560 Did you mistype the name of your editor? If so, please
 561 correct it here, otherwise just press Enter.
 562 EOF
 563         print "Editor [$ed]: ";
 564         my $entry =scalar <>;
 565         chop $entry;
 566
 567         if ($entry ne "") {
 568             $ed = $entry;
 569             goto tryagain;
 570         } else {
 571             paraprint <<EOF;
 572 You may want to save your report to a file, so you can edit and mail it
 573 yourself.
 574 EOF
 575         }
 576     }
 577
 578     return if ($ok and not $::opt_n) || $body;
 579     # Check that we have a report that has some, eh, report in it.
 580     my $unseen = 0;
 581
 582     open(REP, "<$filename");
 583     # a strange way to check whether any significant editing
 584     # have been done: check whether any new non-empty lines
 585     # have been added. Yes, the below code ignores *any* space
 586     # in *any* line.
 587     while (<REP>) {
 588         s/\s+//g;
 589         $unseen++ if $_ ne '' and not exists $REP{$_};
 590     }
 591
 592     while ($unseen == 0) {
 593         paraprint <<EOF;
 594 I am sorry but it looks like you did not report anything.
 595 EOF
 596         print "Action (Retry Edit/Cancel) ";
 597         my ($action) = scalar(<>);
 598         if ($action =~ /^[re]/i) { # <R>etry <E>dit
 599             goto tryagain;
 600         } elsif ($action =~ /^[cq]/i) { # <C>ancel, <Q>uit
 601             Cancel();
 602         }
 603     }
 604 } # sub Edit
 605
 606 sub Cancel {
 607     1 while unlink($filename);  # remove all versions under VMS
 608     print "\nCancelling.\n";
 609     exit(0);
 610 }
 611
 612 sub NowWhat {
 613     # Report is done, prompt for further action
 614     if( !$::opt_S ) {
 615         while(1) {
 616             paraprint <<EOF;
 617 Now that you have completed your report, would you like to send
 618 the message to $address$andcc, display the message on
 619 the screen, re-edit it, or cancel without sending anything?
 620 You may also save the message as a file to mail at another time.
 621 EOF
 622             print "Action (Send/Display/Edit/Cancel/Save to File): ";
 623             my $action = scalar <>;
 624             chop $action;
 625
 626             if ($action =~ /^(f|sa)/i) { # <F>ile/<Sa>ve
 627                 print "\n\nName of file to save message in [perlbug.rep]: ";
 628                 my $file = scalar <>;
 629                 chop $file;
 630                 $file = "perlbug.rep" if $file eq "";
 631
 632                 open(FILE, ">$file");
 633                 open(REP, "<$filename");
 634                 print FILE "To: $address\nSubject: $subject\n";
 635                 print FILE "Cc: $cc\n" if $cc;
 636                 print FILE "Reply-To: $from\n" if $from;
 637                 print FILE "\n";
 638                 while (<REP>) { print FILE }
 639                 close(REP);
 640                 close(FILE);
 641
 642                 print "\nMessage saved in `$file'.\n";
 643                 exit;
 644             } elsif ($action =~ /^(d|l|sh)/i ) { # <D>isplay, <L>ist, <Sh>ow
 645                 # Display the message
 646                 open(REP, "<$filename");
 647                 while (<REP>) { print $_ }
 648                 close(REP);
 649             } elsif ($action =~ /^se/i) { # <S>end
 650                 # Send the message
 651                 print "Are you certain you want to send this message?\n"
 652                     . 'Please type "yes" if you are: ';
 653                 my $reply = scalar <STDIN>;
 654                 chop $reply;
 655                 if ($reply eq "yes") {
 656                     last;
 657                 } else {
 658                     paraprint <<EOF;
 659 That wasn't a clear "yes", so I won't send your message. If you are sure
 660 your message should be sent, type in "yes" (without the quotes) at the
 661 confirmation prompt.
 662 EOF
 663                 }
 664             } elsif ($action =~ /^[er]/i) { # <E>dit, <R>e-edit
 665                 # edit the message
 666                 Edit();
 667             } elsif ($action =~ /^[qc]/i) { # <C>ancel, <Q>uit
 668                 Cancel();
 669             } elsif ($action =~ /^s/) {
 670                 paraprint <<EOF;
 671 I'm sorry, but I didn't understand that. Please type "send" or "save".
 672 EOF
 673             }
 674         }
 675     }
 676 } # sub NowWhat
 677
 678 sub Send {
 679     # Message has been accepted for transmission -- Send the message
 680     if ($::HaveSend) {
 681         $msg = new Mail::Send Subject => $subject, To => $address;
 682         $msg->cc($cc) if $cc;
 683         $msg->add("Reply-To",$from) if $from;
 684
 685         $fh = $msg->open;
 686         open(REP, "<$filename");
 687         while (<REP>) { print $fh $_ }
 688         close(REP);
 689         $fh->close;
 690
 691         print "\nMessage sent.\n";
 692     } elsif ($Is_VMS) {
 693         if ( ($address =~ /@/ and $address !~ /^\w+%"/) or
 694              ($cc      =~ /@/ and $cc      !~ /^\w+%"/) ) {
 695             my $prefix;
 696             foreach (qw[ IN MX SMTP UCX PONY WINS ], '') {
 697                 $prefix = "$_%", last if $ENV{"MAIL\$PROTOCOL_$_"};
 698             }
 699             $address = qq[${prefix}"$address"] unless $address =~ /^\w+%"/;
 700             $cc = qq[${prefix}"$cc"] unless !$cc || $cc =~ /^\w+%"/;
 701         }
 702         $subject =~ s/"/""/g; $address =~ s/"/""/g; $cc =~ s/"/""/g;
 703         my $sts = system(qq[mail/Subject="$subject" $filename. "$address","$cc"]);
 704         if ($sts) {
 705             die <<EOF;
 706 Can't spawn off mail
 707         (leaving bug report in $filename): $sts
 708 EOF
 709         }
 710     } else {
 711         my $sendmail = "";
 712         for (qw(/usr/lib/sendmail /usr/sbin/sendmail /usr/ucblib/sendmail)) {
 713             $sendmail = $_, last if -e $_;
 714         }
 715         if ($^O eq 'os2' and $sendmail eq "") {
 716             my $path = $ENV{PATH};
 717             $path =~ s:\\:/: ;
 718             my @path = split /$Config{'path_sep'}/, $path;
 719             for (@path) {
 720                 $sendmail = "$_/sendmail", last if -e "$_/sendmail";
 721                 $sendmail = "$_/sendmail.exe", last if -e "$_/sendmail.exe";
 722             }
 723         }
 724
 725         paraprint(<<"EOF"), die "\n" if $sendmail eq "";
 726 I am terribly sorry, but I cannot find sendmail, or a close equivalent, and
 727 the perl package Mail::Send has not been installed, so I can't send your bug
 728 report. We apologize for the inconvenience.
 729
 730 So you may attempt to find some way of sending your message, it has
 731 been left in the file `$filename'.
 732 EOF
 733         open(SENDMAIL, "|$sendmail -t") || die "'|$sendmail -t' failed: $!";
 734         print SENDMAIL "To: $address\n";
 735         print SENDMAIL "Subject: $subject\n";
 736         print SENDMAIL "Cc: $cc\n" if $cc;
 737         print SENDMAIL "Reply-To: $from\n" if $from;
 738         print SENDMAIL "\n\n";
 739         open(REP, "<$filename");
 740         while (<REP>) { print SENDMAIL $_ }
 741         close(REP);
 742
 743         if (close(SENDMAIL)) {
 744             print "\nMessage sent.\n";
 745         } else {
 746             warn "\nSendmail returned status '", $? >> 8, "'\n";
 747         }
 748     }
 749     1 while unlink($filename);  # remove all versions under VMS
 750 } # sub Send
 751
 752 sub Help {
 753     print <<EOF;
 754
 755 A program to help generate bug reports about perl5, and mail them.
 756 It is designed to be used interactively. Normally no arguments will
 757 be needed.
 758
 759 Usage:
 760 $0  [-v] [-a address] [-s subject] [-b body | -f file ]
 761     [-r returnaddress] [-e editor] [-c adminaddress | -C] [-S] [-t] [-h]
 762 $0  [-v] [-r returnaddress] [-ok | -okay | -nok | -nokay]
 763
 764 Simplest usage:  run "$0", and follow the prompts.
 765
 766 Options:
 767
 768   -v    Include Verbose configuration data in the report
 769   -f    File containing the body of the report. Use this to
 770         quickly send a prepared message.
 771   -S    Send without asking for confirmation.
 772   -a    Address to send the report to. Defaults to `$address'.
 773   -c    Address to send copy of report to. Defaults to `$cc'.
 774   -C    Don't send copy to administrator.
 775   -s    Subject to include with the message. You will be prompted
 776         if you don't supply one on the command line.
 777   -b    Body of the report. If not included on the command line, or
 778         in a file with -f, you will get a chance to edit the message.
 779   -r    Your return address. The program will ask you to confirm
 780         this if you don't give it here.
 781   -e    Editor to use.
 782   -t    Test mode. The target address defaults to `$testaddress'.
 783   -d    Data mode (the default if you redirect or pipe output.)
 784         This prints out your configuration data, without mailing
 785         anything. You can use this with -v to get more complete data.
 786   -ok   Report successful build on this system to perl porters
 787         (use alone or with -v). Only use -ok if *everything* was ok:
 788         if there were *any* problems at all, use -nok.
 789   -okay As -ok but allow report from old builds.
 790   -nok  Report unsuccessful build on this system to perl porters
 791         (use alone or with -v). You must describe what went wrong
 792         in the body of the report which you will be asked to edit.
 793   -nokay As -nok but allow report from old builds.
 794   -h    Print this help message.
 795
 796 EOF
 797 }
 798
 799 sub filename {
 800     my $dir = $Is_VMS ? 'sys$scratch:'
 801         : ($Is_MSWin32 && $ENV{'TEMP'}) ? $ENV{'TEMP'}
 802         : '/tmp/';
 803     $filename = "bugrep0$$";
 804     $dir .= "\\" if $Is_MSWin32 and $dir !~ m|[\\/]$|;
 805     $filename++ while -e "$dir$filename";
 806     $filename = "$dir$filename";
 807 }
 808
 809 sub paraprint {
 810     my @paragraphs = split /\n{2,}/, "@_";
 811     print "\n\n";
 812     for (@paragraphs) {   # implicit local $_
 813         s/(\S)\s*\n/$1 /g;
 814         write;
 815         print "\n";
 816     }
 817 }
 818
 819 format STDOUT =
 820 ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
 821 $_
 822 .
 823
 824 __END__
 825
 826 =head1 NAME
 827
 828 perlbug - how to submit bug reports on Perl
 829
 830 =head1 SYNOPSIS
 831
 832 B<perlbug> S<[ B<-v> ]> S<[ B<-a> I<address> ]> S<[ B<-s> I<subject> ]>
 833 S<[ B<-b> I<body> | B<-f> I<file> ]> S<[ B<-r> I<returnaddress> ]>
 834 S<[ B<-e> I<editor> ]> S<[ B<-c> I<adminaddress> | B<-C> ]>
 835 S<[ B<-S> ]> S<[ B<-t> ]>  S<[ B<-d> ]>  S<[ B<-h> ]>
 836
 837 B<perlbug> S<[ B<-v> ]> S<[ B<-r> I<returnaddress> ]>
 838 S<[ B<-ok> | B<-okay> | B<-nok> | B<-nokay> ]>
 839
 840 =head1 DESCRIPTION
 841
 842 A program to help generate bug reports about perl or the modules that
 843 come with it, and mail them.
 844
 845 If you have found a bug with a non-standard port (one that was not part
 846 of the I<standard distribution>), a binary distribution, or a
 847 non-standard module (such as Tk, CGI, etc), then please see the
 848 documentation that came with that distribution to determine the correct
 849 place to report bugs.
 850
 851 C<perlbug> is designed to be used interactively. Normally no arguments
 852 will be needed.  Simply run it, and follow the prompts.
 853
 854 If you are unable to run B<perlbug> (most likely because you don't have
 855 a working setup to send mail that perlbug recognizes), you may have to
 856 compose your own report, and email it to B<perlbug@perl.com>.  You might
 857 find the B<-d> option useful to get summary information in that case.
 858
 859 In any case, when reporting a bug, please make sure you have run through
 860 this checklist:
 861
 862 =over 4
 863
 864 =item What version of perl you are running?
 865
 866 Type C<perl -v> at the command line to find out.
 867
 868 =item Are you running the latest released version of perl?
 869
 870 Look at http://www.perl.com/ to find out.  If it is not the latest
 871 released version, get that one and see whether your bug has been
 872 fixed.  Note that bug reports about old versions of perl, especially
 873 those prior to the 5.0 release, are likely to fall upon deaf ears.
 874 You are on your own if you continue to use perl1 .. perl4.
 875
 876 =item Are you sure what you have is a bug?
 877
 878 A significant number of the bug reports we get turn out to be documented
 879 features in perl.  Make sure the behavior you are witnessing doesn't fall
 880 under that category, by glancing through the documentation that comes
 881 with perl (we'll admit this is no mean task, given the sheer volume of
 882 it all, but at least have a look at the sections that I<seem> relevant).
 883
 884 Be aware of the familiar traps that perl programmers of various hues
 885 fall into.  See L<perltrap>.
 886
 887 Try to study the problem under the perl debugger, if necessary.
 888 See L<perldebug>.
 889
 890 =item Do you have a proper test case?
 891
 892 The easier it is to reproduce your bug, the more likely it will be
 893 fixed, because if no one can duplicate the problem, no one can fix it.
 894 A good test case has most of these attributes: fewest possible number
 895 of lines; few dependencies on external commands, modules, or
 896 libraries; runs on most platforms unimpeded; and is self-documenting.
 897
 898 A good test case is almost always a good candidate to be on the perl
 899 test suite.  If you have the time, consider making your test case so
 900 that it will readily fit into the standard test suite.
 901
 902 =item Can you describe the bug in plain English?
 903
 904 The easier it is to understand a reproducible bug, the more likely it
 905 will be fixed.  Anything you can provide by way of insight into the
 906 problem helps a great deal.  In other words, try to analyse the
 907 problem to the extent you feel qualified and report your discoveries.
 908
 909 =item Can you fix the bug yourself?
 910
 911 A bug report which I<includes a patch to fix it> will almost
 912 definitely be fixed.  Use the C<diff> program to generate your patches
 913 (C<diff> is being maintained by the GNU folks as part of the B<diffutils>
 914 package, so you should be able to get it from any of the GNU software
 915 repositories).  If you do submit a patch, the cool-dude counter at
 916 perlbug@perl.com will register you as a savior of the world.  Your
 917 patch may be returned with requests for changes, or requests for more
 918 detailed explanations about your fix.
 919
 920 Here are some clues for creating quality patches: Use the B<-c> or
 921 B<-u> switches to the diff program (to create a so-called context or
 922 unified diff).  Make sure the patch is not reversed (the first
 923 argument to diff is typically the original file, the second argument
 924 your changed file).  Make sure you test your patch by applying it with
 925 the C<patch> program before you send it on its way.  Try to follow the
 926 same style as the code you are trying to patch.  Make sure your patch
 927 really does work (C<make test>, if the thing you're patching supports
 928 it).
 929
 930 =item Can you use C<perlbug> to submit the report?
 931
 932 B<perlbug> will, amongst other things, ensure your report includes
 933 crucial information about your version of perl.  If C<perlbug> is unable
 934 to mail your report after you have typed it in, you may have to compose
 935 the message yourself, add the output produced by C<perlbug -d> and email
 936 it to B<perlbug@perl.com>.  If, for some reason, you cannot run
 937 C<perlbug> at all on your system, be sure to include the entire output
 938 produced by running C<perl -V> (note the uppercase V).
 939
 940 =back
 941
 942 Having done your bit, please be prepared to wait, to be told the bug
 943 is in your code, or even to get no reply at all.  The perl maintainers
 944 are busy folks, so if your problem is a small one or if it is difficult
 945 to understand or already known, they may not respond with a personal reply.
 946 If it is important to you that your bug be fixed, do monitor the
 947 C<Changes> file in any development releases since the time you submitted
 948 the bug, and encourage the maintainers with kind words (but never any
 949 flames!).  Feel free to resend your bug report if the next released
 950 version of perl comes out and your bug is still present.
 951
 952 =head1 OPTIONS
 953
 954 =over 8
 955
 956 =item B<-a>
 957
 958 Address to send the report to.  Defaults to `perlbug@perl.com'.
 959
 960 =item B<-b>
 961
 962 Body of the report.  If not included on the command line, or
 963 in a file with B<-f>, you will get a chance to edit the message.
 964
 965 =item B<-C>
 966
 967 Don't send copy to administrator.
 968
 969 =item B<-c>
 970
 971 Address to send copy of report to.  Defaults to the address of the
 972 local perl administrator (recorded when perl was built).
 973
 974 =item B<-d>
 975
 976 Data mode (the default if you redirect or pipe output).  This prints out
 977 your configuration data, without mailing anything.  You can use this
 978 with B<-v> to get more complete data.
 979
 980 =item B<-e>
 981
 982 Editor to use.
 983
 984 =item B<-f>
 985
 986 File containing the body of the report.  Use this to quickly send a
 987 prepared message.
 988
 989 =item B<-h>
 990
 991 Prints a brief summary of the options.
 992
 993 =item B<-ok>
 994
 995 Report successful build on this system to perl porters. Forces B<-S>
 996 and B<-C>. Forces and supplies values for B<-s> and B<-b>. Only
 997 prompts for a return address if it cannot guess it (for use with
 998 B<make>). Honors return address specified with B<-r>.  You can use this
 999 with B<-v> to get more complete data.   Only makes a report if this
1000 system is less than 60 days old.
1001
1002 =item B<-okay>
1003
1004 As B<-ok> except it will report on older systems.
1005
1006 =item B<-nok>
1007
1008 Report unsuccessful build on this system.  Forces B<-C>.  Forces and
1009 supplies a value for B<-s>, then requires you to edit the report
1010 and say what went wrong.  Alternatively, a prepared report may be
1011 supplied using B<-f>.  Only prompts for a return address if it
1012 cannot guess it (for use with B<make>). Honors return address
1013 specified with B<-r>.  You can use this with B<-v> to get more
1014 complete data.  Only makes a report if this system is less than 60
1015 days old.
1016
1017 =item B<-nokay>
1018
1019 As B<-nok> except it will report on older systems.
1020
1021 =item B<-r>
1022
1023 Your return address.  The program will ask you to confirm its default
1024 if you don't use this option.
1025
1026 =item B<-S>
1027
1028 Send without asking for confirmation.
1029
1030 =item B<-s>
1031
1032 Subject to include with the message.  You will be prompted if you don't
1033 supply one on the command line.
1034
1035 =item B<-t>
1036
1037 Test mode.  The target address defaults to `perlbug-test@perl.com'.
1038
1039 =item B<-v>
1040
1041 Include verbose configuration data in the report.
1042
1043 =back
1044
1045 =head1 AUTHORS
1046
1047 Kenneth Albanowski (E<lt>kjahds@kjahds.comE<gt>), subsequently I<doc>tored
1048 by Gurusamy Sarathy (E<lt>gsar@umich.eduE<gt>), Tom Christiansen
1049 (E<lt>tchrist@perl.comE<gt>), Nathan Torkington (E<lt>gnat@frii.comE<gt>),
1050 Charles F. Randall (E<lt>cfr@pobox.comE<gt>), Mike Guy
1051 (E<lt>mjtg@cam.a.ukE<gt>), Dominic Dunlop (E<lt>domo@computer.orgE<gt>)
1052 and Hugo van der Sanden (E<lt>hv@crypt0.demon.co.ukE<gt>).
1053
1054 =head1 SEE ALSO
1055
1056 perl(1), perldebug(1), perltrap(1), diff(1), patch(1)
1057
1058 =head1 BUGS
1059
1060 None known (guess what must have been used to report them?)
1061
1062 =cut
1063
1064 !NO!SUBS!
1065
1066 close OUT or die "Can't close $file: $!";
1067 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
1068 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
1069 chdir $origdir;
1070