3 # Copyright (C) 2004-2007, The Perl Foundation.
7 eval 'exec perl -w -S $0 ${1+"$@"}'
8 if $running_under_some_shell;
18 my $VERSION = "0.6.1";
20 # These are the standard addresses for reporting bugs.
22 ( bug
=> 'parrotbug@parrotcode.org',
23 ok
=> 'parrotstatus-ok@parrotcode.org',
24 nok
=> 'parrotstatus-nok@parrotcode.org',
27 my $parrotdir = File
::Spec
->curdir();
28 my ( %opts, %parrot, %report );
29 my ( $editor, $user, $domain, $msgid, $tmpfile );
30 my ( $is_linux, $is_macos, $is_mswin32, $is_os2, $is_vms );
31 my @categories = qw
[ core docs install library utilities languages
];
32 my @severities = qw
[ critical high medium low wishlist none
];
35 #------------------------------------------------------------#
39 help
() if $opts{help
};
40 version
() if $opts{version
};
41 explain_parrotbug
() unless $opts{quiet
};
49 # Explain what C<parrotbug> is.
50 sub explain_parrotbug
{
53 This program provides an easy way to create a message reporting a bug
54 in parrot, and e-mail it to the parrot developers.
56 It is *NOT* intended for:
57 - sending test messages,
58 - or reporting bugs in languages targetting parrot,
59 - or reporting bugs in some library bindings for parrot,
60 - or simply verifying that parrot works.
62 It is *ONLY* a mean of reporting verifiable problems with the core
63 parrot distribution, and any solutions to such problems, to parrot
66 If you're just looking for help with parrot, subscribe to the parrot
67 mailing list, parrot-porters<at>perl.org.
77 #------------------------------------------------------------#
80 # Generate random filename to edit report.
81 sub generate_filename
{
82 my $dir = File
::Spec
->tmpdir();
83 my $filename = "bugrep0$$";
84 $filename++ while -e File
::Spec
->catfile($dir, $filename);
85 $filename = File
::Spec
->catfile($dir, $filename);
90 # Check whether a subject is trivial. A subject is not considered trivial
91 # if it's an ok or a nok report.
92 # Return 1 if trivial, 0 otherwise (subject acceptable).
96 return 0 if $opts{ok
} || $opts{nok
};
98 /^(y(es)?|no?|help|parrot( (bug|problem))?|bug|problem)$/i ||
99 length($subject) < 4 ||
111 #------------------------------------------------------------#
114 # Initialize the program.
116 # Get parrot information, process the options, create the message
117 # information (subject, to, body, etc.) depending on the type of report
118 # (ok, nok or bug report).
120 $is_linux = lc($^O
) eq 'linux';
121 $is_mswin32 = $^O
eq 'MSWin32';
122 $is_os2 = $^O
eq 'os2';
123 $is_vms = $^O
eq 'VMS';
126 ## Fetch Parrot information.
129 # Get parrot version.
130 # There will always be an up-to-date $parrot/VERSION
131 my $filename = File
::Spec
->catfile($parrotdir, "VERSION");
132 open(VERSION
, "<$filename") or die "Cannot open '$filename': $!";
133 $parrot{version
} = <VERSION
>;
134 chomp $parrot{version
};
135 close(VERSION
) or die "Cannot close '$filename': $!";
137 # Get parrot configuration, stored in $parrot/myconfig
138 $filename = File
::Spec
->catfile($parrotdir, "myconfig");
139 open(MYCONFIG
, "<$filename") or die "Cannot open '$filename': $!";
142 $parrot{myconfig
} = <MYCONFIG
>;
144 close(MYCONFIG
) or die "Cannot close '$filename': $!";
150 Getopt
::Long
::Configure
("no_bundling", "no_ignore_case", "auto_abbrev");
151 help
() unless GetOptions
153 "help|h", "version|V",
154 "send", "dump", "save",
155 "from|f=s", "to|test|t=s", "editor|e=s",
156 "subject|s=s", "category|C=s", "severity|S=s",
157 "input|input-file|i=s", "output|output-file|o=s",
158 "ok", "nok", "ack!", "quiet|q!" );
161 ## Report to be sent.
165 last ok_report
unless defined $opts{ok
};
167 # This is an ok report, woohoo!
168 $report{to
} = $std_to{ok
};
169 $report{subject
} = "OK: parrot $parrot{version} "
170 . "on $Config{archname} $Config{osvers}";
171 $report{body
} = "Parrot reported to build OK on this system.\n";
172 $report{category
} = "install";
173 $report{severity
} = "none";
178 # Ok reports do not need body, but nok and bug reports do need
180 if ( $opts{input
} ) {
181 # Report was pre-written, slurp it.
182 open BODY
, "<$opts{input}" or die "Can't open '$opts{input}': $!";
184 $report{body
} = <BODY
>;
185 close BODY
or die "Can't close '$opts{input}': $!";
188 # No file provided...
193 last nok_report
unless defined $opts{nok
};
195 # This a nok report, how sad... :-(
196 $report{to
} = $std_to{nok
};
197 $report{subject
} = "Not OK: parrot $parrot{version} "
198 . "on $Config{archname} $Config{osvers}";
199 $report{category
} = "install";
200 $report{severity
} = "none";
204 # Neither an ok nor a nok.
205 $report{to
} = $std_to{bug
};
206 $report{subject
} = $opts{subject
} || "";
207 $report{category
} = $opts{category
} || "";
208 $report{severity
} = $opts{severity
} || "";
211 # Test message, shortcuting recipent.
212 $report{to
} = $opts{to
} if $opts{to
};
219 $user = $is_mswin32 ?
$ENV{USERNAME
}
220 : $is_os2 ?
$ENV{USER
} || $ENV{LOGNAME
}
221 : $is_macos ?
$ENV{USER
}
222 : eval { getpwuid($<) }; # May be missing
224 # User address, used in message and in Reply-To header.
225 $report{from
} = $opts{from
} || "";
228 $editor = $ENV{VISUAL
} || $ENV{EDITOR
} || $ENV{EDIT
}
229 || ( $is_vms && "edit/tpu" )
230 || ( $is_mswin32 && "notepad" )
231 || ( $is_macos && "" )
240 eval "use Mail::Util;";
242 $domain = Mail
::Util
::maildomain
();
244 elsif ($is_mswin32) {
245 $domain = $ENV{USERDOMAIN
};
248 require Sys
::Hostname
;
249 $domain = Sys
::Hostname
::hostname
();
251 $msgid = "<parrotbug_${VERSION}_${$}_".time."\@$domain>";
256 #------------------------------------------------------------#
259 # Query missing information in order to have a complete report.
260 sub query_missing_info
{
261 $report{subject
} = "" if trivial_subject
( $report{subject
} );
262 $report{subject
} = ask_for_subject
() unless $report{subject
};
263 $report{category
} = ask_for_alternative
( "category", \
@categories)
264 unless $report{category
};
265 $report{severity
} = ask_for_alternative
( "severity", \
@severities)
266 unless $report{severity
};
267 $report{from
} = ask_for_return_address
() unless $report{from
};
268 $report{body
} = ask_for_body
() unless $report{body
};
272 # Prompt for alternatives from a set of choices.
274 # The arguments are: the name of alternative, the choices (as an array
275 # ref), and the default answer. (first element if undef)
277 # Return the lowercased alternative chosen.
279 # Die if more than 5 wrong answers.
280 sub ask_for_alternative
{
281 my ( $what, $choices, $default ) = @_;
283 print <<EOT unless $opts{quiet};
284 Please pick a $what from the following:
289 $default ||= $choices->[0];
293 die "Invalid $alt: aborting.\n" if $err++ > 5;
294 print "Please enter a $what [$default]: ";
297 $alt = $default if $alt =~ /^\s*$/;
298 } until ( ($alt) = grep /^$alt/i, @
$choices );
305 # Prompt for a body, through an external editor.
307 unless ( $opts{quiet
} ) {
309 Now you need to supply the bug report. Try to make the report concise
310 but descriptive. Include any relevant detail. If you are reporting
311 something that does not work as you think it should, please try to
312 include example of both the actual result, and what you expected.
314 Some information about your local parrot configuration will
315 automatically be included at the end of the report. If you are using
316 any unusual version of parrot, please try and confirm exactly which
317 versions are relevant.
321 print "Press 'Enter' to continue...\n";
325 # Prompt for editor to use if none supplied.
326 if ( $opts{editor
} ) {
327 $editor = $opts{editor
};
331 ask_for_editor
($opts{quiet
} ?
"" : <<EOT);
332 You will probably want to use an editor to enter the report. If the
333 default editor proposed below is the editor you want to use, then just
334 press the 'Enter' key, otherwise type in the name of the editor you
340 $tmpfile = generate_filename
();
344 edit_bug_report
( $tmpfile );
346 open BODY
, "<$tmpfile" or die "Can't open '$tmpfile': $!";
351 close BODY
or die "Can't close '$tmpfile': $!";
353 print "\nYou provided an empty bug report!\n";
354 print "Press 'Enter' to continue...\n";
357 die "Aborting.\n" if $err++ == 5;
364 # Prompt for editor to use.
366 print shift() . "Editor [$editor]: ";
369 $editor = $entry if $entry ne "";
370 $opts{editor
} = $editor;
374 # Prompt for return address, return it.
375 sub ask_for_return_address
{
376 print <<EOT unless $opts{quiet};
377 Your e-mail address will be useful if you need to be contacted. If the
378 default shown below is not your full internet e-mail address, please
382 # Try and guess return address
384 $guess = $ENV{'REPLY-TO'} || $ENV{REPLYTO
} || "";
387 # Use $domain if we can.
389 $guess = $is_vms && !$Config{d_socket
} ?
390 "$domain\:\:$user" : "$user\@$domain";
395 print "Your address [$guess]: ";
398 $from = $guess if $from eq "";
404 # Prompt for subject of message.
406 # Return the subject chosen.
408 # Die if more than 5 wrong subjects.
409 sub ask_for_subject
{
410 print <<EOT unless $opts{quiet};
411 First of all, please provide a subject for the message. It should be a
412 concise description of the bug or problem. "parrot bug" or "parrot
413 problem" is not a concise description.
420 $err and print "\nThat doesn't look like a good subject. "
421 . "Please be more verbose.\n";
424 $subject = q{} unless defined $subject;
426 die "Aborting.\n" if $err++ == 5;
427 } while ( trivial_subject
($subject) );
433 # Launch an editor in which to edit the bug report.
434 sub edit_bug_report
{
435 my $filename = shift;
439 $retval = system("$editor $filename");
441 # Check whether editor run was successful.
442 die <<EOT if $retval;
443 The editor you chose ('$editor') could apparently not be run! Did you
444 mistype the name of your editor?
452 #------------------------------------------------------------#
456 # Display everything collected.
458 print "==> Dumping message...\n";
459 print format_message
();
463 # Last chance to edit report.
465 # Prompt for editor to use if none supplied.
466 unless ( $opts{editor
} ) {
467 ask_for_editor
(<<EOT);
468 You will probably want to use an editor to modify the report. If the
469 default editor proposed below is the editor you want to use, then just
470 press the 'Enter' key, otherwise type in the name of the editor you
475 $tmpfile ||= $opts{input
};
479 edit_bug_report
( $tmpfile );
481 open BODY
, "<$tmpfile" or die "Can't open '$tmpfile': $!";
486 close BODY
or die "Can't close '$tmpfile': $!";
488 print "\nYou provided an empty bug report!\n";
489 print "Press 'Enter' to continue...\n";
492 die "Aborting.\n" if $err++ == 5;
495 $report{body
} = $body;
499 # Format the message with everything collected and return it.
503 # OS, arch, compiler...
506 osname= $Config{osname}
507 osvers= $Config{osvers}
508 arch= $Config{archname}
511 my $cc = $Config{cc
};
512 #$report .= "cc= $cc $Config{${cc}.'version'}\n";
513 $report .= "cc= $cc\n";
520 category=$report{category}
521 severity=$report{severity}
523 $report .= " ack=no\n" if ! $opts{ack
};
526 $report .= "---\n$report{body}\n";
529 $report .= "---\n$parrot{myconfig}\n---\n";
531 # ... and environment.
532 $report .= "Environment:\n";
533 my @env = qw
[ PATH LD_LIBRARY_PATH LANG SHELL HOME LOGDIR LANGUAGE
];
534 push @env, $Config{ldlibpthname
} if $Config{ldlibpthname
} ne '';
535 push @env, grep /^(?:PERL|LC_|LANG|CYGWIN)/, keys %ENV;
538 for my $env (sort keys %env) {
539 my $env_value = exists $ENV{$env} ?
"=$ENV{$env}\n" : " (unset)\n";
540 $report .= " $env $env_value";
547 # Print synopsis + help message and exit.
551 A program to help generate bug reports about parrot, and mail them.
552 It is designed to be used interactively. Normally no arguments will
555 Simplest usage: run '$0', and follow the prompts.
556 Usage: $0 [OPTIONS] [ACTIONS]
559 --ok Report successful build on this system to parrot
560 developers. Only use --ok if *everything* was ok:
561 if there were *any* problems at all, use --nok.
562 --nok Report unsuccessful build on this system.
563 --subject <subject> Subject to include with the message.
564 --category <category> Category of the bug report.
565 --severity <severity> Severity of the bug report.
566 --from <address> Your email address.
567 --editor <editor> Editor to use for editing the bug report.
568 --ack, --noack Don't send a bug received acknowledgement.
569 --input-file File containing the body of the report. Use this
570 to quickly send a prepared message.
571 --output-file File where parrotbug will save its bug report.
572 --to <address> Email address to send report to. (testing only)
574 Note: you will be prompted if the program miss some information.
580 --help Print this help message and exit.
581 --version Print version information and exit.
588 # Save message to file.
590 print "\n==> Saving message to file...\n";
591 if ( ! $opts{output
} ) {
592 print "Enter filename to save bug report: ";
593 $opts{output
} = <STDIN
>;
596 open OUTPUT
, ">$opts{output}" or die "Cannot open '$opts{output}': $!";
597 print OUTPUT format_message
();
598 close OUTPUT
or die "Cannot open '$opts{output}': $!";
600 print "Message saved.\n";
604 # Send message to final recipient.
606 print "==> Sending message to recipient...\n";
608 # On linux certain mail implementations won't accept the subject
609 # as "~s subject" and thus the Subject header will be corrupted
610 # so don't use Mail::Send to be safe
611 eval "require Mail::Send";
612 if ( $@
eq "" && !$is_linux) {
613 my $msg = new Mail
::Send Subject
=> $report{subject
}, To
=> $report{to
};
614 $msg->add( "Reply-To", $report{from
} );
617 print $fh format_message
();
620 print "\nMessage sent.\n";
625 for ( qw
[ /usr/lib
/sendmail /usr
/sbin/sendmail
626 /usr/ucblib
/sendmail /var
/qmail/bin
/sendmail
] ) {
627 $sendmail = $_, last if -e
$_;
630 die <<EOT if $sendmail eq "";
631 I am terribly sorry, but I cannot find sendmail, or a close
632 equivalent, and the perl package Mail::Send has not been installed, so
633 I can't send your bug report. We apologize for the inconvenience.
635 So you may attempt to find some way of sending your message, it has
636 been left in the file '$tmpfile'.
639 open(SENDMAIL
, "|$sendmail -t -oi") || die "'|$sendmail -t -oi' failed: $!";
641 print SENDMAIL
<<EOT;
643 Subject: $report{subject}
644 Reply-To: $report{from}
649 print SENDMAIL format_message
();
650 if (close(SENDMAIL
)) {
651 printf "\nMessage sent.\n";
654 warn "\nSendmail returned status '", $?
>> 8, "'\n";
660 # Print version information (of the parrotbug program) and exit.
664 This is $0, version $VERSION.
671 # Check whether actions have been provided on comand-line, otherwise
672 # prompt for what to do with bug report.
674 dump_report
() if $opts{dump};
675 save_report
() if $opts{save
};
676 send_report
() if $opts{send};
678 return if $opts{dump} || $opts{save
} || $opts{send};
680 # No actions provided on command-line, prompt for action.
684 print "Action (send,display,edit,save,quit): ";
687 dump_report
(), last sw
if /^d/i;
688 edit_report
(), last sw
if /^e/i;
689 save_report
(), last sw
if /^sa/i;
690 send_report
(), last sw
if /^se/i;
691 print "Uh?\n" unless /^q/i;
693 } until ( $action =~ /^q/i );
701 parrotbug - Parrot Bug Reporter
705 % ./parrotbug [options] [actions]
709 A program to help generate bug reports about parrot, and mail them.
710 It is designed to be used interactively. Normally no arguments will
714 =head1 COMMAND-LINE SWITCHES
719 Note: you will be prompted if the program miss some information.
725 Report unsuccessful build on this system to parrot developers.
729 Report successful build on this system to parrot developers Only use
730 C<--ok> if B<everything> was ok; if there were B<any> problems at all,
735 Subject of the report. You will be prompted if you don't supply one on
740 Category of the bug report. You will be prompted if you don't supply
741 one on the command-line.
745 Severity of the bug report. You will be prompted if you don't supply
746 one on the command-line.
750 Your email address. The program will try to guess one if you don't
751 provide one, but you'll still need to validate it.
755 Editor to use for editing the bug report.
757 =item B<--ack>, B<--noack>
759 Don't send a bug received acknowledgement.
761 =item B<--input-file>
763 File containing the body of the report. Use this to quickly send a
766 =item B<--output-file>
768 File where parrotbug will save its bug report, if you ask it to do so.
772 Email address to send report to. (for testing purposes only)
779 You can provide more than one action on the command-line. If none is
780 supplied, then you will be prompted for what to do.
786 Dump formatted report on standard output.
790 Save message to a file, in order for you to send it later from your
791 own. See C<--output> flag.
795 Try to send a mail with the report.
799 Print a short synopsis and exit.
803 Print version information and exit.
810 Jerome Quelin (E<lt>jquelin@cpan.orgE<gt>), with lots of good stuff taken from perlbug.
815 perlbug(1), parrot(1), diff(1), patch(1)
821 # cperl-indent-level: 4
824 # vim: expandtab shiftwidth=4: