This file is indexed.

/usr/share/perl5/Petal/Hash/Var.pm is in libpetal-perl 2.20-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
# ------------------------------------------------------------------
# Petal::Hash::Var - Evaluates an expression and returns the result.
# ------------------------------------------------------------------
# Author: Jean-Michel Hiver
# This module is redistributed under the same license as Perl
# itself.
# ------------------------------------------------------------------
package Petal::Hash::Var;

use strict;
use warnings;

use Carp;
use Scalar::Util qw( blessed reftype );


our $STRING_RE_DOUBLE  = qr/(?<!\\)\".*?(?<!\\)\"/;
our $STRING_RE_SINGLE  = qr/(?<!\\)\'.*?(?<!\\)\'/;
our $STRING_RE         = qr/(?:$STRING_RE_SINGLE|$STRING_RE_DOUBLE)/;
our $VARIABLE_RE       = qr/(?:--)?[A-Za-z\_][^ \t]*/;
our $PARAM_PREFIX_RE   = qr/^--/;
our $ESCAPED_CHAR_RE   = qr/(?sm:\\(.))/;
our $BEGIN_QUOTE_RE    = qr/^\"|\'/;
our $END_QUOTE_RE      = qr/\"|\'$/;
our $TOKEN_RE          = qr/(?:$STRING_RE|$VARIABLE_RE)/;
our $PATH_SEPARATOR_RE = qr/(?:\/|\.)/;
our $INTEGER_KEY_RE    = qr/^\d+$/;


sub process
{
    my $class    = shift;
    my $hash     = shift;
    my $argument = shift;
    
    my @tokens = $argument =~ /($TOKEN_RE)/gsm;
    my $path   = shift (@tokens) or confess "bad syntax for $class: $argument (\$path)";
    my @path   = split( /$PATH_SEPARATOR_RE/, $path );
    my @args   = @tokens;

    # replace variable names by their value
    for (my $i=0; $i < @args; $i++)
    {
	my $arg = $args[$i];
	if ($arg =~ /^$VARIABLE_RE$/)
	{
	    $arg =~ s/$ESCAPED_CHAR_RE/$1/gsm;
	    if ($arg =~ $PARAM_PREFIX_RE)
	    {
		$arg =~ s/$PARAM_PREFIX_RE//;
		$args[$i] = $arg;
	    }
	    else
	    {
		$args[$i] = $hash->fetch ($arg);
	    }
	}
	else
	{
	    $arg =~ s/$BEGIN_QUOTE_RE//;
	    $arg =~ s/$END_QUOTE_RE//;
	    $arg =~ s/$ESCAPED_CHAR_RE/$1/gsm;
	    $args[$i] = $arg;
	}
    }
    
    my $current = $hash;
    my $current_path = '';
    while (@path)
    {
	my $next = shift (@path);
	$next = ($next =~ /:/) ? $hash->fetch ($next) : $next;
	
	my $has_path_tokens = scalar @path;
	my $has_args        = scalar @args;
	
	if (blessed $current)
	{
	  ACCESS_OBJECT:
	    goto ACCESS_HASH if ($current->isa('Petal::Hash'));

	    if ($current->can ($next) or $current->can ('AUTOLOAD'))
	    {
		if ($has_path_tokens) { $current = $current->$next ()      }
		else                  { $current = $current->$next (@args) }
	    }
	    else
	    {
		goto ACCESS_HASH  if ((reftype($current) or '') eq 'HASH');
		goto ACCESS_ARRAY if ((reftype($current) or '') eq 'ARRAY');
		confess "Cannot invoke '$next' on '" . ref($current) .
		  "' object at '$current_path' - no such method (near $argument)";
	    }
	}
	elsif (ref($current) eq 'HASH')
	{
	  ACCESS_HASH:
          unless (ref($current->{$next}) eq 'CODE')
          {
	    confess "Cannot access hash at '$current_path' with parameters (near $argument)"
	        if ($has_args and not $has_path_tokens);
          }
	    $current = $current->{$next};
	}
	elsif (ref($current) eq 'ARRAY')
	{
	  ACCESS_ARRAY:
	    # it might be an array, then the key has to be numerical...
	    confess "Cannot access array at '$current_path' with non-integer index '$next' (near $argument)"
	        unless ($next =~ /$INTEGER_KEY_RE/);

	    confess "Cannot access array at '$current_path' with parameters (near $argument)"
	        if ($has_args and not $has_path_tokens);

	    $current = $current->[$next];
	}
	else
	{
	    # ... or we cannot find the next value
	    if ($Petal::ERROR_ON_UNDEF_VAR)
	    {
		# let's croak and return
		my $warnstr = "Cannot find value for '$next' at '$current_path': $next cannot be retrieved\n";
		$warnstr   .= "(current value was ";
		$warnstr   .= (defined $current) ? "'$current'" : 'undef';
		$warnstr   .= ", near $argument)";
		confess $warnstr;
	    }
	    return '';
	}

	$current = (ref($current) eq 'CODE') ? $current->(@args) : $current;
	$current_path .= "/$next";
    }
    
    # return '' unless (defined $current);
    # $current = "$current" if (defined $current);
    return $$current if ref($current) eq 'SCALAR';
    return $current;
}


1;