bin/apply-snapshotflattener.pl

   1 #!/usr/bin/perl
   2
   3 # use 5.010;
   4 use strict;
   5 use warnings;
   6
   7 =head1 NAME
   8
   9
  10
  11 =head1 SYNOPSIS
  12
  13
  14
  15 =head1 OPTIONS
  16
  17 =over 8
  18
  19 =cut
  20
  21 my @opt = <<'=back' =~ /B<--(\S+)>/g;
  22
  23 =item B<--help|h!>
  24
  25 This help
  26
  27 =item B<--maxiter|m=i>
  28
  29 Number of iterations, defaults to 1.
  30
  31 =item B<--megalog=s>
  32
  33 Megalogfile. Defaults to some historical file.
  34
  35 =back
  36
  37 =head1 DESCRIPTION
  38
  39
  40
  41 =cut
  42
  43
  44 use FindBin;
  45 use lib "$FindBin::Bin/../lib";
  46 BEGIN {
  47     push @INC, qw(       );
  48 }
  49
  50 use Dumpvalue;
  51 use File::Basename qw(dirname);
  52 use File::Path qw(mkpath);
  53 use File::Spec;
  54 use File::Temp;
  55 use Getopt::Long;
  56 use Pod::Usage;
  57 use Hash::Util qw(lock_keys);
  58
  59 our %Opt;
  60 lock_keys %Opt, map { /([^=|!]+)/ } @opt;
  61 GetOptions(\%Opt,
  62            @opt,
  63           ) or pod2usage(1);
  64 if ($Opt{help}) {
  65     pod2usage(0);
  66 }
  67 $Opt{megalog} //= "/home/sand/megalog/megalog-2018-10-05T23:09:31.log";
  68
  69 use YAML;
  70
  71 my $maxloops = $Opt{maxiter} //= 1;
  72 my $i = 0;
  73 while (++$i <= $maxloops) {
  74     my $yaml = qx{$^X bin/snapshotflattener.pl --sfr $Opt{megalog}} or last;
  75     my $y = YAML::Load $yaml;
  76     die "Human help required for yaml[\n$yaml\n]\n" if $y->{line} == 0;
  77     my $snap = "lib/Bundle/Snapshot_2011_10_21_$y->{bfile}.pm";
  78     rename $snap, "$snap~" or die "Could not rename $snap: $!";
  79     open my $fh, "$snap~" or die "Could not open $snap~: $!";
  80     open my $fh2, ">", $snap or die "Could not open >$snap: $!";
  81     warn "About to process $y->{name} on $snap\n";
  82     while (<$fh>) {
  83         my($m) = /^(\S*)/;
  84         if ($m eq $y->{name}) {
  85             warn "$y->{name} found\n";
  86             for my $dep (@{$y->{deps}}) {
  87                 print $fh2 "$dep\n";
  88             }
  89             warn sprintf "%d lines injected near bline %s\n", scalar @{$y->{deps}}, $y->{line};
  90         }
  91         print $fh2 $_;
  92     }
  93     close $fh2 or die "Could not close $snap: $!";
  94     system q<perl -i~ -nle ' use strict; our(%IN,%S); BEGIN { $IN{contents}=0; } if (/^=head1 CONTENTS/){   $IN{contents}=1;   print; next; } if (/^=/){   $IN{contents}=0; } if ($IN{contents}){   /^([A-Za-z]\S*)/ and $S{$1}++ and next; } print; ' lib/Bundle/Snapshot_2011_10_21_0?.pm>;
  95 }
  96
  97 # Local Variables:
  98 # mode: cperl
  99 # cperl-indent-level: 4
 100 # End: