###### 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 Routing )', )->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 for logging and # Audit the real information is kept on the correaltor in the Logon.evt file. my $sql = qq{SELECT userid,orderrouting FROM apama_owner.user_routing}; 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) was reset\n"); my $ret1 = orderrouting('check', $guid, $orderouting); # Check users order routing. my $ret2 = checkuserexists('apama', $guid); # Check user is in the database if ($debug){ writelog(1, "$date: DEBUG: process_amend_userorderroute_rt: userid = $guid"); writelog(1, "$date: DEBUG: process_amend_userorderroute_rt: function = $func"); writelog(1, "$date: DEBUG: process_amend_userorderroute_rt: order_routing = $orderouting"); writelog(1, "$date: DEBUG: process_amend_userorderroute_rt: current routing for uid = $ret1"); writelog(1, "$date: DEBUG: process_amend_userorderroute_rt: user 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: correlator response = $ans") if $debug; if ($ans =~ m/COMPLETED:ADDED/i) { # WE know the new user has been injected into the correlator, so we update the database. orderrouting("newrouting", $guid, $orderouting); # Add new routing into the database $txt->insert('end', "New Order routing setup $guid:$orderouting \n"); writelog(1, "$date: INFO: New Order routing setup $guid:$orderouting ($amuid)"); } elsif ($ans =~ m/REJECTED-EXISTS/i) { $txt->insert('end', "Order routing $guid:$orderouting Correlator 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 widget only to destroy it before it can possibly be updated? } elsif (($func =~ m/add/i) && (!$ret1) && ($ret2) && ($orderouting =~ m/exchangelink/i)) { # User does not have the order routing that 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: correlator response = $ans") if $debug; if ($ans =~ m/COMPLETED:ADDED/i) { # WE know the new user has been injected into the correlator, so we update the database. orderrouting("newrouting",$guid,$orderouting); # Add new routing into the database $txt->insert('end', "New Order routing setup $guid:$orderouting \n"); writelog(1,"$date: INFO: New Order routing setup $guid:$orderouting "); } elsif($ans =~ m/REJECTED-EXISTS/i) { $txt->insert('end', "Order routing $guid:$orderouting Correlator 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:$orderouting already configured\n"); writelog(1,"$date: INFO: New Order routing setup $guid:$orderouting already configured"); $txt->toplevel->destroy; } # Start Delete functions # Add in support for FF translation on userid elsif(($func =~ /remove/) && ($orderouting =~ /fastfix/)) { # Delete users order routing, and routing is not in database. # First run some checks to see if user has order routing and in 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 has removed it from the Logon.evt file $txt->insert('end', "Order routing setup $guid:$orderouting deleted\n"); writelog(1,"$date: INFO: Order routing setup $guid:$orderouting deleted ($damuid)"); orderrouting("delrouting",$guid,$orderouting); # Add new routing into the database } elsif ($ans =~ m/REJECTED-NOEXISTS/i) { $txt->insert('end', "Order routing setup $guid:$orderouting Correlator rejected, Does not exists\n"); writelog(1,"$date: INFO: Order routing setup $guid:$orderouting 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 and 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 correlator has removed it from the Logon.evt file $txt->insert('end', "Order routing setup $guid:$orderouting 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:$orderouting 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:$orderouting Not in database \n"); writelog(1,"$date: INFO: New Order routing setup $guid:$orderouting Not in database ::$ret1 : $ret2"); $txt->toplevel->destroy; } } } }