home *** CD-ROM | disk | FTP | other *** search
/ BURKS 2 / BURKS_AUG97.ISO / SLAKWARE / D12 / PERL1.TGZ / perl1.tar / usr / bin / perlbug < prev    next >
Text File  |  1996-06-28  |  14KB  |  611 lines
  1. #!/usr/bin/perl
  2.     eval 'exec perl -S $0 "$@"'
  3.     if 0;
  4.  
  5. use Config;
  6. use Getopt::Std;
  7.  
  8. BEGIN {
  9.     eval "use Mail::Send;";
  10.     $::HaveSend = ($@ eq "");
  11.     eval "use Mail::Util;";
  12.     $::HaveUtil = ($@ eq "");
  13. };
  14.  
  15.  
  16. use strict;
  17.  
  18. sub paraprint;
  19.  
  20.  
  21. my($Version) = "1.13";
  22.  
  23. # Changed in 1.06 to skip Mail::Send and Mail::Util if not available.
  24. # Changed in 1.07 to see more sendmail execs, and added pipe output.
  25. # Changed in 1.08 to use correct address for sendmail.
  26. # Changed in 1.09 to close the REP file before calling it up in the editor.
  27. #                 Also removed some old comments duplicated elsewhere.
  28. # Changed in 1.10 to run under VMS without Mail::Send; also fixed
  29. #                 temp filename generation.
  30. # Changed in 1.11 to clean up some text and removed Mail::Send deactivator.
  31. # Changed in 1.12 to check for editor errors, make save/send distinction
  32. #                 clearer and add $ENV{REPLYTO}.
  33. # Changed in 1.13 to hopefully make it more difficult to accidentally
  34. #                 send mail
  35.  
  36. # TODO: Allow the user to re-name the file on mail failure, and
  37. #       make sure failure (transmission-wise) of Mail::Send is 
  38. #       accounted for.
  39.  
  40. my( $file, $cc, $address, $perlbug, $testaddress, $filename,
  41.     $subject, $from, $verbose, $ed, 
  42.     $fh, $me, $Is_VMS, $msg, $body, $andcc );
  43.  
  44. Init();
  45.  
  46. if($::opt_h) { Help(); exit; }
  47.  
  48. if(!-t STDIN) {
  49.     paraprint <<EOF;
  50. Please use perlbug interactively. If you want to 
  51. include a file, you can use the -f switch.
  52. EOF
  53.     die "\n";
  54. }
  55.  
  56. if($::opt_d or !-t STDOUT) { Dump(*STDOUT); exit; }
  57.  
  58. Query();
  59. Edit();
  60. NowWhat();
  61. Send();
  62.  
  63. exit;
  64.  
  65. sub Init {
  66.  
  67.     # -------- Setup --------
  68.  
  69.     $Is_VMS = $^O eq 'VMS';
  70.  
  71.     getopts("dhva:s:b:f:r:e:SCc:t");
  72.     
  73.  
  74.     # This comment is needed to notify metaconfig that we are
  75.     # using the $perladmin, $cf_by, and $cf_time definitions.
  76.  
  77.  
  78.     # -------- Configuration ---------
  79.     
  80.     # perlbug address
  81.     $perlbug = 'perlbug@perl.com';
  82.     
  83.     # Test address
  84.     $testaddress = 'perlbug-test@perl.com';
  85.     
  86.     # Target address
  87.     $address = $::opt_a || ($::opt_t ? $testaddress : $perlbug);
  88.  
  89.     # Possible administrator addresses, in order of confidence
  90.     # (Note that cf_email is not mentioned to metaconfig, since
  91.     # we don't really want it. We'll just take it if we have to.)
  92.     $cc = ($::opt_C ? "" : (
  93.         $::opt_c || $::Config{perladmin} || $::Config{cf_email} || $::Config{cf_by}
  94.         ));
  95.     
  96.     # Users address, used in message and in Reply-To header
  97.     $from = $::opt_r || "";
  98.  
  99.     # Include verbose configuration information
  100.     $verbose = $::opt_v || 0;
  101.  
  102.     # Subject of bug-report message
  103.     $subject = $::opt_s || "";
  104.  
  105.     # File to send as report
  106.     $file = $::opt_f || "";
  107.  
  108.     # Body of report
  109.     $body = $::opt_b || "";
  110.  
  111.     # Editor
  112.     $ed = ($::opt_f ? "file" : (
  113.             $::opt_e || $ENV{VISUAL} || $ENV{EDITOR} || $ENV{EDIT} || 
  114.               ($Is_VMS ? "edit/tpu" : "vi")
  115.           ));
  116.       
  117.     # My username
  118.     $me = getpwuid($<);
  119.  
  120. }
  121.  
  122.  
  123. sub Query {
  124.  
  125.     # Explain what perlbug is
  126.     
  127.     paraprint <<EOF;
  128. This program allows you to create a bug report,
  129. which will be sent as an e-mail message to $address
  130. once you have filled in the report.
  131.  
  132. EOF
  133.  
  134.  
  135.     # Prompt for subject of message, if needed
  136.     if(! $subject) {
  137.         paraprint <<EOF;
  138. First of all, please provide a subject for the 
  139. message. It should be as a concise description of 
  140. the bug as is possible.
  141.  
  142. EOF
  143.         print "Subject: ";
  144.     
  145.         $subject = <>;
  146.         chop $subject;
  147.     
  148.         my($err)=0;
  149.         while( $subject =~ /^\s*$/ ) {
  150.             print "\nPlease enter a subject: ";
  151.             $subject = <>;
  152.             chop $subject;
  153.             if($err++>5) {
  154.                 die "Aborting.\n";
  155.             }
  156.         }
  157.     }
  158.     
  159.  
  160.     # Prompt for return address, if needed
  161.     if( !$from) {
  162.  
  163.         # Try and guess return address
  164.         my($domain);
  165.         
  166.         if($::HaveUtil) {
  167.             $domain = Mail::Util::maildomain();
  168.         } elsif ($Is_VMS) {
  169.             require Sys::Hostname;
  170.             $domain = Sys::Hostname::hostname();
  171.         } else {
  172.             $domain = `hostname`.".".`domainname`;
  173.             $domain =~ s/[\r\n]+//g;
  174.         }
  175.         
  176.         my($guess);
  177.                          
  178.             if( !$domain) {
  179.                 $guess = "";
  180.             } elsif ($Is_VMS && !$::Config{'d_has_sockets'}) { 
  181.                 $guess = "$domain\:\:$me";
  182.             } else {
  183.                 $guess = "$me\@$domain" if $domain;
  184.                 $guess = "$me\@unknown.addresss" unless $domain;
  185.             }
  186.             
  187.         $guess = $ENV{'REPLYTO'} if defined($ENV{'REPLYTO'});
  188.         $guess = $ENV{"REPLY-TO"} if defined($ENV{'REPLY-TO'});
  189.     
  190.         if( $guess ) {
  191.             paraprint <<EOF;
  192.  
  193.  
  194. Your e-mail address will be useful if you need to be contacted. If the
  195. default shown is not your full internet e-mail address, please correct it.
  196.  
  197. EOF
  198.         } else {
  199.             paraprint <<EOF;
  200.  
  201. So that you may be contacted if necessary, please enter 
  202. your full internet e-mail address here.
  203.  
  204. EOF
  205.         }
  206.         print "Your address [$guess]: ";
  207.     
  208.         $from = <>;
  209.         chop $from;
  210.     
  211.         if($from eq "") { $from = $guess }
  212.     
  213.     }
  214.     
  215.     #if( $from =~ /^(.*)\@(.*)$/ ) {
  216.     #    $mailname = $1;
  217.     #    $maildomain = $2;
  218.     #}
  219.  
  220.     if( $from eq $cc or $me eq $cc ) {
  221.         # Try not to copy ourselves
  222.         $cc = "yourself";
  223.     }
  224.  
  225.  
  226.     # Prompt for administrator address, unless an override was given
  227.     if( !$::opt_C and !$::opt_c ) {
  228.         paraprint <<EOF;
  229.  
  230.  
  231. A copy of this report can be sent to your local
  232. perl administrator. If the address is wrong, please 
  233. correct it, or enter 'none' or 'yourself' to not send
  234. a copy.
  235.  
  236. EOF
  237.  
  238.         print "Local perl administrator [$cc]: ";
  239.     
  240.         my($entry) = scalar(<>);
  241.         chop $entry;
  242.     
  243.         if($entry ne "") {
  244.             $cc = $entry;
  245.             if($me eq $cc) { $cc = "" }
  246.         }
  247.     
  248.     }
  249.  
  250.     if($cc =~ /^(none|yourself|me|myself|ourselves)$/i) { $cc = "" }
  251.  
  252.     $andcc = " and $cc" if $cc;
  253.  
  254.  
  255.     # Prompt for editor, if no override is given
  256.     if(! $::opt_e and ! $::opt_f and ! $::opt_b) {
  257.         paraprint <<EOF;
  258.  
  259.  
  260. Now you need to supply the bug report. Try to make
  261. the report concise but descriptive. Include any 
  262. relevant detail. Some information about your local
  263. perl configuration will automatically be included 
  264. at the end of the report. 
  265.  
  266. You will probably want to use an editor to enter
  267. the report. If "$ed" is the editor you want
  268. to use, then just press Enter, otherwise type in
  269. the name of the editor you would like to use.
  270.  
  271. If you would like to use a prepared file, type
  272. "file", and you will be asked for the filename.
  273.  
  274. EOF
  275.  
  276.         print "Editor [$ed]: ";
  277.     
  278.         my($entry) =scalar(<>);
  279.         chop $entry;
  280.     
  281.         if($entry ne "") {
  282.             $ed = $entry;
  283.         } 
  284.     }
  285.  
  286.  
  287.     # Generate scratch file to edit report in
  288.     
  289.     {
  290.     my($dir) = $Is_VMS ? 'sys$scratch:' : '/tmp/';
  291.     $filename = "bugrep0$$";
  292.     $filename++ while -e "$dir$filename";
  293.     $filename = "$dir$filename";
  294.     }
  295.     
  296.     
  297.     # Prompt for file to read report from, if needed
  298.     
  299.     if( $ed eq "file" and ! $file) {
  300.         paraprint <<EOF;
  301.  
  302.  
  303. What is the name of the file that contains your report?
  304.  
  305. EOF
  306.  
  307.         print "Filename: ";
  308.     
  309.         my($entry) = scalar(<>);
  310.         chop($entry);
  311.  
  312.         if(!-f $entry or !-r $entry) {
  313.             print "\n\nUnable to read from `$entry'.\nExiting.\n";
  314.             exit;
  315.         }
  316.         $file = $entry;
  317.  
  318.     }
  319.  
  320.  
  321.     # Generate report
  322.  
  323.     open(REP,">$filename");
  324.  
  325.     print REP <<EOF;
  326. This is a bug report for perl from $from,
  327. generated with the help of perlbug $Version running under perl $].
  328.  
  329. EOF
  330.  
  331.     if($body) {
  332.         print REP $body;
  333.     } elsif($file) {
  334.         open(F,"<$file") or die "Unable to read report file: $!\n";
  335.         while(<F>) {
  336.         print REP $_
  337.         }
  338.         close(F);
  339.     } else {
  340.         print REP "[Please enter your report here]\n";
  341.     }
  342.     
  343.     Dump(*REP);
  344.     close(REP);
  345.  
  346. }
  347.  
  348. sub Dump {
  349.     local(*OUT) = @_;
  350.     
  351.     print OUT <<EOF;
  352.  
  353.  
  354.  
  355. Site configuration information for perl $]:
  356.  
  357. EOF
  358.  
  359.     if( $::Config{cf_by} and $::Config{cf_time}) {
  360.         print OUT "Configured by $::Config{cf_by} at $::Config{cf_time}.\n\n";
  361.     }
  362.  
  363.     print OUT Config::myconfig;
  364.  
  365.     if($verbose) {
  366.         print OUT "\nComplete configuration data for perl $]:\n\n";
  367.         my($value);
  368.         foreach (sort keys %::Config) {
  369.             $value = $::Config{$_};
  370.             $value =~ s/'/\\'/g;
  371.             print OUT "$_='$value'\n";
  372.         }
  373.     }
  374. }
  375.  
  376. sub Edit {
  377.     # Edit the report
  378.     
  379. tryagain:    
  380.     if(!$file and !$body) {
  381.         my($sts) = system("$ed $filename");
  382.         if( $Is_VMS ? !($sts & 1) : $sts ) {
  383.             #print "\nUnable to run editor!\n";
  384.             paraprint <<EOF;
  385.  
  386. The editor you chose (`$ed') could apparently not be run!
  387. Did you mistype the name of your editor? If so, please
  388. correct it here, otherwise just press Enter. 
  389.  
  390. EOF
  391.             print "Editor [$ed]: ";
  392.         
  393.             my($entry) =scalar(<>);
  394.             chop $entry;
  395.     
  396.             if($entry ne "") {
  397.                 $ed = $entry;
  398.                 goto tryagain;
  399.             } else {
  400.             
  401.             paraprint <