view release on metacpan or  search on metacpan

lib/Protocol/IRC/Message.pm  view on Meta::CPAN

#
#  (C) Paul Evans, 2008-2016 -- leonerd@leonerd.org.uk

package Protocol::IRC::Message 0.13;

use v5.14;
use warnings;

use Carp;
our @CARP_NOT = qw( Net::Async::IRC );

=head1 NAME

C<Protocol::IRC::Message> - encapsulates a single IRC message

=head1 SYNOPSIS

 use Protocol::IRC::Message;

 my $hello = Protocol::IRC::Message->new(
    "PRIVMSG",
    undef,
    "World",
    "Hello, world!"
 );

 printf "The command is %s and the final argument is %s\n",
    $hello->command, $hello->arg( -1 );

=head1 DESCRIPTION

An object in this class represents a single IRC message, either received from
or to be sent to the server. These objects are immutable once constructed, but
provide a variety of methods to access the contained information.

This class also understands IRCv3 message tags.

=cut

=head1 CONSTRUCTOR

=cut

=head2 new_from_line

   $message = Protocol::IRC::Message->new_from_line( $line )

Returns a new C<Protocol::IRC::Message> object, constructed by parsing the
given IRC line. Most typically used to create a new object to represent a
message received from the server.

=cut

sub new_from_line
{
   my $class = shift;
   my ( $line ) = @_;

   my %tags;
   if( $line =~ s/^\@([^ ]+) +// ) {
      foreach ( split m/;/, $1 ) {
         if( m/^([^=]+)=(.*)$/ ) {
            $tags{$1} = $2;
         }
         else {
            $tags{$_} = undef;
         }
      }
   }

   my $prefix;
   if( $line =~ s/^:([^ ]+) +// ) {
      $prefix = $1;
   }

   my ( $mid, $final ) = split( m/ +:/, $line, 2 );
   my @args = split( m/ +/, $mid );

   push @args, $final if defined $final;

   my $command = shift @args;

   return $class->new_with_tags( $command, \%tags, $prefix, @args );
}

=head2 new

   $message = Protocol::IRC::Message->new( $command, $prefix, @args )

Returns a new C<Protocol::IRC::Message> object, intialised from the given
components. Most typically used to create a new object to send to the server
using C<stream_to_line>. The message will contain no IRCv3 tags.

=cut

sub new
{
   my $class = shift;
   return $class->new_with_tags( $_[0], {}, $_[1], @_[2..$#_] );
}

=head2 new_from_named_args

   $message = Protocol::IRC::Message->new_from_named_args( $command, %args )

Returns a new C<Protocol::IRC::Message> object, initialised from the given
named arguments. The argument names must match those required by the given
command.

=cut

sub new_from_named_args
{
   my $class = shift;
   my ( $command, %args ) = @_;

   my $argnames = $class->arg_names( $command );

   my @args;

   foreach my $name ( keys %$argnames ) {

lib/Protocol/IRC/Message.pm  view on Meta::CPAN

      $named_args{$name} = $value;
   }

   return \%named_args;
}

=head2 gate_disposition

   $disp = $message->gate_disposition

Returns the "gating disposition" of the message. This defines how a reply
message from the server combines with other messages in response of a command
sent by the client. The disposition is either C<undef>, or a string consisting
of a type symbol and a gate name. If defined, the symbol defines what effect
it has on the gate name.

=over 4

=item -GATE

Adds more information to the response for that gate, but doesn't yet complete
it.

=item +GATE

Completes the gate with a successful result.

=item *GATE

Completes the gate with a successful result, but only if the nick in the
message prefix relates to the connection it is received on.

=item !GATE

Completes the gate with a failure result.

=back

=cut

my %GATE_DISPOSITIONS;

sub gate_disposition
{
   my $self = shift;
   return $GATE_DISPOSITIONS{ $self->command };
}

=head1 AUTHOR

Paul Evans <leonerd@leonerd.org.uk>

=cut

local $_;
while( <DATA> ) {
   chomp;
   m/^\s*#/ and next; # ignore comments

   my ( $cmdname, $args, $gating ) = split m/\s*\|\s*/, $_ or next;
   my ( $cmd, $name ) = split m/=/, $cmdname;

   my $index = 0;
   my %args = map {
      if( m/^(.*)=(.*)$/ ) {
         $index = $1;
         ( $2 => $1 )
      }
      else {
         ( $_ => ++$index );
      }
   } split m/,/, $args;

   $NUMERIC_NAMES{$cmd} = $name;
   $ARG_NAMES{$cmd} = \%args;
   $GATE_DISPOSITIONS{$cmd} = $gating if defined $gating;
}
close DATA;

0x55AA;

# And now the actual numeric definitions, given in columns
# number=NAME | argname,argname,argname

# arg may be position=argname

# See also
#   http://www.alien.net.au/irc/irc2numerics.html

__DATA__
JOIN | 0=target_name | *join

001=RPL_WELCOME         | text
002=RPL_YOURHOST        | text
003=RPL_CREATED         | text
004=RPL_MYINFO          | serverhost,serverversion,usermodes,channelmodes
005=RPL_ISUPPORT        | 1..-2=isupport,-1=text

250=RPL_STATSCONN       | text
251=RPL_LUSERCLIENT     | text
252=RPL_LUSEROP         | count,text
253=RPL_LUSERUNKNOWN    | count,text
254=RPL_LUSERCHANNELS   | count,text
255=RPL_LUSERME         | text
265=RPL_LOCALUSERS      | count,max_count,text
266=RPL_GLOBALUSERS     | count,max_count,text

301=RPL_AWAY            | target_name,text
305=RPL_UNAWAY          | text
306=RPL_NOWAWAY         | text

307=RPL_USERIP          | target_name
311=RPL_WHOISUSER       | target_name,ident,host,flags,realname | -whois
312=RPL_WHOISSERVER     | target_name,server,serverinfo         | -whois
313=RPL_WHOISOPERATOR   | target_name,text                      | -whois
315=RPL_ENDOFWHO        | target_name                           | +who
314=RPL_WHOWASUSER      | target_name,ident,host,flags,realname
317=RPL_WHOISIDLE       | target_name,idle_time                 | -whois
318=RPL_ENDOFWHOIS      | target_name                           | +whois
319=RPL_WHOISCHANNELS   | target_name,2@=channels               | -whois
320=RPL_WHOISSPECIAL    | target_name                           | -whois
324=RPL_CHANNELMODEIS   | target_name,modechars,3..=modeargs
328=RPL_CHANNEL_URL     | target_name,text
329=RPL_CHANNELCREATED  | target_name,timestamp
330=RPL_WHOISACCOUNT    | target_name,whois_nick,login_name     | -whois

331=RPL_NOTOPIC         | target_name
332=RPL_TOPIC           | target_name,text
333=RPL_TOPICWHOTIME    | target_name,topic_nick,timestamp

341=RPL_INVITING        | target_name,channel_name
346=RPL_INVITELIST      | target_name,invite_mask