#!/usr/bin/perl

BEGIN { 
  local $_ = $0; 
  s#\\#/#g; # those ass backwards \'s annoy me
  m#.*/#; 
  push @INC, $& . "lib"; 
} 

$|++; 

use strict;
use warnings; 

use Carp qw(croak);
use Socket; 

use IRC::Sock; 
use IRC::Parser;

my $IRC = IRC::Sock->spawn(Host => 'irc.icq.com:6667');

my $Parser = IRC::Parser->new; 

print $IRC "NICK ubu\nUSER bob \"\" \"\" :unf\n"; 

while(<$IRC>) { 
  my($origin, $command, $target, $args, $text) = $Parser->break;
  my($nick, $host) = split /!/, $origin if defined $origin; 
  
  print $target . "; (" . $command . ")" . $text . "\n" if $text;   
  print $IRC "PONG :" . $text . "\n"   if($command eq 'PING') ;
 
  print $IRC "JOIN #bored\n" if $command eq '005';
  
  if (defined $nick) { 
    if ($nick eq 'stacey' && $text =~ /^die\s*(.*)/) { print $IRC "QUIT " . $1 . "\n"; }
	
  } 
}












package IRC::Parser; 

use strict; 
use warnings; 

# ok, the idea here.. 
# plugin always takes precedence, this way any protocol fixes for any ircd.. 
# can be easily added, defined.. 
# IRC does not need parsed twice, I really could give a fuck if someone thinks they 
# NEED TO in some special case.. so if they define a plugin, handle the line there!! simple enough.. 
# and I can't see any need in defining a protocol fix twice, so I'm not iterating through a list of them
# not that it'd be anymore difficult, just it'd be pointless to do so.


sub new { 
  my $class = shift;
  bless {
    origin => undef, 
    command => undef, 
    target => undef,
    args => undef, 
    text => undef, 
    raw => undef
  }, $class; 
} 

# ?origin? - command - ?target? - ?arguments? - ?text?
sub break { 
  my $self = shift;
  (local $_ = ($self->{raw} = shift || $_)) =~ s/[\r\n]$//g; 
  if(@{ $self }{qw(origin command target args text)} = $_ =~ /^
    (?:\x3a(\S+)\x20+)?
    (\d{3}|[A-Za-z]+)
    (?: 
      \x20+
      ((?!\x3a)\S+)
      \x20*		
      (
        (?:\x20*(?!\x3a)\S+)*
      )
    )?
    \x20*
    \x3a?
    (.*)
  $/x) { # gotta love that gibberish, IRC is a ludicrous protocol 
    my @broken = ($1, ($self->{command} = uc($2)), $3, $4, $5); 
    wantarray() ? @broken : \@broken;
  } else { warn "Failed to parse ($_); string does not conform to IRC protocol."; } 
} 

1;












package IRC::Sock; 

use strict; 
use warnings; 

BEGIN { 
  local $_ = $0; 
  s#\\#/#g; # those ass backwards \'s annoy me
  m#.*/#; 
  push @INC, $& . "lib"
} 


use Socket; 
use base 'IO::Handle'; 
use Carp qw(croak);

sub new { 
  @_ == 1 
     or croak 'usage: ' . __PACKAGE__ . '->new'; 
  my $Sock = (!ref $_[0] ? shift : ref shift)->SUPER::new;  
  $Sock->autoflush(1); 
  $Sock 
} 

#  IRC::Sock->spawn( 
#    Host => 'severed.org[:80]',
# ); 
sub spawn { 
  @_ >= 2 
    or croak 'usage: ' . __PACKAGE__ . '->connect(ADDRESS, PORT|SERVICE)'; 
  my $Class = shift; 
  my $Sock = $Class->new; 
  $Sock->connect(@_); 
  $Sock
} 

sub connect { 
 my($E, $Sock, %ar) = (undef, shift, @_); 
  my($proto, $host, $port) = $ar{Host} =~ m#^(?:(\w+)://)?((?!/).*\.[a-z]+)(?:[:/](\d+))?#i; 
  $port = getservbyname($proto, 'tcp') 
    if defined $proto && !defined $port; 
  socket($Sock, AF_INET, SOCK_STREAM, getprotobyname('tcp'))
    or croak "Cannot create socket! ($!)"; 
  my $iaddr = inet_aton($host)
    or croak "Cannot resolve host."; 
#	$Sock->blocking(1);
  connect($Sock, sockaddr_in($port || 6667, $iaddr)) || undef
}
1;