Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
PerlMonks  

Re^3: Perl TK Submit enter incorrect routine

by thundergnat (Deacon)
on Nov 15, 2005 at 16:33 UTC ( [id://508673]=note: print w/replies, xml ) Need Help??


in reply to Re^2: Perl TK Submit enter incorrect routine
in thread Perl TK Submit enter incorrect routine

I took a longer look at it and have some more detailed comments/advice.

In General:

Use more white space. It's inexpensive and makes debugging less tedious. (Personal opinion, though many will agree.)

Somewhat related, indent consistantly. Inconsistent, semi-random indentation makes finding missing/extra brackets an excercise in frustration. It also makes following the logic of nested if blocks very tedious.

Don't declare variables as globals unless necessary, 'our' variables have especially far-reaching scopes and should be avoided if possible. Use 'my' variables instead.

Keep variables in the smallest scope practical, don't pass Tk widget names to subroutiness if all you want is the widgets' value, pass the value instead. Action-at-a-distance bugs are hard to track down.

If you are just going to use default values for object attributes, don't include them, it clutters up the code unnecessarily and makes it more difficult for others to help you debug.

Don't use prototypes for subroutines if you don't need them. And even if you think you do, you probably don't.

Don't call subroutines with the leading ampersand unless you need the effects it adds. If you don't know what effects it adds, you probably don't need it.

Something I found puzzling, in the sub process_amend_userorderroute, there are many situations where you are writing information out to a text widget, then, before the information could possibly be displayed, destroying the toplevel that the widget is in. Seems like a lot of wasted effort.

Anyway, I took the liberty of rewriting some of your code to demonstrate what I am talking about. There are lots of missing subs, so it won't work standalone. It is still more cluttered than I would prefer, but it is a step in the right direction. Take it or leave it as you like.

###### Add a stub header to test with #### ###### Need to comment out DB stuff ###### ###### too to test. ###### use warnings; use strict; use Tk; use Text::Table; my $debug = 1; my $date = localtime; my $top = MainWindow->new; my $mainmenu = $top->Menu; show_amend_userorderroute(); MainLoop; ######################################### sub show_amend_userorderroute{ my $frame = $mainmenu->Toplevel(-title => 'Amend User'); $frame->geometry ('+100+400'); $frame->minsize(303,250); my $_frame_1 = $frame->Frame->pack; my $_frame_2 = $frame->Frame->pack; my $_frame_3 = $frame->Frame->pack; my $_text_4 = $frame->Scrolled('Text', -width => 40, -height => 2, -scrollbars => 'oe' )->pack( -expand => 1, -fill => 'both', ); my $pady = 7; $_frame_1->Label( -activeforeground => '#990000', -font => '{MS Sans Serif} 8 bold', -foreground => '#990000', -text => 'Complex Trading admin ( Amend Order Rout +ing )', )->pack( -pady => $pady, ); $_frame_1->Label( -activeforeground => '#000099', -foreground => '#000099', -text => 'Select Fix / Fastfix for user routing', )->pack( -pady => $pady, ); $_frame_2->Label( -text => 'Userid' )->grid( -column => '1', -row => '1', -pady => $pady, ); my $amuuserid = $_frame_2->Entry ->grid( -column => '2', -row => '1', ); $_frame_2->Label( -text => 'Function' )->grid( -column => '1', -row => '2', -pady => $pady, ); my $amurolename = $_frame_2->Spinbox( -values => "add remove" )->grid( -column => '2', -row => '2', ); $_frame_2->Label( -text => 'Order Routing' )->grid( -column => '1', -row => '3', -pady => $pady, ); my $amufunction = $_frame_2->Spinbox( -values => 'exchangelink fastfix' )->grid( -column => '2', -row => '3', ); $_frame_3->Button( -text => 'Submit', -command => sub { process_amend_userorderroute($amuuserid->get, $amurolename->get, $amufunction->get, $_text_4) } )->grid( -column => '1', -row => '1', -pady => $pady, -padx => 4 ); $_frame_3->Button( -text => 'Cancel', -command => sub {$frame->destroy;} )->grid( -column => '2', -row => '1', -pady => $pady, ); # Display a table with all the user order routing, that is on the +correlator # this table is held in the database, and then that info is kept f +or logging and # Audit the real information is kept on the correaltor in the Logo +n.evt file. my $sql = qq{SELECT userid,orderrouting FROM apama_owner.user_rout +ing}; my $tb = Text::Table->new("User Name", "Routing"); my $sth = $dbh->prepare($sql); $sth->execute(); my($username, $routing); $sth->bind_columns( undef, \$username, \$routing); my $ucount = 3; while($sth->fetch() ) { $ucount++; $tb->load(["$username", "$routing"]); } $sth->finish(); $_text_4->insert('end', $tb); $_text_4->configure(-height => $ucount); # End order routine table. } sub process_amend_userorderroute{ my($guid, $func, $orderouting, $txt) = @_; # Get values from user +input.... $txt->insert('end', "INFO: The following admins password ($guid) w +as reset\n"); my $ret1 = orderrouting('check', $guid, $orderouting); # Check use +rs order routing. my $ret2 = checkuserexists('apama', $guid); # Check user is in the + database if ($debug){ writelog(1, "$date: DEBUG: process_amend_userorderroute_rt: us +erid = $guid"); writelog(1, "$date: DEBUG: process_amend_userorderroute_rt: fu +nction = $func"); writelog(1, "$date: DEBUG: process_amend_userorderroute_rt: or +der_routing = $orderouting"); writelog(1, "$date: DEBUG: process_amend_userorderroute_rt: cu +rrent routing for uid = $ret1"); writelog(1, "$date: DEBUG: process_amend_userorderroute_rt: us +er exists in Apama DB = $ret2"); }; if (($func =~ m/add/i) && (!$ret1) && ($ret2) && ($orderouting =~ +m/fastfix/i)) { # User does not have the order routing that is being + required. my $amuid = "$guid-FF"; $amuid =~ s/-//g; my $ans = sendcorrelatorupdates("ADD:$amuid:$orderouting"); +# And send the new data into the Correlator Logon.evt file writelog(1,"$date: DEBUG: process_amend_userorderroute_rt: cor +relator response = $ans") if $debug; if ($ans =~ m/COMPLETED:ADDED/i) { # WE know the new user has been injected into the correlat +or, so we update the database. orderrouting("newrouting", $guid, $orderouting); # Add +new routing into the database $txt->insert('end', "New Order routing setup $guid:$ordero +uting \n"); writelog(1, "$date: INFO: New Order routing setup $guid:$o +rderouting ($amuid)"); } elsif ($ans =~ m/REJECTED-EXISTS/i) { $txt->insert('end', "Order routing $guid:$orderouting Corr +elator rejected, Already exists\n"); writelog(1,"$date: INFO: Order routing $guid:$orderouting +Correlator rejected, Already exists ($amuid)"); } $txt->toplevel->destroy; # Why write information to the text w +idget only to destroy it before it can possibly be updated? } elsif (($func =~ m/add/i) && (!$ret1) && ($ret2) && ($orderoutin +g =~ m/exchangelink/i)) { # User does not have the order routing tha +t is being required. my $ans = sendcorrelatorupdates("ADD:$guid:$orderouting"); # + And send the new data into the Correlator Logon.evt file writelog(1,"$date: DEBUG: process_amend_userorderroute_rt: cor +relator response = $ans") if $debug; if ($ans =~ m/COMPLETED:ADDED/i) { # WE know the new user has been injected into the correlat +or, so we update the database. orderrouting("newrouting",$guid,$orderouting); # Add ne +w routing into the database $txt->insert('end', "New Order routing setup $guid:$ordero +uting \n"); writelog(1,"$date: INFO: New Order routing setup $guid:$or +derouting "); } elsif($ans =~ m/REJECTED-EXISTS/i) { $txt->insert('end', "Order routing $guid:$orderouting Corr +elator rejected, Already exists\n"); writelog(1,"$date: INFO: Order routing $guid:$orderouting +Correlator rejected, Already exists "); } $txt->toplevel->destroy; }elsif(($func =~ m/add/i) && ($ret1) && ($ret2)) { # User already +has the required routing. $txt->insert('end', "New Order routing setup $guid:$orderoutin +g already configured\n"); writelog(1,"$date: INFO: New Order routing setup $guid:$ordero +uting already configured"); $txt->toplevel->destroy; } # Start Delete functions # Add in support for FF translation on userid elsif(($func =~ /remove/) && ($orderouting =~ /fastfix/)) { # Dele +te users order routing, and routing is not in database. # First run some checks to see if user has order routing and i +n apama. if ($ret1) { my $damuid = "$guid-FF"; my $ans = sendcorrelatorupdates("DEL:$damuid:$orderouting" +); # And send the new data into the Correlator Logon.evt file writelog(1,"$date: DEBUG: process_amend_userorderroute_rt: + correlator response = $ans ($damuid)") if $debug; if($ans =~ m/COMPLETED:DEL/i) { # We know the correlator h +as removed it from the Logon.evt file $txt->insert('end', "Order routing setup $guid:$order +outing deleted\n"); writelog(1,"$date: INFO: Order routing setup $guid:$o +rderouting deleted ($damuid)"); orderrouting("delrouting",$guid,$orderouting); # A +dd new routing into the database } elsif ($ans =~ m/REJECTED-NOEXISTS/i) { $txt->insert('end', "Order routing setup $guid:$order +outing Correlator rejected, Does not exists\n"); writelog(1,"$date: INFO: Order routing setup $guid:$o +rderouting Correlator rejected, Does not exists ($damuid)"); } $txt->toplevel->destroy; } elsif (($func =~ /remove/) && ($orderouting =~ /exchangelink +/)) { # Delete users order routing, and routing is not in database. # First run some checks to see if user has order routing an +d in apama. if ($ret1) { my $ans = sendcorrelatorupdates("DEL:$guid:$orderouting +"); # And send the new data into the Correlator Logon.evt file writelog(1,"$date: DEBUG: process_amend_userorderroute_ +rt: correlator response = $ans ") if $debug; if ($ans =~ m/COMPLETED:DEL/i) { # We know the correlat +or has removed it from the Logon.evt file $txt->insert('end', "Order routing setup $guid:$ord +erouting deleted\n"); writelog(1,"$date: INFO: Order routing setup $guid: +$orderouting deleted "); orderrouting("delrouting",$guid,$orderouting); # + Add new routing into the database } elsif ($ans =~ m/REJECTED-NOEXISTS/i) { $txt->insert('end', "Order routing setup $guid:$ord +erouting Correlator rejected, Does not exists\n"); writelog(1,"$date: INFO: Order routing setup $guid: +$orderouting Correlator rejected, Does not exists "); } $txt->toplevel->destroy; } else { $txt->insert('end', "New Order routing setup $guid:$ord +erouting Not in database \n"); writelog(1,"$date: INFO: New Order routing setup $guid: +$orderouting Not in database ::$ret1 : $ret2"); $txt->toplevel->destroy; } } } }

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others goofing around in the Monastery: (7)
As of 2024-03-29 11:39 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found