view release on metacpan or  search on metacpan

lib/Config/INI/RefVars.pm  view on Meta::CPAN

        $sect_vars->{$var_name} .= " "
          . ($exp_flag ? $self->$_expand_value($curr_section, $value) : $value);
      }
      else {
        $sect_vars->{$var_name} = $value;
      }
    }
    elsif ($modifier eq '.') {
      $sect_vars->{$var_name} = ($sect_vars->{$var_name} // "")
        . ($exp_flag ? $self->$_expand_value($curr_section, $value) : $value);
    }
    elsif ($modifier eq ':') {
      delete $expanded->{$x_var_name} if $exp_flag;
      $sect_vars->{$var_name} = $self->$_expand_vars($curr_section, $var_name, $value, undef, 1);
    }
    elsif ($modifier eq '+>') {
      if (exists($sect_vars->{$var_name})) {
        $sect_vars->{$var_name} =
          ($exp_flag ? $self->$_expand_value($curr_section, $value) : $value)
          . ' ' . $sect_vars->{$var_name};
      }
      else {
        $sect_vars->{$var_name} = $value;
      }
    }
    elsif ($modifier eq '.>') {
      $sect_vars->{$var_name} = ($exp_flag ? $self->$_expand_value($curr_section, $value) : $value)
        . ($sect_vars->{$var_name} // "");
    }
    else {
      $_fatal->("'$modifier': unsupported modifier");
    }
  }
  return ($tocopy_sec_declared, $curr_section);
};


