crawfordr has asked for the wisdom of the Perl Monks concerning the following question:

Hello, I have created a perl script that connects to a specific socket (Ip address/port) using protocall of TCP. It is the server socket script. There is also coding to manage multiple handles by usung the select() in the coding. This was needed due to the fact we expect a large volume of transactions at any given time on the client's side. The script's purpose is to connect to the client's port and listen for connections, accept the connections, receive the data, then pass the data to an oracle database function, that function returns different data back to the server script, then sends that data back to the client's file handler that it was received on. The client file handler is waiting for that response. The data must be sent back to the same file handler that it was received on. The problem that I am having is that the client is not receiving the data back. I think there may be problem in how the script is coded to send the data back to the same file handler. I have tried all kinds of things and nothing seems to work. maybe the code should be written a different way. I wanted to send the the perl code but when I inserted it here it was a mess. I was not sure how to send it with tags. If someone could please help me it would be very much appreciated. Thanks very much, Randall here is the code: 
#!/usr/bin/perl -w
require 5.002;
use strict;
use IO::Socket;
use IO::Select;
use DBI;
use DBD::Oracle;

our ($dbh);
our ($find_min_request_rec, $find_response_rec, $price_call_rec, $pric
+e_response_rec);
our($find_resp_pr1,$find_resp_pr2,$find_resp_pr3,$find_resp_pr4,$find_
+resp_pr5);
our  $read_set ;
our $rh;
our $ns;
our $buf;
our $find_resp;
our $iroam_req_type;

# Create the receiving socket
my $s = new IO::Socket::INET (
                         LocalHost => '172.17.8.201', # IP Address Hos
+t to listen on
                         LocalPort => '18490',  # Port Number Host to 
+listen on
                         Proto => 'tcp',
                         Listen => 5,
                         Reuse => 1,
                        );
die "Could not create socket: $!\n" unless $s;

$find_resp = 'GCD 000'; #Used in Testing 
 
$read_set = new IO::Select(); # create handle set for reading
$read_set->add($s);           # add the main socket to the set
 
connect_to_oracle_db();

print "At Host/Port listening. Waiting to receive transactions from Ir
+oam Client...\n";

while (1) { # Continous Listening on Port for a connection
    
        # get a set of readable handles (blocks until at least one han
+dle is ready)
   my ($rh_set) = IO::Select->select($read_set, undef, undef, 0);
   
        # take all readable handles in turn
   foreach $rh (@$rh_set) {
   print "Process each readable handle...\n";
   print "Value of rh is $rh...\n";
   print "Value of rh_set is @$rh_set..\n";
          # if it is the main socket then we have an incoming connecti
+on and
          # we should accept() it and then add the new socket to the $
+read_set 
      if ($rh == $s) {
          print "Main socket and incoming connection.. add to the read
+able set...\n";
         $ns = $rh->accept();
         $read_set->add($ns); ##already added at beginning
         print "Value of rh_set is @$rh_set..after adding ns connectio
+n\n";
         # otherwise it is an ordinary socket and we should read and p
+rocess the request
      }else{
           print "Its an ordinary socket, so read and process the requ
+est ...\n";
           print     "Connected from: ", $rh->peerhost();  # Display P
+eer Connection from Info
       print    " Port: ", $rh->peerport(), "\n";
           $buf = <$rh>;
           $iroam_req_type = substr($buf,0,8);   #Extract the requesto
+r type from the string sent from the Iroam Client
           print "Requestor type extracted from the Iroam Data: $iroam
+_req_type||Requestor Type\n";   #Display value of the Iroam requestor
           
           if($buf) { # return normal input and process $buf
              print "Iroam transaction received from Iroam Client:\n";
+ #Display value of the Iroam data from Iroam
                print "$buf\n"; #Display value of the Iroam data from 
+Iroam
              if ($iroam_req_type  =~ /FindMin/){              
                  $find_min_request_rec = $buf;
              }elsif ($iroam_req_type  =~ /PriceCall/){
                  $price_call_rec = $buf;     
              }
              pass_transaction_to_iroam_package();
              ###print "s  send value is: $s->send($find_response_rec)
+ \n";
              ###$s->send($find_response_rec);
              $rh->send($find_response_rec);
              print "rh send value is: $rh->send($find_response_rec) \
+n";
            }else { # the client has closed the socket
            print "Iroam client has closed the socket. Socket will be 
+removed from the readbale set and closed...\n";
               # remove the socket from the $read_set and close it
             $read_set->remove($rh);
             close($rh);
         }
      }
   }
 }

