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

Happy Thanksgiving Monks!

I want to have to receive loops for two differant simaltanious socket connections, that can send data back to each other. But the problem I'm having is that when the script gets into one loop and dosn't get into the other. I know this is a simple problem, and that I should fork it, or use threads or something like that, but I've been coding perl for couple months now, and I havn't messed with forking/threads and stuff (the loops have to be able to pass socket/file handles between each other too).

To give you an example of what I'm talking about, I'm writing a script that will run as an IRC/AIM bots that allow me to send irc messages through the aim bot portion, and aim messages through the irc bot portion (so I don't allways have to use an irc client or aim client). And when the irc bot gets "PRIVMSG" packets, it will use the AIM connection to send that "PRIVMSG" data to someone on aim. Does this make anysense?

Well any response will be greatly appriciated!

Thank you, and have a great thanksgiving :)

^jasper

Replies are listed 'Best First'.
Re: Passing data between two receive loops
by Abigail-II (Bishop) on Nov 28, 2002 at 18:17 UTC
    This isn't a simple problem. (Why is that so many people who have a problem say "I know it's a simple problem". If you know enough about the problem to know it's simple, why not solve it yourself instead of taking the trouble to post here?)

    You don't say much about your specific problem, but this looks like you have a race-condition, or even deadlock. If both ends of the connection are doing a blocking read, they'll wait forever. You need to carefully synchronize your programs, and may want to use non-blocking reads. Perhaps by using 4-arg select, Event.pm, POE, and whatever it is Uri is always promoting (Stem?).

    Abigail

      Well, i thought it was a simple problem because I was thinking I would have to fork the loops (but im new to forking and working with processes in perl), so i would need help even if that was the case.

      But thanks for the help anyway :)

      ^jasper <jasper@wintermarket.org>
