view release on metacpan or  search on metacpan

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

            } ## end if ( -d $loc . '/conf.d')
        } ## end elsif ( -d $loc )
        elsif ( -e $loc ) {
            if ( $self->_is_legacy_config($loc) ) {
                push( @legacy_files, $loc );
            }
            else {
                push( @files, $loc );
            }
        } ## end if ( -e $loc )
    } ## end foreach my $loc ( @{ $self->locations...})
    ## no critic (RequireCheckedSyscalls)
    print '_init_config - glob()ed these files: ' . join( q{:}, @files ) . "\n" if $self->debug();
    print '_init_config - glob()ed these legacy files: ' . join( q{:}, @legacy_files ) . "\n" if $self->debug();
    ## use critic
    my $cfg = {};
    $cfg = $self->_load_legacy_config( [@legacy_files], $cfg );
    foreach my $file (@files) {
        $cfg = $self->_load_config( [$file], $cfg );
    }
    return $cfg;
} ## end sub _init_data

sub _is_legacy_config {
    my $self = shift;
    my $file = shift;

    my $is_legacy = 0;
    if ( -e $file && open( my $FH, '<', $file ) ) {
        my @lines = <$FH>;
        close($FH);
        foreach my $line (@lines) {
            if ( $line =~ m/^\[/ ) {    # ini-style config, old
                $is_legacy = 1;
                last;
            }
            elsif ( $line =~ m/^\s*</ ) {    # pseudo-XML config, new
                $is_legacy = 0;
                last;
            }
        } ## end foreach my $line (@lines)

    } ## end if ( -e $file && open(...))
    return $is_legacy;
} ## end sub _is_legacy_config

sub _load_legacy_config {
    my $self      = shift;
    my $files_ref = shift;
    my $cfg       = shift || {};

    Hash::Merge::set_behavior('RETAINMENT_PRECEDENT');
    foreach my $file ( @{$files_ref} ) {
        if ( -e $file ) {
            try {
                my $Config = Config::Tiny::->read($file);
                print '_load_legacy_config - Loaded ' . $file . "\n" if $self->debug();
                Data::Structure::Util::unbless($Config);
                $cfg = Hash::Merge::merge( $cfg, $Config );
                ## no critic (ProhibitMagicNumbers)
                my $last_ts = ( stat($file) )[9];
                ## use critic
                $self->last_ts($last_ts) if $last_ts > $self->last_ts();
                1;
            } ## end try
            catch {
                warn "Loading $file failed: $_\n" if $self->debug();
            };
        } ## end if ( -e $file )
    } ## end foreach my $file ( @{$files_ref...})
    return $cfg;
} ## end sub _load_legacy_config

sub _load_config {
    my $self      = shift;
    my $files_ref = shift;
    my $ccfg      = shift || {};

    ## no critic (ProhibitNoWarnings)
    no warnings 'once';
    ## no critic (ProhibitTwoArgOpen ProhibitBarewordFileHandles RequireBriefOpen ProhibitUnixDevNull)
    if(!$self->debug()) {
        open( OLD_STDERR, '>&STDERR' )
          or die('Failed to save STDERR');
        open( STDERR, '>', '/dev/null' )
          or die('Failed to redirect STDERR');
    }
    ## use critic
    my $cfg     = {};
    my $success = try {
        $cfg = Config::Any->load_files(
            {
                files       => $files_ref,
                use_ext     => 1,
                driver_args => {

                    # see http://search.cpan.org/~tlinden/Config-General-2.50/General.pm
                    General => {
                        -UseApacheInclude      => 0,
                        -IncludeRelative       => 0,
                        -IncludeDirectories    => 0,
                        -IncludeGlob           => 0,
                        -SplitPolicy           => 'equalsign',
                        -CComments             => 0,
                        -AutoTrue              => 1,
                        -MergeDuplicateBlocks  => 1,
                        -MergeDuplicateOptions => 0,
                        -LowerCaseNames        => 1,
                        -UTF8                  => 1,
                    },
                },
                flatten_to_hash => 1,
            },
        );
        1;
    } ## end try
    catch {
        print 'Loading ' . join( q{:}, @{$files_ref} ) . " failed: $_\n" if $self->debug();
    };
    return $ccfg unless $success;

    ## no critic (ProhibitTwoArgOpen)
    if(!$self->debug()) {
        open( STDERR, '>&OLD_STDERR' );
    }
    use warnings 'once';
    ## use critic
    Hash::Merge::set_behavior('RETAINMENT_PRECEDENT');

    # older versions of Config::Any don't know flatten_to_hash,
    # they'll always return an array of hashes, so we'll
    # transform them here
    if ( ref($cfg) eq 'ARRAY' ) {
        my $ncfg = {};
        foreach my $c ( @{$cfg} ) {
            foreach my $file ( keys %{$c} ) {
                $ncfg->{$file} = $c->{$file};
            }
        }
        $cfg = $ncfg;
    } ## end if ( ref($cfg) eq 'ARRAY')
    if ( ref($cfg) eq 'HASH' ) {
        foreach my $file ( keys %{$cfg} ) {
            print "_load_config - Loaded $file\n" if $self->debug();
            push(@{$self->files_read()},$file);
            $ccfg = Hash::Merge::merge( $ccfg, $cfg->{$file} );
            ## no critic (ProhibitMagicNumbers)
            my $last_ts = ( stat($file) )[9];
            ## use critic
            $self->last_ts($last_ts) if $last_ts > $self->last_ts();
        } ## end foreach my $file ( keys %{$cfg...})
    } ## end if ( ref($cfg) eq 'HASH')
    return $ccfg;
} ## end sub _load_config

############################################
# Usage      :
# Purpose    :
# Returns    :
# Parameters :
# Throws     : no exceptions
# Comments   : none
# See Also   : n/a
sub add_config {
    my $self = shift;
    my $file = shift;

    $self->config( Hash::Merge::merge( $self->config(), $self->_load_config( [$file] ) ) );
    return 1;
} ## end sub add_config

############################################
# Usage      :
# Purpose    :
# Returns    :
# Parameters :
# Throws     : no exceptions
# Comments   : none
# See Also   : n/a
sub reset_config {
    my $self = shift;

    $self->config( {} );

    return 1;
} ## end sub reset_config
## no critic (ProhibitBuiltinHomonyms)
sub dump {
    ## use critic
    my $self = shift;

    $Data::Dumper::Sortkeys = 1;
    return Dumper( $self->config() );
} ## end sub dump

no Moose;
__PACKAGE__->meta->make_immutable;

1;

__END__

=pod

=encoding utf-8

=head1 NAME