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