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