sub connect_to_oracle_db{
    
    print "Connect to the Oracle Database sub....\n";
    
    $dbh = DBI->connect(
                                        'DBI:Oracle:dev',
                                        'perluser',
                                        'oraperl',
                                            {AutoCommit => 0, RaiseErr
+or => 1}
                                ) or die "Couldn't connect to database
+:".DBI->errstr;
}

sub pass_transaction_to_iroam_package{
       
    print "pass transaction to iroam package sub....\n";
    
    my $v_param_iroam_resp;
       
    if ($iroam_req_type  =~ /FindMin/){
        my $csr = $dbh->prepare(q{
                                   begin
                                     :v_param_iroam_resp:= WIRELESS_IR
+OAM_PKG.Lookup_Min_Request(:find_min_request_rec);
                                  end;
                        });
       $csr->bind_param(":find_min_request_rec", $find_min_request_rec
+);
       $csr->bind_param_inout(":v_param_iroam_resp", \$v_param_iroam_r
+esp,400);
       $csr->execute() or die "Couldn't execute pass transaction to ir
+oam package sub ".DBI->errstr;
    
       $find_response_rec = $v_param_iroam_resp;
        
        $find_resp_pr1 = substr($find_response_rec ,0,90);
        $find_resp_pr2 = substr($find_response_rec ,91,90);
        $find_resp_pr3 = substr($find_response_rec ,182,90);
        $find_resp_pr4 = substr($find_response_rec ,273,90);
        $find_resp_pr5 = substr($find_response_rec ,364,11);
        print "Value of v param iroam resp is: $v_param_iroam_resp\n";
        print "Value of find response rec is:  $find_resp_pr1\n";
        print "Value of find response rec is:  $find_resp_pr2\n";
        print "Value of find response rec is:  $find_resp_pr3\n";
        print "Value of find response rec is:  $find_resp_pr4\n";
        print "Value of find response rec is:  $find_resp_pr5\n";
    
    }elsif ($iroam_req_type  =~ /PriceCall/){
             my $csr = $dbh->prepare(q{
                                   begin
                                     :v_param_iroam_resp:= WIRELESS_IR
+OAM_PKG.Price_Call(:price_call_rec);
                                  end;
                        });
       $csr->bind_param(":price_call_rec", $price_call_rec);
       $csr->bind_param_inout(":v_param_iroam_resp", \$v_param_iroam_r
+esp,400);
       $csr->execute() or die "Couldn't execute pass transaction to ir
+oam package sub ".DBI->errstr;
    
       $price_response_rec = $v_param_iroam_resp;
             
        print "Value of v param iroam resp is:  $v_param_iroam_resp\n"
+;
        print "Value of price response is:  $price_response_rec \n";  
+ 
       
    }
    
    print "Processed transaction through the Iroam package\n"; # Infor
+m that connection to client is closed
   
}

[download]

Replies are listed 'Best First'.
Re: Perl Sockets
by ikegami (Patriarch) on Jul 19, 2007 at 16:06 UTC

    I wanted to send the the perl code but when I inserted it here it was a mess.

    Putting the code in <c>...</c> tags will keep the format and escape what needs to be escaped. For best results, keep the code minimal. Remove everything from it until you can't remove anything else without making the problem go away.

    By the way, it would help to place paragraph breaks in your text. Do so by adding <p> at the start of every paragraph.

[reply]
[d/l]
[select]
      Hello, Could you take a look at this, it should be working. I have been told now that it is possible that the ip address/port that I am using may not be configured to receive SEND messages. Anyway, could you look at the code and make any suggestions. Thanks. here is my perl coded program: 
      #!/usr/bin/perl -w
require 5.002;
use strict;
use IO::Socket;
use IO::Select;
use DBI;
use DBD::Oracle;

our ($dbh);
our ($find_min_request_rec, $find_response_rec);
our ($price_call_rec, $price_response_rec);
our ($find_resp_pr1,$find_resp_pr2,$find_resp_pr3);
our ($find_resp_pr4,$find_resp_pr5);
our  $read_set ;
our $rh;
our $ns;
our $buf;
our $find_resp;
our $iroam_req_type;

