lib/perl/Query.pm

   1 #       Perl module for sending queries to Sherlock search servers and parsing answers
   2 #
   3 #       (c) 2002--2003 Martin Mares <mj@ucw.cz>
   4 #
   5 #       This software may be freely distributed and used according to the terms
   6 #       of the GNU Lesser General Public License.
   7
   8 =head1 NAME
   9
  10 Sherlock::Query -- Communication with Sherlock Search Servers
  11
  12 =head1 DESCRIPTION
  13
  14 This perl library offers a simple interface for connecting to Sherlock
  15 search servers, sending queries or control commands and parsing the
  16 results.
  17
  18 First of all, you have to use
  19
  20         my $conn = new Sherlock::Query('server:port');
  21
  22 to create a new connection object (unconnected yet). Then you can call
  23
  24         my $res = $conn->command('command');
  25
  26 to establish the connection, send a given command to the search server
  27 and gather the results (see below) or, if you want to send a normal query,
  28
  29         my $res = $conn->query('"simple" OR "query"');
  30
  31 which does the same as C<< $conn->command(...) >>, but it also parses the
  32 results to a representation convenient for handling in Perl programs
  33 (again, see below).
  34
  35 Currently, you can use a single connection to send only a single command or query.
  36
  37 =head1 RESULTS
  38
  39 The I<raw answer> of the search server (i.e., the lines it has returned) is always
  40 available as C<< $conn->{RAW} >> as a list of strings, each representing a single
  41 line.
  42
  43 Parsed results of queries are stored in a more complicated way, but before
  44 explaining it, let's mention a couple of axioms: Any search server I<object>
  45 (header, footer, a single document of answer) is always stored as a hash keyed
  46 by attribute names. Ordinary single-valued attributes are stored as strings,
  47 multi-valued attributes as (references to) arrays of strings. When an object
  48 contains sub-objects, they are stored as references to other hashes, possibly
  49 encapsulated within a list if there can be multiple such objects. Most objects
  50 have an extra attribute C<RAW> containing the original description of the
  51 object, a sub-list of C<< $conn->{RAW} >>.
  52
  53 The parsed answer consists of three parts (please follow F<doc/search> to
  54 get a better picture of what does the server answer): header C<< $conn->{HEADER} >>
  55 (an object, as described above), footer C<< $conn->{FOOTER} >> (object) and document
  56 cards C<< $conn->{CARDS} >> (a list of objects).
  57
  58 The I<header> contains all the standard header attributes and also C<< $hdr->{D} >>
  59 which is a list of sub-objects, each corresponding to a single database and
  60 containing per-database attributes like C<W> (word list).
  61
  62 The I<footer> is pretty straightforward and it just contains what you'd
  63 expect it to.
  64
  65 Each I<card> contains the usual document attributes (see F<doc/objects> for
  66 a list) plus C<< $card->{U} >> which is a list of sub-objects corresponding
  67 to URL's of the document and containing per-URL attributes like C<U> (URL),
  68 C<s> (original size) and C<T> (content type).
  69
  70 When in doubt, call the C<print> method which will print the whole contents
  71 of the connection object. It's actually a much more general (but pretty
  72 simple due to Perl being able to be a very introspective language) routine
  73 usable for dumping any acyclic Perl data structure composed of strings,
  74 hashes, arrays and references to them. You can access this general routine
  75 by calling C<format({ print; }, $what)> which dumps C<$what> and for
  76 each line of output it calls the given subroutine.
  77
  78 =head1 SEE ALSO
  79
  80 A good example of use of this module is the C<query> utility and
  81 of course the example front-end (F<front-end/query.cgi>).
  82
  83 =head1 AUTHOR
  84
  85 Martin Mares <mj@ucw.cz>
  86
  87 =cut
  88
  89 package Sherlock::Query;
  90
  91 use strict;
  92 use warnings;
  93 use IO::Socket::INET;
  94
  95 sub parse_tree($$);
  96 sub do_parse_tree($$$$);
  97 sub format_tree($$$);
  98
  99 sub new($$) {
 100         my $class = shift @_;
 101         my $server = shift @_;
 102         my $self = {
 103                 SERVER  => $server
 104         };
 105         bless $self;
 106         return $self;
 107 }
 108
 109 sub command($$) {
 110         my ($q,$string) = @_;
 111
 112         $q->{RAW} = [];
 113
 114         my $sock = IO::Socket::INET->new(PeerAddr => $q->{SERVER}, Proto => 'tcp')
 115                 or return "-900 Cannot connect to search server: $!";
 116         print $sock $string, "\n";
 117
 118         # Status line
 119         my $stat = <$sock>;
 120         chomp $stat;
 121         $stat =~ /^[+-]/ or return "-901 Reply parse error";
 122
 123         # Blocks of output
 124         my $block = undef;
 125         for(;;) {
 126                 my $res = <$sock>;
 127                 last if $sock->eof;
 128                 chomp $res;
 129                 if ($res eq "") {
 130                         $block = undef;
 131                 } else {
 132                         if (!defined $block) {
 133                                 $block = [];
 134                                 push @{$q->{RAW}}, $block;
 135                         }
 136                         push @$block, $res;
 137                 }
 138         }
 139
 140         return $stat;
 141 }
 142
 143 our $hdr_syntax = {
 144         '(D' => {
 145                 'W' => [],
 146                 'P' => [],
 147                 'n' => [],
 148                 '.' => [],
 149         },
 150         '.' => [],
 151 };
 152
 153 our $card_syntax = {
 154         '(U' => {
 155                 'V' => [],
 156                 'y' => [],
 157                 'E' => [],
 158         },
 159         'M' => [],
 160         'X' => [],
 161 };
 162
 163 our $footer_syntax = {
 164 };
 165
 166 sub query($$) {
 167         my ($q,$string) = @_;
 168
 169         # Send the query and gather results
 170         my $stat = $q->command($string);
 171         my @raw = @{$q->{RAW}};
 172
 173         # Split results to header, cards and footer
 174         $q->{HEADER} = { RAW => [] };
 175         if (@raw) { $q->{HEADER}{RAW} = shift @raw; }
 176         elsif (!$stat) { return "-902 Incomplete reply"; }
 177         $q->{FOOTER} = { RAW => [] };
 178         if (@raw && $raw[@raw-1]->[0] =~ /^\+/) {
 179                 $q->{FOOTER}{RAW} = pop @raw;
 180         }
 181         $q->{CARDS} = [];
 182         while (@raw) {
 183                 push @{$q->{CARDS}}, { RAW => shift @raw };
 184         }
 185
 186         # Parse everything
 187         parse_tree($q->{HEADER}, $hdr_syntax);
 188         foreach my $c (@{$q->{CARDS}}) {
 189                 parse_tree($c, $card_syntax);
 190         }
 191         parse_tree($q->{FOOTER}, $footer_syntax);
 192
 193         return $stat;
 194 }
 195
 196 sub parse_tree($$) {
 197         my $tree = shift @_;
 198         my $syntax = shift @_;
 199         do_parse_tree($tree->{RAW}, 0, $tree, $syntax);
 200 }
 201
 202 sub do_parse_tree($$$$) {
 203         my $raw = shift @_;
 204         my $i = shift @_;
 205         my $cooked = shift @_;
 206         my $syntax = shift @_;
 207
 208         while ($i < @$raw) {
 209                 $raw->[$i] =~ /^([^(]|\(.)(.*)/;
 210                 if ($1 eq ")") {
 211                         return $i;
 212                 } elsif (!defined($syntax->{$1})) {
 213                         $cooked->{$1} = $2 if !defined($cooked->{$1});
 214                         $i++;
 215                 } elsif (ref $syntax->{$1} eq "ARRAY") {
 216                         push @{$cooked->{$1}}, $2;
 217                         $i++;
 218                 } elsif (ref $syntax->{$1} eq "HASH") {
 219                         my $block = {};
 220                         push @{$cooked->{$1}}, $block;
 221                         $i = do_parse_tree($raw, $i+1, $block, $syntax->{$1});
 222                 }
 223         }
 224         return $i;
 225 }
 226
 227 sub format_tree($$$) {
 228         my ($func, $a, $indent) = @_;
 229         if (ref $a eq "ARRAY") {
 230                 if (@{$a} == 0) { &$func("[]\n"); }
 231                 else {
 232                         &$func("[\n");
 233                         foreach my $k (@{$a}) {
 234                                 &$func("$indent\t");
 235                                 format_tree($func, $k, "$indent\t");
 236                         }
 237                         &$func($indent . "]\n");
 238                 }
 239         } elsif (ref $a) {
 240                 &$func("{\n");
 241                 foreach my $k (sort keys %{$a}) {
 242                         &$func("$indent\t$k => ");
 243                         format_tree($func, $a->{$k}, "$indent\t");
 244                 }
 245                 &$func($indent . "}\n");
 246         } elsif (defined $a) {
 247                 &$func("$a\n");
 248         } else {
 249                 &$func("UNDEF\n");
 250         }
 251 }
 252
 253 sub format($&$) {
 254         my ($q, $func, $what) = @_;
 255         format_tree($func, $what, "");
 256 }
 257
 258 sub print($) {
 259         my $q = shift @_;
 260         format_tree(sub { print $_[0]; }, $q, "");
 261 }
 262
 263 1;  # OK