#!/usr/local/bin/perl



#

# PLweb.pm

# by Paul Lindner <lindner@itu.int>

# Copyright (C) 1997 by the UN Administrative Committee on Coordination (ACC)

#



package WWW::Search::PLweb;



=head1 NAME



WWW::Search::PLweb - class for searching PLS PLweb search engine



=head1 SYNOPSIS



    require WWW::Search;

    $search = new WWW::Search('PLweb');



=head1 DESCRIPTION



This class is a PLweb specialization of WWW::Search.

It queries and interprets searches based on PLweb, by PLS 

F<http://www.pls.com/>.



This class exports no public interface; all interaction should be

done through WWW::Search objects.



This software assumes that you're using the default output format for

a PLweb search.  It should look like this:



  VAL DOCUMENT DB SIZE

  ------------------------------------------------------------------

  388 Document1 foo 1122 ...



=head1 OPTIONS



This search supports standard WWW::Search arguments



=over 8



=item search_url



The PLweb URL to search.  On unix this usually looks like 

http://somehost/cgi-bin/iopcode.pl



=item search_args



The arguments used for the search engine, separate them by &.



=back



=head1 SEE ALSO



To make new back-ends, see L<WWW::Search>,



=head1 AUTHOR



C<WWW::Search::PLweb> is written by Paul Lindner, <lindner@itu.int>



=head1 BUGS



Things not supported: $result->raw()



=head1 COPYRIGHT



Copyright (c) 1997, 98 by the United Nations Administrative Committee 

on Coordination (ACC)



All rights reserved.



=cut

#'



use strict;

use vars qw(@EXPORT @EXPORT_OK @ISA $debug);



require Exporter;

@EXPORT = qw();

@EXPORT_OK = qw();

@ISA = qw(WWW::Search Exporter);



use Carp ();

require WWW::SearchResult;



my($debug) = 0;



#private

sub native_setup_search {

    my($self, $native_query, $native_opt) = @_;

    my($native_url);

    my($default_native_url) = 

	"http://www.un.org/plweb-cgi/iopcode.pl?platmode=unix&operation=query&dbgroup=un&account=_free_user_&waittime=30 seconds&dbname=gopher:webdepts:webnews&query=%s";

    

    if (defined($native_opt)) {

	$debug = 1 if ($native_opt->{'search_debug'});



	if ($self->{'search_url'} && $native_opt->{'search_args'}) {

	    $native_url = $native_opt->{'search_url'} . "?" . $native_opt->{'search_args'};

	}

    } 



    $native_url = $default_native_url if (!$native_url);



    ## Change behaviour depending on 'search_how'

    my $how = $self->{'search_how'};

    if (defined $how) {

	if ($how =~ /any/) {

	    ## change separator to or, or add it..

	    $native_url =~ s/separator=[^&]+/separator=or/ig;

	    if ($native_url !~ /separator=/) {

		$native_url .= "&separator=or";

	    }

	    

	} elsif ($how =~ /all/) {

	    ## change separator to and, or add it..

	    $native_url =~ s/separator=[^&]+/separator=and/ig;

	    if ($native_url !~ /separator=/) {

		$native_url .= "&separator=and";

	    }

	} elsif ($how =~ /phrase/) {

	    ## change separator to adj, or add it..

	    $native_url =~ s/separator=[^&]+/separator=adj/ig;

	    if ($native_url !~ /separator=/) {

		$native_url .= "&separator=adj";

	    }

	} elsif ($how =~ /boolean/) {

	    ## Get rid of the separator

	    $native_url =~ s/separator=[^&]+//ig;

	}	    

    }

    $native_url =~ s/%s/$native_query/g; # Substitute search terms...



    $self->user_agent();

    $self->{_next_to_retrieve} = 0;

    $self->{_base_url} = $self->{_next_url} = $native_url;

}





# private

sub native_retrieve_some

{

    my ($self) = @_;

    my ($hit)  = ();

    my ($hits_found) = 0;



    # fast exit if already done

    return undef if (!defined($self->{_next_url}));



    # get some

    print  $self->{_next_url} . "\n" if ($debug);

    my $method = $self->{'search_method'};

    $method = 'POST' unless $method;



    my($response) = $self->http_request($method, $self->{_next_url}); 



    if (!$response->is_success) {

	print "Some problem\n" if ($debug);

	return undef;

    };



    print "Got something...\n" if ($debug);

    # parse the output

    use HTML::TreeBuilder;





    my $score = 800;

    my $results = $response->content();

    #print "$results" if ($debug);

    if (!$results) {

	return(undef);

    }

    

    my (@lines) = $self->split_lines($results);

    my ($docs_found);

    my ($score_ratio) = 0;



    while ($#lines > -1)  {

	$_ = shift(@lines);

	s,\s+, ,g;

	if (m,(\d+) documents found,) {

	    $docs_found = $1;

	} elsif (m,^\s*(\d+) <A HREF=\"([^\"]+)\">(.*)</A>.*\s(\d+).*$,) {

	    if (($1 > 0) && ($score_ratio == 0)) {

		if ($1 > 900) {

		    $score_ratio = 1000/$1;

		} else {

		    $score_ratio = (1000/$1) * .9;

		}

	    }	    	    

	    #print "Make abs, " . $self->{_next_url} . "\n  for $2\n";

	    my($linkobj) = new URI::URL $2, $self->{_next_url};

	    my($hit) = new WWW::SearchResult;

	    $hit->add_url($linkobj->abs->as_string);

	    $hit->title($3);

	    $hit->size($4);

	    #print "Found a link $1, $2, $3, $4\n";

	    $hit->score($1 * $score_ratio);

	    push(@{$self->{cache}}, $hit);

	}

    }

    $self->approximate_result_count($docs_found);

    $self->{_next_url} = undef;

    return($docs_found);



    my($h) = new HTML::TreeBuilder;

    $h->parse($results);



    for (@{ $h->extract_links(qw(a)) }) {

	my($link, $linkelem) = @$_;

	

      if (($linkelem->parent->starttag() =~ /<P>/) &&

	  ($linkelem->parent->endtag()   =~ m,</P>,)) {



	    my($linkobj)       = new URI::URL $link, $self->{_next_url};



	    $hits_found++;



	    my($hit) = new WWW::SearchResult;

	    $hit->add_url($linkobj->abs->as_string());

	    $hit->title(join(' ',@{$linkelem->content}));

	    $hit->score($score);

	    $hit->normalized_score($score);



	    push(@{$self->{cache}}, $hit);

		

	    #$srchitem{'origin'} = $self->{'myurl'};

	    #$srchitem{'index'}  = $self->{'index'};



	    $score = int ($score * .95);

	}

    }

    $self->approximate_result_count($hits_found);

    $self->{_next_url} = undef;

    return($hits_found);

}







1;

