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