package PerlMonitorServer::Config;
use strict;
use Exporter;
use Cwd;
use Config;
use PerlMonitorServer::Logs;
use vars qw(@ISA @EXPORT $AUTOLOAD $write_flag);
use PerlMonitorServer::Misc;
use Data::Dumper;
@ISA = ('Exporter');
$write_flag = 0;
my $basedir = $0;
$basedir =~ s/(pws\.pl|web_server\.pl|html\/gestion_formulario\.cgi|html\/gestion_formulario_mantenimiento\.cgi)//;
my $conf_file = "websrvr.cfg";
my $mime_file = "mime.types";
# Define los mime-types por defecto. Estos pueden ser también definidos en el fichero $mime_file.
my %mime = qw(js application/x-javascript
gz application/x-gzip
zip application/zip
bin application/octet-stream
dms application/octet-stream
lha application/octet-stream
lzh application/octet-stream
exe application/octet-stream
class application/octet-stream
mpga audio/mpeg
mp2 audio/mpeg
mp3 audio/mpeg
aif audio/x-aiff
aiff audio/x-aiff
aifc audio/x-aiff
ram audio/x-pn-realaudio
rm audio/x-pn-realaudio
ra audio/x-realaudio
wav audio/x-wav
bmp image/bmp
gif image/gif
jpeg image/jpeg
jpg image/jpeg
jpe image/jpeg
png image/png
css text/css
html text/html
htm text/html
asc text/plain
txt text/plain
rtf text/rtf
qt video/quicktime
mov video/quicktime
avi video/x-msvideo
);
my %_scope_hash;
my $_default_host = '';
my %_handlers;
my %_handler_ext;
my $modules_loaded = 0;
my $mime_types_loaded = 0;
$Global::CONFIG_LOADED = 1;
sub new {
my $pkg = shift;
my %hash = (_permitted => {}, _scope => 'server');
my $ref = \%hash;
bless $ref, $pkg;
# logDebug(caller(). " creating new Config object=$ref.");
my %args = @_;
$write_flag = 1 if (defined $args{'write'});
$ref->load_config();
$ref->load_mime_types() unless ($mime_types_loaded);
return $ref;
}
sub load_config {
my $self = shift;
local (*IN);
my $dir = $basedir;
my $file_name = ($dir) ? $dir.$SEP.$conf_file : $conf_file;
if (-f $file_name && -r $file_name) {
if (open(IN,$file_name)) {
while (my $line = <IN>) {
$line =~ s/^\s//o;
$line =~ s/#.*$//o;
$line =~ s/\s+$//o;
next unless ($line);
while ($line =~ /__\w+__/o) {
$line =~ s/__(\w+)__/$self->$1()/e || die "Error in config file:\nUnknown value at line ". $. .": $line\n";
}
if ($line =~ /^<Scope\s+([^>]+)>$/io) {
$self->scope($1);
} elsif ($line =~ /^<\/Scope>$/io) {
$self->scope('server');
} elsif ($line =~ /^(\w+)\s+(.*)$/o) {
my ($key,$val) = ($1,$2);
if ($val =~ /\s/o) {
$self->add_attribute($key, [split(/\s+/, $val)]);
} else {
$self->add_attribute($key, $val);
}
} else {
die "Error in config file:\nUnknown syntax at line ". $. .": $line\n";
}
}
$modules_loaded = 1;
close(IN);
} else {
die "Can't open config file: $file_name $!\n";
}
} else {
die "Can't open config file: $file_name $!\n";
}
}
sub reload_config {
my $self = shift;
$modules_loaded = 0;
$mime_types_loaded = 0;
$self->load_config();
$self->load_mime_types();
}
sub scope {
my ($self) = shift;
$_default_host ||= $self->{_scope} if ($self->{_scope} ne 'server');
return (@_) ? $self->{_scope} = lc(shift) : $self->{_scope};
}
sub has_scope {
my ($self,$scope) = @_;
return 0 unless ($scope);
return (defined $_scope_hash{$scope}) ? $scope : 0;
}
sub default_host {
my $self = shift;
return $_default_host || 'server';
}
sub add_attribute {
my ($self,$key,$val) = @_;
return unless (defined $key);
$key = lc $key;
if ($key eq 'addmodule' and (! $modules_loaded)) {
$self->add_module($val);
} elsif ($key eq 'addtype' and (! $modules_loaded)) {
my $tmp = shift(@$val);
$self->handler_type($val,$tmp);
} else {
$self->{_permitted}{$self->scope}{$key} = 1;
$_scope_hash{$self->scope}{$key} = $val;
# print caller() . ":add_attribute: scope=". $self->scope ." $key=". $_scope_hash{$self->scope}{$key} ."\n";
if ($self->scope eq 'server') {
no strict 'refs';
${"Global::". uc $key} = $val;
}
}
}
sub add_module {
my $self = shift;
my $mod = shift or return;
# print "add_module: $mod\n";
my $obj;
my $code = qq{
require PerlMonitorServer::Module::$mod;
\$obj = new PerlMonitorServer::Module::$mod();
};
eval $code;
if ($@) {
logError("Error loading module: $mod $@");
return;
}
# print "Loaded module: $mod\n";
if ($obj->init() == M_OK) {
$self->handler($obj->handler_type,$obj);
}
}
sub handler {
my ($self,$type,$obj) = @_;
# print "Called handler: type=$type\n";
# print "Handlers:\n";
# print Dumper(\%_handlers) ."\n";
return (defined $obj) ? $_handlers{$self->scope}{$type} = $obj :
$_handlers{$self->scope}{$type} || undef;
}
sub handler_type {
my $self = shift;
my $ext = shift;
if (my $new_type = shift()) {
foreach (@$ext) {
$_handler_ext{$self->scope}{$_} = $new_type;
}
}
return $_handler_ext{$self->scope}{$ext} || 'text';
}
sub load_mime_types {
my $self = shift;
foreach my $dir (cwd(),$self->ServerRoot) {
if (-f $dir.$SEP.$mime_file) {
$mime_file = $dir.$SEP.$mime_file;
last;
}
}
local (*IN);
if (open(IN,$mime_file)) {
while (my $line = <IN>) {
chomp($line);
$line =~ s/^\s+//o;
$line =~ s/\#.*$//o;
next unless ($line);
$line =~ s/\s+$//o;
if ($line =~ /^(\S+)\s+(.*)$/o) {
my ($key,$val) = ($1,$2);
foreach (split(/\s+/, $val)) {
next unless (/\S/);
$mime{$_} = $key;
}
}
}
$mime_types_loaded = 1;
close(IN);
} else {
# logError("Cannot open mimie.types for mime definitions. $!");
}
}
sub mime_type {
my ($self,$ext) = @_;
$ext ||= '';
$ext =~ s/^\.//;
return (defined $mime{$ext}) ? $mime{$ext} : 'text/html';
}
sub AUTOLOAD {
my $self = shift;
my $call = $AUTOLOAD;
$call =~ s/^.*:://;
$call = lc $call;
my $tmp_scope = $self->scope;
$tmp_scope = 'server' unless (defined $self->{'_permitted'}{$tmp_scope}{$call});
if (defined $self->{'_permitted'}{$tmp_scope}{$call}) {
if ($write_flag && @_) {
my @tmp = @_;
$_scope_hash{$tmp_scope}{$call} = (@tmp > 1) ? \@tmp : $tmp[0];
}
my @arr = (ref $_scope_hash{$tmp_scope}{$call}) ? @{$_scope_hash{$tmp_scope}{$call}} : ($_scope_hash{$tmp_scope}{$call});
return (wantarray) ? @arr : $arr[0];
} else {
my $err = "Config: scope=". $self->scope ."\n";
$err .= Dumper($_scope_hash{$self->scope}) ."\n";
$err .= "Permitted: \n";
$err .= Dumper($self->{_permitted}) ."\n";
die "Method '$call' not supported by package ", ref($self), "\n$err";
}
}
sub OSTYPE {
return $Config{'osname'};
}
sub is_unix {
my $self = shift;
return ($Config{'osname'} =~ /n[ui]x$/i) ? 1 : 0;
}
sub DESTROY {
my $self = shift;
}
######################## FUNCIONES NUEVAS CREADAS #####################
sub config {
my $self->{_config} = new PerlMonitorServer::Config();
return $self->{_config};
} # config
sub getIP{
my $self = config;
return $self->serverip;
}
sub setIP($$){
my $self= config;
$self->serverip = shift;
}
sub getPort{
my $self = config;
return $self->serverport;
}
sub getMonitoringServices{
my $self = config;
print "La tarea es ".$self->servertask."\n";
return $self->servertask;
}
sub getInstalationDirectory{
my $self = config;
return $self->serverroot;
}
1;
)
