-#!/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;
-}
-