lib/Sepia/Xref.pm

   1 package Sepia::Xref;
   2
   3 =head1 NAME
   4
   5 Sepia::Xref - Generates cross reference database for use by Perl programs.
   6
   7 =head1 SYNOPSIS
   8
   9     use Sepia::Xref qw(rebuild defs callers);
  10
  11     rebuild;
  12     for (defs 'foo') {
  13         printf "%s:%d: sub %s\::foo() defined\n", @{$_}[0..2];
  14     }
  15
  16     for (callers 'foo') {
  17         printf "%s:%d: sub foo() called by %s\::%s().\n", @{$_}[0..3];
  18     }
  19
  20 =head1 DESCRIPTION
  21
  22 C<Sepia::Xref> is intended as a programmatic interface to the
  23 information supplied by L<B::Xref>.  It is intended to be a component
  24 for interactive Perl development, with other packages providing a
  25 friendly interface to the raw information it extracts.  C<B::Xref>
  26 could be seen as an example of this sort of user-level tool, if it
  27 weren't for the fact that this module was created later, and stole
  28 most of its code.
  29
  30 =cut
  31
  32 # use Sepia '_apropos_re';
  33 require Sepia;
  34 BEGIN { *_apropos_re = *Sepia::_apropos_re; }
  35 $VERSION = '0.65';
  36
  37 use strict;
  38 use Config;
  39 use Cwd 'abs_path';
  40 use B qw(peekop class comppadlist main_start svref_2object walksymtable
  41          OPpLVAL_INTRO SVf_POK OPpOUR_INTRO OPf_MOD OPpDEREF_HV OPpDEREF_AV
  42          cstring);
  43 # stupid warnings...
  44 no warnings 'uninitialized';
  45
  46 =head2 Variables
  47
  48 =over
  49
  50 =item C<%call>
  51
  52 A map of subs to call locations and callers
  53
  54 =item C<%callby>
  55
  56 A map of subs to subs called.
  57
  58 =item C<%var_use>
  59
  60 A map of global/package variables to uses.
  61
  62 =item C<%var_def>
  63
  64 A map of global/package variables to definitions (usually empty, since
  65 it only picks up local (...) declarations.
  66
  67 =back
  68
  69 =cut
  70
  71 our %call;
  72 our %callby;
  73 our %var_def;
  74 our %var_use;
  75
  76 require Exporter;
  77 our @ISA = 'Exporter';
  78 my @most = qw(redefined forget rebuild callers callees
  79               var_defs var_uses
  80               var_apropos);
  81 our @EXPORT_OK = (@most,
  82     qw(xref_definitions xref_object xref_main
  83        %call %callby %var_use %var_def));
  84
  85 our %EXPORT_TAGS =
  86     (':all' => \@EXPORT_OK,
  87      ':most' => \@most);
  88
  89 ######################################################################
  90 ## Xref state variables:
  91
  92 sub UNKNOWN { ["?", "?", "?"] }
  93
  94 my @pad;                        # lexicals in current pad
  95                                 # as ["(lexical)", type, name]
  96 my @padval;
  97 our %done;                      # keyed by $$op: set when each $op is done
  98 my $top = UNKNOWN;              # shadows top element of stack as
  99                                 # [pack, type, name] (pack can be "(lexical)")
 100 our $file;                      # shadows current filename
 101 my $line;                       # shadows current line number
 102 our $subname;                   # shadows current sub name
 103 our @todo = ();                 # List of CVs that need processing
 104 my $lastclass;                  # last bareword seen after entersub.
 105
 106 our $DEBUG = 0;
 107 sub dprint {
 108     my $type = shift;
 109     my $res = "@_";
 110     $res =~ s/%//g;             # XXX: work around EPL's misuse of (message)
 111     print STDERR "@_" if $DEBUG =~ /$type/;
 112 }
 113
 114 my %code = (intro => "i", used => "",
 115             subdef => "s", subused => "&",
 116             formdef => "f", meth => "->");
 117
 118 =over 4
 119
 120 =head2 Functions
 121
 122 =item C<guess_module_file($pack, $ofile)>
 123
 124 XXX: it turns out that rooting around trying to figure out the file
 125 ourselves is more reliable than what we grab from the op.  Are we
 126 doing this wrong?
 127
 128 =cut
 129
 130 sub guess_module_file {
 131     my ($pack, $ofile) = @_;
 132     my $file;
 133
 134     # XXX: is this why we get the bogus defs?
 135     return undef if $ofile =~ /Exporter\.pm$/;
 136     # Try for standard translation in %INC:
 137     (my $fn = $pack) =~ s/::/\//g;
 138     return unless $fn;          # stupid warnings...
 139     if (exists $INC{"$fn.pm"}) {
 140         return $INC{"$fn.pm"};
 141     }
 142
 143     # Try what they told us:
 144     chomp $ofile;
 145     return $ofile if -f $ofile;
 146
 147     # Try "parent" packages:
 148     while ($fn =~ s|/?[^/]+$|| && !$file) {
 149         $file ||= $INC{"$fn.pm"};
 150     }
 151
 152     if ($file && $file !~ /^\//) {
 153         $file = abs_path($file);
 154     }
 155
 156     if (!$file || !-f $file) {
 157         undef $file;
 158     }
 159     $file;
 160 }
 161
 162 # XXX: should weed through the code below so it only generates decent
 163 # package names, but this will fix it for now.
 164 sub realpack {
 165     my $p = shift;
 166     if (!defined $p || $p eq '?' || $p eq '(method)') {
 167         return undef;
 168     } elsif ($p eq '') {
 169         return 'main';
 170     } else {
 171         return $p;
 172     }
 173 }
 174
 175 # Turn a possibly-qualified name into a package and basename.
 176 sub split_name {
 177     local $_ = shift;
 178     my ($p, $s);
 179     if (/^(.*)::(.+)$/) {
 180         ($p, $s) = ($1, $2);
 181     } else {
 182         ($p, $s) = ('main', $_);
 183     }
 184     undef $s if $s eq '?';
 185     ($p, $s);
 186 }
 187
 188 sub process {
 189     my ($var, $event) = @_;
 190     my ($pack, $type, $name) = @$var;
 191     $pack = realpack($pack);
 192     dprint 'loud', "Processing $event: @$var ($subname)";
 193     if ($type eq "*") {
 194         if ($event eq "used" || $event eq 'set') {
 195             return;
 196         } elsif ($event eq "subused") {
 197             $type = "&";
 198         } elsif ($event eq "meth") {
 199             $type = '->';
 200         }
 201     }
 202     $type =~ s/(.)\*$/$1/g;
 203     $file = guess_module_file($pack, $file);
 204
 205     if (($type eq '&' || $type eq '->') && $subname ne '(definitions)') {
 206         # Handle caller/callee relations
 207         my ($spack, $sname) = split_name($subname);
 208
 209         $call{$name}{$pack}{$subname} = 1;
 210         $callby{$sname}{$spack}{"$pack\::$name"} = 1;
 211     } elsif ($type eq 's' || $subname eq '(definitions)') {
 212         # definition
 213     } elsif ($name !~ /^[\x00-\x1f^] | ^\d+$ | ^[\W_]$
 214                        | ^(?:ENV|INC|STD(?:IN|OUT|ERR)|SIG)$ /x
 215              && realpack($pack)) {
 216         # Variables, but ignore specials and lexicals
 217         my ($spack, $sname) = split_name($subname);
 218         if ($event eq 'intro') {
 219             $var_def{$name}{$pack} =
 220             { file => $file,
 221               package => $spack,
 222               line => $line,
 223               sub => $sname,
 224             };
 225         } elsif ($event eq 'used' || $event eq 'set') {
 226             push @{$var_use{$name}{$pack}},
 227             { file => $file,
 228               package => $spack,
 229               line => $line,
 230               sub => $sname,
 231               assign => ($event eq 'set'),
 232             };
 233         } else {
 234             dprint 'ignore', "Ignoring var event $event";
 235         }
 236     } else {
 237         dprint 'ignore', "Ignoring $type event $event";
 238     }
 239 }
 240
 241 sub load_pad {
 242     my $padlist = shift;
 243     my ($namelistav, $vallistav, @namelist, $ix);
 244     @pad = ();
 245     @padval = ();
 246     return if class($padlist) eq "SPECIAL";
 247     ($namelistav,$vallistav) = $padlist->ARRAY;
 248     @namelist = $namelistav->ARRAY;
 249     for ($ix = 1; $ix < @namelist; $ix++) {
 250         my $namesv = $namelist[$ix];
 251         next if class($namesv) eq "SPECIAL";
 252         my ($type, $name) = $namesv->PV =~ /^(.)([^\0]*)(\0.*)?$/;
 253         $pad[$ix] = [undef, $type, $name];
 254     }
 255     if ($Config{useithreads}) {
 256         my (@vallist);
 257         @vallist = $vallistav->ARRAY;
 258         for ($ix = 1; $ix < @vallist; $ix++) {
 259             my $valsv = $vallist[$ix];
 260             next unless class($valsv) eq "GV";
 261             # these pad GVs don't have corresponding names, so same @pad
 262             # array can be used without collisions
 263
 264             # XXX: for some reason, on 5.10 $valsv->STASH can be a
 265             # B::SPECIAL, which doesn't have a name.
 266
 267             # XXX: this segfaults on 5.10 for some reason while
 268             # traversing File::Find::contract_name from main
 269
 270             next if ref $valsv->STASH eq 'B::SPECIAL';
 271             $pad[$ix] = [$valsv->STASH->NAME, "*", $valsv->NAME];
 272         }
 273     }
 274     @padval = $vallistav->ARRAY;
 275 }
 276
 277 sub xref {
 278     my $start = shift;
 279     my $op;
 280     for ($op = $start; $$op; $op = $op->next) {
 281         last if $done{$$op}++;
 282         my $opname = $op->name;
 283         if ($opname =~ /^(or|and|mapwhile|grepwhile|range|cond_expr)$/) {
 284             xref($op->other);
 285         } elsif ($opname eq "match" || $opname eq "subst") {
 286             xref($op->pmreplstart);
 287         } elsif ($opname eq "substcont") {
 288             xref($op->other->pmreplstart);
 289             $op = $op->other;
 290             redo;
 291         } elsif ($opname eq "enterloop") {
 292             xref($op->redoop);
 293             xref($op->nextop);
 294             xref($op->lastop);
 295         } elsif ($opname eq "subst") {
 296             xref($op->pmreplstart);
 297         } else {
 298             no strict 'refs';
 299             my $ppname = "pp_$opname";
 300             &$ppname($op) if defined(&$ppname);
 301         }
 302     }
 303 }
 304
 305 sub xref_cv {
 306     my $cv = shift;
 307     my $pack = $cv->GV->STASH->NAME;
 308     local $subname = ($pack eq "main" ? "" : "$pack\::") . $cv->GV->NAME;
 309     load_pad($cv->PADLIST);
 310     xref($cv->START);
 311 }
 312
 313 sub xref_object {
 314     my $cvref = shift;
 315     local (@todo, %done);
 316     my $cv = svref_2object($cvref);
 317     xref_cv($cv);
 318     dprint 'todo', "todo = (@todo)";
 319     my $gv = $cv->GV;
 320     process([$gv->STASH->NAME, '&', $gv->NAME], 'subdef');
 321 }
 322
 323 sub xref_main {
 324     $subname = "(main)";
 325     load_pad(comppadlist);
 326     xref(main_start);
 327     while (@todo) {
 328         xref_cv(shift @todo);
 329     }
 330 }
 331
 332 sub pp_pushmark {
 333     my $op = shift;
 334     my ($class, $meth);
 335     if (($class = $op->next)->name eq 'const') {
 336         my $sv = $class->sv;
 337         my $classname;
 338         # constant could be in the pad (under useithreads)
 339         if (class($sv) ne "SPECIAL" && $sv->FLAGS & SVf_POK) {
 340             $classname = $sv->PV;
 341         } else {
 342             my $pv = $padval[$class->targ];
 343             if (class($pv) =~ /^PV/ && class($sv) eq 'SPECIAL'
 344                 ## bareword flag -- should use this?
 345 #                 && ($op->private & 64)
 346                ) {
 347                 $classname = $pv->PV;
 348             }
 349         }
 350         $lastclass = $classname;
 351     }
 352 }
 353
 354 sub pp_nextstate {
 355     my $op = shift;
 356     $file = $op->file;
 357     die "pp_nextstate: $file" if $file =~ /::/;
 358     $line = $op->line;
 359     $top = UNKNOWN;
 360 }
 361
 362 sub use_type($) {
 363     my ($op) = @_;
 364     if ($op->private & (OPpLVAL_INTRO | OPpOUR_INTRO)) {
 365         'intro';
 366     } elsif ($op->flags & OPf_MOD
 367              && !($op->private & (OPpDEREF_HV | OPpDEREF_AV))) {
 368         'set';
 369     } else {
 370         'used';
 371     }
 372 }
 373
 374 sub pp_padsv {
 375     my $op = shift;
 376      $top = $pad[$op->targ];
 377 #     process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used");
 378 }
 379
 380 sub pp_padav { pp_padsv(@_) }
 381 sub pp_padhv { pp_padsv(@_) }
 382
 383 sub deref {
 384     my ($op, $var, $as) = @_;
 385     $var->[1] = $as . $var->[1];
 386     process($var, use_type $op);
 387 }
 388
 389 sub pp_rv2cv { deref(shift, $top, "&"); }
 390 sub pp_rv2hv { deref(shift, $top, "%"); }
 391 sub pp_rv2sv { deref(shift, $top, "\$"); }
 392 sub pp_rv2av { deref(shift, $top, "\@"); }
 393 sub pp_rv2gv { deref(shift, $top, "*"); }
 394
 395 sub pp_gvsv {
 396     my $op = shift;
 397     my $gv;
 398     if ($Config{useithreads}) {
 399         $top = $pad[$op->padix];
 400         $top = UNKNOWN unless $top;
 401         $top->[1] = '$';
 402     }
 403     else {
 404         $gv = $op->gv;
 405         $top = [$gv->STASH->NAME, '$', $gv->SAFENAME];
 406     }
 407     process($top, use_type $op);
 408 }
 409
 410 sub pp_gv {
 411     my $op = shift;
 412     my $gv;
 413     if ($Config{useithreads}) {
 414         $top = $pad[$op->padix];
 415         $top = UNKNOWN unless $top;
 416         $top->[1] = '*';
 417     }
 418     else {
 419         $gv = $op->gv;
 420         $top = [$gv->STASH->NAME, "*", $gv->SAFENAME];
 421     }
 422     process($top, use_type $op);
 423 }
 424
 425 sub pp_method {
 426     my $op = shift;
 427     $top = [$lastclass || "(method)", "->".$top->[1], $top->[2]];
 428     dprint 'method', "pp_method($top->[1])";
 429     undef $lastclass;
 430 }
 431
 432 sub pp_method_named {
 433     use Data::Dumper;
 434     my $op = shift;
 435     my $sv = $op->sv;
 436     my $pviv = $padval[$op->targ];
 437     if ($pviv && class($pviv) =~ /^PV/) {
 438         my $name = $pviv->PV;
 439         dprint 'method_named', $op->targ.": $name";
 440         undef $top->[2] if $top->[2] eq '?';
 441         $top = [$lastclass || "(method)", '->', $name];
 442         undef $lastclass;
 443     } else {
 444         dprint 'method_named', "method_named: wtf: sizeof padval = ".@padval;
 445     }
 446 }
 447
 448 sub pp_entersub {
 449     my $op = shift;
 450     if ($top->[1] =~ /^(?:m$|->)/) {
 451         dprint 'method', "call to (@$top) from $subname";
 452         process($top, "meth");
 453     } else {
 454         process($top, "subused");
 455     }
 456     undef $lastclass;
 457     $top = UNKNOWN;
 458 }
 459
 460 #
 461 # Stuff for cross referencing definitions of variables and subs
 462 #
 463
 464 sub B::GV::xref {
 465     my $gv = shift;
 466     my $cv = $gv->CV;
 467     $file = $gv->FILE;
 468     # XXX: sometimes the "file" is a module.  Why?
 469     $line = $gv->LINE;
 470     if ($$cv) {
 471         #return if $done{$$cv}++;
 472         process([$gv->STASH->NAME, "&", $gv->NAME], "subdef");
 473         push(@todo, $cv);
 474     }
 475     my $form = $gv->FORM;
 476     if ($$form) {
 477         return if $done{$$form}++;
 478         process([$gv->STASH->NAME, "", $gv->NAME], "formdef");
 479     }
 480 }
 481
 482 ## Exclude all pragmatic modules (lowercase first letter) and the
 483 ## following problematic things, which tend to cause more harm than
 484 ## good when they get xref'd:
 485 my %exclude;
 486 BEGIN {
 487     undef $exclude{"$_\::"}
 488         for qw(B O AutoLoader DynaLoader XSLoader Config DB VMS
 489                FileHandle Exporter Carp PerlIO::Layer);
 490 }
 491
 492 sub xref_exclude {
 493     my $x = shift;
 494     $x =~ /^[a-z]/ || exists $exclude{$x};
 495 }
 496
 497 sub xref_definitions {
 498     my ($pack, %exclude);
 499     $subname = "(definitions)";
 500     no strict qw(vars refs);
 501     walksymtable(\%{"main::"}, "xref", sub { !xref_exclude($_[0]) });
 502 }
 503
 504 =item C<rebuild()>
 505
 506 Rebuild the Xref database.
 507
 508 =cut
 509
 510 sub rebuild {
 511     %call = (); %callby = ();
 512     %var_def = (); %var_use = ();
 513     local (@todo, %done);
 514     xref_definitions;
 515     xref_main;
 516     1;
 517 }
 518
 519 sub unmention {
 520     my ($h, $K, $V, $pack) = @_;
 521     dprint 'unmention', "Unmentioning $K => $V";
 522     while (my ($k, $v) = each %$h) {
 523         while (my ($k2, $v2) = each %$v) {
 524             if (ref $v2 eq 'ARRAY') {
 525                 $v->{$k2} = [grep {
 526                     $_->{$K} ne $V || !$pack || $pack ne $_->{package}
 527                 } @$v2];
 528                 delete $v->{$k2} unless @{$v->{$k2}};
 529             } else {
 530                 delete $v->{$k2} if $k2 eq $V;
 531             }
 532         }
 533         delete $h->{$k} unless keys %{$h->{$k}};
 534     }
 535 }
 536
 537 sub unmention_sub {
 538     my ($h, $sub, $pack) = @_;
 539     dprint 'unmention', "Unmentioning $pack\::$sub";
 540     if ($pack) {
 541         delete $h->{$sub}{$pack};
 542         delete $h->{$sub} unless keys %{$h->{$sub}};
 543     } else {
 544         delete $h->{$sub};
 545     }
 546 }
 547
 548 =item C<forget($func [, $mod])>
 549
 550 Forget that C<$func> was defined.
 551
 552 =cut
 553
 554 sub forget {
 555     my ($obj, $pack) = @_;
 556     unmention_sub \%callby, @_;
 557     unmention \%call, 'sub', @_;
 558     unmention \%var_use, 'sub', @_;
 559     unmention \%var_def, 'sub', @_;
 560 }
 561
 562 =item C<redefined($func [, $pack])>
 563
 564 Recompute xref info for C<$func>, or C<$pack::$func> if C<$pack> given.
 565
 566 =cut
 567
 568 sub redefined {
 569     forget @_;
 570     {
 571         no strict 'refs';
 572         my ($sub, $pack) = @_;
 573         $pack ||= 'main';
 574         $sub = $pack eq 'main' ? $sub : "$pack\::$sub";
 575         local $subname = '(definitions)';
 576         xref_object \&$sub;
 577     }
 578 }
 579
 580 ######################################################################
 581 # Apropos and definition-finding:
 582
 583 sub _ret_list
 584 {
 585     my ($h, $sub, $mod) = @_;
 586     if ($sub =~ /^(.*)::([^:]+)$/) {
 587         $sub = $2;
 588         $mod = $1;
 589     }
 590     $h = $h->{$sub};
 591     my @r;
 592     if ($mod) {
 593         @r = keys %{$h->{$mod}};
 594     } else {
 595 #        @r = map { @$_ } values %$h;
 596         my %h;
 597         @h{keys %$_} = 1 for values %$h;
 598         @r = keys %h;
 599     }
 600     @r = sort @r;
 601     return wantarray ? @r : \@r;
 602 }
 603
 604 sub _var_ret_list
 605 {
 606     my ($h, $v, $mod, $assign) = @_;
 607     if ($v =~ /^(.*)::([^:]+)$/) {
 608         $mod = $1;
 609         $v = $2;
 610     }
 611     $h = $h->{$v};
 612     my @r;
 613     if ($mod) {
 614         @r = exists $h->{$mod} ? @{$h->{$mod}} : ();
 615     } else {
 616         ## XXX: Need to revisit when this is/isn't an array!
 617         @r = map { ref $_ eq 'ARRAY' ? @$_ : $_ } values %$h;
 618     }
 619     @r = grep $_->{assign}, @r if $assign;
 620     @r = map { [@{$_}{qw(file line sub package)}] } @r;
 621     return wantarray ? @r : \@r;
 622 }
 623
 624 =item C<callers($func)>
 625
 626 List callers of C<$func>.
 627
 628 =cut
 629
 630 sub callers {
 631     _ret_list \%call, @_;
 632 }
 633
 634 =item C<callees($func)>
 635
 636 List callees of C<$func>.
 637
 638 =cut
 639
 640 sub callees {
 641     _ret_list \%callby, @_;
 642 }
 643
 644 =item C<var_defs($var)>
 645
 646 Find locations where C<$var> is defined.
 647
 648 =cut
 649
 650 sub var_defs {
 651     return _var_ret_list \%var_def, @_;
 652 }
 653
 654 =item C<var_uses($var)>
 655
 656 Find locations where C<$var> is used.
 657
 658 =cut
 659
 660 sub var_uses {
 661     return _var_ret_list \%var_use, @_;
 662 }
 663
 664 =item C<var_assigns($var)>
 665
 666 Find locations where C<$var> is assigned to.
 667
 668 =cut
 669
 670 sub var_assigns {
 671     my ($v, $pack) = @_;
 672     return _var_ret_list \%var_use, $v, $pack, 1;
 673 }
 674
 675 =item C<file_modules($file)>
 676
 677 List the modules defined in file C<$file>.
 678
 679 =cut
 680
 681 sub file_modules {
 682     my $file = shift;
 683     eval {
 684         require Module::Info;
 685         my $mod = Module::Info->new_from_file(abs_path($file));
 686         if ( $mod ) {
 687             return $mod->packages_inside();
 688         }
 689     }
 690 }
 691
 692 =item C<var_apropos($expr)>
 693
 694 Find variables matching C<$expr>.
 695
 696 =cut
 697
 698 sub _apropos {
 699     my ($h, $re, $mod) = @_;
 700     my @r = do {
 701         if($re) {
 702             $re = _apropos_re($re);
 703             sort grep /$re/, keys %$h;
 704         } else {
 705             sort keys %$h;
 706         }
 707     };
 708     if ($mod) {
 709         $mod = _apropos_re($mod);
 710         my %r;
 711         for (@r) {
 712             my $sn = $_;
 713             for (keys %{$h->{$_}}) {
 714                 $r{$_ eq 'main' ? $sn : "$_\::$sn"} = 1 if /$mod/;
 715             }
 716         }
 717         @r = sort keys %r;
 718     }
 719     return wantarray ? @r : \@r;
 720 }
 721
 722 sub var_apropos {
 723     _apropos \%var_use, @_;
 724 }
 725
 726 1;
 727
 728 __END__
 729
 730 =back
 731
 732 =head1 EXPORTS
 733
 734 Nothing by default, but all sub and variable described above can be
 735 imported.  C<Sepia::Xref> also defines the tags C<:most> for the
 736 above-listed functions, and C<:all> for those and the variables as
 737 well.
 738
 739 =head1 BUGS
 740
 741 =over 4
 742
 743 =item See L<B::Xref>.
 744
 745 =item module names are ignored when looking up a sub.
 746
 747 =item file and line number guessing is evil
 748
 749 Both should be done more cleanly and effectively.  This is a hack
 750 because I don't quite understand what perl saves.  We should be able
 751 to do as well as its warning messages.
 752
 753 =item Some packages are not xref'd.
 754
 755 Some "internal" packages are deliberately not cross-referenced, either
 756 because they are hairy and cause us problems, or because they are so
 757 commonly included as to be uninteresting.  The current list includes
 758 all pragmatic modules, plus: B, O, AutoLoader, DynaLoader, XSLoader,
 759 Config, DB, VMS, FileHandle, Exporter, Carp, PerlIO::Layer.
 760
 761 =item Tree-view is not fully functional
 762
 763 Ideally, clicking the function names in tree view would take you to
 764 that function.  This doesn't work.  Also, more keys (like "q" to quit)
 765 should be implemented.
 766
 767 =back
 768
 769 =head1 SEE ALSO
 770
 771 C<B::Xref>, of which C<Sepia::Xref> is a bastard child.
 772
 773 =head1 AUTHOR
 774
 775 L<B::Xref> by Malcolm Beattie, m(angl|odifi)ed by Sean O'Rourke
 776 (seano@cpan.org).
 777
 778 =cut