sub new {
my $class = shift;
if(ref $class){
$class->{_errstr} = "Unable to generate object from within object";
return;
}
my %acess = @_;
my $self = {_settings => 0,_divdir => 0, _divlist => 0,_members => 0,alog => ''};
#Preload any files they specify a need for
#List of keys:
# divisions
# memberlist
my($settings,$memblist,$path);
croak "Unable to locate GMSSettings.gms in current path" unless(-e "GMSSettings.gms");
$settings = new IniFile("GMSSettings.gms");
$path = $settings->get(['FILE','MEMBERDIRL'], -mapping => 0);
if($acess{'divisions'} && $settings->get(['OTHER','DIVISIONS'], -mapping=>'single') ){
if(-e "$path/division.gms" && -e "$path/divlist.gms"){
$self->{_divdir} = new IniFile("$path/division.gms");
$self->{_divlist} = new IniFile("$path/divlist.gms");
}else{
croak "Unable to locate division.gms and/or divlist.gms in $path";
}
}
if($acess{'memberlist'}){
if(-e "$path/memberlist.gms"){
$self->{_members} = new IniFile("$path/memberlist.gms");
}else{
croak "Unable to locate memberlist.gms in $path";
}
}
if($settings->get(['FILE','LOGACTION'],-mapping=>'single')){
local *LOGFILE;
open(LOGFILE,">>$path/GMS.log") or croak("Unable to open logfile! $!");
$self->{alog} = \*LOGFILE;
my $temp = $self->{alog};
}
$self->{_settings} = $settings;
my $object = bless($self,$class);
$GMS::LIVEOBJECT = $object;
return $object;
}
sub logaction{
my $self = ref($_[0]) ? shift : 0;
croak("Logaction is a METHOD. GMS object required.") if(!ref($self));
return(1) unless($self->{_settings}->get(['FILE','LOGACTION'],-mapping=>'single'));
my $file = $self->{alog};
unless($file){
$self->{_errstr} = "Log not open!";
return;
}
my($uid,$ip);
if($_[1] && $_[1] !~ m/\D/go){
$uid = $_[1];
}else{
my $temp = $self->verifylogin();
$uid = $temp->[1] || "???";
}
$ip = $ENV{'REMOTE_ADDR'} || '???';
my $action = $_[0];
$action =~ s/\n|\r/
/go;
flock($file,2) if($self->getsetting('OTHER','FLOCK'));
seek($file,0,2);
print $file time.";$ip;$uid;$action\n";# or warn("UNABLE TO LOG!\n$!");
flock($file,8) if($self->getsetting('OTHER','FLOCK'));
return(1);
}
####
E:\Apache\cgi-bin\GMS>perl -w -e "use GMS; my $GMS = new GMS; $GMS->logaction('test') or die($!);"
seek() on unopened filehandle GMS::LOGFILE at GMS.pm line 271.
print() on unopened filehandle GMS::LOGFILE at GMS.pm line 272.
(in cleanup) Can't call method "EXISTS" on an undefined value at E:/Perl/site/lib/IniFile.pm line 375 during global destruction.