bin/cleanup-quickaccess.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<--skipquestions!>
  28
  29 Only does the conversions that work without doubt.
  30
  31 =back
  32
  33 =head1 DESCRIPTION
  34
  35 We have plenty of records in quickaccess/distcontext that have
  36 greenish=3 although they are not greenish anymore because there is a
  37 newer release.
  38
  39 Found a version C<.53b>.
  40
  41 Found a distro that contained UTF-8 in the name:
  42
  43   0000000 64 69 73 74 76 5b e2 80 8b 51 75 64 6f 2d e2 80  >distv[�..Qudo-�.<
  44   0000020 8b 30 2e 30 31 5f 30 32 2d 5d 20 3d 3e 0a 20 64  >.0.01_02-] =>. d<
  45
  46 That's ZERO WIDTH SPACE, of course.
  47
  48 Found Spreadsheet::WriteExcel::WebPivot in
  49 NATHANL/Spreadsheet-WriteExcel-WebPivot2.tar.gz which is
  50 misinterpreted by all of metacpan and search and matrix as an early
  51 version of Spreadsheet::WriteExcel. Since the module is released 2005
  52 it's probably a good idea to keep this as the others did and let
  53 history mull over it forever:(
  54
  55 Found C<makepp-1.50-cvs-070506>.
  56
  57 Found C<MegaDistro-0.02-5>, C<Konstrukt-0.5-beta6>, C<pfacter-1.13-1>,
  58 C<Data-Dump-Streamer-2.05-36>, C<Data-Path-1.3.fix_missing_build_require>
  59
  60 =cut
  61
  62
  63 use FindBin;
  64 use lib "$FindBin::Bin/../lib";
  65 BEGIN {
  66     push @INC, qw(       );
  67 }
  68
  69 use Dumpvalue;
  70 use File::Basename qw(dirname);
  71 use File::Path qw(mkpath);
  72 use File::Spec;
  73 use File::Temp;
  74 use Getopt::Long;
  75 use Pod::Usage;
  76 use Hash::Util qw(lock_keys);
  77 use YAML::Syck;
  78
  79 our %Opt;
  80 lock_keys %Opt, map { /([^=|!]+)/ } @opt;
  81 GetOptions(\%Opt,
  82            @opt,
  83           ) or pod2usage(1);
  84 if ($Opt{help}) {
  85     pod2usage(0);
  86 }
  87
  88 our $SIGNAL = 0;
  89 $SIG{INT} = $SIG{TERM} = sub { my $sig = shift; warn "Caught $sig\n"; $SIGNAL=1 };
  90
  91 use DBI;
  92 use Time::HiRes qw(sleep time);
  93 use CPAN::Blame::Config::Cnntp;
  94 my($workdir,$cpan_home,$ext_src);
  95 BEGIN {
  96     $workdir = File::Spec->catdir
  97         ($CPAN::Blame::Config::Cnntp::Config->{solver_vardir},
  98          "workdir");
  99     $cpan_home = $CPAN::Blame::Config::Cnntp::Config->{cpan_home};
 100     $ext_src = $CPAN::Blame::Config::Cnntp::Config->{ext_src};
 101 }
 102 my $sldbi = DBI->connect ("dbi:SQLite:dbname=$workdir/quickaccess.db"); # return a dbi handle
 103
 104 my $slsth = $sldbi->prepare("SELECT count(distv) from distcontext where dist is null");
 105 $slsth->execute();
 106 my($slcnt) = $slsth->fetchrow_array();
 107 warn "records without dist: $slcnt\n";
 108
 109 my $selsth = $sldbi->prepare("SELECT distv,yaml from distcontext where dist is null");
 110 my $updsth = $sldbi->prepare("UPDATE distcontext set dist=? where distv=?");
 111 $selsth->execute();
 112 $|=1;
 113 my $dumper = Dumpvalue->new(unctrl => "unctrl", quoteHighBit => 1);
 114 REC: while (my($distv,$yaml) = $selsth->fetchrow_array) {
 115     my $y = YAML::Syck::Load $yaml;
 116     die "distv[$distv] has no dist???" unless $y->{dist};
 117     my $ans;
 118     my $quest = "distv[$distv] =>\n dist[$y->{dist}] (Y/n/q) ?";
 119     my $qquest = $dumper->stringify($quest);
 120     print $qquest;
 121     if (substr($distv,0,length($y->{dist})) eq $y->{dist}
 122         and substr($distv,length($y->{dist})) =~ /^-[Vv]?\d+[\d\._]*$/
 123         and substr($distv,-1) =~ /[0-9]/
 124        ) {
 125         $ans = "y";
 126         print "\n";
 127         sleep 0.01;
 128     } else {
 129         if ($Opt{skipquestions}) {
 130             next REC;
 131         }
 132         $ans = <>;
 133     }
 134     $ans = "y" if $ans =~ /^\s*$/;
 135     if ($ans =~ /^y/i) {
 136         $updsth->execute($y->{dist}, $distv) or die "Could not update";
 137     } elsif ($ans =~ /^q/i) {
 138         last;
 139     } else {
 140         warn "Skipping\n";
 141     }
 142     last REC if $SIGNAL;
 143 }
 144
 145 # Local Variables:
 146 # mode: cperl
 147 # cperl-indent-level: 4
 148 # End: