view release on metacpan or  search on metacpan

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

        grep { defined } (
            map {
                $set->{ join( '|', ( grep { defined } @$_ ) ) }
            } (
                [ 'default'         ],
                [ '+',  '+',   '+'  ], [ '+',  '+'   ],  [ '+'  ],
                [ $box, '+',   '+'  ], [ $box, '+'   ],  [ $box ],
                [ '+',  $user, '+'  ], [ '+',  $user ],
                [ $box, $user, '+'  ], [ $box, $user ],
                [ '+',  '+',   $env ],
                [ '+',  $user, $env ],
                [ $box, '+',   $env ],
                [ $box, $user, $env ],
            )
        )
    );

    my $sub_process_location = sub {
        _process_location({
            box      => $input->{box},
            user     => $input->{user},
            env      => $input->{env},
            conf     => $input->{conf},
            sources  => $sources,
            location => $_[0],
            optional => $_[1],
            reverse  => $_[2],
        });
    };

    for (
        [ '',          'pre' ],
        [ 'optional_', 'pre' ],
        [ '',          ''    ],
        [ 'optional_', ''    ],
    ) {
        my $type = join( '', @$_, 'include' );
        $sub_process_location->( $set->{$type},                     @$_ ) if ( $set->{$type}           );
        $sub_process_location->( delete( $input->{conf}->{$type} ), @$_ ) if ( $input->{conf}->{$type} );
    }

    return;
}

{
    my $ua;

    sub _get_raw_config {
        my ($input) = @_;

        if ( URI->new( $input->{include} )->scheme ) {
            $ua ||= LWP::UserAgent->new(
                agent      => 'Config-App',
                cookie_jar => {},
                env_proxy  => 1,
            );

            my $res = $ua->get( $input->{include} );

            if ( $res->is_success ) {
                return $res->decoded_content;
            }
            else {
                croak 'Failed to get '
                    . join( ' -> ', map { "\"$_\"" } @{ $input->{sources} } )
                    . '; '
                    . $res->status_line
                    unless $input->{optional};
                return;
            }
        }
        else {
            unless ( $input->{include} ) {
                croak 'Failed to find ' .
                    join( ' -> ', map { "\"$_\"" } @{ $input->{sources} } )
                    unless $input->{optional};
                return;
            }
            else {
                open( my $include_fh, '<', $input->{include} )
                    or croak "Failed to read $input->{include}; $!";
                return join( '', <$include_fh> );
            }
        }
    }
}

{
    my $json_xs;

    sub _parse_config {
        my ($input) = @_;

        my @types = qw( yaml json );
        if ( $input->{include} =~ /\.yaml$/i or $input->{include} =~ /\.yml$/i ) {
            @types = ( 'yaml', grep { $_ ne 'yaml' } @types );
        }
        elsif ( $input->{include} =~ /\.json$/i or $input->{include} =~ /\.js$/i ) {
            @types = ( 'json', grep { $_ ne 'json' } @types );
        }

        my ( $config, @errors );
        for my $type (@types) {
            my $error = do {
                local $@;
                eval {
                    if ( $type eq 'json' ) {
                        $json_xs ||= JSON::XS->new
                            ->utf8
                            ->relaxed
                            ->allow_nonref
                            ->allow_unknown
                            ->allow_blessed
                            ->allow_tags;

                        $config = $json_xs->decode( $input->{raw_config} );
                    }
                    else {
                        $config = YAML::XS::Load( $input->{raw_config} );
                    }
                };