Skip to content
This repository
Browse code

- version 0.3.1

- use of new set of flags
- use of global hash instead of global vars
- user is prompted for action


git-svn-id: https://svn.parrot.org/parrot/trunk@6069 d31e2699-5ff4-0310-a27c-f18f2fbe73fe
  • Loading branch information...
commit 42d74f6d2699fbc6ff3d6cd17598cd6bfbc1026c 1 parent 4a0f921
Jerome Quelin authored

Showing 1 changed file with 210 additions and 159 deletions. Show diff stats Hide diff stats

  1. +210 159 parrotbug
369 parrotbug
@@ -7,6 +7,7 @@
7 7 eval 'exec perl -w -S $0 ${1+"$@"}'
8 8 if $running_under_some_shell;
9 9
  10 +$^W = 1; # Set warnings;
10 11 use strict;
11 12
12 13 use Config;
@@ -14,8 +15,9 @@ use File::Spec;
14 15 use Getopt::Long;
15 16
16 17
17   -my $VERSION = "0.3.0";
  18 +my $VERSION = "0.3.1";
18 19
  20 +# These are the standard addresses for reporting bugs.
19 21 my %std_to =
20 22 ( bug => 'parrotbug@parrotcode.org',
21 23 ok => 'parrotstatus-ok@parrotcode.org',
@@ -23,13 +25,11 @@ my %std_to =
23 25 );
24 26
25 27 my $parrotdir = File::Spec->curdir();
26   -
27   -my %opts;
28   -my ( $user, $domain, $editor, $use_file );
29   -my ( $to, $cc, $from, $subject, $msgid, $body );
30   -my ( $category, $severity );
  28 +my ( %opts, %parrot, %report );
  29 +my ( $editor, $user, $domain, $msgid, $tmpfile );
31 30 my ( $is_linux, $is_macos, $is_mswin32, $is_os2, $is_vms );
32   -my ( $parrot_version, $parrot_myconfig ) ;
  31 +my @categories = qw[ core docs install library utilities ];
  32 +my @severities = qw[ critical high medium low wishlist none ];
33 33
34 34
35 35 #------------------------------------------------------------#
@@ -38,14 +38,14 @@ my ( $parrot_version, $parrot_myconfig ) ;
38 38 init();
39 39 help() if $opts{help};
40 40 version() if $opts{version};
41   -if ( $opts{dump} ) { dump_info(*STDOUT); exit; }
42   -explain_parrotbug();
43   -query_info();
44   -send_msg();
  41 +explain_parrotbug() unless $opts{quiet};
  42 +query_missing_info();
  43 +what_next();
45 44 exit;
46 45
47 46
48   -#Explain what C<parrotbug> is.
  47 +
  48 +# Explain what C<parrotbug> is.
