http://qs321.pair.com?node_id=351865
Category: GUI Programming
Author/Contact Info zentara
Description: This is a pure perl search and display app using Tk. I use it to browse my perl snippets. Here is a ztksearch screenshot

It uses File::Find to recursively search directories, and filter thru text files for an exact match on a word or phrase. I don't slurp the files, but process the files line by line, stopping the file search after the first match. So multiline matches are missed.

The screen is updated in realtime, so you can start viewing the first return, while the search continues. I didn't spend too much time on formatting output, so man pages may have "clutter", but are still readable.

#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use Tk::HList;
use Tk::Pane;
use File::Find;
use File::Spec;

my $maxfilesize = 5000000;  #limit file opens to 5 meg 
my $h;        #my HList; 
my $search = '';   #string to search for 
my $regex;
my $case = 1; #defaults to case sensitive  
my $cur_info; #currently selected file info  
my $display;  #labels to display info 
my $display1;
my $display2;
my $text;      #the textbox 
my $firstflag; #flag for displaying first result 
my $indicator; #searching indicator 
my $indicate = -1;
my $stop;      #used to stop excessively long searches 

my $mw = MainWindow->new(-bg=>'black');
$mw->geometry('800x700+100+15');

$mw->bind('<Control-c>', [sub{Tk::exit;}] );

my $topframe = $mw->Frame(-height =>30, -background=>'darkgrey')
                            ->pack(-fill=>'both', -expand=>1);

my $leftframe = $mw->Frame( -width =>25,
                            -background=>'black',
                            )->pack(-side => "left", -anchor => "n",
                                     -fill=>'both', -expand=>1);

my $mainframe = $mw->Frame(-background=>'black')
                            ->pack(-side => "right", -anchor => "n",
                              -fill=>'both', -expand=>1);

#create leftframe  
HList2();

#fill mainframe with default screen  
setup_pane();

$topframe->Button(-text => "Next",
                   -bg=>'cyan3',
                   -activebackground =>'cyan',
                   -padx=>40,
                   -relief=>'raised',
                   -command => sub {
                       if(defined  $h->info('selection')){
                       my $next = $h->info('next',$h->info('selection'
+));

                       if($next){
                              $h->selectionClear($h->info('selection')
+);
                              $h->selectionSet($next);
                              $h->see($next);
                              browseThis($next);
                            }else{print chr(07)}
                       }
                    })->pack(-side =>'left');

