File Coverage

blib/lib/XAS/Base.pm

Criterion	Covered	Total	%
statement	15	52	28.8
branch	0	8	0.0
condition	0	6	0.0
subroutine	5	14	35.7
pod	1	1	100.0
total	21	81	25.9

package XAS::Base;

our $VERSION = '0.06';
our $EXCEPTION = 'XAS::Exception';

use XAS::Factory;
use XAS::Exception;

use XAS::Class
  debug    => 0,
  version  => $VERSION,
  base     => 'Badger::Base',
  utils    => ':validation xprintf dotid',
  import   => 'class',
  auto_can => '_auto_load',
  vars => {
    PARAMS => {
      -xdebug => { optional => 1, default => 0 }
    }
  }
;

#use Data::Dumper;

# ----------------------------------------------------------------------
# Overrides
# ----------------------------------------------------------------------

class('Badger::Base')->methods(
    message => sub {
        my $self = shift;
        my $name = shift
          || $self->fatal("message() called without format name");

        my $m1 = XAS::Base->env->get_msgs;
        my $m2 = $self->class->all_vars('MESSAGES');

        foreach my $h (@$m2) {

            while (my ($key, $value) = each(%$h)) {

                $m1->{$key} = $value;

            }

        }

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

        my $format = $self->class->hash_value('MESSAGES', $name)
          || $self->fatal("message() called with invalid message type: $name");

        xprintf($format, @_);

    }
);

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

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

sub _auto_load {
    my $self = shift;
    my $name = shift;

    if ($name eq 'alert') {

        return sub { XAS::Factory->module('alert'); }

    } elsif ($name eq 'email') {

        return sub { XAS::Factory->module('email'); }

    } elsif ($name eq 'log') {

        return sub { XAS::Factory->module('logger'); }

    } elsif ($name eq 'env') {

        return sub { XAS::Factory->module('environment'); }

    }

    my ($package, $filename, $line) = caller(2);
    $self->throw_msg(
        dotid($self->class) . '.auto_load.invmethod',
        'invmethod',
        $name, $filename, $line
    );

}

sub _create_methods {
    my $self = shift;
    my $p = shift;

    no strict "refs";               # to register new methods in package
    no warnings;                    # turn off warnings

    while (my ($key, $value) = each(%$p)) {

        $self->{$key} = $value;

        *$key = sub {
            my $self = shift;
            return $self->{$key};
        };

    }

}

sub init {
    my $self = shift;

    # process PARAMS

    my $class = $self->class;
    my $params = $self->class->hash_vars('PARAMS');
    my $p = validate_params(\@_, $params, $class);

    # build our object

    $self->{'config'} = $p;
    $self->_create_methods($p);

    return $self;

}

1;

__END__