Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

ztksearch

by zentara (Archbishop)
on May 09, 2004 at 16:28 UTC ( #351865=sourcecode: print w/ replies, xml ) Need Help??

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;

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


Comment on ztksearch
Download Code
Re: ztksearch
by graff (Chancellor) on May 10, 2004 at 03:32 UTC
    Hey, it works for you, and it's a great idea -- you got my ++.

    Still, I'd point out that your "Next", "Previous" and "Delete Entry" buttons have a lot in common among their respective "-command" callback subs, so you'd be better off writing an actual sub that takes a parameter for each mode of operation, and set the "-command" options to something like [\&manip_entry, 'next'] etc. Eliminating redundant lines of code is always a good thing.

    Apart from that, I would also suggest that consistent and logical indentation is always worthwhile. The pattern you have in the "display_text" sub is especially gruesome and somewhat misleading.

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://351865]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (6)
As of 2014-09-30 20:43 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (383 votes), past polls