File:ctagsPerlFilter.pl v.1.1.0 --- a textpad utility for searching perl packages and subs and jumping to them

# File:ctagsPerlFilter.pl v.1.0.0 docs at the end 

use strict ; use warnings ; 

package ctagsPerlFilter ; 

use Carp qw(cluck);

our ( $StrFileCtags , $FileCtags , $FileSourceCode , $DirSourceCode ) = () ; 

our ( $FileNameSourceCode ) = () ; 

our ( $Filter ) = () ; 

our ( @RowsFileCtags , @FilteredRowsFileCtags ) = () ; 

our ( @SubRoutines , $StrSubRoutines ) = () ; 

# -----------------------------------------------------------------------------

# Initials the global vars from the cmd

# -----------------------------------------------------------------------------

sub Initialize { 

   $FileSourceCode = $ARGV[0] ; 

   $Filter =  $ARGV[1] ; 

   $FileSourceCode =~ m/^(.*)(\\|\/)(.*)/; 

   $FileNameSourceCode = "$3" ; 

   $DirSourceCode = "$1" ; 

   $FileCtags = "$DirSourceCode/tags" ; 

}

#eof sub Initialize

# -----------------------------------------------------------------------------

# filters the build ctags file from the 

# -----------------------------------------------------------------------------

sub filterCtagsFile { 

   my $RefFileCtags = ReadFileReturnArray ( $FileCtags ) ; 

   @RowsFileCtags = @$RefFileCtags ; 

   #filter only the file name to query for

   @FilteredRowsFileCtags = grep(/$Filter/, @RowsFileCtags); 

   #filter for subroutines 

   @FilteredRowsFileCtags = grep(/$Filter/, @FilteredRowsFileCtags); 

   # go trough the filtered rows 

   foreach my $row ( @FilteredRowsFileCtags ) { 

      my @rowTokens = split ( '\s+' , $row ) ; 

      my $SubRoutineName = $rowTokens[0] ; 

      my $SrcFile = $rowTokens[1] ; 

      $SrcFile =~ s/\.\\//g ; 

      $SrcFile = "$DirSourceCode\\$SrcFile" ; 

      my $PackageName = $rowTokens[1] ; 

      # leave only the package name , remove the path and the file extension 

      no warnings ; 

      $PackageName =~ s/^(.*)(\\|\/)(.*)(\.)([a-z]*)/$3/; use warnings ; 

      my $LineNumber = $rowTokens[2] ; 

      $LineNumber =~ s/^(\D*)(\d*)(\D*)$/$2/g ; 

      # build the printable array 

      push ( @SubRoutines , "$PackageName\.$SubRoutineName $LineNumber $SrcFile" ) ; 

   } #eof foreach 

     #sort the array     

    @SubRoutines = sort { lc($a) cmp lc($b) } @SubRoutines   ; # alphabetical sort 

    #build the printable string 

    $StrSubRoutines = join ( "\n" , @SubRoutines ) ; 

} #eof sub filterCtagsFile

# -----------------------------------------------------------------------------

# Reads a file returns a sting out of it

# -----------------------------------------------------------------------------

sub ReadFileReturnString {

   my $FileToRead = shift ; 

   my $ErrorMsg = "can not read \$FileToRead $FileToRead !!! "; 

   cluck ( "$ErrorMsg   $! !!!" )       unless ( (-e $FileToRead) && (-f $FileToRead) && (-r $FileToRead) ) ; 

   return $ErrorMsg                       unless ( (-e $FileToRead) && (-f $FileToRead) && (-r $FileToRead) ) ;

   #debug print " readFileReturnString \$FileToRead is $FileToRead \n" ; 

   #todo: detect whether the file is utf8 encoded 

   #how-to slurp file

   my $string = (); 

   local $/=undef;

   open FILE, "$FileToRead " or cluck ( "Couldn't open \$FileToRead $FileToRead : $!" ) ; 

   $string = <FILE>;

   close FILE;

   return $string ; 

} #eof sub readFileReturnString 

# -----------------------------------------------------------------------------

# Read a file and return an array

# -----------------------------------------------------------------------------

sub ReadFileReturnArray {

   my $file = shift ;

   unless ( defined $file ) {

      cluck  ( "undefined file $file !!! $! \n\n" ) ; 

      return ; 

   }

   #READ ALL ROWS OF A FILE TO ALIST 

    open (INPUT, "<$file") || cluck  ( "could not open the file $file !!! $! \n\n"   ) ; 

       my @ArrFile =<INPUT> ;

    close INPUT;

   return \@ArrFile ; 

} #eof sub 

# -----------------------------------------------------------------------------

# the main entry point of the script - captures fatal erros 

# if any and opens the fatal errors file 

# -----------------------------------------------------------------------------

sub main { 

    #check for runtime errors 

    eval { 

         Initialize();

         filterCtagsFile();

         print STDOUT "$StrSubRoutines" ; 

    };

    #Trap run-time erros in the whole perl application and print them to FatalErrorsLog.log in cd

    if ( $@ )           {      

         cluck $@ ;

         #provide time for the user to grasp !!!

         sleep 2 ; 

         open  (  F , ">>FatalErrorsLog.log" );

         print    F $@ ; 

         print F localtime(time) . "\n";

         close F ; 

         #open the fatal erros file 

         `FatalErrorsLog.log` ; 

   } #eof if  errors found      

} 

#eof sub main 

# Action !!!

main();

1 ; 

=head1 NAME

ctagsPerlFilter

=head1 SYNOPSIS

this scripts assumes that you have run 

ctags.exe -R -n --fields=+i+K+S+l+m+a on your directory 

perl ctagsPerlFilter.pl <<FullFilePath>> <<SelectedWordToSearchFor>>

This is the registry setting for the tool ( change the path in the Parameters value t) 

Windows Registry Editor Version 5.00

[HKEY_CURRENT_USER\Software\Helios\TextPad 5\Tools\11]

"Properties"=hex:01,00,00,00,61,80,00,00,f8,4b,00,00

"MenuText"="cmd /c perl $FileName $Sel "

"Command"="cmd.exe"

"Parameters"="perl F:\\morphus\\morphus.1.2.1.dev.ysg\\conf\\HOSTNAME\\textpad\\perl\\ctagsPerlFilter.pl $File $SelWord"

"Folder"="$FileDir"

"RE"="(.+)[ ]([0-9]+)[ ](.*)"

=head1 DESCRIPTION

An intellisence like functionality to filter the subroutines and package names from a ctags db file

Requirements: 

perl ; ) 

ctags 

=head2 EXPORT

=head1 SEE ALSO

perldoc perlvars

No mailing list for this module

=head1 AUTHOR

yordan.georgiev@gmail.com

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2011 Yordan Georgiev

This library is free software; you can redistribute it and/or modify

it under the same terms as Perl itself, either Perl version 5.8.1 or,

at your option, any later version of Perl 5 you may have available.

VersionHistory: 

1.1.0 --- 2012-05-06 11:10:06 --- ysg --- Added registry settings 

1.0.0 --- 2012-05-05 21:12:13  --- ysg --- Initial version

=cut