view release on metacpan or  search on metacpan

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

      { debug         => $options->{debug},
        warning_level => $options->{warning_level},
        logger        => $logger,
        %{$plugin_specific_config},
      }
    );

    if ($logger) {
      $logger->level($log_level);
    }

    $plugin_handlers{$protocol} = $plugin_obj;
  }

  my $final_handler_map = { %base_handlers, %plugin_handlers, %{$user_handlers}, };

  $self->set_handler_map($final_handler_map);

  return $self;
}

########################################################################
sub resolve_value {
########################################################################
  my ( $self, $value, $parameters ) = @_;

  my $handlers = $self->get_handler_map;

  # It checks for the "protocol" pattern first.
  if ( $value =~ /^(\w+):\/\/(.+)$/xsm ) {
    my ( $prefix, $path ) = ( $1, $2 );  # $prefix is the 'xxx'

    if ( my $handler = $handlers->{$prefix} ) {

      my $resolved_val;

      if ( reftype($handler) eq 'CODE' ) {
        $resolved_val = $handler->( $path, $parameters );
      }
      elsif ( blessed($handler) && $handler->can('resolve') ) {
        $resolved_val = $handler->resolve( $path, $parameters );
      }
      else {
        croak "Invalid handler for protocol '$prefix': "
          . 'handler must be a coderef or a blessed object '
          . q{that implements a 'resolve' method.};
      }

      # Handle errors/undefs
      die "could not resolve [$value]\n"
        if !defined $resolved_val && $self->get_warning_level eq 'error';

      # Return the resolved value, defaulting undef to empty string
      return ( $resolved_val // $EMPTY, $parameters );
    }

    # If no backend plugin exists, we can either 'croak' or just
    # fall through and treat it as a literal string.
  }

  if ( $value =~ /\$[{]([\S]+?)[}]/xsm ) {
    my %vars;

    while ( $value =~ /\$[{]([\S]+?)[}]/xsmg ) {
      my $p = $1;

      my $v = $self->get_parameter( $parameters, $p );

      {
        local $SIG{__DIE__} = 'DEFAULT';

        die "could not resolve [$p]\n"
          if !defined $v && $self->get_warning_level eq 'error';
      }

      $vars{$p} = $v;
    }

    foreach my $k ( keys %vars ) {
      if ( !exists $vars{$k} || !defined $vars{$k} ) {
        $vars{$k} = q{};
        print {*STDERR} "WARNING: $k is undefined!\n";
      }

      $value =~ s/\$[{]\Q$k\E[}]/$vars{$k}/xsmg;
    }
    return ( $value, $parameters );
  }

  if ( $value =~ /\$[{]([\S]+?)\s+([\w!=><]+)\s+(.+?)\s+\?\s+(.+?)\s+\:\s+(.+?)\s*[}]/ ) {
    my %dispatch_ops = (
      # Numeric
      q{==} => sub { $_[0] == $_[1] },
      q{!=} => sub { $_[0] != $_[1] },
      q{>}  => sub { $_[0] > $_[1] },
      q{<}  => sub { $_[0] < $_[1] },
      q{>=} => sub { $_[0] >= $_[1] },
      q{<=} => sub { $_[0] <= $_[1] },

      # String
      q{eq} => sub { $_[0] eq $_[1] },
      q{ne} => sub { $_[0] ne $_[1] },
      q{gt} => sub { $_[0] gt $_[1] },
      q{lt} => sub { $_[0] lt $_[1] },
      q{ge} => sub { $_[0] ge $_[1] },
      q{le} => sub { $_[0] le $_[1] },
    );

    # ternary
    my $lhs       = $self->get_parameter( $parameters, $1 );
    my $rhs       = $self->eval_arg( $3, $parameters );
    my $op        = $2;
    my $alt_true  = $self->eval_arg( $4, $parameters );
    my $alt_false = $self->eval_arg( $5, $parameters );

    croak "Invalid operator $op in ternary"
      if !exists $dispatch_ops{$op};

    my $is_true = $dispatch_ops{$op}->( $lhs, $rhs );
    my $val     = $is_true ? $alt_true : $alt_false;

    $value =~ s/\$[{]([\S]+?)\s+([\w!=><]+)\s+(.+?)\s+\?\s+(.+?)\s+\:\s+(.+?)\s*[}]/$val/;

    return ( $value, $parameters );
  }

  return ( $value, $parameters );
}

########################################################################
sub eval_arg {
########################################################################
  my ( $self, $arg, $parameters ) = @_;

  # 1. Is it a number? (e.g., 123)
  if ( looks_like_number($arg) ) {
    return $arg;
  }

  # 2. Is it a quoted string? (e.g., "prod-db" or 'dev-db')
  if ( $arg =~ / ^ (["']) (.*?) \1 $ /xsm ) {
    my $val = $2;  # Get the captured content

    # Un-escape any backslashed quotes
    $val =~ s/ \\ (["']) /$1/gx;

    return $val;
  }

  # 3. If it's not a number or quoted string, it must be a
  #    variable path (e.g., database.dev).
  return $self->get_parameter( $parameters, $arg );
}

########################################################################
sub _resolve_array {
########################################################################
  my ( $self, $obj, $parameters ) = @_;

  foreach my $val ( @{$obj} ) {
    ( $val, $parameters ) = $self->finalize_parameters( $val, $parameters );
  }

  return ( $obj, $parameters );
}

########################################################################
sub _resolve_hash {
########################################################################
  my ( $self, $obj, $parameters ) = @_;

  foreach my $key ( keys %{$obj} ) {
    my $val;

    ( $val, $parameters ) = $self->finalize_parameters( $obj->{$key}, $parameters );

    $obj->{$key} = $val;
  }

  return ( $obj, $parameters );
}