This file is indexed.

/usr/share/perl5/Object/InsideOut/Dump.pm is in libobject-insideout-perl 3.97-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
package Object::InsideOut; {

use strict;
use warnings;
no warnings 'redefine';

# Installs object dumper and loader methods
sub dump
{
    my ($GBL, $call, @args) = @_;
    push(@{$$GBL{'export'}}, 'dump');
    $$GBL{'init'} = 1;

    *Object::InsideOut::dump = sub
    {
        my $self = shift;

        my $d_flds =  $$GBL{'dump'}{'fld'};

        # Extract field info from any :InitArgs hashes
        while (my $pkg = shift(@{$$GBL{'dump'}{'args'}})) {
            my $p_args = $$GBL{'args'}{$pkg};
            foreach my $name (keys(%{$p_args})) {
                my $val = $$p_args{$name};
                next if (ref($val) ne 'HASH');
                if (my $field = $$val{'_F'}) {
                    $$d_flds{$pkg} ||= {};
                    if (add_dump_field('InitArgs', $name, $field, $$d_flds{$pkg}) eq 'conflict') {
                        OIO::Code->die(
                            'message' => 'Cannot dump object',
                            'Info'    => "In class '$pkg', '$name' refers to two different fields set by 'InitArgs' and '$$d_flds{$pkg}{$name}{'src'}'");
                    }
                }
            }
        }

        # Must call ->dump() as an object method
        if (! Scalar::Util::blessed($self)) {
            OIO::Method->die('message' => q/'dump' called as a class method/);
        }

        # Gather data from the object's class tree
        my %dump;
        my $fld_refs = $$GBL{'fld'}{'ref'};
        my $dumpers  = $$GBL{'dump'}{'dumper'};
        my $weak     = $$GBL{'fld'}{'weak'};
        foreach my $pkg (@{$$GBL{'tree'}{'td'}{ref($self)}}) {
            # Try to use a class-supplied dumper
            if (my $dumper = $$dumpers{$pkg}) {
                local $SIG{'__DIE__'} = 'OIO::trap';
                $dump{$pkg} = $self->$dumper();

            } elsif ($$fld_refs{$pkg}) {
                # Dump the data ourselves from all known class fields
                my @fields = @{$$fld_refs{$pkg}};

                # Fields for which we have names
                foreach my $name (keys(%{$$d_flds{$pkg}})) {
                    my $field = $$d_flds{$pkg}{$name}{'fld'};
                    if (ref($field) eq 'HASH') {
                        if (exists($$field{$$self})) {
                            $dump{$pkg}{$name} = $$field{$$self};
                        }
                    } else {
                        if (defined($$field[$$self])) {
                            $dump{$pkg}{$name} = $$field[$$self];
                        }
                    }
                    if ($$weak{$field} && exists($dump{$pkg}{$name})) {
                        Scalar::Util::weaken($dump{$pkg}{$name});
                    }
                    @fields = grep { $_ != $field } @fields;
                }

                # Fields for which names are not known
                foreach my $field (@fields) {
                    if (ref($field) eq 'HASH') {
                        if (exists($$field{$$self})) {
                            $dump{$pkg}{$field} = $$field{$$self};
                        }
                    } else {
                        if (defined($$field[$$self])) {
                            $dump{$pkg}{$field} = $$field[$$self];
                        }
                    }
                    if ($$weak{$field} && exists($dump{$pkg}{$field})) {
                        Scalar::Util::weaken($dump{$pkg}{$field});
                    }
                }
            }
        }

        # Package up the object's class and its data
        my $output = [ ref($self), \%dump ];

        # Create a string version of dumped data if arg is true
        if ($_[0]) {
            require Data::Dumper;
            local $Data::Dumper::Indent = 1;
            $output = Data::Dumper::Dumper($output);
            chomp($output);
            $output =~ s/^\$VAR1 = //;  # Remove leading '$VAR1 = '
            $output =~ s/;$//s;         # Remove trailing semi-colon
        }

        # Done - send back the dumped data
        return ($output);
    };


    *Object::InsideOut::pump = sub
    {
        my $input = shift;

        # Check usage
        if ($input) {
            if ($input eq 'Object::InsideOut') {
                $input = shift;    # Called as a class method

            } elsif (Scalar::Util::blessed($input)) {
                OIO::Method->die('message' => q/'pump' called as an object method/);
            }
        }

        # Must have an arg
        if (! $input) {
            OIO::Args->die('message' => 'Missing argument to pump()');
        }

        # Convert string input to array ref, if needed
        if (! ref($input)) {
            my @errs;
            local $SIG{'__WARN__'} = sub { push(@errs, @_); };

            my $array_ref;
            eval "\$array_ref = $input";

            if ($@ || @errs) {
                my ($err) = split(/ at /, $@ || join(" | ", @errs));
                OIO::Args->die(
                    'message'  => 'Failure converting dump string back to hash ref',
                    'Error'    => $err,
                    'Arg'      => $input);
            }

            $input = $array_ref;
        }

        # Check input
        if (ref($input) ne 'ARRAY') {
            OIO::Args->die('message'  => 'Argument to pump() is not an array ref');
        }

        # Extract class name and object data
        my ($class, $dump) = @{$input};
        if (! defined($class) || ref($dump) ne 'HASH') {
            OIO::Args->die('message'  => 'Argument to pump() is invalid');
        }

        # Create a new 'bare' object
        my $self = _obj($class);

        # Store object data
        foreach my $pkg (keys(%{$dump})) {
            if (! exists($$GBL{'tree'}{'td'}{$pkg})) {
                OIO::Args->die('message' => "Unknown class: $pkg");
            }
            my $data = $$dump{$pkg};

            # Try to use a class-supplied pumper
            if (my $pumper = $$GBL{'dump'}{'pumper'}{$pkg}) {
                local $SIG{'__DIE__'} = 'OIO::trap';
                $self->$pumper($data);

            } else {
                # Pump in the data ourselves
                foreach my $fld_name (keys(%{$data})) {
                    my $value = $$data{$fld_name};
                    if (my $field = $$GBL{'dump'}{'fld'}{$pkg}{$fld_name}{'fld'}) {
                        $self->set($field, $value);
                    } else {
                        if ($fld_name =~ /^(?:HASH|ARRAY)/) {
                            OIO::Args->die(
                                'message' => "Unnamed field encounted in class '$pkg'",
                                'Arg'     => "$fld_name => $value");
                        } else {
                            OIO::Args->die(
                                'message' => "Unknown field name for class '$pkg': $fld_name");
                        }
                    }
                }
            }
        }

        # Done - return the object
        return ($self);
    };


    # Do the original call
    @_ = @args;
    goto &$call;
}

}  # End of package's lexical scope


# Ensure correct versioning
($Object::InsideOut::VERSION == 3.97)
    or die("Version mismatch\n");

# EOF