From 121731baf33064577dfea15976489cf64ef5fb8e Mon Sep 17 00:00:00 2001 From: Patrick Spek Date: Mon, 19 Apr 2021 22:13:35 +0200 Subject: Initial commit --- .editorconfig | 16 + .gitignore | 14 + .gitlab-ci.yml | 23 + .travis.yml | 13 + CHANGELOG.md | 9 + META6.json | 23 + README.pod6 | 23 + lib/IRC/Grammar.pm6 | 51 +++ t/rfc1459.t | 0 t/rfc2812.t | 1269 +++++++++++++++++++++++++++++++++++++++++++++++++++ 10 files changed, 1441 insertions(+) create mode 100644 .editorconfig create mode 100644 .gitignore create mode 100644 .gitlab-ci.yml create mode 100644 .travis.yml create mode 100644 CHANGELOG.md create mode 100644 META6.json create mode 100644 README.pod6 create mode 100644 lib/IRC/Grammar.pm6 create mode 100644 t/rfc1459.t create mode 100644 t/rfc2812.t diff --git a/.editorconfig b/.editorconfig new file mode 100644 index 0000000..74dde7f --- /dev/null +++ b/.editorconfig @@ -0,0 +1,16 @@ +[*] +charset = utf-8 +end_of_line = lf +insert_final_newline = true +indent_style = tab +indent_size = 4 + +[*.json] +indent_style = space +indent_size = 2 + +[*.yml] +indent_style = space +indent_size = 2 + +# vim: ft=dosini diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..93356c2 --- /dev/null +++ b/.gitignore @@ -0,0 +1,14 @@ +## Perl 6 precompilation files ## +.precomp + +## Editor files ## + +# emacs +*~ + +# vim +.*.sw? + +# comma +.idea +*.iml diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml new file mode 100644 index 0000000..264169a --- /dev/null +++ b/.gitlab-ci.yml @@ -0,0 +1,23 @@ +IRC::Grammar: + only: + - master + image: rakudo-star + before_script: + - zef install . --deps-only --test-depends --/test + script: AUTHOR_TESTING=1 prove -v -e "perl6 -Ilib" t + artifacts: + name: "IRC-Grammar" + paths: + - META6.json + - bin + - lib + - resources + - t + +test: + except: + - master + image: rakudo-star + before_script: + - zef install . --deps-only --test-depends --/test + script: AUTHOR_TESTING=1 prove -v -e "perl6 -Ilib" t diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..077ddb0 --- /dev/null +++ b/.travis.yml @@ -0,0 +1,13 @@ +language: perl6 + +perl6: + - latest + +os: + - linux + +install: + - rakudobrew build zef + - zef install --deps-only . + +script: AUTHOR_TESTING=1 prove -v -e "perl6 -Ilib" t/ diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000..1003abb --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,9 @@ +# Changelog +All notable changes to this project will be documented in this file. + +The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/) +and this project adheres to [Semantic +Versioning](http://semver.org/spec/v2.0.0.html). + +## [UNRELEASED] +- Initial release diff --git a/META6.json b/META6.json new file mode 100644 index 0000000..e29a0e6 --- /dev/null +++ b/META6.json @@ -0,0 +1,23 @@ +{ + "api": "0", + "auth": "cpan:TYIL", + "authors": [ + "Patrick Spek <~tyil/raku-devel@lists.sr.ht>" + ], + "depends": [ + ], + "description": "Nondescript", + "license": "AGPL-3.0", + "meta-version": 0, + "name": "IRC::Grammar", + "perl": "6.d", + "provides": { + "IRC::Grammar": "lib/IRC/Grammar.pm6" + }, + "resources": [ + ], + "source-url": "", + "tags": [ + ], + "version": "0.0.0" +} \ No newline at end of file diff --git a/README.pod6 b/README.pod6 new file mode 100644 index 0000000..902a960 --- /dev/null +++ b/README.pod6 @@ -0,0 +1,23 @@ +=begin pod + +=NAME IRC::Grammar +=AUTHOR Patrick Spek <~tyil/raku-devel@lists.sr.ht> +=VERSION 0.0.0 + +=head1 Description + +Nondescript + +=head1 Installation + +Install this module through L: + +=begin code :lang +zef install IRC::Grammar +=end code + +=head1 License + +This module is distributed under the terms of the AGPL-3.0. + +=end pod diff --git a/lib/IRC/Grammar.pm6 b/lib/IRC/Grammar.pm6 new file mode 100644 index 0000000..f859edc --- /dev/null +++ b/lib/IRC/Grammar.pm6 @@ -0,0 +1,51 @@ +#! /usr/bin/env false + +use v6.d; + +unit grammar IRC::Grammar; + +regex TOP { + [ ':' <.ws> ]? + + <.ws> + * % <.ws> + + # Use an OPTIONAL crlf, as opposed to RFC 2812's required crlf, to make + # it easier for people to use this in regular programs, where they're + # more likely to encounter the IRC messages without \r\n. + "\r\n"? +} + +token prefix { [ [ '!' ]? '@' ]? | } +token command { \d ** 3 | \w+ } +token middle { <.nospcrlfcl>+ } +token params { <.middle> | [ ':' <( )> ] } +token trailing { <-[ \0 \r \n ]>* } +token nickname { [ \w | ] [ \w | \d | | '-' ]* } +token special { <[ [ \] \\ ` _ ^ { | } ]>+ } +token user { <-[ \r \n \s @ ]>+ } +token host { | } +token hostname { [ '.' ]* '.'? } +token hostaddr { | } +token ip4addr { [ \d ** 1..3 ] ** 4 % '.' } +token ip6addr { [ <[ \d a..f A..F ]> ** 1..4 ] ** 8 % ':' } +token shortname { <[ \w \d / ]> <[ \w \d / \- ]>* <[ \w \d / ]>? } +token nospcrlfcl { <-[ \0 \r \n \s : ]> } + +=begin pod + +=NAME IRC::Grammar +=AUTHOR Patrick Spek <~tyil/raku-devel@lists.sr.ht> +=VERSION 0.0.0 + +=head1 Synopsis + +=head1 Description + +=head1 Examples + +=head1 See also + +=end pod + +# vim: ft=perl6 noet diff --git a/t/rfc1459.t b/t/rfc1459.t new file mode 100644 index 0000000..e69de29 diff --git a/t/rfc2812.t b/t/rfc2812.t new file mode 100644 index 0000000..ead5565 --- /dev/null +++ b/t/rfc2812.t @@ -0,0 +1,1269 @@ +#!/usr/bin/env raku + +use Test; + +use IRC::Grammar; + +plan 2; + +subtest '3. Message Details', { + plan 7; + + subtest '3.1 Connection Registration', { + plan 8; + + subtest '3.1.1 Password message', { + plan 1; + + subtest 'PASS secretpasswordhere', { + plan 3; + + my $match = IRC::Grammar.parse('PASS secretpasswordhere'); + + ok $match; + is $match, 'PASS'; + is $match[0], 'secretpasswordhere'; + } + } + + subtest '3.1.2 Nick message', { + plan 2; + + subtest 'NICK Wiz', { + plan 3; + + my $match = IRC::Grammar.parse('NICK Wiz'); + + ok $match; + is $match, 'NICK'; + is $match[0], 'Wiz'; + } + + subtest ':WiZ!jto@tolsun.oulu.fi NICK Kilroy', { + plan 4; + + my $match = IRC::Grammar.parse(':WiZ!jto@tolsun.oulu.fi NICK Kilroy'); + + ok $match; + is $match, 'WiZ!jto@tolsun.oulu.fi'; + is $match, 'NICK'; + is $match[0], 'Kilroy'; + } + } + + subtest '3.1.3 User message', { + plan 2; + + subtest 'USER guest 0 * :Ronnie Reagan', { + plan 6; + + my $match = IRC::Grammar.parse('USER guest 0 * :Ronnie Reagan'); + + ok $match; + is $match, 'USER'; + is $match[0], 'guest'; + is $match[1], '0'; + is $match[2], '*'; + is $match[3], 'Ronnie Reagan'; + } + + subtest 'USER guest 8 * :Ronnie Reagan', { + plan 6; + + my $match = IRC::Grammar.parse('USER guest 8 * :Ronnie Reagan'); + + ok $match; + is $match, 'USER'; + is $match[0], 'guest'; + is $match[1], '8'; + is $match[2], '*'; + is $match[3], 'Ronnie Reagan'; + } + } + + subtest '3.1.4 Oper message', { + plan 1; + + subtest 'OPER foo bar', { + plan 4; + + my $match = IRC::Grammar.parse('OPER foo bar'); + + ok $match; + is $match, 'OPER'; + is $match[0], 'foo'; + is $match[1], 'bar'; + } + } + + subtest '3.1.5 User mode message', { + plan 3; + + subtest 'MODE WiZ -w', { + plan 4; + + my $match = IRC::Grammar.parse('MODE WiZ -w'); + + ok $match; + is $match, 'MODE'; + is $match[0], 'WiZ'; + is $match[1], '-w'; + } + + subtest 'MODE Angel +i', { + plan 4; + + my $match = IRC::Grammar.parse('MODE Angel +i'); + + ok $match; + is $match, 'MODE'; + is $match[0], 'Angel'; + is $match[1], '+i'; + } + + subtest 'MODE WiZ -o', { + plan 4; + + my $match = IRC::Grammar.parse('MODE WiZ -o'); + + ok $match; + is $match, 'MODE'; + is $match[0], 'WiZ'; + is $match[1], '-o'; + } + } + + subtest '3.1.6 Service message', { + plan 1; + + subtest 'SERVICE dict * *.fr 0 0 :French Dictionary', { + plan 8; + + my $match = IRC::Grammar.parse('SERVICE dict * *.fr 0 0 :French Dictionary'); + + ok $match; + is $match, 'SERVICE'; + is $match[0], 'dict'; + is $match[1], '*'; + is $match[2], '*.fr'; + is $match[3], '0'; + is $match[4], '0'; + is $match[5], 'French Dictionary'; + } + } + + subtest '3.1.7 Quit', { + plan 2; + + subtest 'QUIT :Gone to have lunch', { + plan 3; + + my $match = IRC::Grammar.parse('QUIT :Gone to have lunch'); + + ok $match; + is $match, 'QUIT'; + is $match[0], 'Gone to have lunch'; + } + + subtest ':syrk!kalt@millennium.stealth.net QUIT', { + plan 3; + + my $match = IRC::Grammar.parse(':syrk!kalt@millennium.stealth.net QUIT'); + + ok $match; + is $match, 'syrk!kalt@millennium.stealth.net'; + is $match, 'QUIT'; + } + } + + subtest '3.1.8 Squit', { + plan 2; + + subtest 'SQUIT tolsun.oulu.fi :Bad Link ?', { + plan 4; + + my $match = IRC::Grammar.parse('SQUIT tolsun.oulu.fi :Bad Link ?'); + + ok $match; + is $match, 'SQUIT'; + is $match[0], 'tolsun.oulu.fi'; + is $match[1], 'Bad Link ?'; + } + + subtest ':Trillian SQUIT cm22.eng.umd.edu :Server out of control', { + plan 5; + + my $match = IRC::Grammar.parse(':Trillian SQUIT cm22.eng.umd.edu :Server out of control'); + + ok $match; + is $match, 'Trillian'; + is $match, 'SQUIT'; + is $match[0], 'cm22.eng.umd.edu'; + is $match[1], 'Server out of control'; + } + } + } + + subtest '3.2 Channel operations', { + plan 8; + + subtest '3.2.1 Join message', { + plan 7; + + subtest 'JOIN #foobar', { + plan 3; + + my $match = IRC::Grammar.parse('JOIN #foobar'); + + ok $match; + is $match, 'JOIN'; + is $match[0], '#foobar'; + } + + subtest 'JOIN &foo fubar', { + plan 4; + + my $match = IRC::Grammar.parse('JOIN &foo fubar'); + + ok $match; + is $match, 'JOIN'; + is $match[0], '&foo'; + is $match[1], 'fubar'; + } + + subtest 'JOIN #foo,&bar fubar', { + plan 4; + + my $match = IRC::Grammar.parse('JOIN #foo,&bar fubar'); + + ok $match; + is $match, 'JOIN'; + is $match[0], '#foo,&bar'; + is $match[1], 'fubar'; + } + + subtest 'JOIN #foo,#bar fubar,foobar', { + plan 4; + + my $match = IRC::Grammar.parse('JOIN #foo,#bar fubar,foobar'); + + ok $match; + is $match, 'JOIN'; + is $match[0], '#foo,#bar'; + is $match[1], 'fubar,foobar'; + } + + subtest 'JOIN #foo,#bar', { + plan 3; + + my $match = IRC::Grammar.parse('JOIN #foo,#bar'); + + ok $match; + is $match, 'JOIN'; + is $match[0], '#foo,#bar'; + } + + subtest 'JOIN 0', { + plan 3; + + my $match = IRC::Grammar.parse('JOIN 0'); + + ok $match; + is $match, 'JOIN'; + is $match[0], '0'; + } + + subtest ':WiZ!jto@tolsun.oulu.fi JOIN #Twilight_zone', { + plan 4; + + my $match = IRC::Grammar.parse(':WiZ!jto@tolsun.oulu.fi JOIN #Twilight_zone'); + + ok $match; + is $match, 'WiZ!jto@tolsun.oulu.fi'; + is $match, 'JOIN'; + is $match[0], '#Twilight_zone'; + } + } + + subtest '3.2.2 Part message', { + plan 3; + + subtest 'PART #twilight_zone', { + plan 3; + + my $match = IRC::Grammar.parse('PART #twilight_zone'); + + ok $match; + is $match, 'PART'; + is $match[0], '#twilight_zone'; + } + + subtest 'PART #oz-ops,&group5', { + plan 3; + + my $match = IRC::Grammar.parse('PART #oz-ops,&group5'); + + ok $match; + is $match, 'PART'; + is $match[0], '#oz-ops,&group5'; + } + + subtest ':WiZ!jto@tolsun.oulu.fi PART #playzone :I lost', { + plan 5; + + my $match = IRC::Grammar.parse(':WiZ!jto@tolsun.oulu.fi PART #playzone :I lost'); + + ok $match; + is $match, 'WiZ!jto@tolsun.oulu.fi'; + is $match, 'PART'; + is $match[0], '#playzone'; + is $match[1], 'I lost'; + } + } + + subtest '3.2.3 Channel mode message', { + plan 15; + + subtest 'MODE #Finnish +imI *!*@*.fi', { + plan 5; + + my $match = IRC::Grammar.parse('MODE #Finnish +imI *!*@*.fi'); + + ok $match; + is $match, 'MODE'; + is $match[0], '#Finnish'; + is $match[1], '+imI'; + is $match[2], '*!*@*.fi'; + } + + subtest 'MODE #Finnish +o Kilroy', { + plan 5; + + my $match = IRC::Grammar.parse('MODE #Finnish +o Kilroy'); + + ok $match; + is $match, 'MODE'; + is $match[0], '#Finnish'; + is $match[1], '+o'; + is $match[2], 'Kilroy'; + } + + subtest 'MODE #Finnish +v Wiz', { + plan 5; + + my $match = IRC::Grammar.parse('MODE #Finnish +v Wiz'); + + ok $match; + is $match, 'MODE'; + is $match[0], '#Finnish'; + is $match[1], '+v'; + is $match[2], 'Wiz'; + } + + subtest 'MODE #Fins -s', { + plan 4; + + my $match = IRC::Grammar.parse('MODE #Fins -s'); + + ok $match; + is $match, 'MODE'; + is $match[0], '#Fins'; + is $match[1], '-s'; + } + + subtest 'MODE #42 +k oulu', { + plan 5; + + my $match = IRC::Grammar.parse('MODE #42 +k oulu'); + + ok $match; + is $match, 'MODE'; + is $match[0], '#42'; + is $match[1], '+k'; + is $match[2], 'oulu'; + } + + subtest 'MODE #42 -k oulu', { + plan 5; + + my $match = IRC::Grammar.parse('MODE #42 -k oulu'); + + ok $match; + is $match, 'MODE'; + is $match[0], '#42'; + is $match[1], '-k'; + is $match[2], 'oulu'; + } + + subtest 'MODE #eu-opers +l 10', { + plan 5; + + my $match = IRC::Grammar.parse('MODE #eu-opers +l 10'); + + ok $match; + is $match, 'MODE'; + is $match[0], '#eu-opers'; + is $match[1], '+l'; + is $match[2], '10'; + } + + subtest ':WiZ!jto@tolsun.oulu.fi MODE #eu-opers -l', { + plan 5; + + my $match = IRC::Grammar.parse(':WiZ!jto@tolsun.oulu.fi MODE #eu-opers -l'); + + ok $match; + is $match, 'WiZ!jto@tolsun.oulu.fi'; + is $match, 'MODE'; + is $match[0], '#eu-opers'; + is $match[1], '-l'; + } + + subtest 'MODE &oulu +b', { + plan 4; + + my $match = IRC::Grammar.parse('MODE &oulu +b'); + + ok $match; + is $match, 'MODE'; + is $match[0], '&oulu'; + is $match[1], '+b'; + } + + subtest 'MODE &oulu +b *!*@*', { + plan 5; + + my $match = IRC::Grammar.parse('MODE &oulu +b *!*@*'); + + ok $match; + is $match, 'MODE'; + is $match[0], '&oulu'; + is $match[1], '+b'; + is $match[2], '*!*@*'; + } + + subtest 'MODE &oulu +b *!*@*.edu +e *!*@*.bu.edu', { + plan 7; + + my $match = IRC::Grammar.parse('MODE &oulu +b *!*@*.edu +e *!*@*.bu.edu'); + + ok $match; + is $match, 'MODE'; + is $match[0], '&oulu'; + is $match[1], '+b'; + is $match[2], '*!*@*.edu'; + is $match[3], '+e'; + is $match[4], '*!*@*.bu.edu'; + } + + subtest 'MODE #bu +be *!*@*.edu *!*@*.bu.edu', { + plan 6; + + my $match = IRC::Grammar.parse('MODE #bu +be *!*@*.edu *!*@*.bu.edu'); + + ok $match; + is $match, 'MODE'; + is $match[0], '#bu'; + is $match[1], '+be'; + is $match[2], '*!*@*.edu'; + is $match[3], '*!*@*.bu.edu'; + } + + subtest 'MODE #meditation e', { + plan 4; + + my $match = IRC::Grammar.parse('MODE #meditation e'); + + ok $match; + is $match, 'MODE'; + is $match[0], '#meditation'; + is $match[1], 'e'; + } + + subtest 'MODE #meditation I', { + plan 4; + + my $match = IRC::Grammar.parse('MODE #meditation I'); + + ok $match; + is $match, 'MODE'; + is $match[0], '#meditation'; + is $match[1], 'I'; + } + + subtest 'MODE !12345ircd O', { + plan 4; + + my $match = IRC::Grammar.parse('MODE !12345ircd O'); + + ok $match; + is $match, 'MODE'; + is $match[0], '!12345ircd'; + is $match[1], 'O'; + } + } + + subtest '3.2.4 Topic message', { + plan 4; + + subtest ':WiZ!jto@tolsun.oulu.fi TOPIC #test :New topic', { + plan 5; + + my $match = IRC::Grammar.parse(':WiZ!jto@tolsun.oulu.fi TOPIC #test :New topic'); + + ok $match; + is $match, 'WiZ!jto@tolsun.oulu.fi'; + is $match, 'TOPIC'; + is $match[0], '#test'; + is $match[1], 'New topic'; + } + + subtest 'TOPIC #test :another topic', { + plan 4; + + my $match = IRC::Grammar.parse('TOPIC #test :another topic'); + + ok $match; + is $match, 'TOPIC'; + is $match[0], '#test'; + is $match[1], 'another topic'; + } + + subtest 'TOPIC #test :', { + plan 4; + + my $match = IRC::Grammar.parse('TOPIC #test :'); + + ok $match; + is $match, 'TOPIC'; + is $match[0], '#test'; + is $match[1], ''; + } + + subtest 'TOPIC #test', { + plan 3; + + my $match = IRC::Grammar.parse('TOPIC #test'); + + ok $match; + is $match, 'TOPIC'; + is $match[0], '#test'; + } + } + + subtest '3.2.5 Names message', { + plan 2; + + subtest 'NAMES #twilight_zone,#42', { + plan 3; + + my $match = IRC::Grammar.parse('NAMES #twilight_zone,#42'); + + ok $match; + is $match, 'NAMES'; + is $match[0], '#twilight_zone,#42'; + } + + subtest 'NAMES', { + plan 2; + + my $match = IRC::Grammar.parse('NAMES'); + + ok $match; + is $match, 'NAMES'; + } + } + + subtest '3.2.6 List message', { + plan 2; + + subtest 'LIST', { + plan 2; + + my $match = IRC::Grammar.parse('LIST'); + + ok $match; + is $match, 'LIST'; + } + + subtest 'LIST #twilight_zone,#42', { + plan 3; + + my $match = IRC::Grammar.parse('LIST #twilight_zone,#42'); + + ok $match; + is $match, 'LIST'; + is $match[0], '#twilight_zone,#42'; + } + } + + subtest '3.2.7 Invite message', { + plan 2; + + subtest ':Angel!wings@irc.org INVITE Wiz #Dust', { + plan 5; + + my $match = IRC::Grammar.parse(':Angel!wings@irc.org INVITE Wiz #Dust'); + + ok $match; + is $match, 'Angel!wings@irc.org'; + is $match, 'INVITE'; + is $match[0], 'Wiz'; + is $match[1], '#Dust'; + } + + subtest 'INVITE Wiz #Twilight_Zone', { + plan 4; + + my $match = IRC::Grammar.parse('INVITE Wiz #Twilight_Zone'); + + ok $match; + is $match, 'INVITE'; + is $match[0], 'Wiz'; + is $match[1], '#Twilight_Zone'; + } + } + + subtest '3.2.8 Kick command', { + plan 3; + + subtest 'KICK &Melbourne Matthew', { + plan 4; + + my $match = IRC::Grammar.parse('KICK &Melbourne Matthew'); + + ok $match; + is $match, 'KICK'; + is $match[0], '&Melbourne'; + is $match[1], 'Matthew'; + } + + subtest 'KICK #Finnish John :Speaking English', { + plan 5; + + my $match = IRC::Grammar.parse('KICK #Finnish John :Speaking English'); + + ok $match; + is $match, 'KICK'; + is $match[0], '#Finnish'; + is $match[1], 'John'; + is $match[2], 'Speaking English'; + } + + subtest ':WiZ!jto@tolsun.oulu.fi KICK #Finnish John', { + plan 5; + + my $match = IRC::Grammar.parse(':WiZ!jto@tolsun.oulu.fi KICK #Finnish John'); + + ok $match; + is $match, 'WiZ!jto@tolsun.oulu.fi'; + is $match, 'KICK'; + is $match[0], '#Finnish'; + is $match[1], 'John'; + } + } + } + + subtest '3.3 Sending messages', { + plan 1; + + subtest '3.3.1 Private messages', { + subtest ':Angel!wings@irc.org PRIVMSG Wiz :Are you receiving this message ?', { + plan 5; + + my $match = IRC::Grammar.parse(':Angel!wings@irc.org PRIVMSG Wiz :Are you receiving this message ?'); + + ok $match; + is $match, 'Angel!wings@irc.org'; + is $match, 'PRIVMSG'; + is $match[0], 'Wiz'; + is $match[1], 'Are you receiving this message ?'; + } + + subtest "PRIVMSG Angel :yes I'm receiving it !", { + plan 4; + + my $match = IRC::Grammar.parse("PRIVMSG Angel :yes I'm receiving it !"); + + ok $match; + is $match, 'PRIVMSG'; + is $match[0], 'Angel'; + is $match[1], "yes I'm receiving it !"; + } + + subtest 'PRIVMSG jto@tolsun.oulu.fi :Hello !', { + plan 4; + + my $match = IRC::Grammar.parse('PRIVMSG jto@tolsun.oulu.fi :Hello !'); + + ok $match; + is $match, 'PRIVMSG'; + is $match[0], 'jto@tolsun.oulu.fi'; + is $match[1], 'Hello !'; + } + + subtest 'PRIVMSG kalt%millennium.stealth.net@irc.stealth.net :Are you a frog?', { + plan 4; + + my $match = IRC::Grammar.parse('PRIVMSG kalt%millennium.stealth.net@irc.stealth.net :Are you a frog?'); + + ok $match; + is $match, 'PRIVMSG'; + is $match[0], 'kalt%millennium.stealth.net@irc.stealth.net'; + is $match[1], 'Are you a frog?'; + } + + subtest 'PRIVMSG kalt%millennium.stealth.net :Do you like cheese?', { + plan 4; + + my $match = IRC::Grammar.parse('PRIVMSG kalt%millennium.stealth.net :Do you like cheese?'); + + ok $match; + is $match, 'PRIVMSG'; + is $match[0], 'kalt%millennium.stealth.net'; + is $match[1], 'Do you like cheese?'; + } + + subtest 'PRIVMSG Wiz!jto@tolsun.oulu.fi :Hello !', { + plan 4; + + my $match = IRC::Grammar.parse('PRIVMSG Wiz!jto@tolsun.oulu.fi :Hello !'); + + ok $match; + is $match, 'PRIVMSG'; + is $match[0], 'Wiz!jto@tolsun.oulu.fi'; + is $match[1], 'Hello !'; + } + + subtest 'PRIVMSG $*.fi :Server tolsun.oulu.fi rebooting.', { + plan 4; + + my $match = IRC::Grammar.parse('PRIVMSG $*.fi :Server tolsun.oulu.fi rebooting.'); + + ok $match; + is $match, 'PRIVMSG'; + is $match[0], '$*.fi'; + is $match[1], 'Server tolsun.oulu.fi rebooting.'; + } + + subtest 'PRIVMSG #*.edu :NSFNet is undergoing work, expect interruptions', { + plan 4; + + my $match = IRC::Grammar.parse('PRIVMSG #*.edu :NSFNet is undergoing work, expect interruptions'); + + ok $match; + is $match, 'PRIVMSG'; + is $match[0], '#*.edu'; + is $match[1], 'NSFNet is undergoing work, expect interruptions'; + } + } + } + + subtest '3.4 Server queries and commands', { + plan 8; + + subtest '3.4.3 Version message', { + plan 1; + + subtest 'VERSION tolsun.oulu.fi', { + plan 3; + + my $match = IRC::Grammar.parse('VERSION tolsun.oulu.fi'); + + ok $match; + is $match, 'VERSION'; + is $match[0], 'tolsun.oulu.fi'; + } + } + + subtest '3.4.4 Stats message', { + plan 1; + + subtest 'STATS m', { + plan 3; + + my $match = IRC::Grammar.parse('STATS m'); + + ok $match; + is $match, 'STATS'; + is $match[0], 'm'; + } + } + + subtest '3.4.5 Links message', { + plan 2; + + subtest 'LINKS *.au', { + plan 3; + + my $match = IRC::Grammar.parse('LINKS *.au'); + + ok $match; + is $match, 'LINKS'; + is $match[0], '*.au'; + } + + subtest 'LINKS *.edu *.bu.edu', { + plan 4; + + my $match = IRC::Grammar.parse('LINKS *.edu *.bu.edu'); + + ok $match; + is $match, 'LINKS'; + is $match[0], '*.edu'; + is $match[1], '*.bu.edu'; + } + } + + subtest '3.4.6 Time message', { + plan 1; + + subtest 'TIME tolsun.oulu.fi', { + plan 3; + + my $match = IRC::Grammar.parse('TIME tolsun.oulu.fi'); + + ok $match; + is $match, 'TIME'; + is $match[0], 'tolsun.oulu.fi'; + } + } + + subtest '3.4.7 Connect message', { + plan 1; + + subtest 'CONNECT tolsun.oulu.fi 6667', { + plan 4; + + my $match = IRC::Grammar.parse('CONNECT tolsun.oulu.fi 6667'); + + ok $match; + is $match, 'CONNECT'; + is $match[0], 'tolsun.oulu.fi'; + is $match[1], '6667'; + } + } + + subtest '3.4.8 Trace message', { + plan 1; + + subtest 'TRACE *.oulu.fi', { + plan 3; + + my $match = IRC::Grammar.parse('TRACE *.oulu.fi'); + + ok $match; + is $match, 'TRACE'; + is $match[0], '*.oulu.fi'; + } + } + + subtest '3.4.9 Admin command', { + plan 2; + + subtest 'ADMIN tolsun.oulu.fi', { + plan 3; + + my $match = IRC::Grammar.parse('ADMIN tolsun.oulu.fi'); + + ok $match; + is $match, 'ADMIN'; + is $match[0], 'tolsun.oulu.fi'; + } + + subtest 'ADMIN syrk', { + plan 3; + + my $match = IRC::Grammar.parse('ADMIN syrk'); + + ok $match; + is $match, 'ADMIN'; + is $match[0], 'syrk'; + } + } + + subtest '3.4.10 Info command', { + plan 2; + + subtest 'INFO csd.bu.edu', { + plan 3; + + my $match = IRC::Grammar.parse('INFO csd.bu.edu'); + + ok $match; + is $match, 'INFO'; + is $match[0], 'csd.bu.edu'; + } + + subtest 'INFO Angel', { + plan 3; + + my $match = IRC::Grammar.parse('INFO Angel'); + + ok $match; + is $match, 'INFO'; + is $match[0], 'Angel'; + } + } + } + + subtest '3.5 Service Query and Commands', { + plan 1; + + subtest '3.5.2 Squery', { + plan 2; + + subtest 'SQUERY irchelp :HELP privmsg', { + plan 4; + + my $match = IRC::Grammar.parse('SQUERY irchelp :HELP privmsg'); + + ok $match; + is $match, 'SQUERY'; + is $match[0], 'irchelp'; + is $match[1], 'HELP privmsg'; + } + + subtest 'SQUERY dict@irc.fr :fr2en blaireau', { + plan 4; + + my $match = IRC::Grammar.parse('SQUERY dict@irc.fr :fr2en blaireau'); + + ok $match; + is $match, 'SQUERY'; + is $match[0], 'dict@irc.fr'; + is $match[1], 'fr2en blaireau'; + } + } + } + + subtest '3.6 User based queries', { + plan 3; + + subtest '3.6.1 Who query', { + plan 2; + + subtest 'WHO *.fi', { + plan 3; + + my $match = IRC::Grammar.parse('WHO *.fi'); + + ok $match; + is $match, 'WHO'; + is $match[0], '*.fi'; + } + + subtest 'WHO jto* o', { + plan 4; + + my $match = IRC::Grammar.parse('WHO jto* o'); + + ok $match; + is $match, 'WHO'; + is $match[0], 'jto*'; + is $match[1], 'o'; + } + } + + subtest '3.6.2 Whois query', { + plan 2; + + subtest 'WHOIS wiz', { + plan 3; + + my $match = IRC::Grammar.parse('WHOIS wiz'); + + ok $match; + is $match, 'WHOIS'; + is $match[0], 'wiz'; + } + + subtest 'WHOIS eff.org trillian', { + plan 4; + + my $match = IRC::Grammar.parse('WHOIS eff.org trillian'); + + ok $match; + is $match, 'WHOIS'; + is $match[0], 'eff.org'; + is $match[1], 'trillian'; + } + } + + subtest '3.6.3 Whowas', { + plan 3; + + subtest 'WHOWAS Wiz', { + plan 3; + + my $match = IRC::Grammar.parse('WHOWAS Wiz'); + + ok $match; + is $match, 'WHOWAS'; + is $match[0], 'Wiz'; + } + + subtest 'WHOWAS Mermaid 9', { + plan 4; + + my $match = IRC::Grammar.parse('WHOWAS Mermaid 9'); + + ok $match; + is $match, 'WHOWAS'; + is $match[0], 'Mermaid'; + is $match[1], '9'; + } + + subtest 'WHOWAS Trillian 1 *.edu', { + plan 5; + + my $match = IRC::Grammar.parse('WHOWAS Trillian 1 *.edu'); + + ok $match; + is $match, 'WHOWAS'; + is $match[0], 'Trillian'; + is $match[1], '1'; + is $match[2], '*.edu'; + } + } + } + + subtest '3.7 Miscellaneous messages', { + plan 3; + + subtest '3.7.2 Ping message', { + plan 3; + + subtest 'PING tolsun.oulu.fi', { + plan 3; + + my $match = IRC::Grammar.parse('PING tolsun.oulu.fi'); + + ok $match; + is $match, 'PING'; + is $match[0], 'tolsun.oulu.fi'; + } + + subtest 'PING WiZ tolsun.oulu.fi', { + plan 4; + + my $match = IRC::Grammar.parse('PING WiZ tolsun.oulu.fi'); + + ok $match; + is $match, 'PING'; + is $match[0], 'WiZ'; + is $match[1], 'tolsun.oulu.fi'; + } + + subtest 'PING :irc.funet.fi', { + plan 3; + + my $match = IRC::Grammar.parse('PING :irc.funet.fi'); + + ok $match; + is $match, 'PING'; + is $match[0], 'irc.funet.fi'; + } + } + + subtest '3.7.3 Pong message', { + plan 1; + + subtest 'PONG csd.bu.edu tolsun.oulu.fi', { + plan 4; + + my $match = IRC::Grammar.parse('PONG csd.bu.edu tolsun.oulu.fi'); + + ok $match; + is $match, 'PONG'; + is $match[0], 'csd.bu.edu'; + is $match[1], 'tolsun.oulu.fi'; + } + } + + subtest '3.7.4 Error', { + plan 2; + + subtest 'ERROR :Server *.fi already exists', { + plan 3; + + my $match = IRC::Grammar.parse('ERROR :Server *.fi already exists'); + + ok $match; + is $match, 'ERROR'; + is $match[0], 'Server *.fi already exists'; + } + + subtest 'NOTICE WiZ :ERROR from csd.bu.edu -- Server *.fi already exists', { + plan 4; + + my $match = IRC::Grammar.parse('NOTICE WiZ :ERROR from csd.bu.edu -- Server *.fi already exists'); + + ok $match; + is $match, 'NOTICE'; + is $match[0], 'WiZ'; + is $match[1], 'ERROR from csd.bu.edu -- Server *.fi already exists'; + } + } + } +} + +subtest '4. Optional features', { + plan 9; + + subtest '4.1 Away', { + plan 1; + + subtest 'AWAY :Gone to lunch. Back in 5', { + plan 3; + + my $match = IRC::Grammar.parse('AWAY :Gone to lunch. Back in 5'); + + ok $match; + is $match, 'AWAY'; + is $match[0], 'Gone to lunch. Back in 5'; + } + } + + subtest '4.2 Rehash message', { + plan 1; + + subtest 'REHASH', { + plan 2; + + my $match = IRC::Grammar.parse('REHASH'); + + ok $match; + is $match, 'REHASH'; + } + } + + subtest '4.3 Die message', { + plan 1; + + subtest 'DIE', { + plan 2; + + my $match = IRC::Grammar.parse('DIE'); + + ok $match; + is $match, 'DIE'; + } + } + + subtest '4.4 Restart message', { + plan 1; + + subtest 'RESTART', { + plan 2; + + my $match = IRC::Grammar.parse('RESTART'); + + ok $match; + is $match, 'RESTART'; + } + } + + subtest '4.5 Summon message', { + plan 2; + + subtest 'SUMMON jto', { + plan 3; + + my $match = IRC::Grammar.parse('SUMMON jto'); + + ok $match; + is $match, 'SUMMON'; + is $match[0], 'jto'; + } + + subtest 'SUMMON jto tolsun.oulu.fi', { + plan 4; + + my $match = IRC::Grammar.parse('SUMMON jto tolsun.oulu.fi'); + + ok $match; + is $match, 'SUMMON'; + is $match[0], 'jto'; + is $match[1], 'tolsun.oulu.fi'; + } + } + + subtest '4.6 Users', { + plan 1; + + subtest 'USERS eff.org', { + plan 3; + + my $match = IRC::Grammar.parse('USERS eff.org'); + + ok $match; + is $match, 'USERS'; + is $match[0], 'eff.org'; + } + } + + subtest '4.7 Operwall message', { + plan 1; + + subtest ":csd.bu.edu WALLOPS :Connect '*.uiuc.edu 6667' from Joshua", { + plan 4; + + my $match = IRC::Grammar.parse(":csd.bu.edu WALLOPS :Connect '*.uiuc.edu 6667' from Joshua"); + + ok $match; + is $match, 'csd.bu.edu'; + is $match, 'WALLOPS'; + is $match[0], "Connect '*.uiuc.edu 6667' from Joshua"; + } + } + + subtest '4.8 Userhost message', { + plan 2; + + subtest 'USERHOST Wiz Michael syrk', { + plan 5; + + my $match = IRC::Grammar.parse('USERHOST Wiz Michael syrk'); + + ok $match; + is $match, 'USERHOST'; + is $match[0], 'Wiz'; + is $match[1], 'Michael'; + is $match[2], 'syrk'; + } + + subtest ':ircd.stealth.net 302 yournick :syrk=+syrk@millennium.stealth.net', { + plan 5; + + my $match = IRC::Grammar.parse(':ircd.stealth.net 302 yournick :syrk=+syrk@millennium.stealth.net'); + + ok $match; + is $match, 'ircd.stealth.net'; + is $match, '302'; + is $match[0], 'yournick'; + is $match[1], 'syrk=+syrk@millennium.stealth.net'; + } + } + + subtest '4.9 Ison message', { + plan 1; + + subtest 'ISON phone trillian WiZ jarlek Avalon Angel Monstah syrk', { + plan 10; + + my $match = IRC::Grammar.parse('ISON phone trillian WiZ jarlek Avalon Angel Monstah syrk'); + + ok $match; + is $match, 'ISON'; + is $match[0], 'phone'; + is $match[1], 'trillian'; + is $match[2], 'WiZ'; + is $match[3], 'jarlek'; + is $match[4], 'Avalon'; + is $match[5], 'Angel'; + is $match[6], 'Monstah'; + is $match[7], 'syrk'; + } + } +} -- cgit v1.1