view release on metacpan or  search on metacpan

lib/CTK/Configuration.pm  view on Meta::CPAN

    my $root = getcwd();
    my $confdir;
    if ($mydir) {
        $confdir = File::Spec->file_name_is_absolute($mydir)
            ? $mydir
            : File::Spec->catdir($root, $mydir);
        push (@dirs, $root) unless File::Spec->file_name_is_absolute($mydir);
    } else {
        $confdir = File::Spec->catdir($root, CONF_DIR);
        push (@dirs, $root);
    }
    push(@dirs, $confdir) if length($confdir);
    push(@dirs, CONF_DIR) if $confdir ne CONF_DIR;
    $self->{dirs} = [@dirs];

    # Set files
    my $fileconf = $args{config} // $args{file} // $args{fileconf};
    unless ($fileconf) {
        $self->{error} = "Config file not specified";
        return $self;
    }
    $fileconf = File::Spec->catfile($root, $fileconf)
        unless File::Spec->file_name_is_absolute($fileconf);
    $self->{files} = [$fileconf];
    unless (-e $fileconf) {
        $self->{error} = sprintf("Config file not found: %s", $fileconf);
        return $self;
    }

    # Options
    my $tmpopts = $args{options} || {};
    my %options = %$tmpopts;
    $options{"-ConfigFile"}         = $fileconf;
    $options{"-ConfigPath"}         ||= [@dirs];
    $options{"-ApacheCompatible"}   = 1 unless exists $options{"-ApacheCompatible"};
    $options{"-LowerCaseNames"}     = 1 unless exists $options{"-LowerCaseNames"};
    $options{"-AutoTrue"}           = 1 unless exists $options{"-AutoTrue"};
    $self->{orig} = {%options};

    return $self if $args{no_autoload};
    return $self->load;
}
sub load {
    my $self = shift;
    my $orig = $self->{orig} || {};
    $self->{error} = "";

    # Loading
    my $cfg;
    try {
        $cfg = Config::General->new( %$orig );
    } catch {
        $self->{error} = $_ // '';
    };
    return $self if length($self->{error});

    # Ok
    my %newconfig = $cfg->getall if $cfg && $cfg->can('getall');
    $self->{files} = [$cfg->files] if $cfg && $cfg->can('files');

    # Set only unlocked keys
    my %lkeys = ();
    foreach my $k (@{(LOCKED_KEYS)}) { $lkeys{$k} = 1 }
    foreach my $k (keys(%newconfig)) { $self->{conf}->{$k} = $newconfig{$k} if $k && !$lkeys{$k} }

    # Set statuses
    $self->{status} = 1;
    $self->{conf}->{loadstatus} = 1;

    return $self;
}
sub reload {
    my $self = shift;

    # Flush settings
    $self->{conf} = {
        hitime      => $self->{myhitime},
        loadstatus  => 0,
    };

    return $self->load;
}
sub error {
    my $self = shift;
    return $self->{error} // '';
}
sub status {
    my $self = shift;
    return $self->{status} ? 1 : 0;
}
sub set {
    my $self = shift;
    my $key = shift;
    return undef unless defined($key) && length($key);
    my $val = shift;
    $self->{conf}->{$key} = $val;
}
sub get {
    my $self = shift;
    my $key = shift;
    return undef unless defined($key) && length($key);
    return $self->{conf}->{$key};
}
sub getall {
    my $self = shift;
    return $self->{conf};
}
sub conf {
    my $self = shift;
    my $key  = shift;
    return undef unless $self->{conf};
    return $self->{conf} unless defined $key;
    return $self->{conf}->{$key};
}

1;

__END__