perl/DXUser.pm

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