7 B::Xref - Generates cross reference reports for Perl programs
11 perl -MO=Xref[,OPTIONS] foo.pl
15 The B::Xref module is used to generate a cross reference listing of all
16 definitions and uses of variables, subroutines and formats in a Perl program.
17 It is implemented as a backend for the Perl compiler.
19 The report generated is in the following format:
30 Each B<File> section reports on a single file. Each B<Subroutine> section
31 reports on a single subroutine apart from the special cases
32 "(definitions)" and "(main)". These report, respectively, on subroutine
33 definitions found by the initial symbol table walk and on the main part of
34 the program or module external to all subroutines.
36 The report is then grouped by the B<Package> of each variable,
37 subroutine or format with the special case "(lexicals)" meaning
38 lexical variables. Each B<object> name (implicitly qualified by its
39 containing B<Package>) includes its type character(s) at the beginning
40 where possible. Lexical variables are easier to track and even
41 included dereferencing information where possible.
43 The C<line numbers> are a comma separated list of line numbers (some
44 preceded by code letters) where that object is used in some way.
45 Simple uses aren't preceded by a code letter. Introductions (such as
46 where a lexical is first defined with C<my>) are indicated with the
47 letter "i". Subroutine and method calls are indicated by the character
48 "&". Subroutine definitions are indicated by "s" and format
53 Option words are separated by commas (not whitespace) and follow the
54 usual conventions of compiler backend options.
60 Directs output to C<FILENAME> instead of standard output.
64 Raw output. Instead of producing a human-readable report, outputs a line
65 in machine-readable form for each definition/use of a variable/sub/format.
69 Don't output the "(definitions)" sections.
73 (Internal) debug options, probably only useful if C<-r> included.
74 The C<t> option prints the object on the top of the stack as it's
75 being tracked. The C<O> option prints each operator as it's being
76 processed in the execution order of the program.
82 Non-lexical variables are quite difficult to track through a program.
83 Sometimes the type of a non-lexical variable's use is impossible to
84 determine. Introductions of non-lexical non-scalars don't seem to be
89 Malcolm Beattie, mbeattie@sable.ox.ac.uk.
95 use B qw(peekop class comppadlist main_start svref_2object walksymtable
96 OPpLVAL_INTRO SVf_POK OPpOUR_INTRO cstring
99 sub UNKNOWN { ["?", "?", "?"] }
101 my @pad; # lexicals in current pad
102 # as ["(lexical)", type, name]
103 my %done; # keyed by $$op: set when each $op is done
104 my $top = UNKNOWN; # shadows top element of stack as
105 # [pack, type, name] (pack can be "(lexical)")
106 my $file; # shadows current filename
107 my $line; # shadows current line number
108 my $subname; # shadows current sub name
109 my %table; # Multi-level hash to record all uses etc.
110 my @todo = (); # List of CVs that need processing
112 my %code = (intro => "i", used => "",
113 subdef => "s", subused => "&",
114 formdef => "f", meth => "->");
118 my ($debug_op, $debug_top, $nodefs, $raw);
121 my ($var, $event) = @_;
122 my ($pack, $type, $name) = @$var;
124 if ($event eq "used") {
126 } elsif ($event eq "subused") {
130 $type =~ s/(.)\*$/$1/g;
132 printf "%-16s %-12s %5d %-12s %4s %-16s %s\n",
133 $file, $subname, $line, $pack, $type, $name, $event;
136 push(@{$table{$file}->{$subname}->{$pack}->{$type.$name}->{$event}},
143 my ($namelistav, $vallistav, @namelist, $ix);
145 return if class($padlist) eq "SPECIAL";
146 ($namelistav,$vallistav) = $padlist->ARRAY;
147 @namelist = $namelistav->ARRAY;
148 for ($ix = 1; $ix < @namelist; $ix++) {
149 my $namesv = $namelist[$ix];
150 next if class($namesv) eq "SPECIAL";
151 my ($type, $name) = $namesv->PV =~ /^(.)([^\0]*)(\0.*)?$/;
152 $pad[$ix] = ["(lexical)", $type || '?', $name || '?'];
154 if ($Config{useithreads}) {
156 @vallist = $vallistav->ARRAY;
157 for ($ix = 1; $ix < @vallist; $ix++) {
158 my $valsv = $vallist[$ix];
159 next unless class($valsv) eq "GV";
160 next if class($valsv->STASH) eq 'SPECIAL';
161 # these pad GVs don't have corresponding names, so same @pad
162 # array can be used without collisions
163 $pad[$ix] = [$valsv->STASH->NAME, "*", $valsv->NAME];
171 for ($op = $start; $$op; $op = $op->next) {
172 last if $done{$$op}++;
173 warn sprintf("top = [%s, %s, %s]\n", @$top) if $debug_top;
174 warn peekop($op), "\n" if $debug_op;
175 my $opname = $op->name;
176 if ($opname =~ /^(or|and|mapwhile|grepwhile|range|cond_expr)$/) {
178 } elsif ($opname eq "match" || $opname eq "subst") {
179 xref($op->pmreplstart);
180 } elsif ($opname eq "substcont") {
181 xref($op->other->pmreplstart);
184 } elsif ($opname eq "enterloop") {
188 } elsif ($opname eq "subst") {
189 xref($op->pmreplstart);
192 my $ppname = "pp_$opname";
193 &$ppname($op) if defined(&$ppname);
200 my $pack = $cv->GV->STASH->NAME;
201 $subname = ($pack eq "main" ? "" : "$pack\::") . $cv->GV->NAME;
202 load_pad($cv->PADLIST);
209 xref_cv(svref_2object($cvref));
214 load_pad(comppadlist);
217 xref_cv(shift @todo);
230 $top = $pad[$op->targ];
231 process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used");
234 sub pp_padav { pp_padsv(@_) }
235 sub pp_padhv { pp_padsv(@_) }
238 my ($op, $var, $as) = @_;
239 $var->[1] = $as . $var->[1];
240 process($var, $op->private & OPpOUR_INTRO ? "intro" : "used");
243 sub pp_rv2cv { deref(shift, $top, "&"); }
244 sub pp_rv2hv { deref(shift, $top, "%"); }
245 sub pp_rv2sv { deref(shift, $top, "\$"); }
246 sub pp_rv2av { deref(shift, $top, "\@"); }
247 sub pp_rv2gv { deref(shift, $top, "*"); }
252 if ($Config{useithreads}) {
253 $top = $pad[$op->padix];
254 $top = UNKNOWN unless $top;
259 $top = [$gv->STASH->NAME, '$', $gv->SAFENAME];
261 process($top, $op->private & OPpLVAL_INTRO ||
262 $op->private & OPpOUR_INTRO ? "intro" : "used");
268 if ($Config{useithreads}) {
269 $top = $pad[$op->padix];
270 $top = UNKNOWN unless $top;
275 $top = [$gv->STASH->NAME, "*", $gv->SAFENAME];
277 process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used");
283 # constant could be in the pad (under useithreads)
286 (class($sv) ne "SPECIAL" && $sv->FLAGS & SVf_POK)
287 ? cstring($sv->PV) : "?"];
290 $top = $pad[$op->targ];
291 $top = UNKNOWN unless $top;
297 $top = ["(method)", "->".$top->[1], $top->[2]];
302 if ($top->[1] eq "m") {
303 process($top, "meth");
305 process($top, "subused");
311 # Stuff for cross referencing definitions of variables and subs
318 #return if $done{$$cv}++;
321 process([$gv->STASH->NAME, "&", $gv->NAME], "subdef");
324 my $form = $gv->FORM;
326 return if $done{$$form}++;
329 process([$gv->STASH->NAME, "", $gv->NAME], "formdef");
333 sub xref_definitions {
334 my ($pack, %exclude);
336 $subname = "(definitions)";
337 foreach $pack (qw(B O AutoLoader DynaLoader XSLoader Config DB VMS
338 strict vars FileHandle Exporter Carp PerlIO::Layer
339 attributes utf8 warnings)) {
340 $exclude{$pack."::"} = 1;
342 no strict qw(vars refs);
343 walksymtable(\%{"main::"}, "xref", sub { !defined($exclude{$_[0]}) });
348 my ($file, $subname, $pack, $name, $ev, $perfile, $persubname,
349 $perpack, $pername, $perev);
350 foreach $file (sort(keys(%table))) {
351 $perfile = $table{$file};
352 print "File $file\n";
353 foreach $subname (sort(keys(%$perfile))) {
354 $persubname = $perfile->{$subname};
355 print " Subroutine $subname\n";
356 foreach $pack (sort(keys(%$persubname))) {
357 $perpack = $persubname->{$pack};
358 print " Package $pack\n";
359 foreach $name (sort(keys(%$perpack))) {
360 $pername = $perpack->{$name};
362 foreach $ev (qw(intro formdef subdef meth subused used)) {
363 $perev = $pername->{$ev};
364 if (defined($perev) && @$perev) {
365 my $code = $code{$ev};
366 push(@lines, map("$code$_", @$perev));
369 printf " %-16s %s\n", $name, join(", ", @lines);
378 my ($option, $opt, $arg);
380 while ($option = shift @options) {
381 if ($option =~ /^-(.)(.*)/) {
385 unshift @options, $option;
388 if ($opt eq "-" && $arg eq "-") {
391 } elsif ($opt eq "o") {
392 $arg ||= shift @options;
393 open(STDOUT, ">$arg") or return "$arg: $!\n";
394 } elsif ($opt eq "d") {
396 } elsif ($opt eq "r") {
398 } elsif ($opt eq "D") {
399 $arg ||= shift @options;
400 foreach $arg (split(//, $arg)) {
403 } elsif ($arg eq "O") {
405 } elsif ($arg eq "t") {
415 foreach $objname (@options) {
416 $objname = "main::$objname" unless $objname =~ /::/;
417 eval "xref_object(\\&$objname)";
418 die "xref_object(\\&$objname) failed: $@" if $@;