$topframe->Button(-text => "Previous",
                   -bg=>'thistle3',
                   -activebackground =>'thistle1',
                   -padx=>40,
                   -relief=>'raised',
                   -command => sub {
                          if(defined  $h->info('selection')){
                          my $prev = $h->info('prev',$h->info('selecti
+on'));

                           if($prev){
                              $h->selectionClear($h->info('selection')
+);
                              $h->selectionSet($prev);
                              $h->see($prev);
                              browseThis($prev);
                            }else{print chr(07)}
                         }
                  })->pack(-side =>'left');

$topframe->Button(-text => "Exit",
                   -bg => 'lightgrey',
                   -activebackground =>'snow',
                   -padx=>40,
                   -relief=>'raised',
                   -command => sub { exit; })->pack(-side =>'right');


$topframe->Button(-text => "Stop Search",
                   -bg => 'red',
                   -activebackground =>'yellow',
                   -relief=>'raised',
                   -command => sub {$stop = 1})->pack(-side =>'right',
+-padx => 20);
                          
                   
$topframe->Button(-text => "Delete Entry",
                   -bg=>'pink',
                   -activebackground =>'hotpink',
                   -padx=>40,
                   -relief=>'raised',
                   -command => sub {

                       if(defined  $h->info('selection')){
                       my $next = $h->info('next',$h->info('selection'
+));
                       my $prev = $h->info('prev',$h->info('selection'
+));
                       
                       $h->delete( 'entry', $h->info('selection') );

                       if($next){
                              $h->selectionClear($h->info('selection')
+);
                              $h->selectionSet($next);
                              $h->see($next);
                              browseThis($next);
                       }elsif($prev){
                              $h->selectionClear($h->info('selection')
+);
                              $h->selectionSet($prev);
                              $h->see($prev);
                              browseThis($prev);
                       }else{print chr(07)}
                     }
                   })->pack();

MainLoop;

sub HList2 {

 $h = $leftframe->Scrolled( 'HList',
                               -header => 1,
                               -columns => 1,
                               -width => 20,
                               -height => 60,
                               -takefocus => 1,
                               -background => 'steelblue',
                               -foreground =>'snow',
                               -selectmode => 'single',
                               -selectforeground => 'pink',
                               -selectbackground => 'black',
                               -browsecmd => \&browseThis,
                   )->pack(-side => "left", -anchor => "n");

$h->header('create', 0, -text => '    FILENAME ',
                        -borderwidth => 3,
                        -headerbackground => 'steelblue',
                        -relief => 'raised');

}

############################################################# 
sub setup_pane{

my $pane = $mainframe->Pane(
               -width => 1000,
               -height =>1000,
               -background => 'black',
               -sticky => 'n',
              )->pack(-side => "left", -anchor => "n",
                      -fill=>'both',-expand=>1);


# search entry box 
my $f1 = $pane->Frame(-background => 'black')
                 ->pack(-side => 'top', -fill => 'x', -expand => 1, -p
+ady =>5);

$f1->Label(-text=>"Search: ",-background => 'black',-foreground => 'gr
+een')
                                -> pack(-side =>'left', -anchor => 'n'
+);

my $entry = $f1->Entry(-textvariable => \$search,
                    -width =>50,
                    -bg => 'white',
                    ) ->pack(-side=>'left', -anchor => 'n');

$entry->focus();
$entry->bind('<Return>', [sub{&search_it}] );

$f1->Checkbutton(-text => 'Case Sensitive',
                 -bg => 'grey',
                 -fg => 'black',
                 -padx => 10,
                 -onvalue => 1,
                 -offvalue => 0,
                 -variable => \$case)->pack(-side =>'left');

########################################################## 
#currently selected file info 
my $f1a = $pane->Frame(-background => 'black')
                 ->pack(-side => 'top', -fill => 'x', -expand => 1);

$f1a->Label(-text=>"Filename: ",-background => 'black',-foreground => 
+'green')
                                -> pack(-side =>'left', -anchor => 'n'
+);

$display = $f1a->Label(-text=>'' ,-background => 'black',-foreground =
+> 'lightblue')
                               -> pack(-side =>'left', -anchor => 'n')
+;

my $f1b = $pane->Frame(-background => 'black')
                 ->pack(-side => 'top', -fill => 'x', -expand => 1);

$f1b->Label(-text=>"Size: ",-background => 'black',-foreground => 'gre
+en')
                                -> pack(-side =>'left', -anchor => 'n'
+);

$display1 = $f1b->Label(-text=>'' ,-background => 'black',-foreground 
+=> 'pink')
                               -> pack(-side =>'left', -anchor => 'n')
+;

my $f1c = $pane->Frame(-background => 'black')
                 ->pack(-side => 'top', -fill => 'x', -expand => 1);

$f1c->Label(-text=>"FullPath: ",-background => 'black',-foreground => 
+'green')
                                -> pack(-side =>'left', -anchor => 'n'
+);

$display2 = $f1c->Label(-text=>'' ,-background => 'black',-foreground 
+=> 'yellow')
                               -> pack(-side =>'left', -anchor => 'w')
+;

################################################################## 
#text box to display files 
my $f2 = $pane->Frame(-background => 'black')
                 ->pack(-side => 'bottom', -fill => 'both', -expand =>
+ 1,);


$text = $f2->Scrolled('Text',-scrollbars=>'se', -bg => 'lightyellow',
                          -height=>45
                          )->pack(-fill=>'both', -expand=>1);

}
##############################################################  
sub browseThis {
   my $ent = shift;
   my $data = $h->info('data',$ent);

$indicator->cancel;

my (undef,undef,$filename) = File::Spec->splitpath( $data );
my $size = -s $data;

$display->configure(-text=>  $filename);
$display1->configure(-text=> $size);
$display2->configure(-text=> $data);

&display_text($data);
}
############################################################ 
sub add_file{

my ($file,$abs_path)  = @_;

my $e = $h->addchild("",-data => $abs_path);

    $h->itemCreate ($e, 0,
       -itemtype => 'text',
       -text => $file,
           );
}
################################################################# 
sub search_it{

  if(length $search == 0){print chr(07);return}

 $h->delete('all');
 $firstflag = 0;
 $stop = 0;

#start the blinking "Searching message indicator " 
 $indicator = $mw->repeat(500,\&indicate);

my $path =  File::Spec->rel2abs('.');

if ($case){$regex =  qr/\Q$search\E/}
          else{$regex =  qr/\Q$search\E/i}

find(\&wanted,$path);

if($firstflag == 0){
   print chr(07);
   $indicator->cancel;
   $text->delete("1.0","end");
   $text->see("1.0");
   $text->insert('end',"NO RESULTS !!!!!");
 }

#goto hack to exit File::Find early 
FINISHED:

}

################################################################# 
sub wanted{
    return unless (-f and -T);  #only consider text files     
    if(-s $File::Find::name > $maxfilesize){return}

    open(FILE, $File::Find::name) || die "Cant open $File::Find::name:
+ $!\n";
      while (<FILE>) {           #process files line by line, no slurp
+ 
           next unless /$regex/;

      my $localname = File::Spec->abs2rel($File::Find::name);
      &add_file($localname, $File::Find::name);

     if($firstflag == 0){ #on subsequent searches the first entry 
                          #will not be 0, due to HList's internal coun
+ter 
                         my $first = $h->info('children');
                         &browseThis($first);
                         $h->selectionSet($first);
                         $firstflag = 1;
                        }
                        
      last;  #quit searching file after first match 
             #the textbox will show all matches 
          }

   close(FILE);
   $h->update;
   if($stop == 1){ goto FINISHED}
 }
##################################################################### 

sub display_text {
my $file = shift;

$text->delete("1.0","end");
$text->see("1.0");

$text->tagConfigure( 'search', -foreground => 'black',-background => '
+lightgreen' );

my $buf;

if($file =~ /([Hh]tml?|HTML?)$/ ){
    $buf = `lynx -dump -force_html $file`;
       }elsif($file =~ /(pdf|PDF)$/){
         $buf = `pdftotext $file -`;
           }elsif($file =~ /(ps|PS|eps|EPS)$/){
              $buf = `ps2ascii $file`;
                }elsif($file =~ /(pod)$/){
                   $buf = `pod2text $file`;
                     }else{
                         open (FH,"< $file") or warn "$! \n";
                         read( FH, $buf, -s FH );
                         close FH;
      }

$text->insert('end',$buf);

&search_text($text,\$search,'search','exact');

}
#################################################################### 

sub search_text {

    # The utility procedure below searches for all instances of a give
+n 
    # string in a text widget and applies a given tag to each instance
+ found. 
    # Arguments: 
    # 
    # w -       The window in which to search.  Must be a text widget.
+ 
    # string -  Reference to the string to search for.  The search is 
+done 
    #           using exact matching only;  no special characters. 
    # tag -     Tag to apply to each instance of a matching string. 

    my ( $w, $string, $tag, $kind ) = @_;
    #print "@_\n"; 

    return unless ref($string) && length($$string);

    $w->tagRemove( $tag, qw/0.0 end/ );
    my ( $current, $length ) = ( '1.0', 0 );

    my ($current_last, $length_last);

    while (1) {
       if($case){
           $current =
              $w->search(-count => \$length, "-$kind", $$string, $curr
+ent, 'end' );
          }else{
           $current =
             $w->search(-count => \$length, "-$kind",'-nocase', $$stri
+ng, $current, 'end' );
         }

        last if not $current;
#       warn "Posn=$current count=$length\n", 

        $w->see($current);

          $w->tagAdd( $tag, $current, "$current + $length char" );
        $current = $w->index("$current + $length char");
    }

}    # end search_text 
######################################################################
+ 
sub indicate {
   $indicate = -$indicate;  #negative toggle 
   $text->delete("1.0","end");
   $text->see("1.0");
   $text->insert('end','Searching ');
 if($indicate == -1){$text->insert('end',' .....No Results Yet')}
 $text->update;

}
####################################################################