Added test script.

[newsd] / t / 01_connectivity.t

diff --git a/t/01_connectivity.t b/t/01_connectivity.t
new file mode 100644 (file)
index 0000000..81c05b2
--- /dev/null
+++ b/t/01_connectivity.t
@@ -0,0 +1,100 @@
+#!/usr/bin/perl
+
+use Test::More tests => 14; 
+
+BEGIN { use_ok('Net::Cmd') }
+BEGIN { use_ok('Net::NNTP') }
+
+my $c = Net::NNTP->new(Host => '127.0.0.1', Port => 20203, Reader => 0);
+
+ok(defined $c, 'connected to localhost');
+
+BAIL_OUT(q{can't connect to test server'}) unless $c;
+
+sub Net::NNTP::issue {
+       my ($c, @cmd) = @_;
+       $c->command(@cmd);
+       $c->response();
+       return $c->code();
+}
+
+sub Net::NNTP::test {
+       my ($c, $valid, @cmd) = @_;
+       $c->response();
+       ok(grep {$c->code == $_} @$valid, "valid response for @$cmd = @$valid");
+       return $c->code;
+}
+
+# 3977:5.1.1 initial greeting must be 200 201 400 502
+my @valid = (200, 201, 400, 502);
+my $greeting = $c->code;
+
+ok(grep {$c->code == $_} @valid, 'correct initial response from server');
+
+unless ($greeting == 200 or $greeting = 201) {
+       goto done;
+}
+
+$c->command('CAPABILITIES');
+$c->response();
+is($c->code, 101, 'correct response to capabilities');
+$c->read_until_dot() if ($c->code == 101);
+
+$c->command('capabilities');
+$c->response();
+is($c->code, 101, 'lower case capabilities ok');
+my $capabilities = $c->read_until_dot() if ($c->code == 101);
+
+my %cap = ();
+my $twice = 0;
+foreach my $line (@$capabilities) {
+       my ($capability, @arg) = split(/\s+/, $line);
+       if (exists($cap{$capability})) {
+               $twice = 1;
+       }
+       $cap{$cap} = \@arg;
+}
+
+ok($twice == 0, 'Capability listed twice (3977:5.2.2)');
+
+$capabilities->[0] =~ /(VERSION) (\d+)(\r?)(\n)/;
+
+is($1, 'VERSION', 'VERSION capability first');
+is($2, 2, 'Version 2 server');
+
+unless ($2==2) {
+       diag('can only test version 2 servers');
+       goto quit;
+}
+
+SKIP: {
+       skip 'Net::Cmd strips \r, skipping \r\n testing', 2;
+       is($3, "\r", 'Server terminated line with \r');
+       is($4, "\n", 'Server terminated line with \n');
+}
+
+is($c->issue('aninvalidcommand'), 500, 'responds with 500 to unknown command');
+
+SKIP: {
+       skip 'No LIST capability, skipping list tests', 1 unless $cap{'LIST'};
+       is($c->issue('list aninvalidlist'), 501, 'responds with 501 to unknown list');
+}
+
+# RFC 4644
+if ($cap{'STREAMING'}) {
+       # check mode stream
+}
+
+quit:
+
+$c->command('QUIT');
+$c->response;
+is($c->code, 205, 'correct response to quit');
+
+done:
+done_testing();
+exit 0;
+
+sub checkcmd {
+       my ($cmd, $args, $valid) = @_;
+}