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
  18 open OUT,">$file" or die "Can't create $file: $!";
  19
  20 print "Extracting $file (with variable substitutions)\n";
  21
  22 # In this section, perl variables will be expanded during extraction.
  23 # You can use $Config{...} to use Configure variables.
  24
  25 print OUT <<"!GROK!THIS!";
  26 $Config{startperl}
  27     eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
  28         if \$running_under_some_shell;
  29 !GROK!THIS!
  30
  31 # In the following, perl variables are not expanded during extraction.
  32
  33 print OUT <<'!NO!SUBS!';
  34
  35 use Config;
  36 use Getopt::Std;
  37
  38 BEGIN {
  39         eval "use Mail::Send;";
  40         $::HaveSend = ($@ eq "");
  41         eval "use Mail::Util;";
  42         $::HaveUtil = ($@ eq "");
  43 };
  44
  45
  46 use strict;
  47
  48 sub paraprint;
  49
  50
  51 my($Version) = "1.14";
  52
  53 # Changed in 1.06 to skip Mail::Send and Mail::Util if not available.
  54 # Changed in 1.07 to see more sendmail execs, and added pipe output.
  55 # Changed in 1.08 to use correct address for sendmail.
  56 # Changed in 1.09 to close the REP file before calling it up in the editor.
  57 #                 Also removed some old comments duplicated elsewhere.
  58 # Changed in 1.10 to run under VMS without Mail::Send; also fixed
  59 #                 temp filename generation.
  60 # Changed in 1.11 to clean up some text and removed Mail::Send deactivator.
  61 # Changed in 1.12 to check for editor errors, make save/send distinction
  62 #                 clearer and add $ENV{REPLYTO}.
  63 # Changed in 1.13 to hopefully make it more difficult to accidentally
  64 #                 send mail
  65 # Changed in 1.14 to make the prompts a little more clear on providing
  66 #                 helpful information. Also let file read fail gracefully.
  67
  68 # TODO: Allow the user to re-name the file on mail failure, and
  69 #       make sure failure (transmission-wise) of Mail::Send is
  70 #       accounted for.
  71
  72 my( $file, $usefile, $cc, $address, $perlbug, $testaddress, $filename,
  73     $subject, $from, $verbose, $ed,
  74     $fh, $me, $Is_VMS, $msg, $body, $andcc );
  75
  76 Init();
  77
  78 if($::opt_h) { Help(); exit; }
  79
  80 if(!-t STDIN) {
  81         paraprint <<EOF;
  82 Please use perlbug interactively. If you want to
  83 include a file, you can use the -f switch.
  84 EOF
  85         die "\n";
  86 }
  87
  88 if($::opt_d or !-t STDOUT) { Dump(*STDOUT); exit; }
  89
  90 Query();
  91 Edit() unless $usefile;
  92 NowWhat();
  93 Send();
  94
  95 exit;
  96
  97 sub Init {
  98
  99         # -------- Setup --------
 100
 101         $Is_VMS = $^O eq 'VMS';
 102
 103         getopts("dhva:s:b:f:r:e:SCc:t");
 104
 105
 106         # This comment is needed to notify metaconfig that we are
 107         # using the $perladmin, $cf_by, and $cf_time definitions.
 108
 109
 110         # -------- Configuration ---------
 111
 112         # perlbug address
 113         $perlbug = 'perlbug@perl.com';
 114
 115         # Test address
 116         $testaddress = 'perlbug-test@perl.com';
 117
 118         # Target address
 119         $address = $::opt_a || ($::opt_t ? $testaddress : $perlbug);
 120
 121         # Possible administrator addresses, in order of confidence
 122         # (Note that cf_email is not mentioned to metaconfig, since
 123         # we don't really want it. We'll just take it if we have to.)
 124         $cc = ($::opt_C ? "" : (
 125                 $::opt_c || $::Config{perladmin} || $::Config{cf_email} || $::Config{cf_by}
 126                 ));
 127
 128         # Users address, used in message and in Reply-To header
 129         $from = $::opt_r || "";
 130
 131         # Include verbose configuration information
 132         $verbose = $::opt_v || 0;
 133
 134         # Subject of bug-report message
 135         $subject = $::opt_s || "";
 136
 137         # Send a file
 138         $usefile = ($::opt_f || 0);
 139
 140         # File to send as report
 141         $file = $::opt_f || "";
 142
 143         # Body of report
 144         $body = $::opt_b || "";
 145
 146         # Editor
 147         $ed = ( $::opt_e || $ENV{VISUAL} || $ENV{EDITOR} || $ENV{EDIT} ||
 148                       ($Is_VMS ? "edit/tpu" : "vi")
 149               );
 150
 151
 152         # My username
 153         $me = getpwuid($<);
 154
 155 }
 156
 157
 158 sub Query {
 159
 160         # Explain what perlbug is
 161
 162         paraprint <<EOF;
 163 This program provides an easy way to create a message reporting a bug in
 164 perl, and e-mail it to $address.
 165
 166 EOF
 167
 168
 169         # Prompt for subject of message, if needed
 170         if(! $subject) {
 171                 paraprint <<EOF;
 172 First of all, please provide a subject for the
 173 message. It should be a concise description of
 174 the bug or problem.
 175
 176 EOF
 177                 print "Subject: ";
 178
 179                 $subject = <>;
 180                 chop $subject;
 181
 182                 my($err)=0;
 183                 while( $subject =~ /^\s*$/ ) {
 184                         print "\nPlease enter a subject: ";
 185                         $subject = <>;
 186                         chop $subject;
 187                         if($err++>5) {
 188                                 die "Aborting.\n";
 189                         }
 190                 }
 191         }
 192
 193
 194         # Prompt for return address, if needed
 195         if( !$from) {
 196
 197                 # Try and guess return address
 198                 my($domain);
 199
 200                 if($::HaveUtil) {
 201                         $domain = Mail::Util::maildomain();
 202                 } elsif ($Is_VMS) {
 203                         require Sys::Hostname;
 204                         $domain = Sys::Hostname::hostname();
 205                 } else {
 206                         $domain = `hostname`.".".`domainname`;
 207                         $domain =~ s/[\r\n]+//g;
 208                 }
 209
 210             my($guess);
 211
 212                 if( !$domain) {
 213                         $guess = "";
 214                 } elsif ($Is_VMS && !$::Config{'d_socket'}) {
 215                         $guess = "$domain\:\:$me";
 216                 } else {
 217                         $guess = "$me\@$domain" if $domain;
 218                         $guess = "$me\@unknown.addresss" unless $domain;
 219                         }
 220
 221                 $guess = $ENV{'REPLYTO'} if defined($ENV{'REPLYTO'});
 222                 $guess = $ENV{"REPLY-TO"} if defined($ENV{'REPLY-TO'});
 223
 224                 if( $guess ) {
 225                         paraprint <<EOF;
 226
 227
 228 Your e-mail address will be useful if you need to be contacted. If the
 229 default shown is not your full internet e-mail address, please correct it.
 230
 231 EOF
 232                 } else {
 233                         paraprint <<EOF;
 234
 235 So that you may be contacted if necessary, please enter
 236 your full internet e-mail address here.
 237
 238 EOF
 239                 }
 240                 print "Your address [$guess]: ";
 241
 242                 $from = <>;
 243                 chop $from;
 244
 245                 if($from eq "") { $from = $guess }
 246
 247         }
 248
 249         #if( $from =~ /^(.*)\@(.*)$/ ) {
 250         #       $mailname = $1;
 251         #       $maildomain = $2;
 252         #}
 253
 254         if( $from eq $cc or $me eq $cc ) {
 255                 # Try not to copy ourselves
 256                 $cc = "yourself";
 257         }
 258
 259
 260         # Prompt for administrator address, unless an override was given
 261         if( !$::opt_C and !$::opt_c ) {
 262                 paraprint <<EOF;
 263
 264
 265 A copy of this report can be sent to your local
 266 perl administrator. If the address is wrong, please
 267 correct it, or enter 'none' or 'yourself' to not send
 268 a copy.
 269
 270 EOF
 271
 272                 print "Local perl administrator [$cc]: ";
 273
 274                 my($entry) = scalar(<>);
 275                 chop $entry;
 276
 277                 if($entry ne "") {
 278                         $cc = $entry;
 279                         if($me eq $cc) { $cc = "" }
 280                 }
 281
 282         }
 283
 284         if($cc =~ /^(none|yourself|me|myself|ourselves)$/i) { $cc = "" }
 285
 286         $andcc = " and $cc" if $cc;
 287
 288 editor:
 289
 290         # Prompt for editor, if no override is given
 291         if(! $::opt_e and ! $::opt_f and ! $::opt_b) {
 292                 paraprint <<EOF;
 293
 294
 295 Now you need to supply the bug report. Try to make
 296 the report concise but descriptive. Include any
 297 relevant detail. If you are reporting something
 298 that does not work as you think it should, please
 299 try to include example of both the actual
 300 result, and what you expected.
 301
 302 Some information about your local
 303 perl configuration will automatically be included
 304 at the end of the report. If you are using any
 305 unusual version of perl, please try and confirm
 306 exactly which versions are relevant.
 307
 308 You will probably want to use an editor to enter
 309 the report. If "$ed" is the editor you want
 310 to use, then just press Enter, otherwise type in
 311 the name of the editor you would like to use.
 312
 313 If you would like to use a prepared file, type
 314 "file", and you will be asked for the filename.
 315
 316 EOF
 317
 318                 print "Editor [$ed]: ";
 319
 320                 my($entry) =scalar(<>);
 321                 chop $entry;
 322
 323                 $usefile = 0;
 324                 if($entry eq "file") {
 325                         $usefile = 1;
 326                 } elsif($entry ne "") {
 327                         $ed = $entry;
 328                 }
 329         }
 330
 331
 332         # Generate scratch file to edit report in
 333
 334         {
 335         my($dir) = $Is_VMS ? 'sys$scratch:' : '/tmp/';
 336         $filename = "bugrep0$$";
 337         $filename++ while -e "$dir$filename";
 338         $filename = "$dir$filename";
 339         }
 340
 341
 342         # Prompt for file to read report from, if needed
 343
 344         if( $usefile and ! $file) {
 345 filename:
 346                 paraprint <<EOF;
 347
 348 What is the name of the file that contains your report?
 349
 350 EOF
 351
 352                 print "Filename: ";
 353
 354                 my($entry) = scalar(<>);
 355                 chop($entry);
 356
 357                 if($entry eq "") {
 358                         paraprint <<EOF;
 359
 360 No filename? I'll let you go back and choose an editor again.
 361
 362 EOF
 363                         goto editor;
 364                 }
 365
 366                 if(!-f $entry or !-r $entry) {
 367                         paraprint <<EOF;
 368
 369 I'm sorry, but I can't read from `$entry'. Maybe you mistyped the name of
 370 the file? If you don't want to send a file, just enter a blank line and you
 371 can get back to the editor selection.
 372
 373 EOF
 374                         goto filename;
 375                 }
 376                 $file = $entry;
 377
 378         }
 379
 380
 381         # Generate report
 382
 383         open(REP,">$filename");
 384
 385         print REP <<EOF;
 386 This is a bug report for perl from $from,
 387 generated with the help of perlbug $Version running under perl $].
 388
 389 EOF
 390
 391         if($body) {
 392                 print REP $body;
 393         } elsif($usefile) {
 394                 open(F,"<$file") or die "Unable to read report file from `$file': $!\n";
 395                 while(<F>) {
 396                 print REP $_
 397                 }
 398                 close(F);
 399         } else {
 400                 print REP "[Please enter your report here]\n";
 401         }
 402
 403         Dump(*REP);
 404         close(REP);
 405
 406 }
 407
 408 sub Dump {
 409         local(*OUT) = @_;
 410
 411         print OUT <<EOF;
 412
 413
 414
 415 Site configuration information for perl $]:
 416
 417 EOF
 418
 419         if( $::Config{cf_by} and $::Config{cf_time}) {
 420                 print OUT "Configured by $::Config{cf_by} at $::Config{cf_time}.\n\n";
 421         }
 422
 423         print OUT Config::myconfig;
 424
 425         if($verbose) {
 426                 print OUT "\nComplete configuration data for perl $]:\n\n";
 427                 my($value);
 428                 foreach (sort keys %::Config) {
 429                         $value = $::Config{$_};
 430                         $value =~ s/'/\\'/g;
 431                         print OUT "$_='$value'\n";
 432                 }
 433         }
 434 }
 435
 436 sub Edit {
 437         # Edit the report
 438
 439         if($usefile) {
 440                 $usefile = 0;
 441                 paraprint <<EOF;
 442
 443 Please make sure that the name of the editor you want to use is correct.
 444
 445 EOF
 446                 print "Editor [$ed]: ";
 447
 448                 my($entry) =scalar(<>);
 449                 chop $entry;
 450
 451                 if($entry ne "") {
 452                         $ed = $entry;
 453                 }
 454         }
 455
 456 tryagain:
 457         if(!$usefile and !$body) {
 458                 my($sts) = system("$ed $filename");
 459                 if( $Is_VMS ? !($sts & 1) : $sts ) {
 460                         #print "\nUnable to run editor!\n";
 461                         paraprint <<EOF;
 462
 463 The editor you chose (`$ed') could apparently not be run!
 464 Did you mistype the name of your editor? If so, please
 465 correct it here, otherwise just press Enter.
 466
 467 EOF
 468                         print "Editor [$ed]: ";
 469
 470                         my($entry) =scalar(<>);
 471                         chop $entry;
 472
 473                         if($entry ne "") {
 474                                 $ed = $entry;
 475                                 goto tryagain;
 476                         } else {
 477
 478                         paraprint <<EOF;
 479
 480 You may want to save your report to a file, so you can edit and mail it
 481 yourself.
 482 EOF
 483                         }
 484                 }
 485         }
 486 }
 487
 488 sub NowWhat {
 489
 490         # Report is done, prompt for further action
 491         if( !$::opt_S ) {
 492                 while(1) {
 493
 494                         paraprint <<EOF;
 495
 496
 497 Now that you have completed your report, would you like to send
 498 the message to $address$andcc, display the message on
 499 the screen, re-edit it, or cancel without sending anything?
 500 You may also save the message as a file to mail at another time.
 501
 502 EOF
 503
 504                         print "Action (Send/Display/Edit/Cancel/Save to File): ";
 505                         my($action) = scalar(<>);
 506                         chop $action;
 507
 508                         if( $action =~ /^(f|sa)/i ) { # <F>ile/<Sa>ve
 509                                 print "\n\nName of file to save message in [perlbug.rep]: ";
 510                                 my($file) = scalar(<>);
 511                                 chop $file;
 512                                 if($file eq "") { $file = "perlbug.rep" }
 513
 514                                 open(FILE,">$file");
 515                                 open(REP,"<$filename");
 516                                 print FILE "To: $address\nSubject: $subject\n";
 517                                 print FILE "Cc: $cc\n" if $cc;
 518                                 print FILE "Reply-To: $from\n" if $from;
 519                                 print FILE "\n";
 520                                 while(<REP>) { print FILE }
 521                                 close(REP);
 522                                 close(FILE);
 523
 524                                 print "\nMessage saved in `$file'.\n";
 525                                 exit;
 526
 527                         } elsif( $action =~ /^(d|l|sh)/i ) { # <D>isplay, <L>ist, <Sh>ow
 528                                 # Display the message
 529                                 open(REP,"<$filename");
 530                                 while(<REP>) { print $_ }
 531                                 close(REP);
 532                         } elsif( $action =~ /^se/i ) { # <S>end
 533                                 # Send the message
 534                                 print "\
 535 Are you certain you want to send this message?
 536 Please type \"yes\" if you are: ";
 537                                 my($reply) = scalar(<STDIN>);
 538                                 chop($reply);
 539                                 if( $reply eq "yes" ) {
 540                                         last;
 541                                 } else {
 542                                         paraprint <<EOF;
 543
 544 That wasn't a clear "yes", so I won't send your message. If you are sure
 545 your message should be sent, type in "yes" (without the quotes) at the
 546 confirmation prompt.
 547
 548 EOF
 549
 550                                 }
 551                         } elsif( $action =~ /^[er]/i ) { # <E>dit, <R>e-edit
 552                                 # edit the message
 553                                 Edit();
 554                                 #system("$ed $filename");
 555                         } elsif( $action =~ /^[qc]/i ) { # <C>ancel, <Q>uit
 556                                 1 while unlink($filename);  # remove all versions under VMS
 557                                 print "\nCancelling.\n";
 558                                 exit(0);
 559                         } elsif( $action =~ /^s/ ) {
 560                                 paraprint <<EOF;
 561
 562 I'm sorry, but I didn't understand that. Please type "send" or "save".
 563 EOF
 564                         }
 565
 566                 }
 567         }
 568 }
 569
 570
 571 sub Send {
 572
 573         # Message has been accepted for transmission -- Send the message
 574
 575         if($::HaveSend) {
 576
 577                 $msg = new Mail::Send Subject => $subject, To => $address;
 578
 579                 $msg->cc($cc) if $cc;
 580                 $msg->add("Reply-To",$from) if $from;
 581
 582                 $fh = $msg->open;
 583
 584                 open(REP,"<$filename");
 585                 while(<REP>) { print $fh $_ }
 586                 close(REP);
 587
 588                 $fh->close;
 589
 590         } else {
 591                 if ($Is_VMS) {
 592                         if ( ($address =~ /@/ and $address !~ /^\w+%"/) or
 593                              ($cc      =~ /@/ and $cc      !~ /^\w+%"/) ){
 594                                 my($prefix);
 595                                 foreach (qw[ IN MX SMTP UCX PONY WINS ],'') {
 596                                         $prefix = "$_%",last if $ENV{"MAIL\$PROTOCOL_$_"};
 597                                 }
 598                                 $address = qq[${prefix}"$address"] unless $address =~ /^\w+%"/;
 599                                 $cc = qq[${prefix}"$cc"] unless !$cc || $cc =~ /^\w+%"/;
 600                         }
 601                         $subject =~ s/"/""/g; $address =~ s/"/""/g; $cc =~ s/"/""/g;
 602                         my($sts) = system(qq[mail/Subject="$subject" $filename. "$address","$cc"]);
 603                         if (!($sts & 1)) { die "Can't spawn off mail\n\t(leaving bug report in $filename): $sts\n;" }
 604                 } else {
 605                         my($sendmail) = "";
 606
 607                         foreach (qw(/usr/lib/sendmail /usr/sbin/sendmail /usr/ucblib/sendmail))
 608                         {
 609                                 $sendmail = $_, last if -e $_;
 610                         }
 611
 612                         paraprint <<"EOF" and die "\n" if $sendmail eq "";
 613
 614 I am terribly sorry, but I cannot find sendmail, or a close equivalent, and
 615 the perl package Mail::Send has not been installed, so I can't send your bug
 616 report. We apologize for the inconveniencence.
 617
 618 So you may attempt to find some way of sending your message, it has
 619 been left in the file `$filename'.
 620
 621 EOF
 622
 623                         open(SENDMAIL,"|$sendmail -t");
 624                         print SENDMAIL "To: $address\n";
 625                         print SENDMAIL "Subject: $subject\n";
 626                         print SENDMAIL "Cc: $cc\n" if $cc;
 627                         print SENDMAIL "Reply-To: $from\n" if $from;
 628                         print SENDMAIL "\n\n";
 629                         open(REP,"<$filename");
 630                         while(<REP>) { print SENDMAIL $_ }
 631                         close(REP);
 632
 633                         close(SENDMAIL);
 634                 }
 635
 636         }
 637
 638         print "\nMessage sent.\n";
 639
 640         1 while unlink($filename);  # remove all versions under VMS
 641
 642 }
 643
 644 sub Help {
 645         print <<EOF;
 646
 647 A program to help generate bug reports about perl5, and mail them.
 648 It is designed to be used interactively. Normally no arguments will
 649 be needed.
 650
 651 Usage:
 652 $0  [-v] [-a address] [-s subject] [-b body | -f file ]
 653     [-r returnaddress] [-e editor] [-c adminaddress | -C] [-S] [-t]
 654
 655 Simplest usage:  run "$0", and follow the prompts.
 656
 657 Options:
 658
 659   -v    Include Verbose configuration data in the report
 660   -f    File containing the body of the report. Use this to
 661         quickly send a prepared message.
 662   -S    Send without asking for confirmation.
 663   -a    Address to send the report to. Defaults to `$address'.
 664   -c    Address to send copy of report to. Defaults to `$cc'.
 665   -C    Don't send copy to administrator.
 666   -s    Subject to include with the message. You will be prompted
 667         if you don't supply one on the command line.
 668   -b    Body of the report. If not included on the command line, or
 669         in a file with -f, you will get a chance to edit the message.
 670   -r    Your return address. The program will ask you to confirm
 671         this if you don't give it here.
 672   -e    Editor to use.
 673   -t    Test mode. The target address defaults to `$testaddress'.
 674   -d    Data mode (the default if you redirect or pipe output.)
 675         This prints out your configuration data, without mailing
 676         anything. You can use this with -v to get more complete data.
 677
 678 EOF
 679 }
 680
 681 sub paraprint {
 682     my @paragraphs = split /\n{2,}/, "@_";
 683     print "\n\n";
 684     for (@paragraphs) {   # implicit local $_
 685         s/(\S)\s*\n/$1 /g;
 686             write;
 687             print "\n";
 688     }
 689
 690 }
 691
 692
 693 format STDOUT =
 694 ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
 695 $_
 696 .
 697 !NO!SUBS!
 698
 699 close OUT or die "Can't close $file: $!";
 700 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
 701 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';