From 5d39a55158a8200c28d0717c60c26d4c5c16aaa9 Mon Sep 17 00:00:00 2001
From: Yorhel <git@yorhel.nl>
Date: Wed, 11 Jul 2012 11:30:15 +0200
Subject: [PATCH] Initial search stuff

---
 www/index.pl | 34 +++++++++++++++++++++++++++++++++-
 1 file changed, 33 insertions(+), 1 deletion(-)

diff --git a/www/index.pl b/www/index.pl
index b6cf40f..505bd61 100755
--- a/www/index.pl
+++ b/www/index.pl
@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-use TUWF ':html', 'html_escape';
+use TUWF ':html', 'html_escape', ':xml';
 use IPC::Open2;
 use IO::Select;
 use Encode 'encode_utf8', 'decode_utf8';
@@ -42,6 +42,7 @@ TUWF::register(
   qr{info/about} => \&about,
   qr{browse/([^/]+)} => \&browsesys,
   qr{browse/([^/]+)/([^/]+)(?:/([^/]+))?} => \&browsepkg,
+  qr{xml/search} => \&xmlsearch,
   qr{([^/]+)/([0-9a-f]{8})} => \&man,
   qr{([^/]+)/([0-9a-f]{8})/src} => \&src,
   qr{([^/]+)} => \&man,
@@ -469,6 +470,37 @@ sub src {
 }
 
 
+# TODO: This is a prototype, really needs to be polished and optimized!
+sub xmlsearch {
+  my $self = shift;
+  my $q = $self->reqGet('q')||'';
+
+  my $mansect = $1 if $q =~ s/^([0-9])\s+// || $q =~ s/\(([a-zA-Z0-9]+)\)$//;
+  my $manname = $1 if $q =~ s/^([a-zA-Z0-9,.:_-]+)$//;
+
+  # Manual pages
+  my $man = !$manname ? [] : $self->dbAll(
+    'SELECT name, section
+       FROM man !W
+   GROUP BY name, section
+   ORDER BY name, section
+      LIMIT 10',
+    { # Don't use wildcards in this query, prevents index usage.
+      "name ILIKE '$manname%'" => 1,
+      $mansect ? ("section ILIKE '$mansect%'" => 1) : ()
+    }
+  );
+
+  $self->resHeader('Content-Type' => 'text/xml; charset=UTF-8');
+  xml;
+  tag 'results';
+   tag 'mans';
+    tag 'man', %$_, undef for(@$man);
+   end;
+  end 'results';
+}
+
+
 
 package TUWF::Object;