# Create the receiving socket
my $s = new IO::Socket::INET (
                LocalHost => '172.17.8.201', # IP Address Host to list
+en on
                LocalPort => '18490',  # Port Number Host to listen on
                Proto => 'tcp',
                Listen => 5,
                Reuse => 1,
                );
die "Could not create socket: $!\n" unless $s;

 
$read_set = new IO::Select(); # create handle set for reading
$read_set->add($s);           # add the main socket to the set
 
connect_to_oracle_db();

print "At Host/Port listening...\n";

while (1) { # Continous Listening on Port for a connection
    
   # get a set of readable handles(blocks until at least one handle is
+ ready)
   my ($rh_set) = IO::Select->select($read_set, undef, undef, 0);
   
        # take all readable handles in turn
   foreach $rh (@$rh_set) {
   print "Process each readable handle...\n";
   print "Value of rh is $rh...\n";
   print "Value of rh_set is @$rh_set..\n";
          # if it is the main socket then we have an incoming 
          # connection and we should accept() it and then add 
          # the new socket to the $read_set 
      if ($rh == $s) {
        print "Main socket/incoming connection add to readable set\n";
        $ns = $rh->accept();
        $read_set->add($ns); ##already added at beginning
        print "Value of rh_set is @$rh_set.after adding connection\n";
        # otherwise it is an ordinary socket and we should read 
        #and process the request
      }else{
        print "Its an ordinary socket,so read and process the request 
+...\n";
        print     "Connected from: ", $rh->peerhost();#Display Peer Co
+nnection
          print    " Port: ", $rh->peerport(), "\n";
        $buf = <$rh>;
        $iroam_req_type = substr($buf,0,8);#Extract the requestor type
        print "Requestor type extracted is: $iroam_req_type\n";#Displa
+y Iroam req
           
        if($buf) { # return normal input and process $buf
          print "Iroam transaction recd:\n";# Iroam Data
            print "$buf\n"; #Display value of the Iroam data from Iroa
+m
          if ($iroam_req_type  =~ /FindMin/){              
              $find_min_request_rec = $buf;
          }elsif ($iroam_req_type  =~ /PriceCall/){
                  $price_call_rec = $buf;     
          }
           pass_transaction_to_iroam_package();
           $rh->send($find_response_rec);
           print "rh send value is: $rh->send($find_response_rec) \n";
          }else { # the client has closed the socket
            print "Iroam client has closed the socket.\n";
            # remove the socket from the $read_set and close it
            $read_set->remove($rh);
            close($rh);
         }
      }
   }
 }

sub connect_to_oracle_db{
    
    print "Connect to the Oracle Database sub....\n";
    
    $dbh = DBI->connect(
           'DBI:Oracle:dev',
           'perluser',
           'oraperl',
           {AutoCommit => 0, RaiseError => 1}
   ) or die "Couldn't connect to database:".DBI->errstr;
}

sub pass_transaction_to_iroam_package{
       
    print "pass transaction to iroam package sub....\n";
    
    my $v_param_iroam_resp;
       
    if ($iroam_req_type  =~ /FindMin/){
       my $csr = $dbh->prepare(q{
                    begin
                      :v_param_iroam_resp:= WIRELESS_IROAM_PKG.Lookup_
+Min_Request(:find_min_request_rec);
                    end;
                  });
       $csr->bind_param(":find_min_request_rec", $find_min_request_rec
+);
       $csr->bind_param_inout(":v_param_iroam_resp", \$v_param_iroam_r
+esp,400);
       $csr->execute() 
        or die "Couldn't exe pass transaction iroam pkg sub ".DBI->err
+str;
    
       $find_response_rec = $v_param_iroam_resp;
        
        $find_resp_pr1 = substr($find_response_rec ,0,90);
        $find_resp_pr2 = substr($find_response_rec ,91,90);
        $find_resp_pr3 = substr($find_response_rec ,182,90);
        $find_resp_pr4 = substr($find_response_rec ,273,90);
        $find_resp_pr5 = substr($find_response_rec ,364,11);
    
    }elsif ($iroam_req_type  =~ /PriceCall/){
            my $csr = $dbh->prepare(q{
                       begin
                        :v_param_iroam_resp:= WIRELESS_IROAM_PKG.Price
+_Call(:price_call_rec);
                       end;
              });
     $csr->bind_param(":price_call_rec", $price_call_rec);
     $csr->bind_param_inout(":v_param_iroam_resp", \$v_param_iroam_res
+p,400);
     $csr->execute() or die "Couldn't exe pass iroam pkg sub ".DBI->er
+rstr;
    
     $price_response_rec = $v_param_iroam_resp;
             
     print "Value of v param iroam resp is:  $v_param_iroam_resp\n";
     print "Value of price response is:  $price_response_rec \n";   
       
    }
    
    print "Processed transaction through the Iroam package\n";
   
}

      [download]
