bin/annotations-in-db.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 =back
  28
  29 =head1 DESCRIPTION
  30
  31 We are losing annotations somewhere.
  32
  33 I tried to find out whether a recalc enters the annotation like so:
  34
  35 ~/src/installed-perls/v5.16.0/4e6d/bin/perl bin/annotations-in-db.pl | awk '{print $1}' | while read d; do redis-cli zincrby analysis:jobqueue:q 1 $d; done
  36
  37 It does, indeed.
  38
  39 =cut
  40
  41
  42 use FindBin;
  43 use lib "$FindBin::Bin/../lib";
  44 BEGIN {
  45     push @INC, qw(       );
  46 }
  47
  48 use Dumpvalue;
  49 use File::Basename qw(dirname);
  50 use File::Path qw(mkpath);
  51 use File::Spec;
  52 use File::Temp;
  53 use Getopt::Long;
  54 use Pod::Usage;
  55 use Hash::Util qw(lock_keys);
  56
  57 our %Opt;
  58 lock_keys %Opt, map { /([^=|!]+)/ } @opt;
  59 GetOptions(\%Opt,
  60            @opt,
  61           ) or pod2usage(1);
  62 if ($Opt{help}) {
  63     pod2usage(0);
  64 }
  65
  66 open my $fh, "annotate.txt" or die "Could not open 'annotate.txt': $!";
  67 use Tie::IxHash;
  68 my $anno;
  69 tie %$anno, 'Tie::IxHash';
  70 ANNOLINE: while (<$fh>) {
  71     chomp;
  72     next ANNOLINE if /^\s*$/;
  73     my($dist,$splain) = split " ", $_, 2;
  74     $anno->{$dist} = $splain;
  75 }
  76 use DBI ();
  77 use YAML::Syck ();
  78 my $dbi = DBI->connect ("dbi:Pg:dbname=analysis");
  79 my $sth = $dbi->prepare("SELECT yaml FROM distcontext WHERE distv=?");
  80 ANNO: for my $distv (keys %$anno) {
  81     $sth->execute($distv);
  82     if (my($yaml) = $sth->fetchrow_array) {
  83         my $y = YAML::Syck::Load($yaml);
  84         if ($y->{annotation} && $y->{annotation} eq $anno->{$distv}) {
  85             next ANNO;
  86         } else {
  87             substr($anno->{$distv},38) = "..." if length $anno->{$distv}>41;
  88             printf "%-38s %s\n", $distv, $anno->{$distv};
  89         }
  90     } else {
  91         warn "==> not found in db: $distv\n";
  92     }
  93 }
  94
  95 # Local Variables:
  96 # mode: cperl
  97 # cperl-indent-level: 4
  98 # End: