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