utils/perlbug.PL

   1 #!/usr/local/bin/perl
   2
   3 use Config;
   4 use File::Basename qw(&basename &dirname);
   5 use Cwd;
   6 use File::Spec::Functions;
   7
   8 # List explicitly here the variables you want Configure to
   9 # generate.  Metaconfig only looks for shell variables, so you
  10 # have to mention them as if they were shell variables, not
  11 # %Config entries.  Thus you write
  12 #  $startperl
  13 # to ensure Configure will look for $Config{startperl}.
  14 #  $perlpath
  15
  16 # This forces PL files to create target in same directory as PL file.
  17 # This is so that make depend always knows where to find PL derivatives.
  18 $origdir = cwd;
  19 chdir dirname($0);
  20 $file = basename($0, '.PL');
  21 $file .= '.com' if $^O eq 'VMS';
  22
  23 open OUT, ">$file" or die "Can't create $file: $!";
  24
  25 # extract patchlevel.h information
  26
  27 open PATCH_LEVEL, "<" . catfile(updir, "patchlevel.h")
  28     or die "Can't open patchlevel.h: $!";
  29
  30 my $patchlevel_date = (stat PATCH_LEVEL)[9];
  31
  32 while (<PATCH_LEVEL>) {
  33     last if $_ =~ /^\s*static\s+(?:const\s+)?char.*?local_patches\[\]\s*=\s*{\s*$/;
  34 }
  35
  36 if (! defined($_)) {
  37     warn "Warning: local_patches section not found in patchlevel.h\n";
  38 }
  39
  40 my @patches;
  41 while (<PATCH_LEVEL>) {
  42     last if /^\s*}/;
  43     chomp;
  44     s/^\s+,?\s*"?//;
  45     s/"?\s*,?$//;
  46     s/(['\\])/\\$1/g;
  47     push @patches, $_ unless $_ eq 'NULL';
  48 }
  49 my $patch_desc = "'" . join("',\n    '", @patches) . "'";
  50 my $patch_tags = join "", map /(\S+)/ ? "+$1 " : (), @patches;
  51
  52 close(PATCH_LEVEL) or die "Error closing patchlevel.h: $!";
  53
  54 # TO DO (prehaps): store/embed $Config::config_sh into perlbug. When perlbug is
  55 # used, compare $Config::config_sh with the stored version. If they differ then
  56 # append a list of individual differences to the bug report.
  57
  58
  59 print "Extracting $file (with variable substitutions)\n";
  60
  61 # In this section, perl variables will be expanded during extraction.
  62 # You can use $Config{...} to use Configure variables.
  63
  64 my $extract_version = sprintf("%vd", $^V);
  65
  66 print OUT <<"!GROK!THIS!";
  67 $Config{startperl}
  68     eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
  69         if \$running_under_some_shell;
  70
  71 my \$config_tag1 = '$extract_version - $Config{cf_time}';
  72
  73 my \$patchlevel_date = $patchlevel_date;
  74 my \$patch_tags = '$patch_tags';
  75 my \@patches = (
  76     $patch_desc
  77 );
  78 !GROK!THIS!
  79
  80 # In the following, perl variables are not expanded during extraction.
  81
  82 print OUT <<'!NO!SUBS!';
  83
  84 use Config;
  85 use File::Spec;         # keep perlbug Perl 5.005 compatible
  86 use Getopt::Std;
  87 use strict;
  88
  89 sub paraprint;
  90
  91 BEGIN {
  92     eval "use Mail::Send;";
  93     $::HaveSend = ($@ eq "");
  94     eval "use Mail::Util;";
  95     $::HaveUtil = ($@ eq "");
  96     # use secure tempfiles wherever possible
  97     eval "require File::Temp;";
  98     $::HaveTemp = ($@ eq "");
  99 };
 100
 101 my $Version = "1.35";
 102
 103 # Changed in 1.06 to skip Mail::Send and Mail::Util if not available.
 104 # Changed in 1.07 to see more sendmail execs, and added pipe output.
 105 # Changed in 1.08 to use correct address for sendmail.
 106 # Changed in 1.09 to close the REP file before calling it up in the editor.
 107 #                 Also removed some old comments duplicated elsewhere.
 108 # Changed in 1.10 to run under VMS without Mail::Send; also fixed
 109 #                 temp filename generation.
 110 # Changed in 1.11 to clean up some text and removed Mail::Send deactivator.
 111 # Changed in 1.12 to check for editor errors, make save/send distinction
 112 #                 clearer and add $ENV{REPLYTO}.
 113 # Changed in 1.13 to hopefully make it more difficult to accidentally
 114 #                 send mail
 115 # Changed in 1.14 to make the prompts a little more clear on providing
 116 #                 helpful information. Also let file read fail gracefully.
 117 # Changed in 1.15 to add warnings to stop people using perlbug for non-bugs.
 118 #                 Also report selected environment variables.
 119 # Changed in 1.16 to include @INC, and allow user to re-edit if no changes.
 120 # Changed in 1.17 Win32 support added.  GSAR 97-04-12
 121 # Changed in 1.18 add '-ok' option for reporting build success. CFR 97-06-18
 122 # Changed in 1.19 '-ok' default not '-v'
 123 #                 add local patch information
 124 #                 warn on '-ok' if this is an old system; add '-okay'
 125 # Changed in 1.20 Added patchlevel.h reading and version/config checks
 126 # Changed in 1.21 Added '-nok' for reporting build failure DFD 98-05-05
 127 # Changed in 1.22 Heavy reformatting & minor bugfixes HVDS 98-05-10
 128 # Changed in 1.23 Restore -ok(ay): say 'success'; don't prompt
 129 # Changed in 1.24 Added '-F<file>' to save report HVDS 98-07-01
 130 # Changed in 1.25 Warn on failure to open save file. HVDS 98-07-12
 131 # Changed in 1.26 Don't require -t STDIN for -ok. HVDS 98-07-15
 132 # Changed in 1.27 Added Mac OS and File::Spec support CNANDOR 99-07-27
 133 # Changed in 1.28 Additional questions for Perlbugtron RFOLEY 20.03.2000
 134 # Changed in 1.29 Perlbug(tron): auto(-ok), short prompts RFOLEY 05-05-2000
 135 # Changed in 1.30 Added warnings on failure to open files MSTEVENS 13-07-2000
 136 # Changed in 1.31 Add checks on close().Fix my $var unless. TJENNESS 26-07-2000
 137 # Changed in 1.32 Use File::Spec->tmpdir TJENNESS 20-08-2000
 138 # Changed in 1.33 Don't require -t STDOUT for -ok.
 139 # Changed in 1.34 Added Message-Id RFOLEY 18-06-2002
 140 # Changed in 1.35 Use File::Temp (patch from Solar Designer) NWCLARK 28-02-2004
 141
 142 # TODO: - Allow the user to re-name the file on mail failure, and
 143 #       make sure failure (transmission-wise) of Mail::Send is
 144 #       accounted for.
 145 #       - Test -b option
 146
 147 my( $file, $usefile, $cc, $address, $perlbug, $testaddress, $filename, $messageid, $domain,
 148     $subject, $from, $verbose, $ed, $outfile, $Is_MacOS, $category, $severity,
 149     $fh, $me, $Is_MSWin32, $Is_Linux, $Is_VMS, $msg, $body, $andcc, %REP, $ok,
 150     $Is_OpenBSD);
 151
 152 my $perl_version = $^V ? sprintf("%vd", $^V) : $];
 153
 154 my $config_tag2 = "$perl_version - $Config{cf_time}";
 155
 156 Init();
 157
 158 if ($::opt_h) { Help(); exit; }
 159 if ($::opt_d) { Dump(*STDOUT); exit; }
 160 if (!-t STDIN && !($ok and not $::opt_n)) {
 161     paraprint <<EOF;
 162 Please use perlbug interactively. If you want to
 163 include a file, you can use the -f switch.
 164 EOF
 165     die "\n";
 166 }
 167
 168 Query();
 169 Edit() unless $usefile || ($ok and not $::opt_n);
 170 NowWhat();
 171 Send();
 172
 173 exit;
 174
 175 sub ask_for_alternatives { # (category|severity)
 176     my $name = shift;
 177     my %alts = (
 178         'category' => {
 179             'default' => 'core',
 180             'ok'      => 'install',
 181             'opts'    => [qw(core docs install library utilities)], # patch, notabug
 182         },
 183         'severity' => {
 184             'default' => 'low',
 185             'ok'      => 'none',
 186             'opts'    => [qw(critical high medium low wishlist none)], # zero
 187         },
 188     );
 189     die "Invalid alternative($name) requested\n" unless grep(/^$name$/, keys %alts);
 190     my $alt = "";
 191     if ($ok) {
 192         $alt = $alts{$name}{'ok'};
 193     } else {
 194         my @alts = @{$alts{$name}{'opts'}};
 195         paraprint <<EOF;
 196 Please pick a \u$name from the following:
 197
 198     @alts
 199
 200 EOF
 201         my $err = 0;
 202         do {
 203             if ($err++ > 5) {
 204                 die "Invalid $name: aborting.\n";
 205             }
 206             print "Please enter a \u$name [$alts{$name}{'default'}]: ";
 207             $alt = <>;
 208             chomp $alt;
 209             if ($alt =~ /^\s*$/) {
 210                 $alt = $alts{$name}{'default'};
 211             }
 212         } while !((($alt) = grep(/^$alt/i, @alts)));
 213     }
 214     lc $alt;
 215 }
 216
 217 sub Init {
 218     # -------- Setup --------
 219
 220     $Is_MSWin32 = $^O eq 'MSWin32';
 221     $Is_VMS = $^O eq 'VMS';
 222     $Is_Linux = lc($^O) eq 'linux';
 223     $Is_OpenBSD = lc($^O) eq 'openbsd';
 224     $Is_MacOS = $^O eq 'MacOS';
 225
 226     @ARGV = split m/\s+/,
 227         MacPerl::Ask('Provide command-line args here (-h for help):')
 228         if $Is_MacOS && $MacPerl::Version =~ /App/;
 229
 230     if (!getopts("Adhva:s:b:f:F:r:e:SCc:to:n:")) { Help(); exit; };
 231
 232     # This comment is needed to notify metaconfig that we are
 233     # using the $perladmin, $cf_by, and $cf_time definitions.
 234
 235     # -------- Configuration ---------
 236
 237     # perlbug address
 238     $perlbug = 'perlbug@perl.org';
 239
 240     # Test address
 241     $testaddress = 'perlbug-test@perl.org';
 242
 243     # Target address
 244     $address = $::opt_a || ($::opt_t ? $testaddress : $perlbug);
 245
 246     # Users address, used in message and in Reply-To header
 247     $from = $::opt_r || "";
 248
 249     # Include verbose configuration information
 250     $verbose = $::opt_v || 0;
 251
 252     # Subject of bug-report message
 253     $subject = $::opt_s || "";
 254
 255     # Send a file
 256     $usefile = ($::opt_f || 0);
 257
 258     # File to send as report
 259     $file = $::opt_f || "";
 260
 261     # File to output to
 262     $outfile = $::opt_F || "";
 263
 264     # Body of report
 265     $body = $::opt_b || "";
 266
 267     # Editor
 268     $ed = $::opt_e || $ENV{VISUAL} || $ENV{EDITOR} || $ENV{EDIT}
 269         || ($Is_VMS && "edit/tpu")
 270         || ($Is_MSWin32 && "notepad")
 271         || ($Is_MacOS && '')
 272         || "vi";
 273
 274     # Not OK - provide build failure template by finessing OK report
 275     if ($::opt_n) {
 276         if (substr($::opt_n, 0, 2) eq 'ok' )    {
 277             $::opt_o = substr($::opt_n, 1);
 278         } else {
 279             Help();
 280             exit();
 281         }
 282     }
 283
 284     # OK - send "OK" report for build on this system
 285     $ok = 0;
 286     if ($::opt_o) {
 287         if ($::opt_o eq 'k' or $::opt_o eq 'kay') {
 288             my $age = time - $patchlevel_date;
 289             if ($::opt_o eq 'k' and $age > 60 * 24 * 60 * 60 ) {
 290                 my $date = localtime $patchlevel_date;
 291                 print <<"EOF";
 292 "perlbug -ok" and "perlbug -nok" do not report on Perl versions which
 293 are more than 60 days old.  This Perl version was constructed on
 294 $date.  If you really want to report this, use
 295 "perlbug -okay" or "perlbug -nokay".
 296 EOF
 297                 exit();
 298             }
 299             # force these options
 300             unless ($::opt_n) {
 301                 $::opt_S = 1; # don't prompt for send
 302                 $::opt_b = 1; # we have a body
 303                 $body = "Perl reported to build OK on this system.\n";
 304             }
 305             $::opt_C = 1; # don't send a copy to the local admin
 306             $::opt_s = 1; # we have a subject line
 307             $subject = ($::opt_n ? 'Not ' : '')
 308                     . "OK: perl $perl_version ${patch_tags}on"
 309                     ." $::Config{'archname'} $::Config{'osvers'} $subject";
 310             $ok = 1;
 311         } else {
 312             Help();
 313             exit();
 314         }
 315     }
 316
 317     # Possible administrator addresses, in order of confidence
 318     # (Note that cf_email is not mentioned to metaconfig, since
 319     # we don't really want it. We'll just take it if we have to.)
 320     #
 321     # This has to be after the $ok stuff above because of the way
 322     # that $::opt_C is forced.
 323     $cc = $::opt_C ? "" : (
 324         $::opt_c || $::Config{'perladmin'}
 325         || $::Config{'cf_email'} || $::Config{'cf_by'}
 326     );
 327
 328     if ($::HaveUtil) {
 329                 $domain = Mail::Util::maildomain();
 330     } elsif ($Is_MSWin32) {
 331                 $domain = $ENV{'USERDOMAIN'};
 332     } else {
 333                 require Sys::Hostname;
 334                 $domain = Sys::Hostname::hostname();
 335     }
 336
 337     # Message-Id - rjsf
 338     $messageid = "<$::Config{'version'}_${$}_".time."\@$domain>";
 339
 340     # My username
 341     $me = $Is_MSWin32 ? $ENV{'USERNAME'}
 342             : $^O eq 'os2' ? $ENV{'USER'} || $ENV{'LOGNAME'}
 343             : $Is_MacOS ? $ENV{'USER'}
 344             : eval { getpwuid($<) };    # May be missing
 345
 346     $from = $::Config{'cf_email'}
 347        if !$from && $::Config{'cf_email'} && $::Config{'cf_by'} && $me &&
 348                ($me eq $::Config{'cf_by'});
 349 } # sub Init
 350
 351 sub Query {
 352     # Explain what perlbug is
 353     unless ($ok) {
 354         paraprint <<EOF;
 355 This program provides an easy way to create a message reporting a bug
 356 in perl, and e-mail it to $address.  It is *NOT* intended for
 357 sending test messages or simply verifying that perl works, *NOR* is it
 358 intended for reporting bugs in third-party perl modules.  It is *ONLY*
 359 a means of reporting verifiable problems with the core perl distribution,
 360 and any solutions to such problems, to the people who maintain perl.
 361
 362 If you're just looking for help with perl, try posting to the Usenet
 363 newsgroup comp.lang.perl.misc.  If you're looking for help with using
 364 perl with CGI, try posting to comp.infosystems.www.programming.cgi.
 365 EOF
 366     }
 367
 368     # Prompt for subject of message, if needed
 369
 370     if (TrivialSubject($subject)) {
 371         $subject = '';
 372     }
 373
 374     unless ($subject) {
 375         paraprint <<EOF;
 376 First of all, please provide a subject for the
 377 message. It should be a concise description of
 378 the bug or problem. "perl bug" or "perl problem"
 379 is not a concise description.
 380 EOF
 381
 382         my $err = 0;
 383         do {
 384             print "Subject: ";
 385             $subject = <>;
 386             chomp $subject;
 387             if ($err++ == 5) {
 388                 die "Aborting.\n";
 389             }
 390         } while (TrivialSubject($subject));
 391     }
 392
 393     # Prompt for return address, if needed
 394     unless ($from) {
 395         # Try and guess return address
 396         my $guess;
 397
 398         $guess = $ENV{'REPLY-TO'} || $ENV{'REPLYTO'} || '';
 399         if ($Is_MacOS) {
 400             require Mac::InternetConfig;
 401             $guess = $Mac::InternetConfig::InternetConfig{
 402                 Mac::InternetConfig::kICEmail()
 403             };
 404         }
 405
 406         unless ($guess) {
 407                 # move $domain to where we can use it elsewhere
 408         if ($domain) {
 409                 if ($Is_VMS && !$::Config{'d_socket'}) {
 410                     $guess = "$domain\:\:$me";
 411                 } else {
 412                     $guess = "$me\@$domain" if $domain;
 413                 }
 414             }
 415         }
 416
 417         if ($guess) {
 418             unless ($ok) {
 419                 paraprint <<EOF;
 420 Your e-mail address will be useful if you need to be contacted. If the
 421 default shown is not your full internet e-mail address, please correct it.
 422 EOF
 423             }
 424         } else {
 425             paraprint <<EOF;
 426 So that you may be contacted if necessary, please enter
 427 your full internet e-mail address here.
 428 EOF
 429         }
 430
 431         if ($ok && $guess) {
 432             # use it
 433             $from = $guess;
 434         } else {
 435             # verify it
 436             print "Your address [$guess]: ";
 437             $from = <>;
 438             chomp $from;
 439             $from = $guess if $from eq '';
 440         }
 441     }
 442
 443     if ($from eq $cc or $me eq $cc) {
 444         # Try not to copy ourselves
 445         $cc = "yourself";
 446     }
 447
 448     # Prompt for administrator address, unless an override was given
 449     if( !$::opt_C and !$::opt_c ) {
 450         paraprint <<EOF;
 451 A copy of this report can be sent to your local
 452 perl administrator. If the address is wrong, please
 453 correct it, or enter 'none' or 'yourself' to not send
 454 a copy.
 455 EOF
 456         print "Local perl administrator [$cc]: ";
 457         my $entry = scalar <>;
 458         chomp $entry;
 459
 460         if ($entry ne "") {
 461             $cc = $entry;
 462             $cc = '' if $me eq $cc;
 463         }
 464     }
 465
 466     $cc = '' if $cc =~ /^(none|yourself|me|myself|ourselves)$/i;
 467     $andcc = " and $cc" if $cc;
 468
 469     # Prompt for editor, if no override is given
 470 editor:
 471     unless ($::opt_e || $::opt_f || $::opt_b) {
 472         paraprint <<EOF;
 473 Now you need to supply the bug report. Try to make
 474 the report concise but descriptive. Include any
 475 relevant detail. If you are reporting something
 476 that does not work as you think it should, please
 477 try to include example of both the actual
 478 result, and what you expected.
 479
 480 Some information about your local
 481 perl configuration will automatically be included
 482 at the end of the report. If you are using any
 483 unusual version of perl, please try and confirm
 484 exactly which versions are relevant.
 485
 486 You will probably want to use an editor to enter
 487 the report. If "$ed" is the editor you want
 488 to use, then just press Enter, otherwise type in
 489 the name of the editor you would like to use.
 490
 491 If you would like to use a prepared file, type
 492 "file", and you will be asked for the filename.
 493 EOF
 494         print "Editor [$ed]: ";
 495         my $entry =scalar <>;
 496         chomp $entry;
 497
 498         $usefile = 0;
 499         if ($entry eq "file") {
 500             $usefile = 1;
 501         } elsif ($entry ne "") {
 502             $ed = $entry;
 503         }
 504     }
 505
 506     # Prompt for category of bug
 507     $category ||= ask_for_alternatives('category');
 508
 509     # Prompt for severity of bug
 510     $severity ||= ask_for_alternatives('severity');
 511
 512     # Generate scratch file to edit report in
 513     $filename = filename();
 514
 515     # Prompt for file to read report from, if needed
 516     if ($usefile and !$file) {
 517 filename:
 518         paraprint <<EOF;
 519 What is the name of the file that contains your report?
 520 EOF
 521         print "Filename: ";
 522         my $entry = scalar <>;
 523         chomp $entry;
 524
 525         if ($entry eq "") {
 526             paraprint <<EOF;
 527 No filename? I'll let you go back and choose an editor again.
 528 EOF
 529             goto editor;
 530         }
 531
 532         unless (-f $entry and -r $entry) {
 533             paraprint <<EOF;
 534 I'm sorry, but I can't read from `$entry'. Maybe you mistyped the name of
 535 the file? If you don't want to send a file, just enter a blank line and you
 536 can get back to the editor selection.
 537 EOF
 538             goto filename;
 539         }
 540         $file = $entry;
 541     }
 542
 543     # Generate report
 544     open(REP,">$filename") or die "Unable to create report file `$filename': $!\n";
 545     my $reptype = !$ok ? "bug" : $::opt_n ? "build failure" : "success";
 546
 547     print REP <<EOF;
 548 This is a $reptype report for perl from $from,
 549 generated with the help of perlbug $Version running under perl $perl_version.
 550
 551 EOF
 552
 553     if ($body) {
 554         print REP $body;
 555     } elsif ($usefile) {
 556         open(F, "<$file")
 557                 or die "Unable to read report file from `$file': $!\n";
 558         while (<F>) {
 559             print REP $_
 560         }
 561         close(F) or die "Error closing `$file': $!";
 562     } else {
 563         print REP <<EOF;
 564
 565 -----------------------------------------------------------------
 566 [Please enter your report here]
 567
 568
 569
 570 [Please do not change anything below this line]
 571 -----------------------------------------------------------------
 572 EOF
 573     }
 574     Dump(*REP);
 575     close(REP) or die "Error closing report file: $!";
 576
 577     # read in the report template once so that
 578     # we can track whether the user does any editing.
 579     # yes, *all* whitespace is ignored.
 580     open(REP, "<$filename") or die "Unable to open report file `$filename': $!\n";
 581     while (<REP>) {
 582         s/\s+//g;
 583         $REP{$_}++;
 584     }
 585     close(REP) or die "Error closing report file `$filename': $!";
 586 } # sub Query
 587
 588 sub Dump {
 589     local(*OUT) = @_;
 590
 591     print OUT <<EFF;
 592 ---
 593 Flags:
 594     category=$category
 595     severity=$severity
 596 EFF
 597     if ($::opt_A) {
 598         print OUT <<EFF;
 599     ack=no
 600 EFF
 601     }
 602     print OUT <<EFF;
 603 ---
 604 EFF
 605     print OUT "This perlbug was built using Perl $config_tag1\n",
 606             "It is being executed now by  Perl $config_tag2.\n\n"
 607         if $config_tag2 ne $config_tag1;
 608
 609     print OUT <<EOF;
 610 Site configuration information for perl $perl_version:
 611
 612 EOF
 613     if ($::Config{cf_by} and $::Config{cf_time}) {
 614         print OUT "Configured by $::Config{cf_by} at $::Config{cf_time}.\n\n";
 615     }
 616     print OUT Config::myconfig;
 617
 618     if (@patches) {
 619         print OUT join "\n    ", "Locally applied patches:", @patches;
 620         print OUT "\n";
 621     };
 622
 623     print OUT <<EOF;
 624
 625 ---
 626 \@INC for perl $perl_version:
 627 EOF
 628     for my $i (@INC) {
 629         print OUT "    $i\n";
 630     }
 631
 632     print OUT <<EOF;
 633
 634 ---
 635 Environment for perl $perl_version:
 636 EOF
 637     my @env =
 638         qw(PATH LD_LIBRARY_PATH LANG PERL_BADLANG SHELL HOME LOGDIR LANGUAGE);
 639     push @env, $Config{ldlibpthname} if $Config{ldlibpthname} ne '';
 640     push @env, grep /^(?:PERL|LC_|LANG|CYGWIN)/, keys %ENV;
 641     my %env;
 642     @env{@env} = @env;
 643     for my $env (sort keys %env) {
 644         print OUT "    $env",
 645                 exists $ENV{$env} ? "=$ENV{$env}" : ' (unset)',
 646                 "\n";
 647     }
 648     if ($verbose) {
 649         print OUT "\nComplete configuration data for perl $perl_version:\n\n";
 650         my $value;
 651         foreach (sort keys %::Config) {
 652             $value = $::Config{$_};
 653             $value =~ s/'/\\'/g;
 654             print OUT "$_='$value'\n";
 655         }
 656     }
 657 } # sub Dump
 658
 659 sub Edit {
 660     # Edit the report
 661     if ($usefile || $body) {
 662         paraprint <<EOF;
 663 Please make sure that the name of the editor you want to use is correct.
 664 EOF
 665         print "Editor [$ed]: ";
 666         my $entry =scalar <>;
 667         chomp $entry;
 668         $ed = $entry unless $entry eq '';
 669     }
 670
 671 tryagain:
 672     my $sts;
 673     $sts = system("$ed $filename") unless $Is_MacOS;
 674     if ($Is_MacOS) {
 675         require ExtUtils::MakeMaker;
 676         ExtUtils::MM_MacOS::launch_file($filename);
 677         paraprint <<EOF;
 678 Press Enter when done.
 679 EOF
 680         scalar <>;
 681     }
 682     if ($sts) {
 683         paraprint <<EOF;
 684 The editor you chose (`$ed') could apparently not be run!
 685 Did you mistype the name of your editor? If so, please
 686 correct it here, otherwise just press Enter.
 687 EOF
 688         print "Editor [$ed]: ";
 689         my $entry =scalar <>;
 690         chomp $entry;
 691
 692         if ($entry ne "") {
 693             $ed = $entry;
 694             goto tryagain;
 695         } else {
 696             paraprint <<EOF;
 697 You may want to save your report to a file, so you can edit and mail it
 698 yourself.
 699 EOF
 700         }
 701     }
 702
 703     return if ($ok and not $::opt_n) || $body;
 704     # Check that we have a report that has some, eh, report in it.
 705     my $unseen = 0;
 706
 707     open(REP, "<$filename") or die "Couldn't open `$filename': $!\n";
 708     # a strange way to check whether any significant editing
 709     # have been done: check whether any new non-empty lines
 710     # have been added. Yes, the below code ignores *any* space
 711     # in *any* line.
 712     while (<REP>) {
 713         s/\s+//g;
 714         $unseen++ if $_ ne '' and not exists $REP{$_};
 715     }
 716
 717     while ($unseen == 0) {
 718         paraprint <<EOF;
 719 I am sorry but it looks like you did not report anything.
 720 EOF
 721         print "Action (Retry Edit/Cancel) ";
 722         my ($action) = scalar(<>);
 723         if ($action =~ /^[re]/i) { # <R>etry <E>dit
 724             goto tryagain;
 725         } elsif ($action =~ /^[cq]/i) { # <C>ancel, <Q>uit
 726             Cancel();
 727         }
 728     }
 729 } # sub Edit
 730
 731 sub Cancel {
 732     1 while unlink($filename);  # remove all versions under VMS
 733     print "\nCancelling.\n";
 734     exit(0);
 735 }
 736
 737 sub NowWhat {
 738     # Report is done, prompt for further action
 739     if( !$::opt_S ) {
 740         while(1) {
 741             paraprint <<EOF;
 742 Now that you have completed your report, would you like to send
 743 the message to $address$andcc, display the message on
 744 the screen, re-edit it, display/change the subject,
 745 or cancel without sending anything?
 746 You may also save the message as a file to mail at another time.
 747 EOF
 748       retry:
 749             print "Action (Send/Display/Edit/Subject/Save to File): ";
 750             my $action = scalar <>;
 751             chomp $action;
 752
 753             if ($action =~ /^(f|sa)/i) { # <F>ile/<Sa>ve
 754                 my $file_save = $outfile || "perlbug.rep";
 755                 print "\n\nName of file to save message in [$file_save]: ";
 756                 my $file = scalar <>;
 757                 chomp $file;
 758                 $file = $file_save if $file eq "";
 759
 760                 unless (open(FILE, ">$file")) {
 761                     print "\nError opening $file: $!\n\n";
 762                     goto retry;
 763                 }
 764                 open(REP, "<$filename") or die "Couldn't open file `$filename': $!\n";
 765                 print FILE "To: $address\nSubject: $subject\n";
 766                 print FILE "Cc: $cc\n" if $cc;
 767                 print FILE "Reply-To: $from\n" if $from;
 768                 print FILE "Message-Id: $messageid\n" if $messageid;
 769                 print FILE "\n";
 770                 while (<REP>) { print FILE }
 771                 close(REP) or die "Error closing report file `$filename': $!";
 772                 close(FILE) or die "Error closing $file: $!";
 773
 774                 print "\nMessage saved in `$file'.\n";
 775                 exit;
 776             } elsif ($action =~ /^(d|l|sh)/i ) { # <D>isplay, <L>ist, <Sh>ow
 777                 # Display the message
 778                 open(REP, "<$filename") or die "Couldn't open file `$filename': $!\n";
 779                 while (<REP>) { print $_ }
 780                 close(REP) or die "Error closing report file `$filename': $!";
 781             } elsif ($action =~ /^su/i) { # <Su>bject
 782                 print "Subject: $subject\n";
 783                 print "If the above subject is fine, just press Enter.\n";
 784                 print "If not, type in the new subject.\n";
 785                 print "Subject: ";
 786                 my $reply = scalar <STDIN>;
 787                 chomp $reply;
 788                 if ($reply ne '') {
 789                     unless (TrivialSubject($reply)) {
 790                         $subject = $reply;
 791                         print "Subject: $subject\n";
 792                     }
 793                 }
 794             } elsif ($action =~ /^se/i) { # <S>end
 795                 # Send the message
 796                 print "Are you certain you want to send this message?\n"
 797                     . 'Please type "yes" if you are: ';
 798                 my $reply = scalar <STDIN>;
 799                 chomp $reply;
 800                 if ($reply eq "yes") {
 801                     last;
 802                 } else {
 803                     paraprint <<EOF;
 804 That wasn't a clear "yes", so I won't send your message. If you are sure
 805 your message should be sent, type in "yes" (without the quotes) at the
 806 confirmation prompt.
 807 EOF
 808                 }
 809             } elsif ($action =~ /^[er]/i) { # <E>dit, <R>e-edit
 810                 # edit the message
 811                 Edit();
 812             } elsif ($action =~ /^[qc]/i) { # <C>ancel, <Q>uit
 813                 Cancel();
 814             } elsif ($action =~ /^s/i) {
 815                 paraprint <<EOF;
 816 I'm sorry, but I didn't understand that. Please type "send" or "save".
 817 EOF
 818             }
 819         }
 820     }
 821 } # sub NowWhat
 822
 823 sub TrivialSubject {
 824     my $subject = shift;
 825     if ($subject =~
 826         /^(y(es)?|no?|help|perl( (bug|problem))?|bug|problem)$/i ||
 827         length($subject) < 4 ||
 828         $subject !~ /\s/) {
 829         print "\nThat doesn't look like a good subject.  Please be more verbose.\n\n";
 830         return 1;
 831     } else {
 832         return 0;
 833     }
 834 }
 835
 836 sub Send {
 837     # Message has been accepted for transmission -- Send the message
 838     if ($outfile) {
 839         open SENDMAIL, ">$outfile" or die "Couldn't open '$outfile': $!\n";
 840         goto sendout;
 841     }
 842
 843     # on linux certain mail implementations won't accept the subject
 844     # as "~s subject" and thus the Subject header will be corrupted
 845     # so don't use Mail::Send to be safe
 846     if ($::HaveSend && !$Is_Linux && !$Is_OpenBSD) {
 847         $msg = new Mail::Send Subject => $subject, To => $address;
 848         $msg->cc($cc) if $cc;
 849         $msg->add("Reply-To",$from) if $from;
 850
 851         $fh = $msg->open;
 852         open(REP, "<$filename") or die "Couldn't open `$filename': $!\n";
 853         while (<REP>) { print $fh $_ }
 854         close(REP) or die "Error closing $filename: $!";
 855         $fh->close;
 856
 857         print "\nMessage sent.\n";
 858     } elsif ($Is_VMS) {
 859         if ( ($address =~ /@/ and $address !~ /^\w+%"/) or
 860              ($cc      =~ /@/ and $cc      !~ /^\w+%"/) ) {
 861             my $prefix;
 862             foreach (qw[ IN MX SMTP UCX PONY WINS ], '') {
 863                 $prefix = "$_%", last if $ENV{"MAIL\$PROTOCOL_$_"};
 864             }
 865             $address = qq[${prefix}"$address"] unless $address =~ /^\w+%"/;
 866             $cc = qq[${prefix}"$cc"] unless !$cc || $cc =~ /^\w+%"/;
 867         }
 868         $subject =~ s/"/""/g; $address =~ s/"/""/g; $cc =~ s/"/""/g;
 869         my $sts = system(qq[mail/Subject="$subject" $filename. "$address","$cc"]);
 870         if ($sts) {
 871             die <<EOF;
 872 Can't spawn off mail
 873         (leaving bug report in $filename): $sts
 874 EOF
 875         }
 876     } else {
 877         my $sendmail = "";
 878         for (qw(/usr/lib/sendmail /usr/sbin/sendmail /usr/ucblib/sendmail)) {
 879             $sendmail = $_, last if -e $_;
 880         }
 881         if ($^O eq 'os2' and $sendmail eq "") {
 882             my $path = $ENV{PATH};
 883             $path =~ s:\\:/: ;
 884             my @path = split /$Config{'path_sep'}/, $path;
 885             for (@path) {
 886                 $sendmail = "$_/sendmail", last if -e "$_/sendmail";
 887                 $sendmail = "$_/sendmail.exe", last if -e "$_/sendmail.exe";
 888             }
 889         }
 890
 891         paraprint(<<"EOF"), die "\n" if $sendmail eq "";
 892 I am terribly sorry, but I cannot find sendmail, or a close equivalent, and
 893 the perl package Mail::Send has not been installed, so I can't send your bug
 894 report. We apologize for the inconvenience.
 895
 896 So you may attempt to find some way of sending your message, it has
 897 been left in the file `$filename'.
 898 EOF
 899         open(SENDMAIL, "|$sendmail -t -oi") || die "'|$sendmail -t -oi' failed: $!";
 900 sendout:
 901         print SENDMAIL "To: $address\n";
 902         print SENDMAIL "Subject: $subject\n";
 903         print SENDMAIL "Cc: $cc\n" if $cc;
 904         print SENDMAIL "Reply-To: $from\n" if $from;
 905         print SENDMAIL "Message-Id: $messageid\n" if $messageid;
 906         print SENDMAIL "\n\n";
 907         open(REP, "<$filename") or die "Couldn't open `$filename': $!\n";
 908         while (<REP>) { print SENDMAIL $_ }
 909         close(REP) or die "Error closing $filename: $!";
 910
 911         if (close(SENDMAIL)) {
 912             printf "\nMessage %s.\n", $outfile ? "saved" : "sent";
 913         } else {
 914             warn "\nSendmail returned status '", $? >> 8, "'\n";
 915         }
 916     }
 917     1 while unlink($filename);  # remove all versions under VMS
 918 } # sub Send
 919
 920 sub Help {
 921     print <<EOF;
 922
 923 A program to help generate bug reports about perl5, and mail them.
 924 It is designed to be used interactively. Normally no arguments will
 925 be needed.
 926
 927 Usage:
 928 $0  [-v] [-a address] [-s subject] [-b body | -f inpufile ] [ -F outputfile ]
 929     [-r returnaddress] [-e editor] [-c adminaddress | -C] [-S] [-t] [-h]
 930 $0  [-v] [-r returnaddress] [-A] [-ok | -okay | -nok | -nokay]
 931
 932 Simplest usage:  run "$0", and follow the prompts.
 933
 934 Options:
 935
 936   -v    Include Verbose configuration data in the report
 937   -f    File containing the body of the report. Use this to
 938         quickly send a prepared message.
 939   -F    File to output the resulting mail message to, instead of mailing.
 940   -S    Send without asking for confirmation.
 941   -a    Address to send the report to. Defaults to `$address'.
 942   -c    Address to send copy of report to. Defaults to `$cc'.
 943   -C    Don't send copy to administrator.
 944   -s    Subject to include with the message. You will be prompted
 945         if you don't supply one on the command line.
 946   -b    Body of the report. If not included on the command line, or
 947         in a file with -f, you will get a chance to edit the message.
 948   -r    Your return address. The program will ask you to confirm
 949         this if you don't give it here.
 950   -e    Editor to use.
 951   -t    Test mode. The target address defaults to `$testaddress'.
 952   -d    Data mode.  This prints out your configuration data, without mailing
 953         anything. You can use this with -v to get more complete data.
 954   -A    Don't send a bug received acknowledgement to the return address.
 955   -ok   Report successful build on this system to perl porters
 956         (use alone or with -v). Only use -ok if *everything* was ok:
 957         if there were *any* problems at all, use -nok.
 958   -okay As -ok but allow report from old builds.
 959   -nok  Report unsuccessful build on this system to perl porters
 960         (use alone or with -v). You must describe what went wrong
 961         in the body of the report which you will be asked to edit.
 962   -nokay As -nok but allow report from old builds.
 963   -h    Print this help message.
 964
 965 EOF
 966 }
 967
 968 sub filename {
 969     if ($::HaveTemp) {
 970         # Good. Use a secure temp file
 971         my ($fh, $filename) = File::Temp::tempfile(UNLINK => 1);
 972         close($fh);
 973         return $filename;
 974     } else {
 975         # Bah. Fall back to doing things less securely.
 976         my $dir = File::Spec->tmpdir();
 977         $filename = "bugrep0$$";
 978         $filename++ while -e File::Spec->catfile($dir, $filename);
 979         $filename = File::Spec->catfile($dir, $filename);
 980     }
 981 }
 982
 983 sub paraprint {
 984     my @paragraphs = split /\n{2,}/, "@_";
 985     print "\n\n";
 986     for (@paragraphs) {   # implicit local $_
 987         s/(\S)\s*\n/$1 /g;
 988         write;
 989         print "\n";
 990     }
 991 }
 992
 993 format STDOUT =
 994 ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
 995 $_
 996 .
 997
 998 __END__
 999
1000 =head1 NAME
1001
1002 perlbug - how to submit bug reports on Perl
1003
1004 =head1 SYNOPSIS
1005
1006 B<perlbug> S<[ B<-v> ]> S<[ B<-a> I<address> ]> S<[ B<-s> I<subject> ]>
1007 S<[ B<-b> I<body> | B<-f> I<inputfile> ]> S<[ B<-F> I<outputfile> ]>
1008 S<[ B<-r> I<returnaddress> ]>
1009 S<[ B<-e> I<editor> ]> S<[ B<-c> I<adminaddress> | B<-C> ]>
1010 S<[ B<-S> ]> S<[ B<-t> ]>  S<[ B<-d> ]>  S<[ B<-A> ]>  S<[ B<-h> ]>
1011
1012 B<perlbug> S<[ B<-v> ]> S<[ B<-r> I<returnaddress> ]>
1013  S<[ B<-A> ]> S<[ B<-ok> | B<-okay> | B<-nok> | B<-nokay> ]>
1014
1015 =head1 DESCRIPTION
1016
1017 A program to help generate bug reports about perl or the modules that
1018 come with it, and mail them.
1019
1020 If you have found a bug with a non-standard port (one that was not part
1021 of the I<standard distribution>), a binary distribution, or a
1022 non-standard module (such as Tk, CGI, etc), then please see the
1023 documentation that came with that distribution to determine the correct
1024 place to report bugs.
1025
1026 C<perlbug> is designed to be used interactively. Normally no arguments
1027 will be needed.  Simply run it, and follow the prompts.
1028
1029 If you are unable to run B<perlbug> (most likely because you don't have
1030 a working setup to send mail that perlbug recognizes), you may have to
1031 compose your own report, and email it to B<perlbug@perl.org>.  You might
1032 find the B<-d> option useful to get summary information in that case.
1033
1034 In any case, when reporting a bug, please make sure you have run through
1035 this checklist:
1036
1037 =over 4
1038
1039 =item What version of Perl you are running?
1040
1041 Type C<perl -v> at the command line to find out.
1042
1043 =item Are you running the latest released version of perl?
1044
1045 Look at http://www.perl.com/ to find out.  If it is not the latest
1046 released version, get that one and see whether your bug has been
1047 fixed.  Note that bug reports about old versions of Perl, especially
1048 those prior to the 5.0 release, are likely to fall upon deaf ears.
1049 You are on your own if you continue to use perl1 .. perl4.
1050
1051 =item Are you sure what you have is a bug?
1052
1053 A significant number of the bug reports we get turn out to be documented
1054 features in Perl.  Make sure the behavior you are witnessing doesn't fall
1055 under that category, by glancing through the documentation that comes
1056 with Perl (we'll admit this is no mean task, given the sheer volume of
1057 it all, but at least have a look at the sections that I<seem> relevant).
1058
1059 Be aware of the familiar traps that perl programmers of various hues
1060 fall into.  See L<perltrap>.
1061
1062 Check in L<perldiag> to see what any Perl error message(s) mean.
1063 If message isn't in perldiag, it probably isn't generated by Perl.
1064 Consult your operating system documentation instead.
1065
1066 If you are on a non-UNIX platform check also L<perlport>, as some
1067 features may be unimplemented or work differently.
1068
1069 Try to study the problem under the Perl debugger, if necessary.
1070 See L<perldebug>.
1071
1072 =item Do you have a proper test case?
1073
1074 The easier it is to reproduce your bug, the more likely it will be
1075 fixed, because if no one can duplicate the problem, no one can fix it.
1076 A good test case has most of these attributes: fewest possible number
1077 of lines; few dependencies on external commands, modules, or
1078 libraries; runs on most platforms unimpeded; and is self-documenting.
1079
1080 A good test case is almost always a good candidate to be on the perl
1081 test suite.  If you have the time, consider making your test case so
1082 that it will readily fit into the standard test suite.
1083
1084 Remember also to include the B<exact> error messages, if any.
1085 "Perl complained something" is not an exact error message.
1086
1087 If you get a core dump (or equivalent), you may use a debugger
1088 (B<dbx>, B<gdb>, etc) to produce a stack trace to include in the bug
1089 report.  NOTE: unless your Perl has been compiled with debug info
1090 (often B<-g>), the stack trace is likely to be somewhat hard to use
1091 because it will most probably contain only the function names and not
1092 their arguments.  If possible, recompile your Perl with debug info and
1093 reproduce the dump and the stack trace.
1094
1095 =item Can you describe the bug in plain English?
1096
1097 The easier it is to understand a reproducible bug, the more likely it
1098 will be fixed.  Anything you can provide by way of insight into the
1099 problem helps a great deal.  In other words, try to analyze the
1100 problem (to the extent you can) and report your discoveries.
1101
1102 =item Can you fix the bug yourself?
1103
1104 A bug report which I<includes a patch to fix it> will almost
1105 definitely be fixed.  Use the C<diff> program to generate your patches
1106 (C<diff> is being maintained by the GNU folks as part of the B<diffutils>
1107 package, so you should be able to get it from any of the GNU software
1108 repositories).  If you do submit a patch, the cool-dude counter at
1109 perlbug@perl.org will register you as a savior of the world.  Your
1110 patch may be returned with requests for changes, or requests for more
1111 detailed explanations about your fix.
1112
1113 Here are some clues for creating quality patches: Use the B<-c> or
1114 B<-u> switches to the diff program (to create a so-called context or
1115 unified diff).  Make sure the patch is not reversed (the first
1116 argument to diff is typically the original file, the second argument
1117 your changed file).  Make sure you test your patch by applying it with
1118 the C<patch> program before you send it on its way.  Try to follow the
1119 same style as the code you are trying to patch.  Make sure your patch
1120 really does work (C<make test>, if the thing you're patching supports
1121 it).
1122
1123 =item Can you use C<perlbug> to submit the report?
1124
1125 B<perlbug> will, amongst other things, ensure your report includes
1126 crucial information about your version of perl.  If C<perlbug> is unable
1127 to mail your report after you have typed it in, you may have to compose
1128 the message yourself, add the output produced by C<perlbug -d> and email
1129 it to B<perlbug@perl.org>.  If, for some reason, you cannot run
1130 C<perlbug> at all on your system, be sure to include the entire output
1131 produced by running C<perl -V> (note the uppercase V).
1132
1133 Whether you use C<perlbug> or send the email manually, please make
1134 your Subject line informative.  "a bug" not informative.  Neither is
1135 "perl crashes" nor "HELP!!!".  These don't help.
1136 A compact description of what's wrong is fine.
1137
1138 =back
1139
1140 Having done your bit, please be prepared to wait, to be told the bug
1141 is in your code, or even to get no reply at all.  The Perl maintainers
1142 are busy folks, so if your problem is a small one or if it is difficult
1143 to understand or already known, they may not respond with a personal reply.
1144 If it is important to you that your bug be fixed, do monitor the
1145 C<Changes> file in any development releases since the time you submitted
1146 the bug, and encourage the maintainers with kind words (but never any
1147 flames!).  Feel free to resend your bug report if the next released
1148 version of perl comes out and your bug is still present.
1149
1150 =head1 OPTIONS
1151
1152 =over 8
1153
1154 =item B<-a>
1155
1156 Address to send the report to.  Defaults to B<perlbug@perl.org>.
1157
1158 =item B<-A>
1159
1160 Don't send a bug received acknowledgement to the reply address.
1161 Generally it is only a sensible to use this option if you are a
1162 perl maintainer actively watching perl porters for your message to
1163 arrive.
1164
1165 =item B<-b>
1166
1167 Body of the report.  If not included on the command line, or
1168 in a file with B<-f>, you will get a chance to edit the message.
1169
1170 =item B<-C>
1171
1172 Don't send copy to administrator.
1173
1174 =item B<-c>
1175
1176 Address to send copy of report to.  Defaults to the address of the
1177 local perl administrator (recorded when perl was built).
1178
1179 =item B<-d>
1180
1181 Data mode (the default if you redirect or pipe output).  This prints out
1182 your configuration data, without mailing anything.  You can use this
1183 with B<-v> to get more complete data.
1184
1185 =item B<-e>
1186
1187 Editor to use.
1188
1189 =item B<-f>
1190
1191 File containing the body of the report.  Use this to quickly send a
1192 prepared message.
1193
1194 =item B<-F>
1195
1196 File to output the results to instead of sending as an email. Useful
1197 particularly when running perlbug on a machine with no direct internet
1198 connection.
1199
1200 =item B<-h>
1201
1202 Prints a brief summary of the options.
1203
1204 =item B<-ok>
1205
1206 Report successful build on this system to perl porters. Forces B<-S>
1207 and B<-C>. Forces and supplies values for B<-s> and B<-b>. Only
1208 prompts for a return address if it cannot guess it (for use with
1209 B<make>). Honors return address specified with B<-r>.  You can use this
1210 with B<-v> to get more complete data.   Only makes a report if this
1211 system is less than 60 days old.
1212
1213 =item B<-okay>
1214
1215 As B<-ok> except it will report on older systems.
1216
1217 =item B<-nok>
1218
1219 Report unsuccessful build on this system.  Forces B<-C>.  Forces and
1220 supplies a value for B<-s>, then requires you to edit the report
1221 and say what went wrong.  Alternatively, a prepared report may be
1222 supplied using B<-f>.  Only prompts for a return address if it
1223 cannot guess it (for use with B<make>). Honors return address
1224 specified with B<-r>.  You can use this with B<-v> to get more
1225 complete data.  Only makes a report if this system is less than 60
1226 days old.
1227
1228 =item B<-nokay>
1229
1230 As B<-nok> except it will report on older systems.
1231
1232 =item B<-r>
1233
1234 Your return address.  The program will ask you to confirm its default
1235 if you don't use this option.
1236
1237 =item B<-S>
1238
1239 Send without asking for confirmation.
1240
1241 =item B<-s>
1242
1243 Subject to include with the message.  You will be prompted if you don't
1244 supply one on the command line.
1245
1246 =item B<-t>
1247
1248 Test mode.  The target address defaults to B<perlbug-test@perl.org>.
1249
1250 =item B<-v>
1251
1252 Include verbose configuration data in the report.
1253
1254 =back
1255
1256 =head1 AUTHORS
1257
1258 Kenneth Albanowski (E<lt>kjahds@kjahds.comE<gt>), subsequently I<doc>tored
1259 by Gurusamy Sarathy (E<lt>gsar@activestate.comE<gt>), Tom Christiansen
1260 (E<lt>tchrist@perl.comE<gt>), Nathan Torkington (E<lt>gnat@frii.comE<gt>),
1261 Charles F. Randall (E<lt>cfr@pobox.comE<gt>), Mike Guy
1262 (E<lt>mjtg@cam.a.ukE<gt>), Dominic Dunlop (E<lt>domo@computer.orgE<gt>),
1263 Hugo van der Sanden (E<lt>hv@crypt.org<gt>),
1264 Jarkko Hietaniemi (E<lt>jhi@iki.fiE<gt>), Chris Nandor
1265 (E<lt>pudge@pobox.comE<gt>), Jon Orwant (E<lt>orwant@media.mit.eduE<gt>,
1266 and Richard Foley (E<lt>richard@rfi.netE<gt>).
1267
1268 =head1 SEE ALSO
1269
1270 perl(1), perldebug(1), perldiag(1), perlport(1), perltrap(1),
1271 diff(1), patch(1), dbx(1), gdb(1)
1272
1273 =head1 BUGS
1274
1275 None known (guess what must have been used to report them?)
1276
1277 =cut
1278
1279 !NO!SUBS!
1280
1281 close OUT or die "Can't close $file: $!";
1282 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
1283 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
1284 chdir $origdir;