Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100755 517 lines (406 sloc) 13.36 kb
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
1 #!/usr/bin/env perl
e79a97a - cvs $Id$ tag
Jerome Quelin authored
2 #
3 # $Id$
4 #
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
5
6 eval 'exec perl -w -S $0 ${1+"$@"}'
7 if $running_under_some_shell;
8
9 #
10 # This utility borrows heavily from perlbug.
11 #
12
13 use Config;
14 use File::Spec;
15 use Getopt::Std;
16
e9d08a2 - version 0.0.3
Jerome Quelin authored
17 my $VERSION = "0.0.3";
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
18
19 my %std_to =
e79a97a - cvs $Id$ tag
Jerome Quelin authored
20 ( bug => 'parrotbug@parrotcode.org',
21 ok => 'parrotstatus-ok@parrotcode.org',
22 nok => 'parrotstatus-nok@parrotcode.org'
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
23 );
24
514b65a - no need for storing updir
Jerome Quelin authored
25 my $parrotdir = File::Spec->curdir();
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
26
6861224 - version 0.0.2
Jerome Quelin authored
27 my ( $user, $domain, $editor, $use_file );
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
28 my ( $to, $cc, $from, $subject, $msgid, $body );
29 my ( $category, $severity );
514b65a - no need for storing updir
Jerome Quelin authored
30 my ( $is_linux, $is_macos, $is_mswin32, $is_os2, $is_vms );
9286c79 - test for Mail::Util done where needed, not in BEGIN
Jerome Quelin authored
31 my ( $parrot_version, $parrot_myconfig ) ;
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
32
33
4b46d98 - guessing return address
Jerome Quelin authored
34 #------------------------------------------------------------#
35 # Main program. #
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
36 BEGIN {
37 eval "use Mail::Send;";
38 $have_send = ($@ eq "");
39 }
40
41 init();
42 help() if $opt_h;
43 version() if $opt_V;
6861224 - version 0.0.2
Jerome Quelin authored
44 explain_parrotbug();
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
45 query_info();
514b65a - no need for storing updir
Jerome Quelin authored
46
47 die "work in progress... nothing ready yet!\n";
48
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
49 edit_info();
50 ask_for_action();
51 send_msg();
52 exit;
53
54
55
56
4b46d98 - guessing return address
Jerome Quelin authored
57 #------------------------------------------------------------#
ab940f6 - reorganizing subs
Jerome Quelin authored
58 # Info subs. #
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
59
ab940f6 - reorganizing subs
Jerome Quelin authored
60 #----
6861224 - version 0.0.2
Jerome Quelin authored
61 # Explain what parrotbug is.
62 sub explain_parrotbug {
63 print <<EOF;
64
65 This program provides an easy way to create a message reporting a bug
66 in parrot, and e-mail it to parrot developpers.
67
68 It is *NOT* intended for:
69 - sending test messages,
70 - or reporting bugs in languages targetting parrot,
71 - or reporting bugs in some library bindings for parrot,
72 - or simply verifying that parrot works.
73
74 It is *ONLY* a mean of reporting verifiable problems with the core
75 parrot distribution, and any solutions to such problems, to parrot
76 developpers.
77
78 If you're just looking for help with parrot, subscribe to the parrot
79 mailing list, perl6-internals<at>perl.org.
80
81
82
83 EOF
84 #'
85 }
86
87
ab940f6 - reorganizing subs
Jerome Quelin authored
88 #----
514b65a - no need for storing updir
Jerome Quelin authored
89 # Print synopsis + help message and exit.
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
90 sub help {
91 print <<EOF;
92
93 A program to help generate bug reports about parrot, and mail them.
94
95 Usage:
96
e09ecda - can provide an -b switch with a nok flag
Jerome Quelin authored
97 $0 [-s subject] [-b body] [-f inputfile] [-r returnaddress] [-A]
960e359 - process -e (editor) flag
Jerome Quelin authored
98 [-e editor] [-ok|-nok]
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
99 $0 {-h|-V}
100
101 Options:
e09ecda - can provide an -b switch with a nok flag
Jerome Quelin authored
102 -A Don't send a bug received acknowledgement to the return address.
103 -b Body of the report. If not included on the command line, or
104 in a file with -f, you will get a chance to edit the message.
960e359 - process -e (editor) flag
Jerome Quelin authored
105 -e Editor to use.
e09ecda - can provide an -b switch with a nok flag
Jerome Quelin authored
106 -f File containing the body of the report. Use this to
107 quickly send a prepared message.
108 -h Print this help message and exit.
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
109 -nok Report unsuccessful build on this system to parrot developpers
110 -ok Report successful build on this system to parrot developpers
111 Only use -ok if *everything* was ok: if there were *any* problems
112 at all, use -nok.
e09ecda - can provide an -b switch with a nok flag
Jerome Quelin authored
113 -r Your return address. The program will ask you to confirm
114 this if you don't give it here.
115 -s Subject to include with the message. You will be prompted
116 if you don't supply one on the command line.
117 -V Print version information and exit.
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
118
119 EOF
514b65a - no need for storing updir
Jerome Quelin authored
120 #'
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
121 exit;
122 }
123
ab940f6 - reorganizing subs
Jerome Quelin authored
124
125 #----
126 # Print version information (of the parrotbug program) and exit.
127 sub version {
128 print <<"EOF";
129
130 This is $0, version $VERSION.
131
132 EOF
133 exit;
134 }
135
136
137
138
139 #------------------------------------------------------------#
140 # Utils subs. #
141
142 #----
143 # Generate random filename to edit report.
144 sub generate_filename {
145 my $dir = File::Spec->tmpdir();
146 my $filename = "bugrep0$$";
147 $filename++ while -e File::Spec->catfile($dir, $filename);
148 $filename = File::Spec->catfile($dir, $filename);
149 return $filename;
150 }
151
152
153 #----
154 # Check whether a subject is trivial. A subject is not considered
155 # trivial if it's an ok or a nok report.
156 # Return 1 if trivial, 0 otherwise (subject acceptable).
157 sub trivial_subject {
158 my $subject = shift;
159
160 return 0 if $opt_o || $opt_f;
161 if ( $subject =~
162 /^(y(es)?|no?|help|parrot( (bug|problem))?|bug|problem)$/i ||
163 length($subject) < 4 ||
164 $subject !~ /\s/ ) {
165 return 1;
166 } else {
167 return 0;
168 }
169 }
170
171
172
173
174 #------------------------------------------------------------#
175 # Init subs. #
176
177 #----
514b65a - no need for storing updir
Jerome Quelin authored
178 # Initialize prog:
179 # - get parrot information
180 # - process options
181 # - create the message information (subject, to, body, etc.)
182 # depending on the type of report (ok, nok or bug report)
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
183 sub init {
184 $is_linux = lc($^O) eq 'linux';
185 $is_macos = $^O eq 'MacOS';
514b65a - no need for storing updir
Jerome Quelin authored
186 $is_mswin32 = $^O eq 'MSWin32';
187 $is_os2 = $^O eq 'os2';
188 $is_vms = $^O eq 'VMS';
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
189
9286c79 - test for Mail::Util done where needed, not in BEGIN
Jerome Quelin authored
190 ##
191 ## Fetch Parrot information.
192 ##
193
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
194 # Get parrot version.
9286c79 - test for Mail::Util done where needed, not in BEGIN
Jerome Quelin authored
195 # There will always be an up-to-date $parrot/VERSION
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
196 my $filename = File::Spec->catfile($parrotdir, "VERSION");
197 open(VERSION, "<$filename") or die "Cannot open '$filename': $!";
198 $parrot_version = <VERSION>;
960e359 - process -e (editor) flag
Jerome Quelin authored
199 chomp $parrot_version;
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
200 close(VERSION) or die "Cannot close '$filename': $!";
201
9286c79 - test for Mail::Util done where needed, not in BEGIN
Jerome Quelin authored
202 # Get parrot configuration, stored in $parrot/myconfig
203 $filename = File::Spec->catfile($parrotdir, "myconfig");
204 open(MYCONFIG, "<$filename") or die "Cannot open '$filename': $!";
205 {
206 local $/;
207 $parrot_myconfig = <MYCONFIG>;
208 }
209 close(MYCONFIG) or die "Cannot close '$filename': $!";
210
211
212 ##
213 ## Process options.
214 ##
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
215 @ARGV = split m/\s+/,
960e359 - process -e (editor) flag
Jerome Quelin authored
216 MacPerl::Ask("Provide command-line args here (-h for help):")
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
217 if $is_macos && $MacPerl::Version =~ /App/;
960e359 - process -e (editor) flag
Jerome Quelin authored
218 help() unless getopts("AVhb:e:f:n:o:r:s:");
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
219
220
9286c79 - test for Mail::Util done where needed, not in BEGIN
Jerome Quelin authored
221 ##
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
222 ## Report to be sent.
9286c79 - test for Mail::Util done where needed, not in BEGIN
Jerome Quelin authored
223 ##
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
224 sw: {
225 opt_o: {
226 last opt_o unless defined $opt_o;
227 help() unless $opt_o eq "k";
228
229 # This is an ok report, woohoo!
230 $to = $std_to{ok};
231 $subject = "OK: parrot $parrot_version "
232 . "on $Config{archname} $Config{osvers}";
233 $body = "Parrot reported to build OK on this system.\n";
234 $category = "install";
235 $severity = "none";
236 last sw;
237 };
238
e09ecda - can provide an -b switch with a nok flag
Jerome Quelin authored
239 # Ok reports do not need body, but nok and bug reports do need
240 # a body. It can be done with either -f or -b flag.
241 if ( $opt_f ) {
6861224 - version 0.0.2
Jerome Quelin authored
242 $use_file = 1;
e09ecda - can provide an -b switch with a nok flag
Jerome Quelin authored
243 } else {
244 # No file provided...
6861224 - version 0.0.2
Jerome Quelin authored
245 $use_file = 0;
e09ecda - can provide an -b switch with a nok flag
Jerome Quelin authored
246 $body = $opt_b || "";
247 }
248
249
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
250 opt_n: {
251 last opt_n unless defined $opt_n;
252 help() unless $opt_n eq "ok";
253
254 # This a nok report, how sad... :-(
255 $to = $std_to{nok};
e79a97a - cvs $Id$ tag
Jerome Quelin authored
256 $subject = "Not OK: parrot $parrot_version "
257 . "on $Config{archname} $Config{osvers}";
258 $category = "install";
259 $severity = "none";
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
260 last sw;
261 };
262
e79a97a - cvs $Id$ tag
Jerome Quelin authored
263 # Neither an ok nor a nok.
264 $to = $std_to{bug};
265 $subject = $opt_s || "";
266 $category = "";
9286c79 - test for Mail::Util done where needed, not in BEGIN
Jerome Quelin authored
267 $severity = "";
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
268 };
269
270
9286c79 - test for Mail::Util done where needed, not in BEGIN
Jerome Quelin authored
271 ##
960e359 - process -e (editor) flag
Jerome Quelin authored
272 ## User information.
9286c79 - test for Mail::Util done where needed, not in BEGIN
Jerome Quelin authored
273 ##
274
514b65a - no need for storing updir
Jerome Quelin authored
275 # Username.
960e359 - process -e (editor) flag
Jerome Quelin authored
276 $user = $is_mswin32 ? $ENV{USERNAME}
277 : $is_os2 ? $ENV{USER} || $ENV{LOGNAME}
278 : $is_macos ? $ENV{USER}
514b65a - no need for storing updir
Jerome Quelin authored
279 : eval { getpwuid($<) }; # May be missing
280
9286c79 - test for Mail::Util done where needed, not in BEGIN
Jerome Quelin authored
281 # User address, used in message and in Reply-To header.
282 $from = $opt_r || "";
283
960e359 - process -e (editor) flag
Jerome Quelin authored
284 # Editor
285 $editor = $opt_e || $ENV{VISUAL} || $ENV{EDITOR} || $ENV{EDIT}
286 || ( $is_vms && "edit/tpu" )
287 || ( $is_mswin32 && "notepad" )
288 || ( $is_macos && "" )
289 || "vi";
290
291
292 ##
293 ## Mail information.
294 ##
295
9286c79 - test for Mail::Util done where needed, not in BEGIN
Jerome Quelin authored
296 # Message-Id.
297 eval "use Mail::Util;";
298 if ( $@ eq "" ) {
299 $domain = Mail::Util::maildomain();
300 } elsif ($is_mswin32) {
960e359 - process -e (editor) flag
Jerome Quelin authored
301 $domain = $ENV{USERDOMAIN};
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
302 } else {
9286c79 - test for Mail::Util done where needed, not in BEGIN
Jerome Quelin authored
303 require Sys::Hostname;
304 $domain = Sys::Hostname::hostname();
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
305 }
9286c79 - test for Mail::Util done where needed, not in BEGIN
Jerome Quelin authored
306 $msgid = "<parrotbug_$VERSION_$$_".time."\@$domain>";
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
307 }
308
309
ab940f6 - reorganizing subs
Jerome Quelin authored
310
311 #------------------------------------------------------------#
312 # Querying subs. #
313
314 #----
514b65a - no need for storing updir
Jerome Quelin authored
315 # Query missing information in order to have a complete report.
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
316 sub query_info {
6861224 - version 0.0.2
Jerome Quelin authored
317 $subject = "" if trivial_subject( $subject );
e9d08a2 - version 0.0.3
Jerome Quelin authored
318 ask_for_subject() unless $subject;
319 ask_for_alternative
320 ( "category", [ qw[ core docs install library utilities ] ],
321 "core" ) unless $category;
322 ask_for_alternative
323 ( "severity", [ qw[ critical high medium low wishlist none ] ],
324 "low" ) unless $severity;
325 ask_for_return_address() unless $from;
326 ask_for_body() unless $use_file || $body;
327 }
328
329
330 #----
331 # Prompt for alternatives from a set of choices.
332 # Provide:
333 # - the name of alternative
334 # - the choices (array ref)
335 # - the default answer
336 # Return the lowercased alternative chosen.
337 # Die if more than 5 wrong answers.
338 sub ask_for_alternative {
339 my ( $what, $choices, $default ) = @_;
340
341 print <<EOF;
342 Please pick a $what from the following:
343 @{$choices}
344
345 EOF
346
347 my $alt;
348 my $err = 0;
349 do {
350 die "Invalid $name: aborting.\n" if $err++ > 5;
351 print "Please enter a $what [$default]: ";
352 $alt = <>;
353 chomp $alt;
354 $alt = $default if $alt =~ /^\s*$/;
355 } until ( ($alt) = grep /^$alt/i, @$choices );
356
357 print "\n\n\n";
358 return lc $alt;
6861224 - version 0.0.2
Jerome Quelin authored
359 }
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
360
ab940f6 - reorganizing subs
Jerome Quelin authored
361
362 #----
6861224 - version 0.0.2
Jerome Quelin authored
363 # Prompt for body, through an external editor.
ab940f6 - reorganizing subs
Jerome Quelin authored
364 sub ask_for_body {
6861224 - version 0.0.2
Jerome Quelin authored
365 print <<EOF;
366 Now you need to supply the bug report. Try to make the report concise
367 but descriptive. Include any relevant detail. If you are reporting
368 something that does not work as you think it should, please try to
369 include example of both the actual result, and what you expected.
960e359 - process -e (editor) flag
Jerome Quelin authored
370
6861224 - version 0.0.2
Jerome Quelin authored
371 Some information about your local parrot configuration will
372 automatically be included at the end of the report. If you are using
373 any unusual version of parrot, please try and confirm exactly which
374 versions are relevant.
960e359 - process -e (editor) flag
Jerome Quelin authored
375
514b65a - no need for storing updir
Jerome Quelin authored
376 EOF
377
6861224 - version 0.0.2
Jerome Quelin authored
378 # Prompt for editor to use if none supplied.
e9d08a2 - version 0.0.3
Jerome Quelin authored
379 ask_for_editor(<<EOF) unless $opt_e;
6861224 - version 0.0.2
Jerome Quelin authored
380 You will probably want to use an editor to enter the report. If the
381 default editor proposed below is the editor you want to use, then just
382 press the 'Enter' key, otherwise type in the name of the editor you
383 would like to use.
514b65a - no need for storing updir
Jerome Quelin authored
384 EOF
385
386
6861224 - version 0.0.2
Jerome Quelin authored
387 }
514b65a - no need for storing updir
Jerome Quelin authored
388
ab940f6 - reorganizing subs
Jerome Quelin authored
389
390 #----
6861224 - version 0.0.2
Jerome Quelin authored
391 # Prompt for editor to use.
ab940f6 - reorganizing subs
Jerome Quelin authored
392 sub ask_for_editor {
6861224 - version 0.0.2
Jerome Quelin authored
393 print shift() . "Editor [$editor]: ";
394 my $entry = <>;
395 chomp $entry;
396 $editor = $entry if $entry ne "";
397 }
398
ab940f6 - reorganizing subs
Jerome Quelin authored
399
400 #----
6861224 - version 0.0.2
Jerome Quelin authored
401 # Prompt for return address.
ab940f6 - reorganizing subs
Jerome Quelin authored
402 sub ask_for_return_address {
6861224 - version 0.0.2
Jerome Quelin authored
403 print <<EOF;
4b46d98 - guessing return address
Jerome Quelin authored
404 Your e-mail address will be useful if you need to be contacted. If the
405 default shown below is not your full internet e-mail address, please
406 correct it.
407 EOF
6861224 - version 0.0.2
Jerome Quelin authored
408
409 # Try and guess return address
410 my $guess;
411 if ( $is_macos ) {
412 require Mac::InternetConfig;
413 $guess = $Mac::InternetConfig::InternetConfig{
414 Mac::InternetConfig::kICEmail()
415 };
416 } else {
417 $guess = $ENV{REPLY-TO} || $ENV{REPLYTO} || "";
418 }
4b46d98 - guessing return address
Jerome Quelin authored
419
6861224 - version 0.0.2
Jerome Quelin authored
420 if ( ! $guess ) {
421 # Use $domain if we can.
422 if ( $domain ) {
423 $guess = $is_vms && !$Config{d_socket} ?
424 "$domain\:\:$user" : "$user\@$domain";
4b46d98 - guessing return address
Jerome Quelin authored
425 }
960e359 - process -e (editor) flag
Jerome Quelin authored
426 }
427
6861224 - version 0.0.2
Jerome Quelin authored
428 # Verify our guess.
429 print "Your address [$guess]: ";
430 $from = <>;
431 chomp $from;
432 $from = $guess if $from eq "";
433 print "\n\n\n";
434 }
960e359 - process -e (editor) flag
Jerome Quelin authored
435
436
ab940f6 - reorganizing subs
Jerome Quelin authored
437 #----
6861224 - version 0.0.2
Jerome Quelin authored
438 # Prompt for subject of message.
ab940f6 - reorganizing subs
Jerome Quelin authored
439 sub ask_for_subject {
6861224 - version 0.0.2
Jerome Quelin authored
440 print <<EOF;
441 First of all, please provide a subject for the message. It should be a
442 concise description of the bug or problem. "parrot bug" or "parrot
443 problem" is not a concise description.
960e359 - process -e (editor) flag
Jerome Quelin authored
444
445 EOF
446
6861224 - version 0.0.2
Jerome Quelin authored
447 my $err = 0;
448 do {
449 $err and print "\nThat doesn't look like a good subject. "
450 . "Please be more verbose.\n";
451 print "Subject: ";
452 $subject = <>;
453 chomp $subject;
454 die "Aborting.\n" if $err++ == 5;
455 } while ( trivial_subject($subject) );
456 print "\n\n\n";
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
457 }
458
ab940f6 - reorganizing subs
Jerome Quelin authored
459
460
461 #------------------------------------------------------------#
462 # Sending subs. #
463
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
464 sub send_msg {
465 # Message has been accepted for transmission -- Send the message
466 if ($outfile) {
467 open SENDMAIL, ">$outfile" or die "Couldn't open '$outfile': $!\n";
468 goto sendout;
469 }
470
471 # on linux certain mail implementations won't accept the subject
472 # as "~s subject" and thus the Subject header will be corrupted
473 # so don't use Mail::Send to be safe
474 if ($have_send && !$is_linux) {
475 my $msg = new Mail::Send Subject => $subject, To => $address;
476 $msg->add("Reply-To",$from) if $from;
477
478 $fh = $msg->open;
479 print $fh $body;
480 $fh->close;
481
482 print "\nMessage sent.\n";
483
484 } else {
485 my $sendmail = "";
486 for (qw(/usr/lib/sendmail /usr/sbin/sendmail /usr/ucblib/sendmail)) {
487 $sendmail = $_, last if -e $_;
488 }
489
490 die <<"EOF" if $sendmail eq "";
491 I am terribly sorry, but I cannot find sendmail, or a close
492 equivalent, and the perl package Mail::Send has not been installed, so
493 I can't send your bug report. We apologize for the inconvenience.
494
495 So you may attempt to find some way of sending your message, it has
496 been left in the file '$filename'.
497 EOF
514b65a - no need for storing updir
Jerome Quelin authored
498 # '
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
499 open(SENDMAIL, "|$sendmail -t -oi") || die "'|$sendmail -t -oi' failed: $!";
500
501 print SENDMAIL "To: $address\n";
502 print SENDMAIL "Subject: $subject\n";
503 print SENDMAIL "Reply-To: $from\n" if $from;
504 print SENDMAIL "Message-Id: $messageid\n" if $messageid;
505 print SENDMAIL "\n\n";
506 print SENDMAIL $body;
507
508 if (close(SENDMAIL)) {
509 printf "\nMessage sent.\n";
510 } else {
511 warn "\nSendmail returned status '", $? >> 8, "'\n";
512 }
513 }
514 }
515
ab940f6 - reorganizing subs
Jerome Quelin authored
516 __END__
Something went wrong with that request. Please try again.