view release on metacpan or  search on metacpan

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

      $skip = 1;   # This separator doesn't support the prefixes.
   } else {
      my $assign_str  = convert_to_regexp_string ($rOpts->{assign}, 1);
      ( $tag, $value ) = split ( /\s*${assign_str}\s*/, $ln, 2 );
   }

   my $export_prefix = "";

   unless ( $skip ) {
      # Check if one of the export/set variable prefixes were used!
      if ( $tag =~ m/^(export\s+)(\S.*)$/i ) {
         $tag = $2;           # Remove the leading "export" keyword ...
         $export_prefix = $1;
      } elsif ( $tag =~ m/^(set\s+)(\S.*)$/i ) {
         $tag = $2;           # Remove the leading "set" keyword ...
         $export_prefix = $1;
      }
   }

   # Did we request case insensitive tags ... ?
   my $ci_tag = ( $rOpts->{tag_case} && defined $tag ) ? lc ($tag) : $tag;

   return ( $ci_tag, $value, $export_prefix, $tag );
}


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

=item $sts = read_config ( $file, $config )

This method performs the reading and parsing of the given config file and puts
the results into the L<Advanced::Config> object I<$config>.  This object
provides the necessary parsing rules to use.

If a line was too badly mangled to be parsed, it will be ignored and a warning
will be written to your screen.

It returns B<1> on success and B<0> on failure.

Please note that comments are just thrown away by this process and only
tag/value pairs remain afterwards.  Everything else is just instructions to
the parser or how to group together these tag/value pairs.

If it sees something like:  export tag = value, it will export tag's value
to the %ENV hash for you just like it does in a Unix shell script!

Additional modifiers can be found in the comments after a tag/value pair
as well.

=cut

# ==============================================================
sub read_config
{
   DBUG_ENTER_FUNC ( @_ );
   my $file = shift;     # The filename to read ...
   my $cfg  = shift;     # The Advanced::Config object ...

   my $opts = $cfg->get_cfg_settings ();   # The Read Options ...

   # Locate the parent section of the config file.
   my $pcfg = $cfg->get_section ();

   # Using a variable so that we can be recursive in reading config files.
   my $READ_CONFIG;

   DBUG_PRINT ("INFO", "Opening the config file named: %s", $file);

   unless ( open ($READ_CONFIG, "<", $file) ) {
      return DBUG_RETURN ( croak_helper ($opts,
                                        "Unable to open the config file.", 0) );
   }

   # Misuse of this option makes the config file unreadable ...
   if ( $opts->{use_utf8} ) {
      binmode ($READ_CONFIG, "encoding(UTF-8)");
      $pcfg->_allow_utf8 ();   # Tells get_date() that wide char languages are OK!
   }

   # Some common RegExp strings ... Done here to avoid asking repeatably ...
   my $decrypt_str = convert_to_regexp_string ($opts->{decrypt_lbl});
   my $encrypt_str = convert_to_regexp_string ($opts->{encrypt_lbl});
   my $hide_str    = convert_to_regexp_string ($opts->{hide_lbl});
   my $sect_str    = convert_to_regexp_string ($opts->{source_file_section_lbl});

   my $export_str  = convert_to_regexp_string ($opts->{export_lbl});
   my ($lb, $rb) = ( convert_to_regexp_string ($opts->{section_left}),
                     convert_to_regexp_string ($opts->{section_right}) );
   my $assign_str  = convert_to_regexp_string ($opts->{assign});
   my $src_str     = convert_to_regexp_string ($opts->{source});
   my ($lv, $rv) = ( convert_to_regexp_string ($opts->{variable_left}),
                     convert_to_regexp_string ($opts->{variable_right}) );

   # The label separators used when searching for option labels in a comment ...
   my $lbl_sep = '[\s.,$!()-]';

   # Initialize to the default secion ...
   my $section = make_new_section ( $cfg, "" );

   my %hide_section;

   while ( <$READ_CONFIG> ) {
      chomp;
      my $line = $_;             # Save so can use in fish logging later on.

      my ($tv, $ln, $cmt, $lq, $rq) = parse_line ( $line, $opts );

      if ( $ln eq "" ) {
         DBUG_PRINT ("READ", "READ LINE:  %s", $line);
         next;                   # Skip to the next line if only comments found.
      }

      # Check for lines with no tag/value pairs in them ...
      if ( ! $tv ) {
         DBUG_PRINT ("READ", "READ LINE:  %s", $line);

         # EX:  . ${file} --- Sourcing in ${file} ...
         if ( $ln =~ m/^${src_str}\s+(.+)$/i ) {
            my $src = $1;
            my $def_section = "";
            if ( $cmt =~ m/(^|${lbl_sep})${sect_str}(${lbl_sep}|$)/ ) {

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

The optional I<$sensitive> when set to a non-zero value is used to disable
B<fish> logging when it's turned on because the I<$string> being passed contains
sensitive information.

The optional I<$trim> tells if you may trim the results before it's returned.

It returns the new value $v, once all the variable substitution(s) have
occurred.  And optionally a second return value $h that tells if B<fish> was
paused during the expansion of that value due to something being sensitive.
This 2nd return value $h is meaningless in most situations, so don't ask for it.

All variables are defined as B<${>I<...>B<}>, where I<...> is the variable you
wish to substitute.  If something isn't surrounded by a B<${> + B<}> pair, it's
not a variable.

   A config file exampe:
       tmp1 = /tmp/work-1
       tmp2 = /tmp/work-2
       opt  = 1
       date = 2011-02-03
       logs = ${tmp${opt}}/log-${date}.txt
       date = 2012-12-13

   So when passed "${tmp${opt}}/log-${date}.txt", it would return:
       /tmp/work-1/log-2011-02-03.txt
   And assigned it to B<logs>.

As you can see multiple variable substitutions may be expanded in a single
string as well as nested substitutions.  And when the variable substitution is
done while reading in the config file, all the values used were defined before
the tag was referenced.

Should you call this method after the config file was loaded you get slightly
different results.  In that case the final tag value is used instead and the
2nd date in the above example would have been used in it's place.

See L<Advanced::Config::lookup_one_variable> for more details on how it
evaluates individual variables.

As a final note, if one or more of the referenced variables holds encrypted
values that haven't yet been decrypted, those variables are not resolved.  But
all variables that don't contain encrypted data are resolved.

=cut

# ==============================================================
sub expand_variables
{
   my $config    = shift;           # For the current section of config obj ...
   my $value     = shift;           # The value to parse for variables ...
   my $file      = shift || "";     # The config file the value came from ...
   my $mask_flag = shift || 0;      # Hide/mask sensitive info written to fish?
   my $trim_flag = shift || 0;      # Tells if we should trim the result or not.

   # Only mask ${value} if ${mask_flag} is true ...
   DBUG_MASK_NEXT_FUNC_CALL (1)  if ( $mask_flag );
   DBUG_ENTER_FUNC ( $config, $value, $file, $mask_flag, $trim_flag, @_);

   my $opts = $config->get_cfg_settings ();   # The Read Options ...

   my $pcfg = $config->get_section();    # Get the main/parent section to work with!

   # Don't write to Fish if we're hiding any values ...
   if ( $mask_flag ) {
      DBUG_PAUSE ();
      DBUG_MASK ( 0 );
   }

   # The 1st split of the value into it's component parts ...
   my ($left, $tag, $right, $cmt_flag, $mod_tag, $mod_opt, $mod_val, $ot) =
                               parse_for_variables ( $value, 0, $opts );

   # Any variables to substitute ???
   unless ( defined $tag ) {
      return DBUG_RETURN ( $value, $mask_flag );  # nope ...
   }

   my $output = $value;

   my %encrypt_vars;
   my $encrypt_cnt = 0;
   my $encrypt_fmt = "_"x50 . "ENCRYPT_%02d" . "-"x50;

   my ($lv, $rv) = ( convert_to_regexp_string ($opts->{variable_left}),
                     convert_to_regexp_string ($opts->{variable_right}) );

   # While there are still variables to process ...
   while ( defined $tag ) {
      my ( $val, $mask );
      my $do_mod_lookup = 0;    # Very rarely set to true ...

      # ${tag} and ${mod_tag} will never have the same value ...
      # ${mod_tag} will amost always be undefinded.
      # If both are defined, we'll almost always end up using ${mod_tag} as
      # the real variable to expand!  But we check to be sure 1st.

      ( $val, $mask ) = $config->lookup_one_variable ( $tag );

      # It's extreemly rare to have this "if statement" evalate to true ...
      if ( (! defined $val) && defined $mod_tag ) {
         ( $val, $mask ) = $config->lookup_one_variable ( $mod_tag );

         # -----------------------------------------------------------------
         # If we're using variable modifiers, it doesn't matter if the
         # varible exists or not.  The modifier gets evaluated!
         # So checking if the undefined $mod_tag needs to be masked or not ...
         # -----------------------------------------------------------------
         unless ( defined $val ) {
            $mask = should_we_hide_sensitive_data ( $mod_tag );
         }

         $do_mod_lookup = 1;    # Yes, apply the modifiers!
      }

      # Use a place holder if the variable references data that is still encrypted.
      if ( $mask == -1 ) {
         $mask_flag = -1;
         $val = sprintf ($encrypt_fmt, ++$encrypt_cnt);

         # If the place holder contains variable anchors abort the substitutions.
         last  if ( $val =~ m/${lv}/ || $val =~ m/${rv}/ );