# %Config entries. Thus you write
# $startperl
# to ensure Configure will look for $Config{startperl}.
+# $perlpath
# This forces PL files to create target in same directory as PL file.
# This is so that make depend always knows where to find PL derivatives.
open OUT,">$file" or die "Can't create $file: $!";
+# extract patchlevel.h information
+
+open PATCH_LEVEL, "<../patchlevel.h" or die "Can't open patchlevel.h: $!";
+
+my $patchlevel_date = (stat PATCH_LEVEL)[9];
+
+while (<PATCH_LEVEL>) {
+ last if $_ =~ /^\s*static\s+char.*?local_patches\[\]\s*=\s*{\s*$/;
+};
+
+my @patches;
+while (<PATCH_LEVEL>) {
+ last if /^\s*}/;
+ chomp;
+ s/^\s+,?"?//;
+ s/"?,?$//;
+ s/(['\\])/\\$1/g;
+ push @patches, $_ unless $_ eq 'NULL';
+};
+my $patch_desc = "'" . join("',\n\t'", @patches) . "'";
+my @patch_tags = map { my $p=$_; $p=~s/\s.*//; $p } @patches;
+my $patch_tags = join " ", map { "+$_" } @patch_tags;
+$patch_tags .= " " if $patch_tags;
+
+close PATCH_LEVEL;
+
+# TO DO (prehaps): store/embed $Config::config_sh into perlbug. When perlbug is
+# used, compare $Config::config_sh with the stored version. If they differ then
+# append a list of individual differences to the bug report.
+
+
print "Extracting $file (with variable substitutions)\n";
# In this section, perl variables will be expanded during extraction.
$Config{startperl}
eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
if \$running_under_some_shell;
+
+my \$config_tag1 = '$] - $Config{cf_time}';
+
+my \$patchlevel_date = $patchlevel_date;
+my \$patch_tags = '$patch_tags';
+my \@patches = (
+ $patch_desc
+);
!GROK!THIS!
# In the following, perl variables are not expanded during extraction.
sub paraprint;
-my($Version) = "1.18";
+my($Version) = "1.20";
# Changed in 1.06 to skip Mail::Send and Mail::Util if not available.
# Changed in 1.07 to see more sendmail execs, and added pipe output.
# Changed in 1.16 to include @INC, and allow user to re-edit if no changes.
# Changed in 1.17 Win32 support added. GSAR 97-04-12
# Changed in 1.18 add '-ok' option for reporting build success. CFR 97-06-18
+# Changed in 1.19 '-ok' default not '-v'
+# add local patch information
+# warn on '-ok' if this is an old system; add '-okay'
+# Changed in 1.20 Added patchlevel.h reading and version/config checks
# TODO: - Allow the user to re-name the file on mail failure, and
# make sure failure (transmission-wise) of Mail::Send is
$subject, $from, $verbose, $ed,
$fh, $me, $Is_MSWin32, $Is_VMS, $msg, $body, $andcc, %REP, $ok);
+my $config_tag2 = "$] - $Config{cf_time}";
+
Init();
if($::opt_h) { Help(); exit; }
+if($::opt_d) { Dump(*STDOUT); exit; }
+
if(!-t STDIN) {
paraprint <<EOF;
Please use perlbug interactively. If you want to
die "\n";
}
-if($::opt_d or !-t STDOUT) { Dump(*STDOUT); exit; }
+if(!-t STDOUT) { Dump(*STDOUT); exit; }
Query();
Edit() unless $usefile;
# OK - send "OK" report for build on this system
$ok = 0;
if ( $::opt_o ) {
- if ( $::opt_o eq 'k' ) {
+ if ( $::opt_o eq 'k' or $::opt_o eq 'kay' ) {
+ my $age = time - $patchlevel_date;
+ if ( $::opt_o eq 'k' and $age > 60 * 24 * 60 * 60 ) {
+ my $date = localtime $patchlevel_date;
+ print <<"EOF";
+\"perlbug -ok\" does not report on Perl versions which are more than
+60 days old. This Perl version was constructed on $date.
+If you really want to report this, use \"perlbug -okay\".
+EOF
+ exit();
+ };
# force these options
$::opt_S = 1; # don't prompt for send
$::opt_C = 1; # don't send a copy to the local admin
- $::opt_v = 1; $verbose = 1;
- $::opt_s = 1; $subject = "OK: perl $] on "
- . $::Config{'osname'} . ' '
- . $::Config{'osvers'};
- $::opt_b = 1; $body = "Perl reported to build OK on this system\n";
+ $::opt_s = 1;
+ $subject = "OK: perl $] ${patch_tags}on"
+ ." $::Config{'archname'} $::Config{'osvers'} $subject";
+ $::opt_b = 1;
+ $body = "Perl reported to build OK on this system.\n";
$ok = 1;
}
else {
));
# My username
- $me = ($Is_MSWin32 ? $ENV{'USERNAME'} : getpwuid($<));
+ $me = ( $Is_MSWin32
+ ? $ENV{'USERNAME'}
+ : ( $^O eq 'os2'
+ ? $ENV{'USER'} || $ENV{'LOGNAME'}
+ : eval { getpwuid($<) }) ); # May be missing
}
$domain = Mail::Util::maildomain();
} elsif ($Is_MSWin32) {
$domain = $ENV{'USERDOMAIN'};
- } elsif ($Is_VMS) {
+ } else {
require Sys::Hostname;
$domain = Sys::Hostname::hostname();
- } else {
- $domain = `hostname`.".".`domainname`;
- $domain =~ s/[\r\n]+//g;
}
my($guess);
{
my($dir) = ($Is_VMS ? 'sys$scratch:' :
- ($Is_MSWin32 and $ENV{'TEMP'} ? $ENV{'TEMP'} : '/tmp/'));
+ (($Is_MSWin32 && $ENV{'TEMP'}) ? $ENV{'TEMP'} : '/tmp/'));
$filename = "bugrep0$$";
$dir .= "\\" if $Is_MSWin32 and $dir !~ m|[\\/]$|;
$filename++ while -e "$dir$filename";
open(REP,">$filename");
+ my $reptype = $ok ? "success" : "bug";
+
print REP <<EOF;
-This is a bug report for perl from $from,
+This is a $reptype report for perl from $from,
generated with the help of perlbug $Version running under perl $].
EOF
sub Dump {
local(*OUT) = @_;
- print OUT <<EOF;
+ print REP "\n---\n";
----
+ print REP "This perlbug was built using Perl $config_tag1\n",
+ "It is being executed now by Perl $config_tag2.\n\n"
+ if $config_tag2 ne $config_tag1;
+
+ print OUT <<EOF;
Site configuration information for perl $]:
EOF
print OUT Config::myconfig;
- if($verbose) {
- print OUT "\nComplete configuration data for perl $]:\n\n";
- my($value);
- foreach (sort keys %::Config) {
- $value = $::Config{$_};
- $value =~ s/'/\\'/g;
- print OUT "$_='$value'\n";
- }
- }
+ if (@patches) {
+ print OUT join "\n\t", "Locally applied patches:", @patches;
+ print OUT "\n";
+ };
+
print OUT <<EOF;
---
exists $ENV{$env} ? "=$ENV{$env}" : ' (unset)',
"\n";
}
+ if($verbose) {
+ print OUT "\nComplete configuration data for perl $]:\n\n";
+ my($value);
+ foreach (sort keys %::Config) {
+ $value = $::Config{$_};
+ $value =~ s/'/\\'/g;
+ print OUT "$_='$value'\n";
+ }
+ }
}
sub Edit {
$fh->close;
+ print "\nMessage sent.\n";
} else {
if ($Is_VMS) {
if ( ($address =~ /@/ and $address !~ /^\w+%"/) or
{
$sendmail = $_, last if -e $_;
}
+
+ if ($^O eq 'os2' and $sendmail eq "") {
+ my $path = $ENV{PATH};
+ $path =~ s:\\:/: ;
+ my @path = split /$Config{path_sep}/, $path;
+ for (@path) {
+ $sendmail = "$_/sendmail", last
+ if -e "$_/sendmail";
+ $sendmail = "$_/sendmail.exe", last
+ if -e "$_/sendmail.exe";
+ }
+ }
- paraprint <<"EOF", die "\n" if $sendmail eq "";
+ paraprint(<<"EOF"), die "\n" if $sendmail eq "";
I am terribly sorry, but I cannot find sendmail, or a close equivalent, and
the perl package Mail::Send has not been installed, so I can't send your bug
EOF
- open(SENDMAIL,"|$sendmail -t");
+ open(SENDMAIL,"|$sendmail -t") || die "'|$sendmail -t' failed: $|";
print SENDMAIL "To: $address\n";
print SENDMAIL "Subject: $subject\n";
print SENDMAIL "Cc: $cc\n" if $cc;
while(<REP>) { print SENDMAIL $_ }
close(REP);
- close(SENDMAIL);
+ if (close(SENDMAIL)) {
+ print "\nMessage sent.\n";
+ } else {
+ warn "\nSendmail returned status '",$?>>8,"'\n";
+ }
}
}
-
- print "\nMessage sent.\n";
1 while unlink($filename); # remove all versions under VMS
-d Data mode (the default if you redirect or pipe output.)
This prints out your configuration data, without mailing
anything. You can use this with -v to get more complete data.
- -ok Report successful build on this sytem to perl porters (use alone).
+ -ok Report successful build on this system to perl porters
+ (use alone or with -v). Only use -ok if *everything* was ok.
+ If there were *any* problems at all then don't use -ok.
+ -okay As -ok but allow report from old builds.
-h Print this help message.
EOF
S<[ B<-e> I<editor> ]> S<[ B<-c> I<adminaddress> | B<-C> ]>
S<[ B<-S> ]> S<[ B<-t> ]> S<[ B<-d> ]> S<[ B<-h> ]>
-B<perlbug> S<[ B<-r> I<returnaddress> ]> B<-ok>
+B<perlbug> S<[ B<-v> ]> S<[ B<-r> I<returnaddress> ]> S<[ B<-ok> | B<okay> ]>
=head1 DESCRIPTION
Having done your bit, please be prepared to wait, to be told the bug
is in your code, or even to get no reply at all. The perl maintainers
-are busy folks, so if your problem is a small one or if it is
-difficult to understand, they may not respond with a personal reply.
+are busy folks, so if your problem is a small one or if it is difficult
+to understand or already known, they may not respond with a personal reply.
If it is important to you that your bug be fixed, do monitor the
C<Changes> file in any development releases since the time you submitted
the bug, and encourage the maintainers with kind words (but never any
=item B<-ok>
-Report successful build on this system to perl porters. Forces B<-S>,
-B<-C>, and B<-v>. Forces and supplies values for B<-s> and B<-b>. Only
+Report successful build on this system to perl porters. Forces B<-S>
+and B<-C>. Forces and supplies values for B<-s> and B<-b>. Only
prompts for a return address if it cannot guess it (for use with
-B<make>). Honors return address specified with B<-r>.
+B<make>). Honors return address specified with B<-r>. You can use this
+with B<-v> to get more complete data. Only makes a report if this
+system is less than 60 days old.
+
+=item B<-okay>
+
+As B<-ok> except it will report on older systems.
=item B<-r>
Kenneth Albanowski (E<lt>kjahds@kjahds.comE<gt>), subsequently I<doc>tored
by Gurusamy Sarathy (E<lt>gsar@umich.eduE<gt>), Tom Christiansen
(E<lt>tchrist@perl.comE<gt>), Nathan Torkington (E<lt>gnat@frii.comE<gt>),
-and Charles F. Randall (E<lt>cfr@pobox.comE<gt>).
+Charles F. Randall (E<lt>cfr@pobox.comE<gt>) and
+Mike Guy (E<lt>mjtg@cam.a.ukE<gt>).
=head1 SEE ALSO
projects / p5sagit/p5-mst-13.2.git / blobdiff