view release on metacpan or  search on metacpan

lib/Circle/Net/IRC/Target.pm  view on Meta::CPAN

}

sub on_disconnected
{
   my $self = shift;
   my ( $message ) = @_;

   $self->push_displayevent( "status", { text => $message } );
}

sub _split_text_chunks
{
   my ( $text, $maxlen, $on_chunk ) = @_;

   my $head = "<< ";
   my $tail = " >>";

   while( length $text ) {
      if( $maxlen >= length $text ) {
         $on_chunk->( $text );
         return;
      }

      my $prefix = substr $text, 0, $maxlen - length( $tail );
      if( $prefix =~ m/\s+\S+$/ ) {
         substr( $prefix, $-[0] ) = "";
      }

      $on_chunk->( $prefix . $tail );

      substr( $text, 0, length $prefix ) = "";
      $text =~ s/^\s+//;
      substr( $text, 0, 0 ) = $head;
   }
}

sub msg
{
   my $self = shift;
   my ( $text, %hints ) = @_;

   my $irc = $self->{irc};
   my $net = $self->{net};

   my $event = {
      text      => Circle::TaggedString->new( $text ),
      is_action => $hints{action}, 
   };

   $net->run_rulechain( "output", $event );

   my $is_action = $event->{is_action};

   my $maxlen = 510 -
      # To work out the maximum message length size we'd need to know our own
      # prefix that the server will send. We can't know the host, but we know
      # everything else. Just pretend it's maximal length, 64
      ( length( $irc->{nick} ) + length( $irc->{user} ) + 64 + PREFIX_OVERHEAD );
   my $target = $self->name;

   foreach my $line ( split m/\n/, $event->{text}->str ) {
      if( $is_action ) {
         _split_text_chunks( $line, $maxlen - length($target) - CTCP_ACTION_OVERHEAD, sub {
            $irc->send_ctcp( undef, $target, "ACTION", $_[0] );
         });
      }
      else {
         _split_text_chunks( $line, $maxlen - length($target) - PRIVMSG_OVERHEAD, sub {
            $irc->send_message( "PRIVMSG", undef, $target, $_[0] );
         });
      }

      my $line_formatted = $net->format_text( $line );

      $self->fire_event( $is_action ? "act" : "msg", $irc->nick, $line );
      $self->push_displayevent( $is_action ? "irc.act" : "irc.msg", { target => $self->name, nick => $irc->nick, text => $line_formatted } );
   }
}

sub method_msg
{
   my $self = shift; my $ctx = shift;
   $self->msg( $_[0], action => 0 );
}

sub notice
{
   my $self = shift;
   my ( $text ) = @_;

   my $irc = $self->{irc};
   $irc->send_message( "NOTICE", undef, $self->name, $text );

   my $net = $self->{net};
   my $text_formatted = $net->format_text( $text );

   $self->fire_event( "notice", $irc->nick, $text );
   $self->push_displayevent( "irc.notice", { target => $self->name, nick => $irc->nick, text => $text_formatted } );
}

sub method_notice
{
   my $self = shift; my $ctx = shift;
   $self->notice( @_ );
}

sub method_act
{
   my $self = shift; my $ctx = shift;
   $self->msg( $_[0], action => 1 );
}

sub command_say
   : Command_description("Quote text directly as a PRIVMSG")
   : Command_arg('text', eatall => 1)
{
   my $self = shift;
   my ( $text ) = @_;

   $self->msg( $text, action => 0 );