From c94ff1bf2cbe16ed59c5b273c7f6730fd7314cab Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Wed, 17 Aug 2016 00:46:27 +0100 Subject: [PATCH] move ganerated stuff to local_data Mega change to push all local data in $root/local_data and where there is duplication with system data (still in $root/data) then use whichever is newer. This will move stuff (permanently) like spots and other DXLog files to local_data as well as the userfile, DX QSL file and usdb stuff. --- Changes | 5 ++ cmd/bye.pl | 4 +- cmd/crontab | 2 +- cmd/export_users.pl | 2 +- perl/BadWords.pm | 6 +- perl/Bands.pm | 2 +- perl/DXDupe.pm | 3 +- perl/DXHash.pm | 9 ++- perl/DXLog.pm | 3 +- perl/DXProt.pm | 3 +- perl/DXUser.pm | 29 ++++---- perl/DXUtil.pm | 34 ++++++++- perl/DXVars.pm.issue | 17 ----- perl/ExtMsg.pm | 4 +- perl/Geomag.pm | 2 +- perl/Prefix.pm | 5 +- perl/QSL.pm | 4 +- perl/SysVar.pm | 39 +++++++++++ perl/USDB.pm | 5 +- perl/WCY.pm | 3 +- perl/cluster.pl | 15 ++-- perl/console.pl | 4 +- perl/convert_users.pl | 155 ------------------------------------------ perl/create_prefix.pl | 23 +++++-- perl/create_qsl.pl | 7 +- perl/create_sysop.pl | 15 ++-- perl/gen_usdb_data.pl | 9 ++- perl/grepdbg | 2 +- perl/hlptohtml.pl | 2 +- perl/lock_nodes.pl | 15 ++-- perl/talias.pl | 2 +- perl/update_sysop.pl | 9 +-- perl/watchdbg | 2 +- perl/winclient.pl | 2 + 34 files changed, 190 insertions(+), 253 deletions(-) create mode 100644 perl/SysVar.pm delete mode 100755 perl/convert_users.pl diff --git a/Changes b/Changes index 0b307ae2..ee9be652 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,8 @@ +16Aug16======================================================================= +1. Mega change to push all local data in $root/local_data and where there + is duplication with system data (still in $root/data) then use whichever + is newer. This will move stuff (permanently) like spots and other DXLog + files to local_data as well as the userfile, DX QSL file and usdb stuff. 25Jul16======================================================================= 1. Add some timing stats to cmd spawn_cmd. 08Jul16======================================================================= diff --git a/cmd/bye.pl b/cmd/bye.pl index 41d3ee91..513b3055 100644 --- a/cmd/bye.pl +++ b/cmd/bye.pl @@ -8,8 +8,8 @@ my $self = shift; return (1, $self->msg('e5')) if $self->inscript; # log out text -if ($self->is_user && -e "$main::data/logout") { - open(I, "$main::data/logout") or confess; +if ($self->is_user && -e localdata("logout")) { + open(I, localdata("logout")) or confess; my @in = ; close(I); $self->send_now('D', @in); diff --git a/cmd/crontab b/cmd/crontab index f971764c..4343d76b 100644 --- a/cmd/crontab +++ b/cmd/crontab @@ -5,6 +5,6 @@ # create and edit the one in /spider/local_cmd/crontab # for doing connections and things # -1 0 * * 3 DXUser::export("$main::data/user_asc") +1 0 * * 3 DXUser::export(localdata("user_asc")) 5 0 * * * DXDebug::dbgclean() 0 3 * * * Spot::daily() diff --git a/cmd/export_users.pl b/cmd/export_users.pl index a8cec7de..a7a2c6ec 100644 --- a/cmd/export_users.pl +++ b/cmd/export_users.pl @@ -4,7 +4,7 @@ # # my $self = shift; -my $line = shift || "$main::data/user_asc"; +my $line = shift || localdata("user_asc"); return (1, $self->msg('e5')) unless $self->priv >= 9; my ($fn, $flag) = split /\s+/, $line; diff --git a/perl/BadWords.pm b/perl/BadWords.pm index 05a41bcc..141b3e9a 100644 --- a/perl/BadWords.pm +++ b/perl/BadWords.pm @@ -19,9 +19,9 @@ use IO::File; use vars qw($badword $regexcode); -my $oldfn = "$main::data/badwords"; -my $regex = "$main::data/badw_regex"; -my $bwfn = "$main::data/badword"; +my $oldfn = localdata("badwords"); +my $regex = localdata("badw_regex"); +my $bwfn = localdata("badword"); # copy issue ones across filecopy("$regex.gb.issue", $regex) unless -e $regex; diff --git a/perl/Bands.pm b/perl/Bands.pm index 9f44c090..cc67dc23 100644 --- a/perl/Bands.pm +++ b/perl/Bands.pm @@ -18,7 +18,7 @@ use vars qw(%bands %regions %aliases $bandsfn %valid); %bands = (); # the 'raw' band data %regions = (); # list of regions for shortcuts eg vhf ssb %aliases = (); # list of aliases -$bandsfn = "$main::data/bands.pl"; +$bandsfn = localdata("bands.pl"); %valid = ( cw => '0,CW,parraypairs', diff --git a/perl/DXDupe.pm b/perl/DXDupe.pm index 5b288d1f..ebb2aac4 100644 --- a/perl/DXDupe.pm +++ b/perl/DXDupe.pm @@ -17,7 +17,8 @@ use vars qw{$lasttime $dbm %d $default $fn}; $default = 48*24*60*60; $lasttime = 0; -$fn = "$main::data/dupefile"; +localdata_mv("dupefile"); +$fn = localdata("dupefile"); sub init { diff --git a/perl/DXHash.pm b/perl/DXHash.pm index 1e3c833e..cf9f0521 100644 --- a/perl/DXHash.pm +++ b/perl/DXHash.pm @@ -8,7 +8,7 @@ # Things entered into the list are always upper # cased. # -# The files that are created live in /spider/data +# The files that are created live in /spider/local_data (was data) # # Dunno why I didn't do this earlier but heyho.. # @@ -28,7 +28,10 @@ use strict; sub new { my ($pkg, $name) = @_; - my $s = readfilestr($main::data, $name); + + # move existing file + localdata_mv($name); + my $s = readfilestr($main::local_data, $name); my $self = undef; $self = eval $s if $s; dbg("error in reading $name in DXHash $@") if $@; @@ -39,7 +42,7 @@ sub new sub put { my $self = shift; - writefilestr($main::data, $self->{name}, undef, $self); + writefilestr($main::local_data, $self->{name}, undef, $self); } sub add diff --git a/perl/DXLog.pm b/perl/DXLog.pm index 1113bc24..9ec12fd3 100644 --- a/perl/DXLog.pm +++ b/perl/DXLog.pm @@ -49,7 +49,8 @@ sub new { my ($prefix, $suffix, $sort) = @_; my $ref = bless {}, __PACKAGE__; - $ref->{prefix} = "$main::data/$prefix"; + localdata_mv($prefix); + $ref->{prefix} = "$main::local_data/$prefix"; $ref->{suffix} = $suffix if $suffix; $ref->{sort} = $sort; diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 7064dc7f..37e4c1dc 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -232,7 +232,8 @@ sub update_pc92_keepalive sub init { - do "$main::data/hop_table.pl" if -e "$main::data/hop_table.pl"; + my $fn = localdata("hop_table.pl"); + do $fn if -e $fn; confess $@ if $@; my $user = DXUser::get($main::mycall); diff --git a/perl/DXUser.pm b/perl/DXUser.pm index 43250746..dd31e6f6 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -16,6 +16,7 @@ use IO::File; use DXDebug; use DXUtil; use LRU; +use File::Copy; use strict; @@ -115,10 +116,8 @@ sub AUTOLOAD # sub init { - my ($pkg, $fn, $mode) = @_; + my $mode = shift; - confess "need a filename in User" if !$fn; - my $ufn; my $convert; @@ -126,10 +125,10 @@ sub init require Storable; }; -# eval "use Storable qw(nfreeze thaw)"; + my $fn = "users"; if ($@) { - $ufn = "$fn.v2"; + $ufn = localdata("users.v2"); $v3 = $convert = 0; dbg("the module Storable appears to be missing!!"); dbg("trying to continue in compatibility mode (this may fail)"); @@ -137,9 +136,9 @@ sub init } else { import Storable qw(nfreeze thaw); - $ufn = "$fn.v3"; + $ufn = localdata("users.v3"); $v3 = 1; - $convert++ if -e "$fn.v2" && !-e $ufn; + $convert++ if -e localdata("users.v2") && !-e $ufn; } if ($mode) { @@ -159,7 +158,7 @@ sub init my %oldu; dbg("Converting the User File to V3 "); dbg("This will take a while, I suggest you go and have cup of strong tea"); - my $odbm = tie (%oldu, 'DB_File', "$fn.v2", O_RDONLY, 0666, $DB_BTREE) or confess "can't open user file: $fn.v2 ($!) [rebuild it from user_asc?]"; + my $odbm = tie (%oldu, 'DB_File', localdata("users.v2"), O_RDONLY, 0666, $DB_BTREE) or confess "can't open user file: $fn.v2 ($!) [rebuild it from user_asc?]"; for ($action = R_FIRST; !$odbm->seq($key, $val, $action); $action = R_NEXT) { my $ref = asc_decode($val); if ($ref) { @@ -178,9 +177,7 @@ sub init sub del_file { - my ($pkg, $fn) = @_; - - confess "need a filename in User" if !$fn; + my $fn = localdata("users"); $fn .= $v3 ? ".v3" : ".v2"; unlink $fn; } @@ -457,7 +454,7 @@ BEGIN { # try to detect a lockfile (this isn't atomic but # should do for now - $lockfn = "$root/local/cluster.lck"; # lock file name + $lockfn = "$root/local_data/cluster.lck"; # lock file name if (-e $lockfn) { open(CLLOCK, "$lockfn") or die "Can't open Lockfile ($lockfn) $!"; my $pid = ; @@ -469,7 +466,7 @@ BEGIN { package DXUser; -use DXVars; +use SysVar; use DXUser; if (@ARGV) { @@ -477,8 +474,8 @@ if (@ARGV) { print "user filename now $userfn\n"; } -DXUser->del_file($main::userfn); -DXUser->init($main::userfn, 1); +DXUser::del_file(); +DXUser::init(); %u = (); my $count = 0; my $err = 0; @@ -494,7 +491,7 @@ while () { $err++ } } -DXUser->sync; DXUser->finish; +DXUser::sync; DXUser::finish; print "There are $count user records and $err errors\n"; }; print $fh "__DATA__\n"; diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm index 4e442140..b58a4528 100644 --- a/perl/DXUtil.pm +++ b/perl/DXUtil.pm @@ -8,11 +8,13 @@ package DXUtil; + use Date::Parse; use IO::File; use File::Copy; use Data::Dumper; + use strict; use vars qw(@month %patmap $pi $d2r $r2d @ISA @EXPORT); @@ -24,7 +26,7 @@ require Exporter; filecopy ptimelist print_all_fields cltounix unpad is_callsign is_long_callsign is_latlong is_qra is_freq is_digits is_pctext is_pcflag insertitem deleteitem - is_prefix dd is_ipaddr $pi $d2r $r2d + is_prefix dd is_ipaddr $pi $d2r $r2d localdata localdata_mv ); @@ -472,3 +474,33 @@ sub deleteitem return $n - @$list; } +# find the correct local_data directory +# basically, if there is a local_data directory with this filename and it is younger than the +# equivalent one in the (system) data directory then return that name rather than the system one +sub localdata +{ + my $ifn = shift; + my $ofn = "$main::data/$ifn"; + my $tfn; + + if (-e "$main::local_data") { + $tfn = "main::local_data/$ifn"; + if (-e $tfn && -M $tfn < -M $ofn) { + $ofn = $tfn; + } + } + + return $ofn; +} + +# move a file or a directory from data -> local_data if isn't there already +sub localdata_mv +{ + my $ifn = shift; + if (-e "$main::data/$ifn" ) { + unless (-e "$main::local_data/$ifn") { + move("$main::data/$ifn", "$main::local_data/$ifn") or die "localdata_mv: cannot move $ifn from '$main::data' -> '$main::local_data' $!\n"; + } + } +} + diff --git a/perl/DXVars.pm.issue b/perl/DXVars.pm.issue index 3f05a7b6..b4058cf0 100644 --- a/perl/DXVars.pm.issue +++ b/perl/DXVars.pm.issue @@ -64,23 +64,6 @@ $no = 'No'; # the interval between unsolicited prompts if not traffic $user_interval = 11*60; -# data files live in -$data = "$root/data"; - -# system files live in -$system = "$root/sys"; - -# command files live in -$cmd = "$root/cmd"; - -# local command files live in (and overide $cmd) -$localcmd = "$root/local_cmd"; - -# where the user data lives -$userfn = "$data/users"; - -# the "message of the day" file -$motd = "$data/motd"; # are we debugging ? @debug = qw(chan state msg cron connect); diff --git a/perl/ExtMsg.pm b/perl/ExtMsg.pm index 0188e49c..ffa16bb7 100644 --- a/perl/ExtMsg.pm +++ b/perl/ExtMsg.pm @@ -152,7 +152,7 @@ sub to_connected delete $conn->{timeout}; $conn->{csort} = $sort; &{$conn->{rproc}}($conn, "$dir$call|$sort"); - $conn->_send_file("$main::data/connected") unless $conn->{outgoing}; + $conn->_send_file(localdata("connected")) unless $conn->{outgoing}; } sub new_client { @@ -162,7 +162,7 @@ sub new_client { my $conn = $server_conn->SUPER::new_client($client); # send login prompt $conn->{state} = 'WL'; - $conn->_send_file("$main::data/issue"); + $conn->_send_file(localdata("issue")); $conn->send_raw("login: "); $conn->_dotimeout(60); $conn->{echo} = 1; diff --git a/perl/Geomag.pm b/perl/Geomag.pm index 881ab9d6..3447743f 100644 --- a/perl/Geomag.pm +++ b/perl/Geomag.pm @@ -38,7 +38,7 @@ $from = ""; # who this came from $duplth = 20; # the length of text to use in the deduping $dupage = 12*3600; # the length of time to hold spot dups -$dirprefix = "$main::data/wwv"; +$dirprefix = "$main::local_data/wwv"; $param = "$dirprefix/param"; $filterdef = bless ([ diff --git a/perl/Prefix.pm b/perl/Prefix.pm index 53424e03..fd361eba 100644 --- a/perl/Prefix.pm +++ b/perl/Prefix.pm @@ -72,7 +72,8 @@ sub load # tie the main prefix database eval {$db = tie(%pre, "DB_File", undef, O_RDWR|O_CREAT, 0664, $DB_BTREE);}; my $out = "$@($!)" if !$db || $@ ; - eval {do "$main::data/prefix_data.pl" if !$out; }; + my $fn = localdata("prefix_data.pl"); + eval {do $fn if !$out; }; $out .= $@ if $@; $lru = LRU->newbase('Prefix', $lrusize); @@ -88,7 +89,7 @@ sub store { my ($k, $l); my $fh = new IO::File; - my $fn = "$main::data/prefix_data.pl"; + my $fn = localdata("prefix_data.pl"); confess "Prefix system not started" if !$db; diff --git a/perl/QSL.pm b/perl/QSL.pm index 20d5c614..1738ed6e 100644 --- a/perl/QSL.pm +++ b/perl/QSL.pm @@ -18,10 +18,12 @@ use vars qw($qslfn $dbm); $qslfn = 'qsl'; $dbm = undef; +localdata_mv("$qslfn.v1"); + sub init { my $mode = shift; - my $ufn = "$main::root/data/$qslfn.v1"; + my $ufn = localdata("$qslfn.v1"); Prefix::load() unless Prefix::loaded(); diff --git a/perl/SysVar.pm b/perl/SysVar.pm new file mode 100644 index 00000000..92a81e4b --- /dev/null +++ b/perl/SysVar.pm @@ -0,0 +1,39 @@ +# These are a load of system variables that used to live in DXVars.pm. +# +# They have been broken out into a separate module which must be called AFTER 'use DXVars' if that is in fact called at all. +# +# It is a replacement for DXVars.pm wherever it is used just for these paths +# + +package main; +use warnings; + +## +## DXVars.pm overrides +## +# data files live in +$data = "$root/data"; + +# for local data +$local_data = "$root/local_data"; + +# system files live in (except they don't, not really) +$system = "$root/sys"; + +# command files live in +$cmd = "$root/cmd"; + +# local command files live in (and overide $cmd) +$localcmd = "$root/local_cmd"; + +# data files live in +$data = "$root/data"; + +# for local data +$local_data = "$root/local_data"; + +# where the user data lives +$userfn = "$local_data/users"; + +# the "message of the day" file +$motd = "$local_data/motd"; diff --git a/perl/USDB.pm b/perl/USDB.pm index 042e9190..478763ef 100644 --- a/perl/USDB.pm +++ b/perl/USDB.pm @@ -13,11 +13,14 @@ use DXVars; use DB_File; use File::Copy; use DXDebug; +use DXUtil; + #use Compress::Zlib; use vars qw(%db $present $dbfn); -$dbfn = "$main::data/usdb.v1"; +localdata_mv("usdb.v1"); +$dbfn = localdata("usdb.v1"); sub init { diff --git a/perl/WCY.pm b/perl/WCY.pm index f18950b6..826208e5 100644 --- a/perl/WCY.pm +++ b/perl/WCY.pm @@ -39,7 +39,7 @@ $from = ""; # who this came from $duplth = 20; # the length of text to use in the deduping $dupage = 12*3600; # the length of time to hold spot dups -$dirprefix = "$main::data/wcy"; +$dirprefix = "$main::local_data/wcy"; $param = "$dirprefix/param"; $filterdef = bless ([ @@ -55,7 +55,6 @@ $filterdef = bless ([ ['origin_zone', 'nz', 19], ], 'Filter::Cmd'); - sub init { $fp = DXLog::new('wcy', 'dat', 'm'); diff --git a/perl/cluster.pl b/perl/cluster.pl index fc530e21..86785a97 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -10,6 +10,8 @@ # # +package main; + require 5.10.1; use warnings; @@ -29,12 +31,13 @@ BEGIN { die "$root/local doesn't exist, please RTFM" unless -d "$root/local"; die "$root/local/DXVars.pm doesn't exist, please RTFM" unless -e "$root/local/DXVars.pm"; - mkdir "$root/local_cmd", 0777 unless -d "$root/local_cmd"; - + # create some directories + mkdir "$root/local_cmd", 02777 unless -d "$root/local_cmd"; + mkdir "$root/local_data", 02777 unless -d "$root/local_data"; # try to create and lock a lockfile (this isn't atomic but # should do for now - $lockfn = "$root/local/cluster.lck"; # lock file name + $lockfn = "$root/local_data/cluster.lck"; # lock file name if (-w $lockfn) { open(CLLOCK, "$lockfn") or die "Can't open Lockfile ($lockfn) $!"; my $pid = ; @@ -56,6 +59,8 @@ BEGIN { use Mojo::IOLoop; use DXVars; +use SysVar; + use Msg; use IntMsg; use Internet; @@ -148,7 +153,6 @@ our $ending; # signal that we are ending; our $broadcast_debug; # allow broadcasting of debug info down "enhanced" user connections - # send a message to call on conn and disconnect sub already_conn { @@ -439,6 +443,7 @@ sub setup_start } STDOUT->autoflush(1); + # try to load the database if (DXSql::init($dsn)) { $dbh = DXSql->new($dsn); @@ -495,7 +500,7 @@ sub setup_start # initialise User file system dbg("loading user file system ..."); - DXUser->init($userfn, 1); + DXUser::init(1); # look for the sysop and the alias user and complain if they aren't there { diff --git a/perl/console.pl b/perl/console.pl index 720d2575..854f3835 100755 --- a/perl/console.pl +++ b/perl/console.pl @@ -29,9 +29,11 @@ BEGIN { use Mojo::IOLoop; +use DXVars; +use SysVar; + use Msg; use IntMsg; -use DXVars; use DXDebug; use DXUtil; use DXDebug; diff --git a/perl/convert_users.pl b/perl/convert_users.pl deleted file mode 100755 index dbf9fb03..00000000 --- a/perl/convert_users.pl +++ /dev/null @@ -1,155 +0,0 @@ -#!/usr/bin/env perl -# -# Export the user file in a form that can be directly imported -# back with a do statement -# - -require 5.004; - -# search local then perl directories -BEGIN { - umask 002; - - # root of directory tree for this system - $root = "/spider"; - $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'}; - - unshift @INC, "$root/perl"; # this IS the right way round! - unshift @INC, "$root/local"; -} - -use DXVars; -use DB_File; -use Fcntl; -use Carp; - -$userfn = $ARGV[0] if @ARGV; -unless ($userfn) { - croak "need a filename"; -} - -DXUser->init($userfn); -unlink "$userfn.asc"; -open OUT, ">$userfn.asc" or die; - -%newu = (); -$t = scalar localtime; -print OUT "#!/usr/bin/perl -# -# The exported userfile for a DXSpider System -# -# Input file: $userfn -# Time: $t -# - -package DXUser; - -%u = ( -"; - -@all = DXUser::get_all_calls(); - -for $a (@all) { - my $ref = DXUser::get($a); - my $s = $ref->encode() if $ref; - print OUT "'$a' => q{$s},\n" if $a; - $count++; -} - -DXUser->finish(); - -print OUT "); -# -# there were $count records -#\n"; - - close(OUT); - -exit(0); - - -package DXUser; - - -use MLDBM qw(DB_File); -use Fcntl; -use Carp; - -# -# initialise the system -# -sub init -{ - my ($pkg, $fn, $mode) = @_; - - confess "need a filename in User" if !$fn; - if ($mode) { - $dbm = tie (%u, MLDBM, $fn, O_CREAT|O_RDWR, 0666) or confess "can't open user file: $fn ($!)"; - } else { - $dbm = tie (%u, MLDBM, $fn, O_RDONLY) or confess "can't open user file: $fn ($!)"; - } - - $filename = $fn; -} - -# -# close the system -# - -sub finish -{ - untie %u; -} - -# -# get - get an existing user - this seems to return a different reference everytime it is -# called - see below -# - -sub get -{ - my $pkg = shift; - my $call = uc shift; - # $call =~ s/-\d+$//o; # strip ssid - return $u{$call}; -} - -# -# get all callsigns in the database -# - -sub get_all_calls -{ - return (sort keys %u); -} - - -# -# create a string from a user reference -# -sub encode -{ - my $self = shift; - my $out; - my $f; - - $out = "bless( { "; - for $f (sort keys %$self) { - my $val = $$self{$f}; - if (ref $val) { # it's an array (we think) - $out .= "'$f'=>[ "; - foreach (@$val) { - my $s = $_; - $out .= "'$s',"; - } - $out .= " ],"; - } else { - $val =~ s/'/\\'/og; - $val =~ s/\@/\\@/og; - $out .= "'$f'=>'$val',"; - } - } - $out .= " }, 'DXUser')"; - return $out; -} - diff --git a/perl/create_prefix.pl b/perl/create_prefix.pl index 43501eea..daf4a09e 100755 --- a/perl/create_prefix.pl +++ b/perl/create_prefix.pl @@ -13,13 +13,18 @@ BEGIN { # root of directory tree for this system $root = "/spider"; $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'}; - + + mkdir "$root/local_data", 02777 unless -d "$root/local_data"; + unshift @INC, "$root/perl"; # this IS the right way round! unshift @INC, "$root/local"; } -use DXVars; +use SysVar; + use Data::Dumper; +use DXUtil; + use strict; my %loc = (); # the location unique hash @@ -28,9 +33,17 @@ my %locn = (); # the inverse of the above my %pre = (); # the prefix hash my %pren = (); # the inverse +if (@ARGV && $ARVG[0] =~ /^--system$/) { + $prefix = $main::data; + shift; +} else { + $prefix = $main:local_data; +} + # open the input file my $ifn = $ARGV[0] if $ARGV[0]; -$ifn = "$main::data/wpxloc.raw" if !$ifn; + +$ifn = "$prefix/wpxloc.raw" if !$ifn; open (IN, $ifn) or die "can't open $ifn ($!)"; # first pass, find all the 'master' location records @@ -94,7 +107,7 @@ close(IN); my @f; my @a; $line = 0; -if (open(IN, "$main::data/cty.dat")) { +if (open(IN, "$prefix/cty.dat")) { my $state = 0; while () { $line++; @@ -125,7 +138,7 @@ if (open(IN, "$main::data/cty.dat")) { close IN; -open(OUT, ">$main::data/prefix_data.pl") or die "Can't open $main::data/prefix_data.pl ($!)"; +open(OUT, ">$prefix/prefix_data.pl") or die "Can't open $prefix/prefix_data.pl ($!)"; print OUT "\%pre = (\n"; foreach my $k (sort keys %pre) { diff --git a/perl/create_qsl.pl b/perl/create_qsl.pl index 2cca7b31..f4083f55 100755 --- a/perl/create_qsl.pl +++ b/perl/create_qsl.pl @@ -22,7 +22,7 @@ BEGIN { use strict; use IO::File; -use DXVars; +use SysVar; use DXUtil; use Spot; use QSL; @@ -36,11 +36,12 @@ my $qslfn = "qsl"; $main::systime = time; -unlink "$root/data/qsl.v1"; +unlink "$data/qsl.v1"; +unlink "$local_data/qsl.v1"; QSL::init(1) or die "cannot open QSL file"; -my $base = "$root/data/spots"; +my $base = localdata("spots"); opendir YEAR, $base or die "$base $!"; foreach my $year (sort readdir YEAR) { diff --git a/perl/create_sysop.pl b/perl/create_sysop.pl index 31c208b0..b85c60b7 100755 --- a/perl/create_sysop.pl +++ b/perl/create_sysop.pl @@ -19,12 +19,13 @@ BEGIN { unshift @INC, "$root/local"; } -use DXVars; +use SysVar; use DXUser; +use DXUtil; sub delete_it { - DXUser->del_file($userfn); + DXUser::del_file(); } sub create_it @@ -79,7 +80,7 @@ sub create_it die "\$myalias \& \$mycall are the same ($mycall)!, they must be different (hint: make \$mycall = '${mycall}-2';).\n" if $mycall eq $myalias; -$lockfn = "$root/local/cluster.lck"; # lock file name +$lockfn = localdata("cluster.lck"); # lock file name if (-e $lockfn) { open(CLLOCK, "$lockfn") or die "Can't open Lockfile ($lockfn) $!"; my $pid = ; @@ -95,21 +96,21 @@ if (-e "$userfn.v2" || -e "$userfn.v3") { $ans = ; if ($ans =~ /^[Yy]/) { delete_it(); - DXUser->init($userfn, 1); + DXUser::init(1); create_it(); } else { print "Do you wish to reset your cluster and sysop information? [y/N]: "; $ans = ; if ($ans =~ /^[Yy]/) { - DXUser->init($userfn, 1); + DXUser::init(1); create_it(); } } } else { - DXUser->init($userfn, 1); + DXUser::init(1); create_it(); } -DXUser->finish(); +DXUser::finish(); exit(0); diff --git a/perl/gen_usdb_data.pl b/perl/gen_usdb_data.pl index 7c9d47e2..7857a5c5 100755 --- a/perl/gen_usdb_data.pl +++ b/perl/gen_usdb_data.pl @@ -36,11 +36,14 @@ BEGIN { $root = "/spider"; $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'}; + mkdir "$root/local_data", 02777 unless -d "$root/local_data"; + unshift @INC, "$root/perl"; # this IS the right way round! unshift @INC, "$root/local"; } -use DXVars; +use SysVar; + use Archive::Zip qw(:ERROR_CODES); use Archive::Zip::MemberRead; use IO::File; @@ -50,7 +53,7 @@ my $blksize = 1024 * 1024; STDOUT->autoflush(1); -my $dbrawfn = "$main::data/usdbraw.gz"; +my $dbrawfn = localdata("usdbraw.gz"); rename "$dbrawfn.oo", "$dbrawfn.ooo"; rename "$dbrawfn.o", "$dbrawfn.oo"; @@ -75,7 +78,7 @@ sub handleEN { my ($zip, $argv) = @_; my $mname = "EN.dat"; - my $ofn = "$main::data/$mname"; + my $ofn = localdata($mname); print " Handling EN records, unzipping"; if ($zip->extractMember($mname, $ofn) == AZ_OK) { my $fh = new IO::File "$ofn" or die "Cannot open $ofn $!"; diff --git a/perl/grepdbg b/perl/grepdbg index 3d1526f8..ebf581bd 100755 --- a/perl/grepdbg +++ b/perl/grepdbg @@ -29,7 +29,7 @@ BEGIN { unshift @INC, "$root/local"; } -use DXVars; +use SysVar; use DXUtil; use DXLog; use Julian; diff --git a/perl/hlptohtml.pl b/perl/hlptohtml.pl index 9bebb9c0..6b48df2b 100755 --- a/perl/hlptohtml.pl +++ b/perl/hlptohtml.pl @@ -21,7 +21,7 @@ BEGIN { use strict; use IO::File; -use DXVars; +use SysVar; use Carp; my $lang = 'en'; diff --git a/perl/lock_nodes.pl b/perl/lock_nodes.pl index 0afad397..3ab0e7d1 100755 --- a/perl/lock_nodes.pl +++ b/perl/lock_nodes.pl @@ -1,13 +1,9 @@ #!/usr/bin/env perl # -# remove all records with the sysop/cluster callsign and recreate -# it from the information contained in DXVars +# Lock all non local nodes that have a privileges <= 1 # # WARNING - this must be run when the cluster.pl is down! # -# This WILL NOT delete an old sysop call if you are simply -# changing the callsign. -# # Copyright (c) 1998 Dirk Koopman G1TLH # # @@ -23,10 +19,11 @@ BEGIN { unshift @INC, "$root/local"; } -use DXVars; +use SysVar; use DXUser; +use DXUtil; -my $lockfn = "$root/local/cluster.lck"; # lock file name +my $lockfn = localdata("cluster.lck"); # lock file name if (-e $lockfn) { open(CLLOCK, "$lockfn") or die "Can't open Lockfile ($lockfn) $!"; my $pid = ; @@ -37,7 +34,7 @@ if (-e $lockfn) { my @nodes = map { uc } @ARGV; -DXUser->init($userfn, 1); +DXUser::init(1); my $count; my $nodes; @@ -71,6 +68,6 @@ print "If there are any nodes missing on the above list then you MUST do\n"; print "a set/node (set/spider, set/clx etc) on each of them to allow them\n"; print "to connect to you or you to them\n"; -DXUser->finish(); +DXUser::finish(); exit(0); diff --git a/perl/talias.pl b/perl/talias.pl index 1cf70e82..c5dc83f9 100755 --- a/perl/talias.pl +++ b/perl/talias.pl @@ -13,7 +13,7 @@ BEGIN { unshift @INC, "$root/local"; } -use DXVars; +use SysVar; use CmdAlias; use Carp; diff --git a/perl/update_sysop.pl b/perl/update_sysop.pl index f76dc725..e7225c7c 100755 --- a/perl/update_sysop.pl +++ b/perl/update_sysop.pl @@ -22,8 +22,9 @@ BEGIN { unshift @INC, "$root/local"; } -use DXVars; +use SysVar; use DXUser; +use DXUtil; sub create_it { @@ -85,7 +86,7 @@ sub create_it die "\$myalias \& \$mycall are the same ($mycall)!, they must be different (hint: make \$mycall = '${mycall}-2';).\n" if $mycall eq $myalias; -$lockfn = "$root/local/cluster.lck"; # lock file name +$lockfn = localdata("cluster.lck"); # lock file name if (-e $lockfn) { open(CLLOCK, "$lockfn") or die "Can't open Lockfile ($lockfn) $!"; my $pid = ; @@ -94,9 +95,9 @@ if (-e $lockfn) { close CLLOCK; } -DXUser->init($userfn, 1); +DXUser::init(1); create_it(); -DXUser->finish(); +DXUser:finish(); print "Update of $myalias on cluster $mycall successful\n"; exit(0); diff --git a/perl/watchdbg b/perl/watchdbg index 348ac8fe..32979413 100755 --- a/perl/watchdbg +++ b/perl/watchdbg @@ -23,7 +23,7 @@ BEGIN { } use IO::File; -use DXVars; +use SysVar; use DXUtil; use DXLog; diff --git a/perl/winclient.pl b/perl/winclient.pl index f556b102..96898000 100755 --- a/perl/winclient.pl +++ b/perl/winclient.pl @@ -28,6 +28,8 @@ BEGIN { use IO::Socket; use DXVars; +use SysVar; + use IO::File; use Config; -- 2.43.0