From 79f4593964c44fb39faf9d070a418125e90e1333 Mon Sep 17 00:00:00 2001 From: minima Date: Tue, 1 Aug 2000 21:46:08 +0000 Subject: [PATCH] fixed import export removed import_users.pl --- Changes | 5 ++++ cmd/set/address.pl | 15 ++-------- cmd/set/email.pl | 1 + cmd/set/homenode.pl | 1 + cmd/set/name.pl | 1 + cmd/set/password.pl | 1 + cmd/set/qth.pl | 1 + perl/DXUser.pm | 65 ++++++++++++++++++++++++++++++++++---------- perl/import_users.pl | 36 ------------------------ 9 files changed, 64 insertions(+), 62 deletions(-) delete mode 100755 perl/import_users.pl diff --git a/Changes b/Changes index 2e4be4fc..39f982fe 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,8 @@ +01Aug00======================================================================= +1. made the export and import ascii system work finally. The user_asc file +generated (automatically and 0000Z Sunday morning) is autoloading. Just +execute it and it will automatically reload your user database. +2. remove import_users.pl no longer necessary 31Jul00======================================================================= 1. try to fix paging problem. 2. added help for spoof and set/forward diff --git a/cmd/set/address.pl b/cmd/set/address.pl index 15e42579..daea06c8 100644 --- a/cmd/set/address.pl +++ b/cmd/set/address.pl @@ -11,18 +11,9 @@ my $call; my @out; my $user; -if ($self->priv >= 5) { # allow a callsign as first arg - my @args = split /\s+/, $line; - $call = UC $args[0]; - $user = DXUser->get_current($call); - shift @args if $user; - $line = join ' ', @args; -} else { - $call = $self->call; - $user = $self->user; -} - +$user = $self->user; +$line =~ s/[{}]//g; # no braces allowed $user->addr($line); -push @out, $self->msg('addr', $call, $line); +push @out, $self->msg('addr', $line); return (1, @out); diff --git a/cmd/set/email.pl b/cmd/set/email.pl index 8748df1f..ed68420e 100644 --- a/cmd/set/email.pl +++ b/cmd/set/email.pl @@ -13,6 +13,7 @@ my $user; # remove leading and trailing spaces $line =~ s/^\s+//; $line =~ s/\s+$//; +$line =~ s/[{}]//g; # remove any braces return (1, $self->msg('emaile1')) if !$line; diff --git a/cmd/set/homenode.pl b/cmd/set/homenode.pl index f1e909ff..5d3cb413 100644 --- a/cmd/set/homenode.pl +++ b/cmd/set/homenode.pl @@ -13,6 +13,7 @@ my $user; # remove leading and trailing spaces $line =~ s/^\s+//; $line =~ s/\s+$//; +$line =~ s/[{}]//g; # no braces allowed return (1, $self->msg('hnodee1')) if !$line; diff --git a/cmd/set/name.pl b/cmd/set/name.pl index e966837d..6f76ea60 100644 --- a/cmd/set/name.pl +++ b/cmd/set/name.pl @@ -13,6 +13,7 @@ my $user; # remove leading and trailing spaces $line =~ s/^\s+//; $line =~ s/\s+$//; +$line =~ s/[{}]//g; # no braces allowed return (1, $self->msg('namee1')) if !$line; diff --git a/cmd/set/password.pl b/cmd/set/password.pl index 1aa425f6..1c248d02 100644 --- a/cmd/set/password.pl +++ b/cmd/set/password.pl @@ -19,6 +19,7 @@ return (1, $self->msg('e5')) if $self->priv < 9; if ($ref = DXUser->get_current($call)) { $line =~ s/^\s*$call\s+//; $line =~ s/\s+//og; # remove any blanks + $line =~ s/[{}]//g; # no braces allowed $ref->passwd($line); $ref->put(); push @out, $self->msg("password", $call); diff --git a/cmd/set/qth.pl b/cmd/set/qth.pl index e76e5fff..567208c7 100644 --- a/cmd/set/qth.pl +++ b/cmd/set/qth.pl @@ -13,6 +13,7 @@ my $user; # remove leading and trailing spaces $line =~ s/^\s+//; $line =~ s/\s+$//; +$line =~ s/[{}]//g; # no braces allowed return (1, $self->msg('qthe1')) if !$line; diff --git a/perl/DXUser.pm b/perl/DXUser.pm index eaf88039..ce26c291 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -103,7 +103,7 @@ sub init sub del_file { - my ($pkg, $fn, $mode) = @_; + my ($pkg, $fn) = @_; confess "need a filename in User" if !$fn; $fn .= ".v2"; @@ -308,11 +308,11 @@ sub export my $count = 0; my $fh = new IO::File ">$fn" or return "cannot open $fn ($!)"; if ($fh) { - my $ref; - my $key; + my $ref = 0; + my $key = 0; my $action; my $t = scalar localtime; - print $fh "#!/usr/bin/perl + print $fh q{#!/usr/bin/perl # # The exported userfile for a DXSpider System # @@ -320,19 +320,56 @@ sub export # Time: $t # +package main; + +# 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"; + + # try to detect a lockfile (this isn't atomic but + # should do for now + $lockfn = "$root/perl/cluster.lock"; # lock file name + if (-e $lockfn) { + open(CLLOCK, "$lockfn") or die "Can't open Lockfile ($lockfn) $!"; + my $pid = ; + chomp $pid; + die "Lockfile ($lockfn) and process $pid exists - cluster must be stopped first\n" if kill 0, $pid; + close CLLOCK; + } +} + package DXUser; +use DXVars; +use DXUser; + +if (@ARGV) { + $main::userfn = shift @ARGV; + print "user filename now $userfn\n"; +} + +DXUser->del_file($main::userfn); +DXUser->init($main::userfn, 1); + %u = ( -"; - - for ($action = R_FIRST; !$dbm->seq($key, $ref, $action); $action = R_NEXT) { - print $fh "'$key' => $ref,\n"; - ++$count; - } - print $fh ");\n#\n# there were $count records\n#\n"; - $fh->close; - } - return $count; + }; + +for ($action = R_FIRST; !$dbm->seq($key, $ref, $action); $action = R_NEXT) { + print $fh "'$key' => q{$ref},\n"; + ++$count; +} +print $fh ");\n#\nprint \"there were $count records\\n\";\n#\n"; +print $fh "DXUser->sync; DXUser->finish;\n#\n"; +$fh->close; +} + return $count; } # diff --git a/perl/import_users.pl b/perl/import_users.pl deleted file mode 100755 index 159989b8..00000000 --- a/perl/import_users.pl +++ /dev/null @@ -1,36 +0,0 @@ -#!/usr/bin/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 DXUser; -use DXUtil; -use Carp; - -$inpfn = $ARGV[0] if @ARGV; -croak "need a input filename" unless $inpfn; - -DXUser->del_file($userfn); -DXUser->init($userfn, 1); - -my $s = readfilestr "$inpfn"; -eval $s; -print $@ if $@; - -DXUser->finish(); -- 2.43.0