This file is indexed.

/usr/share/perl5/Devel/Symdump.pm is in libdevel-symdump-perl 2.12-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
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
package Devel::Symdump;

use 5.003;
use Carp ();
use strict;
use vars qw($Defaults $VERSION *ENTRY $MAX_RECURSION);

$VERSION = '2.12';
$MAX_RECURSION = 97;

$Defaults = {
	     'RECURS'   => 0,
	     'AUTOLOAD' => {
			    'packages'	=> 1,
			    'scalars'	=> 1,
			    'arrays'	=> 1,
			    'hashes'	=> 1,
			    'functions'	=> 1,
			    'ios'	=> 1,
			    'unknowns'	=> 1,
			   },
             'SEEN' => {},
	    };

sub rnew {
    my($class,@packages) = @_;
    no strict "refs";
    my $self = bless {%${"$class\::Defaults"}}, $class;
    $self->{RECURS}++;
    $self->_doit(@packages);
}

sub new {
    my($class,@packages) = @_;
    no strict "refs";
    my $self = bless {%${"$class\::Defaults"}}, $class;
    $self->_doit(@packages);
}

sub _doit {
    my($self,@packages) = @_;
    @packages = ("main") unless @packages;
    $self->{RESULT} = $self->_symdump(@packages);
    return $self;
}

sub _symdump {
    my($self,@packages) = @_ ;
    my($key,$val,$num,$pack,@todo,$tmp);
    my $result = {};
    foreach $pack (@packages){
	no strict;
	while (($key,$val) = each(%{*{"$pack\::"}})) {
	    my $gotone = 0;
	    local(*ENTRY) = $val;
	    #### SCALAR ####
	    if (defined $val && defined *ENTRY{SCALAR}) {
		$result->{$pack}{SCALARS}{$key}++;
		$gotone++;
	    }
	    #### ARRAY ####
	    if (defined $val && defined *ENTRY{ARRAY}) {
		$result->{$pack}{ARRAYS}{$key}++;
		$gotone++;
	    }
	    #### HASH ####
	    if (defined $val && defined *ENTRY{HASH} && $key !~ /::/) {
		$result->{$pack}{HASHES}{$key}++;
		$gotone++;
	    }
	    #### PACKAGE ####
	    if (defined $val && defined *ENTRY{HASH} && $key =~ /::$/ &&
                $key ne "main::" && $key ne "<none>::") {
                my($p) = $pack ne "main" ? "$pack\::" : "";
                ($p .= $key) =~ s/::$//;
                $result->{$pack}{PACKAGES}{$p}++;
                $gotone++;
                if (++$self->{SEEN}{*$val} > $Devel::Symdump::MAX_RECURSION){
                    next;
                }
		push @todo, $p;
	    }
	    #### FUNCTION ####
	    if (defined $val && defined *ENTRY{CODE}) {
		$result->{$pack}{FUNCTIONS}{$key}++;
		$gotone++;
	    }

	    #### IO #### had to change after 5.003_10
	    if ($] > 5.003_10){
		if (defined $val && defined *ENTRY{IO}){ # fileno and telldir...
		    $result->{$pack}{IOS}{$key}++;
		    $gotone++;
		}
	    } else {
		#### FILEHANDLE ####
		if (defined fileno(ENTRY)){
		    $result->{$pack}{IOS}{$key}++;
		    $gotone++;
		} elsif (defined telldir(ENTRY)){
		    #### DIRHANDLE ####
		    $result->{$pack}{IOS}{$key}++;
		    $gotone++;
		}
	    }

	    #### SOMETHING ELSE ####
	    unless ($gotone) {
		$result->{$pack}{UNKNOWNS}{$key}++;
	    }
	}
    }

    return (@todo && $self->{RECURS})
		? { %$result, %{$self->_symdump(@todo)} }
		: $result;
}

sub _partdump {
    my($self,$part)=@_;
    my ($pack, @result);
    my $prepend = "";
    foreach $pack (keys %{$self->{RESULT}}){
	$prepend = "$pack\::" unless $part eq 'PACKAGES';
	push @result, map {"$prepend$_"} keys %{$self->{RESULT}{$pack}{$part} || {}};
    }
    return @result;
}

# this is needed so we don't try to AUTOLOAD the DESTROY method
sub DESTROY {}

sub as_string {
    my $self = shift;
    my($type,@m);
    for $type (sort keys %{$self->{'AUTOLOAD'}}) {
	push @m, $type;
	push @m, "\t" . join "\n\t", map {
	    s/([\000-\037\177])/ '^' . pack('c', ord($1) ^ 64) /eg;
	    $_;
	} sort $self->_partdump(uc $type);
    }
    return join "\n", @m;
}

