#!/usr/bin/perl -w
# Copyright: 2004 The Perl Foundation.  All Rights Reserved.
# $Id: parrotbug,v 1.26 2004/03/10 18:07:57 jquelin Exp $

=head1 NAME

parrotbug - Parrot Bug Reporter

=head1 SYNOPSIS

    % ./parrotbug [options]

=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.

=head2 Command-line Options

=over 4

=item C<-A>

Don't send a bug received acknowledgement to the return address.

=item C<-b>

Body of the report. If not included on the command line, or in a file
with C<-f>, you will get a chance to edit the message.

=item C<-d>

Dump mode. This prints out your configuration data, without mailing
anything.

=item C<-e>

Editor to use.

=item C<-f>

File containing the body of the report. Use this to quickly send a
prepared message.

=item C<-h>

Print this help message and exit.

=item C<-nok>

Report unsuccessful build on this system to parrot developpers

=item C<-ok>

Report successful build on this system to parrot developpers Only use
C<-ok> if B<everything> was ok; if there were B<any> problems at all,
use C<-nok>.

=item C<-r>

Your return address. The program will ask you to confirm this if you
don't give it here.

=item C<-s>

Subject to include with the message. You will be prompted if you don't
supply one on the command line.

=item C<-V>

Print version information and exit.

=cut

#'
eval 'exec perl -w -S $0 ${1+"$@"}'
  if $running_under_some_shell;

use strict;
use Config;
use File::Spec;
use Getopt::Std;

my $VERSION = "0.2.2";

my %std_to = 
  ( bug => 'parrotbug@parrotcode.org',
    ok  => 'parrotstatus-ok@parrotcode.org',
    nok => 'parrotstatus-nok@parrotcode.org',
  );

my $parrotdir = File::Spec->curdir();

my %opts;
my ( $user, $domain, $editor, $use_file );
my ( $to, $cc, $from, $subject, $msgid, $body );
my ( $category, $severity );
my ( $is_linux, $is_macos, $is_mswin32, $is_os2, $is_vms );
my ( $parrot_version, $parrot_myconfig ) ;


#------------------------------------------------------------#
#                       Main program.                        #

init();
help()    if $opts{h};
version() if $opts{V};
if ( $opts{d} ) { dump_info(*STDOUT); exit; }
explain_parrotbug();
query_info();
send_msg();
exit;


#Explain what C<parrotbug> is.
sub explain_parrotbug {
    print <<EOF;

This program provides an easy way to create a message reporting a bug
in parrot, and e-mail it to parrot developpers.

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
developpers.

If you're just looking for help with parrot, subscribe to the parrot
mailing list, perl6-internals<at>perl.org.



EOF
#'
}


#Print synopsis + help message and exit.
sub help {
    print <<EOF;

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.

Usage:

 $0 [-s subject] [-b body] [-f inputfile] [-r returnaddress] [-A]
    [-e editor] [-t address] ][-ok|-nok|-d]
 $0 {-h|-V}

Simplest usage:  run '$0', and follow the prompts.

Options:
  -A    Don't send a bug received acknowledgement to the return address.
  -b    Body of the report. If not included on the command line, or
        in a file with -f, you will get a chance to edit the message.
  -d    Dump mode.  This prints out your configuration data, without mailing
        anything.
  -e    Editor to use.
  -f    File containing the body of the report. Use this to
        quickly send a prepared message.
  -h    Print this help message and exit.
  -nok  Report unsuccessful build on this system to parrot developpers
  -ok   Report successful build on this system to parrot developpers
        Only use -ok if *everything* was ok: if there were *any* problems
        at all, use -nok.
  -r    Your return address. The program will ask you to confirm
        this if you don't give it here.
  -s    Subject to include with the message. You will be prompted
        if you don't supply one on the command line.
  -t    Test mode, so one can provide an address to send reports to.
  -V    Print version information and exit.

EOF
#'
    exit;
}


# Print version information (of the parrotbug program) and exit.
sub version {
    print <<"EOF";

This is $0, version $VERSION.

EOF
    exit;
}




#------------------------------------------------------------#
#                        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{o} || $opts{n};
    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_macos   = $^O eq 'MacOS';
    $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.
    ##
    @ARGV = split m/\s+/,
        MacPerl::Ask("Provide command-line args here (-h for help):")
        if $is_macos && $MacPerl::Version =~ /App/;
    help() unless getopts("AVhb:de:f:n:o:r:s:t:", \%opts);


    ##
    ## Report to be sent.
    ##
  sw: {
      opt_o: {
            last opt_o unless defined $opts{o};
            help()     unless $opts{o} eq "k";

            # This is an ok report, woohoo!
            $to = $std_to{ok};
            $subject = "OK: parrot $parrot_version "
              . "on $Config{archname} $Config{osvers}";
            $body = "Parrot reported to build OK on this system.\n";
            $category = "install";
            $severity = "none";
            last sw;
        };

        # Ok reports do not need body, but nok and bug reports do need
        # a body. It can be done with either -f or -b flag.
        if ( $opts{f} ) {
            $use_file = 1;
        } else {
            # No file provided...
            $use_file = 0;
            $body = $opts{b} || "";
        }
            

      opt_n: {
            last opt_n unless defined $opts{n};
            help()     unless $opts{n} eq "ok";

            # This a nok report, how sad... :-(
            $to = $std_to{nok};
            $subject = "Not OK: parrot $parrot_version "
              . "on $Config{archname} $Config{osvers}";
            $category = "install";
            $severity = "none";
            last sw;
        };

        # Neither an ok nor a nok.
        $to = $std_to{bug};
        $subject  = $opts{s} || "";
        $category = "";
        $severity = "";
    };

    # Test message, shortcuting recipent.
    $to = $opts{t} if $opts{t};

    ## 
    ## 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.
    $from = $opts{r} || "";

   # 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_info {
    $subject = "" if trivial_subject( $subject );
    ask_for_subject()        unless $subject;
    ask_for_alternative
      ( "category", [ qw[ core docs install library utilities ] ],
        "core" )             unless $category;
    ask_for_alternative
      ( "severity", [ qw[ critical high medium low wishlist none ] ],
        "low" )              unless $severity;
    ask_for_return_address() unless $from;
    ask_for_body()           unless $use_file || $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.
