view release on metacpan or  search on metacpan

Connection.pm  view on Meta::CPAN

                           # Perhaps we'll finally use it soon.
  
  $self->sl("ADMIN" . ($_[0] ? " $_[0]" : ""));
}

# Toggles away-ness with the server.  Optionally takes an away message.
sub away {
    my $self = shift;
    $self->sl("AWAY" . ($_[0] ? " :$_[0]" : ""));
}

# Attempts to connect to the specified IRC (server, port) with the specified
#   (nick, username, ircname). Will close current connection if already open.
sub connect {
  my $self = shift;
  my ($password, $sock);
  
  if (@_) {
    my (%arg) = @_;
    
    $self->hostname($arg{'LocalAddr'}) if exists $arg{'LocalAddr'};
    $password = $arg{'Password'} if exists $arg{'Password'};
    $self->nick($arg{'Nick'}) if exists $arg{'Nick'};
    $self->port($arg{'Port'}) if exists $arg{'Port'};
    $self->server($arg{'Server'}) if exists $arg{'Server'};
    $self->ircname($arg{'Ircname'}) if exists $arg{'Ircname'};
    $self->username($arg{'Username'}) if exists $arg{'Username'};
    $self->pacing($arg{'Pacing'}) if exists $arg{'Pacing'};
    $self->ssl($arg{'SSL'}) if exists $arg{'SSL'};
  }
  
  # Lots of error-checking claptrap first...
  unless ($self->server) {
    unless ($ENV{IRCSERVER}) {
      croak "No server address specified in connect()";
    }
    $self->server( $ENV{IRCSERVER} );
  }
  unless ($self->nick) {
    $self->nick($ENV{IRCNICK} || eval { scalar getpwuid($>) }
                || $ENV{USER} || $ENV{LOGNAME} || "WankerBot");
  }
  unless ($self->port) {
    $self->port($ENV{IRCPORT} || 6667);
  }
  unless ($self->ircname)  {
    $self->ircname($ENV{IRCNAME} || eval { (getpwuid($>))[6] }
                   || "Just Another Perl Hacker");
  }
  unless ($self->username) {
    $self->username(eval { scalar getpwuid($>) } || $ENV{USER}
                    || $ENV{LOGNAME} || "japh");
  }
  
  # Now for the socket stuff...
  if ($self->connected) {
    $self->quit("Changing servers");
  }
  
  if($self->ssl) {
    require IO::Socket::SSL;
    
    $self->socket(IO::Socket::SSL->new(PeerAddr  => $self->server,
                                       PeerPort  => $self->port,
                                       Proto     => "tcp",
                                       LocalAddr => $self->hostname,
                                       ));
  } else {
    
    $self->socket(IO::Socket::INET->new(PeerAddr  => $self->server,
                                        PeerPort  => $self->port,
                                        Proto     => "tcp",
                                        LocalAddr => $self->hostname,
                                        ));
  }
  
  if(!$self->socket) {
    carp (sprintf "Can't connect to %s:%s!",
          $self->server, $self->port);
    $self->error(1);
    return;
  }
  
  # Send a PASS command if they specified a password. According to
  # the RFC, we should do this as soon as we connect.
  if (defined $password) {
    $self->sl("PASS $password");
  }
  
  # Now, log in to the server...
  unless ($self->sl('NICK ' . $self->nick()) and
          $self->sl(sprintf("USER %s %s %s :%s",
                            $self->username(),
                            "foo.bar.com",
                            $self->server(),
                            $self->ircname()))) {
    carp "Couldn't send introduction to server: $!";
    $self->error(1);
    $! = "Couldn't send NICK/USER introduction to " . $self->server;
    return;
  }
  
  $self->{_connected} = 1;
  $self->parent->addconn($self);
}

# Returns a boolean value based on the state of the object's socket.
sub connected {
  my $self = shift;
  
  return ( $self->{_connected} and $self->socket() );
}

# Sends a CTCP request to some hapless victim(s).
# Takes at least two args:  the type of CTCP request (case insensitive)
#                           the nick or channel of the intended recipient(s)
# Any further args are arguments to CLIENTINFO, ERRMSG, or ACTION.
sub ctcp {
  my ($self, $type, $target) = splice @_, 0, 3;
  $type = uc $type;
  
  unless ($target) {
    croak "Not enough arguments to ctcp()";