Very nice looking interface.
Some commentary on the logic. You really, really should use warnings and strict while your are developing anything larger than a trivial script. Don't try to clean it up afterwords, it will be twice as hard. I took your script and tweaked it to make it warnings and strict clean and found a few variable collision and scoping issues.
You really should try to separate presentation code from logic code. (When practical.) For instance; I factored out all of your calls to add messages to the notification text box to a subroutine "report()" which takes a message string and adds it to the appropriate place. It cuts down on the clutter, and makes it easier to change your message style if they are all generated from a single place in your script.
I gathered Tk widgets into a single widget hash (%tk), and all the "settings" variables into a single settings hash. (%s) This not only cut down on the globals floating around, but made it easier to use a third party module to handle the setting file saving and loading. I used YAML here. (It isn't without its warts, but it works pretty well for things like this.)
I ran your script through perltidy to clean up the formatting too. Not strictly necessary, but it helps clarify things when blocks and spacing are uniform.
I made some other stylistic tweaks too, 3 argument opens with lexical filehandles, single quotes instead of double for non-interpolated data, factoring out repeated strings into a variable, etc. Don't remember all of them.
I didn't check through all your logic in all the permutations of settings, but I didn't change them either, if they worked before they still should.
Anyway, see if this might be useful to you, or at least give you some good guidance.
#!C:\Program Files\Perl\bin\perl.exe
# Created By Bert.Mcguirk@gmail.com
# VERSION 1.3
use strict;
use warnings;
#die "This script is intended to run on a windows machine"
# unless ( $^O eq "MSWin32" );
use File::Path;
use File::Find;
use Tk;
use Tk::LabFrame;
use Tk::ROText;
use YAML qw(DumpFile LoadFile);
my $settings_file = $0 . '.settings';
my $debug = 0;
my @output;
my @errors;
my $output_data_file_name;
my $positive_match;
my %s; # settings hash. cuts down on the globals
my %tk; # widget hash to hold Tk widgets
make_gui();
load_settings();
MainLoop;
##########################################START GUI FUNCTION##########
+#################################
sub make_gui {
my $last_line;
$tk{mw} = MainWindow->new;
# Mainwindow: size x/y, position x/y
$tk{mw}->geometry('620x575+100+120');
$tk{mw}->title('svgrep 1.3');
# Logging window
$tk{eventpad} = $tk{mw}->Scrolled(
'ROText', # RO = Read Only
-scrollbars => 'e', # scrollbar on the right
-background => 'white',
-width => 83, # width/height in characters
-height => 10,
)->place( -x => 8, -y => 415 );
report('Event Logging will be shown here');
$tk{mw}->Label(
-text => 'Simple Visual grep',
-font => 'Helvetica -20',
)->place( -x => 210, -y => 5 );
$tk{mw}->Label(
-text => 'OR',
-font => 'Helvetica -20',
)->place( -x => 500, -y => 300 );
required_parameter_frame( $tk{mw} );
add_lines_frame( $tk{mw} );
advanced_options_frame( $tk{mw} );
text_block_frame( $tk{mw} );
$tk{mw}->Button(
-text => 'run grep',
#padx/y is to create space IN the button around the text
-padx => 5,
-pady => 5,
-font => 'Helvetica -18',
-command => sub {
$tk{eventpad}->delete( '1.0', 'end' );
# create output file for the regex function
my ( $sec, $min, $hour ) = localtime(time);
$output_data_file_name =
sprintf( "output_data_%02d-%02d-%02d.txt", $hour, $min,
+$sec );
#validate numberic inputs. 0 = bad, 1 = good
my $valid = 1;
print("1)valid is: [$valid]\n") if $debug; #debug
$valid = validate_inputs( $s{lines_above}, 'numeric' )
if $s{lines_above};
$valid = validate_inputs( $s{lines_below}, 'numeric' )
if $s{lines_below};
$valid = validate_inputs( $s{lines_below_to_skip}, 'numeri
+c' )
if $s{lines_below_to_skip};
$valid =
validate_inputs( $s{lines_below_to_end_text_block}, 'num
+eric' )
if $s{lines_below_to_end_text_block};
print("2)valid is: [$valid]\n") if $debug;
# catch bad input combinations.
if ( $s{lines_above} && $s{scan_up_string}
or $s{lines_below} && $s{scan_down_string} )
{
$valid = 0;
report( "\nYou must select either a line "
. 'amount or scan to string, not both' );
}
if (
(
$s{lines_above}
|| $s{lines_below}
|| $s{scan_up_string}
|| $s{scan_down_string}
)
&& ( $s{lines_below_to_skip}
|| $s{lines_below_to_end_text_block}
|| $s{scan_down_string_to_end_text_block}
|| $s{skip_until_string} )
)
{
$valid = 0;
report( "\nYou must select either add lines "
. "option or text block option, not both" );
}
if ( $s{lines_below_to_skip} && $s{skip_until_string} ) {
$valid = 0;
report( "\nYou must select either lines below to "
. "skip or scan down string, not both" );
}
print("3)valid is: [$valid]\n") if $debug;
if ( $valid == 0 ) {
print("4)valid is: [$valid]\n") if $debug;
report("grep action aborted\n");
return; # exit button function, GUI thread will sta
+y alive.
}
if ( $s{directory} && $s{search_string} ) {
$s{directory} =~ s{[\\/]\s*$}{};
if ( $s{chk_button_save_search} == 1 ) {
unless ( -e $settings_file ) {
report("Missing search parameters file\n");
}
DumpFile( $settings_file, %s );
}
report(
"\n - grep started for search string:[$s{search_st
+ring}]"
. "\n - Within directory: [$s{directory}]\n" );
regex();
$output_data_file_name = '';
@output = '';
@errors = '';
}
else {
report("Please enter a directory and search string");
}
},
)->place( -x => 500, -y => 50 );
}
sub required_parameter_frame {
my $mother = shift;
my $font = 'Helvetica -12';
#####################
# Primary frame #
#####################
my $frame = $mother->LabFrame(
-label => "Required",
-width => 200,
-height => 105, # Pixel
-font => $font,
)->place( -x => 7, -y => 35 );
$frame->Label(
-text => 'Enter a Target Directory',
-font => $font,
)->place( -x => 7, -y => 10 );
my $dir = $frame->Entry(
-width => 30, # width is in characters, no
+t pixel
-textvariable => \$s{directory}
)->place( -x => 7, -y => 30 );
$frame->Label(
-text => 'Search String',
-font => $font,
)->place( -x => 7, -y => 50 );
$frame->Entry(
-width => 30, # width is in characters,
+ not pixel
-textvariable => \$s{search_string}
)->place( -x => 7, -y => 70 );
$dir->bind(
'<Double-Button-1>',
sub {
$s{directory} =
$tk{mw}->chooseDirectory(
-initialdir => $s{directory} ? $s{directory} : '.' );
}
);
}
sub add_lines_frame {
my $mother = shift;
my $font = 'Helvetica -12';
my $frame = $mother->LabFrame(
-label => "Add lines to be returned",
-width => 200,
-height => 210,
-font => $font,
)->place( -x => 7, -y => 165 );
$frame->Label(
-text => '# of lines above search string',
-font => $font,
)->place( -x => 7, -y => 10 );
$frame->Entry(
-width => 6, # width is in characters,
+not pixel
-textvariable => \$s{lines_above}
)->place( -x => 7, -y => 30 );
$frame->Label(
-text => 'OR Scan up to this string',
-font => $font,
)->place( -x => 7, -y => 50 );
$frame->Entry(
-width => 30, # width is in characters,
+ not pixel
-textvariable => \$s{scan_up_string}
)->place( -x => 7, -y => 70 );
$frame->Label(
-text => '# of lines below search string',
-font => $font,
)->place( -x => 7, -y => 110 );
$frame->Entry(
-width => 6, # width is in characters,
+ not pixel
-textvariable => \$s{lines_below}
)->place( -x => 7, -y => 130 );
$frame->Label(
-text => 'OR scan down to this string',
-font => $font,
)->place( -x => 7, -y => 150 );
$frame->Entry(
-width => 30, # width is in characters,
+ not pixel
-textvariable => \$s{scan_down_string}
)->place( -x => 7, -y => 170 );
}
sub advanced_options_frame {
my $mother = shift;
my $frame = $mother->LabFrame(
-label => 'Advanced Options',
-width => 200,
-height => 105, # Pixel
-font => 'Helvetica -12',
)->place( -x => 250, -y => 35 );
# check buttons are set to 0 for deselect and 1 for select
my $chk1 = $frame->Checkbutton(
-text => 'Recursive Directory Search',
-variable => \$s{chk_button_recursive}
)->place( -x => 7, -y => 7 );
$chk1->deselect();
my $chk2 = $frame->Checkbutton(
-text => 'Show File Name in Output',
-variable => \$s{chk_button_show_file}
)->place( -x => 7, -y => 28 );
$chk2->deselect();
my $chk3 = $frame->Checkbutton(
-text => "Show Line Number in Output",
-variable => \$s{chk_button_show_line_number}
)->place( -x => 7, -y => 49 );
$chk3->deselect();
my $chk4 = $frame->Checkbutton(
-text => 'Save search parameters',
-variable => \$s{chk_button_save_search}
)->place( -x => 7, -y => 69 );
$chk4->select();
}
sub text_block_frame {
my $mother = shift;
my $font = 'Helvetica -12';
my $frame = $mother->LabFrame(
-label => 'Define a text block to be returned (simulate AWK)'
+,
-width => 350,
-height => 180,
-font => $font,
)->place( -x => 250, -y => 175 );
$frame->Label(
-text => '# of lines to skip below search string to start outp
+ut',
-font => $font,
)->place( -x => 60, -y => 30 );
$frame->Entry(
-width => 6, # width is in characters, not pixel
-textvariable => \$s{lines_below_to_skip}
)->place( -x => 7, -y => 30 );
$frame->Label(
-text => 'OR scan down to this string',
-font => $font,
)->place( -x => 150, -y => 60 );
$frame->Entry(
-width => 20, # width is in characters, not pixel
-textvariable => \$s{skip_until_string}
)->place( -x => 7, -y => 60 );
$frame->Label(
-text => 'total # of lines to output',
-font => $font,
)->place( -x => 60, -y => 100 );
$frame->Entry(
-width => 6, # width is in characters, not pixel
-textvariable => \$s{lines_below_to_end_text_block}
)->place( -x => 7, -y => 100 );
$frame->Label(
-text => 'OR end text block at this string',
-font => $font,
)->place( -x => 150, -y => 130 );
$frame->Entry(
-width => 20, # width is in characters, not pixel
-textvariable => \$s{scan_down_string_to_end_text_block}
)->place( -x => 7, -y => 130 );
}
##########################################END GUI FUNCTIONs###########
+################################
sub regex {
# parameters are now in the global settings hash %s
$positive_match = 0;
#will traverse all sub directories if allowed by the depth check
find( \&wanted, $s{directory} );
sub wanted {
my $filename = "$File::Find::name";
#Directory Depth control
my $max_depth = $s{directory} =~ y[\/][];
if ( $s{chk_button_recursive} ) {
$max_depth = 99;
}
my $depth = $File::Find::dir =~
tr[\/][]; # line_count the slashes, windows or unix style
return if $depth > $max_depth;
if ( -f $filename ) {
my $infile;
unless ( open $infile, '<', $filename ) {
push @errors, "Can't open $filename : $!";
report("Can't open $filename : $!");
return;
}
my @data = <$infile>; #load whole file into an
close $infile;
for my $line_count ( 0 .. $#data ) {
chomp( $data[$line_count] );
#strip end of lines and extra with space.
# index function returns -1 if no match
if ( index( $data[$line_count], $s{search_string} ) >=
+ 0 ) {
$positive_match = 1;
unless ( $s{lines_above}
|| $s{lines_below}
|| $s{lines_below_to_skip}
|| $s{lines_below_to_end_text_block}
|| $s{scan_down_string_to_end_text_block}
|| $s{scan_up_string}
|| $s{scan_down_string}
|| $s{skip_until_string} )
{
send_output(
$s{chk_button_show_line_number},
$s{chk_button_show_file},
$File::Find::name,
$line_count,
$data[$line_count]
);
}
#start add lines option ->
if ( $s{lines_above}
|| $s{lines_below}
|| $s{scan_up_string}
|| $s{scan_down_string} )
{
my $start_line = $line_count;
$start_line -= $s{lines_above} if $s{lines_abo
+ve};
$start_line = 0 if $start_line < 0;
my $stop_line = $line_count;
$stop_line += $s{lines_below} if $s{lines_belo
+w};
$stop_line = $#data if $stop_line > $#data;
if ( $s{scan_up_string} ) {
my $match = '';
for my $i ( reverse 0 .. $line_count ) {
if (
index( $data[$i], $s{scan_up_strin
+g} ) >=
0 )
{
$start_line = $i;
$match = 1;
last; # exit loop
}
}
unless ($match) {
report( 'Could not find scan up string
+:['
. $s{scan_up_string}
. "] in file:\n"
. "[$filename]" );
push @errors,
( 'Could not find scan up string
+: ['
. $s{scan_up_string}
. "] in file: $filename" );
$match = '';
$positive_match = '';
return;
}
}
if ( $s{scan_down_string} ) {
my $match = '';
for my $i ( $line_count .. $#data ) {
if (
index( $data[$i], $s{scan_down_str
+ing} ) >=
0 )
{
$stop_line = $i;
$match = 1;
last; # exit loop
}
}
unless ($match) {
report( 'Could not find scan down stri
+ng: ['
. $s{scan_down_string}
. "] in file:\n"
. "[$filename]" );
push @errors,
( 'Could not find scan up string
+: ['
. $s{scan_down_string}
. "] in file: $filename" );
$match = '';
$positive_match = '';
return;
}
}
#send data from start line to matched line
if ( $s{lines_above}
|| $s{scan_up_string} )
{
for my $i ( $start_line .. $line_count - 1
+ ) {
send_output(
$s{chk_button_show_line_number},
$s{chk_button_show_file},
$filename,
$i,
$data[$i]
);
}
}
#send matched line out
send_output(
$s{chk_button_show_line_number},
$s{chk_button_show_file},
$filename,
$line_count,
$data[$line_count]
);
#send lines after matched line down to the new stopp
+ing point.
if ( $s{lines_below}
|| $s{scan_down_string} )
{
#start right after matched line
for my $i ( $line_count + 1 .. $stop_line
+) {
send_output(
$s{chk_button_show_line_number},
$s{chk_button_show_file},
$filename,
$i,
$data[$i]
);
}
}
}
#end add lines option <-
#start textblock options->
if ( $s{lines_below_to_skip}
|| $s{lines_below_to_end_text_block}
|| $s{scan_down_string_to_end_text_block}
|| $s{skip_until_string} )
{
#start at matched line if lines below to skip wasn't
#$s{lines_below_to_skip} = 0 unless ($s{lines_below_
+to_skip});
my ( $start_line, $stop_line );
if ( $s{skip_until_string} ) {
my $match = '';
for my $i ( $line_count .. $#data ) {
if (
index( $data[$i], $s{skip_until_st
+ring} ) >=
0 )
{
$start_line =
( $i + 1 ); #start output aft
+er string
$match = 1;
last; # exit loop
}
}
unless ($match) {
report( 'Could not find scan down stri
+ng '
. 'requested in text block optio
+ns:['
. $s{skip_until_string}
. " ] in file:\n"
. "[$filename]" );
push @errors,
( 'Could not find scan down '
. 'string int text block options
+: ['
. $s{skip_until_string}
. "] in file: $filename" );
$match = '';
$positive_match = '';
return;
}
}
else {
$start_line =
( $line_count + $s{lines_below_to_skip}
+);
}
if ( $s{scan_down_string_to_end_text_block} )
+{
my $match = '';
for my $i ( $start_line .. $#data - 1 ) {
if (
index( $data[$i],
$s{scan_down_string_to_end_tex
+t_block} )
>= 0
)
{
$stop_line =
( $i - 1 ); #don't grab terminat
+or string.
$match = 1;
last; # exit loop
}
}
unless ($match) {
report(
'Could not find string to end text
+ block:['
. $s{scan_down_string_to_end_tex
+t_block}
. "] in file:\n"
. "[$filename]" );
push @errors,
( 'Could not find scan down stri
+ng: ['
. $s{scan_down_string_to_end_tex
+t_block}
. "] in file: $filename" );
$match = '';
$positive_match = '';
return;
}
}
else {
$stop_line =
( $s{lines_below_to_end_text_block} +
$start_line );
}
for my $i ( $start_line .. $stop_line ) {
send_output(
$s{chk_button_show_line_number},
$s{chk_button_show_file},
$filename, $i, $data[$i]
);
}
}
# end text block options <-
return;
}
}
}
}
# create output file ONLY if there is a match
if ($positive_match) {
open( my $outfile, '>', $output_data_file_name ) or warn $!;
print $outfile join "\n", @output;
close $outfile;
report('Results have been found, please check output file.');
report("Created output file: $output_data_file_name.");
}
else {
report('No results found :( ');
push @errors,
'['
. localtime() . ']'
. "No results found in directory: [$s{directory}]";
}
make_error_log();
}
sub load_settings {
if ( -e $settings_file ) {
my %settings = LoadFile($settings_file);
for my $key ( keys %settings ) {
$s{$key} = delete $settings{$key};
}
#notify user:
report("Previous inputs have been loaded");
}
}
sub report {
$tk{eventpad}
->insert( 'end', sprintf( "[%s] %s\n", scalar localtime(), shift
+ ) );
}
sub make_error_log {
if ( $errors[0] ) {
open( my $error_log, '>', 'error log.txt' );
print $error_log join "\n", @errors;
close $error_log;
report("$#errors Errors have been sent to the error log file."
+);
}
}
sub send_output {
my ( $show_line, $show_file_name, $file_name, $line_count, $data )
+ = @_;
chomp($data); #strip end of line's to avoid double spacing.
if ( $show_line && $show_file_name ) {
push @output, ("$file_name,$line_count,$data");
}
elsif ($show_file_name) {
push @output, ("$file_name,$data");
}
elsif ($show_line) {
push @output, ("$line_count,$data");
}
else {
push @output, ($data);
}
}
sub validate_inputs {
my ( $user_response, $type ) = @_;
return unless defined $user_response;
if ( $user_response =~ /^[+-]?\d+$/ ) {
return 1
if $type eq 'numeric';
# this isn't needed but made the code clearer to me when debug
+ging.
}
else {
report("Invalid entry: [$user_response]");
return "0";
}
}