# 
# Return the lowercased alternative chosen.
# 
# Die if more than 5 wrong answers.
sub ask_for_alternative {
    my ( $what, $choices, $default ) = @_;

    print <<EOF;
Please pick a $what from the following:
  @{$choices}

EOF

    my $alt;
    my $err = 0;
    do {
        die "Invalid $alt: aborting.\n" if $err++ > 5;
        print "Please enter a $what [$default]: ";
        $alt = <>;
        chomp $alt;
        $alt = $default if $alt =~ /^\s*$/;
    } until ( ($alt) = grep /^$alt/i, @$choices );

    print "\n\n\n";
    return lc $alt;
}


# Prompt for body, through an external editor.
sub ask_for_body {
    print <<EOF;
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.

EOF

    # Prompt for editor to use if none supplied.
    if ( $opts{e} ) {
        $editor = $opts{e};
        print "Press 'Enter' to continue...\n";
        scalar <>;

    } else {
        ask_for_editor(<<EOF) unless $opts{e};
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.
EOF
    }

    # Launch editor.
    $opts{f} = generate_filename();
    edit_bug_report( $opts{f} );
}


# Prompt for editor to use.
sub ask_for_editor {
    print shift() . "Editor [$editor]: ";
    my $entry = <>;
    chomp $entry;
    $editor = $entry if $entry ne "";
}


# Prompt for return address.
sub ask_for_return_address {
    print <<EOF;
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.
EOF
    
    # Try and guess return address
    my $guess;
    if ( $is_macos ) {
        require Mac::InternetConfig;
        $guess = $Mac::InternetConfig::InternetConfig{
                   Mac::InternetConfig::kICEmail()
                 };
    } else {
        $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 = <>;
    chomp $from;
    $from = $guess if $from eq "";
    print "\n\n\n";
}


# Prompt for subject of message.
sub ask_for_subject {
    print <<EOF;
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.

EOF

    my $err = 0;
    do {
        $err and print "\nThat doesn't look like a good subject. "
          . "Please be more verbose.\n";
        print "Subject: ";
        $subject = <>;
        chomp $subject;
        die "Aborting.\n" if $err++ == 5;
    } while ( trivial_subject($subject) );
    print "\n\n\n";
}


# Launch an editor in which to edit the bug report.
sub edit_bug_report {
    my $filename = shift;

    # Launch editor.
    my $retval;
    if ($is_macos) {
        require ExtUtils::MakeMaker;
        ExtUtils::MM_MacOS::launch_file($filename);
        print "Press Enter when done.\n";
        scalar <>;
    } else {
        $retval = system("$editor $filename");
    }

    # Check whether editor run was successful.
    die <<EOF if $retval;
The editor you chose ('$editor') could apparently not be run! Did you
mistype the name of your editor?

EOF

}



#------------------------------------------------------------#
#                        Action subs.                        #

# Dump everything collected on the specified glob.
sub dump_info {
    local (*OUT) = @_;

    # OS, arch, compiler...
    print OUT <<EOF;
---
osname= $Config{osname}
osvers= $Config{osvers}
arch=   $Config{archname}
EOF

    my $cc = $Config{cc};
    print OUT "cc=     $cc $Config{${cc}.'version'}\n";


    # ... flags...
    print OUT <<EOF;
---
Flags:
    category=$category
    severity=$severity
EOF
    print OUT "    ack=no\n" if $opts{A};

    # ... myconfig ...
    print OUT "---\n$parrot_myconfig\n---\n";

    # ... and environment.
    print OUT "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) {
	print OUT "    $env",
          exists $ENV{$env} ? "=$ENV{$env}\n" : " (unset)\n";
    }
}


# Send message to final recipient.
sub send_msg {
    # Get the body.
    if ( $opts{f} ) {
        open BODY, "<$opts{f}" or die "Can't open '$opts{f}': $!";
        local $/;
        $body = <BODY>;
        close BODY or  die "Can't close '$opts{f}': $!";
    }
    
    # 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 => $subject, To => $to;
	$msg->add( "Reply-To", $from );

	my $fh = $msg->open;
        print $fh <<EOF;
-----------------------------------------------------------------
$body
-----------------------------------------------------------------
EOF
        dump_info($fh);
	$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 <<EOF 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 '$opts{f}'.
EOF
# '
	open(SENDMAIL, "|$sendmail -t -oi") || die "'|$sendmail -t -oi' failed: $!";

	print SENDMAIL <<EOT;
To: $to
Subject: $subject
Reply-To: $from
Message-Id: $msgid

-----------------------------------------------------------------
$body
-----------------------------------------------------------------
EOT

        dump_info( *SENDMAIL );
	if (close(SENDMAIL)) {
	    printf "\nMessage sent.\n";
	} else {
	    warn "\nSendmail returned status '", $? >> 8, "'\n";
	}
	}
}

=back

=head1 HISTORY

This utility borrows heavily from perlbug.

=cut

__END__