49 49 sub explain_parrotbug {
50 50 print <<EOF;
51 51
@@ -68,61 +68,6 @@ mailing list, perl6-internals<at>perl.org.
68 68
69 69
70 70 EOF
71   -#'
72   -}
73   -
74   -
75   -#Print synopsis + help message and exit.
76   -sub help {
77   - print <<EOF;
78   -
79   -A program to help generate bug reports about parrot, and mail them.
80   -It is designed to be used interactively. Normally no arguments will
81   -be needed.
82   -
83   -Usage:
84   -
85   - $0 [-s subject] [-b body] [-f inputfile] [-r returnaddress] [-A]
86   - [-e editor] [-t address] ][-ok|-nok|-d]
87   - $0 {-h|-V}
88   -
89   -Simplest usage: run '$0', and follow the prompts.
90   -
91   -Options:
92   - -A Don't send a bug received acknowledgement to the return address.
93   - -b Body of the report. If not included on the command line, or
94   - in a file with -f, you will get a chance to edit the message.
95   - -d Dump mode. This prints out your configuration data, without mailing
96   - anything.
97   - -e Editor to use.
98   - -f File containing the body of the report. Use this to
99   - quickly send a prepared message.
100   - -h Print this help message and exit.
101   - -nok Report unsuccessful build on this system to parrot developpers
102   - -ok Report successful build on this system to parrot developpers
103   - Only use -ok if *everything* was ok: if there were *any* problems
104   - at all, use -nok.
105   - -r Your return address. The program will ask you to confirm
106   - this if you don't give it here.
107   - -s Subject to include with the message. You will be prompted
108   - if you don't supply one on the command line.
109   - -t Test mode, so one can provide an address to send reports to.
110   - -V Print version information and exit.
111   -
112   -EOF
113   -#'
114   - exit;
115   -}
116   -
117   -
118   -# Print version information (of the parrotbug program) and exit.
119   -sub version {
120   - print <<"EOF";
121   -
122   -This is $0, version $VERSION.
123   -
124   -EOF
125   - exit;
126 71 }
127 72
128 73
@@ -184,8 +129,8 @@ sub init {
184 129 # There will always be an up-to-date $parrot/VERSION
185 130 my $filename = File::Spec->catfile($parrotdir, "VERSION");
186 131 open(VERSION, "<$filename") or die "Cannot open '$filename': $!";
187   - $parrot_version = <VERSION>;
188   - chomp $parrot_version;
  132 + $parrot{version} = <VERSION>;
  133 + chomp $parrot{version};
189 134 close(VERSION) or die "Cannot close '$filename': $!";
190 135
191 136 # Get parrot configuration, stored in $parrot/myconfig
@@ -193,7 +138,7 @@ sub init {
193 138 open(MYCONFIG, "<$filename") or die "Cannot open '$filename': $!";
194 139 {
195 140 local $/;
196   - $parrot_myconfig = <MYCONFIG>;
  141 + $parrot{myconfig} = <MYCONFIG>;
197 142 }
198 143 close(MYCONFIG) or die "Cannot close '$filename': $!";
199 144
@@ -207,10 +152,12 @@ sub init {
207 152 Getopt::Long::Configure("no_bundling", "no_ignore_case", "auto_abbrev");
208 153 help() unless GetOptions
209 154 ( \%opts,
210   - "send|S", "dump|D", "help|h", "version|V",
211   - "from|f=s", "to|test|t=s", "subject|s=s",
212   - "input|i=s", "output|o=s", "ok", "nok", "help|h",
213   - "ack!" );
  155 + "help|h", "version|V",
  156 + "send", "dump", "save",
  157 + "from|f=s", "to|test|t=s", "editor|e=s",
  158 + "subject|s=s", "category|C=s", "severity|S=s",
  159 + "input|input-file|i=s", "output|output-file|o=s",
  160 + "ok", "nok", "ack!", "quiet|q!" );
214 161
215 162 ##
216 163 ## Report to be sent.
@@ -220,23 +167,27 @@ sub init {
220 167 last ok_report unless defined $opts{ok};
221 168
222 169 # This is an ok report, woohoo!
223   - $to = $std_to{ok};
224   - $subject = "OK: parrot $parrot_version "
  170 + $report{to} = $std_to{ok};
  171 + $report{subject} = "OK: parrot $parrot{version} "
225 172 . "on $Config{archname} $Config{osvers}";
226   - $body = "Parrot reported to build OK on this system.\n";
227   - $category = "install";
228   - $severity = "none";
  173 + $report{body} = "Parrot reported to build OK on this system.\n";
  174 + $report{category} = "install";
  175 + $report{severity} = "none";
  176 + $report{body} = "";
229 177 last sw;
230 178 };
231 179
232 180 # Ok reports do not need body, but nok and bug reports do need
233   - # a body. It can be done with either -f or -b flag.
  181 + # a body.
234 182 if ( $opts{input} ) {
235   - $use_file = 1;
  183 + # Report was pre-written, slurp it.
  184 + open BODY, "<$opts{input}" or die "Can't open '$opts{input}': $!";
  185 + local $/;
  186 + $report{body} = <BODY>;
  187 + close BODY or die "Can't close '$opts{input}': $!";
236 188 } else {
237 189 # No file provided...
238   - $use_file = 0;
239   - $body = "";
  190 + $report{body} = "";
240 191 }
241 192
242 193
@@ -244,23 +195,23 @@ sub init {
244 195 last nok_report unless defined $opts{nok};
245 196
246 197 # This a nok report, how sad... :-(
247   - $to = $std_to{nok};
248   - $subject = "Not OK: parrot $parrot_version "
  198 + $report{to} = $std_to{nok};
  199 + $report{subject} = "Not OK: parrot $parrot{version} "
249 200 . "on $Config{archname} $Config{osvers}";
250   - $category = "install";
251   - $severity = "none";
  201 + $report{category} = "install";
  202 + $report{severity} = "none";
252 203 last sw;
253 204 };
254 205
255 206 # Neither an ok nor a nok.
256   - $to = $std_to{bug};
257   - $subject = $opts{s} || "";
258   - $category = "";
259   - $severity = "";
  207 + $report{to} = $std_to{bug};
  208 + $report{subject} = $opts{subject} || "";
  209 + $report{category} = $opts{category} || "";
  210 + $report{severity} = $opts{severity} || "";
260 211 };
261 212
262 213 # Test message, shortcuting recipent.
263   - $to = $opts{to} if $opts{to};
  214 + $report{to} = $opts{to} if $opts{to};
264 215
265 216 ##
266 217 ## User information.
@@ -273,14 +224,14 @@ sub init {
273 224 : eval { getpwuid($<) }; # May be missing
274 225
275 226 # User address, used in message and in Reply-To header.
276   - $from = $opts{from} || "";
  227 + $report{from} = $opts{from} || "";
277 228
278 229 # Editor
279 230 $editor = $ENV{VISUAL} || $ENV{EDITOR} || $ENV{EDIT}
280   - || ( $is_vms && "edit/tpu" )
281   - || ( $is_mswin32 && "notepad" )
282   - || ( $is_macos && "" )
283   - || "vi";
  231 + || ( $is_vms && "edit/tpu" )
  232 + || ( $is_mswin32 && "notepad" )
  233 + || ( $is_macos && "" )
  234 + || "vi";
284 235
285 236
286 237 ##
@@ -306,23 +257,22 @@ sub init {
306 257 # Querying subs. #
307 258
308 259 # Query missing information in order to have a complete report.
309   -sub query_info {
310   - $subject = "" if trivial_subject( $subject );
311   - ask_for_subject() unless $subject;
312   - ask_for_alternative
313   - ( "category", [ qw[ core docs install library utilities ] ],
314   - "core" ) unless $category;
315   - ask_for_alternative
316   - ( "severity", [ qw[ critical high medium low wishlist none ] ],
317   - "low" ) unless $severity;
318   - ask_for_return_address() unless $from;
319   - ask_for_body() unless $use_file || $body;
  260 +sub query_missing_info {
  261 + $report{subject} = "" if trivial_subject( $report{subject} );
  262 + $report{subject} = ask_for_subject() unless $report{subject};
  263 + $report{category} = ask_for_alternative( "category", \@categories)
  264 + unless $report{category};
  265 + $report{severity} = ask_for_alternative( "severity", \@severities)
  266 + unless $report{severity};
  267 + $report{from} = ask_for_return_address() unless $report{from};
  268 + $report{body} = ask_for_body() unless $report{body};
320 269 }
321 270
  271 +
322 272 # Prompt for alternatives from a set of choices.
323 273 #
324 274 # The arguments are: the name of alternative, the choices (as an array
325   -# ref), and the default answer.
  275 +# ref), and the default answer. (first element if undef)
326 276 #
327 277 # Return the lowercased alternative chosen.
328 278 #
@@ -336,12 +286,13 @@ Please pick a $what from the following:
336 286
337 287 EOF
338 288
  289 + $default ||= $choices->[0];
339 290 my $alt;
340 291 my $err = 0;
341 292 do {
342 293 die "Invalid $alt: aborting.\n" if $err++ > 5;
343 294 print "Please enter a $what [$default]: ";
344   - $alt = <>;
  295 + $alt = <STDIN>;
345 296 chomp $alt;
346 297 $alt = $default if $alt =~ /^\s*$/;
347 298 } until ( ($alt) = grep /^$alt/i, @$choices );
@@ -351,7 +302,7 @@ EOF
351 302 }
352 303
353 304
354   -# Prompt for body, through an external editor.
  305 +# Prompt for a body, through an external editor.
355 306 sub ask_for_body {
356 307 print <<EOF;
357 308 Now you need to supply the bug report. Try to make the report concise
@@ -366,11 +317,12 @@ versions are relevant.
366 317
367 318 EOF
368 319
  320 + print "Press 'Enter' to continue...\n";
  321 + scalar <STDIN>;
  322 +
369 323 # Prompt for editor to use if none supplied.
370 324 if ( $opts{editor} ) {
371 325 $editor = $opts{editor};
372   - print "Press 'Enter' to continue...\n";
373   - scalar <>;
374 326
375 327 } else {
376 328 ask_for_editor(<<EOF) unless $opts{editor};
@@ -382,21 +334,40 @@ EOF
382 334 }
383 335
384 336 # Launch editor.
385   - $opts{input} = generate_filename();
386   - edit_bug_report( $opts{input} );
  337 + $tmpfile = generate_filename();
  338 + my $body = "";
  339 + my $err = 0;
  340 + do {
  341 + edit_bug_report( $tmpfile );
  342 + # Slurp bug report.
  343 + open BODY, "<$tmpfile" or die "Can't open '$tmpfile': $!";
  344 + {
  345 + local $/;
  346 + $body = <BODY>;
  347 + }
  348 + close BODY or die "Can't close '$tmpfile': $!";
  349 + unless ( $body ) {
  350 + print "\nYou provided an empty bug report!\n";
  351 + print "Press 'Enter' to continue...\n";
  352 + scalar <STDIN>;
  353 + }
  354 + die "Aborting.\n" if $err++ == 5;
  355 + } until ( $body );
  356 +
  357 + return $body;
387 358 }
388 359
389 360
390 361 # Prompt for editor to use.
391 362 sub ask_for_editor {
392 363 print shift() . "Editor [$editor]: ";
393   - my $entry = <>;
  364 + my $entry = <STDIN>;
394 365 chomp $entry;
395 366 $editor = $entry if $entry ne "";
396 367 }
397 368
398 369
399   -# Prompt for return address.
  370 +# Prompt for return address, return it.
400 371 sub ask_for_return_address {
401 372 print <<EOF;
402 373 Your e-mail address will be useful if you need to be contacted. If the
@@ -405,7 +376,7 @@ correct it.
405 376 EOF
406 377
407 378 # Try and guess return address
408   - my $guess;
  379 + my ($from, $guess);
409 380 if ( $is_macos ) {
410 381 require Mac::InternetConfig;
411 382 $guess = $Mac::InternetConfig::InternetConfig{
@@ -425,14 +396,19 @@ EOF
425 396
426 397 # Verify our guess.
427 398 print "Your address [$guess]: ";
428   - $from = <>;
  399 + $from = <STDIN>;
429 400 chomp $from;
430 401 $from = $guess if $from eq "";
431 402 print "\n\n\n";
  403 + return $from;
432 404 }
433 405
434 406
435 407 # Prompt for subject of message.
  408 +#
  409 +# Return the subject chosen.
  410 +#
  411 +# Die if more than 5 wrong subjects.
436 412 sub ask_for_subject {
437 413 print <<EOF;
438 414 First of all, please provide a subject for the message. It should be a
@@ -441,16 +417,18 @@ problem" is not a concise description.
441 417
442 418 EOF
443 419
  420 + my $subject;
444 421 my $err = 0;
445 422 do {
446 423 $err and print "\nThat doesn't look like a good subject. "
447 424 . "Please be more verbose.\n";
448 425 print "Subject: ";
449   - $subject = <>;
  426 + $subject = <STDIN>;
450 427 chomp $subject;
451 428 die "Aborting.\n" if $err++ == 5;
452 429 } while ( trivial_subject($subject) );
453 430 print "\n\n\n";
  431 + return $subject;
454 432 }
455 433
456 434
@@ -464,7 +442,7 @@ sub edit_bug_report {
464 442 require ExtUtils::MakeMaker;
465 443 ExtUtils::MM_MacOS::launch_file($filename);
466 444 print "Press Enter when done.\n";
467   - scalar <>;
  445 + scalar <STDIN>;
468 446 } else {
469 447 $retval = system("$editor $filename");
470 448 }
@@ -483,12 +461,17 @@ EOF
483 461 #------------------------------------------------------------#
484 462 # Action subs. #
485 463
486   -# Dump everything collected on the specified glob.
487   -sub dump_info {
488   - local (*OUT) = @_;
  464 +
  465 +# Display everything collected.
  466 +sub dump_message { print format_message(); }
  467 +
  468 +
  469 +# Format the message with everything collected and return it.
  470 +sub format_message {
  471 + my $report = "";
489 472
490 473 # OS, arch, compiler...
491   - print OUT <<EOF;
  474 + $report .= <<EOF;
492 475 ---
493 476 osname= $Config{osname}
494 477 osvers= $Config{osvers}
@@ -496,59 +479,92 @@ arch= $Config{archname}
496 479 EOF
497 480
498 481 my $cc = $Config{cc};
499   - print OUT "cc= $cc $Config{${cc}.'version'}\n";
  482 + $report .= "cc= $cc $Config{${cc}.'version'}\n";
500 483
501 484
502 485 # ... flags...
503   - print OUT <<EOF;
  486 + $report .= <<EOF;
504 487 ---
505 488 Flags:
506   - category=$category
507   - severity=$severity
  489 + category=$report{category}
  490 + severity=$report{severity}
508 491 EOF
509   - print OUT " ack=no\n" if ! $opts{ack};
  492 + $report .= " ack=no\n" if ! $opts{ack};
  493 +
  494 + # ... bug report ...
  495 + $report .= "---\n$report{body}\n";
510 496
511 497 # ... myconfig ...
512   - print OUT "---\n$parrot_myconfig\n---\n";
  498 + $report .= "---\n$parrot{myconfig}\n---\n";
513 499
514 500 # ... and environment.
515   - print OUT "Environment:\n";
  501 + $report .= "Environment:\n";
516 502 my @env = qw[ PATH LD_LIBRARY_PATH LANG SHELL HOME LOGDIR LANGUAGE ];
517 503 push @env, $Config{ldlibpthname} if $Config{ldlibpthname} ne '';
518 504 push @env, grep /^(?:PERL|LC_|LANG|CYGWIN)/, keys %ENV;
519 505 my %env; @env{@env} = @env;
520 506 for my $env (sort keys %env) {
521   - print OUT " $env",
  507 + $report .= " $env",
522 508 exists $ENV{$env} ? "=$ENV{$env}\n" : " (unset)\n";
523 509 }
  510 +
  511 + return $report;
  512 +}
  513 +
  514 +
  515 +# Print synopsis + help message and exit.
  516 +sub help {
  517 + print <<EOF;
  518 +
  519 +A program to help generate bug reports about parrot, and mail them.
  520 +It is designed to be used interactively. Normally no arguments will
  521 +be needed.
  522 +
  523 +Simplest usage: run '$0', and follow the prompts.
  524 +Usage: $0 [OPTIONS] [ACTIONS]
  525 +
  526 +Options:
  527 + --ok Report successful build on this system to parrot
  528 + developpers. Only use --ok if *everything* was ok:
  529 + if there were *any* problems at all, use --nok.
  530 + --nok Report unsuccessful build on this system.
  531 + --subject <subject> Subject to include with the message.
  532 + --category <category> Category of the bug report.
  533 + --severity <severity> Severity of the bug report.
  534 + --from <address> Your email address.
  535 + --editor <editor> Editor to use for editing the bug report.
  536 + --ack, --noack Don't send a bug received acknowledgement.
  537 + --input-file File containing the body of the report. Use this
  538 + to quickly send a prepared message.
  539 + --output-file File where parrotbug will save its bug report.
  540 + --to <address> Email adress to send report to. (testing only)
  541 +
  542 + Note: you will be prompted if the program miss some information.
  543 +
  544 +Actions:
  545 + --dump Dump message.
  546 + --save Save message.
  547 + --send Send message.
  548 + --help Print this help message and exit.
  549 + --version Print version information and exit.
  550 +
  551 +EOF
  552 + exit;
524 553 }
525 554
526 555
527 556 # Send message to final recipient.
528   -sub send_msg {
529   - # Get the body.
530   - if ( $opts{input} ) {
531   - open BODY, "<$opts{input}" or die "Can't open '$opts{input}': $!";
532   - local $/;
533   - $body = <BODY>;
534   - close BODY or die "Can't close '$opts{input}': $!";
535   - }
536   -
  557 +sub send_message {
537 558 # On linux certain mail implementations won't accept the subject
538 559 # as "~s subject" and thus the Subject header will be corrupted
539 560 # so don't use Mail::Send to be safe
540 561 eval "require Mail::Send";
541 562 if ( $@ eq "" && !$is_linux) {
542   - my $msg = new Mail::Send Subject => $subject, To => $to;
543   - $msg->add( "Reply-To", $from );
  563 + my $msg = new Mail::Send Subject => $report{subject}, To => $report{to};
  564 + $msg->add( "Reply-To", $report{from} );
544 565
545 566 my $fh = $msg->open;
546   - print $fh <<EOF;
547   ------------------------------------------------------------------
548   -$body
549   ------------------------------------------------------------------
550   -EOF
551   - dump_info($fh);
  567 + print $fh format_message();
552 568 $fh->close;
553 569
554 570 print "\nMessage sent.\n";
@@ -566,31 +582,66 @@ equivalent, and the perl package Mail::Send has not been installed, so
566 582 I can't send your bug report. We apologize for the inconvenience.
567 583
568 584 So you may attempt to find some way of sending your message, it has
569   -been left in the file '$opts{input}'.
  585 +been left in the file 'tmpfile'.
570 586 EOF
571 587 # '
572 588 open(SENDMAIL, "|$sendmail -t -oi") || die "'|$sendmail -t -oi' failed: $!";
573 589
574 590 print SENDMAIL <<EOT;
575   -To: $to
576   -Subject: $subject
577   -Reply-To: $from
  591 +To: $report{to}
  592 +Subject: $report{subject}
  593 +Reply-To: $report{from}
578 594 Message-Id: $msgid
579 595
580   ------------------------------------------------------------------
581   -$body
582   ------------------------------------------------------------------
583 596 EOT
584 597
585   - dump_info( *SENDMAIL );
  598 + print SENDMAIL format_message();
586 599 if (close(SENDMAIL)) {
587 600 printf "\nMessage sent.\n";
588 601 } else {
589 602 warn "\nSendmail returned status '", $? >> 8, "'\n";
590 603 }
591   - }
  604 + }
592 605 }
593 606
  607 +
  608 +# Print version information (of the parrotbug program) and exit.
  609 +sub version {
  610 + print <<"EOF";
  611 +
  612 +This is $0, version $VERSION.
  613 +
  614 +EOF
  615 + exit;
  616 +}
  617 +
  618 +
  619 +# Check whether actions have been provided on comand-line, otherwise
  620 +# prompt for what to do with bug report.
  621 +sub what_next {
  622 + dump_message() if $opts{dump};
  623 + save_message() if $opts{save};
  624 + send_message() if $opts{send};
  625 +
  626 + return if $opts{dump} || $opts{save} || $opts{send};
  627 +
  628 + # No actions provided on command-line, prompt for action.
  629 +
  630 + my $action;
  631 + do {
  632 + print "Action (send,display,edit,save,quit): ";
  633 + $action = <STDIN>;
  634 + sw: for ($action) {
  635 + dump_message(), last sw if /^d/i;
  636 + edit_message(), last sw if /^e/i;
  637 + save_message(), last sw if /^sa/i;
  638 + send_message(), last sw if /^se/i;
  639 + print "Uh?\n" unless /^q/i;
  640 + };
  641 + } until ( $action =~ /^q/i );
  642 +}
  643 +
  644 +
594 645 __END__
595 646
596 647 =head1 NAME

0 comments on commit 42d74f6

Please sign in to comment.
Something went wrong with that request. Please try again.