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);
90 # Constants (should probably be elsewhere)
91 sub OPpLVAL_INTRO () { 128 }
92 sub SVf_POK () { 0x40000 }
94 sub UNKNOWN { ["?", "?", "?"] }
96 my @pad; # lexicals in current pad
97 # as ["(lexical)", type, name]
98 my %done; # keyed by $$op: set when each $op is done
99 my $top = UNKNOWN; # shadows top element of stack as
100 # [pack, type, name] (pack can be "(lexical)")
101 my $file; # shadows current filename
102 my $line; # shadows current line number
103 my $subname; # shadows current sub name
104 my %table; # Multi-level hash to record all uses etc.
105 my @todo = (); # List of CVs that need processing
107 my %code = (intro => "i", used => "",
108 subdef => "s", subused => "&",
109 formdef => "f", meth => "->");
113 my ($debug_op, $debug_top, $nodefs, $raw);
116 my ($var, $event) = @_;
117 my ($pack, $type, $name) = @$var;
119 if ($event eq "used") {
121 } elsif ($event eq "subused") {
125 $type =~ s/(.)\*$/$1/g;
127 printf "%-16s %-12s %5d %-12s %4s %-16s %s\n",
128 $file, $subname, $line, $pack, $type, $name, $event;
131 push(@{$table{$file}->{$subname}->{$pack}->{$type.$name}->{$event}},
138 my ($namelistav, @namelist, $ix);
140 return if class($padlist) eq "SPECIAL";
141 ($namelistav) = $padlist->ARRAY;
142 @namelist = $namelistav->ARRAY;
143 for ($ix = 1; $ix < @namelist; $ix++) {
144 my $namesv = $namelist[$ix];
145 next if class($namesv) eq "SPECIAL";
146 my ($type, $name) = $namesv->PV =~ /^(.)(.*)$/;
147 $pad[$ix] = ["(lexical)", $type, $name];
154 for ($op = $start; $$op; $op = $op->next) {
155 last if $done{$$op}++;
156 warn sprintf("top = [%s, %s, %s]\n", @$top) if $debug_top;
157 warn peekop($op), "\n" if $debug_op;
158 my $ppname = $op->ppaddr;
159 if ($ppname =~ /^pp_(or|and|mapwhile|grepwhile)$/) {
161 } elsif ($ppname eq "pp_match" || $ppname eq "pp_subst") {
162 xref($op->pmreplstart);
163 } elsif ($ppname eq "pp_substcont") {
164 xref($op->other->pmreplstart);
167 } elsif ($ppname eq "pp_cond_expr") {
168 # pp_cond_expr never returns op_next
172 } elsif ($ppname eq "pp_enterloop") {
176 } elsif ($ppname eq "pp_subst") {
177 xref($op->pmreplstart);
180 &$ppname($op) if defined(&$ppname);
187 my $pack = $cv->GV->STASH->NAME;
188 $subname = ($pack eq "main" ? "" : "$pack\::") . $cv->GV->NAME;
189 load_pad($cv->PADLIST);
196 xref_cv(svref_2object($cvref));
201 load_pad(comppadlist);
204 xref_cv(shift @todo);
210 $file = $op->filegv->SV->PV;
217 $top = $pad[$op->targ];
218 process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used");
221 sub pp_padav { pp_padsv(@_) }
222 sub pp_padhv { pp_padsv(@_) }
226 $var->[1] = $as . $var->[1];
227 process($var, "used");
230 sub pp_rv2cv { deref($top, "&"); }
231 sub pp_rv2hv { deref($top, "%"); }
232 sub pp_rv2sv { deref($top, "\$"); }
233 sub pp_rv2av { deref($top, "\@"); }
234 sub pp_rv2gv { deref($top, "*"); }
239 $top = [$gv->STASH->NAME, '$', $gv->NAME];
240 process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used");
246 $top = [$gv->STASH->NAME, "*", $gv->NAME];
247 process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used");
254 (class($sv) ne "SPECIAL" && $sv->FLAGS & SVf_POK) ? $sv->PV : "?"];
259 $top = ["(method)", "->".$top->[1], $top->[2]];
264 if ($top->[1] eq "m") {
265 process($top, "meth");
267 process($top, "subused");
273 # Stuff for cross referencing definitions of variables and subs
280 #return if $done{$$cv}++;
281 $file = $gv->FILEGV->SV->PV;
283 process([$gv->STASH->NAME, "&", $gv->NAME], "subdef");
286 my $form = $gv->FORM;
288 return if $done{$$form}++;
289 $file = $gv->FILEGV->SV->PV;
291 process([$gv->STASH->NAME, "", $gv->NAME], "formdef");
295 sub xref_definitions {
296 my ($pack, %exclude);
298 $subname = "(definitions)";
299 foreach $pack (qw(B O AutoLoader DynaLoader Config DB VMS
300 strict vars FileHandle Exporter Carp)) {
301 $exclude{$pack."::"} = 1;
303 no strict qw(vars refs);
304 walksymtable(\%{"main::"}, "xref", sub { !defined($exclude{$_[0]}) });
309 my ($file, $subname, $pack, $name, $ev, $perfile, $persubname,
310 $perpack, $pername, $perev);
311 foreach $file (sort(keys(%table))) {
312 $perfile = $table{$file};
313 print "File $file\n";
314 foreach $subname (sort(keys(%$perfile))) {
315 $persubname = $perfile->{$subname};
316 print " Subroutine $subname\n";
317 foreach $pack (sort(keys(%$persubname))) {
318 $perpack = $persubname->{$pack};
319 print " Package $pack\n";
320 foreach $name (sort(keys(%$perpack))) {
321 $pername = $perpack->{$name};
323 foreach $ev (qw(intro formdef subdef meth subused used)) {
324 $perev = $pername->{$ev};
325 if (defined($perev) && @$perev) {
326 my $code = $code{$ev};
327 push(@lines, map("$code$_", @$perev));
330 printf " %-16s %s\n", $name, join(", ", @lines);
339 my ($option, $opt, $arg);
341 while ($option = shift @options) {
342 if ($option =~ /^-(.)(.*)/) {
346 unshift @options, $option;
349 if ($opt eq "-" && $arg eq "-") {
352 } elsif ($opt eq "o") {
353 $arg ||= shift @options;
354 open(STDOUT, ">$arg") or return "$arg: $!\n";
355 } elsif ($opt eq "d") {
357 } elsif ($opt eq "r") {
359 } elsif ($opt eq "D") {
360 $arg ||= shift @options;
361 foreach $arg (split(//, $arg)) {
364 } elsif ($arg eq "O") {
366 } elsif ($arg eq "t") {
376 foreach $objname (@options) {
377 $objname = "main::$objname" unless $objname =~ /::/;
378 eval "xref_object(\\&$objname)";
379 die "xref_object(\\&$objname) failed: $@" if $@;