interactive/gms/SKBB/httpd/wwwroot/tts/TTXUser.pm

package TTXUser;
#
# This module is a part of Trouble Ticket Express package
# http://www.troubleticketexpress.com
#
# COPYRIGHT: 2003-2005, United Web Coders
# http://www.unitedwebcoders.com
#
# $Revision: 185 $
# $Date: 2006-06-20 08:14:46 -0400 (Tue, 20 Jun 2006) $
#

$TTXUser::VERSION='2.22';
BEGIN {
  $TTXUser::REVISION = '$Revision: 185 $';
  if ($TTXUser::REVISION =~ /(\d+)/) {
    $TTXUser::REVISION = $1;
  }
};
use strict;
use TTXData;

my %errmsgs = (
  NOUSER => 'User does not exist',
  OPENERR => 'Error reading file',
  WRERR => 'Error writing file'
);

my $delim;
my $redelim;

# ========================================================================== new

sub new {
  my $class = shift;
  my $self = {};
  bless($self, $class);
  $delim = TTXData::get('CONFIG')->get('delim');
  $delim = ':' if $delim eq undef;
  if ($delim eq '|') {
    $redelim = '\|';
  } else {
    $redelim = $delim;
  }
  if ($_[0] ne undef) {
    $self->load($_[0]);
  }
  return $self;
}
# ========================================================================== get

sub get {
  my $self = shift;
  my $name = shift;
  return $self->{$name};
}
# ========================================================================== set

sub set {
  my $self = shift;
  my $name = shift;
  my $value = shift;
  my $old = $self->{$name};
  $self->{$name} = $value;
  return $old
}
# ==================================================================== listemail

sub listemail {
  $delim = TTXData::get('CONFIG')->get('delim');
  $delim = ':' if $delim eq undef;
  if ($delim eq '|') {
    $redelim = '\|';
  } else {
    $redelim = $delim;
  }
  my $fn = TTXData::get('CONFIG')->get('userdb');
  if (! -f $fn) {
    return undef;
  }
  if (!open(USRDB, $fn)) {
    return undef;
  }
  my @buff = <USRDB>;
  close USRDB;
  chomp @buff;
  my @list;
  foreach my $line (@buff) {
    my @parts = split(/$redelim/, $line);
    push @list, $parts[4];
  }
  return @list;
}
# ========================================================================= list

sub list {
  $delim = TTXData::get('CONFIG')->get('delim');
  $delim = ':' if $delim eq undef;
  if ($delim eq '|') {
    $redelim = '\|';
  } else {
    $redelim = $delim;
  }
  my $fn = TTXData::get('CONFIG')->get('userdb');
  if (! -f $fn) {
    return undef;
  }
  if (!open(USRDB, $fn)) {
    return undef;
  }
  my @buff = <USRDB>;
  close USRDB;
  chomp @buff;
  my @list;
  foreach my $line (@buff) {
    $line =~ s/$redelim.*$//;
    push @list, $line;
  }
  return @list;
}
# ===================================================================== userbysn

sub userbysn {
  my $sn = shift;
  my @lst = list();
  foreach my $uid (@lst) {
    my $u = TTXUser->new($uid);
    next if $u eq undef || $u->{snum} ne $sn;
    return $u;
  }
  return undef;
}
# ========================================================================= load

sub load {
  my $self  = shift;
  my $login = shift;
  my $fn = TTXData::get('CONFIG')->get('userdb');
  if (! -f $fn) {
    $self->{_ERROR_CODE} = 'NOUSER';
    return 0;
  }
  if (!open(USRDB, $fn)) {
    $self->{_ERROR_CODE} = 'OPENERR';
    return 0;
  }
  my @buff = <USRDB>;
  close USRDB;
  chomp @buff;
  foreach my $line (@buff) {
    next if $line !~ /^$login$redelim/;
    my ($login, $passwd, $fname, $lname, $email, $image, $usemail, $snum, $ro, $sla) = split(/$redelim/, $line);
    $self->{login} = $login;
    $self->{passwd} = $passwd;
    $self->{fname} = $fname;
    $self->{lname} = $lname;
    $self->{email} = $email;
    $self->{image} = $image;
    $self->{usemail} = $usemail;
    $self->{ro} = $ro;
    $self->{snum} = $snum;
    $self->{sla} = $sla;
    return 1;
  }
  $self->{_ERROR_CODE} = 'NOUSER';
  return 0;
}
# ==================================================================== errortext

sub errortext {
  my $self = shift;
  return $errmsgs{$self->{_ERROR_CODE}};
}
# ======================================================================= delete

sub delete {
  my $self  = shift;
  my $fn = TTXData::get('CONFIG')->get('userdb');
  if (! -f $fn || $self->{login} eq undef) {
    $self->{_ERROR_CODE} = 'NOUSER';
    return 0;
  }
  if (open(USRDB,"+<$fn")) {
    flock(USRDB, 2);
    my @users = <USRDB>;
    my $id = $self->{login};
    @users = grep(!/^$id$redelim/, @users);
    seek(USRDB, 0, 0);
    foreach (@users) { print USRDB $_; }
    truncate(USRDB, tell(USRDB));
    close(USRDB);
  } else {
    $self->{_ERROR_CODE} = 'WRERR';
    return 0;
  }
  return 1;
}
# ========================================================================= save

sub save {
  my $self  = shift;
  my $fn = TTXData::get('CONFIG')->get('userdb');
  if ($self->{login} eq undef) {
    $self->{_ERROR_CODE} = 'NOUSER';
    return 0;
  }
  if (! -f $fn) {
    open(USRDB, ">$fn");
    close USRDB;
    umask(0);
    chmod(0777, $fn);
  }
  if (open(USRDB,"+<$fn")) {
    flock(USRDB, 2);
    my @users = <USRDB>;
    my $id = $self->{login};
    @users = grep(!/^$id$redelim/, @users);
    seek(USRDB, 0, 0);
    if ($delim eq ':') {
      TTXData::get('CONFIG')->set('delim', '|');
      TTXData::get('CONFIG')->save();
      $delim = '|';
      $redelim = '\|';
      foreach my $u (@users) { $u =~ s/:/|/g; print USRDB $u; }
    } else {
      foreach (@users) { print USRDB $_; }
    }
    print USRDB $self->{login}.$delim.$self->{passwd}.$delim.$self->{fname}.
                $delim.$self->{lname}.$delim.$self->{email}.$delim.$self->{image}.
                $delim.$self->{usemail}.$delim.$self->{snum}.$delim.$self->{ro}.$delim.$self->{sla}."\n";
    truncate(USRDB, tell(USRDB));
    close(USRDB);
  } else {
    $self->{_ERROR_CODE} = 'WRERR';
    return 0;
  }
  return 1;
}
# ========================================================================= hash

sub hash {
  my $self  = shift;
  my $h = {};
  foreach my $key ($self->vars()) {
    $h->{$key} = $self->{$key};
  }
  return $h;
}

1;
#