File Coverage

blib/lib/Config/PlConfig.pm

Criterion	Covered	Total	%
statement	72	91	79.1
branch	8	18	44.4
condition	0	3	0.0
subroutine	17	18	94.4
pod	4	5	80.0
total	101	135	74.8

# $Id$
# $Source$
# $Author$
# $HeadURL$
# $Revision$
# $Date$
package Config::PlConfig;
use warnings;
use strict;
use 5.006001;
use Carp;
use version; our $VERSION = qv('0.1_02');
{

    use Class::Dot   qw(property isa_String isa_Data isa_Hash isa_Int isa_Object);
    use Config::PlConfig::Constants;
    use Config::PlConfig::Host::Local;
    use Config::PlConfig::Host::Global;
    use Config::PlConfig::DotScheme;
    use YAML::Syck   qw(LoadFile DumpFile);
    use Params::Util qw(_CODELIKE);

    my %HOST_TO_CLASS = (
        'local'     => 'Config::PlConfig::Host::Local',
        'global'    => 'Config::PlConfig::Host::Global',
    );

    property domain     => isa_String('system.DEFAULT');
    property host       => isa_Data();
    property options    => isa_Hash();
    property config     => isa_Hash();
    property autosave   => isa_Int(0);
    property dotscheme  => isa_Object;

    my $GLOBAL_AUTOSAVE = 0;

    my %EXPORT_TAGS     = (
        ':autosave'         => sub {
            $GLOBAL_AUTOSAVE = 1;
        },
    );

    sub import {
        shift;
        return if not scalar @_;
        my $caller = caller 0;

        ARG:
        for my $arg (@_) {
            if (exists $EXPORT_TAGS{$arg}) {
                my $handler = $EXPORT_TAGS{$arg};
                if (_CODELIKE($handler)) {
                    $handler->($caller);
                }
                next ARG;
            }
            require Carp;
            my @msg = "No such export tag: $arg.";
            my $alt = ":$arg";
            if ($EXPORT_TAGS{$alt}) {
                push @msg, "Did you mean $alt?";
            };
            my $msg = join q{ }, @msg;
            Carp::croak($msg);
        }

        return;
    }

    sub new {
        my ($class, $options_ref) = @_;
        my $self = { };
        bless $self, $class;

        my $DEFAULT_HOST = Config::PlConfig::Constants->get(
           'DEFAULT_HOST'
        );

        my $host_class = $options_ref->{host}
                ? $HOST_TO_CLASS{ lc $options_ref->{host} }
                : $HOST_TO_CLASS{ lc $DEFAULT_HOST        };
        my $host = $host_class->new($options_ref);

        if ($options_ref->{domain}) {
            $self->set_domain( $options_ref->{domain} );
        }

        my $dotscheme = Config::PlConfig::DotScheme->new({
            plconfig => $self,
            dumper   => $options_ref->{dumper},
        });


        $self->set_host($host);
        $self->set_options($options_ref);
        $self->set_dotscheme($dotscheme);

        $self->load( );

        return $self;
    }

    sub get {
        my ($self, $key) = @_;
        my $config       = $self->config;

        return $config->{$key};
    }

    sub load {
        my ($self) = @_;
        my $host   = $self->host;
        my $domain = $self->domain;
        my $cfile  = $host->file_for_domain($domain);

        if (! -f $cfile) {
            return;
        }

        my $config_ref = YAML::Syck::LoadFile($cfile);
        $self->set_config($config_ref);

        return $config_ref;
    }

    sub save {
        my ($self, $opt_config) = @_;
        my $host   = $self->host;
        my $domain = $self->domain;
        my $config = $self->config;
        my $cfile  = $host->file_for_domain($domain);

        if ($opt_config) {
            $config = $opt_config;
        }

        return YAML::Syck::DumpFile($cfile, $config);
    }

    sub DEMOLISH {
        my ($self) = @_;

        if ($GLOBAL_AUTOSAVE || $self->autosave) {
            $self->save( );
        }

        return;
    }
}

1; # Magic true value required at end of module
__END__