Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

comment on
( [id://3333]=superdoc: print w/replies, xml ) Need Help??

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;
           }
       }
    }
}

[download]

In reply to Re^3: Perl TK Submit enter incorrect routine by thundergnat
in thread Perl TK Submit enter incorrect routine by minixman

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":


  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others musing on the Monastery: (5)
As of 2024-04-19 21:11 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found