Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

Re: Noob could use advice on simplification & optimization

by thundergnat (Deacon)
on May 04, 2012 at 17:17 UTC ( #968957=note: print w/ replies, xml ) Need Help??


in reply to Noob could use advice on simplification & optimization

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.

Cheers

UPDATE: Fixed a few errors, tweaked some things, should work under Linux too now.

#!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"; } }


Comment on Re: Noob could use advice on simplification & optimization
Download Code
Replies are listed 'Best First'.
Re^2: Noob could use advice on simplification & optimization
by bgreg (Initiate) on May 07, 2012 at 09:25 UTC
    Aww! Much better! Thank you for taking the time to do this. I started cleaning things up, but my latest update was still felt too verbose and messy. I'm going to incorporate these suggestions as soon as I can, your changes make more sense and are more efficient. I am confused some on the scope of you're hashes, why are they able to be shared if they are not declared as global?

      ?? The %tk and %s hashes ARE global. They are declared in the main scope.

      BTW, I updated the script a bit; fixed some errors (my errors) and tweaked some things here and there.

        I see. I'm missing a simple concept somewhere then, because I see they are declared with 'my'. Does this have a different behavior in your context? Also, I added several of your suggestions already and I'm working through the rest now.

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others having an uproarious good time at the Monastery: (5)
As of 2015-07-28 02:02 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (251 votes), past polls