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

   1 #!/usr/bin/env perl
   2 #
   3 # Convert users.v2 or .v3 to JSON .v3j 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 BEGIN {
  15         # root of directory tree for this system
  16         $root = "/spider";
  17         $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
  18     unshift @INC, "$root/perl";     # this IS the right way round!
  19         unshift @INC, "$root/local";
  20 }
  21
  22 use strict;
  23
  24 use SysVar;
  25 use DXUser;
  26 use DXUtil;
  27 use JSON;
  28 use Data::Structure::Util qw(unbless);
  29 use Time::HiRes qw(gettimeofday tv_interval);
  30 use IO::File;
  31 use File::Copy;
  32 use Carp;
  33 use DB_File;
  34
  35 use 5.10.1;
  36
  37 my $ufn;
  38 my $fn = "users";
  39
  40 my $json = JSON->new()->canonical(1);
  41 my $ofn = localdata("$fn.v3j");
  42 my $convert;
  43
  44 eval {
  45         require Storable;
  46 };
  47
  48 if ($@) {
  49         if ( ! -e localdata("$fn.v3") && -e localdata("$fn.v2") ) {
  50                 $convert = 2;
  51         }
  52         LogDbg('',"the module Storable appears to be missing!!");
  53         LogDbg('',"trying to continue in compatibility mode (this may fail)");
  54         LogDbg('',"please install Storable from CPAN as soon as possible");
  55 }
  56 else {
  57         import Storable qw(nfreeze thaw);
  58         $convert = 3 if -e localdata("users.v3") && !-e $ufn;
  59 }
  60
  61 die "need to have a $fn.v2 or (preferably) a $fn.v3 file in /spider/data or /spider/local_data\n" unless $convert;
  62
  63 if (-e $ofn) {
  64         my $nfn = localdata("$fn.v3j.new");
  65         say "You appear to have (or are using) $ofn, creating $nfn instead";
  66         $ofn = $nfn;
  67 } else {
  68         $ofn = $ofn;
  69         say "using $ofn for output";
  70 }
  71
  72
  73 # do a conversion if required
  74 if ($convert) {
  75         my ($key, $val, $action, $count, $err) = ('','',0,0,0);
  76         my $ta = [gettimeofday];
  77         my $ofh = IO::File->new(">$ofn") or die "cannot open $ofn ($!)\n";
  78
  79         my %oldu;
  80         my %newu;
  81
  82         LogDbg('',"Converting the User from V$convert format to $fn.v3j ");
  83         LogDbg('',"This will take a while, maybe as much as 30 secs on very slow disks and/or machines");
  84         my $idbm = tie (%oldu, 'DB_File', localdata("users.v$convert"), O_RDONLY, 0666, $DB_BTREE) or confess "can't open user file: $fn.v$convert ($!) [rebuild it from user_asc?]";
  85         my $odbm = tie (%newu, 'DB_File', $ofn, O_CREAT|O_RDWR, 0666, $DB_BTREE) or confess "can't open user file: $ofn ($!)";
  86         for ($action = R_FIRST; !$idbm->seq($key, $val, $action); $action = R_NEXT) {
  87                 my $ref;
  88                 if ($convert == 3) {
  89                         eval { $ref = storable_decode($val) };
  90                 }
  91                 else {
  92                         eval { $ref = asc_decode($val) };
  93                 }
  94                 unless ($@) {
  95                         if ($ref) {
  96                                 unbless $ref;
  97                                 $newu{$ref->{call}} = $json->encode($ref);
  98                                 $count++;
  99                         }
 100                         else {
 101                                 $err++
 102                         }
 103                 }
 104                 else {
 105                         Log('err', "DXUser: error decoding $@");
 106                 }
 107         }
 108         untie %oldu;
 109         undef $idbm;
 110         untie %newu;
 111         undef $odbm;
 112         my $t = _diffms($ta);
 113         LogDbg('',"Conversion from users.v$convert to $ofn completed $count records $err errors $t mS");
 114         $ofh->close;
 115 }
 116
 117 exit 0;
 118
 119 sub asc_decode
 120 {
 121         my $s = shift;
 122         my $ref;
 123         $s =~ s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg;
 124         eval '$ref = ' . $s;
 125         if ($@) {
 126                 LogDbg('err', "asc_decode: on '$s' $@");
 127                 $ref = undef;
 128         }
 129         return $ref;
 130 }
 131
 132 sub storable_decode
 133 {
 134         my $ref;
 135         $ref = thaw(shift);
 136         return $ref;
 137 }
 138
 139 sub LogDbg
 140 {
 141         my (undef, $s) = @_;
 142         say $s;
 143 }
 144
 145 sub Log
 146 {
 147         say shift;
 148 }