Re: Passing data between two receive loops
by pg (Canon) on Nov 28, 2002 at 18:21 UTC
    In one of my notes, I gave an example of using socket with threads, (it does not do exactly what you want, but it demos the technics you want.) you can check it out: socket with threads
      thanks

      ^jasper <jasper@wintermarket.org>
        Sorry but I couldnt post the code at the time of writing that (was not at home) =\

        But here is what i got, its *real* messy, and probably buggy(should write it as a package):
        use Class::Struct; # so we can use structures =) use IO::Socket; # for socket connection[s] use IO::Select; # ... use IO::Handle; # . use Net::AIM; # for the aim connection #--------------------- # structures and junk struct( irc => [ server => '$', #irc server port => '$', #irc port nick => '$', #irc nickname chan => '@', #irc channel[s] obj => '$', #irc socket object aim_obj => aim, #... ]); struct ( aim => [ nick => '$', #aim screenname pass => '$', #aim password remote => '@', #remote aim users (to do: make this a +hash) obj => '$', #net::aim object ]); my $debug = true; my ($struct,$irc,$aim); sub start { my ($argv,$nick,$pass,@chan) = @_; #make main structure $struct = irc->new( server => $argv, port => $port, nick => $nick, chan => @chan, ); $irc = &irc_connect($struct,$argv,$nick,$pass,@chan); #create aim object $aim = &aim_start($nick,$pass,$struct,$irc); $irc->shutdown($irc); return $struct; } #----------- # irc stuff sub irc_connect { my ($struct,$argv,$nick,$pass,@chan) = @_; my ($aim,$buff); my ($server,$port) = split(/:/,$argv); $nick =~ s/ //; srand(time); my $rnd_pass = int(rand(9999)); $irc = IO::Socket::INET->new(PeerAddr => $server, PeerPort => $port, Proto => "tcp" ) or die "Can't Con +nect to $server:$port!"; $struct->obj($irc); $irc->send("113,$port : USERID : UNIX : meh\r\n"); $irc->send("PASS $pass\r\n"); $irc->send("NICK $nick\r\n"); $irc->send("USER $nick $rnd_pass $server : $nick\r\n"); &irc_loop($struct,$aim,$irc); return $irc; } sub irc_loop { my ($struct,$aim,$self) = @_; while ($self->recv(my $buff,128)) { my ($what,$remote,$host,$type,$data) = split(/^:(\w+)!(.+) +\s+(\w+)\s+(\w+)$/,$buff); my $errret = &code_resp($buff,$struct,$aim,$self); if ($type eq "PRIVMSG") { #a message of some kind my ($from,$msg) = split(/^(\w+):\s+(\w+)/,$data); foreach my $element (@{$struct->aim_obj->remote}) { $aim->send_im($struct->aim_obj->remote,"<b>&lt;$from/$ +remote&gt;</b> $msg"); } } #so we don't time out =) if (my $pong =~ /PING\s+:\s*(\w+)/) { $self->send("PONG $pong\r\n"); } } return $irc; } sub irc_disconnect { my ($nick,$aim,$struct,$irc) = @_; my $peer = gethostbyaddr($irc->peeraddr,AF_INET || $irc->peerhost) +; my $conn = $irc->connected(); if ($conn != 1) { $irc->send("QUIT :Breakdown! Go ahead and give it to me!\r\n") +; $irc->shutdown($self); $aim->send_im($nick,"Disconnected from $peer!"); exit; } } sub code_resp { my ($buff,$struct,$aim,$irc) = @_; my ($server,$code,$our_nick) = split(/^:(\w+)\s+(\d+)\s+(\w+)/,$bu +ff); if (defined($code)) { if ($code == 372 || $code == 376) { foreach my $chan (@{$struct->chan}) { $irc->send(" +JOIN $chan\r\n"); } } elsif ($code == 433 || $code == 436) { my $new_nick = &rnd_nick; $irc->send("NICK $new_nick\r\n"); } } return; } sub rnd_nick { my $chars = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0 +123456789[]_-^"; my ($cstrlen,$cpos,$rnds); $cstrlen = 0; do { $cpos = int(rand(length($chars)) + 1); $rnds .= substr($chars,$cpos,$cpos+1); } until ($cstrlen = 9); return $rnds; } #----------- # aim stuff sub aim_start { my ($nick,$pass,$struct,$irc) = @_; #aim screenname, aim password +, irc structure, irc object $aim = new Net::AIM; $aim->newconn( Screenname => $nick, Password => $pass, AutoReconnect => 1 ) or die "Can't Connect to AIM server! Please Check your + Internet Connection!\n"; $struct->aim_obj->nick($nick); $struct->aim_obj->pass($pass); $struct->aim_obj->obj($aim); #get connect object and setup event handlers my $conn = $aim->getconn(); $conn->set_handler('error', \&on_error); $conn->set_handler('im_in', \&on_im); $conn->set_handler('nick', \&on_nick); $conn->set_handler('eviled', \&on_eviled); $conn->set_handler('config', \&on_config); $aim->start; return $aim; } sub aim_add_remote { my ($nick,$struct,$irc) = @_; foreach my $element (@{$struct->aim_obj->remote}) { if ($element ne $nick) { push(@{$struct->aim_obj->remote},$nick); last; } } return $struct; } sub aim_rm_remote { my ($nick,$struct,$irc) = @_; for (my $i = 0; $i < @{$struct->aim_obj->remote};$i++) { if ($struct->aim_obj->remote[$i] eq $nick) { splice(@{$struct->aim_obj->remote},$i,1); last; } } return $struct; } sub on_im { my ($self, $evt, $from, $to) = @_; my $args = $evt->args(); my ($nick, $auto_msg, $msg) = @$args; #meh, need to remove html $msg =~ s/<[^>]+>//g; $msg =~ s/^\s+//g; my ($cmd,$argv1,$argv2) = ($msg =~ /\.(\S+)\s*(\S*)/); print "\t$cmd\n"; if (defined($cmd)) { if ($cmd eq "irc") { $irc = $struct->obj; &irc_loop($struct,$self,$irc); } elsif ($cmd eq "add") { if (defined($argv1)) { &aim_add_remote($nick,$struct,$irc); } } last; } } sub on_nick { my ($self, $evt, $from, $to) = @_; my $args = $evt->args(); my $nick = $args->[0]; print "Logged on Successfully!\n"; } sub on_config { my ($self, $evt, $from, $to) = @_; my $str = shift @{$evt->args()}; $self->set_config_str($str, 1); $self->send_config(); } sub on_error { my ($self, $evt) = @_; my ($error, @stuff) = @{$evt->args()}; my $errstr = $evt->trans($error); $errstr =~ s/\$(\d+)/$stuff[$1]/ge; } 1;
        Yes, i know its ugly. But hopefully you will get what im talking about.

        ^jasper