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     print format_message();
 432 }
 433
 434
 435 # Last chance to edit report.
 436 sub edit_report {
 437     # Prompt for editor to use if none supplied.
 438     unless ( $opts{editor} ) {
 439         ask_for_editor(<<EOT);
 440 You will probably want to use an editor to modify the report. If the
 441 default editor proposed below is the editor you want to use, then just
 442 press the 'Enter' key, otherwise type in the name of the editor you
 443 would like to use.
 444 EOT
 445     }
 446
 447     $tmpfile ||= $opts{input};
 448     my $err = 0;
 449     my $body;
 450     do {
 451         edit_bug_report( $tmpfile );
 452         # Slurp bug report.
 453         open BODY, "<$tmpfile" or die "Can't open '$tmpfile': $!";
 454         {
 455             local $/;
 456             $body = <BODY>;
 457         }
 458         close BODY or die "Can't close '$tmpfile': $!";
 459         unless ( $body ) {
 460             print "\nYou provided an empty bug report!\n";
 461             print "Press 'Enter' to continue...\n";
 462             scalar <STDIN>;
 463         }
 464         die "Aborting.\n" if $err++ == 5;
 465     } until ( $body );
 466
 467     $report{body} = $body;
 468 }
 469
 470
 471 # Format the message with everything collected and return it.
 472 sub format_message {
 473     my $report = "";
 474
 475     # ... summary ...
 476     $report .= "Summary: $report{summary}\n";
 477
 478     # ... sender ...
 479     $report .= "Reported by: $report{from}\n";
 480
 481     # ... bug report ...
 482     $report .= "---\n$report{body}\n";
 483
 484     # OS, arch, compiler...
 485     $report .= <<EOT;
 486
 487 ---
 488 osname= $Config{osname}
 489 osvers= $Config{osvers}
 490 arch=   $Config{archname}
 491 EOT
 492
 493     my $cc = $Config{cc};
 494     #$report .= "cc=     $cc $Config{${cc}.'version'}\n";
 495     $report .= "cc=     $cc\n";
 496
 497
 498     # ... flags...
 499     $report .= <<EOT;
 500 ---
 501 Flags:
 502     category=$report{category}
 503     severity=$report{severity}
 504 EOT
 505     $report .= "    ack=no\n" if ! $opts{ack};
 506
 507     # ... myconfig ...
 508     $report .= "---\n$parrot{myconfig}\n---\n";
 509
 510     # ... and environment.
 511     $report .= "Environment:\n";
 512     my @env = qw[ PATH LD_LIBRARY_PATH LANG SHELL HOME LOGDIR LANGUAGE ];
 513     push @env, $Config{ldlibpthname} if $Config{ldlibpthname} ne '';
 514     push @env, grep /^(?:PERL|LC_|LANG|CYGWIN)/, keys %ENV;
 515     my %env;
 516     @env{@env} = @env;
 517     for my $env (sort keys %env) {
 518         my $env_value = exists $ENV{$env} ? "=$ENV{$env}\n" : " (unset)\n";
 519         $report .= "    $env $env_value";
 520     }
 521
 522     return $report;
 523 }
 524
 525
 526 # Print synopsis + help message and exit.
 527 sub help {
 528     print <<EOT;
 529
 530 A program to help generate bug reports about parrot, and mail them.
 531 It is designed to be used interactively. Normally no arguments will
 532 be needed.
 533
 534 Simplest usage:  run '$0', and follow the prompts.
 535 Usage:           $0 [OPTIONS] [ACTIONS]
 536
 537 Options:
 538   --ok                   Report successful build on this system to parrot
 539                          developers. Only use --ok if *everything* was ok:
 540                          if there were *any* problems at all, use --nok.
 541   --nok                  Report unsuccessful build on this system.
 542   --summary <summary>    Summary to include with the message.
 543   --category <category>  Category of the bug report.
 544   --severity <severity>  Severity of the bug report.
 545   --from <address>       Your email address.
 546   --editor <editor>      Editor to use for editing the bug report.
 547   --ack, --noack         Don't send a bug received acknowledgement.
 548   --input-file           File containing the body of the report. Use this
 549                          to quickly send a prepared message.
 550   --output-file          File where parrotbug will save its bug report.
 551
 552   Note: you will be prompted if the program miss some information.
 553
 554 Actions:
 555   --dump           Dump message.
 556   --save           Save message.
 557   --help           Print this help message and exit.
 558   --version        Print version information and exit.
 559
 560 EOT
 561     exit;
 562 }
 563
 564
 565 # Save message to file.
 566 sub save_report {
 567     print "\n==> Saving message to file...\n";
 568     if ( ! $opts{output} ) {
 569         print "Enter filename to save bug report: ";
 570         $opts{output} = <STDIN>;
 571     }
 572
 573     open OUTPUT, ">$opts{output}" or die "Cannot open '$opts{output}': $!";
 574     print OUTPUT format_message();
 575     close OUTPUT or die "Cannot open '$opts{output}': $!";
 576
 577     print "Message saved. Please submit a ticket and attach this file at
 578     https://trac.parrot.org/parrot/newticket\n";
 579 }
 580
 581
 582
 583 # Print version information (of the parrotbug program) and exit.
 584 sub version {
 585     print <<"EOT";
 586
 587 This is $0, version $VERSION.
 588
 589 EOT
 590     exit;
 591 }
 592
 593
 594 # Check whether actions have been provided on comand-line, otherwise
 595 # prompt for what to do with bug report.
 596 sub what_next {
 597     dump_report() if $opts{dump};
 598     save_report() if $opts{save};
 599
 600     return if $opts{dump} || $opts{save};
 601
 602     # No actions provided on command-line, prompt for action.
 603
 604     my $action;
 605     do {
 606         print "Action (display,edit,save,quit): ";
 607         $action = <STDIN>;
 608        sw: for ($action) {
 609              dump_report(), last sw if /^d/i;
 610              edit_report(), last sw if /^e/i;
 611              save_report(), last sw if /^sa/i;
 612              print "Uh?\n" unless /^q/i;
 613          };
 614     } until ( $action =~ /^q/i );
 615 }
 616
 617
 618 __END__
 619
 620 =head1 NAME
 621
 622 parrotbug - Parrot Bug Reporter
 623
 624 =head1 SYNOPSIS
 625
 626     % ./parrotbug [options] [actions]
 627
 628 =head1 DESCRIPTION
 629
 630 A program to help generate bug reports about parrot, and mail them.
 631 It is designed to be used interactively. Normally no arguments will
 632 be needed.
 633
 634
 635 =head1 COMMAND-LINE SWITCHES
 636
 637
 638 =head2 Options
 639
 640 Note: you will be prompted if the program miss some information.
 641
 642 =over 4
 643
 644 =item B<--nok>
 645
 646 Report unsuccessful build on this system to parrot developers.
 647
 648 =item B<--ok>
 649
 650 Report successful build on this system to parrot developers Only use
 651 C<--ok> if B<everything> was ok; if there were B<any> problems at all,
 652 use C<--nok>.
 653
 654 =item B<--summary>
 655
 656 Summary of the report. You will be prompted if you don't supply one on
 657 the command-line.
 658
 659 =item B<--category>
 660
 661 Category of the bug report. You will be prompted if you don't supply
 662 one on the command-line.
 663
 664 =item B<--severity>
 665
 666 Severity of the bug report. You will be prompted if you don't supply
 667 one on the command-line.
 668
 669 =item B<--address>
 670
 671 Your email address. The program will try to guess one if you don't
 672 provide one, but you'll still need to validate it.
 673
 674 =item B<--editor>
 675
 676 Editor to use for editing the bug report.
 677
 678 =item B<--output-file>
 679
 680 File where parrotbug will save its bug report, if you ask it to do so.
 681
 682 =back
 683
 684
 685 =head2 Actions
 686
 687 You can provide more than one action on the command-line. If none is
 688 supplied, then you will be prompted for what to do.
 689
 690 =over 4
 691
 692 =item B<--dump>
 693
 694 Dump formatted report on standard output.
 695
 696 =item B<--save>
 697
 698 Save message to a file, in order for you to send it later from your
 699 own. See C<--output> flag.
 700
 701 =item B<--help>
 702
 703 Print a short synopsis and exit.
 704
 705 =item B<--version>
 706
 707 Print version information and exit.
 708
 709 =back
 710
 711
 712 =head1 SEE ALSO
 713
 714 perlbug(1), parrot(1), diff(1), patch(1)
 715
 716 =cut
 717
 718 # Local Variables:
 719 #   mode: cperl
 720 #   cperl-indent-level: 4
 721 #   fill-column: 100
 722 # End:
 723 # vim: expandtab shiftwidth=4: