view release on metacpan or  search on metacpan

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

                    "Value is not a date ($v) for tag ($tag) in section ($section) for language ($l2).",
                    undef ) );
          }
      }

      # -------------------------------------------------------------------
      # Are we referencing a file?
      if ( $get_opts->{filename} ) {
         my $valid = 1;   # Assume it's a filename ...
         $valid = 0  unless ( -f $v );
         $valid = 0  if ( ($get_opts->{filename} & 2) && ! -r _ );
         $valid = 0  if ( ($get_opts->{filename} & 4) && ! -w _ );
         $valid = 0  if ( ($get_opts->{filename} & 8) && ! -x _ );
         unless ( $valid ) {
            return DBUG_RETURN ( croak_helper ( $get_opts,
                   "Tag ${tag} doesn't reference a valid filename or it doesn't have the requested permissions! ($v)",
                   undef ) );
         }
      }

      # -------------------------------------------------------------------
      # Are we referencing a directory?
      if ( $get_opts->{directory} ) {
         my $valid = 1;   # Assume it's a directory ...
         $valid = 0  unless ( -d $v );
         $valid = 0  if ( ($get_opts->{directory} & 2) && ! -r _ );
         $valid = 0  if ( ($get_opts->{directory} & 4) && ! -w _ );
         $valid = 0  if ( ($get_opts->{directory} & 8) && ! -x _ );
         unless ( $valid ) {
            return DBUG_RETURN ( croak_helper ( $get_opts,
                   "Tag ${tag} doesn't reference a valid directory or it doesn't have the requested permissions! ($v)",
                   undef ) );
         }
      }

      # -------------------------------------------------------------------
      # If not splitting after all, save any changes ... (keep last in loop)
      if ( (! $get_opts->{split}) && $old ne $v ) {
         $result{VALUE} = $v;
      }
   }    # End foreach @vals loop ...


   # Do we need to sort the results ???
   if ( $get_opts->{split} && $get_opts->{sort} ) {
      if ( $is_all_numbers ) {
         @{$result{VALUE}} = sort { $a <=> $b } @{$result{VALUE}};
      } else {
         @{$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;