1:- module(irc_client_parser, [
    2	parse_line/2,
    3	prefix_id/2,
    4	prefix_id/4
    5]).

Parsing messages

This module takes a message line relayed from an IRC server and parses it into a compound term that acts as an acceptable message type for the messages themselves. This is useful for manipulating, processing and acting on events in an IRC session.

Source : http://www.networksorcery.com/enp/protocol/irc.htm

Alternative Source : http://irchelp.org/irchelp/rfc/

CTCP : http://irchelp.org/irchelp/rfc/ctcpspec.html

Message syntax:

message = [ ":" prefix SPACE ] command [ params ] crlf

prefix = servername / ( nickname [ [ "!" user ] "@" host ])

command = 1*letter / 3digit

params = *14( SPACE middle ) [ SPACE ":" trailing ] =/ 14( SPACE middle ) [ SPACE [ ":" ] trailing ]

// Any byte except NUL, CR, LF, " " and ":".

nospcrlfcl = %x01-09 / %x0B-0C / %x0E-1F / %x21-39 / %x3B-FF

middle = nospcrlfcl *( ":" / nospcrlfcl )

trailing = *( ":" / " " / nospcrlfcl )

SPACE = %x20 ; Whitespace.

crlf = %x0D %x0A ; Carriage return/linefeed.

*/

   46parse_line(Line, Msg) :-
   47	split_from_trailer(Line, Out),
   48	once(fmt_line(Out, Msg)).
 prefix_id(+Prefix, -Servername) is semidet
Extract a servername from a msg prefix.
Arguments:
Prefix- A string (usually in message structure) that represents the prefix of the sender
Servername- The server name obtained from the sender's prefix
   59prefix_id(Prefix, Servername) :-
   60	split_string(Prefix, " ", "", [Servername|_]).
 prefix_id(+Prefix, -Nick, -User, -Host) is semidet
Extract the Nick, User, and Host portions of a prefix from a msg. All of these arguments are to take the form of a string type.
   68prefix_id(Prefix, Nick, User, Host) :-
   69	split_string(Prefix, "!", "", [Nick|[Rest]]),
   70	split_string(Rest, "@", "", [User|[Host]]).
   71
   72
   73%---------------------------------------------------------------------------------------------------%
   74
   75
   76%  Split a server message into (potentially) 3 parts. The message can be split
   77%  into a prefix, command, and some command parameters. However, the prefix
   78%  is optional and the parameter list can potentially be empty.
   79%
   80% Msg output is of the format:
   81%
   82% 1) msg(prefix, command, [parameters...], trailing_parameter).
   83%
   84% 2) msg(prefix, command, [parameters...]).
   85%
   86% 3) msg(command, [parameters...], trailing_parameter).
   87%
   88% 4) msg(command, [parameters...]).
   89
   90fmt_line([has_prefix, Main, Trailer], msg(Prefix, Cmd, Params, Trailer)) :-
   91	split_string(Main, " ", "", [Prefix,Cmd|Params]).
   92
   93fmt_line([has_prefix, Main], msg(Prefix, Cmd, Params)) :-
   94	split_string(Main, " ", "", [Prefix,Cmd|Params]).
   95
   96fmt_line([Main, Trailer], msg(Cmd, Params, Trailer)) :-
   97	split_string(Main, " ", "", [Cmd|Params]).
   98
   99fmt_line([Main], msg(Cmd, Params)) :-
  100	split_string(Main, " ", "", [Cmd|Params]).
  101
  102
  103%  Split the main portion of the message from the trailer portion of the message
  104%  if a trailer does exist. These are the possibilities when operating
  105%  under the current IRC protocol:
  106%
  107%  1) [has_prefix, Main, Trailer]
  108%  2) [has_prefix, Main]
  109%  3) [Main, Trailer]
  110%  4) [Main]
  111
  112split_from_trailer(Line, Out) :-
  113	(	split(First, Line, Trailer)
  114	->	(	First = [58|Main]
  115		-> 	Out = [has_prefix, Main, Trailer]
  116		;  	Main = First,
  117			Out = [Main, Trailer]
  118		)
  119	;	(	Line = [58|Main]
  120		->	Out = [has_prefix, Main]
  121		;	Main = Line,
  122			Out = [Main]
  123		)
  124	).
  125
  126
  127split([]) --> ` :`.
  128split([M|Main]) -->
  129	[M], split(Main)