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