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