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.13";
  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
  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, $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();
  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         # File to send as report
 138         $file = $::opt_f || "";
 139
 140         # Body of report
 141         $body = $::opt_b || "";
 142
 143         # Editor
 144         $ed = ($::opt_f ? "file" : (
 145                         $::opt_e || $ENV{VISUAL} || $ENV{EDITOR} || $ENV{EDIT} ||
 146                       ($Is_VMS ? "edit/tpu" : "vi")
 147               ));
 148
 149         # My username
 150         $me = getpwuid($<);
 151
 152 }
 153
 154
 155 sub Query {
 156
 157         # Explain what perlbug is
 158
 159         paraprint <<EOF;
 160 This program allows you to create a bug report,
 161 which will be sent as an e-mail message to $address
 162 once you have filled in the report.
 163
 164 EOF
 165
 166
 167         # Prompt for subject of message, if needed
 168         if(! $subject) {
 169                 paraprint <<EOF;
 170 First of all, please provide a subject for the
 171 message. It should be as a concise description of
 172 the bug as is possible.
 173
 174 EOF
 175                 print "Subject: ";
 176
 177                 $subject = <>;
 178                 chop $subject;
 179
 180                 my($err)=0;
 181                 while( $subject =~ /^\s*$/ ) {
 182                         print "\nPlease enter a subject: ";
 183                         $subject = <>;
 184                         chop $subject;
 185                         if($err++>5) {
 186                                 die "Aborting.\n";
 187                         }
 188                 }
 189         }
 190
 191
 192         # Prompt for return address, if needed
 193         if( !$from) {
 194
 195                 # Try and guess return address
 196                 my($domain);
 197
 198                 if($::HaveUtil) {
 199                         $domain = Mail::Util::maildomain();
 200                 } elsif ($Is_VMS) {
 201                         require Sys::Hostname;
 202                         $domain = Sys::Hostname::hostname();
 203                 } else {
 204                         $domain = `hostname`.".".`domainname`;
 205                         $domain =~ s/[\r\n]+//g;
 206                 }
 207
 208             my($guess);
 209
 210                 if( !$domain) {
 211                         $guess = "";
 212                 } elsif ($Is_VMS && !$::Config{'d_has_sockets'}) {
 213                         $guess = "$domain\:\:$me";
 214                 } else {
 215                         $guess = "$me\@$domain" if $domain;
 216                         $guess = "$me\@unknown.addresss" unless $domain;
 217                         }
 218
 219                 $guess = $ENV{'REPLYTO'} if defined($ENV{'REPLYTO'});
 220                 $guess = $ENV{"REPLY-TO"} if defined($ENV{'REPLY-TO'});
 221
 222                 if( $guess ) {
 223                         paraprint <<EOF;
 224
 225
 226 Your e-mail address will be useful if you need to be contacted. If the
 227 default shown is not your full internet e-mail address, please correct it.
 228
 229 EOF
 230                 } else {
 231                         paraprint <<EOF;
 232
 233 So that you may be contacted if necessary, please enter
 234 your full internet e-mail address here.
 235
 236 EOF
 237                 }
 238                 print "Your address [$guess]: ";
 239
 240                 $from = <>;
 241                 chop $from;
 242
 243                 if($from eq "") { $from = $guess }
 244
 245         }
 246
 247         #if( $from =~ /^(.*)\@(.*)$/ ) {
 248         #       $mailname = $1;
 249         #       $maildomain = $2;
 250         #}
 251
 252         if( $from eq $cc or $me eq $cc ) {
 253                 # Try not to copy ourselves
 254                 $cc = "yourself";
 255         }
 256
 257
 258         # Prompt for administrator address, unless an override was given
 259         if( !$::opt_C and !$::opt_c ) {
 260                 paraprint <<EOF;
 261
 262
 263 A copy of this report can be sent to your local
 264 perl administrator. If the address is wrong, please
 265 correct it, or enter 'none' or 'yourself' to not send
 266 a copy.
 267
 268 EOF
 269
 270                 print "Local perl administrator [$cc]: ";
 271
 272                 my($entry) = scalar(<>);
 273                 chop $entry;
 274
 275                 if($entry ne "") {
 276                         $cc = $entry;
 277                         if($me eq $cc) { $cc = "" }
 278                 }
 279
 280         }
 281
 282         if($cc =~ /^(none|yourself|me|myself|ourselves)$/i) { $cc = "" }
 283
 284         $andcc = " and $cc" if $cc;
 285
 286
 287         # Prompt for editor, if no override is given
 288         if(! $::opt_e and ! $::opt_f and ! $::opt_b) {
 289                 paraprint <<EOF;
 290
 291
 292 Now you need to supply the bug report. Try to make
 293 the report concise but descriptive. Include any
 294 relevant detail. Some information about your local
 295 perl configuration will automatically be included
 296 at the end of the report.
 297
 298 You will probably want to use an editor to enter
 299 the report. If "$ed" is the editor you want
 300 to use, then just press Enter, otherwise type in
 301 the name of the editor you would like to use.
 302
 303 If you would like to use a prepared file, type
 304 "file", and you will be asked for the filename.
 305
 306 EOF
 307
 308                 print "Editor [$ed]: ";
 309
 310                 my($entry) =scalar(<>);
 311                 chop $entry;
 312
 313                 if($entry ne "") {
 314                         $ed = $entry;
 315                 }
 316         }
 317
 318
 319         # Generate scratch file to edit report in
 320
 321         {
 322         my($dir) = $Is_VMS ? 'sys$scratch:' : '/tmp/';
 323         $filename = "bugrep0$$";
 324         $filename++ while -e "$dir$filename";
 325         $filename = "$dir$filename";
 326         }
 327
 328
 329         # Prompt for file to read report from, if needed
 330
 331         if( $ed eq "file" and ! $file) {
 332                 paraprint <<EOF;
 333
 334
 335 What is the name of the file that contains your report?
 336
 337 EOF
 338
 339                 print "Filename: ";
 340
 341                 my($entry) = scalar(<>);
 342                 chop($entry);
 343
 344                 if(!-f $entry or !-r $entry) {
 345                         print "\n\nUnable to read from `$entry'.\nExiting.\n";
 346                         exit;
 347                 }
 348                 $file = $entry;
 349
 350         }
 351
 352
 353         # Generate report
 354
 355         open(REP,">$filename");
 356
 357         print REP <<EOF;
 358 This is a bug report for perl from $from,
 359 generated with the help of perlbug $Version running under perl $].
 360
 361 EOF
 362
 363         if($body) {
 364                 print REP $body;
 365         } elsif($file) {
 366                 open(F,"<$file") or die "Unable to read report file: $!\n";
 367                 while(<F>) {
 368                 print REP $_
 369                 }
 370                 close(F);
 371         } else {
 372                 print REP "[Please enter your report here]\n";
 373         }
 374
 375         Dump(*REP);
 376         close(REP);
 377
 378 }
 379
 380 sub Dump {
 381         local(*OUT) = @_;
 382
 383         print OUT <<EOF;
 384
 385
 386
 387 Site configuration information for perl $]:
 388
 389 EOF
 390
 391         if( $::Config{cf_by} and $::Config{cf_time}) {
 392                 print OUT "Configured by $::Config{cf_by} at $::Config{cf_time}.\n\n";
 393         }
 394
 395         print OUT Config::myconfig;
 396
 397         if($verbose) {
 398                 print OUT "\nComplete configuration data for perl $]:\n\n";
 399                 my($value);
 400                 foreach (sort keys %::Config) {
 401                         $value = $::Config{$_};
 402                         $value =~ s/'/\\'/g;
 403                         print OUT "$_='$value'\n";
 404                 }
 405         }
 406 }
 407
 408 sub Edit {
 409         # Edit the report
 410
 411 tryagain:
 412         if(!$file and !$body) {
 413                 my($sts) = system("$ed $filename");
 414                 if( $Is_VMS ? !($sts & 1) : $sts ) {
 415                         #print "\nUnable to run editor!\n";
 416                         paraprint <<EOF;
 417
 418 The editor you chose (`$ed') could apparently not be run!
 419 Did you mistype the name of your editor? If so, please
 420 correct it here, otherwise just press Enter.
 421
 422 EOF
 423                         print "Editor [$ed]: ";
 424
 425                         my($entry) =scalar(<>);
 426                         chop $entry;
 427
 428                         if($entry ne "") {
 429                                 $ed = $entry;
 430                                 goto tryagain;
 431                         } else {
 432
 433                         paraprint <<EOF;
 434
 435 You may want to save your report to a file, so you can edit and mail it
 436 yourself.
 437 EOF
 438                         }
 439                 }
 440         }
 441 }
 442
 443 sub NowWhat {
 444
 445         # Report is done, prompt for further action
 446         if( !$::opt_S ) {
 447                 while(1) {
 448
 449                         paraprint <<EOF;
 450
 451
 452 Now that you have completed your report, would you like to send
 453 the message to $address$andcc, display the message on
 454 the screen, re-edit it, or cancel without sending anything?
 455 You may also save the message as a file to mail at another time.
 456
 457 EOF
 458
 459                         print "Action (Send/Display/Edit/Cancel/Save to File): ";
 460                         my($action) = scalar(<>);
 461                         chop $action;
 462
 463                         if( $action =~ /^(f|sa)/i ) { # <F>ile/<Sa>ve
 464                                 print "\n\nName of file to save message in [perlbug.rep]: ";
 465                                 my($file) = scalar(<>);
 466                                 chop $file;
 467                                 if($file eq "") { $file = "perlbug.rep" }
 468
 469                                 open(FILE,">$file");
 470                                 open(REP,"<$filename");
 471                                 print FILE "To: $address\nSubject: $subject\n";
 472                                 print FILE "Cc: $cc\n" if $cc;
 473                                 print FILE "Reply-To: $from\n" if $from;
 474                                 print FILE "\n";
 475                                 while(<REP>) { print FILE }
 476                                 close(REP);
 477                                 close(FILE);
 478
 479                                 print "\nMessage saved in `$file'.\n";
 480                                 exit;
 481
 482                         } elsif( $action =~ /^(d|l|sh)/i ) { # <D>isplay, <L>ist, <Sh>ow
 483                                 # Display the message
 484                                 open(REP,"<$filename");
 485                                 while(<REP>) { print $_ }
 486                                 close(REP);
 487                         } elsif( $action =~ /^se/i ) { # <S>end
 488                                 # Send the message
 489                                 print "\
 490 Are you certain you want to send this message?
 491 Please type \"yes\" if you are: ";
 492                                 my($reply) = scalar(<STDIN>);
 493                                 chop($reply);
 494                                 if( $reply eq "yes" ) {
 495                                         last;
 496                                 }
 497                         } elsif( $action =~ /^[er]/i ) { # <E>dit, <R>e-edit
 498                                 # edit the message
 499                                 Edit();
 500                                 #system("$ed $filename");
 501                         } elsif( $action =~ /^[qc]/i ) { # <C>ancel, <Q>uit
 502                                 1 while unlink($filename);  # remove all versions under VMS
 503                                 print "\nCancelling.\n";
 504                                 exit(0);
 505                         } elsif( $action =~ /^s/ ) {
 506                                 paraprint <<EOF;
 507
 508 I'm sorry, but I didn't understand that. Please type "send" or "save".
 509 EOF
 510                         }
 511
 512                 }
 513         }
 514 }
 515
 516
 517 sub Send {
 518
 519         # Message has been accepted for transmission -- Send the message
 520
 521         if($::HaveSend) {
 522
 523                 $msg = new Mail::Send Subject => $subject, To => $address;
 524
 525                 $msg->cc($cc) if $cc;
 526                 $msg->add("Reply-To",$from) if $from;
 527
 528                 $fh = $msg->open;
 529
 530                 open(REP,"<$filename");
 531                 while(<REP>) { print $fh $_ }
 532                 close(REP);
 533
 534                 $fh->close;
 535
 536         } else {
 537                 if ($Is_VMS) {
 538                         if ( ($address =~ /@/ and $address !~ /^\w+%"/) or
 539                              ($cc      =~ /@/ and $cc      !~ /^\w+%"/) ){
 540                                 my($prefix);
 541                                 foreach (qw[ IN MX SMTP UCX PONY WINS ],'') {
 542                                         $prefix = "$_%",last if $ENV{"MAIL\$PROTOCOL_$_"};
 543                                 }
 544                                 $address = qq[${prefix}"$address"] unless $address =~ /^\w+%"/;
 545                                 $cc = qq[${prefix}"$cc"] unless !$cc || $cc =~ /^\w+%"/;
 546                         }
 547                         $subject =~ s/"/""/g; $address =~ s/"/""/g; $cc =~ s/"/""/g;
 548                         my($sts) = system(qq[mail/Subject="$subject" $filename. "$address","$cc"]);
 549                         if (!($sts & 1)) { die "Can't spawn off mail\n\t(leaving bug report in $filename): $sts\n;" }
 550                 } else {
 551                         my($sendmail) = "";
 552
 553                         foreach (qw(/usr/lib/sendmail /usr/sbin/sendmail /usr/ucblib/sendmail))
 554                         {
 555                                 $sendmail = $_, last if -e $_;
 556                         }
 557
 558                         paraprint <<"EOF" and die "\n" if $sendmail eq "";
 559
 560 I am terribly sorry, but I cannot find sendmail, or a close equivalent, and
 561 the perl package Mail::Send has not been installed, so I can't send your bug
 562 report. We apologize for the inconveniencence.
 563
 564 So you may attempt to find some way of sending your message, it has
 565 been left in the file `$filename'.
 566
 567 EOF
 568
 569                         open(SENDMAIL,"|$sendmail -t");
 570                         print SENDMAIL "To: $address\n";
 571                         print SENDMAIL "Subject: $subject\n";
 572                         print SENDMAIL "Cc: $cc\n" if $cc;
 573                         print SENDMAIL "Reply-To: $from\n" if $from;
 574                         print SENDMAIL "\n\n";
 575                         open(REP,"<$filename");
 576                         while(<REP>) { print SENDMAIL $_ }
 577                         close(REP);
 578
 579                         close(SENDMAIL);
 580                 }
 581
 582         }
 583
 584         print "\nMessage sent.\n";
 585
 586         1 while unlink($filename);  # remove all versions under VMS
 587
 588 }
 589
 590 sub Help {
 591         print <<EOF;
 592
 593 A program to help generate bug reports about perl5, and mail them.
 594 It is designed to be used interactively. Normally no arguments will
 595 be needed.
 596
 597 Usage:
 598 $0  [-v] [-a address] [-s subject] [-b body | -f file ]
 599     [-r returnaddress] [-e editor] [-c adminaddress | -C] [-S] [-t]
 600
 601 Simplest usage:  run "$0", and follow the prompts.
 602
 603 Options:
 604
 605   -v    Include Verbose configuration data in the report
 606   -f    File containing the body of the report. Use this to
 607         quickly send a prepared message.
 608   -S    Send without asking for confirmation.
 609   -a    Address to send the report to. Defaults to `$address'.
 610   -c    Address to send copy of report to. Defaults to `$cc'.
 611   -C    Don't send copy to administrator.
 612   -s    Subject to include with the message. You will be prompted
 613         if you don't supply one on the command line.
 614   -b    Body of the report. If not included on the command line, or
 615         in a file with -f, you will get a chance to edit the message.
 616   -r    Your return address. The program will ask you to confirm
 617         this if you don't give it here.
 618   -e    Editor to use.
 619   -t    Test mode. The target address defaults to `$testaddress'.
 620   -d    Data mode (the default if you redirect or pipe output.)
 621         This prints out your configuration data, without mailing
 622         anything. You can use this with -v to get more complete data.
 623
 624 EOF
 625 }
 626
 627 sub paraprint {
 628     my @paragraphs = split /\n{2,}/, "@_";
 629     print "\n\n";
 630     for (@paragraphs) {   # implicit local $_
 631         s/(\S)\s*\n/$1 /g;
 632             write;
 633             print "\n";
 634     }
 635
 636 }
 637
 638
 639 format STDOUT =
 640 ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
 641 $_
 642 .
 643 !NO!SUBS!
 644
 645 close OUT or die "Can't close $file: $!";
 646 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
 647 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';