Advertisement
swarley

IRC.pm

Aug 30th, 2011
172
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Perl 3.00 KB | None | 0 0
  1. use warnings;
  2. use strict;
  3. use conf;
  4. use extras;
  5. use IO::Socket;
  6. use feature 'switch';
  7. package IRC;
  8.  
  9. sub new {
  10.     my $class  = shift;                                                    
  11.     my $config = conf->new(shift);                                        
  12.     my %s_conf = $config->allocate('server');                              
  13.     my %u_conf = $config->allocate('user');                              
  14.     my %o_conf = $config->allocate('owner');                              
  15.     my $conf   = {server => \%s_conf, owner => \%o_conf, user =>\%u_conf};
  16.     my $socket = IO::Socket::INET->new(
  17.                       PeerAddr => $s_conf{network},      
  18.                       PeerPort => $s_conf{port},           
  19.                       Proto    => 'tcp')
  20.     or die "Can't connect to $s_conf{network}:$s_conf{port}\n :$!";      
  21.     my %hash = (
  22.             Socket   => $socket,                       
  23.             Config   => $conf,                 
  24.             numeric  => sub {},                      
  25.             privmsg  => sub {},                
  26.             notice   => sub {},                      
  27.             chan_msg => sub {});                                      
  28.     bless \%hash, $class;                                  
  29.    
  30. }
  31.  
  32. sub init {
  33.     my $self = shift;
  34.     $self->register('notice', sub { });
  35.     $self->register('privmsg', sub { });
  36.     $self->register('chan_msg', sub { });
  37.     $self->register('numeric', sub { });
  38. }
  39.  
  40. sub send_raw {
  41.     my $self = shift;
  42.     my $data = shift;
  43.     $self->{Socket}->send($data."\n");
  44.     puts(">> $data");
  45. }
  46.  
  47. sub puts($) {
  48.     my $text = shift;
  49.     print "$text\n";
  50. }
  51.  
  52. sub connect {
  53.     my $self = shift;
  54.     my $user_conf = $self->{Config}->{user};
  55.     $self->send_raw("USER $$user_conf{user} 0 0 :$$user_conf{real}");
  56.     $self->send_raw("NICK $$user_conf{nick1}");
  57. }
  58.  
  59. sub register {
  60.     my $self = shift;
  61.     my ($command, $ref) = @_;
  62.     $self->{lc $command} = $ref;
  63. }
  64.  
  65. sub breakdown {
  66.     my ($type,$data) = @_;
  67.     $data =~ s/.//;
  68.     given($type) {
  69.         when('privmsg') {
  70.             return {
  71.                 nick => (split /\!/, $data)[0],
  72.                 user => (split /\@/, (split /\!/, $data)[1])[1],
  73.                 host => (split /\s/, (split /\@/, $data)[1])[0],
  74.                 msg  => (split /\:/, $data, 2)[1]};
  75.         }
  76.         when('chan_msg') {
  77.                 nick => (split /\!/, $data)[0],
  78.                 user => (split /\@/, (split /\!/, $data)[1])[1],
  79.                 host => (split /\s/, (split /\@/, $data)[1])[0],
  80.                 chan => (split /\s/ $data)[2],
  81.                 msg  => (split /\:/, $data, 2)[1]};
  82.     }
  83. }
  84.  
  85. sub main {
  86.     my $self   = shift;
  87.     my $socket = $self->{Socket};
  88.     while (my $data = <$socket>) {
  89.         print "<< $data";
  90.         my $type  = (split /\s+/, $data)[1];
  91.         given ($type) {
  92.             when(/\d\d\d/) {
  93.                 $self->{numeric}->($type, $data);
  94.             }
  95.             when(/PRIVMSG/i) {
  96.                 if ($split[2] =~ m/^\#/) {
  97.  
  98.                     $self->{last_message} = breakdown('chan_msg', $data); #make sure it returns a hash reference
  99.                     $self->{chan_msg}->($data);
  100.                 }
  101.                 else {
  102.                     $self->{last_message} = breadown('privmsg', $data);
  103.                     $self->{privmsg}->($data);
  104.                 }
  105.             }
  106.             when(/NOTICE/i) {
  107.                 $self->{notice}->($data);
  108.             }
  109.         }
  110.         if ($data =~ m/^PING/i) {
  111.             my $pong = split(':',$data,2)[1];
  112.             $self->send_raw("PONG :$pong");
  113.         }      
  114.     }
  115. }
  116. 1;
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement