File Coverage

blib/lib/Config/PlConfig/Host/Base.pm

Criterion	Covered	Total	%
statement	54	56	96.4
branch	3	6	50.0
condition	2	2	100.0
subroutine	14	15	93.3
pod	0	5	0.0
total	73	84	86.9

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

    use Class::Dot qw(property isa_String);
    use File::Path qw(mkpath);
    use File::Spec;
    use Config::PlConfig::Constants;

    property confdir => isa_String;

    my $RE_UNTAINT_DOMAIN = qr/
        \A                  # beginning of string.
        (                   # capture:
            [\w\d\.\+\-\_]+?    # any letter, digit, dot, plus-sign,
                                # minus-sign or underscore.
        )
        \z                  # end of string.
    /xms;

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

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

        my $confdir_parent = $self->locate_confdir_parent;
        my $confdir = File::Spec->catdir($confdir_parent, $CONF_DIRNAME);
        $self->set_confdir( $confdir );
        $self->init_confdir( );

        return $self;
    }

    sub file_for_domain {
        my ($self, $domain) = @_;

        $domain = $self->check_domain($domain) || return;
        my $DOMAINFILE_SUFFIX = Config::PlConfig::Constants->get(
            'DOMAINFILE_SUFFIX'
        );

        my $configfile = File::Spec->catfile(
            $self->confdir,
            $domain,
        );

        $configfile = join q{.}, $configfile, $DOMAINFILE_SUFFIX;

        return $configfile;
    }

    sub locate_confdir {
        croak 'Cannot use '. __PACKAGE__ . 'directly!';
    }

    sub check_domain {
        my ($self, $domain) = @_;

        if ($domain =~ $RE_UNTAINT_DOMAIN) {
            $domain = $1;
            return $domain;
        }

        #carp "Illegal domain name."; # TODO Error handling!.

        return;
    }

    sub init_confdir {
        my ($self)  = @_;
        my $confdir = $self->confdir;

        if (! -d $confdir) {
            mkpath($confdir) or return;
        }

        return 1;
    }
}

# Module implementation here


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