#!perl

use 5.006;
use strict;
use Getopt::Long;
use Pod::Usage;

use vars qw($VERSION);
$VERSION = '0.00_3';


my (@EXCLUDE,       # exclude these packages
    @INCLUDE,       # but always include these
    @ISCALLED,      # are these functions called at all?
    $NOEMPTY,       # do not include subs that do not call other subs
    $CALLTREEOPTS,  # options passed to Devel::Calltree
    @PERLLIBS,
    $CODE,
    @INC,
    @PERLOPTS,
    $SCRIPT,
    $REPORTFUNCS,
);

pod2usage(-verbose => 1, -exitvalue => 2) if !@ARGV;

# FIXME this is not the best solution
my $INTERPRETER = $^X;  

Getopt::Long::Configure ("bundling");

GetOptions( 'exclude|x=s'	    => sub { push @EXCLUDE, split /,/, $_[1] },
            'include|i=s'	    => sub { push @INCLUDE, split /,/, $_[1] },
            'chkfunc|c=s'	    => sub { push @ISCALLED, split /,/, $_[1] },
            'noempty|n'		    => \$NOEMPTY,
            'module|M|m=s'	    => \@PERLLIBS,
            'e=s'		    => \$CODE,
            'I=s'		    => \@INC,
            'help|h'		    => sub { pod2usage(-verbose => 1, -exitvalue => 0) },
	    'version|v'		    => sub { print "calltree $VERSION\n"; exit 0 },
	    'reportfunc|r=s'	    => \$REPORTFUNCS,
        );

($SCRIPT, @PERLOPTS) = build_perlops();

if (@EXCLUDE || @INCLUDE and @ISCALLED) {
    pod2usage( -message => "Error: You must not use --chkfunc together with --include or --exclude\n",
               -verbose => 1,
               -exitval => 2,);

}

$CALLTREEOPTS = qq/-MDevel::Calltree/;

# I suspect the following lines are highly unportable
if (@EXCLUDE) {
    my $pat = 'q\!' . join('\!,q\!', @EXCLUDE) . '\!';
    $CALLTREEOPTS .= qq/\\ -exclude=\\>[$pat],/;
}
if (@INCLUDE) {
    my $pat = 'q\!' . join('\!,q\!',@INCLUDE) . '\!';
    $CALLTREEOPTS .= qq/-include=\\>[$pat],/;
}
if ($NOEMPTY) {
    $CALLTREEOPTS .= qq/\\ -filter_empty=\\>1,/;
} else {
    $CALLTREEOPTS .= qq/\\ -filter_empty=\\>0,/;
}
if (@ISCALLED) {
    my $pat = 'q\!' . join('\!,q\!', @ISCALLED) . '\!';
    $CALLTREEOPTS .= qq/\\ -iscalled=\\>[$pat],/;
}
if ($REPORTFUNCS) {
    $CALLTREEOPTS .= qq/\\ -reportfuncs=\\>\\"$REPORTFUNCS\\",/;
}

if (!$CODE) {
    if (!$SCRIPT) {
        $CODE = 1;  # simplest possible script
    } else {
        local *S;
        open S, "<$SCRIPT" or 
            pod2usage( -message => "Error: '$SCRIPT' could not be opened: $!\n",
                       -verbose => 1,
                       -exitval => 2, );
        $CODE = do { local $/; <S> };
        close S;
    }
}

open PERL, "| $INTERPRETER $CALLTREEOPTS @PERLOPTS"
    or die "Could not execute $INTERPRETER: $!";
print PERL $CODE;
close PERL;

sub build_perlops {
    my $script = shift @ARGV;
    my @opts = map "-I$_", @INC;
    if (!$ENV{PERL5LIB}) {
        push @opts, map "-I$_", split /:/, $ENV{ PERLLIB };
    } else {
        push @opts, map "-I$_", split /:/, $ENV{ PERL5LIB };
    }
    push @opts, map "-M$_", @PERLLIBS;
    return ($script, @opts);
}
    
__END__

=head1 NAME

calltree - Who called whom

=head1 SYNOPSIS

    calltree    --exclude=<pkg1>...<pkgN> --include=<pkg3>...<pkgQ>
                --noempty
		[ --reportfunc file ]
                [ -Iinc/path1 -Iinc/path2 -I...] [ -Mmodule1 -Mmodule2 -M...]
                [ -e <CODE> | script.pl ]

    calltree    --chkfunc=<fnc1>...<funcN>
                [ -Iinc/path1 -Iinc/path2 -M...] [ -Mmodule1 -Mmodule2 -M...]
                [ -e <CODE> | script.pl ]

=head1 OPTIONS

=over 4

=item * B<--exclude> LIST

A comma-separated list of regular expressions. Functions matching any of the
expressions are excluded from the report.

=item * B<--include> LIST

A comma-separated list of regular expressions. Functions matching any of the
expressions are always included from the report (even when they match one
in I<--exclude>.

=item * B<--chkfunc> LIST

A comma-separated list of regular expressions. All functions matching one of
the expression are checked whether they are called at all. This function cannot
be used together with I<--exclude> or I<--include>.

=item * B<--noempty>

Exclude functions from the generated report that do not call any other
functions.

=item * B<--reportfunc> FILE

Load FILE and use the function 'Devel::Calltree::print_report' defined therein
to create the report instead of the built-in report functions.

=item * B<-I>path

The same as perl's I<-I>. This is used to add directories to @INC.

=item * B<-M>module

The same as perl's I<-M>. This runs the code after C<use>ing the module
I<module>. Can be used to print the calltree of a module:

    calltree -MMy::Module

=item * B<-e> 'CODE'

The same as perl's I<-e>. This is used to pass the code that shall be inspected.

=back

=head1 DESCRIPTION

F<calltree> inspects the OP-tree of a program or module after compilation is
done and creates a report showing which method and function has been called by
whom.

The default output is pretty straightforward. When not using the I<--chkfunc>
switch, it looks like this:

    Package::func  (/path/to/Package.pm)
      method   'some_method'                                      (68)
      function 'Pkg::function'                                    (70)
      
    Package::nest::otherfunc  (/path/to/Package/nest.pm)
      method   'foobar'                                           (10)
    
    ...

    __MAIN__ (-)
      function 'Package::func::func'                              (3)

It begins with the fully qualified function followed by the path to the file in
which this function resides. After that a list of function and method calls
follows. The line where this call happens is prepended.

The last in the list is always B<__MAIN__> which is the report for what happens
in package main. This doesn't necessarily exist (e.g. when you only inspect a
module).

In I<--chkfunc> mode, output looks like this:

    calltree --chkfunc=foo,bar -e 'sub foo {1} print foo()'
    These patterns did not match any called function:
      bar

    These functions were called:
      function main::foo        from __MAIN__           at line 1

=head1 PROVIDING YOUR OWN REPORT FUNCTIONS

With the help of the I<--reportfunc> switch, you can tell F<calltree> to use a different
function for outputting the report. The argument to this switch must be a file that contains
the function C<Devel::Calltree::print_report>. The file itself must additionally return a true
value.

A skeleton of this file therefore must look like this:

    sub Devel::Calltree::print_report {
	...
    }
    
    "MJD kindly reminded calltree's author of putting in this feature";

=head2 Devel::Calltree::print_report

This function will receive exactly one argument, namely a hash-reference which is additionally
blessed in some fancy way. The keys of this hash are the various functions that F<calltree> was
able to find in your code. The value is an array-reference holding C<Devel::Calltree::Func> objects
where each object represents exactly one call to a function or method that was done from within
the given function.

The hash-reference passed to C<Devel::Calltree::print_report> overloads the C<@{}> operator. That means
that in order to iterate over all functions in your program, you can simply write:

    sub Devel::Calltree::print_report {
	my $calls = shift;
	for my $func (@$calls) {
	    print $func, "\n";
	    ...
	}
    }

This is often more convenient than writing

    for my $func (keys %$calls) {

because C<@$calls> will return the list of functions sorted by package and then by function names.

Now that you are iterating over all exiting functions, you want to look at what
is called from each function. To get the list of these method/function calls:

    for my $func (@$calls) {
	my @called = funcs($calls->{ $func });
	...
    }

where now C<@called> contains the list of C<Devel::Calltree::Func> objects. The list returned
by C<funcs()> has the same order in which the function/method calls were done. That means they
are sorted by line-number.

Additionally, there's a C<file()> function that returns the filename where the current function
resides in.

    for my $func (@$calls) {
	print "$func lives in ", file($calls->{ $func });
	...
    }

Here's a list of methods you can use on each C<Devel::Calltree::Func> object:

=over 4

=item * B<name>

Returns the name of the function/method. If it is a function, the name is fully package-qualified.
Otherwise it is just the name without the package (there is no easy way to package-qualify a method
call at INIT-time).

=item * B<line>

Returns the linenumber where this function/method was called.

=item * B<file>

Returns the name of the file in which this function was called.

=item * B<is_method>

Returns a true value when this function is in fact a method.

=back

Here is an example how a complete report function should look like. This function is in fact producing
the same output as the built-in report function:

    sub print_report {
	my $calls = shift;
	for my $caller (@$calls) {
	    my $file = file($calls->{ $caller });
	    if (funcs($calls->{$caller}) || !$OPT{-filter_empty} ) {
		print "\n$caller  ($file): \n";
		for my $targ (funcs($calls->{$caller})) {
		    my $n = $targ->name;
		    my $l = $targ->line;
		    if ($targ->is_method) {
			print "  method   '$n'", ' ' x (60 - 14 - length($n)), " ($l)\n"; 
			next;
		    }
		    print "  function '$n'", ' ' x (60 - 14 - length($n)), " ($l)\n";
		}
	    }
	}
    }

C<%OPT> holds the arguments which F<calltree> passed on to the underlying module:

=over 4

=item * B<-exclude>

The list of regular expressions passed to F<calltree> through the I<--exclude> switch.

=item * B<-include>

The list of regular expressions passed to F<calltree> through the I<--include> switch.

=item * B<-filter_empty>

Is true when I<--noempty> was passed to F<calltree>.

=item * B<-iscalled>

The list of regular expressions passed to F<calltree> through the I<--chkfunc> switch.

=back

=head1 EXAMPLES

See the calltree of a script:

    calltree script.pl

Or one of a script given on the command-line:

    calltree -e '...'

See the calltree of the module URI:

    calltree -MURI

The same, but skip empty functions (those that do not make calls to others):

    calltree --noempty -MURI

The same, but ignore functions not in the URI:: namespace:

    calltree --noempty --exclude=. --include=URI:: -MURI

Thus, use I<--exclude=.> to exclude everything and then include only functions
from the URI:: namespace with I<--include=URI::>.

And finally check whether a particular function is called at all:

    calltree --chkfunc=Carp::croak -MURI

=head1 ENVIRONMENT VARIABLES

F<calltree> uses C<PERLLIB> and C<PERL5LIB> in a similar fashion as perl does.

=head1 TODO

=over 4

=item * Add a count for function calls

=item * Better control over I<--chkfunc> (packages can't currently be excluded)

=item * Fix some fatal runtime errors that appear to happen sometimes on defined but uncalled functions

=head1 AUTHOR

Original idea and code by Mark Jason Dominus E<lt>mjd@plover.comE<gt>.

Current maintainer Tassilo von Parseval E<lt>tassilo.parseval@post.rwth-aachen.deE<gt>.

=head1 COPYRIGHT AND LICENSE

Original code copyright (C) 2003 by Mark Jason Dominus

Revisions copyright (C) 2004 by Tassilo von Parseval

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

=cut
