parrotbug 0.0.1 - perl.perl6.internals

The old Google Groups will be going away soon, but your browser is incompatible with the new version.
perl.perl6.internals
Message from discussion parrotbug 0.0.1
Newsgroups: perl.perl6.internals
Path: archiver1.google.com!news2.google.com!news.maxwell.syr.edu!newsfeed.stanford.edu!nntp.perl.org
Mailing-List: contact perl6-internals-h...@perl.org; run by ezmlm
To: perl6-intern...@perl.org
Subject: [PATCH] parrotbug 0.0.1
Date: Mon, 1 Mar 2004 20:28:13 +0100
User-Agent: KMail/1.4.3
MIME-Version: 1.0
Content-Type: Multipart/Mixed;  boundary="------------Boundary-00=_1RWWKIASBXJ6G0CQIZRF"
Message-ID: <200403012028.13070.jquelin@mongueurs.net>
Approved: n...@nntp.perl.org
From: jque...@mongueurs.net (Jerome Quelin)

--------------Boundary-00=_1RWWKIASBXJ6G0CQIZRF
Content-Type: text/plain;
  charset="us-ascii"
Content-Transfer-Encoding: 8bit

Hi there,

Following Dan's warnocked demand, here's a first version of parrotbug:
 - it is very rough
 - it currently goes in parrot root dir
 - there is no embedded (pod) doc
 - it borrows heavily from perlbug
 - currently bug reports are sent to bugs-par...@bugs6.perl.org
 - it only accepts -ok / -nok flags (no *real* bug reports to be edited)
 - it includes parrot's myconfig file in the body of the mail
 - did I mention that it's still very rough? :-)

I did not checked it in parrot's repository because:
 - I don't know where it should go in parrot tree
 - the MANIFEST is to be updated too
 - the copyright is missing (Dan, please insert correct copyright)
 - if it does not go in parrot root dir, then the $parrotdir is to be 
updated (should it be updated at Parrot-Configure time? in that case, 
how to do it?)
 - I'm not sure about the reporting address (Robert, I need your advice 
on this one)

I'll continue to work on it when I'll find some time (tomorrow I hope).
But now that there's at least a skeleton, feel free to complete it!
Jerome
-- 
jque...@mongueurs.net

--------------Boundary-00=_1RWWKIASBXJ6G0CQIZRF
Content-Type: text/plain;
  charset="us-ascii";
  name="parrotbug"
Content-Transfer-Encoding: 7bit
Content-Disposition: attachment; filename="parrotbug"

#!perl

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

#
# This utility borrows heavily from perlbug.
#

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

my $VERSION = "0.0.1";
my $parrotbug = 'bugs-par...@bugs6.perl.org';
my $parrotdir = File::Spec->curdir();
my $myconfig  = File::Spec->catdir($parrotdir, "myconfig");
my ($address, $from, $subject, $messageid, $body);

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

BEGIN {
    eval "use Mail::Send;";
    $have_send = ($@ eq "");
    eval "use Mail::Util;";
    $have_util = ($@ eq "");
}

init();
help()    if $opt_h;
version() if $opt_V;
send_msg();
exit;




#-----------------------------------#
#               Subs.               #


sub help {
    print <<"EOF";

A program to help generate bug reports about parrot, and mail them.

Usage:

 $0 {-h|-V}
 $0 [-a address] [-r returnaddress] {-ok|-nok}

Options:
  -a    Address to send the report to. Defaults to '$parrotbug'.
  -h    Print this help message.
  -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 stop if you don't
        give it here.
  -V    Print version information.

EOF
    # '
    exit;
}

sub init {
    $is_mswin32 = $^O eq 'MSWin32';
    $is_vms     = $^O eq 'VMS';
    $is_linux   = lc($^O) eq 'linux';
    $is_macos   = $^O eq 'MacOS';

    @ARGV = split m/\s+/,
        MacPerl::Ask('Provide command-line args here (-h for help):')
        if $is_macos && $MacPerl::Version =~ /App/;

    if (!getopts("a:hn:o:r:s:")) { help(); exit; };

    ## Mail information.

    # Target address.
    $address = $opt_a || $parrotbug;

    # User address, used in message and in Reply-To header.
    $from = $opt_r || "";

    # Message-Id.
    my $domain;
    if ($::HaveUtil) {
        $domain = Mail::Util::maildomain();
    } elsif ($Is_MSWin32) {
        $domain = $ENV{'USERDOMAIN'};
    } else {
        require Sys::Hostname;
        $domain = Sys::Hostname::hostname();
    }
    $messageid = "<parrotbug_$VERSION_${$}_".time."\@$domain>";


    ## Report to be sent.

    # ok - send "OK" report for build on this system
    if ($opt_o || $opt_n) {
        $subject = ($opt_n ? 'Not ' : '')
                   . "OK: parrot"
                   ." $Config{archname} $::Config{osvers} $subject";
        $body = "Parrot reported to build OK on this system.\n\n";
        open(MYCONFIG, "<$myconfig") or die "Couldn't open '$myconfig'; $!\n";
        while(<MYCONFIG>) { $body .= $_ }
        close(MYCONFIG) or die "Error closing '$myconfig': $!";
    } else {
        help();
    }
}

sub send_msg {
    # Message has been accepted for transmission -- Send the message
    if ($outfile) {
	open SENDMAIL, ">$outfile" or die "Couldn't open '$outfile': $!\n";
	goto sendout;
    }

    # 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
    if ($have_send && !$is_linux) {
	my $msg = new Mail::Send Subject => $subject, To => $address;
	$msg->add("Reply-To",$from) if $from;

	$fh = $msg->open;
        print $fh $body;
	$fh->close;

	print "\nMessage sent.\n";

    } else {
	my $sendmail = "";
	for (qw(/usr/lib/sendmail /usr/sbin/sendmail /usr/ucblib/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 '$filename'.
EOF
        # '
	open(SENDMAIL, "|$sendmail -t -oi") || die "'|$sendmail -t -oi' failed: $!";

	print SENDMAIL "To: $address\n";
	print SENDMAIL "Subject: $subject\n";
	print SENDMAIL "Reply-To: $from\n" if $from;
	print SENDMAIL "Message-Id: $messageid\n" if $messageid;
	print SENDMAIL "\n\n";
        print SENDMAIL $body;

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


sub version {
    print <<"EOF";

This is $0, version $VERSION.

EOF

    exit;
}

--------------Boundary-00=_1RWWKIASBXJ6G0CQIZRF--
Create a group - Google Groups - Google Home - Terms of Service - Privacy Policy
Account Options
