| 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 ]; |
| 33 | | |
| 34 | | |
| 35 | | #------------------------------------------------------------# |
| 36 | | # Main program. # |
| 37 | | |
| 38 | | init(); |
| 39 | | help() if $opts{help}; |
| 40 | | version() if $opts{version}; |
| 41 | | explain_parrotbug() unless $opts{quiet}; |
| 42 | | query_missing_info(); |
| 43 | | what_next(); |
| 44 | | unlink $tmpfile; |
| 45 | | exit; |
| 46 | | |
| 47 | | |
| 48 | | |
| 49 | | # Explain what C<parrotbug> is. |
| 50 | | sub explain_parrotbug { |
| 51 | | print <<EOT; |
| 52 | | |
| 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. |
| 55 | | |
| 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. |
| 61 | | |
| 62 | | It is *ONLY* a mean of reporting verifiable problems with the core |
| 63 | | parrot distribution, and any solutions to such problems, to parrot |
| 64 | | developers. |
| 65 | | |
| 66 | | If you're just looking for help with parrot, subscribe to the parrot |
| 67 | | mailing list, parrot-dev<at>lists.parrot.org. |
| 68 | | |
| 69 | | |
| 70 | | |
| 71 | | EOT |
| 72 | | } |
| 73 | | |
| 74 | | |
| 75 | | |
| 76 | | |
| 77 | | #------------------------------------------------------------# |
| 78 | | # Utils subs. # |
| 79 | | |
| 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); |
| 86 | | return $filename; |
| 87 | | } |
| 88 | | |
| 89 | | |
| 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). |
| 93 | | sub trivial_subject { |
| 94 | | my $subject = shift; |
| 95 | | |
| 96 | | return 0 if $opts{ok} || $opts{nok}; |
| 97 | | if ( $subject =~ |
| 98 | | /^(y(es)?|no?|help|parrot( (bug|problem))?|bug|problem)$/i || |
| 99 | | length($subject) < 4 || |
| 100 | | $subject !~ /\s/ ) { |
| 101 | | return 1; |
| 102 | | } |
| 103 | | else { |
| 104 | | return 0; |
| 105 | | } |
| 106 | | } |
| 107 | | |
| 108 | | |
| 109 | | |
| 110 | | |
| 111 | | #------------------------------------------------------------# |
| 112 | | # Init subs. # |
| 113 | | |
| 114 | | # Initialize the program. |
| 115 | | # |
| 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). |
| 119 | | sub init { |
| 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'; |
| 124 | | |
| 125 | | ## |
| 126 | | ## Fetch Parrot information. |
| 127 | | ## |
| 128 | | |
| 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': $!"; |
| 136 | | |
| 137 | | # Get parrot configuration, stored in $parrot/myconfig |
| 138 | | $filename = File::Spec->catfile($parrotdir, "myconfig"); |
| 139 | | open(MYCONFIG, "<$filename") or die "Cannot open '$filename': $!"; |
| 140 | | { |
| 141 | | local $/; |
| 142 | | $parrot{myconfig} = <MYCONFIG>; |
| 143 | | } |
| 144 | | close(MYCONFIG) or die "Cannot close '$filename': $!"; |
| 145 | | |
| 146 | | |
| 147 | | ## |
| 148 | | ## Process options. |
| 149 | | ## |
| 150 | | Getopt::Long::Configure("no_bundling", "no_ignore_case", "auto_abbrev"); |
| 151 | | help() unless GetOptions |
| 152 | | ( \%opts, |
| 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!" ); |
| 159 | | |
| 160 | | ## |
| 161 | | ## Report to be sent. |
| 162 | | ## |
| 163 | | sw: { |
| 164 | | ok_report: { |
| 165 | | last ok_report unless defined $opts{ok}; |
| 166 | | |
| 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"; |
| 174 | | $report{body} = ""; |
| 175 | | last sw; |
| 176 | | }; |
| 177 | | |
| 178 | | # Ok reports do not need body, but nok and bug reports do need |
| 179 | | # a body. |
| 180 | | if ( $opts{input} ) { |
| 181 | | # Report was pre-written, slurp it. |
| 182 | | open BODY, "<$opts{input}" or die "Can't open '$opts{input}': $!"; |
| 183 | | local $/; |
| 184 | | $report{body} = <BODY>; |
| 185 | | close BODY or die "Can't close '$opts{input}': $!"; |
| 186 | | } |
| 187 | | else { |
| 188 | | # No file provided... |
| 189 | | $report{body} = ""; |
| 190 | | } |
| 191 | | |
| 192 | | nok_report: { |
| 193 | | last nok_report unless defined $opts{nok}; |
| 194 | | |
| 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"; |
| 201 | | last sw; |
| 202 | | }; |
| 203 | | |
| 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} || ""; |
| 209 | | }; |
| 210 | | |
| 211 | | # Test message, shortcuting recipent. |
| 212 | | $report{to} = $opts{to} if $opts{to}; |
| 213 | | |
| 214 | | ## |
| 215 | | ## User information. |
| 216 | | ## |
| 217 | | |
| 218 | | # Username. |
| 219 | | $user = $is_mswin32 ? $ENV{USERNAME} |
| 220 | | : $is_os2 ? $ENV{USER} || $ENV{LOGNAME} |
| 221 | | : $is_macos ? $ENV{USER} |
| 222 | | : eval { getpwuid($<) }; # May be missing |
| 223 | | |
| 224 | | # User address, used in message and in Reply-To header. |
| 225 | | $report{from} = $opts{from} || ""; |
| 226 | | |
| 227 | | # Editor |
| 228 | | $editor = $ENV{VISUAL} || $ENV{EDITOR} || $ENV{EDIT} |
| 229 | | || ( $is_vms && "edit/tpu" ) |
| 230 | | || ( $is_mswin32 && "notepad" ) |
| 231 | | || ( $is_macos && "" ) |
| 232 | | || "vi"; |
| 233 | | |
| 234 | | |
| 235 | | ## |
| 236 | | ## Mail information. |
| 237 | | ## |
| 238 | | |
| 239 | | # Message-Id. |
| 240 | | eval "use Mail::Util;"; |
| 241 | | if ( $@ eq "" ) { |
| 242 | | $domain = Mail::Util::maildomain(); |
| 243 | | } |
| 244 | | elsif ($is_mswin32) { |
| 245 | | $domain = $ENV{USERDOMAIN}; |
| 246 | | } |
| 247 | | else { |
| 248 | | require Sys::Hostname; |
| 249 | | $domain = Sys::Hostname::hostname(); |
| 250 | | } |
| 251 | | $msgid = "<parrotbug_${VERSION}_${$}_".time."\@$domain>"; |
| 252 | | } |
| 253 | | |
| 254 | | |
| 255 | | |
| 256 | | #------------------------------------------------------------# |
| 257 | | # Querying subs. # |
| 258 | | |
| 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}; |
| 269 | | } |
| 270 | | |
| 271 | | |
| 272 | | # Prompt for alternatives from a set of choices. |
| 273 | | # |
| 274 | | # The arguments are: the name of alternative, the choices (as an array |
| 275 | | # ref), and the default answer. (first element if undef) |
| 276 | | # |
| 277 | | # Return the lowercased alternative chosen. |
| 278 | | # |
| 279 | | # Die if more than 5 wrong answers. |
| 280 | | sub ask_for_alternative { |
| 281 | | my ( $what, $choices, $default ) = @_; |
| 282 | | |
| 283 | | print <<EOT unless $opts{quiet}; |
| 284 | | Please pick a $what from the following: |
| 285 | | @{$choices} |
| 286 | | |
| 287 | | EOT |
| 288 | | |
| 289 | | $default ||= $choices->[0]; |
| 290 | | my $alt; |
| 291 | | my $err = 0; |
| 292 | | do { |
| 293 | | die "Invalid $alt: aborting.\n" if $err++ > 5; |
| 294 | | print "Please enter a $what [$default]: "; |
| 295 | | $alt = <STDIN>; |
| 296 | | chomp $alt; |
| 297 | | $alt = $default if $alt =~ /^\s*$/; |
| 298 | | } until ( ($alt) = grep /^$alt/i, @$choices ); |
| 299 | | |
| 300 | | print "\n\n\n"; |
| 301 | | return lc $alt; |
| 302 | | } |
| 303 | | |
| 304 | | |
| 305 | | # Prompt for a body, through an external editor. |
| 306 | | sub ask_for_body { |
| 307 | | unless ( $opts{quiet} ) { |
| 308 | | print <<EOT; |
| 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. |
| 313 | | |
| 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. |
| 318 | | |
| 319 | | EOT |
| 320 | | |
| 321 | | print "Press 'Enter' to continue...\n"; |
| 322 | | scalar <STDIN>; |
| 323 | | } |
| 324 | | |
| 325 | | # Prompt for editor to use if none supplied. |
| 326 | | if ( $opts{editor} ) { |
| 327 | | $editor = $opts{editor}; |
| 328 | | |
| 329 | | } |
| 330 | | else { |
| 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 |
| 335 | | would like to use. |
| 336 | | EOT |
| 337 | | } |
| 338 | | |
| 339 | | # Launch editor. |
| 340 | | $tmpfile = generate_filename(); |
| 341 | | my $body = ""; |
| 342 | | my $err = 0; |
| 343 | | do { |
| 344 | | edit_bug_report( $tmpfile ); |
| 345 | | # Slurp bug report. |
| 346 | | open BODY, "<$tmpfile" or die "Can't open '$tmpfile': $!"; |
| 347 | | { |
| 348 | | local $/; |
| 349 | | $body = <BODY>; |
| 350 | | } |
| 351 | | close BODY or die "Can't close '$tmpfile': $!"; |
| 352 | | unless ( $body ) { |
| 353 | | print "\nYou provided an empty bug report!\n"; |
| 354 | | print "Press 'Enter' to continue...\n"; |
| 355 | | scalar <STDIN>; |
| 356 | | } |
| 357 | | die "Aborting.\n" if $err++ == 5; |
| 358 | | } until ( $body ); |
| 359 | | |
| 360 | | return $body; |
| 361 | | } |
| 362 | | |
| 363 | | |
| 364 | | # Prompt for editor to use. |
| 365 | | sub ask_for_editor { |
| 366 | | print shift() . "Editor [$editor]: "; |
| 367 | | my $entry = <STDIN>; |
| 368 | | chomp $entry; |
| 369 | | $editor = $entry if $entry ne ""; |
| 370 | | $opts{editor} = $editor; |
| 371 | | } |
| 372 | | |
| 373 | | |
| 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 |
| 379 | | correct it. |
| 380 | | EOT |
| 381 | | |
| 382 | | # Try and guess return address |
| 383 | | my ($from, $guess); |
| 384 | | $guess = $ENV{'REPLY-TO'} || $ENV{REPLYTO} || ""; |
| 385 | | |
| 386 | | if ( ! $guess ) { |
| 387 | | # Use $domain if we can. |
| 388 | | if ( $domain ) { |
| 389 | | $guess = $is_vms && !$Config{d_socket} ? |
| 390 | | "$domain\:\:$user" : "$user\@$domain"; |
| 391 | | } |
| 392 | | } |
| 393 | | |
| 394 | | # Verify our guess. |
| 395 | | print "Your address [$guess]: "; |
| 396 | | $from = <STDIN>; |
| 397 | | chomp $from; |
| 398 | | $from = $guess if $from eq ""; |
| 399 | | print "\n\n\n"; |
| 400 | | return $from; |
| 401 | | } |
| 402 | | |
| 403 | | |
| 404 | | # Prompt for subject of message. |
| 405 | | # |
| 406 | | # Return the subject chosen. |
| 407 | | # |
| 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. |
| 414 | | |
| 415 | | EOT |
| 416 | | |
| 417 | | my $subject; |
| 418 | | my $err = 0; |
| 419 | | do { |
| 420 | | $err and print "\nThat doesn't look like a good subject. " |
| 421 | | . "Please be more verbose.\n"; |
| 422 | | print "Subject: "; |
| 423 | | $subject = <STDIN>; |
| 424 | | $subject = q{} unless defined $subject; |
| 425 | | chomp $subject; |
| 426 | | die "Aborting.\n" if $err++ == 5; |
| 427 | | } while ( trivial_subject($subject) ); |
| 428 | | print "\n\n\n"; |
| 429 | | return $subject; |
| 430 | | } |
| 431 | | |
| 432 | | |
| 433 | | # Launch an editor in which to edit the bug report. |
| 434 | | sub edit_bug_report { |
| 435 | | my $filename = shift; |
| 436 | | |
| 437 | | # Launch editor. |
| 438 | | my $retval; |
| 439 | | $retval = system($editor, $filename); |
| 440 | | |
| 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? |
| 445 | | |
| 446 | | EOT |
| 447 | | |
| 448 | | } |
| 449 | | |
| 450 | | |
| 451 | | |
| 452 | | #------------------------------------------------------------# |
| 453 | | # Action subs. # |
| 454 | | |
| 455 | | |
| 456 | | # Display everything collected. |
| 457 | | sub dump_report { |
| 458 | | print "==> Dumping message...\n"; |
| 459 | | print format_message(); |
| 460 | | } |
| 461 | | |
| 462 | | |
| 463 | | # Last chance to edit report. |
| 464 | | sub 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 |
| 471 | | would like to use. |
| 472 | | EOT |
| 473 | | } |
| 474 | | |
| 475 | | $tmpfile ||= $opts{input}; |
| 476 | | my $err = 0; |
| 477 | | my $body; |
| 478 | | do { |
| 479 | | edit_bug_report( $tmpfile ); |
| 480 | | # Slurp bug report. |
| 481 | | open BODY, "<$tmpfile" or die "Can't open '$tmpfile': $!"; |
| 482 | | { |
| 483 | | local $/; |
| 484 | | $body = <BODY>; |
| 485 | | } |
| 486 | | close BODY or die "Can't close '$tmpfile': $!"; |
| 487 | | unless ( $body ) { |
| 488 | | print "\nYou provided an empty bug report!\n"; |
| 489 | | print "Press 'Enter' to continue...\n"; |
| 490 | | scalar <STDIN>; |
| 491 | | } |
| 492 | | die "Aborting.\n" if $err++ == 5; |
| 493 | | } until ( $body ); |
| 494 | | |
| 495 | | $report{body} = $body; |
| 496 | | } |
| 497 | | |
| 498 | | |
| 499 | | # Format the message with everything collected and return it. |
| 500 | | sub format_message { |
| 501 | | my $report = ""; |
| 502 | | |
| 503 | | # OS, arch, compiler... |
| 504 | | $report .= <<EOT; |
| 505 | | --- |
| 506 | | osname= $Config{osname} |
| 507 | | osvers= $Config{osvers} |
| 508 | | arch= $Config{archname} |
| 509 | | EOT |
| 510 | | |
| 511 | | my $cc = $Config{cc}; |
| 512 | | #$report .= "cc= $cc $Config{${cc}.'version'}\n"; |
| 513 | | $report .= "cc= $cc\n"; |
| 514 | | |
| 515 | | |
| 516 | | # ... flags... |
| 517 | | $report .= <<EOT; |
| 518 | | --- |
| 519 | | Flags: |
| 520 | | category=$report{category} |
| 521 | | severity=$report{severity} |
| 522 | | EOT |
| 523 | | $report .= " ack=no\n" if ! $opts{ack}; |
| 524 | | |
| 525 | | # ... bug report ... |
| 526 | | $report .= "---\n$report{body}\n"; |
| 527 | | |
| 528 | | # ... myconfig ... |
| 529 | | $report .= "---\n$parrot{myconfig}\n---\n"; |
| 530 | | |
| 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; |
| 536 | | my %env; |
| 537 | | @env{@env} = @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"; |
| 541 | | } |
| 542 | | |
| 543 | | return $report; |
| 544 | | } |
| 545 | | |
| 546 | | |
| 547 | | # Print synopsis + help message and exit. |
| 548 | | sub help { |
| 549 | | print <<EOT; |
| 550 | | |
| 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 |
| 553 | | be needed. |
| 554 | | |
| 555 | | Simplest usage: run '$0', and follow the prompts. |
| 556 | | Usage: $0 [OPTIONS] [ACTIONS] |
| 557 | | |
| 558 | | Options: |
| 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) |
| 573 | | |
| 574 | | Note: you will be prompted if the program miss some information. |
| 575 | | |
| 576 | | Actions: |
| 577 | | --dump Dump message. |
| 578 | | --save Save message. |
| 579 | | --send Send message. |
| 580 | | --help Print this help message and exit. |
| 581 | | --version Print version information and exit. |
| 582 | | |
| 583 | | EOT |
| 584 | | exit; |
| 585 | | } |
| 586 | | |
| 587 | | |
| 588 | | # Save message to file. |
| 589 | | sub save_report { |
| 590 | | print "\n==> Saving message to file...\n"; |
| 591 | | if ( ! $opts{output} ) { |
| 592 | | print "Enter filename to save bug report: "; |
| 593 | | $opts{output} = <STDIN>; |
| 594 | | } |
| 595 | | |
| 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}': $!"; |
| 599 | | |
| 600 | | print "Message saved.\n"; |
| 601 | | } |
| 602 | | |
| 603 | | |
| 604 | | # Send message to final recipient. |
| 605 | | sub send_report { |
| 606 | | print "==> Sending message to recipient...\n"; |
| 607 | | |
| 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} ); |
| 615 | | |
| 616 | | my $fh = $msg->open; |
| 617 | | print $fh format_message(); |
| 618 | | $fh->close; |
| 619 | | |
| 620 | | print "\nMessage sent.\n"; |
| 621 | | |
| 622 | | } |
| 623 | | else { |
| 624 | | my $sendmail = ""; |
| 625 | | for ( qw[ /usr/lib/sendmail /usr/sbin/sendmail |
| 626 | | /usr/ucblib/sendmail /var/qmail/bin/sendmail ] ) { |
| 627 | | $sendmail = $_, last if -e $_; |
| 628 | | } |
| 629 | | |
| 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. |
| 634 | | |
| 635 | | So you may attempt to find some way of sending your message, it has |
| 636 | | been left in the file '$tmpfile'. |
| 637 | | EOT |
| 638 | | |
| 639 | | open(SENDMAIL, "|$sendmail -t -oi") || die "'|$sendmail -t -oi' failed: $!"; |
| 640 | | |
| 641 | | print SENDMAIL <<EOT; |
| 642 | | To: $report{to} |
| 643 | | Subject: $report{subject} |
| 644 | | Reply-To: $report{from} |
| 645 | | Message-Id: $msgid |
| 646 | | |
| 647 | | EOT |
| 648 | | |
| 649 | | print SENDMAIL format_message(); |
| 650 | | if (close(SENDMAIL)) { |
| 651 | | printf "\nMessage sent.\n"; |
| 652 | | } |
| 653 | | else { |
| 654 | | warn "\nSendmail returned status '", $? >> 8, "'\n"; |
| 655 | | } |
| 656 | | } |
| 657 | | } |
| 658 | | |
| 659 | | |
| 660 | | # Print version information (of the parrotbug program) and exit. |
| 661 | | sub version { |
| 662 | | print <<"EOT"; |
| 663 | | |
| 664 | | This is $0, version $VERSION. |
| 665 | | |
| 666 | | EOT |
| 667 | | exit; |
| 668 | | } |
| 669 | | |
| 670 | | |
| 671 | | # Check whether actions have been provided on comand-line, otherwise |
| 672 | | # prompt for what to do with bug report. |
| 673 | | sub what_next { |
| 674 | | dump_report() if $opts{dump}; |
| 675 | | save_report() if $opts{save}; |
| 676 | | send_report() if $opts{send}; |
| 677 | | |
| 678 | | return if $opts{dump} || $opts{save} || $opts{send}; |
| 679 | | |
| 680 | | # No actions provided on command-line, prompt for action. |
| 681 | | |
| 682 | | my $action; |
| 683 | | do { |
| 684 | | print "Action (send,display,edit,save,quit): "; |
| 685 | | $action = <STDIN>; |
| 686 | | sw: for ($action) { |
| 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; |
| 692 | | }; |
| 693 | | } until ( $action =~ /^q/i ); |
| 694 | | } |
| 695 | | |
| 696 | | |
| 697 | | __END__ |
| 698 | | |
| 699 | | =head1 NAME |
| 700 | | |
| 701 | | parrotbug - Parrot Bug Reporter |
| 702 | | |
| 703 | | =head1 SYNOPSIS |
| 704 | | |
| 705 | | % ./parrotbug [options] [actions] |
| 706 | | |
| 707 | | =head1 DESCRIPTION |
| 708 | | |
| 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 |
| 711 | | be needed. |
| 712 | | |
| 713 | | |
| 714 | | =head1 COMMAND-LINE SWITCHES |
| 715 | | |
| 716 | | |
| 717 | | =head2 Options |
| 718 | | |
| 719 | | Note: you will be prompted if the program miss some information. |
| 720 | | |
| 721 | | =over 4 |
| 722 | | |
| 723 | | =item B<--nok> |
| 724 | | |
| 725 | | Report unsuccessful build on this system to parrot developers. |
| 726 | | |
| 727 | | =item B<--ok> |
| 728 | | |
| 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, |
| 731 | | use C<--nok>. |
| 732 | | |
| 733 | | =item B<--subject> |
| 734 | | |
| 735 | | Subject of the report. You will be prompted if you don't supply one on |
| 736 | | the command-line. |
| 737 | | |
| 738 | | =item B<--category> |
| 739 | | |
| 740 | | Category of the bug report. You will be prompted if you don't supply |
| 741 | | one on the command-line. |
| 742 | | |
| 743 | | =item B<--severity> |
| 744 | | |
| 745 | | Severity of the bug report. You will be prompted if you don't supply |
| 746 | | one on the command-line. |
| 747 | | |
| 748 | | =item B<--address> |
| 749 | | |
| 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. |
| 752 | | |
| 753 | | =item B<--editor> |
| 754 | | |
| 755 | | Editor to use for editing the bug report. |
| 756 | | |
| 757 | | =item B<--ack>, B<--noack> |
| 758 | | |
| 759 | | Don't send a bug received acknowledgement. |
| 760 | | |
| 761 | | =item B<--input-file> |
| 762 | | |
| 763 | | File containing the body of the report. Use this to quickly send a |
| 764 | | prepared message. |
| 765 | | |
| 766 | | =item B<--output-file> |
| 767 | | |
| 768 | | File where parrotbug will save its bug report, if you ask it to do so. |
| 769 | | |
| 770 | | =item B<--to> |
| 771 | | |
| 772 | | Email address to send report to. (for testing purposes only) |
| 773 | | |
| 774 | | =back |
| 775 | | |
| 776 | | |
| 777 | | =head2 Actions |
| 778 | | |
| 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. |
| 781 | | |
| 782 | | =over 4 |
| 783 | | |
| 784 | | =item B<--dump> |
| 785 | | |
| 786 | | Dump formatted report on standard output. |
| 787 | | |
| 788 | | =item B<--save> |
| 789 | | |
| 790 | | Save message to a file, in order for you to send it later from your |
| 791 | | own. See C<--output> flag. |
| 792 | | |
| 793 | | =item B<--send> |
| 794 | | |
| 795 | | Try to send a mail with the report. |
| 796 | | |
| 797 | | =item B<--help> |
| 798 | | |
| 799 | | Print a short synopsis and exit. |
| 800 | | |
| 801 | | =item B<--version> |
| 802 | | |
| 803 | | Print version information and exit. |
| 804 | | |
| 805 | | =back |
| 806 | | |
| 807 | | |
| 808 | | =head1 AUTHORS |
| 809 | | |
| 810 | | Jerome Quelin (E<lt>jquelin@cpan.orgE<gt>), with lots of good stuff taken from perlbug. |
| 811 | | |
| 812 | | |
| 813 | | =head1 SEE ALSO |
| 814 | | |
| 815 | | perlbug(1), parrot(1), diff(1), patch(1) |
| 816 | | |
| 817 | | =cut |
| 818 | | |
| 819 | | # Local Variables: |
| 820 | | # mode: cperl |
| 821 | | # cperl-indent-level: 4 |
| 822 | | # fill-column: 100 |
| 823 | | # End: |
| 824 | | # vim: expandtab shiftwidth=4: |
