my $patchlevel_date = (stat PATCH_LEVEL)[9];
while (<PATCH_LEVEL>) {
- last if index($_, "static\tchar\t*local_patches[] = {") >= 0;
+ last if $_ =~ /^\s*static\s+char.*?local_patches\[\]\s*=\s*{\s*$/;
};
-my $patches;
+my @patches;
while (<PATCH_LEVEL>) {
- last if /^}/;
+ last if /^\s*}/;
chomp;
s/^\s+,?"?//;
s/"?,?$//;
s/(['\\])/\\$1/g;
- $patches .= "'$_',\n" unless $_ eq 'NULL';
+ 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";
eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
if \$running_under_some_shell;
+my \$config_tag1 = '$] - $Config{cf_time}';
+
my \$patchlevel_date = $patchlevel_date;
-my \@patches = ( $patches );
+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.19";
+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.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;
$::opt_S = 1; # don't prompt for send
$::opt_C = 1; # don't send a copy to the local admin
$::opt_s = 1;
- $subject = "OK: perl $] on"
- ." $::Config{'osname'} $::Config{'osvers'} $subject";
+ $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;
$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);
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 (@patches) {
- print OUT join "\n\t", "\nLocally applied patches:", @patches;
+ print OUT join "\n\t", "Locally applied patches:", @patches;
print OUT "\n";
};
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 system to perl porters
- (use alone or with -v).
- -okay As -ok but also report on older systems.
+ (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