view release on metacpan or  search on metacpan

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

                app.yaml
            )
        ) ],
    );

    return ( length $root_dir and length $config_file ) ? ( $root_dir, $config_file ) : undef;
}

sub _add_to_inc {
    my ( $root_dir, @libs ) = @_;

    for my $lib ( map { $root_dir . '/' . $_ } @libs ) {
        unshift( @INC, $lib ) unless ( grep { $_ eq $lib } @INC );
    }

    return;
}

sub import {
    my $self = shift;

    my ( $root_dir, $config_file, @libs );
    for ( @_, undef ) {
        my @locate_root_config = _locate_root_config($_);

        unless ( $locate_root_config[0] ) {
            push( @libs, $_ );
        }
        elsif ( not $root_dir ) {
            ( $root_dir, $config_file ) = @locate_root_config;
        }
    }

    die "Config::App unable to locate configuration file\n" unless ($config_file);

    _add_to_inc( $root_dir, ( @libs || 'lib' ) ) if $root_dir;

    my $error = do {
        local $@;
        eval { $self->new($config_file) };
        $@;
    };
    chomp($error);
    die $error . "\n" if $error;

    return;
}

{
    my $singleton;

    sub new {
        my ( $self, $location, $no_singleton ) = @_;
        return $singleton if ( not $no_singleton and $singleton );

        ( my $box = ( POSIX::uname )[1] ) =~ s/\..*$//;
        my $conf  = {};

        _process_location({
            box      => $box,
            user     => getpwuid($>) || POSIX::cuserid,
            env      => $ENV{CONFIGAPPENV},
            conf     => $conf,
            optional => 0,
            location => $location,
        });

        $self      = bless( { _conf => $conf }, $self );
        $singleton = $self unless $no_singleton;

        if ( my $libs = $self->get('libs') ) {
           _add_to_inc(
                $self->root_dir,
                ( ref $libs eq 'ARRAY' ) ? @$libs : $libs,
            );
        }

        return $self;
    }

    sub deimport {
        my $self = shift;

        delete $self->{_conf} if ( __PACKAGE__ eq ref $self );
        $singleton = undef;

        {
            no strict 'refs';
            @{ __PACKAGE__ . '::ISA' } = ();
            my $symbol_table = __PACKAGE__ . '::';
            for my $symbol ( keys %$symbol_table ) {
                next if ( $symbol =~ /\A[^:]+::\z/ );
                delete $symbol_table->{$symbol};
            }
        }

        delete $INC{ join( '/', split qr{(?:'|::)}, __PACKAGE__ ) . '.pm' };

        return;
    }
}

sub find {
    my $class = shift;

    my $self;
    local $@;
    eval {
        $self = $class->new(@_);
    };
    if ($@) {
        return;
    }

    return $self;
}

sub root_dir {
    my ($self) = @_;
    return $self->get( qw( config_app root_dir ) );
}