perl/convert-users-v3-to-v4.pl

   1 #!/usr/bin/env perl
   2 #
   3 # Convert users.v2 or .v3 to JSON .v4 format
   4 #
   5 # It is believed that this can be run at any time...
   6 #
   7 # Copyright (c) 2020 Dirk Koopman G1TLH
   8 #
   9 #
  10 #
  11
  12 # make sure that modules are searched in the order local then perl
  13
  14 our $root;
  15
  16 BEGIN {
  17         # root of directory tree for this system
  18         $root = "/spider";
  19         $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
  20     unshift @INC, "$root/perl";     # this IS the right way round!
  21         unshift @INC, "$root/local";
  22 }
  23
  24 use strict;
  25
  26 use DXVars;
  27 use DXUser;
  28 use JSON;
  29 use Data::Structure::Util qw(unbless);
  30 use Time::HiRes qw(gettimeofday tv_interval);
  31 use IO::File;
  32 use File::Copy;
  33 use Carp;
  34 use DB_File;
  35
  36 use 5.10.1;
  37
  38 my $ufn;
  39 my $fn = "users";
  40
  41 my $json = JSON->new()->canonical(1);
  42 my $ofn = localdata("$fn.v4");
  43 my $convert;
  44
  45 eval {
  46         require Storable;
  47 };
  48
  49 if ($@) {
  50         if ( ! -e localdata("$fn.v3") && -e localdata("$fn.v2") ) {
  51                 $convert = 2;
  52         }
  53         LogDbg('',"the module Storable appears to be missing!!");
  54         LogDbg('',"trying to continue in compatibility mode (this may fail)");
  55         LogDbg('',"please install Storable from CPAN as soon as possible");
  56 }
  57 else {
  58         import Storable qw(nfreeze thaw);
  59         $convert = 3 if -e localdata("users.v3") && !-e $ufn;
  60 }
  61
  62 die "need to have a $fn.v2 or (preferably) a $fn.v3 file in /spider/data or /spider/local_data\n" unless $convert;
  63
  64 if (-e $ofn || -e "$ofn.n") {
  65         my $nfn = localdata("$fn.v4.json");
  66         say "You appear to have (or are using) $ofn, creating $nfn instead";
  67         $ofn = $nfn;
  68 } else {
  69         $ofn = "$ofn.n";
  70         say "using $ofn.n for output";
  71 }
  72
  73
  74 # do a conversion if required
  75 if ($convert) {
  76         my ($key, $val, $action, $count, $err) = ('','',0,0,0);
  77         my $ta = [gettimeofday];
  78         my $ofh = IO::File->new(">$ofn") or die "cannot open $ofn ($!)\n";
  79         my $oldfn = localdata("users.v$convert");
  80
  81         my %oldu;
  82         LogDbg('',"Converting the User File from V$convert to $fn.v4 ");
  83         LogDbg('',"This will take a while, maybe as much as 10 secs");
  84         my $odbm = tie (%oldu, 'DB_File', $oldfn, O_RDONLY, 0666, $DB_BTREE) or confess "can't open user file: $oldfn ($!) [rebuild it from user_asc?]";
  85         for ($action = R_FIRST; !$odbm->seq($key, $val, $action); $action = R_NEXT) {
  86                 my $ref;
  87                 if ($convert == 3) {
  88                         eval { $ref = storable_decode($val) };
  89                 }
  90                 else {
  91                         eval { $ref = asc_decode($val) };
  92                 }
  93                 unless ($@) {
  94                         if ($ref) {
  95                                 unbless $ref;
  96                                 $ofh->print("$ref->{call}\t" . $json->encode($ref) . "\n");
  97                                 $count++;
  98                         }
  99                         else {
 100                                 $err++
 101                         }
 102                 }
 103                 else {
 104                         Log('err', "DXUser: error decoding $@");
 105                 }
 106         }
 107         undef $odbm;
 108         untie %oldu;
 109         my $t = _diffms($ta);
 110         LogDbg('',"Conversion from $oldfn to $ofn completed $count records $err errors $t mS");
 111         $ofh->close;
 112 }
 113
 114 exit 0;
 115
 116 sub asc_decode
 117 {
 118         my $s = shift;
 119         my $ref;
 120         $s =~ s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg;
 121         eval '$ref = ' . $s;
 122         if ($@) {
 123                 LogDbg('err', "DXUser::asc_decode: on '$s' $@");
 124                 $ref = undef;
 125         }
 126         return $ref;
 127 }
 128
 129 sub storable_decode
 130 {
 131         my $ref;
 132         $ref = thaw(shift);
 133         return $ref;
 134 }
 135
 136 sub LogDbg
 137 {
 138         my (undef, $s) = @_;
 139         say $s;
 140 }
 141
 142 sub Log
 143 {
 144         say shift;
 145 }
 146
 147 # find the correct local_data directory
 148 # basically, if there is a local_data directory with this filename and it is younger than the
 149 # equivalent one in the (system) data directory then return that name rather than the system one
 150 sub localdata
 151 {
 152         my $ifn = shift;
 153         my $ofn = "$root/local_data/$ifn";
 154         my $tfn;
 155
 156         if (-e "$root/local_data") {
 157                 $tfn = "$main::data/$ifn";
 158                 if ((-e $tfn) && (-e $ofn)) {
 159                         $ofn = $tfn if -M $ofn < -M $tfn;
 160                 }
 161                 else {
 162                         $ofn = $tfn if -e $tfn;
 163                 }
 164         }
 165
 166         return $ofn;
 167 }
 168 # measure the time taken for something to happen; use Time::HiRes qw(gettimeofday tv_interval);
 169 sub _diffms
 170 {
 171     my $ta = shift;
 172     my $tb = shift || [gettimeofday];
 173     my $a = int($ta->[0] * 1000) + int($ta->[1] / 1000);
 174     my $b = int($tb->[0] * 1000) + int($tb->[1] / 1000);
 175     return $b - $a;
 176 }
 177