[irclog] medium size cleanup

 * moved all functions only used by the CGI scripts from IrcLog to IrcLog::WWW
 * fixed regexes for static links and abbreviations if the data files can't be
   read
 * added test scripts for http_header() and synopsis links
 * some tab -> whitespace cleanups


git-svn-id: http://svn.pugscode.org/pugs/misc/irclog@17075 c213334d-75ef-0310-aa23-eaa082d1ae64

2 files changed, 65 insertions, 0 deletions

diff --git a/t/http-header.t b/t/http-header.t
new file mode 100644
index 0000000..92d0c74
--- /dev/null
+++ b/t/http-header.t
@@ -0,0 +1,25 @@
+use strict;
+use warnings;
+use Test::More tests => 5;
+
+BEGIN { use_ok('IrcLog::WWW'); }
+
+ok( IrcLog::WWW::http_header() =~ m/^Status: 200 OK$/sm, "Return status is '200 OK'");
+{
+	local $ENV{HTTP_ACCEPT};
+	ok( IrcLog::WWW::http_header() 
+			=~ m{^Content-Type: text/html; charset=utf-8$}sm, 
+		"Default Content-Type is text/html, charset is utf-8");
+}
+
+{
+	local $ENV{HTTP_ACCEPT} = qq{application/xhtml+xml;q=1,text/xhtml;qs=0.3};
+	ok( IrcLog::WWW::http_header() 
+			=~ m{^Content-Type: application/xhtml\+xml; charset=utf-8$}sm, 
+		"Environment HTTP_ACCEPT changes Content-Type to xhtml");
+
+	ok( IrcLog::WWW::http_header({no_xhtml => 1}) 
+			=~ m{^Content-Type: text/html; charset=utf-8$}sm, 
+		"Option {no_xhtml => 1} overwrites Environment variable");
+}
+
diff --git a/t/synopsis-links.t b/t/synopsis-links.t
new file mode 100644
index 0000000..e50a597
--- /dev/null
+++ b/t/synopsis-links.t
@@ -0,0 +1,40 @@
+use strict;
+use warnings;
+use Test::More tests => 8;
+
+BEGIN { use_ok('IrcLog::WWW'); }
+
+sub link_length {
+    my $text = shift;
+    my $c = 1;
+    my $h = IrcLog::WWW::message_line({
+            id          => 1,
+            nick        => 'somebody',
+            timestamp   => gmtime,
+            message     => $text,
+            line_number => 1,
+            prev_nick   => '',
+            colors      => [],
+            self_url    => '/',
+            channel     => 'perl6',
+            },
+            \$c
+        );
+    my $msg = $h->{MESSAGE};
+#    print "# $msg\n";
+    if ($msg =~ m{<a [^>]+>([^<]*)</a>}){
+        return length $1;
+    } else {
+        return undef;
+    }
+}
+
+is( link_length(qq{}), undef,        qq{Empty string doesn't linkifiy} );
+is( link_length('foo bar'), undef,   qq{random strings don't linkify} );
+is( link_length('foo S05 bar'), 3,   qq{'S05' in text is turned into a link} );
+is( link_length('sdfS05'), undef,    qq{'S05' within a word in not linkified} );
+is( link_length('S05:123'), 7,       qq{'S05:123' linkifies} );
+is( link_length('S05:1-2'), 7,       qq{'S05:1-2' (ranges) linkify} );
+
+# " is turned into &quot;
+is( link_length('S05/"foo b"'), 21,  qq{'S05/foo bar/ linkifies} );