sub as_HTML {
    my $self = shift;
    my($type,@m);
    push @m, "<TABLE>";
    for $type (sort keys %{$self->{'AUTOLOAD'}}) {
	push @m, "<TR><TD valign=top><B>$type</B></TD>";
	push @m, "<TD>" . join ", ", map {
	    s/([\000-\037\177])/ '^' .
		pack('c', ord($1) ^ 64)
		    /eg; $_;
	} sort $self->_partdump(uc $type);
	push @m, "</TD></TR>";
    }
    push @m, "</TABLE>";
    return join "\n", @m;
}

sub diff {
    my($self,$second) = @_;
    my($type,@m);
    for $type (sort keys %{$self->{'AUTOLOAD'}}) {
	my(%first,%second,%all,$symbol);
	foreach $symbol ($self->_partdump(uc $type)){
	    $first{$symbol}++;
	    $all{$symbol}++;
	}
	foreach $symbol ($second->_partdump(uc $type)){
	    $second{$symbol}++;
	    $all{$symbol}++;
	}
	my(@typediff);
	foreach $symbol (sort keys %all){
	    next if $first{$symbol} && $second{$symbol};
	    push @typediff, "- $symbol" unless $second{$symbol};
	    push @typediff, "+ $symbol" unless $first{$symbol};
	}
	foreach (@typediff) {
	    s/([\000-\037\177])/ '^' . pack('c', ord($1) ^ 64) /eg;
	}
	push @m, $type, @typediff if @typediff;
    }
    return join "\n", @m;
}

sub inh_tree {
    my($self) = @_;
    return $self->{INHTREE} if ref $self && defined $self->{INHTREE};
    my($inherited_by) = {};
    my($m)="";
    my(@isa) = grep /\bISA$/, Devel::Symdump->rnew->arrays;
    my $isa;
    foreach $isa (sort @isa) {
	$isa =~ s/::ISA$//;
	my($isaisa);
	no strict 'refs';
	foreach $isaisa (@{"$isa\::ISA"}){
	    $inherited_by->{$isaisa}{$isa}++;
	}
    }
    my $item;
    foreach $item (sort keys %$inherited_by) {
	$m .= "$item\n";
	$m .= _inh_tree($item,$inherited_by);
    }
    $self->{INHTREE} = $m if ref $self;
    $m;
}

sub _inh_tree {
    my($package,$href,$depth) = @_;
    return unless defined $href;
    $depth ||= 0;
    $depth++;
    if ($depth > 100){
	warn "Deep recursion in ISA\n";
	return;
    }
    my($m) = "";
    # print "DEBUG: package[$package]depth[$depth]\n";
    my $i;
    foreach $i (sort keys %{$href->{$package}}) {
	$m .= qq{\t} x $depth;
	$m .= qq{$i\n};
	$m .= _inh_tree($i,$href,$depth);
    }
    $m;
}

sub isa_tree{
    my($self) = @_;
    return $self->{ISATREE} if ref $self && defined $self->{ISATREE};
    my(@isa) = grep /\bISA$/, Devel::Symdump->rnew->arrays;
    my($m) = "";
    my($isa);
    foreach $isa (sort @isa) {
	$isa =~ s/::ISA$//;
	$m .= qq{$isa\n};
	$m .= _isa_tree($isa)
    }
    $self->{ISATREE} = $m if ref $self;
    $m;
}

sub _isa_tree{
    my($package,$depth) = @_;
    $depth ||= 0;
    $depth++;
    if ($depth > 100){
	warn "Deep recursion in ISA\n";
	return;
    }
    my($m) = "";
    # print "DEBUG: package[$package]depth[$depth]\n";
    my $isaisa;
    no strict 'refs';
    foreach $isaisa (@{"$package\::ISA"}) {
	$m .= qq{\t} x $depth;
	$m .= qq{$isaisa\n};
	$m .= _isa_tree($isaisa,$depth);
    }
    $m;
}

AUTOLOAD {
    my($self,@packages) = @_;
    unless (ref $self) {
	$self = $self->new(@packages);
    }
    no strict "vars";
    (my $auto = $AUTOLOAD) =~ s/.*:://;

    $auto =~ s/(file|dir)handles/ios/;
    my $compat = $1;

    unless ($self->{'AUTOLOAD'}{$auto}) {
	Carp::croak("invalid Devel::Symdump method: $auto()");
    }

    my @syms = $self->_partdump(uc $auto);
    if (defined $compat) {
	no strict 'refs';
        local $^W; # bleadperl@26631 introduced an io warning here
	if ($compat eq "file") {
	    @syms = grep { defined(fileno($_)) } @syms;
	} else {
	    @syms = grep { defined(telldir($_)) } @syms;
	}
    }
    return @syms; # make sure now it gets context right
}

1;

__END__

=head1 NAME

Devel::Symdump - dump symbol names or the symbol table

