File Coverage

blib/lib/XAS/Lib/Modules/Environment.pm

Criterion	Covered	Total	%
statement	12	132	9.0
branch	0	100	0.0
condition			n/a
subroutine	4	18	22.2
pod	7	10	70.0
total	23	260	8.8

package XAS::Lib::Modules::Environment;

our $VERSION = '0.02';

use File::Basename;
use Config::IniFiles;
use Net::Domain qw(hostdomain);

use XAS::Class
  debug      => 0,
  version    => $VERSION,
  base       => 'XAS::Singleton',
  utils      => ':validation dir_walk',
  constants  => ':logging :alerts STOMP_LEVELS',
  filesystem => 'File Dir Path Cwd',
  accessors  => 'path host domain username commandline',
  mutators   => 'mqserver mqport mxserver mxport mxtimeout msgs alerts xdebug',
;

# ------------------------------------------------------------------------
# Public Methods
# ------------------------------------------------------------------------

sub mxmailer {
    my $self = shift;
    my ($mailer) = validate_params(\@_, [
        { optional => 1, default => undef, regex => qr/sendmail|smtp/ }
    ]);

    $self->{'mxmailer'} = $mailer if (defined($mailer));

    return $self->{'mxmailer'};

}

sub mqlevel {
    my $self = shift;
    my ($level) = validate_params(\@_, [
        { optional => 1, default => undef, regex => STOMP_LEVELS },
    ]);

    $self->{'mqlevel'} = $level if (defined($level));

    return $self->{'mqlevel'};

}

sub log_type {
    my $self = shift;
    my ($type) = validate_params(\@_, [
        { optional => 1, default => undef, regex => LOG_TYPES }
    ]);

    $self->{'log_type'} = $type if (defined($type));

    return $self->{'log_type'};

}

sub log_facility {
    my $self = shift;
    my ($type) = validate_params(\@_, [
        { optional => 1, default => undef, regex => LOG_FACILITY }
    ]);

    $self->{'log_facility'} = $type if (defined($type));

    return $self->{'log_facility'};

}

sub throws {
    my $self = shift;
    my ($throws) = validate_params(\@_, [
        { optional => 1, default => undef }
    ]);

    $self->{'throws'} = $throws if (defined($throws));

    return $self->{'throws'};

}

sub priority {
    my $self = shift;
    my ($level) = validate_params(\@_, [
        { optional => 1, default => undef, regex => ALERT_PRIORITY }
    ]);

    $self->{'priority'} = $level if (defined($level));

    return $self->{'priority'};

}

sub facility {
    my $self = shift;
    my ($level) = validate_params(\@_, [
        { optional => 1, default => undef, regex => ALERT_FACILITY }
    ]);

    $self->{'facility'} = $level if (defined($level));

    return $self->{'facility'};

}

sub script {
    my $self = shift;
    my ($script) = validate_params(\@_, [
        { optional => 1, default => undef }
    ]);

    $self->{'script'} = $script if (defined($script));

    return $self->{'script'};

}

sub get_msgs {
    my $self = shift;

    return $self->class->var('MESSAGES');

}

# ------------------------------------------------------------------------
# Private Methods
# ------------------------------------------------------------------------

sub _load_msgs {
    my $self = shift;

    my $messages = $self->class->any_var('MESSAGES');

    foreach my $path (@INC) {

        my $dir = Dir($path, 'XAS');

        if ($dir->exists) {

            dir_walk(
                -directory => $dir,
                -filter    => $self->msgs,
                -callback  => sub {
                    my $file = shift;

                    my $cfg = Config::IniFiles->new(-file => $file->path);
                    if (my @names = $cfg->Parameters('messages')) {

                        foreach my $name (@names) {

                            $messages->{$name} = $cfg->val('messages', $name);

                        }

                    }

                }
            );

        }

    }

    $self->class->var('MESSAGES', $messages);

}

