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