From b63ec31b9272a50ffbfdd58afed9630e70eab517 Mon Sep 17 00:00:00 2001 From: Martin Mares Date: Sat, 11 Dec 2004 11:41:06 +0000 Subject: [PATCH] Moved CGI.pm and Query.pm to Sherlock library. --- lib/perl/CGI.pm | 129 ---------------------- lib/perl/Makefile | 2 +- lib/perl/Query.pm | 264 ---------------------------------------------- 3 files changed, 1 insertion(+), 394 deletions(-) delete mode 100644 lib/perl/CGI.pm delete mode 100644 lib/perl/Query.pm diff --git a/lib/perl/CGI.pm b/lib/perl/CGI.pm deleted file mode 100644 index aeb6c505..00000000 --- a/lib/perl/CGI.pm +++ /dev/null @@ -1,129 +0,0 @@ -# Poor Man's CGI Module for Perl -# -# (c) 2002 Martin Mares -# Slightly modified by Tomas Valla -# -# This software may be freely distributed and used according to the terms -# of the GNU Lesser General Public License. - -package Sherlock::CGI; - -use strict; -use warnings; - -BEGIN { - # The somewhat hairy Perl export mechanism - use Exporter(); - our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); - $VERSION = 1.0; - @ISA = qw(Exporter); - @EXPORT = qw(&html_escape &url_escape &self_ref &self_form); - @EXPORT_OK = qw(); - %EXPORT_TAGS = (); -} - -sub url_escape($) { - my $x = shift @_; - $x =~ s/([^-\$_.!*'(),0-9A-Za-z\x80-\xff])/"%".unpack('H2',$1)/ge; - return $x; -} - -sub html_escape($) { - my $x = shift @_; - $x =~ s/&/&/g; - $x =~ s//>/g; - $x =~ s/"/"/g; - return $x; -} - -our $arg_table; - -sub parse_arg_string($) { - my ($s) = @_; - $s =~ s/\s+//; - foreach $_ (split /[&:]/,$s) { - (/^([^=]+)=(.*)$/) or next; - my $arg = $arg_table->{$1} or next; - $_ = $2; - s/\+/ /g; - s/%(..)/pack("c",hex $1)/eg; - s/(\r|\n|\t)/ /g; - s/^\s+//; - s/\s+$//; - if (my $rx = $arg->{'check'}) { - if (!/^$rx$/) { $_ = $arg->{'default'}; } - } - - my $r = ref($arg->{'var'}); - if ($r eq 'SCALAR') { - ${$arg->{'var'}} = $_; - } elsif ($r eq 'ARRAY') { - push @{$arg->{'var'}}, $_; - } - } -} - -sub parse_args($) { - $arg_table = shift @_; - foreach my $a (values %$arg_table) { - my $r = ref($a->{'var'}); - defined($a->{'default'}) or $a->{'default'}=""; - if ($r eq 'SCALAR') { - ${$a->{'var'}} = $a->{'default'}; - } elsif ($r eq 'ARRAY') { - @{$a->{'var'}} = (); - } - } - defined $ENV{"GATEWAY_INTERFACE"} or die "Not called as a CGI script"; - my $method = $ENV{"REQUEST_METHOD"}; - if ($method eq "GET") { - parse_arg_string($ENV{"QUERY_STRING"}); - } elsif ($method eq "POST") { - if ($ENV{"CONTENT_TYPE"} =~ /^application\/x-www-form-urlencoded\b/i) { - while () { - chomp; - parse_arg_string($_); - } - } else { - return "Unknown content type for POST data"; - } - } else { - return "Unknown request method"; - } -} - -sub make_out_args($) { - my ($overrides) = @_; - my $out = {}; - foreach my $name (keys %$arg_table) { - my $arg = $arg_table->{$name}; - defined $arg->{'pass'} && !$arg->{'pass'} && !exists $overrides->{$name} && next; - my $value; - if (!defined($value = $overrides->{$name})) { - if (exists $overrides->{$name}) { - $value = $arg->{'default'}; - } else { - $value = ${$arg->{'var'}}; - } - } - if ($value ne $arg->{'default'}) { - $out->{$name} = $value; - } - } - return $out; -} - -sub self_ref(@) { - my %h = @_; - my $out = make_out_args(\%h); - return "?" . join(':', map { "$_=" . url_escape($out->{$_}) } sort keys %$out); -} - -sub self_form(@) { - my %h = @_; - my $out = make_out_args(\%h); - return join('', map { "\n" } sort keys %$out); -} - -1; # OK diff --git a/lib/perl/Makefile b/lib/perl/Makefile index eceb6f69..3ddce873 100644 --- a/lib/perl/Makefile +++ b/lib/perl/Makefile @@ -1,7 +1,7 @@ # Perl modules DIRS+=lib/perl -PROGS+=$(addprefix obj/lib/perl/,Config.pm Query.pm CGI.pm) +PROGS+=$(addprefix obj/lib/perl/,Config.pm) ifdef CONFIG_WATSON include lib/perl/Ulimit/Makefile diff --git a/lib/perl/Query.pm b/lib/perl/Query.pm deleted file mode 100644 index a25fcd5f..00000000 --- a/lib/perl/Query.pm +++ /dev/null @@ -1,264 +0,0 @@ -# Perl module for sending queries to Sherlock search servers and parsing answers -# -# (c) 2002--2003 Martin Mares -# -# This software may be freely distributed and used according to the terms -# of the GNU Lesser General Public License. - -=head1 NAME - -Sherlock::Query -- Communication with Sherlock Search Servers - -=head1 DESCRIPTION - -This perl library offers a simple interface for connecting to Sherlock -search servers, sending queries or control commands and parsing the -results. - -First of all, you have to use - - my $conn = new Sherlock::Query('server:port'); - -to create a new connection object (unconnected yet). Then you can call - - my $res = $conn->command('command'); - -to establish the connection, send a given command to the search server -and gather the results (see below) or, if you want to send a normal query, - - my $res = $conn->query('"simple" OR "query"'); - -which does the same as C<< $conn->command(...) >>, but it also parses the -results to a representation convenient for handling in Perl programs -(again, see below). - -Currently, you can use a single connection to send only a single command or query. - -=head1 RESULTS - -The I of the search server (i.e., the lines it has returned) is always -available as C<< $conn->{RAW} >> as a list of strings, each representing a single -line. - -Parsed results of queries are stored in a more complicated way, but before -explaining it, let's mention a couple of axioms: Any search server I -(header, footer, a single document of answer) is always stored as a hash keyed -by attribute names. Ordinary single-valued attributes are stored as strings, -multi-valued attributes as (references to) arrays of strings. When an object -contains sub-objects, they are stored as references to other hashes, possibly -encapsulated within a list if there can be multiple such objects. Most objects -have an extra attribute C containing the original description of the -object, a sub-list of C<< $conn->{RAW} >>. - -The parsed answer consists of three parts (please follow F to -get a better picture of what does the server answer): header C<< $conn->{HEADER} >> -(an object, as described above), footer C<< $conn->{FOOTER} >> (object) and document -cards C<< $conn->{CARDS} >> (a list of objects). - -The I
contains all the standard header attributes and also C<< $hdr->{D} >> -which is a list of sub-objects, each corresponding to a single database and -containing per-database attributes like C (word list). - -The I