utils/perlbug.PL

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