new ticket from slaven
[andk-cpan-tools.git] / bin / migrate-distlookup-sqlite-postgres.pl
blobfd0dfeb1772d2f01582949027029eb917ad621e8
1 #!/usr/bin/perl
3 # use 5.010;
4 use strict;
5 use warnings;
7 =head1 NAME
11 =head1 SYNOPSIS
15 =head1 OPTIONS
17 =over 8
19 =cut
21 my @opt = <<'=back' =~ /B<--(\S+)>/g;
23 =item B<--help|h!>
25 This help
27 =item B<--max=i>
29 Defaults to 0, which stands for unlimited. Otherwise the number of
30 records to transfer.
32 =back
34 =head1 DESCRIPTION
36 Written AFTER quickaccess/distcontext. This time only for the
37 memoize/distlookup table.
39 As we have said before: Just the quickaccess db from sqlite to
40 postgres. Designed to be USED ONLY ONCE. It drops the table before
41 starting work, so if you run it twice, it's OK, but should only be
42 done if the first round was broke or so.
44 Performance? For 64888 records it took 608 seconds.
46 =cut
49 use FindBin;
50 use lib "$FindBin::Bin/../lib";
51 BEGIN {
52 push @INC, qw( );
55 use Dumpvalue;
56 use File::Basename qw(dirname);
57 use File::Path qw(mkpath);
58 use File::Spec;
59 use File::Temp;
60 use Getopt::Long;
61 use Pod::Usage;
62 use Hash::Util qw(lock_keys);
64 our %Opt;
65 lock_keys %Opt, map { /([^=|!]+)/ } @opt;
66 GetOptions(\%Opt,
67 @opt,
68 ) or pod2usage(1);
69 if ($Opt{help}) {
70 pod2usage(0);
73 our $SIGNAL = 0;
74 $SIG{INT} = $SIG{TERM} = sub { my $sig = shift; warn "Caught $sig\n"; $SIGNAL=1 };
76 use DBI;
77 use Time::HiRes qw(sleep time);
78 use FindBin;
79 use lib "$FindBin::Bin/../CPAN-Blame/lib";
80 use CPAN::Blame::Config::Cnntp;
81 my($workdir,$cpan_home,$ext_src);
82 BEGIN {
83 $workdir = File::Spec->catdir
84 ($CPAN::Blame::Config::Cnntp::Config->{solver_vardir},
85 "workdir");
86 $cpan_home = $CPAN::Blame::Config::Cnntp::Config->{cpan_home};
87 $ext_src = $CPAN::Blame::Config::Cnntp::Config->{ext_src};
90 my $dsn = "dbi:SQLite:dbname=$workdir/memoize.db"; # no option any more
92 sub my_do_query {
93 my($dbi,$sql,@args) = @_;
94 my $success = $dbi->do($sql,undef,@args);
95 unless ($success) {
96 my $err = $dbi->errstr;
97 warn sprintf
99 "Warning: error occurred while executing sql[%s]with args[%s]: %s",
100 $sql,
101 join(":",map { defined $_ ? "'$_'" : "<undef>"} @args),
102 $err,
105 return $success;
108 my $sldbi = DBI->connect ($dsn); # return a dbi handle
109 my $slsth0 = $sldbi->prepare("SELECT count(*) from distlookup");
110 $slsth0->execute();
111 my($slcnt) = $slsth0->fetchrow_array();
112 warn "Found $slcnt records in the sqlite table";
113 my $slsql = "SELECT distv,author,upload_date,distroid from distlookup order by distv";
114 if ($Opt{max}) {
115 $slsql .= " limit $Opt{max}";
116 $slcnt = $Opt{max};
118 my $slsth = $sldbi->prepare($slsql);
119 $slsth->execute();
121 my $pgdbi = DBI->connect ("dbi:Pg:dbname=analysis");
122 my $pgsql = "DROP TABLE distlookup";
123 my_do_query($pgdbi, $pgsql);
124 $pgsql = "CREATE TABLE distlookup (
125 distv text primary key,
126 author text,
127 upload_date text,
128 distroid text)";
129 my_do_query($pgdbi, $pgsql);
130 my $pgsth2 = $pgdbi->prepare("INSERT INTO distlookup
131 (distv,author,upload_date,distroid) values
132 (?, ?, ?, ?)");
134 my $i = 0;
135 my $lastreport = my $starttime = time;
136 $|=1;
137 print "\n";
138 ROW: while (my(@row) = $slsth->fetchrow_array) {
139 $row[2] ||= 0;
140 unless ($pgsth2->execute(@row)) {
141 warn sprintf "ALERT: error inserting row/id[%s]: %s\n", $row[0], $sldbi->errstr;
142 last ROW;
144 ++$i;
145 my $eta = int((time - $^T)*($slcnt - $i)/$i);
146 printf "\r%d/%d remaining seconds: %d ", $i, $slcnt, $eta;
147 last ROW if $SIGNAL;
149 print "\n";
150 my $tooktime = time - $starttime;
151 warn "records transferred[$i] tooktime[$tooktime]\n";
153 # Local Variables:
154 # mode: cperl
155 # cperl-indent-level: 4
156 # End: