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