This file is indexed.

/usr/share/perl5/Validation/Class/Util.pm is in libvalidation-class-perl 7.900057-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
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
# Utility Functions for Validation Classes

package Validation::Class::Util;

use strict;
use warnings;

our $VERSION = '7.900057'; # VERSION

use Module::Runtime 'use_module';
use Scalar::Util 'blessed';
use Carp 'confess';
use Exporter ();

our @ISA    = qw(Exporter);
our @EXPORT = qw(

    build_args
    build_args_collection
    has
    hold
    isa_arrayref
    isa_classref
    isa_coderef
    isa_hashref
    isa_listing
    isa_mapping
    isa_prototype
    isa_regexp
    prototype_registry

);

sub build_args {

    my $self = shift;

    my $class = ref $self || $self;

    if ( scalar @_ == 1 ) {
        confess
            "The new() method for $class expects single arguments to " .
            "take the form of a hash reference"
            unless defined $_[0] && ref $_[0] eq 'HASH'
        ;
        return {%{$_[0]}};
    }

    elsif ( @_ % 2 ) {
        confess
            "The new() method for $class expects a hash reference or a " .
            "key/value list. You passed an odd number of arguments"
        ;
    }

    else {
        return {@_};
    }

}

sub build_args_collection {

    my $class = shift;

    # Validation::Class::Mapping should already be loaded
    return Validation::Class::Mapping->new($class->build_args(@_));

}

sub has {

    my ( $attrs, $default ) = @_;

    return unless $attrs;

    confess "Error creating accessor, default must be a coderef or constant"
        if ref $default && ref $default ne 'CODE';

    $attrs = [$attrs] unless ref $attrs eq 'ARRAY';

    for my $attr (@$attrs) {

        confess "Error creating accessor '$attr', name has invalid characters"
            unless $attr =~ /^[a-zA-Z_]\w*$/;

        my $code;

        if ( defined $default ) {

            $code = sub {

                if ( @_ == 1 ) {
                    return $_[0]->{$attr} if exists $_[0]->{$attr};
                    return $_[0]->{$attr}
                        = ref $default eq 'CODE'
                        ? $default->( $_[0] )
                        : $default;
                }
                $_[0]->{$attr} = $_[1];
                $_[0];

            };

        }

        else {

            $code = sub {

                return $_[0]->{$attr} if @_ == 1;
                $_[0]->{$attr} = $_[1];
                $_[0];

            };

        }

        no strict 'refs';
        no warnings 'redefine';

        my $class = caller(0);

        *{"$class\::$attr"} = $code;

    }

    return;

}

sub hold {

    my ( $attrs, $default ) = @_;

    return unless $attrs;

    confess "Error creating accessor, default is required and must be a coderef"
        if ref $default ne 'CODE';

    $attrs = [$attrs] unless ref $attrs eq 'ARRAY';

    for my $attr (@$attrs) {

        confess "Error creating accessor '$attr', name has invalid characters"
            unless $attr =~ /^[a-zA-Z_]\w*$/;

        my $code;

        $code = sub {

            if ( @_ == 1 ) {
                return $_[0]->{$attr} if exists $_[0]->{$attr};
                return $_[0]->{$attr} = $default->( $_[0] );
            }

            # values are read-only cannot be changed
            confess "Error attempting to modify the read-only attribute ($attr)";

        };

        no strict 'refs';
        no warnings 'redefine';

        my $class = caller(0);

        *{"$class\::$attr"} = $code;

    }

    return;

}

sub import {

    strict->import;
    warnings->import;

    __PACKAGE__->export_to_level(1, @_);

    return;

}

sub isa_arrayref {

    return "ARRAY" eq ref(shift) ? 1 : 0;

}

sub isa_classref {

    my ($object) = @_;

    return blessed(shift) ? 1 : 0;

}

sub isa_coderef {

    return "CODE" eq ref(shift) ? 1 : 0;

}

sub isa_hashref {

    return "HASH" eq ref(shift) ? 1 : 0;

}

sub isa_listing {

    return "Validation::Class::Listing" eq ref(shift) ? 1 : 0;

}

sub isa_mapping {

    return "Validation::Class::Mapping" eq ref(shift) ? 1 : 0;

}

sub isa_prototype {

    return prototype_registry->has(shift) ? 1 : 0;

}

sub isa_regexp {

    return "REGEXP" eq uc(ref(shift)) ? 1 : 0;

}

sub prototype_registry {

    # Validation::Class::Prototype should be already loaded
    return Validation::Class::Prototype->registry;

}

1;