bin/analysis-welcome-annotations.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<--sleep=f>
  28
  29 Sleep that much between two annotations.
  30
  31 =item B<--showprogress!>
  32
  33 Reports progress.
  34
  35 =back
  36
  37 =head1 DESCRIPTION
  38
  39 Make sure all annotations are in the distcontext table. Intended as a
  40 cronjob that runs only 4 times per day or so.
  41
  42 =head1 HISTORY
  43
  44 2015/2016 slaven sends so many annotations and wants to see them
  45 sooner than the default.
  46
  47 =cut
  48
  49
  50 use FindBin;
  51 use lib "$FindBin::Bin/../lib";
  52 BEGIN {
  53     push @INC, qw(       );
  54 }
  55
  56 use Dumpvalue;
  57 use File::Basename qw(dirname);
  58 use File::Path qw(mkpath);
  59 use File::Spec;
  60 use File::Temp;
  61 use Getopt::Long;
  62 use Pod::Usage;
  63 use Hash::Util qw(lock_keys);
  64 use Time::HiRes qw(sleep);
  65 use YAML::XS;
  66
  67 our %Opt;
  68 lock_keys %Opt, map { /([^=|!]+)/ } @opt;
  69 GetOptions(\%Opt,
  70            @opt,
  71           ) or pod2usage(1);
  72 if ($Opt{help}) {
  73     pod2usage(0);
  74 }
  75 $Opt{sleep} //= 0.03;
  76
  77 my($workdir);
  78 use FindBin;
  79 use lib "$FindBin::Bin/../CPAN-Blame/lib";
  80 use CPAN::Blame::Config::Cnntp;
  81 BEGIN {
  82     $workdir = File::Spec->catdir
  83         ($CPAN::Blame::Config::Cnntp::Config->{solver_vardir},
  84          "workdir");
  85 }
  86 use IPC::ConcurrencyLimit;
  87
  88 my($basename) = File::Basename::basename(__FILE__);
  89 my $limit = IPC::ConcurrencyLimit->new
  90     (
  91      max_procs => 1,
  92      path      => "$workdir/IPC-ConcurrencyLimit-$basename",
  93     );
  94 my $limitid = $limit->get_lock;
  95 if (not $limitid) {
  96     warn "Another process appears to be still running. Exiting.";
  97     exit(0);
  98 }
  99
 100 sub mypgdbi () {
 101     require DBI;
 102     my $dbi = DBI->connect ("dbi:Pg:dbname=analysis");
 103 }
 104 my $sth = mypgdbi()->prepare("select yaml from distcontext where distv=?");
 105 my $sth2 = mypgdbi()->prepare("update distcontext set yaml=? where distv=? and yaml=?");
 106 setpriority(0, 0, 5); # renice
 107 my $annofile = "$FindBin::Bin/../annotate.txt";
 108 my $fh;
 109 unless (open $fh, $annofile) {
 110     # $DB::single=1;
 111     die "Could not";
 112 }
 113 local $/ = "\n";
 114 my $anno;
 115
 116 ANNOLINE: while (<$fh>) {
 117     chomp;
 118     next ANNOLINE if /^\s*$/;
 119     my($dist,$splain) = split " ", $_, 2;
 120     $anno->{$dist} = $splain;
 121 }
 122 close $fh;
 123 my $cntdown = keys %$anno;
 124 $| = 1;
 125 my $updated = 0;
 126 for my $distv (keys %$anno) {
 127     $sth->execute($distv);
 128     my($ystr) = $sth->fetchrow_array;
 129     unless ($ystr) {
 130         warn "Record n'existe: $distv\n";
 131     }
 132     if (my $y = eval { YAML::XS::Load($ystr) }) {
 133         if (!$y->{annotation} || $y->{annotation} ne $anno->{$distv}) {
 134             $y->{annotation} = $anno->{$distv};
 135             $sth2->execute(YAML::XS::Dump($y), $distv, $ystr);
 136             warn sprintf "%s: %s\n", scalar localtime, $distv;
 137             $updated++;
 138         }
 139     }
 140     --$cntdown;
 141     if ($Opt{showprogress}) {
 142         unless ($cntdown % 10) {
 143             printf "\r%8d %-60s", $cntdown, $distv;
 144         }
 145         unless ($cntdown) {
 146             print "\r";
 147             last;
 148         }
 149     }
 150     sleep $Opt{sleep};
 151 }
 152
 153 # Local Variables:
 154 # mode: cperl
 155 # cperl-indent-level: 4
 156 # End: