This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perlbug: Ask confirmation if would overwrite existing file
[perl5.git] / utils / perlbug.PL
CommitLineData
37fa004c
PP
1#!/usr/local/bin/perl
2
3use Config;
4use File::Basename qw(&basename &dirname);
8a5546a1 5use Cwd;
1948c06a 6use File::Spec::Functions;
37fa004c
PP
7
8# List explicitly here the variables you want Configure to
9# generate. Metaconfig only looks for shell variables, so you
10# have to mention them as if they were shell variables, not
11# %Config entries. Thus you write
12# $startperl
13# to ensure Configure will look for $Config{startperl}.
84902520 14# $perlpath
37fa004c
PP
15
16# This forces PL files to create target in same directory as PL file.
17# This is so that make depend always knows where to find PL derivatives.
8a5546a1 18$origdir = cwd;
44a8e56a
PP
19chdir dirname($0);
20$file = basename($0, '.PL');
774d564b 21$file .= '.com' if $^O eq 'VMS';
37fa004c 22
1ae6ead9 23open OUT, ">", $file or die "Can't create $file: $!";
37fa004c 24
3541c11a
NT
25# get patchlevel.h timestamp
26
27-e catfile(updir, "patchlevel.h")
28 or die "Can't find patchlevel.h: $!";
84902520 29
3541c11a 30my $patchlevel_date = (stat _)[9];
84902520 31
e8a97f29 32# TO DO (perhaps): store/embed $Config::config_sh into perlbug. When perlbug is
5edeba26
TB
33# used, compare $Config::config_sh with the stored version. If they differ then
34# append a list of individual differences to the bug report.
35
84902520 36
37fa004c
PP
37print "Extracting $file (with variable substitutions)\n";
38
39# In this section, perl variables will be expanded during extraction.
40# You can use $Config{...} to use Configure variables.
41
fa510083 42my $extract_version = sprintf("%vd", $^V);
1ec03f31 43
37fa004c 44print OUT <<"!GROK!THIS!";
5f05dabc
PP
45$Config{startperl}
46 eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
47 if \$running_under_some_shell;
84902520 48
1ec03f31 49my \$config_tag1 = '$extract_version - $Config{cf_time}';
fb73857a 50
84902520 51my \$patchlevel_date = $patchlevel_date;
37fa004c
PP
52!GROK!THIS!
53
54# In the following, perl variables are not expanded during extraction.
55
56print OUT <<'!NO!SUBS!';
3541c11a
NT
57my @patches = Config::local_patches();
58my $patch_tags = join "", map /(\S+)/ ? "+$1 " : (), @patches;
37fa004c 59
cee96d52 60BEGIN { pop @INC if $INC[-1] eq '.' }
54c90be1 61use warnings;
721e2275 62use strict;
37fa004c 63use Config;
1ec03f31 64use File::Spec; # keep perlbug Perl 5.005 compatible
37fa004c 65use Getopt::Std;
721e2275 66use File::Basename 'basename';
37fa004c 67
7b1af8a6
TR
68$Getopt::Std::STANDARD_HELP_VERSION = 1;
69
37fa004c
PP
70sub paraprint;
71
55d729e4 72BEGIN {
54c90be1 73 eval { require Mail::Send;};
55d729e4 74 $::HaveSend = ($@ eq "");
54c90be1 75 eval { require Mail::Util; } ;
55d729e4 76 $::HaveUtil = ($@ eq "");
003a92ef 77 # use secure tempfiles wherever possible
54c90be1 78 eval { require File::Temp; };
003a92ef 79 $::HaveTemp = ($@ eq "");
13f4c5e4
AC
80 eval { require Module::CoreList; };
81 $::HaveCoreList = ($@ eq "");
c04bead1
NT
82 eval { require Text::Wrap; };
83 $::HaveWrap = ($@ eq "");
55d729e4 84};
c07a80fd 85
7b1af8a6 86our $VERSION = "1.41";
c07a80fd 87
54c90be1
J
88#TODO:
89# make sure failure (transmission-wise) of Mail::Send is accounted for.
90# (This may work now. Unsure of the original author's issue -JESSE 2008-06-08)
1b0e3b9e 91# - Test -b option
37fa004c 92
721e2275
NC
93my( $file, $usefile, $cc, $address, $bugaddress, $testaddress, $thanksaddress,
94 $filename, $messageid, $domain, $subject, $from, $verbose, $ed, $outfile,
54c90be1 95 $fh, $me, $body, $andcc, %REP, $ok, $thanks, $progname,
8ced8222 96 $Is_MSWin32, $Is_Linux, $Is_VMS, $Is_OpenBSD,
54c90be1 97 $report_about_module, $category, $severity,
2bb62a09 98 %opt, $have_attachment, $attachments, $has_patch, $mime_boundary
54c90be1 99);
37fa004c 100
24963b0a
AC
101my $running_noninteractively = !-t STDIN;
102
fa510083 103my $perl_version = $^V ? sprintf("%vd", $^V) : $];
1ec03f31
GS
104
105my $config_tag2 = "$perl_version - $Config{cf_time}";
fb73857a 106
37fa004c
PP
107Init();
108
4c62848c
JC
109if ($opt{h}) { Help(); exit; }
110if ($opt{d}) { Dump(*STDOUT); exit; }
24963b0a 111if ($running_noninteractively && !$opt{t} && !($ok and not $opt{n})) {
721e2275
NC
112 paraprint <<"EOF";
113Please use $progname interactively. If you want to
84478119
PP
114include a file, you can use the -f switch.
115EOF
55d729e4 116 die "\n";
84478119 117}
c07a80fd 118
37fa004c 119Query();
4c62848c 120Edit() unless $usefile || ($ok and not $opt{n});
37fa004c 121NowWhat();
54c90be1
J
122if ($outfile) {
123 save_message_to_disk($outfile);
124} else {
125 Send();
4dbf56a0
NC
126 if ($thanks) {
127 print "\nThank you for taking the time to send a thank-you message!\n\n";
c983ad79
RS
128
129 paraprint <<EOF
130Please note that mailing lists are moderated, your message may take a while to
131show up.
132EOF
4dbf56a0
NC
133 } else {
134 print "\nThank you for taking the time to file a bug report!\n\n";
a9d7774b 135
c983ad79 136 paraprint <<EOF
a9d7774b
MM
137Please note that mailing lists are moderated, your message may take a while to
138show up. If you do not receive an automated response acknowledging your message
139within a few hours (check your SPAM folder and outgoing mail) please consider
23dfa308 140sending an email directly from your mail client to perlbug\@perl.org.
a9d7774b 141EOF
c983ad79
RS
142 }
143
54c90be1 144}
37fa004c
PP
145
146exit;
147
975b416b 148sub ask_for_alternatives { # (category|severity)
50d3c28b 149 my $name = shift;
975b416b
GS
150 my %alts = (
151 'category' => {
152 'default' => 'core',
153 'ok' => 'install',
721e2275
NC
154 # Inevitably some of these will end up in RT whatever we do:
155 'thanks' => 'thanks',
975b416b
GS
156 'opts' => [qw(core docs install library utilities)], # patch, notabug
157 },
158 'severity' => {
159 'default' => 'low',
160 'ok' => 'none',
dda32041 161 'thanks' => 'none',
975b416b 162 'opts' => [qw(critical high medium low wishlist none)], # zero
7f2de2d2 163 },
975b416b 164 );
54c90be1 165 die "Invalid alternative ($name) requested\n" unless grep(/^$name$/, keys %alts);
50d3c28b 166 my $alt = "";
721e2275
NC
167 my $what = $ok || $thanks;
168 if ($what) {
169 $alt = $alts{$name}{$what};
975b416b
GS
170 } else {
171 my @alts = @{$alts{$name}{'opts'}};
54c90be1 172 print "\n\n";
975b416b 173 paraprint <<EOF;
54c90be1 174Please pick a $name from the following list:
50d3c28b
GS
175
176 @alts
50d3c28b 177EOF
975b416b
GS
178 my $err = 0;
179 do {
180 if ($err++ > 5) {
181 die "Invalid $name: aborting.\n";
182 }
54c90be1
J
183 $alt = _prompt('', "\u$name", $alts{$name}{'default'});
184 $alt ||= $alts{$name}{'default'};
975b416b
GS
185 } while !((($alt) = grep(/^$alt/i, @alts)));
186 }
50d3c28b
GS
187 lc $alt;
188}
189
7b1af8a6
TR
190sub HELP_MESSAGE { Help(); exit; }
191sub VERSION_MESSAGE { print "perlbug version $VERSION\n"; }
192
37fa004c 193sub Init {
55d729e4
GS
194 # -------- Setup --------
195
196 $Is_MSWin32 = $^O eq 'MSWin32';
197 $Is_VMS = $^O eq 'VMS';
afc5e478 198 $Is_Linux = lc($^O) eq 'linux';
8843dda6 199 $Is_OpenBSD = lc($^O) eq 'openbsd';
55d729e4 200
55d729e4 201 # perlbug address
721e2275 202 $bugaddress = 'perlbug@perl.org';
55d729e4
GS
203
204 # Test address
3e79b69b 205 $testaddress = 'perlbug-test@perl.org';
55d729e4 206
721e2275
NC
207 # Thanks address
208 $thanksaddress = 'perl-thanks@perl.org';
209
7b1af8a6
TR
210 # Defaults if getopts fails.
211 $address = (basename ($0) =~ /^perlthanks/i) ? $thanksaddress : $bugaddress;
212 $cc = $::Config{'perladmin'} || $::Config{'cf_email'} || $::Config{'cf_by'} || '';
213
214 HELP_MESSAGE() unless getopts("Adhva:s:b:f:F:r:e:SCc:to:n:T:p:", \%opt);
215
216 # This comment is needed to notify metaconfig that we are
217 # using the $perladmin, $cf_by, and $cf_time definitions.
218 # -------- Configuration ---------
219
721e2275
NC
220 if (basename ($0) =~ /^perlthanks/i) {
221 # invoked as perlthanks
4c62848c
JC
222 $opt{T} = 1;
223 $opt{C} = 1; # don't send a copy to the local admin
721e2275
NC
224 }
225
4c62848c 226 if ($opt{T}) {
721e2275
NC
227 $thanks = 'thanks';
228 }
229
230 $progname = $thanks ? 'perlthanks' : 'perlbug';
55d729e4 231 # Target address
4c62848c 232 $address = $opt{a} || ($opt{t} ? $testaddress
721e2275 233 : $thanks ? $thanksaddress : $bugaddress);
55d729e4 234
e4ef3332 235 # Users address, used in message and in From and Reply-To headers
4c62848c 236 $from = $opt{r} || "";
55d729e4
GS
237
238 # Include verbose configuration information
4c62848c 239 $verbose = $opt{v} || 0;
55d729e4
GS
240
241 # Subject of bug-report message
4c62848c 242 $subject = $opt{s} || "";
55d729e4
GS
243
244 # Send a file
4c62848c 245 $usefile = ($opt{f} || 0);
55d729e4
GS
246
247 # File to send as report
4c62848c 248 $file = $opt{f} || "";
55d729e4 249
2bb62a09
CB
250 # We have one or more attachments
251 $have_attachment = ($opt{p} || 0);
7b1af8a6 252 $mime_boundary = ('-' x 12) . "$VERSION.perlbug" if $have_attachment;
2bb62a09
CB
253
254 # Comma-separated list of attachments
255 $attachments = $opt{p} || "";
256 $has_patch = 0; # TBD based on file type
257
258 for my $attachment (split /\s*,\s*/, $attachments) {
259 unless (-f $attachment && -r $attachment) {
260 die "The attachment $attachment is not a readable file: $!\n";
261 }
262 $has_patch = 1 if $attachment =~ m/\.(patch|diff)$/;
263 }
264
105f9295 265 # File to output to
4c62848c 266 $outfile = $opt{F} || "";
105f9295 267
55d729e4 268 # Body of report
4c62848c 269 $body = $opt{b} || "";
de94c9df 270
55d729e4 271 # Editor
4c62848c 272 $ed = $opt{e} || $ENV{VISUAL} || $ENV{EDITOR} || $ENV{EDIT}
55d729e4
GS
273 || ($Is_VMS && "edit/tpu")
274 || ($Is_MSWin32 && "notepad")
275 || "vi";
276
277 # Not OK - provide build failure template by finessing OK report
4c62848c
JC
278 if ($opt{n}) {
279 if (substr($opt{n}, 0, 2) eq 'ok' ) {
280 $opt{o} = substr($opt{n}, 1);
55d729e4
GS
281 } else {
282 Help();
283 exit();
284 }
285 }
286
287 # OK - send "OK" report for build on this system
721e2275 288 $ok = '';
4c62848c
JC
289 if ($opt{o}) {
290 if ($opt{o} eq 'k' or $opt{o} eq 'kay') {
55d729e4 291 my $age = time - $patchlevel_date;
4c62848c 292 if ($opt{o} eq 'k' and $age > 60 * 24 * 60 * 60 ) {
55d729e4
GS
293 my $date = localtime $patchlevel_date;
294 print <<"EOF";
295"perlbug -ok" and "perlbug -nok" do not report on Perl versions which
296are more than 60 days old. This Perl version was constructed on
297$date. If you really want to report this, use
298"perlbug -okay" or "perlbug -nokay".
84902520 299EOF
1b0e3b9e
CR
300 exit();
301 }
55d729e4 302 # force these options
4c62848c
JC
303 unless ($opt{n}) {
304 $opt{S} = 1; # don't prompt for send
305 $opt{b} = 1; # we have a body
55d729e4
GS
306 $body = "Perl reported to build OK on this system.\n";
307 }
4c62848c
JC
308 $opt{C} = 1; # don't send a copy to the local admin
309 $opt{s} = 1; # we have a subject line
310 $subject = ($opt{n} ? 'Not ' : '')
1ec03f31 311 . "OK: perl $perl_version ${patch_tags}on"
55d729e4 312 ." $::Config{'archname'} $::Config{'osvers'} $subject";
721e2275 313 $ok = 'ok';
55d729e4
GS
314 } else {
315 Help();
316 exit();
1b0e3b9e 317 }
55d729e4 318 }
37fa004c 319
55d729e4
GS
320 # Possible administrator addresses, in order of confidence
321 # (Note that cf_email is not mentioned to metaconfig, since
322 # we don't really want it. We'll just take it if we have to.)
323 #
324 # This has to be after the $ok stuff above because of the way
4c62848c
JC
325 # that $opt{C} is forced.
326 $cc = $opt{C} ? "" : (
327 $opt{c} || $::Config{'perladmin'}
55d729e4
GS
328 || $::Config{'cf_email'} || $::Config{'cf_by'}
329 );
330
de94c9df
RF
331 if ($::HaveUtil) {
332 $domain = Mail::Util::maildomain();
333 } elsif ($Is_MSWin32) {
334 $domain = $ENV{'USERDOMAIN'};
335 } else {
336 require Sys::Hostname;
337 $domain = Sys::Hostname::hostname();
338 }
339
340 # Message-Id - rjsf
341 $messageid = "<$::Config{'version'}_${$}_".time."\@$domain>";
342
55d729e4
GS
343 # My username
344 $me = $Is_MSWin32 ? $ENV{'USERNAME'}
345 : $^O eq 'os2' ? $ENV{'USER'} || $ENV{'LOGNAME'}
346 : eval { getpwuid($<) }; # May be missing
c0830f08
RB
347
348 $from = $::Config{'cf_email'}
349 if !$from && $::Config{'cf_email'} && $::Config{'cf_by'} && $me &&
350 ($me eq $::Config{'cf_by'});
55d729e4 351} # sub Init
37fa004c
PP
352
353sub Query {
55d729e4
GS
354 # Explain what perlbug is
355 unless ($ok) {
721e2275
NC
356 if ($thanks) {
357 paraprint <<'EOF';
358This program provides an easy way to send a thank-you message back to the
359authors and maintainers of perl.
360
361If you wish to submit a bug report, please run it without the -T flag
362(or run the program perlbug rather than perlthanks)
363EOF
364 } else {
365 paraprint <<"EOF";
54c90be1
J
366This program provides an easy way to create a message reporting a
367bug in the core perl distribution (along with tests or patches)
368to the volunteers who maintain perl at $address. To send a thank-you
369note to $thanksaddress instead of a bug report, please run 'perlthanks'.
370
371Please do not use $0 to send test messages, test whether perl
372works, or to report bugs in perl modules from CPAN.
373
a152f763
AC
374Suggestions for how to find help using Perl can be found at
375http://perldoc.perl.org/perlcommunity.html
37fa004c 376EOF
721e2275 377 }
1b0e3b9e 378 }
37fa004c 379
55d729e4 380 # Prompt for subject of message, if needed
2e7f46bf 381
54c90be1 382 if ($subject && TrivialSubject($subject)) {
2e7f46bf
JH
383 $subject = '';
384 }
385
55d729e4 386 unless ($subject) {
54c90be1
J
387 print
388"First of all, please provide a subject for the message.\n";
389 if ( not $thanks) {
721e2275 390 paraprint <<EOF;
54c90be1
J
391This should be a concise description of your bug or problem
392which will help the volunteers working to improve perl to categorize
393and resolve the issue. Be as specific and descriptive as
394you can. A subject like "perl bug" or "perl problem" will make it
395much less likely that your issue gets the attention it deserves.
37fa004c 396EOF
721e2275 397 }
55d729e4
GS
398
399 my $err = 0;
2e7f46bf 400 do {
54c90be1 401 $subject = _prompt('','Subject');
2e7f46bf 402 if ($err++ == 5) {
721e2275
NC
403 if ($thanks) {
404 $subject = 'Thanks for Perl';
405 } else {
406 die "Aborting.\n";
407 }
55d729e4 408 }
2e7f46bf 409 } while (TrivialSubject($subject));
55d729e4 410 }
2bb62a09
CB
411 $subject = '[PATCH] ' . $subject
412 if $has_patch && ($subject !~ m/^\[PATCH/i);
55d729e4
GS
413
414 # Prompt for return address, if needed
4c62848c 415 unless ($opt{r}) {
55d729e4
GS
416 # Try and guess return address
417 my $guess;
418
e6eb9020
DM
419 $guess = $ENV{'REPLY-TO'} || $ENV{'REPLYTO'} || $ENV{'EMAIL'}
420 || $from || '';
1948c06a 421
55d729e4 422 unless ($guess) {
de94c9df
RF
423 # move $domain to where we can use it elsewhere
424 if ($domain) {
55d729e4
GS
425 if ($Is_VMS && !$::Config{'d_socket'}) {
426 $guess = "$domain\:\:$me";
41f926b8 427 } else {
55d729e4 428 $guess = "$me\@$domain" if $domain;
c07a80fd 429 }
55d729e4
GS
430 }
431 }
37fa004c 432
55d729e4
GS
433 if ($guess) {
434 unless ($ok) {
435 paraprint <<EOF;
54c90be1
J
436Perl's developers may need your email address to contact you for
437further information about your issue or to inform you when it is
438resolved. If the default shown is not your email address, please
439correct it.
37fa004c 440EOF
55d729e4
GS
441 }
442 } else {
443 paraprint <<EOF;
54c90be1
J
444Please enter your full internet email address so that Perl's
445developers can contact you with questions about your issue or to
446inform you that it has been resolved.
37fa004c 447EOF
37fa004c 448 }
37fa004c 449
55d729e4
GS
450 if ($ok && $guess) {
451 # use it
452 $from = $guess;
453 } else {
454 # verify it
54c90be1 455 $from = _prompt('','Your address',$guess);
55d729e4
GS
456 $from = $guess if $from eq '';
457 }
458 }
37fa004c 459
55d729e4
GS
460 if ($from eq $cc or $me eq $cc) {
461 # Try not to copy ourselves
462 $cc = "yourself";
463 }
37fa004c 464
55d729e4 465 # Prompt for administrator address, unless an override was given
4c62848c 466 if( !$opt{C} and !$opt{c} ) {
54c90be1
J
467 my $description = <<EOF;
468$0 can send a copy of this report to your local perl
469administrator. If the address below is wrong, please correct it,
470or enter 'none' or 'yourself' to not send a copy.
37fa004c 471EOF
54c90be1 472 my $entry = _prompt($description, "Local perl administrator", $cc);
37fa004c 473
55d729e4
GS
474 if ($entry ne "") {
475 $cc = $entry;
476 $cc = '' if $me eq $cc;
37fa004c 477 }
55d729e4 478 }
37fa004c 479
55d729e4 480 $cc = '' if $cc =~ /^(none|yourself|me|myself|ourselves)$/i;
54c90be1
J
481 if ($cc) {
482 $andcc = " and $cc"
483 } else {
484 $andcc = ''
485 }
37fa004c 486
55d729e4 487 # Prompt for editor, if no override is given
ab3ef367 488editor:
4c62848c 489 unless ($opt{e} || $opt{f} || $opt{b}) {
26ab4e07 490
54c90be1 491 my $description;
26ab4e07 492
54c90be1
J
493 chomp (my $common_end = <<"EOF");
494You will probably want to use a text editor to enter the body of
495your report. If "$ed" is the editor you want to use, then just press
496Enter, otherwise type in the name of the editor you would like to
497use.
498
499If you have already composed the body of your report, you may enter
500"file", and $0 will prompt you to enter the name of the file
501containing your report.
721e2275
NC
502EOF
503
504 if ($thanks) {
54c90be1
J
505 $description = <<"EOF";
506It's now time to compose your thank-you message.
721e2275 507
54c90be1
J
508Some information about your local perl configuration will automatically
509be included at the end of your message, because we're curious about
510the different ways that people build and use perl. If you'd rather
511not share this information, you're welcome to delete it.
721e2275
NC
512
513$common_end
514EOF
515 } else {
54c90be1
J
516 $description = <<"EOF";
517It's now time to compose your bug report. Try to make the report
518concise but descriptive. Please include any detail which you think
519might be relevant or might help the volunteers working to improve
520perl. If you are reporting something that does not work as you think
521it should, please try to include examples of the actual result and of
522what you expected.
523
524Some information about your local perl configuration will automatically
525be included at the end of your report. If you are using an unusual
526version of perl, it would be useful if you could confirm that you
527can replicate the problem on a standard build of perl as well.
37fa004c 528
721e2275 529$common_end
37fa004c 530EOF
721e2275
NC
531 }
532
54c90be1 533 my $entry = _prompt($description, "Editor", $ed);
55d729e4
GS
534 $usefile = 0;
535 if ($entry eq "file") {
536 $usefile = 1;
537 } elsif ($entry ne "") {
538 $ed = $entry;
37fa004c 539 }
55d729e4 540 }
721e2275 541 if ($::HaveCoreList && !$ok && !$thanks) {
54c90be1
J
542 my $description = <<EOF;
543If your bug is about a Perl module rather than a core language
544feature, please enter its name here. If it's not, just hit Enter
545to skip this question.
13f4c5e4 546EOF
54c90be1
J
547
548 my $entry = '';
549 while ($entry eq '') {
550 $entry = _prompt($description, 'Module');
13f4c5e4 551 my $first_release = Module::CoreList->first_release($entry);
54c90be1 552 if ($entry and not $first_release) {
13f4c5e4 553 paraprint <<EOF;
54c90be1
J
554$entry is not a "core" Perl module. Please check that you entered
555its name correctly. If it is correct, quit this program, try searching
556for $entry on http://rt.cpan.org, and report your issue there.
13f4c5e4 557EOF
54c90be1
J
558
559 $entry = '';
0accdd48
NC
560 } elsif (my $bug_tracker = $Module::CoreList::bug_tracker{$entry}) {
561 paraprint <<"EOF";
562$entry included with core Perl is copied directly from the CPAN distribution.
563Please report bugs in $entry directly to its maintainers using $bug_tracker
564EOF
565 $entry = '';
54c90be1
J
566 } elsif ($entry) {
567 $category ||= 'library';
568 $report_about_module = $entry;
569 last;
570 } else {
571 last;
572 }
13f4c5e4
AC
573 }
574 }
37fa004c 575
50d3c28b 576 # Prompt for category of bug
975b416b 577 $category ||= ask_for_alternatives('category');
50d3c28b
GS
578
579 # Prompt for severity of bug
975b416b 580 $severity ||= ask_for_alternatives('severity');
50d3c28b 581
55d729e4
GS
582 # Generate scratch file to edit report in
583 $filename = filename();
37fa004c 584
55d729e4
GS
585 # Prompt for file to read report from, if needed
586 if ($usefile and !$file) {
ab3ef367 587filename:
54c90be1 588 my $description = <<EOF;
37fa004c 589What is the name of the file that contains your report?
37fa004c 590EOF
54c90be1 591 my $entry = _prompt($description, "Filename");
37fa004c 592
55d729e4
GS
593 if ($entry eq "") {
594 paraprint <<EOF;
54c90be1
J
595It seems you didn't enter a filename. Please choose to use a text
596editor or enter a filename.
ab3ef367 597EOF
55d729e4
GS
598 goto editor;
599 }
600
601 unless (-f $entry and -r $entry) {
602 paraprint <<EOF;
54c90be1
J
603'$entry' doesn't seem to be a readable file. You may have mistyped
604its name or may not have permission to read it.
605
606If you don't want to use a file as the content of your report, just
607hit Enter and you'll be able to select a text editor instead.
ab3ef367 608EOF
55d729e4 609 goto filename;
37fa004c 610 }
55d729e4
GS
611 $file = $entry;
612 }
37fa004c 613
55d729e4 614 # Generate report
092c3aff 615 open(REP, '>:raw', $filename) or die "Unable to create report file '$filename': $!\n";
7e6b9e3a
CB
616 binmode(REP, ':raw :crlf') if $Is_MSWin32;
617
721e2275 618 my $reptype = !$ok ? ($thanks ? 'thank-you' : 'bug')
4c62848c 619 : $opt{n} ? "build failure" : "success";
37fa004c 620
55d729e4 621 print REP <<EOF;
84902520 622This is a $reptype report for perl from $from,
7b1af8a6 623generated with the help of perlbug $VERSION running under perl $perl_version.
37fa004c
PP
624
625EOF
626
55d729e4
GS
627 if ($body) {
628 print REP $body;
629 } elsif ($usefile) {
fc6f6f37 630 open(F, '<:raw', $file)
c9967ac8 631 or die "Unable to read report file from '$file': $!\n";
7e6b9e3a 632 binmode(F, ':raw :crlf') if $Is_MSWin32;
55d729e4
GS
633 while (<F>) {
634 print REP $_
635 }
c9967ac8 636 close(F) or die "Error closing '$file': $!";
55d729e4 637 } else {
721e2275
NC
638 if ($thanks) {
639 print REP <<'EOF';
640
641-----------------------------------------------------------------
54c90be1 642[Please enter your thank-you message here]
721e2275
NC
643
644
645
54c90be1 646[You're welcome to delete anything below this line]
721e2275
NC
647-----------------------------------------------------------------
648EOF
649 } else {
650 print REP <<'EOF';
774d564b
PP
651
652-----------------------------------------------------------------
54c90be1 653[Please describe your issue here]
774d564b
PP
654
655
656
657[Please do not change anything below this line]
658-----------------------------------------------------------------
659EOF
721e2275 660 }
55d729e4
GS
661 }
662 Dump(*REP);
c0a6bf09 663 close(REP) or die "Error closing report file: $!";
55d729e4 664
54c90be1
J
665 # Set up an initial report fingerprint so we can compare it later
666 _fingerprint_lines_in_report();
667
55d729e4 668} # sub Query
c07a80fd
PP
669
670sub Dump {
55d729e4 671 local(*OUT) = @_;
37fa004c 672
4ea8010a
DM
673 # these won't have been set if run with -d
674 $category ||= 'core';
675 $severity ||= 'low';
676
50d3c28b
GS
677 print OUT <<EFF;
678---
679Flags:
680 category=$category
681 severity=$severity
890b8eb0 682EFF
54c90be1 683
2bb62a09
CB
684 if ($has_patch) {
685 print OUT <<EFF;
686 Type=Patch
687 PatchStatus=HasPatch
688EFF
689 }
690
54c90be1
J
691 if ($report_about_module ) {
692 print OUT <<EFF;
693 module=$report_about_module
694EFF
695 }
4c62848c 696 if ($opt{A}) {
890b8eb0
NC
697 print OUT <<EFF;
698 ack=no
699EFF
700 }
701 print OUT <<EFF;
50d3c28b
GS
702---
703EFF
704 print OUT "This perlbug was built using Perl $config_tag1\n",
1ec03f31 705 "It is being executed now by Perl $config_tag2.\n\n"
55d729e4 706 if $config_tag2 ne $config_tag1;
fb73857a 707
55d729e4 708 print OUT <<EOF;
1ec03f31 709Site configuration information for perl $perl_version:
37fa004c
PP
710
711EOF
55d729e4
GS
712 if ($::Config{cf_by} and $::Config{cf_time}) {
713 print OUT "Configured by $::Config{cf_by} at $::Config{cf_time}.\n\n";
714 }
715 print OUT Config::myconfig;
37fa004c 716
55d729e4
GS
717 if (@patches) {
718 print OUT join "\n ", "Locally applied patches:", @patches;
719 print OUT "\n";
720 };
84902520 721
55d729e4 722 print OUT <<EOF;
8ecf1a0c 723
774d564b 724---
1ec03f31 725\@INC for perl $perl_version:
774d564b 726EOF
55d729e4
GS
727 for my $i (@INC) {
728 print OUT " $i\n";
729 }
774d564b 730
55d729e4 731 print OUT <<EOF;
8ecf1a0c 732
774d564b 733---
1ec03f31 734Environment for perl $perl_version:
8ecf1a0c 735EOF
5cf1d1f1
JH
736 my @env =
737 qw(PATH LD_LIBRARY_PATH LANG PERL_BADLANG SHELL HOME LOGDIR LANGUAGE);
738 push @env, $Config{ldlibpthname} if $Config{ldlibpthname} ne '';
27414c22 739 push @env, grep /^(?:PERL|LC_|LANG|CYGWIN)/, keys %ENV;
8876aa85
JH
740 my %env;
741 @env{@env} = @env;
742 for my $env (sort keys %env) {
55d729e4
GS
743 print OUT " $env",
744 exists $ENV{$env} ? "=$ENV{$env}" : ' (unset)',
745 "\n";
746 }
747 if ($verbose) {
1ec03f31 748 print OUT "\nComplete configuration data for perl $perl_version:\n\n";
55d729e4
GS
749 my $value;
750 foreach (sort keys %::Config) {
751 $value = $::Config{$_};
4ea8010a 752 $value = '' unless defined $value;
55d729e4
GS
753 $value =~ s/'/\\'/g;
754 print OUT "$_='$value'\n";
84902520 755 }
55d729e4
GS
756 }
757} # sub Dump
37fa004c
PP
758
759sub Edit {
55d729e4
GS
760 # Edit the report
761 if ($usefile || $body) {
54c90be1
J
762 my $description = "Please make sure that the name of the editor you want to use is correct.";
763 my $entry = _prompt($description, 'Editor', $ed);
55d729e4
GS
764 $ed = $entry unless $entry eq '';
765 }
a5f75d66 766
24963b0a 767 _edit_file($ed) unless $running_noninteractively;
54c90be1
J
768}
769
770sub _edit_file {
771 my $editor = shift;
772
773 my $report_written = 0;
774
775 while ( !$report_written ) {
8ced8222
NC
776 my $exit_status = system("$editor $filename");
777 if ($exit_status) {
778 my $desc = <<EOF;
54c90be1
J
779The editor you chose ('$editor') could not be run!
780
781If you mistyped its name, please enter it now, otherwise just press Enter.
1948c06a 782EOF
8ced8222
NC
783 my $entry = _prompt( $desc, 'Editor', $editor );
784 if ( $entry ne "" ) {
785 $editor = $entry;
786 next;
787 } else {
788 paraprint <<EOF;
54c90be1
J
789You may want to save your report to a file, so you can edit and
790mail it later.
a5f75d66 791EOF
8ced8222 792 return;
54c90be1
J
793 }
794 }
4c62848c 795 return if ( $ok and not $opt{n} ) || $body;
a5f75d66 796
54c90be1 797 # Check that we have a report that has some, eh, report in it.
774d564b 798
54c90be1
J
799 unless ( _fingerprint_lines_in_report() ) {
800 my $description = <<EOF;
801It looks like you didn't enter a report. You may [r]etry your edit
802or [c]ancel this report.
803EOF
804 my $action = _prompt( $description, "Action (Retry/Cancel) " );
805 if ( $action =~ /^[re]/i ) { # <R>etry <E>dit
806 next;
807 } elsif ( $action =~ /^[cq]/i ) { # <C>ancel, <Q>uit
808 Cancel(); # cancel exits
809 }
810 }
811 # Ok. the user did what they needed to;
812 return;
55d729e4 813
55d729e4 814 }
54c90be1 815}
774d564b 816
774d564b
PP
817
818sub Cancel {
819 1 while unlink($filename); # remove all versions under VMS
54c90be1 820 print "\nQuitting without sending your message.\n";
774d564b 821 exit(0);
37fa004c
PP
822}
823
824sub NowWhat {
55d729e4 825 # Report is done, prompt for further action
4c62848c 826 if( !$opt{S} ) {
55d729e4 827 while(1) {
54c90be1
J
828 my $menu = <<EOF;
829
830
831You have finished composing your message. At this point, you have
832a few options. You can:
833
6821e383 834 * [Se]nd the message to $address$andcc,
54c90be1
J
835 * [D]isplay the message on the screen,
836 * [R]e-edit the message
837 * Display or change the message's [su]bject
838 * Save the message to a [f]ile to mail at another time
839 * [Q]uit without sending a message
840
37fa004c 841EOF
8b49bb9a 842 retry:
54c90be1 843 print $menu;
9cea1b14
NT
844 my $action = _prompt('', "Action (Send/Display/Edit/Subject/Save to File)",
845 $opt{t} ? 'q' : '');
54c90be1 846 print "\n";
55d729e4 847 if ($action =~ /^(f|sa)/i) { # <F>ile/<Sa>ve
54c90be1 848 if ( SaveMessage() ) { exit }
55d729e4
GS
849 } elsif ($action =~ /^(d|l|sh)/i ) { # <D>isplay, <L>ist, <Sh>ow
850 # Display the message
bd18aea6 851 print _read_report($filename);
2bb62a09
CB
852 if ($have_attachment) {
853 print "\n\n---\nAttachment(s):\n";
854 for my $att (split /\s*,\s*/, $attachments) { print " $att\n"; }
855 }
2e7f46bf 856 } elsif ($action =~ /^su/i) { # <Su>bject
54c90be1 857 my $reply = _prompt( "Subject: $subject", "If the above subject is fine, press Enter. Otherwise, type a replacement now\nSubject");
2e7f46bf
JH
858 if ($reply ne '') {
859 unless (TrivialSubject($reply)) {
860 $subject = $reply;
861 print "Subject: $subject\n";
862 }
863 }
55d729e4
GS
864 } elsif ($action =~ /^se/i) { # <S>end
865 # Send the message
54c90be1
J
866 my $reply = _prompt( "Are you certain you want to send this message?", 'Please type "yes" if you are','no');
867 if ($reply =~ /^yes$/) {
55d729e4
GS
868 last;
869 } else {
870 paraprint <<EOF;
54c90be1 871You didn't type "yes", so your message has not yet been sent.
ab3ef367 872EOF
55d729e4
GS
873 }
874 } elsif ($action =~ /^[er]/i) { # <E>dit, <R>e-edit
875 # edit the message
876 Edit();
877 } elsif ($action =~ /^[qc]/i) { # <C>ancel, <Q>uit
878 Cancel();
01544859 879 } elsif ($action =~ /^s/i) {
55d729e4 880 paraprint <<EOF;
54c90be1 881The command you entered was ambiguous. Please type "send", "save" or "subject".
84478119 882EOF
55d729e4 883 }
37fa004c 884 }
55d729e4
GS
885 }
886} # sub NowWhat
37fa004c 887
2e7f46bf
JH
888sub TrivialSubject {
889 my $subject = shift;
890 if ($subject =~
891 /^(y(es)?|no?|help|perl( (bug|problem))?|bug|problem)$/i ||
892 length($subject) < 4 ||
a2b4240a 893 ($subject !~ /\s/ && ! $opt{t})) { # non-whitespace is accepted in test mode
54c90be1 894 print "\nThe subject you entered wasn't very descriptive. Please try again.\n\n";
2e7f46bf
JH
895 return 1;
896 } else {
897 return 0;
898 }
899}
900
54c90be1
J
901sub SaveMessage {
902 my $file_save = $outfile || "$progname.rep";
903 my $file = _prompt( '', "Name of file to save message in", $file_save );
904 save_message_to_disk($file) || return undef;
905 print "\n";
906 paraprint <<EOF;
907A copy of your message has been saved in '$file' for you to
908send to '$address' with your normal mail client.
909EOF
910}
911
37fa004c 912sub Send {
54c90be1 913
55d729e4 914 # Message has been accepted for transmission -- Send the message
afc5e478 915
54c90be1 916 # on linux certain "mail" implementations won't accept the subject
afc5e478
SB
917 # as "~s subject" and thus the Subject header will be corrupted
918 # so don't use Mail::Send to be safe
54c90be1
J
919 eval {
920 if ( $::HaveSend && !$Is_Linux && !$Is_OpenBSD ) {
921 _send_message_mailsend();
922 } elsif ($Is_VMS) {
923 _send_message_vms();
924 } else {
925 _send_message_sendmail();
926 }
927 };
37fa004c 928
54c90be1
J
929 if ( my $error = $@ ) {
930 paraprint <<EOF;
931$0 has detected an error while trying to send your message: $error.
c07a80fd 932
54c90be1 933Your message may not have been sent. You will now have a chance to save a copy to disk.
c07a80fd 934EOF
54c90be1
J
935 SaveMessage();
936 return;
55d729e4 937 }
54c90be1
J
938
939 1 while unlink($filename); # remove all versions under VMS
940} # sub Send
37fa004c
PP
941
942sub Help {
55d729e4 943 print <<EOF;
37fa004c 944
54c90be1
J
945This program is designed to help you generate and send bug reports
946(and thank-you notes) about perl5 and the modules which ship with it.
947
948In most cases, you can just run "$0" interactively from a command
949line without any special arguments and follow the prompts.
950
951Advanced usage:
55d729e4 952
105f9295 953$0 [-v] [-a address] [-s subject] [-b body | -f inpufile ] [ -F outputfile ]
d121ca8c 954 [-r returnaddress] [-e editor] [-c adminaddress | -C] [-S] [-t] [-h]
2bb62a09 955 [-p patchfile ]
890b8eb0 956$0 [-v] [-r returnaddress] [-A] [-ok | -okay | -nok | -nokay]
55d729e4 957
37fa004c
PP
958
959Options:
960
961 -v Include Verbose configuration data in the report
55d729e4 962 -f File containing the body of the report. Use this to
37fa004c 963 quickly send a prepared message.
2bb62a09
CB
964 -p File containing a patch or other text attachment. Separate
965 multiple files with commas.
1948c06a 966 -F File to output the resulting mail message to, instead of mailing.
37fa004c 967 -S Send without asking for confirmation.
c9967ac8
NC
968 -a Address to send the report to. Defaults to '$address'.
969 -c Address to send copy of report to. Defaults to '$cc'.
37fa004c 970 -C Don't send copy to administrator.
55d729e4 971 -s Subject to include with the message. You will be prompted
37fa004c
PP
972 if you don't supply one on the command line.
973 -b Body of the report. If not included on the command line, or
974 in a file with -f, you will get a chance to edit the message.
975 -r Your return address. The program will ask you to confirm
976 this if you don't give it here.
55d729e4 977 -e Editor to use.
c9967ac8
NC
978 -t Test mode. The target address defaults to '$testaddress'.
979 -T Thank-you mode. The target address defaults to '$thanksaddress'.
489b74f8 980 -d Data mode. This prints out your configuration data, without mailing
c07a80fd 981 anything. You can use this with -v to get more complete data.
890b8eb0 982 -A Don't send a bug received acknowledgement to the return address.
84902520 983 -ok Report successful build on this system to perl porters
55d729e4
GS
984 (use alone or with -v). Only use -ok if *everything* was ok:
985 if there were *any* problems at all, use -nok.
fb73857a 986 -okay As -ok but allow report from old builds.
55d729e4
GS
987 -nok Report unsuccessful build on this system to perl porters
988 (use alone or with -v). You must describe what went wrong
989 in the body of the report which you will be asked to edit.
990 -nokay As -nok but allow report from old builds.
991 -h Print this help message.
992
37fa004c
PP
993EOF
994}
995
55d729e4 996sub filename {
003a92ef
NC
997 if ($::HaveTemp) {
998 # Good. Use a secure temp file
999 my ($fh, $filename) = File::Temp::tempfile(UNLINK => 1);
1000 close($fh);
1001 return $filename;
1002 } else {
1003 # Bah. Fall back to doing things less securely.
1004 my $dir = File::Spec->tmpdir();
1005 $filename = "bugrep0$$";
1006 $filename++ while -e File::Spec->catfile($dir, $filename);
1007 $filename = File::Spec->catfile($dir, $filename);
1008 }
55d729e4
GS
1009}
1010
37fa004c
PP
1011sub paraprint {
1012 my @paragraphs = split /\n{2,}/, "@_";
37fa004c 1013 for (@paragraphs) { # implicit local $_
55d729e4
GS
1014 s/(\S)\s*\n/$1 /g;
1015 write;
1016 print "\n";
37fa004c 1017 }
37fa004c 1018}
37fa004c 1019
54c90be1
J
1020sub _prompt {
1021 my ($explanation, $prompt, $default) = (@_);
1022 if ($explanation) {
1023 print "\n\n";
1024 paraprint $explanation;
1025 }
1026 print $prompt. ($default ? " [$default]" :''). ": ";
1027 my $result = scalar(<>);
9cea1b14 1028 return $default if !defined $result; # got eof
54c90be1
J
1029 chomp($result);
1030 $result =~ s/^\s*(.*?)\s*$/$1/s;
1031 if ($default && $result eq '') {
1032 return $default;
1033 } else {
1034 return $result;
1035 }
1036}
1037
1038sub _build_header {
1039 my %attr = (@_);
1040
1041 my $head = '';
1042 for my $header (keys %attr) {
1043 $head .= "$header: ".$attr{$header}."\n";
1044 }
1045 return $head;
1046}
1047
1048sub _message_headers {
1049 my %headers = ( To => $address, Subject => $subject );
1050 $headers{'Cc'} = $cc if ($cc);
1051 $headers{'Message-Id'} = $messageid if ($messageid);
1052 $headers{'Reply-To'} = $from if ($from);
e4ef3332 1053 $headers{'From'} = $from if ($from);
2bb62a09
CB
1054 if ($have_attachment) {
1055 $headers{'MIME-Version'} = '1.0';
1056 $headers{'Content-Type'} = qq{multipart/mixed; boundary=\"$mime_boundary\"};
1057 }
54c90be1
J
1058 return \%headers;
1059}
1060
2bb62a09
CB
1061sub _add_body_start {
1062 my $body_start = <<"BODY_START";
1063This is a multi-part message in MIME format.
1064--$mime_boundary
fc6f6f37 1065Content-Type: text/plain; format=fixed
2bb62a09
CB
1066Content-Transfer-Encoding: 8bit
1067
1068BODY_START
1069 return $body_start;
1070}
1071
1072sub _add_attachments {
1073 my $attach = '';
1074 for my $attachment (split /\s*,\s*/, $attachments) {
1075 my $attach_file = basename($attachment);
1076 $attach .= <<"ATTACHMENT";
1077
1078--$mime_boundary
1079Content-Type: text/x-patch; name="$attach_file"
1080Content-Transfer-Encoding: 8bit
1081Content-Disposition: attachment; filename="$attach_file"
1082
1083ATTACHMENT
1084
092c3aff 1085 open my $attach_fh, '<:raw', $attachment
2bb62a09
CB
1086 or die "Couldn't open attachment '$attachment': $!\n";
1087 while (<$attach_fh>) { $attach .= $_; }
1088 close($attach_fh) or die "Error closing attachment '$attachment': $!";
1089 }
1090
1091 $attach .= "\n--$mime_boundary--\n";
1092 return $attach;
1093}
1094
bd18aea6
NT
1095sub _read_report {
1096 my $fname = shift;
1097 my $content;
1098 open( REP, "<:raw", $fname ) or die "Couldn't open file '$fname': $!\n";
1099 binmode(REP, ':raw :crlf') if $Is_MSWin32;
c04bead1
NT
1100 # wrap long lines to make sure the report gets delivered
1101 local $Text::Wrap::columns = 900;
1102 local $Text::Wrap::huge = 'overflow';
1103 while (<REP>) {
1104 if ($::HaveWrap && /\S/) { # wrap() would remove empty lines
1105 $content .= Text::Wrap::wrap(undef, undef, $_);
1106 } else {
1107 $content .= $_;
1108 }
1109 }
bd18aea6
NT
1110 close(REP) or die "Error closing report file '$fname': $!";
1111 return $content;
1112}
1113
54c90be1
J
1114sub build_complete_message {
1115 my $content = _build_header(%{_message_headers()}) . "\n\n";
2bb62a09 1116 $content .= _add_body_start() if $have_attachment;
bd18aea6 1117 $content .= _read_report($filename);
2bb62a09 1118 $content .= _add_attachments() if $have_attachment;
54c90be1
J
1119 return $content;
1120}
1121
1122sub save_message_to_disk {
1123 my $file = shift;
1124
fbb64cf5
KW
1125 if (-e $file) {
1126 my $response = _prompt( '', "Overwrite existing '$file'", 'n' );
1127 return undef unless $response =~ / yes | y /xi;
1128 }
092c3aff 1129 open OUTFILE, '>:raw', $file or do { warn "Couldn't open '$file': $!\n"; return undef};
7e6b9e3a
CB
1130 binmode(OUTFILE, ':raw :crlf') if $Is_MSWin32;
1131
54c90be1
J
1132 print OUTFILE build_complete_message();
1133 close(OUTFILE) or do { warn "Error closing $file: $!"; return undef };
1134 print "\nMessage saved.\n";
1135 return 1;
1136}
1137
1138sub _send_message_vms {
90e95a22
CB
1139
1140 my $mail_from = $from;
1141 my $rcpt_to_to = $address;
1142 my $rcpt_to_cc = $cc;
1143
1144 map { $_ =~ s/^[^<]*<//;
1145 $_ =~ s/>[^>]*//; } ($mail_from, $rcpt_to_to, $rcpt_to_cc);
1146
092c3aff 1147 if ( open my $sff_fh, '|-:raw', 'MCR TCPIP$SYSTEM:TCPIP$SMTP_SFF.EXE SYS$INPUT:' ) {
90e95a22
CB
1148 print $sff_fh "MAIL FROM:<$mail_from>\n";
1149 print $sff_fh "RCPT TO:<$rcpt_to_to>\n";
1150 print $sff_fh "RCPT TO:<$rcpt_to_cc>\n" if $rcpt_to_cc;
1151 print $sff_fh "DATA\n";
1152 print $sff_fh build_complete_message();
1153 my $success = close $sff_fh;
1154 if ($success ) {
1155 print "\nMessage sent\n";
1156 return;
54c90be1 1157 }
54c90be1 1158 }
90e95a22 1159 die "Mail transport failed (leaving bug report in $filename): $^E\n";
54c90be1
J
1160}
1161
1162sub _send_message_mailsend {
1163 my $msg = Mail::Send->new();
1164 my %headers = %{_message_headers()};
1165 for my $key ( keys %headers) {
1166 $msg->add($key => $headers{$key});
1167 }
1168
1169 $fh = $msg->open;
092c3aff 1170 binmode($fh, ':raw');
2bb62a09 1171 print $fh _add_body_start() if $have_attachment;
bd18aea6 1172 print $fh _read_report($filename);
2bb62a09 1173 print $fh _add_attachments() if $have_attachment;
e90b02b9 1174 $fh->close or die "Error sending mail: $!";
54c90be1
J
1175
1176 print "\nMessage sent.\n";
1177}
1178
1179sub _probe_for_sendmail {
1180 my $sendmail = "";
1181 for (qw(/usr/lib/sendmail /usr/sbin/sendmail /usr/ucblib/sendmail)) {
1182 $sendmail = $_, last if -e $_;
1183 }
1184 if ( $^O eq 'os2' and $sendmail eq "" ) {
1185 my $path = $ENV{PATH};
1186 $path =~ s:\\:/:;
1187 my @path = split /$Config{'path_sep'}/, $path;
1188 for (@path) {
1189 $sendmail = "$_/sendmail", last if -e "$_/sendmail";
1190 $sendmail = "$_/sendmail.exe", last if -e "$_/sendmail.exe";
1191 }
1192 }
1193 return $sendmail;
1194}
1195
1196sub _send_message_sendmail {
1197 my $sendmail = _probe_for_sendmail();
1198 unless ($sendmail) {
e90d6148 1199 my $message_start = !$Is_Linux && !$Is_OpenBSD ? <<'EOT' : <<'EOT';
54c90be1
J
1200It appears that there is no program which looks like "sendmail" on
1201your system and that the Mail::Send library from CPAN isn't available.
e90d6148
A
1202EOT
1203It appears that there is no program which looks like "sendmail" on
1204your system.
1205EOT
1206 paraprint(<<"EOF"), die "\n";
1207$message_start
54c90be1
J
1208Because of this, there's no easy way to automatically send your
1209message.
1210
1211A copy of your message has been saved in '$filename' for you to
1212send to '$address' with your normal mail client.
1213EOF
1214 }
1215
092c3aff 1216 open( SENDMAIL, "|-:raw", $sendmail, "-t", "-oi", "-f", $from )
019cfd23 1217 || die "'|$sendmail -t -oi -f $from' failed: $!";
54c90be1
J
1218 print SENDMAIL build_complete_message();
1219 if ( close(SENDMAIL) ) {
1220 print "\nMessage sent\n";
1221 } else {
1222 warn "\nSendmail returned status '", $? >> 8, "'\n";
1223 }
1224}
1225
1226
1227
1228# a strange way to check whether any significant editing
1229# has been done: check whether any new non-empty lines
1230# have been added.
1231
1232sub _fingerprint_lines_in_report {
1233 my $new_lines = 0;
1234 # read in the report template once so that
1235 # we can track whether the user does any editing.
1236 # yes, *all* whitespace is ignored.
1237
092c3aff 1238 open(REP, '<:raw', $filename) or die "Unable to open report file '$filename': $!\n";
7e6b9e3a 1239 binmode(REP, ':raw :crlf') if $Is_MSWin32;
54c90be1
J
1240 while (my $line = <REP>) {
1241 $line =~ s/\s+//g;
1242 $new_lines++ if (!$REP{$line});
1243
1244 }
1245 close(REP) or die "Error closing report file '$filename': $!";
1246 # returns the number of lines with content that wasn't there when last we looked
1247 return $new_lines;
1248}
1249
1250
1251
37fa004c
PP
1252format STDOUT =
1253^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
1254$_
1255.
d121ca8c
CS
1256
1257__END__
1258
1259=head1 NAME
1260
1261perlbug - how to submit bug reports on Perl
1262
1263=head1 SYNOPSIS
1264
54c90be1
J
1265B<perlbug>
1266
d121ca8c 1267B<perlbug> S<[ B<-v> ]> S<[ B<-a> I<address> ]> S<[ B<-s> I<subject> ]>
105f9295
HS
1268S<[ B<-b> I<body> | B<-f> I<inputfile> ]> S<[ B<-F> I<outputfile> ]>
1269S<[ B<-r> I<returnaddress> ]>
d121ca8c 1270S<[ B<-e> I<editor> ]> S<[ B<-c> I<adminaddress> | B<-C> ]>
985dc10a 1271S<[ B<-S> ]> S<[ B<-t> ]> S<[ B<-d> ]> S<[ B<-A> ]> S<[ B<-h> ]> S<[ B<-T> ]>
d121ca8c 1272
55d729e4 1273B<perlbug> S<[ B<-v> ]> S<[ B<-r> I<returnaddress> ]>
890b8eb0 1274 S<[ B<-A> ]> S<[ B<-ok> | B<-okay> | B<-nok> | B<-nokay> ]>
1b0e3b9e 1275
985dc10a
SP
1276B<perlthanks>
1277
d121ca8c
CS
1278=head1 DESCRIPTION
1279
d121ca8c 1280
54c90be1
J
1281This program is designed to help you generate and send bug reports
1282(and thank-you notes) about perl5 and the modules which ship with it.
1283
1284In most cases, you can just run it interactively from a command
1285line without any special arguments and follow the prompts.
1286
1287If you have found a bug with a non-standard port (one that was not
1288part of the I<standard distribution>), a binary distribution, or a
1289non-core module (such as Tk, DBI, etc), then please see the
1290documentation that came with that distribution to determine the
1291correct place to report bugs.
d121ca8c 1292
54c90be1
J
1293If you are unable to send your report using B<perlbug> (most likely
1294because your system doesn't have a way to send mail that perlbug
1295recognizes), you may be able to use this tool to compose your report
1296and save it to a file which you can then send to B<perlbug@perl.org>
1297using your regular mail client.
d121ca8c 1298
54c90be1
J
1299In extreme cases, B<perlbug> may not work well enough on your system
1300to guide you through composing a bug report. In those cases, you
1301may be able to use B<perlbug -d> to get system configuration
1302information to include in a manually composed bug report to
1303B<perlbug@perl.org>.
d121ca8c 1304
54c90be1
J
1305
1306When reporting a bug, please run through this checklist:
d121ca8c
CS
1307
1308=over 4
1309
884baa66 1310=item What version of Perl you are running?
d121ca8c
CS
1311
1312Type C<perl -v> at the command line to find out.
1313
1314=item Are you running the latest released version of perl?
1315
54c90be1
J
1316Look at http://www.perl.org/ to find out. If you are not using the
1317latest released version, please try to replicate your bug on the
1318latest stable release.
1319
1320Note that reports about bugs in old versions of Perl, especially
1321those which indicate you haven't also tested the current stable
1322release of Perl, are likely to receive less attention from the
1323volunteers who build and maintain Perl than reports about bugs in
1324the current release.
1325
5538372e 1326This tool isn't appropriate for reporting bugs in any version
54c90be1 1327prior to Perl 5.0.
d121ca8c
CS
1328
1329=item Are you sure what you have is a bug?
1330
54c90be1
J
1331A significant number of the bug reports we get turn out to be
1332documented features in Perl. Make sure the issue you've run into
1333isn't intentional by glancing through the documentation that comes
1334with the Perl distribution.
d121ca8c 1335
54c90be1
J
1336Given the sheer volume of Perl documentation, this isn't a trivial
1337undertaking, but if you can point to documentation that suggests
1338the behaviour you're seeing is I<wrong>, your issue is likely to
1339receive more attention. You may want to start with B<perldoc>
1340L<perltrap> for pointers to common traps that new (and experienced)
1341Perl programmers run into.
d121ca8c 1342
54c90be1
J
1343If you're unsure of the meaning of an error message you've run
1344across, B<perldoc> L<perldiag> for an explanation. If the message
1345isn't in perldiag, it probably isn't generated by Perl. You may
1346have luck consulting your operating system documentation instead.
bdcdfa19 1347
54c90be1 1348If you are on a non-UNIX platform B<perldoc> L<perlport>, as some
1948c06a 1349features may be unimplemented or work differently.
bdcdfa19 1350
54c90be1
J
1351You may be able to figure out what's going wrong using the Perl
1352debugger. For information about how to use the debugger B<perldoc>
1353L<perldebug>.
d121ca8c
CS
1354
1355=item Do you have a proper test case?
1356
1357The easier it is to reproduce your bug, the more likely it will be
985dc10a 1358fixed -- if nobody can duplicate your problem, it probably won't be
54c90be1
J
1359addressed.
1360
1361A good test case has most of these attributes: short, simple code;
1362few dependencies on external commands, modules, or libraries; no
1363platform-dependent code (unless it's a platform-specific bug);
1364clear, simple documentation.
1365
1366A good test case is almost always a good candidate to be included in
1367Perl's test suite. If you have the time, consider writing your test case so
1368that it can be easily included into the standard test suite.
d121ca8c 1369
54c90be1 1370=item Have you included all relevant information?
d121ca8c 1371
54c90be1
J
1372Be sure to include the B<exact> error messages, if any.
1373"Perl gave an error" is not an exact error message.
bdcdfa19
JH
1374
1375If you get a core dump (or equivalent), you may use a debugger
1376(B<dbx>, B<gdb>, etc) to produce a stack trace to include in the bug
54c90be1
J
1377report.
1378
1379NOTE: unless your Perl has been compiled with debug info
bdcdfa19 1380(often B<-g>), the stack trace is likely to be somewhat hard to use
884baa66 1381because it will most probably contain only the function names and not
bdcdfa19 1382their arguments. If possible, recompile your Perl with debug info and
54c90be1 1383reproduce the crash and the stack trace.
bdcdfa19 1384
d121ca8c
CS
1385=item Can you describe the bug in plain English?
1386
54c90be1
J
1387The easier it is to understand a reproducible bug, the more likely
1388it will be fixed. Any insight you can provide into the problem
1389will help a great deal. In other words, try to analyze the problem
1390(to the extent you can) and report your discoveries.
d121ca8c
CS
1391
1392=item Can you fix the bug yourself?
1393
2bb62a09
CB
1394If so, that's great news; bug reports with patches are likely to
1395receive significantly more attention and interest than those without
1396patches. Please attach your patch to the report using the C<-p> option.
1397When sending a patch, create it using C<git format-patch> if possible,
1398though a unified diff created with C<diff -pu> will do nearly as well.
54c90be1
J
1399
1400Your patch may be returned with requests for changes, or requests for more
d121ca8c
CS
1401detailed explanations about your fix.
1402
54c90be1
J
1403Here are a few hints for creating high-quality patches:
1404
1405Make sure the patch is not reversed (the first argument to diff is
1406typically the original file, the second argument your changed file).
2bb62a09
CB
1407Make sure you test your patch by applying it with C<git am> or the
1408C<patch> program before you send it on its way. Try to follow the
1409same style as the code you are trying to patch. Make sure your patch
1410really does work (C<make test>, if the thing you're patching is covered
54c90be1 1411by Perl's test suite).
d121ca8c
CS
1412
1413=item Can you use C<perlbug> to submit the report?
1414
1415B<perlbug> will, amongst other things, ensure your report includes
54c90be1
J
1416crucial information about your version of perl. If C<perlbug> is
1417unable to mail your report after you have typed it in, you may have
1418to compose the message yourself, add the output produced by C<perlbug
1419-d> and email it to B<perlbug@perl.org>. If, for some reason, you
1420cannot run C<perlbug> at all on your system, be sure to include the
1421entire output produced by running C<perl -V> (note the uppercase V).
d121ca8c 1422
bdcdfa19 1423Whether you use C<perlbug> or send the email manually, please make
54c90be1
J
1424your Subject line informative. "a bug" is not informative. Neither
1425is "perl crashes" nor is "HELP!!!". These don't help. A compact
1426description of what's wrong is fine.
bdcdfa19 1427
985dc10a
SP
1428=item Can you use C<perlbug> to submit a thank-you note?
1429
1430Yes, you can do this by either using the C<-T> option, or by invoking
1431the program as C<perlthanks>. Thank-you notes are good. It makes people
1432smile.
1433
d121ca8c
CS
1434=back
1435
54c90be1
J
1436Having done your bit, please be prepared to wait, to be told the
1437bug is in your code, or possibly to get no reply at all. The
1438volunteers who maintain Perl are busy folks, so if your problem is
1439an obvious bug in your own code, is difficult to understand or is
1440a duplicate of an existing report, you may not receive a personal
1441reply.
1442
26ab4e07 1443If it is important to you that your bug be fixed, do monitor the
a9d7774b
MM
1444perl5-porters@perl.org mailing list (mailing lists are moderated, your
1445message may take a while to show up) and the commit logs to development
54c90be1
J
1446versions of Perl, and encourage the maintainers with kind words or
1447offers of frosty beverages. (Please do be kind to the maintainers.
a9d7774b
MM
1448Harassing or flaming them is likely to have the opposite effect of the
1449one you want.)
54c90be1
J
1450
1451Feel free to update the ticket about your bug on http://rt.perl.org
1452if a new version of Perl is released and your bug is still present.
d121ca8c
CS
1453
1454=head1 OPTIONS
1455
1456=over 8
1457
1458=item B<-a>
1459
3e79b69b 1460Address to send the report to. Defaults to B<perlbug@perl.org>.
d121ca8c 1461
890b8eb0
NC
1462=item B<-A>
1463
1464Don't send a bug received acknowledgement to the reply address.
1465Generally it is only a sensible to use this option if you are a
1466perl maintainer actively watching perl porters for your message to
1467arrive.
1468
d121ca8c
CS
1469=item B<-b>
1470
1471Body of the report. If not included on the command line, or
1472in a file with B<-f>, you will get a chance to edit the message.
1473
1474=item B<-C>
1475
1476Don't send copy to administrator.
1477
1478=item B<-c>
1479
1480Address to send copy of report to. Defaults to the address of the
1481local perl administrator (recorded when perl was built).
1482
1483=item B<-d>
1484
1485Data mode (the default if you redirect or pipe output). This prints out
1486your configuration data, without mailing anything. You can use this
1487with B<-v> to get more complete data.
1488
1489=item B<-e>
1490
55d729e4 1491Editor to use.
d121ca8c
CS
1492
1493=item B<-f>
1494
1495File containing the body of the report. Use this to quickly send a
1496prepared message.
1497
105f9295
HS
1498=item B<-F>
1499
1500File to output the results to instead of sending as an email. Useful
1501particularly when running perlbug on a machine with no direct internet
1502connection.
1503
d121ca8c
CS
1504=item B<-h>
1505
1506Prints a brief summary of the options.
1507
1b0e3b9e
CR
1508=item B<-ok>
1509
84902520
TB
1510Report successful build on this system to perl porters. Forces B<-S>
1511and B<-C>. Forces and supplies values for B<-s> and B<-b>. Only
1b0e3b9e 1512prompts for a return address if it cannot guess it (for use with
84902520
TB
1513B<make>). Honors return address specified with B<-r>. You can use this
1514with B<-v> to get more complete data. Only makes a report if this
1515system is less than 60 days old.
1516
1517=item B<-okay>
1518
1519As B<-ok> except it will report on older systems.
1b0e3b9e 1520
55d729e4
GS
1521=item B<-nok>
1522
1523Report unsuccessful build on this system. Forces B<-C>. Forces and
1524supplies a value for B<-s>, then requires you to edit the report
1525and say what went wrong. Alternatively, a prepared report may be
1526supplied using B<-f>. Only prompts for a return address if it
1527cannot guess it (for use with B<make>). Honors return address
1528specified with B<-r>. You can use this with B<-v> to get more
1529complete data. Only makes a report if this system is less than 60
1530days old.
1531
1532=item B<-nokay>
1533
1534As B<-nok> except it will report on older systems.
1535
2bb62a09
CB
1536=item B<-p>
1537
1538The names of one or more patch files or other text attachments to be
1539included with the report. Multiple files must be separated with commas.
1540
d121ca8c
CS
1541=item B<-r>
1542
1543Your return address. The program will ask you to confirm its default
1544if you don't use this option.
1545
1546=item B<-S>
1547
1548Send without asking for confirmation.
1549
1550=item B<-s>
1551
1552Subject to include with the message. You will be prompted if you don't
1553supply one on the command line.
1554
1555=item B<-t>
1556
3e79b69b 1557Test mode. The target address defaults to B<perlbug-test@perl.org>.
fdfa3307
NT
1558Also makes it possible to command perlbug from a pipe or file, for
1559testing purposes.
d121ca8c 1560
985dc10a
SP
1561=item B<-T>
1562
1563Send a thank-you note instead of a bug report.
1564
d121ca8c
CS
1565=item B<-v>
1566
1567Include verbose configuration data in the report.
1568
1569=back
1570
1571=head1 AUTHORS
1572
54c90be1
J
1573Kenneth Albanowski (E<lt>kjahds@kjahds.comE<gt>), subsequently
1574I<doc>tored by Gurusamy Sarathy (E<lt>gsar@activestate.comE<gt>),
1575Tom Christiansen (E<lt>tchrist@perl.comE<gt>), Nathan Torkington
1576(E<lt>gnat@frii.comE<gt>), Charles F. Randall (E<lt>cfr@pobox.comE<gt>),
9e533305
DH
1577Mike Guy (E<lt>mjtg@cam.ac.ukE<gt>), Dominic Dunlop
1578(E<lt>domo@computer.orgE<gt>), Hugo van der Sanden (E<lt>hv@crypt.orgE<gt>),
50d3c28b
GS
1579Jarkko Hietaniemi (E<lt>jhi@iki.fiE<gt>), Chris Nandor
1580(E<lt>pudge@pobox.comE<gt>), Jon Orwant (E<lt>orwant@media.mit.eduE<gt>,
2bb62a09
CB
1581Richard Foley (E<lt>richard.foley@rfi.netE<gt>), Jesse Vincent
1582(E<lt>jesse@bestpractical.comE<gt>), and Craig A. Berry (E<lt>craigberry@mac.comE<gt>).
d121ca8c
CS
1583
1584=head1 SEE ALSO
1585
bdcdfa19
JH
1586perl(1), perldebug(1), perldiag(1), perlport(1), perltrap(1),
1587diff(1), patch(1), dbx(1), gdb(1)
d121ca8c
CS
1588
1589=head1 BUGS
1590
1591None known (guess what must have been used to report them?)
1592
1593=cut
1594
37fa004c
PP
1595!NO!SUBS!
1596
1597close OUT or die "Can't close $file: $!";
1598chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
1599exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
8a5546a1 1600chdir $origdir;