5 B::Xref - Generates cross reference reports for Perl programs
9 perl -MO=Xref[,OPTIONS] foo.pl
13 The B::Xref module is used to generate a cross reference listing of all
14 definitions and uses of variables, subroutines and formats in a Perl program.
15 It is implemented as a backend for the Perl compiler.
17 The report generated is in the following format:
22 object1 C<line numbers>
23 object2 C<line numbers>
28 Each B<File> section reports on a single file. Each B<Subroutine> section
29 reports on a single subroutine apart from the special cases
30 "(definitions)" and "(main)". These report, respectively, on subroutine
31 definitions found by the initial symbol table walk and on the main part of
32 the program or module external to all subroutines.
34 The report is then grouped by the B<Package> of each variable,
35 subroutine or format with the special case "(lexicals)" meaning
36 lexical variables. Each B<object> name (implicitly qualified by its
37 containing B<Package>) includes its type character(s) at the beginning
38 where possible. Lexical variables are easier to track and even
39 included dereferencing information where possible.
41 The C<line numbers> are a comma separated list of line numbers (some
42 preceded by code letters) where that object is used in some way.
43 Simple uses aren't preceded by a code letter. Introductions (such as
44 where a lexical is first defined with C<my>) are indicated with the
45 letter "i". Subroutine and method calls are indicated by the character
46 "&". Subroutine definitions are indicated by "s" and format
51 Option words are separated by commas (not whitespace) and follow the
52 usual conventions of compiler backend options.
58 Directs output to C<FILENAME> instead of standard output.
62 Raw output. Instead of producing a human-readable report, outputs a line
63 in machine-readable form for each definition/use of a variable/sub/format.
67 (Internal) debug options, probably only useful if C<-r> included.
68 The C<t> option prints the object on the top of the stack as it's
69 being tracked. The C<O> option prints each operator as it's being
70 processed in the execution order of the program.
76 Non-lexical variables are quite difficult to track through a program.
77 Sometimes the type of a non-lexical variable's use is impossible to
78 determine. Introductions of non-lexical non-scalars don't seem to be
83 Malcolm Beattie, mbeattie@sable.ox.ac.uk.
88 use B qw(peekop class comppadlist main_start svref_2object walksymtable
92 sub UNKNOWN { ["?", "?", "?"] }
94 my @pad; # lexicals in current pad
95 # as ["(lexical)", type, name]
96 my %done; # keyed by $$op: set when each $op is done
97 my $top = UNKNOWN; # shadows top element of stack as
98 # [pack, type, name] (pack can be "(lexical)")
99 my $file; # shadows current filename
100 my $line; # shadows current line number
101 my $subname; # shadows current sub name
102 my %table; # Multi-level hash to record all uses etc.
103 my @todo = (); # List of CVs that need processing
105 my %code = (intro => "i", used => "",
106 subdef => "s", subused => "&",
107 formdef => "f", meth => "->");
111 my ($debug_op, $debug_top, $nodefs, $raw);
114 my ($var, $event) = @_;
115 my ($pack, $type, $name) = @$var;
117 if ($event eq "used") {
119 } elsif ($event eq "subused") {
123 $type =~ s/(.)\*$/$1/g;
125 printf "%-16s %-12s %5d %-12s %4s %-16s %s\n",
126 $file, $subname, $line, $pack, $type, $name, $event;
129 push(@{$table{$file}->{$subname}->{$pack}->{$type.$name}->{$event}},
136 my ($namelistav, @namelist, $ix);
138 return if class($padlist) eq "SPECIAL";
139 ($namelistav) = $padlist->ARRAY;
140 @namelist = $namelistav->ARRAY;
141 for ($ix = 1; $ix < @namelist; $ix++) {
142 my $namesv = $namelist[$ix];
143 next if class($namesv) eq "SPECIAL";
144 my ($type, $name) = $namesv->PV =~ /^(.)([^\0]*)(\0.*)?$/;
145 $pad[$ix] = ["(lexical)", $type, $name];
152 for ($op = $start; $$op; $op = $op->next) {
153 last if $done{$$op}++;
154 warn sprintf("top = [%s, %s, %s]\n", @$top) if $debug_top;
155 warn peekop($op), "\n" if $debug_op;
156 my $opname = $op->name;
157 if ($opname =~ /^(or|and|mapwhile|grepwhile|range|cond_expr)$/) {
159 } elsif ($opname eq "match" || $opname eq "subst") {
160 xref($op->pmreplstart);
161 } elsif ($opname eq "substcont") {
162 xref($op->other->pmreplstart);
165 } elsif ($opname eq "enterloop") {
169 } elsif ($opname eq "subst") {
170 xref($op->pmreplstart);
173 my $ppname = "pp_$opname";
174 &$ppname($op) if defined(&$ppname);
181 my $pack = $cv->GV->STASH->NAME;
182 $subname = ($pack eq "main" ? "" : "$pack\::") . $cv->GV->NAME;
183 load_pad($cv->PADLIST);
190 xref_cv(svref_2object($cvref));
195 load_pad(comppadlist);
198 xref_cv(shift @todo);
211 $top = $pad[$op->targ];
212 process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used");
215 sub pp_padav { pp_padsv(@_) }
216 sub pp_padhv { pp_padsv(@_) }
220 $var->[1] = $as . $var->[1];
221 process($var, "used");
224 sub pp_rv2cv { deref($top, "&"); }
225 sub pp_rv2hv { deref($top, "%"); }
226 sub pp_rv2sv { deref($top, "\$"); }
227 sub pp_rv2av { deref($top, "\@"); }
228 sub pp_rv2gv { deref($top, "*"); }
233 $top = [$gv->STASH->NAME, '$', $gv->NAME];
234 process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used");
240 $top = [$gv->STASH->NAME, "*", $gv->NAME];
241 process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used");
248 (class($sv) ne "SPECIAL" && $sv->FLAGS & SVf_POK) ? $sv->PV : "?"];
253 $top = ["(method)", "->".$top->[1], $top->[2]];
258 if ($top->[1] eq "m") {
259 process($top, "meth");
261 process($top, "subused");
267 # Stuff for cross referencing definitions of variables and subs
274 #return if $done{$$cv}++;
277 process([$gv->STASH->NAME, "&", $gv->NAME], "subdef");
280 my $form = $gv->FORM;
282 return if $done{$$form}++;
285 process([$gv->STASH->NAME, "", $gv->NAME], "formdef");
289 sub xref_definitions {
290 my ($pack, %exclude);
292 $subname = "(definitions)";
293 foreach $pack (qw(B O AutoLoader DynaLoader Config DB VMS
294 strict vars FileHandle Exporter Carp)) {
295 $exclude{$pack."::"} = 1;
297 no strict qw(vars refs);
298 walksymtable(\%{"main::"}, "xref", sub { !defined($exclude{$_[0]}) });
303 my ($file, $subname, $pack, $name, $ev, $perfile, $persubname,
304 $perpack, $pername, $perev);
305 foreach $file (sort(keys(%table))) {
306 $perfile = $table{$file};
307 print "File $file\n";
308 foreach $subname (sort(keys(%$perfile))) {
309 $persubname = $perfile->{$subname};
310 print " Subroutine $subname\n";
311 foreach $pack (sort(keys(%$persubname))) {
312 $perpack = $persubname->{$pack};
313 print " Package $pack\n";
314 foreach $name (sort(keys(%$perpack))) {
315 $pername = $perpack->{$name};
317 foreach $ev (qw(intro formdef subdef meth subused used)) {
318 $perev = $pername->{$ev};
319 if (defined($perev) && @$perev) {
320 my $code = $code{$ev};
321 push(@lines, map("$code$_", @$perev));
324 printf " %-16s %s\n", $name, join(", ", @lines);
333 my ($option, $opt, $arg);
335 while ($option = shift @options) {
336 if ($option =~ /^-(.)(.*)/) {
340 unshift @options, $option;
343 if ($opt eq "-" && $arg eq "-") {
346 } elsif ($opt eq "o") {
347 $arg ||= shift @options;
348 open(STDOUT, ">$arg") or return "$arg: $!\n";
349 } elsif ($opt eq "d") {
351 } elsif ($opt eq "r") {
353 } elsif ($opt eq "D") {
354 $arg ||= shift @options;
355 foreach $arg (split(//, $arg)) {
358 } elsif ($arg eq "O") {
360 } elsif ($arg eq "t") {
370 foreach $objname (@options) {
371 $objname = "main::$objname" unless $objname =~ /::/;
372 eval "xref_object(\\&$objname)";
373 die "xref_object(\\&$objname) failed: $@" if $@;