sub init {
    my $self = shift;

    my $temp;
    my $name;
    my $path;
    my $suffix;
    my $commandline = $0;
    my ($script) = ( $commandline =~ m#([^\\/]+)$# );

    foreach (@ARGV) {
        $commandline .= /\s/
          ? " \'" . $_ . "\'"
          : " "   . $_;
    }

    # set some defaults

    $self->{'alerts'} = 1;
    $self->{'xdebug'} = 0;
    $self->{'mxtimeout'} = 60;
    $self->{'script'} = $script;
    $self->{'path'} = $ENV{'PATH'};
    $self->{'commandline'} = $commandline;

    # Initialize variables - these are defaults

    $self->{'mqserver'} = defined($ENV{'XAS_MQSERVER'})
        ? $ENV{'XAS_MQSERVER'}
        : 'localhost';

    $self->{'mqport'} = defined($ENV{'XAS_MQPORT'})
        ? $ENV{'XAS_MQPORT'}
        : '61613';

    $self->{'mqlevel'} = defined ($ENV{'XAS_MQLEVEL'})
        ? $ENV{'XAS_MQLEVEL'}
        : '1.0';

    $self->{'mxserver'} = defined($ENV{'XAS_MXSERVER'})
        ? $ENV{'XAS_MXSERVER'}
        : 'localhost';

    $self->{'mxport'} = defined($ENV{'XAS_MXPORT'})
        ? $ENV{'XAS_MXPORT'}
        : '25';

    $self->{'domain'} = defined($ENV{'XAS_DOMAIN'})
        ? $ENV{'XAS_DOMAIN'}
        : hostdomain();

    $self->{'msgs'} = defined($ENV{'XAS_MSGS'})
        ? qr/$ENV{'XAS_MSGS'}/i
        : qr/.*\.msg$/i;

    $self->{'throws'} = defined($ENV{'XAS_ERR_THROWS'})
        ? $ENV{'XAS_ERR_THROWS'}
        : 'xas';

    $self->{'priority'} = defined($ENV{'XAS_ERR_PRIORITY'})
        ? $ENV{'XAS_ERR_PRIORITY'}
        : 'low';

    $self->{'facility'} = defined($ENV{'XAS_ERR_FACILITY'})
        ? $ENV{'XAS_ERR_FACILITY'}
        : 'systems';

    # platform specific

    my $OS = $^O;

    if ($OS eq "MSWin32") {

        require Win32;

        $self->{'host'} = defined($ENV{'XAS_HOSTNAME'})
            ? $ENV{'XAS_HOSTNAME'}
            : Win32::NodeName();

        $self->{'root'} = Dir(defined($ENV{'XAS_ROOT'})
            ? $ENV{'XAS_ROOT'}
            : ['C:', 'XAS']);

        $self->{'etc'} = Dir(defined($ENV{'XAS_ETC'})
            ? $ENV{'XAS_ETC'}
            : [$self->{root}, 'etc']);

        $self->{'tmp'} = Dir(defined($ENV{'XAS_TMP'})
            ? $ENV{'XAS_TMP'}
            : [$self->{root}, 'tmp']);

        $self->{'var'} = Dir(defined($ENV{'XAS_VAR'})
            ? $ENV{'XAS_VAR'}
            : [$self->{root}, 'var']);

        $self->{'lib'} = Dir(defined($ENV{'XAS_LIB'})
            ? $ENV{'XAS_LIB'}
            : [$self->{root}, 'var', 'lib']);

        $self->{'log'} = Dir(defined($ENV{'XAS_LOG'})
            ? $ENV{'XAS_LOG'}
            : [$self->{root}, 'var', 'log']);

        $self->{'locks'} = Dir(defined($ENV{'XAS_LOCKS'})
            ? $ENV{'XAS_LOCKS'}
            : [$self->{root}, 'var', 'lock']);

        $self->{'run'} = Dir(defined($ENV{'XAS_RUN'})
            ? $ENV{'XAS_RUN'}
            : [$self->{root}, 'var', 'run']);

        $self->{'spool'} = Dir(defined($ENV{'XAS_SPOOL'})
            ? $ENV{'XAS_SPOOL'}
            : [$self->{root}, 'var', 'spool']);

        $self->{'mxmailer'}  = defined($ENV{'XAS_MXMAILER'})
            ? $ENV{'XAS_MXMAILER'}
            : 'smtp';

        $self->{'username'} = Win32::LoginName();

    } else {

        # this assumes a unix like working environment

        $self->{'host'} = defined($ENV{'XAS_HOSTNAME'})
            ? $ENV{'XAS_HOSTNAME'}
            : `hostname -s`;

        chomp($self->{'host'});

        $self->{'root'} = Dir(defined($ENV{'XAS_ROOT'})
            ? $ENV{'XAS_ROOT'}
            : ['/']);

        $self->{'etc'} = Dir(defined($ENV{'XAS_ETC'})
            ? $ENV{'XAS_ETC'}
            : [$self->{root}, 'etc', 'xas']);

        $self->{'tmp'} = Dir(defined($ENV{'XAS_TMP'})
            ? $ENV{'XAS_TMP'}
            : ['/', 'tmp']);

        $self->{'var'} = Dir(defined($ENV{'XAS_VAR'})
            ? $ENV{'XAS_VAR'}
            : [$self->{root}, 'var']);

        $self->{'lib'} = Dir(defined($ENV{'XAS_LIB'})
            ? $ENV{'XAS_LIB'}
            : [$self->{root}, 'var', 'lib', 'xas']);

        $self->{'log'} = Dir(defined($ENV{'XAS_LOG'})
            ? $ENV{'XAS_LOG'}
            : [$self->{root}, 'var', 'log', 'xas']);

        $self->{'locks'} = Dir(defined($ENV{'XAS_LOCKS'})
            ? $ENV{'XAS_LOCKS'}
            : [$self->{root}, 'var', 'lock', 'xas']);

        $self->{'run'} = Dir(defined($ENV{'XAS_RUN'})
            ? $ENV{'XAS_RUN'}
            : [$self->{root}, 'var', 'run', 'xas']);

        $self->{'spool'} = Dir(defined($ENV{'XAS_SPOOL'})
            ? $ENV{'XAS_SPOOL'}
            : [$self->{root}, 'var', 'spool', 'xas']);

        $self->{'mxmailer'}  = defined($ENV{'XAS_MXMAILER'})
          ? $ENV{'XAS_MXMAILER'}
          : 'sendmail';

        $self->{'username'} = getpwuid($<);

    }

    # build some common paths

    $self->{'sbin'} = Dir(defined($ENV{'XAS_SBIN'})
        ? $ENV{'XAS_SBIN'}
        : [$self->{'root'}, 'sbin']);

    $self->{'bin'} = Dir(defined($ENV{'XAS_BIN'})
        ? $ENV{'XAS_BIN'}
        : [$self->{'root'}, 'bin']);

    # define some logging options

    $self->{'log_type'} = defined($ENV{'XAS_LOG_TYPE'})
        ? $ENV{'XAS_LOG_TYPE'}
        : 'console';

    $self->{'log_facility'} = defined($ENV{'XAS_LOG_FACILITY'})
        ? $ENV{'XAS_LOG_FACILITY'}
        : 'local6';

    # create some common file names

    ($name, $path, $suffix) = fileparse($0, qr{\..*});

    $self->{'log_file'} = File($self->{'log'}, $name . '.log');
    $self->{'pid_file'} = File($self->{'run'}, $name . '.pid');
    $self->{'cfg_file'} = File($self->{'etc'}, $name . '.ini');

    # build some methods, saves typing

    for my $datum (qw( log_file pid_file cfg_file )) {

        $self->class->methods($datum => sub {
            my $self = shift;
            my ($p) = validate_params(\@_, [
                    {optional => 1, default => undef, isa => 'Badger::Filesystem::File' }
                ],
                "xas.lib.modules.environment.$datum"
            );

            $self->{$datum} = $p if (defined($p));

            return $self->{$datum};

        });

    }

    for my $datum (qw( root etc sbin tmp var bin lib log locks run spool )) {

        $self->class->methods($datum => sub {
            my $self = shift;
            my ($p) = validate_params(\@_, [
                    {optional => 1, default => undef, isa => 'Badger::Filesystem::Directory'}
                ],
                "xas.lib.modules.environment.$datum"
            );

            $self->{$datum} = $p if (defined($p));

            return $self->{$datum};

        });

    }

    $self->_load_msgs();

    return $self;

}

1;

__END__