=head1 SYNOPSIS

    # Constructor
    require Devel::Symdump;
    @packs = qw(some_package another_package);
    $obj = Devel::Symdump->new(@packs);        # no recursion
    $obj = Devel::Symdump->rnew(@packs);       # with recursion

    # Methods
    @array = $obj->packages;
    @array = $obj->scalars;
    @array = $obj->arrays;
    @array = $obj->hashes;
    @array = $obj->functions;
    @array = $obj->filehandles;  # deprecated, use ios instead
    @array = $obj->dirhandles;   # deprecated, use ios instead
    @array = $obj->ios;
    @array = $obj->unknowns;     # only perl version < 5.003 had some

    $string = $obj->as_string;
    $string = $obj->as_HTML;
    $string = $obj1->diff($obj2);

    $string = Devel::Symdump->isa_tree;    # or $obj->isa_tree
    $string = Devel::Symdump->inh_tree;    # or $obj->inh_tree

    # Methods with autogenerated objects
    # all of those call new(@packs) internally
    @array = Devel::Symdump->packages(@packs);
    @array = Devel::Symdump->scalars(@packs);
    @array = Devel::Symdump->arrays(@packs);
    @array = Devel::Symdump->hashes(@packs);
    @array = Devel::Symdump->functions(@packs);
    @array = Devel::Symdump->ios(@packs);
    @array = Devel::Symdump->unknowns(@packs);

=head1 DESCRIPTION

This little package serves to access the symbol table of perl.

=over 4

=item C<Devel::Symdump-E<gt>rnew(@packages)>

returns a symbol table object for all subtrees below @packages.
Nested Modules are analyzed recursively. If no package is given as
argument, it defaults to C<main>. That means to get the whole symbol
table, just do a C<rnew> without arguments.

The global variable $Devel::Symdump::MAX_RECURSION limits the
recursion to prevent contention. The default value is set to 97, just
low enough to survive the test suite without a warning about deep
recursion.

=item C<Devel::Symdump-E<gt>new(@packages)>

does not go into recursion and only analyzes the packages that are
given as arguments.

=item packages, scalars, arrays, hashes, functions, ios

The methods packages(), scalars(), arrays(), hashes(), functions(),
ios(), and (for older perls) unknowns() each return an array of fully
qualified symbols of the specified type in all packages that are held
within a Devel::Symdump object, but without the leading C<$>, C<@> or
C<%>. In a scalar context, they will return the number of such
symbols. Unknown symbols are usually either formats or variables that
haven't yet got a defined value.

Note that scalar symbol table entries are a special case.  If a symbol
table entry exists at all, presence of a scalar is currently
unknowable, due to a feature of Perl described in perlref "Making
References" point 7.  For example, this package will mark a scalar
value C<$foo> as present if any of C<@foo>, C<%foo>, C<&foo> etc. have
been declared or used.

=item as_string

=item as_HTML

As_string() and as_HTML() return a simple string/HTML representations
of the object.

=item diff

Diff() prints the difference between two Devel::Symdump objects in
human readable form. The format is similar to the one used by the
as_string method.

=item isa_tree

=item inh_tree

Isa_tree() and inh_tree() both return a simple string representation
of the current inheritance tree. The difference between the two
methods is the direction from which the tree is viewed: top-down or
bottom-up. As I'm sure, many users will have different expectation
about what is top and what is bottom, I'll provide an example what
happens when the Socket module is loaded:

=item % print Devel::Symdump-E<gt>inh_tree

    AutoLoader
            DynaLoader
                    Socket
    DynaLoader
            Socket
    Exporter
            Carp
            Config
            Socket

The inh_tree method shows on the left hand side a package name and
indented to the right the packages that use the former.

=item % print Devel::Symdump-E<gt>isa_tree

    Carp
            Exporter
    Config
            Exporter
    DynaLoader
            AutoLoader
    Socket
            Exporter
            DynaLoader
                    AutoLoader

The isa_tree method displays from left to right ISA relationships, so
Socket IS A DynaLoader and DynaLoader IS A AutoLoader. (Actually, they
were at the time this manpage was written)

=back

You may call both methods, isa_tree() and inh_tree(), with an
object. If you do that, the object will store the output and retrieve
it when you call the same method again later. The typical usage would
be to use them as class methods directly though.

=head1 SUBCLASSING

The design of this package is intentionally primitive and allows it to
be subclassed easily. An example of a (maybe) useful subclass is
Devel::Symdump::Export, a package which exports all methods of the
Devel::Symdump package and turns them into functions.

=head1 SEE ALSO

Routines for manipulating stashes: C<Package::Stash>; to work with
lexicals: C<PadWalker>.

=head1 AUTHORS

Andreas Koenig F<< <andk@cpan.org> >> and Tom Christiansen
F<< <tchrist@perl.com> >>. Based on the old F<dumpvar.pl> by Larry
Wall.

=head1 COPYRIGHT, LICENSE

This module is

Copyright (c) 1995, 1997, 2000, 2002, 2005, 2006 Andreas Koenig C<< <andk@cpan.org> >>.

All rights reserved.

This library is free software;
you may use, redistribute and/or modify it under the same
terms as Perl itself.

=cut


# Local Variables:
# mode: cperl
# cperl-indent-level: 4
# End: