#!/usr/local/bin/perl -w
###########################################
# ptags - A PPI-based ctags for Perl
# Mike Schilli, 2005 (m@perlmeister.com)
###########################################
use strict;

use PPI::Document;
use File::Find;
use Sysadm::Install qw(:all);
use Log::Log4perl qw(:easy);

my $outfile = "$ENV{HOME}/.ptags.txt";
my %dirs  = ();
my @found = ();

find \&file_wanted, grep {$_ ne "."} @INC;

blurt join("\n", sort @found), $outfile;

###########################################
sub file_wanted {
###########################################
    my $abs = $File::Find::name;

        # Avoid dupe dirs
    $File::Find::prune = 1 if -d and 
        $dirs{$abs}++;

        # Only Perl modules
    return unless /\.pm$/;

    my $d = PPI::Document->load($abs);

    unless($d) {
        WARN "Cannot load $abs ($! $@)";
        return;
    }
        # Find packages and 
        # all named subroutines
    $d->find(\&document_wanted);
}

###########################################
sub document_wanted {
###########################################
    our $package;
    my  $tag;

    if(ref($_[1]) eq 
           'PPI::Statement::Package') {
        $tag = $_[1]->child(2)->content();
        $package = $tag;

    } elsif(ref($_[1]) eq 
            'PPI::Statement::Sub' and 
            $_[1]->name()) {
        $tag = "$package\::" . 
               $_[1]->name();
    }

    return 1 unless defined $tag;

    push @found, $tag . "\t" . 
                 $File::Find::name . "\t" .
                 regex_from_node($_[1]);

    return 1;
}

###########################################
sub regex_from_node {
###########################################
    my($node) = @_;

    my $regex = $node->content();
   
    $regex =~ s/\n.*//gs;

    while(my $prev = 
             $node->previous_sibling()) {
        last if $prev =~ /\n/;
        $regex = $prev->content() . 
                 $regex;
        $node  = $prev;
    }

    $regex =~ s#[/.*[\]^\$]#\\$&#g;
    return "/^$regex/";
}