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 [EMAIL PROTECTED]
- 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
--
[EMAIL PROTECTED]
#!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 = '[EMAIL PROTECTED]';
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."[EMAIL PROTECTED]>";
## 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;
}
