lib/perl/Query.pm

   1 #       Perl module for sending queries to Sherlock search servers and parsing answers
   2 #
   3 #       (c) 2002 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 package Sherlock::Query;
   9
  10 use strict;
  11 use warnings;
  12 use IO::Socket::INET;
  13
  14 sub parse_tree($$);
  15 sub do_parse_tree($$$$);
  16 sub format_tree($$$);
  17
  18 sub new($$) {
  19         my $class = shift @_;
  20         my $server = shift @_;
  21         my $self = {
  22                 SERVER  => $server
  23         };
  24         bless $self;
  25         return $self;
  26 }
  27
  28 sub command($$) {
  29         my ($q,$string) = @_;
  30
  31         $q->{RAW} = [];
  32
  33         my $sock = IO::Socket::INET->new(PeerAddr => $q->{SERVER}, Proto => 'tcp')
  34                 or return "-900 Cannot connect to search server: $!";
  35         print $sock $string, "\n";
  36
  37         # Status line
  38         my $stat = <$sock>;
  39         chomp $stat;
  40         $stat =~ /^[+-]/ or return "-901 Reply parse error";
  41
  42         # Blocks of output
  43         my $block = undef;
  44         for(;;) {
  45                 my $res = <$sock>;
  46                 last if $sock->eof;
  47                 chomp $res;
  48                 if ($res eq "") {
  49                         $block = undef;
  50                 } else {
  51                         if (!defined $block) {
  52                                 $block = [];
  53                                 push @{$q->{RAW}}, $block;
  54                         }
  55                         push @$block, $res;
  56                 }
  57         }
  58
  59         return $stat;
  60 }
  61
  62 our $hdr_syntax = {
  63         'D' => {
  64                 'D' => "",
  65                 'W' => [],
  66                 'P' => [],
  67                 'n' => [],
  68                 'T' => "",
  69                 '-' => "",
  70                 '.' => [],
  71         },
  72         '.' => [],
  73         '' => ""
  74 };
  75
  76 our $card_syntax = {
  77         'U' => {
  78                 'U' => "",
  79                 'D' => "",
  80                 'E' => "",
  81                 'L' => "",
  82                 'T' => "",
  83                 'c' => "",
  84                 's' => "",
  85                 'V' => [],
  86                 'b' => "",
  87                 'i' => "",
  88                 'y' => [],
  89                 'z' => "",
  90         },
  91         'M' => [],
  92         'X' => [],
  93         '' => ""
  94 };
  95
  96 our $footer_syntax = {
  97         '' => ""
  98 };
  99
 100 sub query($$) {
 101         my ($q,$string) = @_;
 102
 103         # Send the query and gather results
 104         my $stat = $q->command($string);
 105         my @raw = @{$q->{RAW}};
 106
 107         # Split results to header, cards and footer
 108         $q->{HEADER} = { RAW => [] };
 109         if (@raw) { $q->{HEADER}{RAW} = shift @raw; }
 110         elsif (!$stat) { return "-902 Incomplete reply"; }
 111         $q->{FOOTER} = { RAW => [] };
 112         if (@raw && $raw[@raw-1]->[0] =~ /^\+/) {
 113                 $q->{FOOTER}{RAW} = pop @raw;
 114         }
 115         $q->{CARDS} = [];
 116         while (@raw) {
 117                 push @{$q->{CARDS}}, { RAW => pop @raw };
 118         }
 119
 120         # Parse everything
 121         parse_tree($q->{HEADER}, $hdr_syntax);
 122         foreach my $c (@{$q->{CARDS}}) {
 123                 parse_tree($c, $card_syntax);
 124         }
 125         parse_tree($q->{FOOTER}, $footer_syntax);
 126
 127         return $stat;
 128 }
 129
 130 sub parse_tree($$) {
 131         my $tree = shift @_;
 132         my $syntax = shift @_;
 133         do_parse_tree($tree->{RAW}, 0, $tree, $syntax);
 134 }
 135
 136 sub do_parse_tree($$$$) {
 137         my $raw = shift @_;
 138         my $i = shift @_;
 139         my $cooked = shift @_;
 140         my $syntax = shift @_;
 141
 142         while ($i < @$raw) {
 143                 $raw->[$i] =~ /^(.)(.*)/;
 144                 if (!defined($syntax->{$1}) && !defined($syntax->{''})) { return $i; }
 145                 if (ref $syntax->{$1} eq "ARRAY") {
 146                         push @{$cooked->{$1}}, $2;
 147                         $i++;
 148                 } elsif (ref $syntax->{$1} eq "HASH") {
 149                         my $block = {};
 150                         push @{$cooked->{$1}}, $block;
 151                         $i = do_parse_tree($raw, $i, $block, $syntax->{$1});
 152                 } else {
 153                         $cooked->{$1} = $2 if !defined($cooked->{$1});
 154                         $i++;
 155                 }
 156         }
 157 }
 158
 159 sub format_tree($$$) {
 160         my ($func, $a, $indent) = @_;
 161         if (ref $a eq "ARRAY") {
 162                 if (@{$a} == 0) { &$func("[]\n"); }
 163                 else {
 164                         &$func("[\n");
 165                         foreach my $k (@{$a}) {
 166                                 &$func("$indent\t");
 167                                 format_tree($func, $k, "$indent\t");
 168                         }
 169                         &$func($indent . "]\n");
 170                 }
 171         } elsif (ref $a) {
 172                 &$func("{\n");
 173                 foreach my $k (sort keys %{$a}) {
 174                         &$func("$indent\t$k => ");
 175                         format_tree($func, $a->{$k}, "$indent\t");
 176                 }
 177                 &$func($indent . "}\n");
 178         } elsif (defined $a) {
 179                 &$func("$a\n");
 180         } else {
 181                 &$func("UNDEF\n");
 182         }
 183 }
 184
 185 sub format($&$) {
 186         my ($q, $func, $what) = @_;
 187         format_tree($func, $what, "");
 188 }
 189
 190 sub print($) {
 191         my $q = shift @_;
 192         format_tree(sub { print $_[0]; }, $q, "");
 193 }
 194
 195 1;  # OK