#!/usr/bin/perl

use HTTP::Daemon;
use HTTP::Status;
use HTTP::Response;
use CGI;

my $d = new HTTP::Daemon LocalPort => 8084;
print "Please contact me at: <URL:", $d->url, ">\n";

$SIG{CHLD} = "IGNORE"; # do not accumulate defunct processes

my %uri_sets;
my %uri_queues;

#NOT REENTRANT: CAN NOT FORK DUE TO THE GLOBAL VARIABLES %uri_sets & %uri_queues
#HENCE, THE "PID" ARGUMENT OF EVERY REQUEST MUST IDENTIFY THE SET OF URI
#IT WANTS TO WORK WITH. MOREOVER, EVERY CLIENT MUST WORK WITH A DIFFERENT SET
#OF URI, I.E. EVERY PID MUST BE UNIQUE.

#CSC: WHAT IF THE CLIENTS ARE ON DIFFERENT MACHINES AND HAVE THE SAME PID?
#CSC: CGI MODULE REQUIRED TO PROCESS PARAMETERS BETTER

while (my $c = $d->accept) {
    while (my $r = $c->get_request) {
        if ($r->method eq 'GET' and $r->url->path eq '/add_if_not_in') {
            my $http_query = $r->url->equery;
            my $cgi = new CGI("$http_query");
            my $uri = $cgi->param('uri');
            my $pid = $cgi->param('PID');
	    print "$pid: ";
            print(@{$uri_queues{$pid}} + 0);
            print "/";
            my $tot = keys(%{$uri_sets{$pid}}) + 0;
	    print "$tot $uri: ";

            my $res;
	    if (!(defined($uri_sets{$pid}->{$uri}))) {
                if ($tot + 1 > 20) {
	           $uri_sets{$pid}->{$uri} = -1;
                   push @{$uri_queues{$pid}},$uri;
                   $res = "added_with_mark";
                } else {
	           $uri_sets{$pid}->{$uri} = 1;
                   push @{$uri_queues{$pid}},$uri;
		   $res = "added";
                }
            } else {
		$res = "already_in";
            }
	    print $res."\n";

	    my $response = new HTTP::Response;
            $response->content("<?xml version=\"1.0\"?>\n<$res/>\n");
	    $response->content_type('text/xml');
            $c->send_response($response);
        } elsif ($r->method eq 'GET' and $r->url->path eq '/get_next') {
            my $http_query = $r->url->equery;
            my $cgi = new CGI("$http_query");
            my $pid = $cgi->param('PID');
	    print "$pid: ";
            print(@{$uri_queues{$pid}} + 0);
            print "/";
	    print(keys(%{$uri_sets{$pid}}) + 0);
            print " ";

            my $elem = shift @{$uri_queues{$pid}};
            my $mark = $uri_sets{$pid}->{$elem};

	    my $response = new HTTP::Response;
            my $xml_header = "<?xml version=\"1.0\"?>\n";
            if ($mark == 1) {
	       print "$elem removed\n";
               $response->content("$xml_header<uri value=\"$elem\"/>\n");
            } elsif ($mark == -1) {
	       print "$elem (marked) removed\n";
               $response->content("$xml_header<marked_uri value=\"$elem\"/>\n");
            } else {
	       print "is now empty\n";
               $response->content("$xml_header<empty/>\n");
            }
	    $response->content_type('text/xml');
            $c->send_response($response);
        } elsif ($r->method eq 'GET' and $r->url->path eq '/reset_to_empty') {
	    my $pid = $r->url->query;
	    $pid =~ s/[^=]*=//;
            # Next loop for debugging purposes only
            my $count = 1;
            while (my $e = shift @{$uri_queues{$pid}}) {
             print "#$count $e forced out of the set\n";
             $count++;
            }
	    print "************\nThe URI set $pid is now empty again\n";
	    delete($uri_sets{$pid});
	    my $response = new HTTP::Response;
            $response->content("<?xml version=\"1.0\"?>\n<done/>\n");
	    $response->content_type('text/xml');
            $c->send_response($response);
        } else {
            $c->send_error(RC_FORBIDDEN)
        }
    }
    $c->close;
    undef($c);
}