Index: parrotbug
===================================================================
--- parrotbug	(revision 37047)
+++ parrotbug	(working copy)
@@ -1,824 +1,19 @@
 #!/usr/bin/perl
 #
-# Copyright (C) 2004-2009, Parrot Foundation.
+# Copyright (C) 2009, Parrot Foundation.
 # $Id$
 #
 
-eval 'exec perl -w -S $0 ${1+"$@"}'
-    if $running_under_some_shell;
-
 use strict;
 use warnings;
 
-use Config;
-use File::Spec;
-use Getopt::Long;
+print <<'END'
 
+We no longer use parrotbug for bug reports; please submit
+reports via the web interface at http://trac.parrot.org/ .
 
-my $VERSION = "1.0";
+Thanks,
+   The Parrot Team
 
-# These are the standard addresses for reporting bugs.
-my %std_to =
-  ( bug => 'parrotbug@parrotcode.org',
-    ok  => 'parrotstatus-ok@parrotcode.org',
-    nok => 'parrotstatus-nok@parrotcode.org',
-  );
+END
 
-my $parrotdir = File::Spec->curdir();
-my ( %opts, %parrot, %report );
-my ( $editor, $user, $domain, $msgid, $tmpfile );
-my ( $is_linux, $is_macos, $is_mswin32, $is_os2, $is_vms );
-my @categories = qw[ core docs install library utilities languages ];
-my @severities = qw[ critical high medium low wishlist none ];
-
-
-#------------------------------------------------------------#
-#                       Main program.                        #
-
-init();
-help()    if $opts{help};
-version() if $opts{version};
-explain_parrotbug() unless $opts{quiet};
-query_missing_info();
-what_next();
-unlink $tmpfile;
-exit;
-
-
-
-# Explain what C<parrotbug> is.
-sub explain_parrotbug {
-    print <<EOT;
-
-This program provides an easy way to create a message reporting a bug
-in parrot, and e-mail it to the parrot developers.
-
-It is *NOT* intended for:
-  - sending test messages,
-  - or reporting bugs in languages targetting parrot,
-  - or reporting bugs in some library bindings for parrot,
-  - or simply verifying that parrot works.
-
-It is *ONLY* a mean of reporting verifiable problems with the core
-parrot distribution, and any solutions to such problems, to parrot
-developers.
-
-If you're just looking for help with parrot, subscribe to the parrot
-mailing list, parrot-dev<at>lists.parrot.org.
-
-
-
-EOT
-}
-
-
-
-
-#------------------------------------------------------------#
-#                        Utils subs.                         #
-
-# Generate random filename to edit report.
-sub generate_filename {
-    my $dir = File::Spec->tmpdir();
-    my $filename = "bugrep0$$";
-    $filename++ while -e File::Spec->catfile($dir, $filename);
-    $filename = File::Spec->catfile($dir, $filename);
-    return $filename;
-}
-
-
-# Check whether a subject is trivial. A subject is not considered trivial
-# if it's an ok or a nok report.
-# Return 1 if trivial, 0 otherwise (subject acceptable).
-sub trivial_subject {
-    my $subject = shift;
-
-    return 0 if $opts{ok} || $opts{nok};
-    if ( $subject =~
-         /^(y(es)?|no?|help|parrot( (bug|problem))?|bug|problem)$/i ||
-         length($subject) < 4 ||
-         $subject !~ /\s/ ) {
-        return 1;
-    }
-    else {
-        return 0;
-    }
-}
-
-
-
-
-#------------------------------------------------------------#
-#                         Init subs.                         #
-
-# Initialize the program. 
-# 
-# Get parrot information, process the options, create the message
-# information (subject, to, body, etc.) depending on the type of report
-# (ok, nok or bug report).
-sub init {
-    $is_linux   = lc($^O) eq 'linux';
-    $is_mswin32 = $^O eq 'MSWin32';
-    $is_os2     = $^O eq 'os2';
-    $is_vms     = $^O eq 'VMS';
-
-    ##
-    ## Fetch Parrot information.
-    ##
-
-    # Get parrot version.
-    # There will always be an up-to-date $parrot/VERSION
-    my $filename = File::Spec->catfile($parrotdir, "VERSION");
-    open(VERSION, "<$filename") or die "Cannot open '$filename': $!";
-    $parrot{version} = <VERSION>;
-    chomp $parrot{version};
-    close(VERSION) or die "Cannot close '$filename': $!";
-
-    # Get parrot configuration, stored in $parrot/myconfig
-    $filename = File::Spec->catfile($parrotdir, "myconfig");
-    open(MYCONFIG, "<$filename") or die "Cannot open '$filename': $!";
-    {
-        local $/;
-        $parrot{myconfig} = <MYCONFIG>;
-    }
-    close(MYCONFIG) or die "Cannot close '$filename': $!";
-
-
-    ##
-    ## Process options.
-    ##
-    Getopt::Long::Configure("no_bundling", "no_ignore_case", "auto_abbrev");
-    help() unless GetOptions
-      ( \%opts,
-        "help|h", "version|V",
-        "send", "dump", "save",
-        "from|f=s", "to|test|t=s", "editor|e=s",
-        "subject|s=s", "category|C=s", "severity|S=s",
-        "input|input-file|i=s", "output|output-file|o=s",
-        "ok", "nok", "ack!", "quiet|q!" );
-
-    ##
-    ## Report to be sent.
-    ##
-  sw: {
-      ok_report: {
-            last ok_report unless defined $opts{ok};
-
-            # This is an ok report, woohoo!
-            $report{to} = $std_to{ok};
-            $report{subject} = "OK: parrot $parrot{version} "
-              . "on $Config{archname} $Config{osvers}";
-            $report{body} = "Parrot reported to build OK on this system.\n";
-            $report{category} = "install";
-            $report{severity} = "none";
-            $report{body} = "";
-            last sw;
-        };
-
-        # Ok reports do not need body, but nok and bug reports do need
-        # a body.
-        if ( $opts{input} ) {
-            # Report was pre-written, slurp it.
-            open BODY, "<$opts{input}" or die "Can't open '$opts{input}': $!";
-            local $/;
-            $report{body} = <BODY>;
-            close BODY or  die "Can't close '$opts{input}': $!";
-        }
-        else {
-            # No file provided...
-            $report{body} = "";
-        }
-
-      nok_report: {
-            last nok_report unless defined $opts{nok};
-
-            # This a nok report, how sad... :-(
-            $report{to} = $std_to{nok};
-            $report{subject} = "Not OK: parrot $parrot{version} "
-              . "on $Config{archname} $Config{osvers}";
-            $report{category} = "install";
-            $report{severity} = "none";
-            last sw;
-        };
-
-        # Neither an ok nor a nok.
-        $report{to} = $std_to{bug};
-        $report{subject}  = $opts{subject}  || "";
-        $report{category} = $opts{category} || "";
-        $report{severity} = $opts{severity} || "";
-    };
-
-    # Test message, shortcuting recipent.
-    $report{to} = $opts{to} if $opts{to};
-
-    ## 
-    ## User information.
-    ## 
-
-    # Username.
-    $user = $is_mswin32 ? $ENV{USERNAME}
-	    : $is_os2   ? $ENV{USER} || $ENV{LOGNAME}
-	    : $is_macos ? $ENV{USER}
-	    : eval { getpwuid($<) };	# May be missing
-
-    # User address, used in message and in Reply-To header.
-    $report{from} = $opts{from} || "";
-
-   # Editor
-    $editor = $ENV{VISUAL} || $ENV{EDITOR} || $ENV{EDIT}
-      || ( $is_vms && "edit/tpu" )
-      || ( $is_mswin32 && "notepad" )
-      || ( $is_macos && "" )
-      || "vi";
-
-
-    ## 
-    ## Mail information.
-    ## 
-
-    # Message-Id.
-    eval "use Mail::Util;";
-    if ( $@ eq "" ) {
-        $domain = Mail::Util::maildomain();
-    }
-    elsif ($is_mswin32) {
-        $domain = $ENV{USERDOMAIN};
-    }
-    else {
-        require Sys::Hostname;
-        $domain = Sys::Hostname::hostname();
-    }
-    $msgid = "<parrotbug_${VERSION}_${$}_".time."\@$domain>";
-}
-
-
-
-#------------------------------------------------------------#
-#                       Querying subs.                       #
-
-# Query missing information in order to have a complete report.
-sub query_missing_info {
-    $report{subject} = "" if trivial_subject( $report{subject} );
-    $report{subject}  = ask_for_subject()     unless $report{subject};
-    $report{category} = ask_for_alternative( "category", \@categories)
-      unless $report{category};
-    $report{severity} = ask_for_alternative( "severity", \@severities)
-      unless $report{severity};
-    $report{from} = ask_for_return_address()  unless $report{from};
-    $report{body} = ask_for_body()            unless $report{body};
-}
-
-
-# Prompt for alternatives from a set of choices.
-# 
-# The arguments are: the name of alternative, the choices (as an array
-# ref), and the default answer. (first element if undef)
-# 
-# Return the lowercased alternative chosen.
-# 
-# Die if more than 5 wrong answers.
-sub ask_for_alternative {
-    my ( $what, $choices, $default ) = @_;
-
-    print <<EOT unless $opts{quiet};
-Please pick a $what from the following:
-  @{$choices}
-
-EOT
-
-    $default ||= $choices->[0];
-    my $alt;
-    my $err = 0;
-    do {
-        die "Invalid $alt: aborting.\n" if $err++ > 5;
-        print "Please enter a $what [$default]: ";
-        $alt = <STDIN>;
-        chomp $alt;
-        $alt = $default if $alt =~ /^\s*$/;
-    } until ( ($alt) = grep /^$alt/i, @$choices );
-
-    print "\n\n\n";
-    return lc $alt;
-}
-
-
-# Prompt for a body, through an external editor.
-sub ask_for_body {
-    unless ( $opts{quiet} ) {
-        print <<EOT;
-Now you need to supply the bug report. Try to make the report concise
-but descriptive. Include any relevant detail. If you are reporting
-something that does not work as you think it should, please try to
-include example of both the actual result, and what you expected.
-
-Some information about your local parrot configuration will
-automatically be included at the end of the report. If you are using
-any unusual version of parrot, please try and confirm exactly which
-versions are relevant.
-
-EOT
-
-        print "Press 'Enter' to continue...\n";
-        scalar <STDIN>;
-    }
-
-    # Prompt for editor to use if none supplied.
-    if ( $opts{editor} ) {
-        $editor = $opts{editor};
-
-    }
-    else {
-        ask_for_editor($opts{quiet} ? "" : <<EOT);
-You will probably want to use an editor to enter the report. If the
-default editor proposed below is the editor you want to use, then just
-press the 'Enter' key, otherwise type in the name of the editor you
-would like to use.
-EOT
-    }
-
-    # Launch editor.
-    $tmpfile = generate_filename();
-    my $body = "";
-    my $err = 0;
-    do {
-        edit_bug_report( $tmpfile );
-        # Slurp bug report.
-        open BODY, "<$tmpfile" or die "Can't open '$tmpfile': $!";
-        {
-            local $/;
-            $body = <BODY>;
-        }
-        close BODY or die "Can't close '$tmpfile': $!";
-        unless ( $body ) {
-            print "\nYou provided an empty bug report!\n";
-            print "Press 'Enter' to continue...\n";
-            scalar <STDIN>;
-        }
-        die "Aborting.\n" if $err++ == 5;
-    } until ( $body );
-
-    return $body;
-}
-
-
-# Prompt for editor to use.
-sub ask_for_editor {
-    print shift() . "Editor [$editor]: ";
-    my $entry = <STDIN>;
-    chomp $entry;
-    $editor = $entry if $entry ne "";
-    $opts{editor} = $editor;
-}
-
-
-# Prompt for return address, return it.
-sub ask_for_return_address {
-    print <<EOT unless $opts{quiet};
-Your e-mail address will be useful if you need to be contacted. If the
-default shown below is not your full internet e-mail address, please
-correct it.
-EOT
-    
-    # Try and guess return address
-    my ($from, $guess);
-    $guess = $ENV{'REPLY-TO'} || $ENV{REPLYTO} || "";
-
-    if ( ! $guess ) {
-        # Use $domain if we can.
-        if ( $domain ) {
-            $guess = $is_vms && !$Config{d_socket} ?
-              "$domain\:\:$user" : "$user\@$domain";
-        }
-    }
-
-    # Verify our guess.
-    print "Your address [$guess]: ";
-    $from = <STDIN>;
-    chomp $from;
-    $from = $guess if $from eq "";
-    print "\n\n\n";
-    return $from;
-}
-
-
-# Prompt for subject of message.
-#
-# Return the subject chosen.
-# 
-# Die if more than 5 wrong subjects.
-sub ask_for_subject {
-    print <<EOT unless $opts{quiet};
-First of all, please provide a subject for the message. It should be a
-concise description of the bug or problem. "parrot bug" or "parrot
-problem" is not a concise description.
-
-EOT
-
-    my $subject;
-    my $err = 0;
-    do {
-        $err and print "\nThat doesn't look like a good subject. "
-          . "Please be more verbose.\n";
-        print "Subject: ";
-        $subject = <STDIN>;
-        $subject = q{} unless defined $subject;
-        chomp $subject;
-        die "Aborting.\n" if $err++ == 5;
-    } while ( trivial_subject($subject) );
-    print "\n\n\n";
-    return $subject;
-}
-
-
-# Launch an editor in which to edit the bug report.
-sub edit_bug_report {
-    my $filename = shift;
-
-    # Launch editor.
-    my $retval;
-    $retval = system($editor, $filename);
-
-    # Check whether editor run was successful.
-    die <<EOT if $retval;
-The editor you chose ('$editor') could apparently not be run! Did you
-mistype the name of your editor?
-
-EOT
-
-}
-
-
-
-#------------------------------------------------------------#
-#                        Action subs.                        #
-
-
-# Display everything collected.
-sub dump_report { 
-    print "==> Dumping message...\n";
-    print format_message();
-}
-
-
-# Last chance to edit report.
-sub edit_report {
-    # Prompt for editor to use if none supplied.
-    unless ( $opts{editor} ) {
-        ask_for_editor(<<EOT);
-You will probably want to use an editor to modify the report. If the
-default editor proposed below is the editor you want to use, then just
-press the 'Enter' key, otherwise type in the name of the editor you
-would like to use.
-EOT
-    }
-
-    $tmpfile ||= $opts{input};
-    my $err = 0;
-    my $body;
-    do {
-        edit_bug_report( $tmpfile );
-        # Slurp bug report.
-        open BODY, "<$tmpfile" or die "Can't open '$tmpfile': $!";
-        {
-            local $/;
-            $body = <BODY>;
-        }
-        close BODY or die "Can't close '$tmpfile': $!";
-        unless ( $body ) {
-            print "\nYou provided an empty bug report!\n";
-            print "Press 'Enter' to continue...\n";
-            scalar <STDIN>;
-        }
-        die "Aborting.\n" if $err++ == 5;
-    } until ( $body );
-
-    $report{body} = $body;
-}
-
-
-# Format the message with everything collected and return it.
-sub format_message {
-    my $report = "";
-
-    # OS, arch, compiler...
-    $report .= <<EOT;
----
-osname= $Config{osname}
-osvers= $Config{osvers}
-arch=   $Config{archname}
-EOT
-
-    my $cc = $Config{cc};
-    #$report .= "cc=     $cc $Config{${cc}.'version'}\n";
-    $report .= "cc=     $cc\n";
-
-
-    # ... flags...
-    $report .= <<EOT;
----
-Flags:
-    category=$report{category}
-    severity=$report{severity}
-EOT
-    $report .= "    ack=no\n" if ! $opts{ack};
-
-    # ... bug report ...
-    $report .= "---\n$report{body}\n";
-
-    # ... myconfig ...
-    $report .= "---\n$parrot{myconfig}\n---\n";
-
-    # ... and environment.
-    $report .= "Environment:\n";
-    my @env = qw[ PATH LD_LIBRARY_PATH LANG SHELL HOME LOGDIR LANGUAGE ];
-    push @env, $Config{ldlibpthname} if $Config{ldlibpthname} ne '';
-    push @env, grep /^(?:PERL|LC_|LANG|CYGWIN)/, keys %ENV;
-    my %env; 
-    @env{@env} = @env;
-    for my $env (sort keys %env) {
-        my $env_value = exists $ENV{$env} ? "=$ENV{$env}\n" : " (unset)\n";
-	$report .= "    $env $env_value";
-    }
-
-    return $report;
-}
-
-
-# Print synopsis + help message and exit.
-sub help {
-    print <<EOT;
-
-A program to help generate bug reports about parrot, and mail them.
-It is designed to be used interactively. Normally no arguments will
-be needed.
-
-Simplest usage:  run '$0', and follow the prompts.
-Usage:           $0 [OPTIONS] [ACTIONS]
-
-Options:
-  --ok                   Report successful build on this system to parrot
-                         developers. Only use --ok if *everything* was ok:
-                         if there were *any* problems at all, use --nok.
-  --nok                  Report unsuccessful build on this system.
-  --subject <subject>    Subject to include with the message.
-  --category <category>  Category of the bug report.
-  --severity <severity>  Severity of the bug report.
-  --from <address>       Your email address.
-  --editor <editor>      Editor to use for editing the bug report.
-  --ack, --noack         Don't send a bug received acknowledgement.
-  --input-file           File containing the body of the report. Use this
-                         to quickly send a prepared message.
-  --output-file          File where parrotbug will save its bug report.
-  --to <address>         Email address to send report to. (testing only)
-
-  Note: you will be prompted if the program miss some information.
-
-Actions:
-  --dump           Dump message.
-  --save           Save message.
-  --send           Send message.
-  --help           Print this help message and exit.
-  --version        Print version information and exit.
-
-EOT
-    exit;
-}
-
-
-# Save message to file.
-sub save_report {
-    print "\n==> Saving message to file...\n";
-    if ( ! $opts{output} ) {
-        print "Enter filename to save bug report: ";
-        $opts{output} = <STDIN>;
-    }
-
-    open OUTPUT, ">$opts{output}" or die "Cannot open '$opts{output}': $!";
-    print OUTPUT format_message();
-    close OUTPUT or die "Cannot open '$opts{output}': $!";
-
-    print "Message saved.\n";
-}
-
-
-# Send message to final recipient.
-sub send_report {
-    print "==> Sending message to recipient...\n";
-
-    # On linux certain mail implementations won't accept the subject
-    # as "~s subject" and thus the Subject header will be corrupted
-    # so don't use Mail::Send to be safe
-    eval "require Mail::Send";
-    if ( $@ eq "" && !$is_linux) {
-	my $msg = new Mail::Send Subject => $report{subject}, To => $report{to};
-	$msg->add( "Reply-To", $report{from} );
-
-	my $fh = $msg->open;
-        print $fh format_message();
-	$fh->close;
-
-	print "\nMessage sent.\n";
-
-    }
-    else {
-	my $sendmail = "";
-	for ( qw[ /usr/lib/sendmail /usr/sbin/sendmail 
-                  /usr/ucblib/sendmail /var/qmail/bin/sendmail ] ) {
-	    $sendmail = $_, last if -e $_;
-	}
-
-	die <<EOT if $sendmail eq "";
-I am terribly sorry, but I cannot find sendmail, or a close
-equivalent, and the perl package Mail::Send has not been installed, so
-I can't send your bug report. We apologize for the inconvenience.
-
-So you may attempt to find some way of sending your message, it has
-been left in the file '$tmpfile'.
-EOT
-
-	open(SENDMAIL, "|$sendmail -t -oi") || die "'|$sendmail -t -oi' failed: $!";
-
-	print SENDMAIL <<EOT;
-To: $report{to}
-Subject: $report{subject}
-Reply-To: $report{from}
-Message-Id: $msgid
-
-EOT
-
-        print SENDMAIL format_message();
-	if (close(SENDMAIL)) {
-	    printf "\nMessage sent.\n";
-        }
-        else {
-	    warn "\nSendmail returned status '", $? >> 8, "'\n";
-	}
-    }
-}
-
-
-# Print version information (of the parrotbug program) and exit.
-sub version {
-    print <<"EOT";
-
-This is $0, version $VERSION.
-
-EOT
-    exit;
-}
-
-
-# Check whether actions have been provided on comand-line, otherwise
-# prompt for what to do with bug report.
-sub what_next {
-    dump_report() if $opts{dump};
-    save_report() if $opts{save};
-    send_report() if $opts{send};
-
-    return if $opts{dump} || $opts{save} || $opts{send};
-
-    # No actions provided on command-line, prompt for action.
-
-    my $action;
-    do {
-        print "Action (send,display,edit,save,quit): ";
-        $action = <STDIN>;
-       sw: for ($action) {
-             dump_report(), last sw if /^d/i;
-             edit_report(), last sw if /^e/i;
-             save_report(), last sw if /^sa/i;
-             send_report(), last sw if /^se/i;
-             print "Uh?\n" unless /^q/i;
-         };
-    } until ( $action =~ /^q/i );
-}
-
-
-__END__
-
-=head1 NAME
-
-parrotbug - Parrot Bug Reporter
-
-=head1 SYNOPSIS
-
-    % ./parrotbug [options] [actions]
-
-=head1 DESCRIPTION
-
-A program to help generate bug reports about parrot, and mail them.
-It is designed to be used interactively. Normally no arguments will
-be needed.
-
-
-=head1 COMMAND-LINE SWITCHES
-
-
-=head2 Options
-
-Note: you will be prompted if the program miss some information.
-
-=over 4
-
-=item B<--nok>
-
-Report unsuccessful build on this system to parrot developers.
-
-=item B<--ok>
-
-Report successful build on this system to parrot developers Only use
-C<--ok> if B<everything> was ok; if there were B<any> problems at all,
-use C<--nok>.
-
-=item B<--subject>
-
-Subject of the report. You will be prompted if you don't supply one on
-the command-line.
-
-=item B<--category>
-
-Category of the bug report. You will be prompted if you don't supply
-one on the command-line.
-
-=item B<--severity>
-
-Severity of the bug report. You will be prompted if you don't supply
-one on the command-line.
-
-=item B<--address>
-
-Your email address. The program will try to guess one if you don't
-provide one, but you'll still need to validate it.
-
-=item B<--editor>
-
-Editor to use for editing the bug report.
-
-=item B<--ack>, B<--noack>
-
-Don't send a bug received acknowledgement.
-
-=item B<--input-file>
-
-File containing the body of the report. Use this to quickly send a
-prepared message.
-
-=item B<--output-file>
-
-File where parrotbug will save its bug report, if you ask it to do so.
-
-=item B<--to>
-
-Email address to send report to. (for testing purposes only)
-
-=back
-
-
-=head2 Actions
-
-You can provide more than one action on the command-line. If none is
-supplied, then you will be prompted for what to do.
-
-=over 4
-
-=item B<--dump>
-
-Dump formatted report on standard output.
-
-=item B<--save>
-
-Save message to a file, in order for you to send it later from your
-own. See C<--output> flag.
-
-=item B<--send>
-
-Try to send a mail with the report.
-
-=item B<--help>
-
-Print a short synopsis and exit.
-
-=item B<--version>
-
-Print version information and exit.
-
-=back
-
-
-=head1 AUTHORS
-
-Jerome Quelin (E<lt>jquelin@cpan.orgE<gt>), with lots of good stuff taken from perlbug.
-
-
-=head1 SEE ALSO
-
-perlbug(1), parrot(1), diff(1), patch(1)
-
-=cut
-
-# Local Variables:
-#   mode: cperl
-#   cperl-indent-level: 4
-#   fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4: