bin/migrate-sqlite-distcontext-numeric-greenish.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<--db=s>
  24
  25 DSN. Defaults to C<dbi:SQLite:dbname=$workdir/quickaccess.db> where
  26 $workdir comes from the configuration.
  27
  28 =item B<--help|h!>
  29
  30 This help
  31
  32 =back
  33
  34 =head1 DESCRIPTION
  35
  36 Just the quickaccess db and there the table distcontext: migrate from
  37 sqlite to sqlite. We did this only to get a bug in the schema fixed.
  38 The migration to postgres was not yet on the agenda, on the horizon
  39 yes, but not on agenda.
  40
  41 The original table had greenish as a text field, we now make it an
  42 integer field. This cannot be achieved with their "alter table"
  43 support, so we must do it in a script.
  44
  45 Before we started the scrpt, we had this histogram:
  46
  47   sqlite> SELECT greenish, count(*) FROM distcontext group by greenish ;
  48   |3432
  49   -1|36
  50   0|3617
  51   1|14134
  52   2|21649
  53   3|6689
  54
  55 We would expect that we have 7049 records with 0 afterwards and all
  56 others equal.
  57
  58 On the first run on Nov 20th I was interrupting and delaying this to a
  59 later time because it was too slow for the middle of the night. Today
  60 I added a remaining seconds indicator and after a few minutes it
  61 reaches a stable 10800 seconds, so I'll do the finishing at about
  62 11:00 which looks good.
  63
  64 =cut
  65
  66
  67 use FindBin;
  68 use lib "$FindBin::Bin/../lib";
  69 BEGIN {
  70     push @INC, qw(       );
  71 }
  72
  73 use Dumpvalue;
  74 use File::Basename qw(dirname);
  75 use File::Path qw(mkpath);
  76 use File::Spec;
  77 use File::Temp;
  78 use Getopt::Long;
  79 use Pod::Usage;
  80 use Hash::Util qw(lock_keys);
  81
  82 our %Opt;
  83 lock_keys %Opt, map { /([^=|!]+)/ } @opt;
  84 GetOptions(\%Opt,
  85            @opt,
  86           ) or pod2usage(1);
  87 if ($Opt{help}) {
  88     pod2usage(0);
  89 }
  90
  91 our $SIGNAL = 0;
  92 $SIG{INT} = $SIG{TERM} = sub { my $sig = shift; warn "Caught $sig\n"; $SIGNAL=1 };
  93
  94 use DBI;
  95 use Time::HiRes qw(sleep time);
  96 use FindBin;
  97 use lib "$FindBin::Bin/../CPAN-Blame/lib";
  98 use CPAN::Blame::Config::Cnntp;
  99 my($workdir,$cpan_home,$ext_src);
 100 BEGIN {
 101     $workdir = File::Spec->catdir
 102         ($CPAN::Blame::Config::Cnntp::Config->{solver_vardir},
 103          "workdir");
 104     $cpan_home = $CPAN::Blame::Config::Cnntp::Config->{cpan_home};
 105     $ext_src = $CPAN::Blame::Config::Cnntp::Config->{ext_src};
 106 }
 107
 108 $Opt{db}  ||= "dbi:SQLite:dbname=$workdir/quickaccess.db";
 109
 110 sub my_do_query {
 111     my($dbi,$sql,@args) = @_;
 112     my $success = $dbi->do($sql,undef,@args);
 113     unless ($success) {
 114         my $err = $dbi->errstr;
 115         warn sprintf
 116             (
 117              "Warning: error occurred while executing sql[%s]with args[%s]: %s",
 118              $sql,
 119              join(":",map { defined $_ ? "'$_'" : "<undef>"} @args),
 120              $err,
 121             );
 122     }
 123     return $success;
 124 }
 125
 126 my $sldbi = DBI->connect ($Opt{db}); # return a dbi handle
 127 my $slsth0 = $sldbi->prepare("SELECT count(*) from distcontext");
 128 $slsth0->execute();
 129 my($slcnt) = $slsth0->fetchrow_array();
 130
 131 my $slsth = $sldbi->prepare("SELECT distv,yaml,greenish,dist from distcontext order by distv");
 132 $slsth->execute();
 133 my $sql = "CREATE TABLE IF NOT EXISTS ngdistcontext (
 134 distv text primary key,
 135 yaml text,
 136 greenish integer,
 137 dist text)";
 138 my_do_query($sldbi, $sql);
 139 my $slsth2 = $sldbi->prepare("INSERT INTO ngdistcontext
 140  (distv,yaml,greenish,dist) values
 141  (?,     ?,     ?,       ?)");
 142
 143 my $i = 0;
 144 my $lastreport = my $starttime = time;
 145 $|=1;
 146 print "\n";
 147 ROW: while (my(@row) = $slsth->fetchrow_array) {
 148     $row[2] ||= 0;
 149     unless ($slsth2->execute(@row)) {
 150         warn sprintf "ALERT: error inserting row/id[%s]: %s\n", $row[0], $sldbi->errstr;
 151         last ROW;
 152     }
 153     ++$i;
 154     my $eta = int((time - $^T)*($slcnt - $i)/$i);
 155     printf "\r%d/%d  remaining seconds: %d    ", $i, $slcnt, $eta;
 156     last ROW if $SIGNAL;
 157 }
 158 print "\n";
 159 my $tooktime = time - $starttime;
 160 warn "records transferred[$i] tooktime[$tooktime]\n";
 161
 162 # Local Variables:
 163 # mode: cperl
 164 # cperl-indent-level: 4
 165 # End: