package PPM::Repository::PPMServer;

use strict;
use PPM::PPD;
use PPM::Search;
use PPM::Result qw(Ok Error Warning List);
use base qw(PPM::Repository);
use vars qw($VERSION @ISA);

use Data::Dumper;

$VERSION = '3.05';

#=============================================================================
# Note: The server appears to expose this interface:
# search_ppds('archname', 'package', 'searchtag')
# fetch_ppd('package')
# fetch_summary()
# packages()
#=============================================================================

# The server-side search function only supports totally gay queries:
sub search {
    my $o = shift;
    my $target = shift;
    my $qstring = $o->mod_to_pkg(shift);
    my ($q_type, $query, $searchtag) = parse_query($qstring);
    my $casei = shift;

    my @ppds;
    if ($q_type eq 'TRADITIONAL') {
	substr($query, 0, 0) = "(?i)" if $casei;
	my $archname = $target->config_get("ARCHITECTURE")->result;
	my $data = eval {
	    $o->{client}->search_ppds($archname, $query, $searchtag)->result
	};
	if ($@) {
	    chomp $@;
	    return Error("server-side search failed: $@");
	}
	my $res = $o->parse_summary($data, $qstring);
	return $res unless $res->ok;
	@ppds = values %{$res->result};
    }
    else {
	unless ($o->{full_summary}) {
	    my $data = eval {
		$o->{client}->fetch_summary()->result
	    };
	    if ($@) {
		chomp $@;
		return Error("server-side summary fetch failed: $@");
	    }
	    $o->{full_summary} = $data;
	}
	my $res = $o->parse_summary($o->{full_summary}, 'full_summary');
	return $res unless $res->ok;
	my $compiled = PPM::PPD::Search->new($query, $casei);
	return Error($compiled->error) unless $compiled->valid;
        @ppds = $compiled->search(values %{$res->result});
    }
    $_->{is_complete} = 0 for @ppds;
    return List(@ppds);
}

sub describe {
    my $o = shift;
    my $target = shift;
    my $pkg = $o->mod_to_pkg(shift);
    my $ppd = $o->getppd($target, $pkg);
    return $ppd unless $ppd->ok;
    my $ppd_ref = PPM::PPD->new($ppd->result, $o, $pkg);
    return Ok($ppd_ref);
}

sub getppd {
    my $o = shift;
    my $target = shift;
    my $pkg = $o->mod_to_pkg(shift);
    my $ppd = eval { $o->{client}->fetch_ppd($pkg)->result };
    if ($@) {
	chomp $@;
	return Error("server-side fetch-ppd failed: $@");
    }
    elsif (not $ppd) {
	return Error("Package '$pkg' not found on server. "
		     . "Please 'search' for it first.");
    }
    Ok($ppd);
}

sub init { }
sub load_pkg { }
sub type_printable { "PPMServer 2.0" }

#=============================================================================
# This query parser decides what type of query we're getting: a traditional
# query which searches by TITLE only, or an advanced query:
#=============================================================================
sub parse_query {
    my $query = shift;
    
    # If the query is '*', return everything:
    if ($query eq '*') {
	# Although we could do this with TRADITIONAL, it's actually faster to
	# request the whole summary, and just return it directly. It's also
	# more portable: the guy at theoryx5.uwinnipeg.ca decided not to
	# implement empty searches. He must have reverse-engineered the PPM
	# Server.
	return ('ADVANCED', '');
    }
    # If there are only alphanumeric characters in it:
    if ($query =~ /^[-_A-Za-z0-9]+$/) {
	return ('TRADITIONAL', $query);
    }
    # If there's only 1 field spec: i.e. NAME=foo, or TITLE=bar
    if ($query =~ /^([A-Za-z]+)=([-_A-Za-z0-9]+)$/ && is_traditional($1)) {
	my ($f, $q) = (uc($1), $2);
	$f = 'TITLE' if $f eq 'NAME'; # Required for the server
	return ('TRADITIONAL', $q, $f);
    }
    # If there are only alphanumeric characters, plus '*' and '.' in it,
    # convert it to the same regular expression PPM::Search would use, and let
    # the server do it:
    if ($query =~ /^[-_A-Za-z0-9\*\.\?]+$/) {
	my $re = PPM::Search::glob_to_regex($query, 0);
	return ('TRADITIONAL', "$re");
    }

    # Otherwise, get the whole summary and use PPM::Search
    return ('ADVANCED', $query);
}

sub is_traditional {
    my $field = uc(shift);
    return scalar grep { $field eq $_ } qw(ABSTRACT AUTHOR TITLE NAME);
}
