f8ac9bf42894827bad56d117a092eb134c3a60de
[spider.git] / 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 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 Carp;
32 use DB_File;
33
34 use 5.10.1;
35
36 my $ufn;
37 my $fn = "users";
38
39 my $json = JSON->new()->canonical(1);
40 my $ofn = localdata("$fn.v4");
41 my $convert;
42
43 eval {
44         require Storable;
45 };
46
47 if ($@) {
48         if ( ! -e localdata("$fn.v3") && -e localdata("$fn.v2") ) {
49                 $convert = 2;
50         }
51         LogDbg('',"the module Storable appears to be missing!!");
52         LogDbg('',"trying to continue in compatibility mode (this may fail)");
53         LogDbg('',"please install Storable from CPAN as soon as possible");
54 }
55 else {
56         import Storable qw(nfreeze thaw);
57         $convert = 3 if -e localdata("users.v3") && !-e $ufn;
58 }
59
60 die "need to have a $fn.v2 or (preferably) a $fn.v3 file in /spider/data or /spider/local_data\n" unless $convert;
61
62 if (-e $ofn || -e "$ofn.n") {
63         my $nfn = localdata("$fn.v4.json");
64         say "You appear to have (or are using) $ofn, creating $nfn instead";
65         $ofn = $nfn;
66 } else {
67    say "using $ofn for output";
68 }
69
70
71 # do a conversion if required
72 if ($convert) {
73         my ($key, $val, $action, $count, $err) = ('','',0,0,0);
74         my $ta = [gettimeofday];
75         my $ofh = IO::File->new(">$ofn") or die "cannot open $ofn ($!)\n";
76                 
77         my %oldu;
78         LogDbg('',"Converting the User File from V$convert to $fn.v4 ");
79         LogDbg('',"This will take a while, maybe as much as 10 secs");
80         my $odbm = 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?]";
81         for ($action = R_FIRST; !$odbm->seq($key, $val, $action); $action = R_NEXT) {
82                 my $ref;
83                 if ($convert == 3) {
84                         eval { $ref = storable_decode($val) };
85                 }
86                 else {
87                         eval { $ref = asc_decode($val) };
88                 }
89                 unless ($@) {
90                         if ($ref) {
91                                 unbless $ref;
92                                 $ofh->print($json->encode($ref) . "\n");
93                                 $count++;
94                         }
95                         else {
96                                 $err++
97                         }
98                 }
99                 else {
100                         Log('err', "DXUser: error decoding $@");
101                 }
102         } 
103         undef $odbm;
104         untie %oldu;
105         my $t = _diffms($ta);
106         LogDbg('',"Conversion from users.v$convert to $ofn completed $count records $err errors $t mS");
107         $ofh->close;
108 }
109
110 exit 0;
111
112 sub asc_decode
113 {
114         my $s = shift;
115         my $ref;
116         $s =~ s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg;
117         eval '$ref = ' . $s;
118         if ($@) {
119                 LogDbg('err', "DXUser::asc_decode: on '$s' $@");
120                 $ref = undef;
121         }
122         return $ref;
123 }
124
125 sub storable_decode
126 {
127         my $ref;
128         $ref = thaw(shift);
129         return $ref;
130 }
131
132 sub LogDbg
133 {
134         my (undef, $s) = @_;
135         say $s;
136 }
137
138 sub Log
139 {
140         say shift;
141 }