parrotbug

   1 #!/usr/bin/perl
   2 #
   3 # Copyright (C) 2004-2009, Parrot Foundation.
   4 # $Id$
   5 #
   6
   7 eval 'exec perl -w -S $0 ${1+"$@"}'
   8     if $running_under_some_shell;
   9
  10 use strict;
  11 use warnings;
  12
  13 use Config;
  14 use File::Spec;
  15 use Getopt::Long;
  16
  17
  18 my $VERSION = "1.0";
  19
  20 my $parrotdir = File::Spec->curdir();
  21 my ( %opts, %parrot, %report );
  22 my ( $editor, $user, $domain, $msgid, $tmpfile );
  23 my ( $is_linux, $is_macos, $is_mswin32, $is_os2, $is_vms );
  24 my @categories = qw[ core docs install library utilities languages ];
  25 my @severities = qw[ critical high medium low wishlist none ];
  26
  27
  28 #------------------------------------------------------------#
  29 #                       Main program.                        #
  30
  31 init();
  32 help()    if $opts{help};
  33 version() if $opts{version};
  34 explain_parrotbug() unless $opts{quiet};
  35 query_missing_info();
  36 what_next();
  37 unlink $tmpfile;
  38 exit;
  39
  40
  41
  42 # Explain what C<parrotbug> is.
  43 sub explain_parrotbug {
  44     print <<EOT;
  45
  46 This program provides an easy way to create a message reporting a bug
  47 in parrot, and e-mail it to the parrot developers.
  48
  49 It is *NOT* intended for:
  50   - sending test messages,
  51   - or reporting bugs in languages targetting parrot,
  52   - or reporting bugs in some library bindings for parrot,
  53   - or simply verifying that parrot works.
  54
  55 It is *ONLY* a mean of reporting verifiable problems with the core
  56 parrot distribution, and any solutions to such problems, to parrot
  57 developers.
  58
  59 If you're just looking for help with parrot, subscribe to the parrot
  60 mailing list, parrot-dev<at>lists.parrot.org.
  61
  62
  63
  64 EOT
  65 }
  66
  67
  68
  69
  70 #------------------------------------------------------------#
  71 #                        Utils subs.                         #
  72
  73 # Generate random filename to edit report.
  74 sub generate_filename {
  75     my $dir = File::Spec->tmpdir();
  76     my $filename = "bugrep0$$";
  77     $filename++ while -e File::Spec->catfile($dir, $filename);
  78     $filename = File::Spec->catfile($dir, $filename);
  79     return $filename;
  80 }
  81
  82
  83 # Check whether a summary is trivial. A summary is not considered trivial
  84 # if it's an ok or a nok report.
  85 # Return 1 if trivial, 0 otherwise (summary acceptable).
  86 sub trivial_summary {
  87     my $summary = shift;
  88
  89     return 0 if $opts{ok} || $opts{nok};
  90     if ( $summary =~
  91          /^(y(es)?|no?|help|parrot( (bug|problem))?|bug|problem)$/i ||
  92          length($summary) < 4 ||
  93          $summary !~ /\s/ ) {
  94         return 1;
  95     }
  96     else {
  97         return 0;
  98     }
  99 }
 100
 101
 102
 103
 104 #------------------------------------------------------------#
 105 #                         Init subs.                         #
 106
 107 # Initialize the program.
 108 #
 109 # Get parrot information, process the options, create the message
 110 # information (summary, to, body, etc.) depending on the type of report
 111 # (ok, nok or bug report).
 112 sub init {
 113     $is_linux   = lc($^O) eq 'linux';
 114     $is_mswin32 = $^O eq 'MSWin32';
 115     $is_os2     = $^O eq 'os2';
 116     $is_vms     = $^O eq 'VMS';
 117
 118     ##
 119     ## Fetch Parrot information.
 120     ##
 121
 122     # Get parrot version.
 123     # There will always be an up-to-date $parrot/VERSION
 124     my $filename = File::Spec->catfile($parrotdir, "VERSION");
 125     open(VERSION, "<$filename") or die "Cannot open '$filename': $!";
 126     $parrot{version} = <VERSION>;
 127     chomp $parrot{version};
 128     close(VERSION) or die "Cannot close '$filename': $!";
 129
 130     # Get parrot configuration, stored in $parrot/myconfig
 131     $filename = File::Spec->catfile($parrotdir, "myconfig");
 132     open(MYCONFIG, "<$filename") or die "Cannot open '$filename': $!";
 133     {
 134         local $/;
 135         $parrot{myconfig} = <MYCONFIG>;
 136     }
 137     close(MYCONFIG) or die "Cannot close '$filename': $!";
 138
 139
 140     ##
 141     ## Process options.
 142     ##
 143     Getopt::Long::Configure("no_bundling", "no_ignore_case", "auto_abbrev");
 144     help() unless GetOptions
 145       ( \%opts,
 146         "help|h", "version|V",
 147         "dump", "save",
 148         "from|f=s", "to|test|t=s", "editor|e=s",
 149         "summary|s=s", "category|C=s", "severity|S=s",
 150         "input|input-file|i=s", "output|output-file|o=s",
 151         "ok", "nok", "ack!", "quiet|q!" );
 152
 153     ##
 154     ## Report to be sent.
 155     ##
 156   sw: {
 157       ok_report: {
 158             last ok_report unless defined $opts{ok};
 159
 160             # This is an ok report, woohoo!
 161             $report{summary} = "OK: parrot $parrot{version} "
 162               . "on $Config{archname} $Config{osvers}";
 163             $report{body} = "Parrot reported to build OK on this system.\n";
 164             $report{category} = "install";
 165             $report{severity} = "none";
 166             $report{body} = "";
 167             last sw;
 168         };
 169
 170         # Ok reports do not need body, but nok and bug reports do need
 171         # a body.
 172         if ( $opts{input} ) {
 173             # Report was pre-written, slurp it.
 174             open BODY, "<$opts{input}" or die "Can't open '$opts{input}': $!";
 175             local $/;
 176             $report{body} = <BODY>;
 177             close BODY or  die "Can't close '$opts{input}': $!";
 178         }
 179         else {
 180             # No file provided...
 181             $report{body} = "";
 182         }
 183
 184       nok_report: {
 185             last nok_report unless defined $opts{nok};
 186
 187             # This a nok report, how sad... :-(
 188             $report{summary} = "Not OK: parrot $parrot{version} "
 189               . "on $Config{archname} $Config{osvers}";
 190             $report{category} = "install";
 191             $report{severity} = "none";
 192             last sw;
 193         };
 194
 195         # Neither an ok nor a nok.
 196         $report{summary}  = $opts{summary}  || "";
 197         $report{category} = $opts{category} || "";
 198         $report{severity} = $opts{severity} || "";
 199     };
 200
 201     # Test message, shortcuting recipent.
 202     $report{to} = $opts{to} if $opts{to};
 203
 204     ##
 205     ## User information.
 206     ##
 207
 208     # Username.
 209     $user = $is_mswin32 ? $ENV{USERNAME}
 210             : $is_os2   ? $ENV{USER} || $ENV{LOGNAME}
 211             : $is_macos ? $ENV{USER}
 212             : eval { getpwuid($<) };    # May be missing
 213
 214     # User address, used in message
 215     $report{from} = $opts{from} || "";
 216
 217    # Editor
 218     $editor = $ENV{VISUAL} || $ENV{EDITOR} || $ENV{EDIT}
 219       || ( $is_vms && "edit/tpu" )
 220       || ( $is_mswin32 && "notepad" )
 221       || ( $is_macos && "" )
 222       || "vi";
 223
 224 }
 225
 226
 227
 228 #------------------------------------------------------------#
 229 #                       Querying subs.                       #
 230
 231 # Query missing information in order to have a complete report.
 232 sub query_missing_info {
 233     $report{summary} = "" if trivial_summary( $report{summary} );
 234     $report{summary}  = ask_for_summary()     unless $report{summary};
 235     $report{category} = ask_for_alternative( "category", \@categories)
 236       unless $report{category};
 237     $report{severity} = ask_for_alternative( "severity", \@severities)
 238       unless $report{severity};
 239     $report{from} = ask_for_return_address()  unless $report{from};
 240     $report{body} = ask_for_body()            unless $report{body};
 241 }
 242
 243
 244 # Prompt for alternatives from a set of choices.
 245 #
 246 # The arguments are: the name of alternative, the choices (as an array
 247 # ref), and the default answer. (first element if undef)
 248 #
 249 # Return the lowercased alternative chosen.
 250 #
 251 # Die if more than 5 wrong answers.
 252 sub ask_for_alternative {
 253     my ( $what, $choices, $default ) = @_;
 254
 255     print <<EOT unless $opts{quiet};
 256 Please pick a $what from the following:
 257   @{$choices}
 258
 259 EOT
 260
 261     $default ||= $choices->[0];
 262     my $alt;
 263     my $err = 0;
 264     do {
 265         die "Invalid $alt: aborting.\n" if $err++ > 5;
 266         print "Please enter a $what [$default]: ";
 267         $alt = <STDIN>;
 268         chomp $alt;
 269         $alt = $default if $alt =~ /^\s*$/;
 270     } until ( ($alt) = grep /^$alt/i, @$choices );
 271
 272     print "\n\n\n";
 273     return lc $alt;
 274 }
 275
 276
 277 # Prompt for a body, through an external editor.
 278 sub ask_for_body {
 279     unless ( $opts{quiet} ) {
 280         print <<EOT;
 281 Now you need to supply the bug report. Try to make the report concise
 282 but descriptive. Include any relevant detail. If you are reporting
 283 something that does not work as you think it should, please try to
 284 include example of both the actual result, and what you expected.
 285
 286 Some information about your local parrot configuration will
 287 automatically be included at the end of the report. If you are using
 288 any unusual version of parrot, please try and confirm exactly which
 289 versions are relevant.
 290
 291 EOT
 292
 293         print "Press 'Enter' to continue...\n";
 294         scalar <STDIN>;
 295     }
 296
 297     # Prompt for editor to use if none supplied.
 298     if ( $opts{editor} ) {
 299         $editor = $opts{editor};
 300
 301     }
 302     else {
 303         ask_for_editor($opts{quiet} ? "" : <<EOT);
 304 You will probably want to use an editor to enter the report. If the
 305 default editor proposed below is the editor you want to use, then just
 306 press the 'Enter' key, otherwise type in the name of the editor you
 307 would like to use.
 308 EOT
 309     }
 310
 311     # Launch editor.
 312     $tmpfile = generate_filename();
 313     my $body = "";
 314     my $err = 0;
 315     do {
 316         edit_bug_report( $tmpfile );
 317         # Slurp bug report.
 318         open BODY, "<$tmpfile" or die "Can't open '$tmpfile': $!";
 319         {
 320             local $/;
 321             $body = <BODY>;
 322         }
 323         close BODY or die "Can't close '$tmpfile': $!";
 324         unless ( $body ) {
 325             print "\nYou provided an empty bug report!\n";
 326             print "Press 'Enter' to continue...\n";
 327             scalar <STDIN>;
 328         }
 329         die "Aborting.\n" if $err++ == 5;
 330     } until ( $body );
 331
 332     return $body;
 333 }
 334
 335
 336 # Prompt for editor to use.
 337 sub ask_for_editor {
 338     print shift() . "Editor [$editor]: ";
 339     my $entry = <STDIN>;
 340     chomp $entry;
 341     $editor = $entry if $entry ne "";
 342     $opts{editor} = $editor;
 343 }
 344
 345
 346 # Prompt for return address, return it.
 347 sub ask_for_return_address {
 348     print <<EOT unless $opts{quiet};
 349 Your e-mail address will be useful if you need to be contacted. If the
 350 default shown below is not your full internet e-mail address, please
 351 correct it.
 352 EOT
 353
 354     # Try and guess return address
 355     my ($from, $guess);
 356     $guess = $ENV{'REPLY-TO'} || $ENV{REPLYTO} || "";
 357
 358     if ( ! $guess ) {
 359         # Use $domain if we can.
 360         if ( $domain ) {
 361             $guess = $is_vms && !$Config{d_socket} ?
 362               "$domain\:\:$user" : "$user\@$domain";
 363         }
 364     }
 365
 366     # Verify our guess.
 367     print "Your address [$guess]: ";
 368     $from = <STDIN>;
 369     chomp $from;
 370     $from = $guess if $from eq "";
 371     print "\n\n\n";
 372     return $from;
 373 }
 374
 375
 376 # Prompt for summary of message.
 377 #
 378 # Return the summary chosen.
 379 #
 380 # Die if more than 5 wrong summaries.
 381 sub ask_for_summary {
 382     print <<EOT unless $opts{quiet};
 383 First of all, please provide a summary for the message. It should be a
 384 concise description of the bug or problem. "parrot bug" or "parrot
 385 problem" is not a concise description.
 386
 387 EOT
 388
 389     my $summary;
 390     my $err = 0;
 391     do {
 392         $err and print "\nThat doesn't look like a good summary. "
 393           . "Please be more verbose.\n";
 394         print "Summary: ";
 395         $summary = <STDIN>;
 396         $summary = q{} unless defined $summary;
 397         chomp $summary;
 398         die "Aborting.\n" if $err++ == 5;
 399     } while ( trivial_summary($summary) );
 400     print "\n\n\n";
 401     return $summary;
 402 }
 403
 404
 405 # Launch an editor in which to edit the bug report.
 406 sub edit_bug_report {
 407     my $filename = shift;
 408
 409     # Launch editor.
 410     my $retval;
 411     $retval = system($editor, $filename);
 412
 413     # Check whether editor run was successful.
 414     die <<EOT if $retval;
 415 The editor you chose ('$editor') could apparently not be run! Did you
 416 mistype the name of your editor?
 417
 418 EOT
 419
 420 }
 421
 422
 423
 424 #------------------------------------------------------------#
 425 #                        Action subs.                        #
 426
 427
 428 # Display everything collected.
 429 sub dump_report {
 430     print "==> Dumping message...\n";
 431     my $report = format_message();
 432
 433     if ( defined($ENV{PAGER}) ) {
 434         open(my $ofh, '|-', $ENV{PAGER});
 435         print {$ofh} $report;
 436         close $ofh;
 437     }
 438     else {
 439         print $report;
 440     }
 441
 442 }
 443
 444
 445 # Last chance to edit report.
 446 sub edit_report {
 447     # Prompt for editor to use if none supplied.
 448     unless ( $opts{editor} ) {
 449         ask_for_editor(<<EOT);
 450 You will probably want to use an editor to modify the report. If the
 451 default editor proposed below is the editor you want to use, then just
 452 press the 'Enter' key, otherwise type in the name of the editor you
 453 would like to use.
 454 EOT
 455     }
 456
 457     $tmpfile ||= $opts{input};
 458     my $err = 0;
 459     my $body;
 460     do {
 461         edit_bug_report( $tmpfile );
 462         # Slurp bug report.
 463         open BODY, "<$tmpfile" or die "Can't open '$tmpfile': $!";
 464         {
 465             local $/;
 466             $body = <BODY>;
 467         }
 468         close BODY or die "Can't close '$tmpfile': $!";
 469         unless ( $body ) {
 470             print "\nYou provided an empty bug report!\n";
 471             print "Press 'Enter' to continue...\n";
 472             scalar <STDIN>;
 473         }
 474         die "Aborting.\n" if $err++ == 5;
 475     } until ( $body );
 476
 477     $report{body} = $body;
 478 }
 479
 480
 481 # Format the message with everything collected and return it.
 482 sub format_message {
 483     my $report = "";
 484
 485     # ... summary ...
 486     $report .= "Summary: $report{summary}\n";
 487
 488     # ... sender ...
 489     $report .= "Reported by: $report{from}\n";
 490
 491     # ... bug report ...
 492     $report .= "---\n$report{body}\n";
 493
 494     # OS, arch, compiler...
 495     $report .= <<EOT;
 496
 497 ---
 498 osname= $Config{osname}
 499 osvers= $Config{osvers}
 500 arch=   $Config{archname}
 501 EOT
 502
 503     my $cc = $Config{cc};
 504     #$report .= "cc=     $cc $Config{${cc}.'version'}\n";
 505     $report .= "cc=     $cc\n";
 506
 507
 508     # ... flags...
 509     $report .= <<EOT;
 510 ---
 511 Flags:
 512     category=$report{category}
 513     severity=$report{severity}
 514 EOT
 515     $report .= "    ack=no\n" if ! $opts{ack};
 516
 517     # ... myconfig ...
 518     $report .= "---\n$parrot{myconfig}\n---\n";
 519
 520     # ... and environment.
 521     $report .= "Environment:\n";
 522     my @env = qw[ PATH LD_LIBRARY_PATH LANG SHELL HOME LOGDIR LANGUAGE ];
 523     push @env, $Config{ldlibpthname} if $Config{ldlibpthname} ne '';
 524     push @env, grep /^(?:PERL|LC_|LANG|CYGWIN)/, keys %ENV;
 525     my %env;
 526     @env{@env} = @env;
 527     for my $env (sort keys %env) {
 528         my $env_value = exists $ENV{$env} ? "=$ENV{$env}\n" : " (unset)\n";
 529         $report .= "    $env $env_value";
 530     }
 531
 532     return $report;
 533 }
 534
 535
 536 # Print synopsis + help message and exit.
 537 sub help {
 538     print <<EOT;
 539
 540 A program to help generate bug reports about parrot, and mail them.
 541 It is designed to be used interactively. Normally no arguments will
 542 be needed.
 543
 544 Simplest usage:  run '$0', and follow the prompts.
 545 Usage:           $0 [OPTIONS] [ACTIONS]
 546
 547 Options:
 548   --ok                   Report successful build on this system to parrot
 549                          developers. Only use --ok if *everything* was ok:
 550                          if there were *any* problems at all, use --nok.
 551   --nok                  Report unsuccessful build on this system.
 552   --summary <summary>    Summary to include with the message.
 553   --category <category>  Category of the bug report.
 554   --severity <severity>  Severity of the bug report.
 555   --from <address>       Your email address.
 556   --editor <editor>      Editor to use for editing the bug report.
 557   --ack, --noack         Don't send a bug received acknowledgement.
 558   --input-file           File containing the body of the report. Use this
 559                          to quickly send a prepared message.
 560   --output-file          File where parrotbug will save its bug report.
 561
 562   Note: you will be prompted if the program miss some information.
 563
 564 Actions:
 565   --dump           Dump message.
 566   --save           Save message.
 567   --help           Print this help message and exit.
 568   --version        Print version information and exit.
 569
 570 EOT
 571     exit;
 572 }
 573
 574
 575 # Save message to file.
 576 sub save_report {
 577     print "\n==> Saving message to file...\n";
 578     if ( ! $opts{output} ) {
 579         print "Enter filename to save bug report: ";
 580         $opts{output} = <STDIN>;
 581     }
 582
 583     open OUTPUT, ">$opts{output}" or die "Cannot open '$opts{output}': $!";
 584     print OUTPUT format_message();
 585     close OUTPUT or die "Cannot open '$opts{output}': $!";
 586
 587     print "Message saved. Please submit a ticket and attach this file at
 588     https://trac.parrot.org/parrot/newticket\n";
 589 }
 590
 591
 592
 593 # Print version information (of the parrotbug program) and exit.
 594 sub version {
 595     print <<"EOT";
 596
 597 This is $0, version $VERSION.
 598
 599 EOT
 600     exit;
 601 }
 602
 603
 604 # Check whether actions have been provided on comand-line, otherwise
 605 # prompt for what to do with bug report.
 606 sub what_next {
 607     dump_report() if $opts{dump};
 608     save_report() if $opts{save};
 609
 610     return if $opts{dump} || $opts{save};
 611
 612     # No actions provided on command-line, prompt for action.
 613
 614     my $action;
 615     do {
 616         print "Action (display,edit,save,quit): ";
 617         $action = <STDIN>;
 618        sw: for ($action) {
 619              dump_report(), last sw if /^d/i;
 620              edit_report(), last sw if /^e/i;
 621              save_report(), last sw if /^sa/i;
 622              print "Uh?\n" unless /^q/i;
 623          };
 624     } until ( $action =~ /^q/i );
 625 }
 626
 627
 628 __END__
 629
 630 =head1 NAME
 631
 632 parrotbug - Parrot Bug Reporter
 633
 634 =head1 SYNOPSIS
 635
 636     % ./parrotbug [options] [actions]
 637
 638 =head1 DESCRIPTION
 639
 640 A program to help generate bug reports about parrot, and mail them.
 641 It is designed to be used interactively. Normally no arguments will
 642 be needed.
 643
 644
 645 =head1 COMMAND-LINE SWITCHES
 646
 647
 648 =head2 Options
 649
 650 Note: you will be prompted if the program miss some information.
 651
 652 =over 4
 653
 654 =item B<--nok>
 655
 656 Report unsuccessful build on this system to parrot developers.
 657
 658 =item B<--ok>
 659
 660 Report successful build on this system to parrot developers Only use
 661 C<--ok> if B<everything> was ok; if there were B<any> problems at all,
 662 use C<--nok>.
 663
 664 =item B<--summary>
 665
 666 Summary of the report. You will be prompted if you don't supply one on
 667 the command-line.
 668
 669 =item B<--category>
 670
 671 Category of the bug report. You will be prompted if you don't supply
 672 one on the command-line.
 673
 674 =item B<--severity>
 675
 676 Severity of the bug report. You will be prompted if you don't supply
 677 one on the command-line.
 678
 679 =item B<--address>
 680
 681 Your email address. The program will try to guess one if you don't
 682 provide one, but you'll still need to validate it.
 683
 684 =item B<--editor>
 685
 686 Editor to use for editing the bug report.
 687
 688 =item B<--output-file>
 689
 690 File where parrotbug will save its bug report, if you ask it to do so.
 691
 692 =back
 693
 694
 695 =head2 Actions
 696
 697 You can provide more than one action on the command-line. If none is
 698 supplied, then you will be prompted for what to do.
 699
 700 =over 4
 701
 702 =item B<--dump>
 703
 704 Dump formatted report on standard output.
 705
 706 =item B<--save>
 707
 708 Save message to a file, in order for you to send it later from your
 709 own. See C<--output> flag.
 710
 711 =item B<--help>
 712
 713 Print a short synopsis and exit.
 714
 715 =item B<--version>
 716
 717 Print version information and exit.
 718
 719 =back
 720
 721
 722 =head1 SEE ALSO
 723
 724 perlbug(1), parrot(1), diff(1), patch(1)
 725
 726 =cut
 727
 728 # Local Variables:
 729 #   mode: cperl
 730 #   cperl-indent-level: 4
 731 #   fill-column: 100
 732 # End:
 733 # vim: expandtab shiftwidth=4: