perl/convert_users.pl

   1 #!/usr/bin/perl
   2 #
   3 # Export the user file in a form that can be directly imported
   4 # back with a do statement
   5 #
   6
   7 require 5.004;
   8
   9 # search local then perl directories
  10 BEGIN {
  11         umask 002;
  12
  13         # root of directory tree for this system
  14         $root = "/spider";
  15         $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
  16
  17         unshift @INC, "$root/perl";     # this IS the right way round!
  18         unshift @INC, "$root/local";
  19 }
  20
  21 use DXVars;
  22 use DB_File;
  23 use Fcntl;
  24 use Carp;
  25
  26 $userfn = $ARGV[0] if @ARGV;
  27 unless ($userfn) {
  28         croak "need a filename";
  29 }
  30
  31 DXUser->init($userfn);
  32 unlink "$userfn.asc";
  33 open OUT, ">$userfn.asc" or die;
  34
  35 %newu = ();
  36 $t = scalar localtime;
  37 print OUT "#!/usr/bin/perl
  38 #
  39 # The exported userfile for a DXSpider System
  40 #
  41 # Input file: $userfn
  42 #       Time: $t
  43 #
  44
  45 package DXUser;
  46
  47 %u = (
  48 ";
  49
  50 @all = DXUser::get_all_calls();
  51
  52 for $a (@all) {
  53         my $ref = DXUser::get($a);
  54         my $s = $ref->encode() if $ref;
  55         print OUT "'$a' => q{$s},\n" if $a;
  56         $count++;
  57 }
  58
  59 DXUser->finish();
  60
  61 print OUT ");
  62 #
  63 # there were $count records
  64 #\n";
  65
  66         close(OUT);
  67
  68 exit(0);
  69
  70
  71 package DXUser;
  72
  73
  74 use MLDBM qw(DB_File);
  75 use Fcntl;
  76 use Carp;
  77
  78 #
  79 # initialise the system
  80 #
  81 sub init
  82 {
  83         my ($pkg, $fn, $mode) = @_;
  84
  85         confess "need a filename in User" if !$fn;
  86         if ($mode) {
  87                 $dbm = tie (%u, MLDBM, $fn, O_CREAT|O_RDWR, 0666) or confess "can't open user file: $fn ($!)";
  88         } else {
  89                 $dbm = tie (%u, MLDBM, $fn, O_RDONLY) or confess "can't open user file: $fn ($!)";
  90         }
  91
  92         $filename = $fn;
  93 }
  94
  95 #
  96 # close the system
  97 #
  98
  99 sub finish
 100 {
 101         untie %u;
 102 }
 103
 104 #
 105 # get - get an existing user - this seems to return a different reference everytime it is
 106 #       called - see below
 107 #
 108
 109 sub get
 110 {
 111         my $pkg = shift;
 112         my $call = uc shift;
 113         #  $call =~ s/-\d+$//o;       # strip ssid
 114         return $u{$call};
 115 }
 116
 117 #
 118 # get all callsigns in the database
 119 #
 120
 121 sub get_all_calls
 122 {
 123         return (sort keys %u);
 124 }
 125
 126
 127 #
 128 # create a string from a user reference
 129 #
 130 sub encode
 131 {
 132         my $self = shift;
 133         my $out;
 134         my $f;
 135
 136         $out = "bless( { ";
 137         for $f (sort keys %$self) {
 138                 my $val = $$self{$f};
 139             if (ref $val) {          # it's an array (we think)
 140                         $out .= "'$f'=>[ ";
 141                         foreach (@$val) {
 142                                 my $s = $_;
 143                                 $out .= "'$s',";
 144                         }
 145                         $out .= " ],";
 146             } else {
 147                         $val =~ s/'/\\'/og;
 148                         $val =~ s/\@/\\@/og;
 149                         $out .= "'$f'=>'$val',";
 150                 }
 151         }
 152         $out .= " }, 'DXUser')";
 153         return $out;
 154 }
 155