view release on metacpan or  search on metacpan

lib/App/CELL/Config.pm  view on Meta::CPAN

use Exporter qw( import );
our @EXPORT_OK = qw( $meta $core $site );

our $meta = bless { CELL_CONFTYPE => 'meta' }, __PACKAGE__;
our $core = bless { CELL_CONFTYPE => 'core' }, __PACKAGE__;
our $site = bless { CELL_CONFTYPE => 'site' }, __PACKAGE__;



=head1 SUBROUTINES


=head2 AUTOLOAD

The C<AUTOLOAD> routine handles calls that look like this:
   $meta->MY_PARAM
   $core->MY_PARAM
   $site->MY_PARAM

=cut

our $AUTOLOAD;
sub AUTOLOAD {
    my $self = shift;
    ( my $param ) = $AUTOLOAD =~ m/.*::(.*)$/;
    return SUPER->DESTROY if $param eq 'DESTROY'; # for Perl <= 5.012
    my ( undef, $file, $line ) = caller;
    die "Bad call to Config.pm \$$param at $file line $line!" if not blessed $self;
    return _retrieve_param( $self->{'CELL_CONFTYPE'}, $param );
}

sub _retrieve_param {
    my ( $type, $param ) = @_;
    if ( $type eq 'meta' ) {
        return (exists $meta->{$param})
            ? $meta->{$param}->{Value}
            : undef;
    } elsif ( $type eq 'core' ) {
        return (exists $core->{$param})
            ? $core->{$param}->{Value}
            : undef;
    } elsif ( $type eq 'site' ) {
        if (exists $site->{$param}) {
            return $site->{$param}->{Value};
        } elsif (exists $core->{$param}) {
            return $core->{$param}->{Value};
        }
    }
    return;
}


=head2 DESTROY

For some reason, Perl 5.012 seems to want a DESTROY method

=cut 

sub DESTROY {
    my $self = shift;
    $self->SUPER::DESTROY if $self->can("SUPER::DESTROY");
}


=head2 exists

Determine parameter existence.

=cut

sub exists {
    my ( $self, $param ) = @_;
    my $type = $self->{'CELL_CONFTYPE'};

    my $bool;
    if ( $type eq 'meta' ) {
        $bool = exists $meta->{ $param };
    } elsif ( $type eq 'core' ) {
        $bool = exists $core->{ $param };
    } elsif ( $type eq 'site' ) {
        $bool = exists $site->{ $param };
        if ( ! $bool ) {
            $bool = exists $core->{ $param };
        }
    } else {
        die "AAAAAAAAAAGGAHHAGHHG! improper param type in exists routine";
    }
    return $bool;
}


=head2 get

Wrapper for get_param

=cut

sub get {
    my ( $self, $param ) = @_;
    return $self->get_param( $param );
}


=head2 get_param

Get value of config param provided in the argument.

=cut

sub get_param {
    my ( $self, $param ) = @_;
    my ( undef, $file, $line ) = caller;
    die "Bad call to Config.pm \$$param at $file line $line!" if not blessed $self;
    return _retrieve_param( $self->{'CELL_CONFTYPE'}, $param );
}


=head2 get_param_metadata

Routine to provide access not only to the value, but also to the metadata
(file and line number where parameter was defined) associated with a