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