[reply]
[d/l]
Re: Perl Sockets
by zentara (Cardinal) on Jul 19, 2007 at 16:21 UTC
    It sounds like you may need a "forking client" so you can have good bi-directional communication. (The $name stuff is just extra spiffiness :-) ) 
    #forking client for tcp
#!/usr/bin/perl -w
use strict;
use IO::Socket;

my ( $host, $port, $kidpid, $handle, $line );

( $host, $port ) = ('192.168.0.9',1200);

my $name = shift || '';
if($name eq ''){print "What's your name?\n"}
chomp ($name = <>);

# create a tcp connection to the specified host and port
$handle = IO::Socket::INET->new(
    Proto    => "tcp",
    PeerAddr => $host,
    PeerPort => $port
  )
  or die "can't connect to port $port on $host: $!";
$handle->autoflush(1);    # so output gets there right away
print STDERR "[Connected to $host:$port]\n";

# split the program into two processes, identical twins
die "can't fork: $!" unless defined( $kidpid = fork() );

# the if{} block runs only in the parent process
if ($kidpid) {

    # copy the socket to standard output
    while ( defined( $line = <$handle> ) ) {
                      print STDOUT $line;
                      }
    kill( "TERM", $kidpid );    # send SIGTERM to child
}

# the else{} block runs only in the child process
else {

    # copy standard input to the socket
    while ( defined( $line = <STDIN> ) ) {
        print $handle "$name->$line";
    }
}

    [download]
    I'm not really a human, but I play one on earth. Cogito ergo sum a bum
[reply]
[d/l]
      Hello, Could you take a look at this, it should be working. I have been told now that it is possible that the ip address/port that I am using may not be configured to receive SEND messages. Anyway, could you look at the code and make any suggestions. Thanks. here is my perl coded program: 
      #!/usr/bin/perl -w
require 5.002;
use strict;
use IO::Socket;
use IO::Select;
use DBI;
use DBD::Oracle;

our ($dbh);
our ($find_min_request_rec, $find_response_rec);
our ($price_call_rec, $price_response_rec);
our ($find_resp_pr1,$find_resp_pr2,$find_resp_pr3);
our ($find_resp_pr4,$find_resp_pr5);
our  $read_set ;
our $rh;
our $ns;
our $buf;
our $find_resp;
our $iroam_req_type;

# Create the receiving socket
my $s = new IO::Socket::INET (
                LocalHost => '172.17.8.201', # IP Address Host to list
+en on
                LocalPort => '18490',  # Port Number Host to listen on
                Proto => 'tcp',
                Listen => 5,
                Reuse => 1,
                );
die "Could not create socket: $!\n" unless $s;

 
$read_set = new IO::Select(); # create handle set for reading
$read_set->add($s);           # add the main socket to the set
 
connect_to_oracle_db();

print "At Host/Port listening...\n";

