perl/DXUser.pm

   1 #
   2 # DX cluster user routines
   3 #
   4 # Copyright (c) 1998 - Dirk Koopman G1TLH
   5 #
   6 # $Id$
   7 #
   8
   9 package DXUser;
  10
  11 require Exporter;
  12 @ISA = qw(Exporter);
  13
  14 use MLDBM;
  15 use Fcntl;
  16
  17 %u = undef;
  18 $dbm = undef;
  19 $filename = undef;
  20
  21 #
  22 # initialise the system
  23 #
  24 sub init
  25 {
  26   my ($pkg, $fn) = @_;
  27
  28   die "need a filename in User\n" if !$fn;
  29   $dbm = tie %u, MLDBM, $fn, O_CREAT|O_RDWR, 0666 or die "can't open user file: $fn ($!)\n";
  30   $filename = $fn;
  31 }
  32
  33 #
  34 # close the system
  35 #
  36
  37 sub finish
  38 {
  39   $dbm = undef;
  40   untie %u;
  41 }
  42
  43 #
  44 # new - create a new user
  45 #
  46
  47 sub new
  48 {
  49   my ($call) = @_;
  50   die "can't create existing call $call in User\n!" if $u{$call};
  51
  52   my $self = {};
  53   $self->{call} = $call;
  54   bless $self;
  55   $u{call} = $self;
  56 }
  57
  58 #
  59 # get - get an existing user
  60 #
  61
  62 sub get
  63 {
  64   my ($call) = @_;
  65   return $u{$call};
  66 }
  67
  68 #
  69 # put - put a user
  70 #
  71
  72 sub put
  73 {
  74   my $self = shift;
  75   my $call = $self->{call};
  76   $u{$call} = $self;
  77 }
  78
  79 #
  80 # del - delete a user
  81 #
  82
  83 sub del
  84 {
  85   my $self = shift;
  86   my $call = $self->{call};
  87   delete $u{$call};
  88 }
  89
  90 #
  91 # close - close down a user
  92 #
  93
  94 sub close
  95 {
  96   my $self = shift;
  97   $self->{lastin} = time;
  98   $self->put();
  99 }
 100
 101 1;
 102 __END__