view release on metacpan or  search on metacpan

lib/Advanced/Config/Reader.pm  view on Meta::CPAN

# ==============================================================

=item $name = make_new_section ($config, $section)

This is a private method called by I<read_config> to create a new section
in the L<Advanced::Config> object if a section of that name doesn't already
exist.

The I<$section> name is allowed to contain variables to expand before the
string is used.  But those variables must be defined in the I<main> section.

Returns the name of the section found/created in lower case.

=cut

sub make_new_section
{
   DBUG_ENTER_FUNC (@_);
   my $config   = shift;
   my $new_name = shift;

   # Check if overriding the default section with a new name ...
   if ( $new_name eq "" || $new_name eq $global_sections{DEFAULT} ) {
      if ( $global_sections{DEFAULT} ne $global_sections{OVERRIDE} ) {
         DBUG_PRINT ("OVERRIDE", "Overriding section '%s' with section '%s'",
                     $new_name, $global_sections{OVERRIDE});
         $new_name = $global_sections{OVERRIDE};
      }
   }

   my $pcfg = $config->get_section ();    # Back to the main section ...

   my $val = expand_variables ($pcfg, $new_name, undef, undef, 1);
   $new_name = lc ( $val );

   # Check if the section name is already in use ...
   my $old = $pcfg->get_section ( $new_name );
   if ( $old ) {
      return DBUG_RETURN ( $old->section_name() );
   }

   # Create the new section now that we know it's name is unique ...
   my $scfg = $pcfg->create_section ( $new_name );

   if ( $scfg ) {
      return DBUG_RETURN ( $scfg->section_name () );
   }

   # Should never, ever happen ...
   DBUG_PRINT ("WARN", "Failed to create the new section: %s.", $new_name);

   DBUG_RETURN ("");    # This is the main/default section being returned.
}


# ==============================================================
# Allows a config file to run a random command when it's loaded into memory.
# Only allowed if explicity enabled & configured!
# Decided it's too dangerous to use, so never called outside of a POC example!
sub _execute_backquoted_cmd
{
   my $rOpts = shift;
   my $hide  = shift;
   my $tag   = shift;
   my $value = shift;

   return ( $value )  unless ( $rOpts->{enable_backquotes} );

   # Left & right backquotes ...
   my ($lbq, $rbq) = ( convert_to_regexp_string ($rOpts->{backquote_left}, 1),
                       convert_to_regexp_string ($rOpts->{backquote_right}, 1) );

   unless ( $value =~ m/^${lbq}(.*)${rbq}$/ ) {
      return ( $value );   # No balanced backquotes detected ...
   }
   my $cmd = $1;           # The command to run ...

   # DBUG_MASK_NEXT_FUNC_CALL (3)  if ( $hide );      # Never hide value (cmd to run)
   DBUG_ENTER_FUNC ($rOpts, $hide, $tag, $value, @_);
   DBUG_MASK (0)  if ( $hide );    # OK to hide the results.

   if ( $cmd =~ m/[`]/ ) {
      DBUG_PRINT ('INFO', 'Your command may not have backquotes (`) in it!');
   } elsif ( $cmd =~ m/^\s*$/ ) {
      DBUG_PRINT ('INFO', 'Your command must have a value!');

   } else {
      die ("Someone tried to run cmd: $cmd\n");
      # $value = `$cmd`;
      $value = ""  unless ( defined $value );
      chomp ($value);
   }

   DBUG_RETURN ($value);
}


# ==============================================================

=item @ret[0..4] = parse_line ( $input, \%opts )

This is a private method called by I<read_config> to parse each line of the
config file as it's read in.  It's main purpose is to strip off leading and
trailing spaces and any comments it might find on the input line.  It also
tells if the I<$input> contains a tag/value pair.

It returns 5 values:  ($tv_flg, $line, $comment, $lQuote, $rQuote)

B<$tv_flg> - True if I<$line> contains a tag/value pair in it, else false.

B<$line> - The trimmed I<$input> line minus any comments.

B<$comment> - The comment stripped out of the original input line minus the
leading comment symbol(s).

B<$lQuote> & B<rQuote> - Only set if I<$tv_flg> is true and I<$lQuote> was
the 1st char of the value and I<$rQuote> was the last char of the tag's value.
If the value wasn't surrounded by balanced quotes, both return values will be
the empty string B<"">.