view release on metacpan or  search on metacpan

lib/AnyEvent/IRC/Client.pm  view on Meta::CPAN

   });

   $dcc->{connect} = tcp_connect $dcc->{ip}, $dcc->{port}, sub {
      my ($fh) = @_;
      return unless $dcc && $self;

      delete $dcc->{timeout};
      delete $dcc->{connect};

      unless ($fh) {
         $self->dcc_disconnect ($id, "CONNECT ERROR: $!");
         return;
      }

      $dcc->{handle} = AnyEvent::Handle->new (
         fh => $fh,
         on_eof => sub {
            delete $dcc->{handle};
            $self->dcc_disconnect ($id, "EOF");
         },
         on_error => sub {
            delete $dcc->{handle};
            $self->dcc_disconnect ($id, "ERROR: $!");
         }
      );

      $self->event (dcc_connected => $id, $dcc->{type}, $dcc->{handle});
   };

   $id
}

sub dcc_handle {
   my ($self, $id) = @_;

   if (my $dcc = $self->{dcc}->{$id}) {
      return $dcc->{handle}
   }
   return;
}

sub send_dcc_chat {
   my ($self, $id, $msg) = @_;

   if (my $dcc = $self->{dcc}->{$id}) {
      if ($dcc->{handle}) {
         $dcc->{handle}->push_write ("$msg\015\012");
      }
   }
}

################################################################################
# Private utility functions
################################################################################

sub _was_me {
   my ($self, $msg) = @_;
   $self->lower_case (prefix_nick ($msg)) eq $self->lower_case ($self->nick ())
}

sub update_ident {
   my ($self, $ident) = @_;
   my ($n, $u, $h) = split_prefix ($ident);
   my $old = $self->{idents}->{$self->lower_case ($n)};
   $self->{idents}->{$self->lower_case ($n)} = $ident;
   if ($old ne $ident) {
      $self->event (ident_change => $n, $ident);
   }
   #d# warn "IDENTS:\n".(join "\n", map { "\t$_\t=>\t$self->{idents}->{$_}" } keys %{$self->{idents}})."\n";
}

################################################################################
# Channel utility functions
################################################################################

sub channel_remove {
   my ($self, $msg, $chan, $nicks) = @_;

   for my $nick (@$nicks) {
      if ($self->lower_case ($nick) eq $self->lower_case ($self->nick ())) {
         delete $self->{chan_queue}->{$self->lower_case ($chan)};
         delete $self->{channel_list}->{$self->lower_case ($chan)};
         last;
      } else {
         delete $self->{channel_list}->{$self->lower_case ($chan)}->{$nick};
      }
   }
}

sub channel_add {
   my ($self, $msg, $chan, $nicks, $modes) = @_;

   my @mods = @$modes;

   for my $nick (@$nicks) {
      my $mode = shift @mods;

      if ($self->is_my_nick ($nick)) {
         for (@{$self->{chan_queue}->{$self->lower_case ($chan)}}) {
            $self->send_msg (@$_);
         }

         $self->clear_chan_queue ($chan);
      }

      my $ch = $self->{channel_list}->{$self->lower_case ($chan)} ||= { };

      if (defined $mode) {
         $ch->{$nick} = $mode;
         $self->event (channel_nickmode_update => $chan, $nick);
      } else {
         $ch->{$nick} = { } unless defined $ch->{$nick};
      }
   }
}

sub channel_mode_change {
   my ($self, $chan, $op, $mode, $nick) = @_;

   my $nickmode = $self->nick_modes ($chan, $nick);
   defined $nickmode or return;

lib/AnyEvent/IRC/Client.pm  view on Meta::CPAN

      delete $self->{away_status};
   } else { # away
      $self->{away_status} = 1;
   }

   $self->event (away_status_change => $self->{away_status});
}

sub debug_cb {
   my ($self, $msg) = @_;
   $self->event (debug_recv => $msg);
}

sub change_nick_login_cb {
   my ($self, $msg) = @_;

   if ($self->registered) {
      delete $self->{change_nick_cb_guard};

   } else {
      my $newnick = $self->{nick_change}->($self->nick);

      if ($self->lower_case ($newnick) eq $self->lower_case ($self->{nick})) {
         $self->disconnect ("couldn't change nick to non-conflicting one");
         return 0;
      }

      $self->{nick} = $newnick;
      $self->send_msg ("NICK", $newnick);
   }
}

sub disconnect_cb {
   my ($self) = @_;

   for (keys %{$self->{channel_list}}) {
      $self->channel_remove (undef, $_, [$self->nick]);
      $self->event (channel_remove => undef, $_, $self->nick)
   }

   $self->cleanup;
}

sub rpl_topic_cb {
   my ($self, $msg) = @_;
   my $chan  = $msg->{params}->[1];
   my $topic = $msg->{params}->[-1];

   $self->event (channel_topic => $chan, $topic);
}

sub topic_change_cb {
   my ($self, $msg) = @_;
   my $who   = prefix_nick ($msg);
   my $chan  = $msg->{params}->[0];
   my $topic = $msg->{params}->[-1];

   $self->event (channel_topic => $chan, $topic, $who);
}

sub update_ident_cb {
   my ($self, $msg) = @_;

   if (is_nick_prefix ($msg->{prefix})) {
      $self->update_ident ($msg->{prefix});
   }
}

sub update_ident_nick_change_cb {
   my ($self, $old, $new) = @_;

   my $oldid = $self->nick_ident ($old);
   return unless defined $oldid;

   my ($n, $u, $h) = split_prefix ($oldid);

   $self->update_ident (join_prefix ($new, $u, $h));
}

sub ctcp_auto_reply_cb {
   my ($self, $src, $targ, $tag, $msg, $type) = @_;

   return if $type ne 'PRIVMSG';

   my $ctcprepl = $self->{ctcp_auto_replies}->{$tag}
      or return;

   if (ref ($ctcprepl->[0]) eq 'CODE') {
      $ctcprepl = [$ctcprepl->[0]->($self, $src, $targ, $tag, $msg, $type)]
   }

   $self->send_msg (NOTICE => $src, encode_ctcp (@$ctcprepl));
}

=back

=head1 EXAMPLES

See samples/anyeventirccl and other samples in samples/ for some examples on how to use AnyEvent::IRC::Client.

=head1 AUTHOR

Robin Redeker, C<< <elmex@ta-sa.org> >>

=head1 SEE ALSO

L<AnyEvent::IRC::Connection>

RFC 1459 - Internet Relay Chat: Client Protocol

=head1 COPYRIGHT & LICENSE

Copyright 2006-2009 Robin Redeker, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1;