Advanced-Config

 view release on metacpan or  search on metacpan

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

   DBUG_RETURN ( $def );
}


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

=item $str = convert_to_regexp_string ( $string[, $no_logs] )

Converts the passed string that may contain special chars for a Perl RegExp
into something that is a literal constant value to Perl's RegExp engine by
turning these problem chars into escape sequences.

It then returns the new string.

If I<$no_logs> is set to a non-zero value, it won't write anything to the logs.

=cut

sub convert_to_regexp_string
{
   my $no_fish = $_[1];

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

   return ( $str );
}

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

=item $str = convert_to_regexp_modifier ( $string )

Similar to C<convert_to_regexp_string> except that it doesn't convert
all the wild card chars.

Leaves the following RegExp wild card's unescaped!
S<(B<*>, B<?>, B<[>, and B<]>)>

Used when processing variable modifier rules.

=cut

sub convert_to_regexp_modifier
{
   DBUG_ENTER_FUNC ( @_ );
   my $str     = shift;

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

            DBUG_PRINT ("WARN", $m);
         } else {
            warn $m;
         }
         next;
      }

      # Was the tag's value encryped??   Then we need to decrypt it ...
      my $still_encrypted = 0;
      if ( $cmt =~ m/(^|${lbl_sep})${decrypt_str}(${lbl_sep}|$)/ ) {
         $value = _reverse_escape_sequences ( $value, $opts );

         if ( $opts->{disable_decryption} ) {
            $still_encrypted = 1;     # Doesn't get decrypted.
         } else {
            $value = decrypt_value ( $value, $t2, $opts, $file );
         }
      }

      # See if we can expand variables in $value ???
      my $still_variables = 0;

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

      $cmt =~ s/(^|${lbl_sep})${encrypt_str}(${lbl_sep}|$)/$1${lbl}$2/g;

      # Remove any balanced quotes from arround the value ...
      if ( $lq ) {
         $value =~ s/^${lq}//;
         $value =~ s/${rq}$//;
      }

      my ($new_value, $nlq, $nrq);
      $new_value = encrypt_value ( $value, $t2, $rOpts, $file);
      ($new_value, $nlq, $nrq) = _apply_escape_sequences ( $new_value, $rOpts );

      if ( is_assign_spaces ( $rOpts ) ) {
         $line =~ s/^(\s*\S+\s+)${old_value}/$1${nlq}${new_value}${nrq}/;
      } else {
         $line =~ s/(\s*${assign_str}\s*)${old_value}/$1${nlq}${new_value}${nrq}/;
      }
      $line =~ s/${old_cmt}$/${cmt}/;

      unless (print NEW $line, "\n") {
         return DBUG_RETURN ( croak_helper ($rOpts, $errMsg, 0) );

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

      # Modify the label in the comment ...
      my $lbl = $rOpts->{encrypt_lbl};
      $cmt =~ s/(^|${lbl_sep})${decrypt_str}(${lbl_sep}|$)/$1${lbl}$2/g;

      # Remove any balanced quotes from arround the value ...
      if ( $lq ) {
         $value =~ s/^${lq}//;
         $value =~ s/${rq}$//;
      }

      my ($new_value, $nlq, $nrq, $rlq2, $rrq2) = _reverse_escape_sequences ( $value, $rOpts );
      $new_value = decrypt_value ( $new_value, $t2, $rOpts, $file);

      if ( $nlq ) {
         if ( $new_value =~ m/${rlq2}/ || $new_value =~ m/${rrq2}/ ) {
            $nlq = $nrq = "";   # Balanced quotes are not supported for this value!
         }
      }

      if ( is_assign_spaces ( $rOpts ) ) {
         $line =~ s/^(\s*\S+\s+)${old_value}/$1${nlq}${new_value}${nrq}/;

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

   if ( exists $rOpts->{encrypt_cb} && ref ( $rOpts->{encrypt_cb} ) eq "CODE" ) {
      $value = $rOpts->{encrypt_cb}->( 0, $tag, $value, $alias, $rOpts->{encrypt_cb_opts} );
   }

   DBUG_RETURN ( $value );
}


# ==============================================================
# Before writing an encrypted value to a config file, all problem
# character sequences must be converted into escape sequences.  So
# that when the encrypted value is read back in again it won't cause
# parsing issues.
sub _apply_escape_sequences
{
   DBUG_ENTER_FUNC ( @_ );
   my $value = shift;       # Encrypted ...
   my $rOpts = shift;

   my ( $lq, $rq ) =  _get_encryption_quotes ( $rOpts );

   # Strings to use in the regular expressions ...
   my ($l_quote, $r_quote) = ( convert_to_regexp_string ($lq, 1),
                               convert_to_regexp_string ($rq, 1) );
   my $cmt = convert_to_regexp_string ($rOpts->{comment}, 1);
   my $var = convert_to_regexp_string ($rOpts->{variable_left}, 1);

   # ---------------------------------------------------------------
   # Replace any problem char for values with escape sequences ...
   # ---------------------------------------------------------------
   $value =~ s/\\/\\z/sg;      # Done so we can use \ as an escape sequence.
   $value =~ s/\n/\\n/sg;      # Remove embedded "\n" so no mult-lines.
   $value =~ s/%/\\p/sg;       # So calls to DBUG_PRINT won't barf ...
   $value =~ s/${cmt}/\\3/sg;  # Don't want any comment chars ...
   if ( $rq ) {
      $value =~ s/${l_quote}/\\q/sg;
      $value =~ s/${r_quote}/\\Q/sg;
   }
   $value =~ s/${var}/\\v/sg;  # So nothing looks like a variable ...
   $value =~ s/\0/\\0/sg;      # So no embedded null chars ...

   DBUG_RETURN ( $value, $lq, $rq );
}


# ==============================================================
# When an encrypted value is read in from the config file, all escape
# secuences need to be removed before the value can be decrypted.
# These escape sequences were required to avoid parsing issues when
# handling encrypted values.
sub _reverse_escape_sequences
{
   DBUG_ENTER_FUNC ( @_ );
   my $value = shift;       # Encrypted with escape sequences ...
   my $rOpts = shift;

   my ( $lq, $rq ) =  _get_encryption_quotes ( $rOpts );
   my $cmt = $rOpts->{comment};
   my $var = $rOpts->{variable_left};

   # Strings to use in the regular expressions ... (by caller)
   my ($l_quote, $r_quote) = ( convert_to_regexp_string ($lq, 1),
                               convert_to_regexp_string ($rq, 1) );

   # ---------------------------------------------------------------
   # Replace the escape sequences to get back the problem chars ...
   # Done in reverse order of what was done in: _apply_escape_sequences()!
   # ---------------------------------------------------------------
   $value =~ s/\\0/\0/sg;
   $value =~ s/\\v/${var}/sg;
   if ( $rq ) {
      $value =~ s/\\Q/${rq}/sg;
      $value =~ s/\\q/${lq}/sg;
   }
   $value =~ s/\\3/${cmt}/sg;
   $value =~ s/\\p/%/sg;
   $value =~ s/\\n/\n/sg;