13 bin/snapshotflattener.pl ~sand/megalog/megalog-9999-99-99T99:99:99.log
15 bin/snapshotflattener.pl ~sand/megalog/megalog-9999-99-99T99:99:99.
23 my @opt = <<'=back' =~ /B<--(\S+)>/g;
31 No default. If given, we reduce the number of changes to this value by
32 deleting random candidates.
38 We rank all modules that trigger a "required" line, that is all
39 modules that are not yet installed when they are suddenly needed as a
40 dependency. This ranking is called RANKIN. We rank these modules again
41 according to the relative lines they occupy in the Bundle/Snapshot
42 files. We call this ranking RANKOUT. For the record: we rank them by
43 module name, not by line number.
45 Finally we calculate the maximum diff between RANKIN and RANKOUT. If
46 the diff is e.g. 700, we can say: we should move this module past 700
47 *ranked* modules. In reality this may mean a movement of thousands of
52 Iff all modules were in perfect linear order to satisfy all
53 dependencies, we could easily read the time it takes to build one
54 module. *And* we could easily rebalance the 5 snapshotfiles when one
55 of them goes over the well established max of 10 hours.
57 I came to this when trying to run C<megalog-overview.pl --debug=reps>
58 which tunred out to be buggy.
64 use lib
"$FindBin::Bin/../lib";
70 use File
::Basename
qw(dirname);
71 use File
::Path
qw(mkpath);
76 use Hash
::Util
qw(lock_keys);
79 lock_keys
%Opt, map { /([^=|!]+)/ } @opt;
88 my $megalog = shift or pod2usage
(1);
89 $megalog =~ s/\.$/.log/;
90 my @snaps = glob("lib/Bundle/Snapshot_2011_10_21_0?.pm");
92 our(%INSTATE,%CANDIDATES,@SHIFTLINES,%RANKIN,%RANKOUT);
94 open my $fh, $megalog or die;
96 next unless /\s(\S+)\s+\[\S*requires\]/;
99 $RANKIN{$1} = scalar keys %RANKIN;
102 while (keys %CANDIDATES > $Opt{max
}){
103 my @c = keys %CANDIDATES;
104 my $r = $c[rand $#c];
105 delete $CANDIDATES{$r};
109 for my $snap (@snaps) {
110 rename $snap, "$snap~" or die "Could not rename $snap: $!";
111 open my $fh, "$snap~" or die "Could not open $snap: $!";
112 open my $fh2, ">", $snap or die "Could not open $snap: $!";
118 if (/^=head1 CONTENTS/){
119 $INSTATE{contents
}=1;
123 $INSTATE{contents
}=0;
124 if (/^=head1 CONFIGU/){
125 print ((shift @SHIFTLINES)->[0]) while @SHIFTLINES;
129 if ($INSTATE{contents
}){
130 if (/^([A-Za-z]\S*)/){
131 if ($CANDIDATES{$1}){
132 $RANKOUT{$1} = undef;
133 $RANKOUT{$1} = scalar keys %RANKOUT;
134 unshift @SHIFTLINES, [$_, $1];
136 push @SHIFTLINES, [$_, $1];
138 if (@SHIFTLINES > 1){
139 my $line = (shift @SHIFTLINES)->[0];
145 $SHIFTLINES[-1][0] .= "\n" unless $SHIFTLINES[-1][0] =~ /\n/;
147 push @SHIFTLINES, [""];
155 my $max = { diff
=> -99999 };
157 for my $k (keys %CANDIDATES) {
158 next unless $RANKOUT{$k} && $RANKIN{$k};
159 my $diff = $RANKOUT{$k} - $RANKIN{$k};
160 if ($diff > $max->{diff
}) {
161 $max->{diff
} = $diff;
162 $max->{in} = $RANKIN{$k};
163 $max->{out
} = $RANKOUT{$k};
165 next if $max->{diff
} < 0;
166 warn "Note: so far largest distance with $max->{k}: $max->{out} - $max->{in} = $max->{diff}\n";
170 warn sprintf "Maybe try:
171 egrep -n '^(%s)(\$| )' lib/Bundle/Snapshot_2011_10_21_0*.pm
172 ", join("|", @reported);
173 warn sprintf "And/Or:
174 egrep -an ' (%s) *\\[.*requi|^perl\\|' %s
175 ", join("|", @reported), $megalog;
179 # cperl-indent-level: 4