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