sub parse_ini {
  my $self = shift;
  my %args = (cleanup => 1, @_);

  state $allowed_keys = {
    map { $_ => undef } qw(cleanup src src_name tocopy_section tocopy_vars not_tocopy)
  };
  state $dflt_src_name = "INI data";

  _check_args(\%args, $allowed_keys);

  foreach my $scalar_arg (qw(tocopy_section src_name)) {
    croak("'$scalar_arg': must not be a reference") if ref($args{$scalar_arg});
  }

  delete $self->{+SRC_NAME} if exists($self->{+SRC_NAME});
  $self->{+SRC_NAME} = $args{src_name} if exists($args{src_name});

  my ($cleanup, $src, $tocopy_section, $tocopy_vars, $not_tocopy)
    = @args{qw(cleanup src tocopy_section tocopy_vars not_tocopy)};

  croak("'src': missing mandatory argument") if !defined($src);

  my $backup = $self->{+BACKUP} //= {};

  if (defined($tocopy_section)) {
    $backup->{tocopy_section} = $self->{+TOCOPY_SECTION};
    $self->{+TOCOPY_SECTION}  = $tocopy_section;
  }
  else {
    $tocopy_section = $self->{+TOCOPY_SECTION};
  }

  $self->{+CURR_TOCP_SECTION} = $tocopy_section;
  $Globals{'=TO_CP_SEC'}      = $tocopy_section;

  if ($tocopy_vars) {
    $backup->{tocopy_vars} = $self->{+TOCOPY_VARS};
    $self->$_check_tocopy_vars($tocopy_vars, 1);
  }

  if ($not_tocopy) {
    $backup->{not_tocopy} = $self->{+NOT_TOCOPY};
    $self->$_check_not_tocopy($not_tocopy, 1);
  }

  $self->{+SECTIONS}   = [];
  $self->{+SECTIONS_H} = {};
  $self->{+EXPANDED}   = {};
  $self->{+VARIABLES}  = {
    $tocopy_section => ($self->{+TOCOPY_VARS} ? {%{$self->{+TOCOPY_VARS}}} : {})
  };
  $self->{+FUNCTIONS} = {};

  my $global_vars     = $self->{+GLOBAL_VARS} = {%Globals};
  my $variables       = $self->{+VARIABLES};
  my $tocopy_sec_vars = $variables->{$tocopy_section};

  if (my $ref_src = ref($src)) {
    $self->{+SRC_NAME} = $dflt_src_name if !exists($self->{+SRC_NAME});

    if ($ref_src eq 'ARRAY') {
      $src = [@$src];
      foreach my $entry (@$src) {
        croak("'src': unexpected ref type in array") if ref($entry);
        if (!defined($entry)) {
          carp("'src': undef entry - treated as empty string");
          $entry = "";
        }
      }
    }
    else {
      croak("'src': $ref_src: ref type not allowed");
    }
  }
  else {
    if (index($src, "\n") < 0) {
      my $path = $src;
      my $abs_path = abs_path($path) or croak("'$path': cannot resolve file name");
      $src = $_read_ini_file->($abs_path);
      $self->{+SRC_NAME} = $path if !exists($self->{+SRC_NAME});

      my ($vol, $dirs, $file) = splitpath($abs_path);
      @{$global_vars}{'=INIfile', '=INIdir'} = ($file,
                                                catdir(length($vol // "") ? $vol : (), $dirs),
                                               );
    }
    else {
      $src = [split(/\n/, $src)];
      $self->{+SRC_NAME} = $dflt_src_name if !exists($self->{+SRC_NAME});
    }
  }

  $global_vars->{'=srcname'} = $self->{+SRC_NAME};

  my $src_dir = '.';
  my $include_stack = {};

  if (!ref($args{src}) && index($args{src}, "\n") < 0) {
    my $abs_path = abs_path($args{src})
      or croak("'$args{src}': cannot resolve file name");
    $include_stack->{$abs_path} = undef;
    my ($vol, $dirs) = splitpath($abs_path);
    $src_dir = catdir(length($vol // "") ? $vol : (), $dirs);
  }

  my ($tocopy_sec_declared, undef) = $self->$_parse_ini($src,
                                                        undef,
                                                        $include_stack,
                                                        $src_dir,
                                                        $self->{+SRC_NAME},
                                                       );

  my @sections = ((exists($self->{+SECTIONS_H}{$tocopy_section}) ? () : $tocopy_section),
                  @{$self->{+SECTIONS}},
                 );

  foreach my $section (@sections) {
    my $sec_vars = $variables->{$section};

    foreach my $variable (keys(%$sec_vars)) {
      my $value = $sec_vars->{$variable};
      $sec_vars->{$variable} = $self->$_expand_vars($section, $variable, $value);
    }
  }

  if ($cleanup) {
    foreach my $section (keys(%$variables)) {
      my $sec_vars = $variables->{$section};
      foreach my $var (keys(%$sec_vars)) {
        delete $sec_vars->{$var} if index($var, '=') >= 0;
      }
    }

    delete $variables->{$self->{+TOCOPY_SECTION}} if (!$tocopy_sec_declared && !%$tocopy_sec_vars);
  }
  else {
    if ($self->{+GLOBAL_MODE}) {
      foreach my $section (keys(%$variables)) {
        my $sec_vars = $variables->{$section};
        $sec_vars->{'='} = $section;
      }
      @{$tocopy_sec_vars}{keys(%$global_vars)} = values(%$global_vars);
    }
    else {
      foreach my $section (keys(%$variables)) {
        my $sec_vars = $variables->{$section};
        $sec_vars->{'='} = $section;
        @{$sec_vars}{keys(%$global_vars)} = values(%$global_vars);
      }
    }
  }

  $self->{+TOCOPY_SECTION} = $backup->{tocopy_section} if exists($backup->{tocopy_section});
  $self->{+TOCOPY_VARS}    = $backup->{tocopy_vars}    if exists($backup->{tocopy_vars});
  $self->{+NOT_TOCOPY}     = $backup->{not_tocopy}     if exists($backup->{not_tocopy});
  $backup = {};

  return $self;
}


sub current_tocopy_section { $_[0]->{+CURR_TOCP_SECTION} }
sub tocopy_section         { $_[0]->{+TOCOPY_SECTION} }
sub global_mode            { $_[0]->{+GLOBAL_MODE} }

sub sections {
  return defined($_[0]->{+SECTIONS}) ? [@{$_[0]->{+SECTIONS}}] : undef;
}

sub sections_h {
  return defined($_[0]->{+SECTIONS_H}) ? +{ %{$_[0]->{+SECTIONS_H}} } : undef;
}

sub separator { $_[0]->{+SEPARATOR} }
sub src_name  { $_[0]->{+SRC_NAME} }


sub variables {
  my $vars = $_[0]->{+VARIABLES} // return undef;
  return { map { $_ => {%{$vars->{$_}}} } keys(%$vars) };
}


$_look_up = sub {
  my ($self, $curr_sect, $variable) = @_;
  my $matched = $variable =~ $self->{+VREF_RE};
  my ($v_section, $v_basename) = $matched ? ($1, $2) : ($curr_sect, $variable);
  my $v_value;
  my $variables      = $self->{+VARIABLES};
  my $tocopy_section = $self->{+TOCOPY_SECTION};
  if (!exists($variables->{$v_section})) {
    $v_value = "";
  }
  elsif (exists($variables->{$v_section}{$v_basename})) {
    $v_value = $variables->{$v_section}{$v_basename};
  }
  elsif ($v_basename !~ /\S/) {
    $v_value = $v_basename;
  }
  elsif ($v_basename eq '=') {
    $v_value = $v_section;
  }
  elsif ($v_basename =~ /^=(?:ENV|env):\s*(.*)$/) {
    $v_value = $ENV{$1} // "";
  }
  elsif ($v_basename =~ /^=CONFIG:\s*(.*)$/) {
    $v_value = $Config{$1} // "";
  }
  elsif (exists($self->{+GLOBAL_VARS}{$v_basename})) {
    $v_value = $self->{+GLOBAL_VARS}{$v_basename};
  }
  elsif ($self->{+GLOBAL_MODE} && exists($variables->{$tocopy_section}{$v_basename})) {
    if (!$matched
        && $curr_sect ne $tocopy_section
        && exists($self->{+NOT_TOCOPY}{$v_basename})
       ) {