Scanning file version 2.0

[Anton van der Steen]

Hey guys,

Here is version 2.0 for scanning files.
I have added scrollbars to the text area and a function
to print OUT the result to a other file.
Below you will find the script.

I have tested it with Perl 5.8.6 from ActiveState.com,
bear this in mind.

Have fun.

Anton van der Steen, another perl addict
Eindhoven/The Netherlands/Europe


#!/perl/bin/perl
#Dit programma is geschreven door Anton van der Steen
#Email adres: (e-mail address removed)
use Tk;

my $mw = new MainWindow; # Main Window
$mw->title("Search Engine Version 2.0 by Stone Logic Systems");

my $frm_name = $mw -> Frame() -> pack();


my $lab1 = $frm_name -> Label(-text=>"Phrase :", -font =>
'-adobe-helvetica-bold-r-normal--11-120-75-75-p-70-*

-1') -> pack();
my $ent1 = $frm_name -> Entry(-width=>100, -borderwidth=>2
) -> pack();
$ent1->configure(-font =>
'-adobe-helvetica-bold-r-normal--11-120-75-75-p-70-*-1');


my $lab2=$frm_name->Label(-text=>"Search in File :", -font =>
'-adobe-helvetica-bold-r-normal--11-120-75-75-p-

70-*-1')->pack();

my $ent2=$frm_name->Entry(-width=>100)->pack();
$ent2->configure(-font =>
'-adobe-helvetica-bold-r-normal--11-120-75-75-p-70-*-1');

my $lab3=$frm_name->Label(-text=>"Save out to file :", -font =>
'-adobe-helvetica-bold-r-normal--11-120-75-75-

p-70-*-1')->pack();

my $ent3=$frm_name->Entry(-width=>100)->pack();
$ent3->configure(-font =>
'-adobe-helvetica-bold-r-normal--11-120-75-75-p-70-*-1');


my $but1 = $mw -> Button(-text=>"Count Appearance Phrase", -command
=>\&push_button1, -background=>"green",
-font => '-adobe-helvetica-bold-r-normal--11-120-75-75-p-70-*-1') ->
pack();

my $but2 = $mw -> Button(-text=>"Show text", -command
=>\&push_button2, -background=>"yellow",
-font => '-adobe-helvetica-bold-r-normal--11-120-75-75-p-70-*-1') ->
pack();

my $but3 = $mw -> Button(-text=>"Clear Text Area", -command
=>\&push_button3, -background=>"orange",
-font => '-adobe-helvetica-bold-r-normal--11-120-75-75-p-70-*-1') ->
pack();

my $but4 = $mw -> Button(-text=>"Save result to file", -command
=>\&push_button4, -background=>"cyan",
-font => '-adobe-helvetica-bold-r-normal--11-120-75-75-p-70-*-1') ->
pack();


#Text Area
my $txt = $mw->Scrolled( 'Text' , -scrollbars=>'se' , -wrap=> 'none');
$txt->configure(-width=>150, -height=>35);
$txt->pack();

MainLoop;

sub push_button1 {

use Getopt::Std;

my $name1 = $ent1 -> get();
my $name2 = $ent2 -> get();
@ARGV= ($name1, $name2);
#print @ARGV;

$i=0;

my $pattern = shift @ARGV;


foreach $file (@ARGV)
{
open (FILE, $file);
while ($line = <FILE>)
{
if ($line =~m"$pattern")
{
$i++;
last if ($opt_1);


}

}
print "The phrase $pattern is $i times found!!\n";


$txt-> insert ('0.0',"The phrase $pattern is $i times found in file
$file.\n");
close (FILE);
$i=0;

}


sub push_button2 {

use Getopt::Std;

my $name1 = $ent1 -> get();
my $name2 = $ent2 -> get();
@ARGV= ($name1, $name2);

$i=0;

my $pattern = shift @ARGV;


foreach $file (@ARGV)
{
open (FILE, $file);
while ($line = <FILE>)
{
if ($line =~m"$pattern")
{
$i++;
last if ($opt_1);
$txt-> insert ('end', "$line\n");
print "$line\n";

}

}

close (FILE);
$i=0;

}

}


sub push_button3 {
$txt-> delete ('0.0', 'end');


}

sub push_button4 {

use Getopt::Std;

my $name1 = $ent1 -> get();
my $name2 = $ent2 -> get();
my $file_out = $ent3 -> get();

@ARGV= ($name1, $name2);

$i=0;

my $pattern = shift @ARGV;

open(OUT,">$file_out");


foreach $file (@ARGV)
{
open (FILE, $file);
while ($line = <FILE>)
{
if ($line =~m"$pattern")
{
$i++;
last if ($opt_1);
print OUT "$line\n";

}

}

close (FILE);
$i=0;

}
close(OUT);

}









};

 

[Mark Clements]

Hey guys,

Here is version 2.0 for scanning files.
I have added scrollbars to the text area and a function
to print OUT the result to a other file.
Below you will find the script.

I have tested it with Perl 5.8.6 from ActiveState.com,
bear this in mind.

Have fun.

er, great: a GUI for grep. A few points:

Anton van der Steen, another perl addict
Eindhoven/The Netherlands/Europe


#!/perl/bin/perl
#Dit programma is geschreven door Anton van der Steen
#Email adres: (e-mail address removed)
use Tk;

you need

use strict;
use warnings;

my $mw = new MainWindow; # Main Window
$mw->title("Search Engine Version 2.0 by Stone Logic Systems");

my $frm_name = $mw -> Frame() -> pack();


my $lab1 = $frm_name -> Label(-text=>"Phrase :", -font =>
'-adobe-helvetica-bold-r-normal--11-120-75-75-p-70-*

-1') -> pack();
my $ent1 = $frm_name -> Entry(-width=>100, -borderwidth=>2
) -> pack();
$ent1->configure(-font =>
'-adobe-helvetica-bold-r-normal--11-120-75-75-p-70-*-1');


my $lab2=$frm_name->Label(-text=>"Search in File :", -font =>
'-adobe-helvetica-bold-r-normal--11-120-75-75-p-

70-*-1')->pack();

my $ent2=$frm_name->Entry(-width=>100)->pack();
$ent2->configure(-font =>
'-adobe-helvetica-bold-r-normal--11-120-75-75-p-70-*-1');

<snip>
Shouldn't some of this be done in config? You've hardcoded the font name
10 times, for instance.

sub push_button1 {

use Getopt::Std;

Put this at the top of the file. Lines like

use Blah;

are executed at compile time, not runtime.

my $name1 = $ent1 -> get();
my $name2 = $ent2 -> get();
@ARGV= ($name1, $name2);

I wouldn't use @ARGV for this. It has a special meaning (ie command-line
arguments) in perl. Using it here doesn't hurt as such, but it's misleading.

#print @ARGV;

$i=0;

my $pattern = shift @ARGV;


foreach $file (@ARGV)
{
open (FILE, $file);

You need to check the return value of open. Here, if the open fails, the
fact isn't reported to the user and then the tool gives misleading results.

Can you not define a file-browse dialog for specifying the filename?

print "The phrase $pattern is $i times found!!\n";

You've written a GUI tool, but you're printing to the console. A little odd.

sub push_button2 {

use Getopt::Std;

You've already done this: no need to do it again.

my $name1 = $ent1 -> get();
my $name2 = $ent2 -> get();
@ARGV= ($name1, $name2);

$i=0;

my $pattern = shift @ARGV;


foreach $file (@ARGV)
{
open (FILE, $file);
while ($line = <FILE>)
{
if ($line =~m"$pattern")
{
$i++;
last if ($opt_1);
$txt-> insert ('end', "$line\n");
print "$line\n";

}

This code looks familiar...... You've copied and pasted it from
push_button1. You should break the common code out into another
subroutine, that returns eg an array containing matching lines.
push_button1 (not a very descriptive name) can then display the matching
lines, and push_button2 can display a count.

sub push_button4 {

use Getopt::Std;

my $name1 = $ent1 -> get();
my $name2 = $ent2 -> get();
my $file_out = $ent3 -> get();

and again.....

Copy-and-paste is not a useful programming paradigm.

Mark

 

[thundergnat]

Hey guys,

Here is version 2.0 for scanning files.
I have added scrollbars to the text area and a function
to print OUT the result to a other file.
Below you will find the script.

I have tested it with Perl 5.8.6 from ActiveState.com,
bear this in mind.

Have fun.

So... what was your perl question?

Or were you looking for commentary on this script?

Several things:

No use warnings
No use strict
Poor (non-descriptive) variable names
Poor (non-descriptive) sub routine names
Poor indenting
Lots of (duplicate) hard coded values
Lots of cut and paste coding
Use of special variables for other than their intended reason (@ARGV)
Repeated loading of modules (doesn't hurt, but doesn't help either)
No error checking or trapping
Two argument opens with global file handles rather than 3 argument
opens with lexical file handles
Usless use of double quotes when not interpolating

All of those are problems with style. None of them will cause the
script to work incorrectly, they will just make it harder to maintain
and debug, and make it harder for other people to help you.

The bigger problem is that your script doesn't work.
It will only find a single occurance of the phrase no matter how many
times (> 1) it appears on a line.

Test it. Make a text file that contains:

the best the best the best the best the
worst the best the best the best the best

then search for the phrase 'the best'. It will report 2, (one per line)
rather than 8.

Also, it won't find phrases that are broken across lines.
Search the above sample file for 'the\sworst' (since your aren't escaping
meta characters you can feed it a regex assertion to search.) It won't
find any.


Here's a quick rewrite of your script to correct all of the above problems,
with some other minor enhancements.


use warnings;
use strict;
use Tk;
use Tk::ROText;
use Tk:ialog;

my $font = '{helvetica} 10 bold';
my $title = 'Crappy GUI Grep';
my $infile;

my $mw = new MainWindow;
$mw->title( $title );

my $search_frame = $mw->Frame->pack;

$search_frame->Label(
-text => 'Search phrase :',
-font => $font,
)->pack;

my $search_term = $search_frame->Entry(
-width => 100,
-borderwidth => 2,
-font => $font
)->pack;

my $button_frame = $mw->Frame->pack( -pady => 3 );

$button_frame->Button(
-text => 'Choose File',
-command => \&load_file,
-background => 'yellow',
-font => $font,
-width => 18
)->grid(
-row => 0,
-column => 0,
-padx => 2
);

$button_frame->Button(
-text => 'Count Matches',
-command => \&count_matches,
-background => 'green',
-font => $font,
-width => 18
)->grid(
-row => 0,
-column => 1,
-padx => 2
);

$button_frame->Button(
-text => 'Save Results to File',
-command => \&save_results,
-background => 'cyan',
-font => $font,
-width => 18
)->grid(
-row => 0,
-column => 2,
-padx => 2
);

$button_frame->Button(
-text => 'Clear',
-command => sub {
clear_text();
$mw->title( $title );
undef $infile;
},
-background => 'orange',
-font => $font,
-width => 18
)->grid(
-row => 0,
-column => 3,
-padx => 2
);

my $match = $mw->ROText(
-width => 150,
-height => 1,
-background => 'white'
)->pack(
-pady => 5
);

my $txt = $mw->Scrolled(
'Text',
-scrollbars => 'se',
-wrap => 'none',
-width => 150,
-height => 35,
)->pack(
-expand => 1,
-fill => 'both'
);

MainLoop;

sub count_matches {
local $/ = '';
my $occurances = '0';
my $file = $infile;
my $pattern = $search_term->get();
return unless defined $file and length $file and length $pattern;
open( my $filehandle, '<', $file )
or err( "Could not open file \"$file\". $!" )
and return;
while ( my $paragraph = <$filehandle> ) {
my (@count) = $paragraph =~ m/($pattern)/mg;
$occurances += @count;
}
$match->delete( '1.0', 'end' );
$match->insert( '1.0',
"The phrase \"$pattern\" was found $occurances times found in file $file." );
}

sub load_file {
my $file = $mw->getOpenFile;
$infile = $file;
return unless defined $file and length $file;
open( my $filehandle, '<', $file )
or err( "Could not open file \"$file\". $!" )
and return;
$mw->title( "$title - $file" );
clear_text();
$txt->insert( 'end', $_ ) while <$filehandle>;
}

sub clear_text {
$txt->delete( '1.0', 'end' );
$match->delete( '1.0', 'end' );
}

sub save_results {
my $file = $mw->getSaveFile;
return unless defined $file and length $file;
open( my $filehandle, '>', $file )
or err( "Could not open file \"$file\" for writing. $!" )
and return;
print $filehandle $match->get( '1.0', 'end' );
}

sub err {
my $message = shift;
my $error = $mw->Dialog(
-title => 'Oops',
-text => $message,
-bitmap => 'error',
-buttons => ['Ok']
);
$error->Show;
}

 

[Raghuramaiah Gompa]

So... what was your perl question?

Or were you looking for commentary on this script?

Several things: K>
No use warnings
No use strict
Poor (non-descriptive) variable names
Poor (non-descriptive) sub routine names
Poor indenting
Lots of (duplicate) hard coded values
Lots of cut and paste coding
Use of special variables for other than their intended
reason (@ARGV)
Repeated loading of modules (doesn't hurt, but doesn't
help either)
No error checking or trapping
Two argument opens with global file handles rather than
3 argument
opens with lexical file handles
Usless use of double quotes when not interpolating

All of those are problems with style. None of them will
cause the
script to work incorrectly, they will just make it
harder to maintain
and debug, and make it harder for other people to help you.

The bigger problem is that your script doesn't work.
It will only find a single occurance of the phrase no
matter how many
times (> 1) it appears on a line.

Test it. Make a text file that contains:

the best the best the best the best the
worst the best the best the best the best

then search for the phrase 'the best'. It will report
2, (one per line)
rather than 8.

Also, it won't find phrases that are broken across lines.
Search the above sample file for 'the\sworst' (since
your aren't escaping
meta characters you can feed it a regex assertion to
search.) It won't
find any.


Here's a quick rewrite of your script to correct all of
the above problems,
with some other minor enhancements.
snip --- snip ----
$error->Show;
}

I wonder whether this code can be modifed to "highlight
all instances of text between quotes". For example, if
the previous
sentence is in a file, the code should show the line with
red color for "highlight all instances of text between
quotes". Is it possible? .. Raghu

 

[thundergnat]

snip --- snip ----

I wonder whether this code can be modifed to "highlight
all instances of text between quotes". For example, if
the previous
sentence is in a file, the code should show the line with
red color for "highlight all instances of text between
quotes". Is it possible? .. Raghu

Yes. It's possible. Though iy may be easier if you take a
slightly different approach. I wrote a little demo script
not too long ago that does that.... (rumage, rumage...)


Here you go: http://www.perlmonks.org/?node_id=522464

try a search string like:

(?<=')\b[^']+\b(?=')

for single quotes or

(?<=")\b[^"]+\b(?=")

for double quotes.

 

[Raghuramaiah Gompa]

Thank you very much. .. Raghu