while (1) { # Continous Listening on Port for a connection
    
   # get a set of readable handles(blocks until at least one handle is
+ ready)
   my ($rh_set) = IO::Select->select($read_set, undef, undef, 0);
   
        # take all readable handles in turn
   foreach $rh (@$rh_set) {
   print "Process each readable handle...\n";
   print "Value of rh is $rh...\n";
   print "Value of rh_set is @$rh_set..\n";
          # if it is the main socket then we have an incoming 
          # connection and we should accept() it and then add 
          # the new socket to the $read_set 
      if ($rh == $s) {
        print "Main socket/incoming connection add to readable set\n";
        $ns = $rh->accept();
        $read_set->add($ns); ##already added at beginning
        print "Value of rh_set is @$rh_set.after adding connection\n";
        # otherwise it is an ordinary socket and we should read 
        #and process the request
      }else{
        print "Its an ordinary socket,so read and process the request 
+...\n";
        print     "Connected from: ", $rh->peerhost();#Display Peer Co
+nnection
          print    " Port: ", $rh->peerport(), "\n";
        $buf = <$rh>;
        $iroam_req_type = substr($buf,0,8);#Extract the requestor type
        print "Requestor type extracted is: $iroam_req_type\n";#Displa
+y Iroam req
           
        if($buf) { # return normal input and process $buf
          print "Iroam transaction recd:\n";# Iroam Data
            print "$buf\n"; #Display value of the Iroam data from Iroa
+m
          if ($iroam_req_type  =~ /FindMin/){              
              $find_min_request_rec = $buf;
          }elsif ($iroam_req_type  =~ /PriceCall/){
                  $price_call_rec = $buf;     
          }
           pass_transaction_to_iroam_package();
           $rh->send($find_response_rec);
           print "rh send value is: $rh->send($find_response_rec) \n";
          }else { # the client has closed the socket
            print "Iroam client has closed the socket.\n";
            # remove the socket from the $read_set and close it
            $read_set->remove($rh);
            close($rh);
         }
      }
   }
 }

sub connect_to_oracle_db{
    
    print "Connect to the Oracle Database sub....\n";
    
    $dbh = DBI->connect(
           'DBI:Oracle:dev',
           'perluser',
           'oraperl',
           {AutoCommit => 0, RaiseError => 1}
   ) or die "Couldn't connect to database:".DBI->errstr;
}

sub pass_transaction_to_iroam_package{
       
    print "pass transaction to iroam package sub....\n";
    
    my $v_param_iroam_resp;
       
    if ($iroam_req_type  =~ /FindMin/){
       my $csr = $dbh->prepare(q{
                    begin
                      :v_param_iroam_resp:= WIRELESS_IROAM_PKG.Lookup_
+Min_Request(:find_min_request_rec);
                    end;
                  });
       $csr->bind_param(":find_min_request_rec", $find_min_request_rec
+);
       $csr->bind_param_inout(":v_param_iroam_resp", \$v_param_iroam_r
+esp,400);
       $csr->execute() 
        or die "Couldn't exe pass transaction iroam pkg sub ".DBI->err
+str;
    
       $find_response_rec = $v_param_iroam_resp;
        
        $find_resp_pr1 = substr($find_response_rec ,0,90);
        $find_resp_pr2 = substr($find_response_rec ,91,90);
        $find_resp_pr3 = substr($find_response_rec ,182,90);
        $find_resp_pr4 = substr($find_response_rec ,273,90);
        $find_resp_pr5 = substr($find_response_rec ,364,11);
    
    }elsif ($iroam_req_type  =~ /PriceCall/){
            my $csr = $dbh->prepare(q{
                       begin
                        :v_param_iroam_resp:= WIRELESS_IROAM_PKG.Price
+_Call(:price_call_rec);
                       end;
              });
     $csr->bind_param(":price_call_rec", $price_call_rec);
     $csr->bind_param_inout(":v_param_iroam_resp", \$v_param_iroam_res
+p,400);
     $csr->execute() or die "Couldn't exe pass iroam pkg sub ".DBI->er
+rstr;
    
     $price_response_rec = $v_param_iroam_resp;
             
     print "Value of v param iroam resp is:  $v_param_iroam_resp\n";
     print "Value of price response is:  $price_response_rec \n";   
       
    }
    
    print "Processed transaction through the Iroam package\n";
   
}

      [download]
[reply]
[d/l]
        Sorry, I'm not very good at finding flaws in code that I can't run, and I don't have Oracle. Maybe if you could post a chopped down example that has some generic filler code for the Oracle db stuff, I could run it.

        As far as the comment about SEND messages go, that is why I posted the forking client for you to try. If you read "perldoc IO::Socket", "send and recv" are mentioned. If you don't use a bi-directional client, you need to somehow switch your client socket into recv mode, after the send. This usually involves some sort of protocol you develop, to signal to both ends of the socket, who should be sending and who should be receiving. The forking bi-directional client is an easy solution for that problem, one fork sends and the other receives.

        I'm not really a human, but I play one on earth. Cogito ergo sum a bum
[reply]

Back to Seekers of Perl Wisdom