view release on metacpan or  search on metacpan

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

         @{$result{VALUE}} = sort ( @{$result{VALUE}} );
      }
      @{$result{VALUE}} = reverse ( @{$result{VALUE}} )  if ( $get_opts->{sort} < 0 );
   }

   DBUG_RETURN ( \%result );
}

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

=item $boolean = is_assign_spaces ( $ropts )

Tells if the assignment operator selected is the special case of using spaces
to separate the tag/value pair.  Only returns true if it's B<\\s>.

=cut

# No fish since it's called so frequently, over & over again ...
sub is_assign_spaces
{
   # Checking the ${rOpts} settings ...
   return ( exists $_[0]->{assign} && $_[0]->{assign} eq "\\s" );
}

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

=item $boolean = using_default_quotes ( $ropts )

This function tells if you are currently using the default quotes.  This is the
only case where there can be multiple values for the quote string anchors.  All
other cases allow only for a single value for each of the quote string anchors.

=cut

sub using_default_quotes
{
   DBUG_ENTER_FUNC ( @_ );
   my $ropts = shift;

   my $def = 0;     # Assume not using the default quotes ...

   unless ( $ropts->{disable_quotes} ) {
      if ( $ropts->{quote_left} eq $ropts->{quote_right} ) {
         if ( $ropts->{quote_left} eq  "['\"]"  ||
              $ropts->{quote_left} eq  "[\"']" ) {
            $def = 1;
         }
      }
   }

   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];
   DBUG_ENTER_FUNC ( @_ )  unless ( $no_fish );;
   my $str     = shift;

   # The 8 problem chars with special meaning in a RegExp ...
   # Chars:  . + ^ | $ \ * ?
   $str =~ s/([.+^|\$\\*?])/\\$1/g;  

   # As do these 3 types of brackets: (), {}, []
   $str =~ s/([(){}[\]])/\\$1/g;

   return DBUG_RETURN ( $str )  unless ( $no_fish );
   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;

   # The 6 problem chars with special meaning in a RegExp ...
   # Chars:  . + ^ | $ \    (Skips * ?)
   $str =~ s/([.+^|\$\\])/\\$1/g;  

   # As do these 2 of 3 types of brackets: () & {}, not []
   $str =~ s/([(){}])/\\$1/g;

   DBUG_RETURN ( $str );
}

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

=item $sensitive = should_we_hide_sensitive_data ( $tag )

Checks the tag against an internal list of patterns to see if there is a match.
This check is done in a case insensitive way.

If there is a match it will return true and the caller should take care about
writing anything about this tag to any log files.

If there is no match it will return false, and you can write what you please to
your logs.

See I<make_it_sensitive> to add additional patterns to the list.

=cut

sub should_we_hide_sensitive_data
{
   my $tag       = shift;
   my $skip_fish = shift;     # Undocumented ...

   my $sensitive = 0;    # Assume it's not to be hidden!

   foreach my $hide ( @hide_from_fish ) {
      if ( $tag =~ m/${hide}/i ) {
         $sensitive = 1;   # We found a match!  It's sensitive!
      }
   }

   unless ( $skip_fish ) {
      DBUG_ENTER_FUNC ( $tag, $skip_fish, @_ );
      return DBUG_RETURN ( $sensitive );
   }

   return ( $sensitive );
}

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