Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

Passing message between 2 sockets

by Light-Angel (Initiate)
on Apr 10, 2016 at 20:20 UTC ( [id://1160060]=perlquestion: print w/replies, xml ) Need Help??

Light-Angel has asked for the wisdom of the Perl Monks concerning the following question:

i have been working a a script with a friend to send chat between to sockets but i just cant figger out where to do it been looking at it for days and still cant figger it out

will post all thew code with to two sockets the code conects to the 2 servicesi will mark the code with =========== IRC NEW code ====================== and that is the code what i want outputted to the hub code and the hub code to be sent back to the IRC i just hope someone can help

#!/usr/bin/perl # ASG-Bot - ASG-Bot Multi-Chat Client # # Copyright (C) 2006 Juliusz Hoffman # # This program is free software; you can redistribute it and/or modif +y # it under the terms of the GNU General Public License as published b +y # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-130 +7 USA use warnings; use strict; use Socket; use POE qw(Wheel::SocketFactory Wheel::ReadWrite Component::Client::TC +P Filter::Stream); my (%hubs, @slaves, %cfg, %ignored, $debug, %var); my $version = "0.11"; &read_cfg; POE::Session->create( args => [ %hubs ], inline_states => { _start => sub { my ( $kernel, $heap, $hubs) = @_[ KERNEL, HEAP, ARG0]; $kernel->alias_set('Classifier'); # foreach my $key ( sort keys %hubs ) # { # push ( @{ $heap->{Slaves} }, CreateSlave($key, $hubs{$key}{ad +dress}, $hubs{$key}{port}, $hubs{$key}{prefix} ) ); # } my $tmp; foreach my $key ( sort keys %hubs ) { $tmp = CreateSlave($key, $hubs{$key}{address}, $hubs{$key}{por +t}, $hubs{$key}{prefix} ); $heap->{Slaves}{$key} = $tmp; # push ( @{ $heap->{Slaves} }, CreateSlave($key, $hubs{$key}{ad +dress}, $hubs{$key}{port}, $hubs{$key}{prefix} ) ); } }, classify => sub { my ( $kernel, $heap, $sender, $alias, $msg, $prefix) = @_[ KER +NEL, HEAP, SENDER, ARG0, ARG1, ARG2 ]; my $split = 0; if ($msg =~ /^\</) { my (@linie) = split(/\n/,$msg); if (@linie > 1 ){ $split=1; my $beznl; foreach (@linie) { $beznl .= "$_"."___NEWLINE___"; } $msg = $beznl; } } if ($msg =~ /^\$Lock (.*)\|/) { $var{$alias}{LoggedIn} = 0; my $key = convertLockToKey($1,5); print "Key - $key\n" if $debug; my $msg_to_send = "\$Key $key|\$ValidateNick $hubs{$alias}{nic +k}||"; $kernel->post('Classifier', 'send_proto', $sender , $msg_to_se +nd) } elsif ($msg =~ /^\$Hello $hubs{$alias}{nick}\|/) { if (!$var{$alias}{LoggedIn} == 1) { print "\n\n\$Hello\n\n" if $debug; $var{$alias}{LoggedIn} = 1; my $msg_to_send = '$MyINFO $ALL '.$hubs{$alias}{nick}.' te +sty pmcc (POE Version) <ASG-Bot++ V:0.785,M:A,H:0/0/11,S:1>$ $DSL'."\ +001".'$http://asg-bot.xxxxx.org$67825326530$|'."<$hubs{$alias}{nick}> + This hub is running version $version of ASG Bot. (http://asg-bot.xxx +xx.org) |"; print $msg_to_send if $debug; $kernel->post('Classifier', 'send_proto', $sender , $msg_t +o_send) } } elsif ($msg =~ /^\<([^>]+)\> (.*)\|/) { my ( $nick, $send_msg) = ($1, $2); if ($split == 1) { my (@newline) = split(/___NEWLINE___/,$send_msg); $send_msg=""; foreach (@newline) { $send_msg .= "$_"."\n"; } chop($send_msg); } $kernel->post('Classifier', "parse_chat", $alias , $prefix +, $nick, $send_msg) } elsif ($msg =~ /^\$GetPass\|/) { my $msg_to_send = "\$MyPass $hubs{$alias}{password}|"; $kernel->post('Classifier', 'send_proto', $sender , $msg_to_se +nd) } elsif ($msg =~ /^\$To: $hubs{$alias}{nick}/) { $kernel->post('Classifier', "parse_pm", $alias , $sender, $msg +) } }, parse_chat => sub { my ( $kernel, $heap, $alias, $prefix, $nick, $msg) = @_[ KERNE +L, HEAP, ARG0, ARG1, ARG2, ARG3]; print "SendChatClassifier - $msg\n\n" if $debug; if ( ($nick ne $hubs{$alias}{nick}) && (!(&check_ignored_nick( +$nick,"nicks"))) && (!(&check_ignored_msg($msg,"begins"))) && (!&chec +k_ignored_msg($msg,"contains")) ) { if ( length($msg) > $cfg{main}{max_mess_len} ) { $msg = substr($msg, 0, $cfg{main}{max_mess_len}); $msg .= "\nThis message was cut due to lenght..."; } $msg = "\<$prefix$nick\> $msg|"; print "$msg\n"; # foreach my $slave ( @{ $heap->{Slaves} } ) { foreach my $slave ( keys % { $heap->{Slaves} } ) { $kernel->post($slave, 'send_chat', $alias , $msg); } } }, parse_pm => sub { my ( $kernel, $heap, $alias, $sender, $msg) = @_[ KERNEL, HEAP +, ARG0, ARG1, ARG2]; print "PM - $msg\n"; if ($msg =~ /^\$To: [^\s]+ From: ([^\s]+) \$\<[^>]+\> ([^|]+)\ +s*\|/ ) { my $from = $1; my $command = $2; my $msg_to_send = "\$To: $from From: $hubs{$alias}{nick} \$\<$ +hubs{$alias}{nick}\> "; if ($command =~ /^\s*(\![^\s]+)\s*(.*)/ ) { my $level = &check_level($from); if ($level == 0) { $msg_to_send .= "\n\n\t\tInfo\n\n"; $msg_to_send .= "You don't have enough privileges to admin +ister this ASG-Bot! (http://asg-bot.xxxxx.org/showthread.php?tid=1)\n +"; $msg_to_send .= "\n\n\t\tASG-Bot by PTB & Light-Angel|"; $kernel->post($sender, 'send', $msg_to_send); } if ($level > 0 ) { if ($1 eq "!help" ){ $msg_to_send .= "\n\n\t\t ASG-Bot Help\n\n"; $msg_to_send .= "\tMaintainer commands:\n"; $msg_to_send .= "!list \t\t-\t list availible hubs\n"; $msg_to_send .= "!connect alias \t-\t connect to hub ' +alias' (check aliases by using !list)\n"; $msg_to_send .= "!disconnect alias \t-\t disconnect fr +om hub 'alias' (check aliases by using !list)\n"; $msg_to_send .= "!reconnect alias \t-\t reconnects the + hub 'alias' (check aliases by using !list)\n"; $msg_to_send .= "!reconnectall \t-\t reconnects all co +nnected hubs\n"; if ($level == 2){ $msg_to_send .= "\n\tAdmin commands\n"; $msg_to_send .= '!addhub alias -address="address" -por +t="port" -nick="nick" -password="password" -prefix="prefix" -auto_con +nect="0\1"'."\n\t\t-\tAdds a hub with the speciied values\n"; $msg_to_send .= '!modhub alias -address="address" -por +t="port" -nick="nick" -password="password" -prefix="prefix" -auto_con +nect="0\1"'."\n\t\t-\tModifies a hub definition. You need to specify +only the desired values\n"; $msg_to_send .= "!remhub alias \t-\t disconnects if co +nnected and removes a hub from the configuration files\n"; $msg_to_send .= "!reload \t\t-\t reloads config files\ +n"; $msg_to_send .= "!save \t\t-\t saves all confg files\n +"; } $msg_to_send .= "|"; $kernel->post($sender, 'send', $msg_to_send); } elsif ($1 eq "!list" ){ $msg_to_send .= "\n\n\t\tASG-Bot Hub List\n"; foreach my $key1 ( sort keys %hubs ) { $msg_to_send .= "\n\nAlias: \t$key1\n"; if ($var{$key1}{LoggedIn} && ($var{$key1}{LoggedIn} == + 1)) { $msg_to_send .= "\tConnected\n"; } else { $msg_to_send .= "\tNot connected\n"; } for my $key2 (sort keys %{ $hubs{$key1} } ) { $msg_to_send .= "\t$key2 - $hubs{$key1}{$key2}\n"; } } $msg_to_send .= "|"; $kernel->post($sender, 'send', $msg_to_send); } elsif ($1 eq "!connect" ){ if ($hubs{$2}) { if ( (!($var{$2}{LoggedIn})) || ($var{$2}{LoggedIn} != + 1)) { $kernel->post($2, 'connect'); $msg_to_send .= "Connecting to $hubs{$2}{address}: +$hubs{$2}{port}...|"; } else { $msg_to_send .= "$2 already connected...|"; } } else { $msg_to_send .= "No such alias $2|"; } $kernel->post($sender, 'send', $msg_to_send); } elsif ($1 eq "!disconnect" ){ if ($hubs{$2}) { if (($var{$2}{LoggedIn}) && ($var{$2}{LoggedIn} == 1)) + { $msg_to_send .= "Disconnecting from $hubs{$2}{addr +ess}:$hubs{$2}{port}...|"; $var{$2}{no_reconnect} = 1; $kernel->post($2, 'disconnect'); } else { $msg_to_send .= "$2 not connected...|"; } } else { $msg_to_send .= "No such alias $2|"; } $kernel->post($sender, 'send', $msg_to_send); } elsif ($1 eq "!reconnect" ){ if ($hubs{$2}) { $msg_to_send .= "Reconnecting to $hubs{$2}{address}:$h +ubs{$2}{port}...|"; $kernel->post($2, 'reconnect'); } else { $msg_to_send .= "No such alias $2|"; } $kernel->post($sender, 'send', $msg_to_send); } elsif ($1 eq "!reconnectall" ){ $msg_to_send .= "Reconnecting all hubs.|"; $kernel->post($sender, 'send', $msg_to_send); foreach my $key1 ( sort keys %var ) { if ( $var{$key1} && ($var{$key1}{LoggedIn} == 1) ) { $kernel->post($key1, 'reconnect'); } } } elsif ($level == 2) { if ($1 eq "!reload" ){ $msg_to_send .= "Reloading configuration, ignored nick +s and messages.|"; &read_cfg; $kernel->post($sender, 'send', $msg_to_send); foreach my $key ( sort keys %hubs ) { if (!exists($var{$key})){ push ( @{ $heap->{Slaves} }, CreateSlave($key, $hu +bs{$key}{address}, $hubs{$key}{port}, $hubs{$key}{prefix} ) ); } } } elsif ($1 eq "!save" ){ $msg_to_send .= "Saving all configuration files.|"; &write_cfg; $kernel->post($sender, 'send', $msg_to_send); } elsif ($1 eq "!addhub" ){ my $ret=&addhub($2); if ($ret eq "0" ) { $msg_to_send .= 'Usage: !addhub alias -address="ad +dress" -port="port" -nick="nick" -password="password" -prefix="prefix +" -auto_connect="0\1"|'; } elsif ($ret eq "1" ) { $msg_to_send .= "A hub with such alias already exi +sts. If you want to change it's config try !modhub.|"; } else { $msg_to_send .= 'Hub added. If you specified auto_ +connect="1" ASG-Bot will connect to this hub now - else use "!connect + alias"|'; #push ( @{ $heap->{Slaves} }, CreateSlave($ret, $h +ubs{$ret}{address}, $hubs{$ret}{port}, $hubs{$ret}{prefix} ) ); my $tmp = CreateSlave($ret, $hubs{$ret}{address}, +$hubs{$ret}{port}, $hubs{$ret}{prefix} ); $heap->{Slaves}{$hubs{$ret}{alias}} = $tmp; } &dump_config("hubs"); $kernel->post($sender, 'send', $msg_to_send); } elsif ($1 eq "!modhub" ){ my $ret=&modhub($2); if ($ret eq "0" ) { $msg_to_send .= 'Usage: !modhub alias -address="ad +dress" -port="port" -nick="nick" -password="password" -prefix="prefix +" -auto_connect="0\1"|'; } else { $msg_to_send .= 'Hub modified. If you changed addr +ess / port type !reconnect alias for the changes to take effect.|'; } &dump_config("hubs"); $kernel->post($sender, 'send', $msg_to_send); } elsif ($1 eq "!remhub" ){ if ($hubs{$2}) { $msg_to_send .= "Removing hub $2"; if ( ($var{$2}{LoggedIn}) && ($var{$2}{LoggedIn} = += 1)) { $var{$2}{no_reconnect} = 1; $kernel->post($2, 'disconnect'); if ( exists($heap->{Slaves}{$2}) ){ delete($heap->{Slaves}{$2}); } if ( exists($heap->{Slaves}{$2}) ){ print "fail\n"; } } delete($var{$2}); delete($hubs{$2}); &dump_config("hubs"); } else { $msg_to_send .= "No such alias $2"; } $msg_to_send .= "|"; $kernel->post($sender, 'send', $msg_to_send); } } else { $msg_to_send .= "No such command or not enough privile +ges to use this command.|"; $kernel->post($sender, 'send', $msg_to_send); } } } } }, send_proto => sub { my ( $kernel, $heap, $to, $msg) = @_[ KERNEL, HEAP, ARG0, ARG1 +]; print "\n\nSendProto - $msg\n\n" if $debug; $kernel->post($to, 'send', $msg); }, _stop => sub { print "Nothing left to do - Classifier slain.\n"; } } ); =========== IRC NEW code ====================== use warnings; use strict; use POE; use POE::Component::IRC; sub CHANNEL () { "#room1" } # Create the component that will represent an IRC network. my ($irc) = POE::Component::IRC->spawn(); # Create the bot session. The new() call specifies the events the bot # knows about and the functions that will handle those events. POE::Session->create( inline_states => { _start => \&bot_start, irc_001 => \&on_connect, irc_public => \&on_public, }, ); # The bot session has started. Register this bot with the "magnet" # IRC component. Select a nickname. Connect to a server. sub bot_start { $irc->yield(register => "all"); my $nick = 'MHC123'; $irc->yield( connect => { Nick => $nick, Username => 'MHC123', Ircname => 'POE::Component::IRC IRC bot', Server => '10.10.0.1', Port => '6667', } ); } # The bot has successfully connected to a server. Join a channel. sub on_connect { $irc->yield(join => CHANNEL); } # The bot has received a public message. Parse it for commands, and # respond to interesting things. sub on_public { my ($kernel, $who, $where, $msg) = @_[KERNEL, ARG0, ARG1, ARG2]; my $nick = (split /!/, $who)[0]; my $channel = $where->[0]; my $ts = scalar localtime; print " [$ts] <$nick:$channel> $msg\n"; if (my ($rot13) = $msg =~ /^rot13 (.+)/) { $rot13 =~ tr[a-zA-Z][n-za-mN-ZA-M]; # Send a response back to the server. $irc->yield(privmsg => CHANNEL, $rot13); } } =========== IRC NEW code ====================== POE::Kernel->run(); exit; sub CreateSlave { my ($alias, $address, $port, $prefix) = @_; return POE::Session->create( args => [ $alias, $address, $port, $prefix ], inline_states => { _start => sub { $_[KERNEL]->alias_set($alias); print "$alias created\n"; $var{$alias}{created}=1; if ( $hubs{$alias}{auto_connect} == 1 ) { $_[KERNEL]->post($alias, 'connect', $alias, $address , $po +rt, $prefix) } }, _stop => sub { print "$alias slain"; }, connect => sub { my $wheel = POE::Component::Client::TCP->new( RemoteAddress => $address, RemotePort => $port, Filter => "POE::Filter::Stream", Connected => sub { print "connected to $address:$port ...\n"; }, ServerInput => sub { my ( $kernel, $heap, $input ) = @_[ KERNEL, HEAP, ARG0 + ]; my @commands = split(/\|/, $input); foreach (@commands) { my $act_command = "$_\|"; print "$alias $act_command\n" if $debug; $_[KERNEL]->post('Classifier', 'classify', $alias, $ac +t_command, $prefix); } }, Disconnected => sub { print "$alias disconnected\n"; $var{$alias}{LoggedIn} = 0; if ( ! $var{$alias}{no_reconnect} ){ if ($cfg{main}{reconnect_time}) { $_[KERNEL]->delay( reconnect => $cfg{main}{reconnect_t +ime} ); } else { $_[KERNEL]->delay( reconnect => 60 ); } } else { delete($var{$alias}{no_reconnect}); } }, ConnectError => sub { $var{$alias}{LoggedIn} = 0; if ($cfg{main}{reconnect_time}) { $_[KERNEL]->delay( reconnect => $cfg{main}{reconnect_t +ime} ); } else { $_[KERNEL]->delay( reconnect => 60 ); } }, InlineStates =>{ send => sub { my ( $kernel, $heap, $input ) = @_[ KERNEL, HEAP, ARG0 + ]; $_[HEAP]->{server}->put($input); }, send_chat => sub { my ( $kernel, $heap, $source, $input ) = @_[ KERNEL, H +EAP, ARG0, ARG1]; print "$input\n" if $debug; $_[HEAP]->{server}->put($input) if ($_[HEAP]->{server} +); }, disconnect => sub { delete($var{$alias}{LoggedIn}); print "shutting down\n"; $_[KERNEL]->yield( "shutdown" ); }, shutdown => sub { $_[KERNEL]->yield( "shutdown" ); $_[HEAP]->{shutdown} = 1; $_[HEAP]->{shutdown_on_error}=1; }, check => sub { # if ($_[HEAP]->{shutdown} == 1) { if ($_[HEAP]->{server}) { print "shuttingdown\n"; } else { print "not shutting down\n"; } }, } ); $_[HEAP]->{wheel} = $wheel; }, send_chat => sub { my ( $kernel, $heap, $source, $input ) = @_[ KERNEL, HEAP, ARG +0, ARG1]; print "source - $source, alias - $alias\n" if $debug; if ($source ne $alias ) { $input = "<$hubs{$alias}{nick}> $input"; $kernel->post($heap->{wheel}, 'send_chat', $source, $input +) } }, disconnect => sub { my ( $kernel, $heap ) = @_[ KERNEL, HEAP]; $kernel->post($heap->{wheel}, 'disconnect'); $kernel->post($heap->{wheel}, 'send_chat', "", "|"); }, reconnect => sub { my ( $kernel, $heap ) = @_[ KERNEL, HEAP]; delete ($var{$alias}{LoggedIn}); $kernel->post($heap->{wheel}, 'connect'); }, remove => sub { my ( $kernel, $heap ) = @_[ KERNEL, HEAP]; $kernel->post($heap->{wheel}, 'shutdown'); delete($heap->{wheel}); $_[KERNEL]->yield( "shutdown" ); }, } ); } sub check_ignored_msg { my $msg = shift; my $array = shift; $msg = lc($msg); foreach (@{$ignored{$array}}) { if ($array eq "contains") { if( $msg =~ /^$_/ ) { return 1 } } elsif ($array eq "begins") { if( $msg =~ /$_/ ) { return 1 } } } return 0 } sub check_ignored_nick { my $msg = shift; my $array = shift; $msg = lc($msg); foreach (@{$ignored{'nicks'}}) { if ( $msg eq $_ ) { return 1 } } return 0 } sub parse_config_file { my %cfg; my $header; my $file_to_parse = shift; my $i = 0; open (SRC,"<$file_to_parse" ); my @plik = <SRC>; while ($plik[$i]){ if ($plik[$i] =~ /^\s*\;.*/) { print "Coment: $plik[$i]\n" if $debug; } elsif ($plik[$i] =~ /^\s*\[([^]]+)\]/) { print "Header: $1 \n" if $debug; $header = $1; } elsif ($plik[$i] =~ /^\s*([^=]+)\=(.*)/) { $cfg{$header}{$1} = $2; print "Var $header $1 = \"$2\"\n" if $debug; } elsif ($plik[$i] =~ /^\s*$/) { } elsif ($header && ($header eq "mch_admins" || $header eq "mch_main +tainers")){ if ($plik[$i] =~ /^(.*)/) { push @{ $cfg{$header} }, lc($1); print "$header = $1\n" if $debug; } } $i++ } return %cfg } sub parse_ignored_file { my %cfg; my $header; my $file_to_parse = shift; my $i = 0; open (SRC,"<$file_to_parse" ); my @plik = <SRC>; while ($plik[$i]){ if ($plik[$i] =~ /^\s*\;.*/) { print "Coment: $plik[$i]\n" if $debug; } elsif ($plik[$i] =~ /^\s*\[([^]]+)\]/) { print "Header: $1 \n" if $debug; $header = $1; } elsif ($plik[$i] =~ /^\s*$/) { } elsif ($plik[$i] =~ /^(.*)/) { push @{ $cfg{$header} }, lc($1); print "Var $header = $1\n" if $debug; } $i++ } return %cfg } sub read_cfg { # $cfg{main}{max_mess_len} = 300; %hubs = &parse_config_file("hubs"); %cfg = &parse_config_file("config"); %ignored = &parse_ignored_file("ignored"); } sub check_level { my $nick = shift; $nick = lc($nick); if ($cfg{mch_admins}){ foreach (@{$cfg{mch_admins}}) { return 2 if ($nick eq $_); } } if ($cfg{mch_maintainers}) { foreach (@{$cfg{mch_maintainers}}) { return 1 if ($nick eq $_); } } return 0 } sub write_cfg { &dump_config("hubs"); &dump_config("config"); &dump_config("ignored"); } sub dump_config { my $type = shift; my ($key1, $key2); if ($type eq "hubs"){ open (DST,">hubs" ); print DST "; \tHubs configuration file:\n"; print DST "; Sample hub configuration:\n\n"; print DST "; [hub1]\n"; print DST "; password=test\n"; print DST "; address=127.0.0.1\n"; print DST "; nick=MultiChat\n"; print DST "; port=411\n"; print DST "; prefix=hub1> \n"; print DST "; auto_connect=1\n\n"; print DST "; Remember not to use same section names for each hub ( + in the [] brackets)\n; if you use the same name twice, aerlier decla +ration will be overwritten\n\n"; foreach $key1 (keys %hubs) { print DST "[$key1]\n"; for $key2 ( keys %{ $hubs{$key1} } ) { print DST "$key2=$hubs{$key1}{$key2}\n"; } print DST "\n" } close(DST); } elsif ($type eq "config") { open (DST,">config" ); print DST "; \tMain config file:\n"; print DST "; Below sections mean:\n"; print DST "; [main] - main config variables\n"; print DST "; [mch_admins] - users that have full access to all DC +console functions\n"; print DST "; [mch maintainers] - users that can list, connect, dis +connect and reconnect ASG-Bot to / from given hubs\n\n"; foreach $key1 (keys %cfg) { print DST"[$key1]\n"; if ($key1 eq "main") { for $key2 ( keys %{ $cfg{$key1} } ) { print DST "$key2=$cfg{$key1}{$key2}\n"; } } else { for $key2 ( @{ $cfg{$key1} } ) { print DST "$key2\n"; } } print DST "\n" } } elsif ($type eq "ignored"){ open (DST,">ignored" ); print DST "; \tIgnored users/messages configfile:\n"; print DST "; Below sections mean:\n"; print DST "; [begins] - ignored message begins with this text\n"; print DST "; [contains] - ignored message contains this text\n"; print DST "; [nicks] - ignored nicks (bots etc.)\n\n"; foreach $key1 (keys %ignored) { print DST "[$key1]\n"; for $key2 ( @{ $ignored{$key1} } ) { print DST "$key2\n"; } print DST "\n" } close(DST); } } sub convertLockToKey { @_ == 2 or die "usage: convertLockToKey( lock , xorkey )"; my @lock = split( // , shift ); my $xor_key = scalar( shift ); my $i; my @key = (); # convert to ordinal foreach( @lock ) { $_ = ord; } # calc key[0] with some xor-ing magic push( @key , ( $lock[0] ^ $lock[ $#lock - 1 ] ^ $lock[ $#lock +] ^ $xor_key ) ); # calc rest of key with some other xor-ing magic for( $i = 1 ; $i < @lock ; $i++ ) { push( @key , ( $lock[$i] ^ $lock[$i - 1] ) ); } # nibble swapping for( $i = 0 ; $i < @key ; $i++ ) { $key[$i] = ( ( $key[$i] << 4 ) & 0xF0 ) | ( ( $key[$i] + >> 4 ) & 0x0F ); } # escape some foreach( @key ) { if ( $_ == 0 || $_ == 5 || $_ == 36 || $_ == 96 || $_ +== 124 || $_ == 126 ) { $_ = sprintf( '/%%DCN%03i%%/' , $_ ); } else { $_ = chr; } } # done return join( '' , @key ); } sub addhub { my $msg= shift; #sample msg 'alias -address="localhost" -port="411" -nick="mch" -p +assword="mch" -prefix="mch" -auto_connect="1"'; my ($alias, $address, $port, $nick, $password, $prefix, $auto_conn +ect); print "$msg"; if ($msg =~ /^([^\s]+)/ ) { $alias = $1; if ($msg =~ /-address="([^"]+)"/ ) { $address = $1; if ($msg =~ /-port="([^"]+)"/ ) { $port = $1; if ($msg =~ /-nick="([^"]+)"/ ) { $nick = $1; if ($msg =~ /-password="([^"]+)"/ ) { $password = $1; if ($msg =~ /-prefix="([^"]+)"/ ) { $prefix = $1; if ($msg =~ /-auto_connect="([^"]+)"/ ) { $auto_connect = $1; #" } else { return 0; } } else { return 0; } } else { return 0; } } else { return 0; } } else { return 0; } } else { return 0; } } else{ return 0; } foreach my $key1 (keys %hubs) { if ($key1 eq $alias) { return 1 } } $hubs{$alias}{address}=$address; $hubs{$alias}{port}=$port; $hubs{$alias}{nick}=$nick; $hubs{$alias}{password}=$password; $hubs{$alias}{prefix}=$prefix; $hubs{$alias}{auto_connect}=$auto_connect; return $alias; } sub modhub { my $msg= shift; my ($alias, $address, $port, $nick, $password, $prefix, $auto_conn +ect); my $ret = 0; if ($msg =~ /^([^\s]+)/ ) { $alias = $1; } else { return 0 } if ($msg =~ /-address="([^"]+)"/ ) { $hubs{$alias}{address} = $1; $ret = 1; } if ($msg =~ /-port="([^"]+)"/ ) { $hubs{$alias}{port} = $1; $ret = 1; } if ($msg =~ /-nick="([^"]+)"/ ) { $hubs{$alias}{address} = $1; $ret = 1; } if ($msg =~ /-password="([^"]+)"/ ) { $hubs{$alias}{password} = $1; $ret = 1; } if ($msg =~ /-prefix="([^"]+)"/ ) { $hubs{$alias}{prefix} = $1; $ret = 1; } if ($msg =~ /-auto_connect="([^"]+)"/ ) { $hubs{$alias}{auto_connect} = $1; $ret = 1; } return $ret; }

Replies are listed 'Best First'.
Re: Passing message between 2 sockets
by golux (Chaplain) on Apr 11, 2016 at 01:30 UTC
    Hi Light-Angel,

    Before I even try to figure out what your error is, I want to suggest you consider refactoring your code, at least in future programs.

    Edit: I see you're using POE modules, which I don't use, nor have installed. I'll take a few more minutes to see if I spot anything, but I'm afraid I won't be able to run this.

    For example, doing this:

    if (...) { if (...) { if (...) { if (...) { .... } else { return 0; } } else { return 0; } } else { return 0; } } else { return 0; }
    Is simply unreadable. And my example only goes to 4 levels; your code goes to 7!

    If you reverse the logic, and do the return 0 blocks first, it's a heck of a lot easier to read and maintain:

    ($msg =~ /^([^\s]+)/) or return 0; $alias = $1; ($msg =~ /-address="([^"]+)"/) or return 0; $address = $1; ($msg =~ /-port="([^"]+)"/) or return 0; $port = $1; ($msg =~ /-nick="([^"]+)"/) or return 0; $nick = $1; ($msg =~ /-password="([^"]+)"/) or return 0; $password = $1; ($msg =~ /-prefix="([^"]+)"/) or return 0; $prefix = $1; ($msg =~ /-auto_connect="([^"]+)"/) or return 0; $auto_connect = $1;

    You could even take it a step further, and make it data-driven. It's not as short as the first rewrite, but it has the advantage of grouping functionality together, so you can see what's being matched all in one section, and what's being assigned to in another section:

    # Regular expressions to apply my $a_regexes = [ qr/^([^\s]+)/, qr/-address="([^"]+)"/, qr/-port="([^"]+)"/, qr/-nick="([^"]+)"/, qr/-password="([^"]+)"/, qr/-prefix="([^"]+)"/, qr/-auto_connect="([^"]+)"/, ]; # Construct an array of resulting regex captures my @results = ( ); # Save each pattern (returning if missing from regex) foreach my $regex (@$a_regexes) { if ($msg !~ /$regex/) { return 0; } push @results, $1; } # Assign to the desired variables my ($alias, $address, $port, $nick, $password, $prefix, $auto_connect) = @results;

    Update 2:

    Here's an even terser suggestion for capturing the tokens, since (other than the first regex) they all have the same essential format. Define the list of tokens to capture, and build each regex from that:

    # Define the tokens we wish to extract my @tokens = qw( address port nick password prefix auto_connect ); # First token is a special case my $alias = ($msg =~ /^(\S+)\s*/)? $1: ""; $alias or return 0; # Construct an array of resulting regex captures my @results = ( ); # Construct the regex from each token, and capture the value foreach my $token (@tokens) { ($msg =~ /-${token}="([^"]+)"/ or return 0; push @results, $1; } # Assign to the desired variables my ($address, $port, $nick, $password, $prefix, $auto_connect) = @r +esults;
    say  substr+lc crypt(qw $i3 SI$),4,5
Re: Passing message between 2 sockets
by Anonymous Monk on Apr 10, 2016 at 21:49 UTC

    will post all thew code with to two sockets the code conects to the 2 servicesi will mark the code with =========== IRC NEW code ====================== and that is the code what i want outputted to the hub code and the hub code to be sent back to the IRC i just hope someone can help

    ?Where did you get "ASG-Bot - ASG-Bot Multi-Chat Client" I can't find it on the internet?

Re: Passing message between 2 sockets
by Anonymous Monk on Apr 10, 2016 at 21:09 UTC
    too much code

      too much code

      too much lazy

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others imbibing at the Monastery: (3)
As of 2024-04-20 04:27 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found