Untitled

#!/usr/bin/perl
use strict;use warnings;use IO::Socket;sub fail($$){my$what=shift;
my$why=shift;return"[$0] $what: $why\n";}sub timestamp($){my$mode=
shift;my($seconds,$minutes,$hours,$day,$month,$year)=localtime(time
);$year+=1900;my%modes=('time'=>sub{return sprintf("[%02d:%02d:%02d
] ",$hours,$minutes,$seconds)},'date'=>sub{return sprintf("[%04d.%0
2d.%02d] ",$year,$month,$day)},'all'=>sub{return sprintf("[%02d.%02
d.%04d %02d:%02d:%02d] ",$day,$month,$year,$hours,$minutes,$seconds
)});$modes{$mode}->()if(defined$modes{$mode});}sub readrc($){my
$rcpath=shift;my%settings=();open my$rc,"<$rcpath"or die fail$rcpath,
$!;foreach(<$rc>){$settings{$1}=$2 if(m/^\s*?(\w+?)\s*?=\s*?\"([^"]
*?)\"(?:\s|#|$)/);}close$rc;return%settings;}sub init(\%){my$rcref=
shift;my%rc=%$rcref;my$server=IO::Socket::INET->new(PeerAddr=>$rc{'
host'},PeerPort=>$rc{'port'},proto=>getprotobyname('tcp'))or die
fail"unable to connect to $rc{'host'}:$rc{'port'}",$!;print$server
"NICK $rc{'nickname'}\n";print$server "USER $rc{'uname'} * * :$rc{'
ident'}\n";print$server "NOTICE $rc{'owner'} online ($rc{'nickname'
} at $rc{'host'}:$rc{'port'})\n";while(<$server>){parse($server,$_,
\%rc);}close$server if$server;}sub parse($$\%){my$socket=shift;my
$incoming=shift;my$rcref=shift;my%rc=%$rcref;$incoming=~s/([\x00-
\x1f])//g;if($incoming=~m/^\:?([^:]+?)\:(.*?)(?:\s?$)/){my($header,
$message)=($1,$2||"null");print timestamp('time')."DEBUG: |$header|
$message|\n";my%patterns=('^ping'=>sub{sendpong($socket,$rc{'host'}
)},'privmsg'=>sub{handlemessage$socket,$header,$message,\%rc});
foreach my$key(keys%patterns){$patterns{$key}->()if($header=~qr/
$key/i);}}}sub sendpong($$){my$socket=shift;my$host=shift;print"[
$host] ping? ";print$socket "pong $host\n";print"pong!\n";}sub
handlemessage($$$\%){my$socket=shift;my$header=shift;my$message=
shift;my$rcref=shift;my%rc=%$rcref;if($header=~m/^([^!]+?)!([^@]+?)
@([^\s]+?)\sPRIVMSG\s([^\s]+?)\b/i){my($from,$ident,$host,$to)=($1,
$2,$3,$4);if($message=~m/^\.(\w+?)(\s+?|$)(.*?)$/i){my$cmd=$1;my
$arg=$2||"DEBUG: null";print"DEBUG: |$cmd|$arg|\n";}}}sub
handlecommand($$){my$cmd=shift;my$arg=shift;}1;