3 # arguments can be package names: their versions are appended to each line, space separated
20 my $optpod = <<'=back';
24 TBD: Code to eval and print the output.
32 when determining the config file, use this hostname.
36 stop output after that many perls
48 Config attributes to be included in the table. Defaults to
49 C<useithreads>, C<uselongdouble>, and C<config_args~EBUGGING=both>.
51 Config attributes are mostly reported with their own value with two
57 If the expression contains a tilde, it's a primitive matching. RTFS.
59 =item B<--sprintfwidth|w=i>
61 Width reserved for the versions. Defaults to 8. If there is one
62 spielverderber with a version number of 20110324.1600_001, you can set
63 it to 17 to get the columns aligned.
67 Include the module names in the output
73 Lookss which perls we have in
74 C</home/sand/src/perl/repoperls/installed-perls/perl/> and reports
75 about the two significant directory levels in their paths, ordered
76 according to perl's git conventions, e.g.:
78 v5.17.7.0-15-ge2beedf/a2da
79 v5.17.7.0-15-ge2beedf/9980
80 v5.17.7.0-15-ge2beedf/127ecf
81 v5.17.7.0-15-ge2beedf/127ec
82 v5.17.7.0-15-ge2beedf/127e
83 v5.17.6-424-ge2beedf/127e
84 v5.17.6-423-g67e0a0c/9980
85 v5.17.6-422-gc2219ca/a2da
86 v5.17.6-421-gd1bee06/165a
87 v5.17.6-416-g9a90211/127e
88 v5.17.6-415-gbfd14e5/9980
89 v5.17.6-413-g2e1be9f/a2da
90 v5.17.6-412-g6e0a4ea/165a
91 v5.17.6-408-g3cf48ca/127e
92 v5.17.6-306-g23b7025/9980
93 v5.17.6-98-gcd298ce/127e
94 v5.17.6-97-gf5a0fd1/9980
95 v5.17.6-97-gf5a0fd1/127e
96 v5.17.6-92-g00f6437/127e
108 use Pod
::Usage
qw(pod2usage);
110 $ENV{HARNESS_ACTIVE
} = 1;
112 my @opt = $optpod =~ /B<--(\S+)>/g;
120 pod2usage
(0) if $Opt{help
};
122 use Sys
::Hostname
qw(hostname);
124 use Time
::HiRes
qw(sleep);
126 my $hostname = $Opt{hostname
} || hostname
();
128 my $perls_config_file = "/home/sand/src/andk/andk-cpan-tools/bin/loop-over-recent.pl.otherperls.$hostname";
130 my $perlhomepath = "perl";
131 unless ($hostname eq "k83") {
132 $perlhomepath = "host/$hostname";
134 if (open my $fh2, $perls_config_file) {
137 s/#.*//; # remove comments
138 s/\s+\z//; # remove trailing spaces
139 next if /^\s*$/; # remove empty/white lines
141 s
|^|/home/sand
/src/perl
/repoperls/installed
-perls
/$perlhomepath/|;
151 my @L = grep { !/bad/ }glob("/home/sand/src/perl/repoperls/installed-perls/$perlhomepath/*/*/bin/perl");
152 my %firstlettermap = ( p
=>1, G
=>2, v
=>3 );
154 my $aXX = substr($a,47+length($perlhomepath));
155 my $bXX = substr($b,47+length($perlhomepath));
156 my $ret = $firstlettermap{substr($bXX,0,1)} <=> $firstlettermap{substr($aXX,0,1)};
161 if ($aXX =~ /(.+)-RC(\d+)/) {
162 if ($bXX =~ /(.+)-RC(\d+)/) {
163 } elsif (substr($bXX,0,length($1)) eq $1) {
166 } elsif ($bXX =~ /(.+)-RC(\d+)/) {
167 if ($aXX =~ /(.+)-RC(\d+)/) {
168 } elsif (substr($aXX,0,length($1)) eq $1) {
180 $ret = versioncmp
($bXX,$aXX);
183 my $aXX = substr($a,47+length($perlhomepath));
184 my $bXX = substr($b,47+length($perlhomepath));
185 $ret = $bXX cmp $aXX;
187 # warn sprintf "%-12s %-12s %s\n", $aXX, $bXX, $ret;
193 my @testperl_not_in_globperl = grep { !$globperl{$_} } keys %testperl;
194 unshift @L, @testperl_not_in_globperl;
195 if ($Opt{max
} && $Opt{max
} < @L) {
196 pop @L while $Opt{max
} < @L;
199 my @Showconfig = qw(useithreads uselongdouble config_args~EBUGGING=both);
200 for my $showconfig (@
{$Opt{show
}||[]}) {
201 push @Showconfig, $showconfig;
203 $Opt{sprintfwidth
} ||= 8;
204 # this string is injected into the small program that every perl has to execute:
205 my $sprintfshowconfig = "%1s%1s%1s " . join " ", ("%-$Opt{sprintfwidth}s") x
(@Showconfig-3);
206 # this string is injected into the small program that every perl has to execute:
207 my $showconfigvalues = join " ", @Showconfig;
208 my $modules_differs_from_args = 0;
211 } elsif (s/\.pm$//) {
213 $modules_differs_from_args++;
216 $modules_differs_from_args++;
227 if ($modules_differs_from_args++) {
230 # some day try with IPC::System::Simple for better signal handling? I
231 # mean for delivering ^C to the right process(es)?
235 warn "Saw signal '$sig', will stop asap";
238 PERL
: for my $p (@L) {
239 # my($path) = $p =~ m{/([^/\-]+(?:[\d\.]{4,}|blead)(-(?:\d+-g[[:xdigit:]]+|RC\d+))?)/};
240 my $aXX = substr($p,47+length($perlhomepath));
241 my($path,$sha) = $aXX =~ m
|([^/]+)/([^/]+)/|;
242 my $vpath = $path; # version-relevant-path
243 $vpath =~ s/-g[[:xdigit:]]{7,10}//; # recently git started to use 10 digits instead of 7
245 my $vcmp = versioncmp
($vpath,$Opt{minperl
});
246 #warn "vcmp[$vcmp]vpath[$vpath]minperl[$Opt{minperl}]\n";
247 next PERL
if $vcmp<0;
250 my $vcmp = versioncmp
($vpath,$Opt{maxperl
});
251 #warn "vcmp[$vcmp]vpath[$vpath]maxperl[$Opt{maxperl}]\n";
252 next PERL
if $vcmp>0;
255 my $program = <<'EOP';
260 warn "Inner perl saw signal '$sig', will stop asap";
263 my $testperl = shift;
272 #$v = eval {$m->VERSION();};
274 eval "require Module::Info";
278 $v=eval "Module::Info->new_from_module(q{$m})->version";
279 $v = "_n/a_" unless defined $v;
281 } elsif (defined $m) {
282 local($SIG{__WARN__}) = sub {}; # silence List::Gen
283 $v = eval {$m->VERSION();};
284 if (!defined($v) or !length($v) or $@) {
285 $v = eval "\$$m\::VERSION";
287 $v = '_n\a_' unless length $v;
292 push @v, $verbose ? ("X$m" => $v) : $v
295 warn "Exiting due signal" ;
301 if (length $path > 21){
303 s{^/home/sand/src/perl/repoperls/installed-perls/<PERLHOMEPATH>/}{};
307 if (length $path > 21){
312 #no warnings "uninitialized";
313 my @showconfigvalues = map {
314 if (my($name,$qr)=/(.+?)~(.+)/) {
315 my $cqr = eval "qr{$qr}";
316 $Config{$name} =~ $qr ? 1 : 0;
317 } elsif (!defined($Config{$_})) {
320 "define" eq $Config{$_} ? "D" : $Config{$_}
322 } qw(<SHOWCONFIGVALUES>);
323 printf "%-28s %s%-8s<SPRINTFSHOWCONFIG> %s\n", $path, $testperl?
"*":" ", $Config{version
}, @showconfigvalues, join(" ",map {sprintf "<SPRINTFWIDTH>", $_} @v);
325 $program =~ s/<SPRINTFSHOWCONFIG>/$sprintfshowconfig/g;
326 $program =~ s/<SHOWCONFIGVALUES>/$showconfigvalues/;
327 $program =~ s/<SPRINTFWIDTH>/%-$Opt{sprintfwidth}s/;
328 $program =~ s/<PERLHOMEPATH>/$perlhomepath/g;
330 last PERL
if $SIGNAL;
331 my @system = ($p, '-e', $program, $testperl{$p}, $Opt{verbose
}, "$path/$sha", @modules);
332 # some day try with IPC::System::Simple for better signal handling?
333 my $ret = system @system;
334 $SIGNAL++ if $ret>>8 == 42;
335 last PERL
if $SIGNAL;
337 last PERL
if $SIGNAL;