8 my $d = new HTTP::Daemon LocalPort => 8084;
9 print "Please contact me at: <URL:", $d->url, ">\n";
11 $SIG{CHLD} = "IGNORE"; # do not accumulate defunct processes
18 #NOT REENTRANT: CAN NOT FORK DUE TO THE GLOBAL VARIABLES %uri_sets & ...
19 #HENCE, THE "PID" ARGUMENT OF EVERY REQUEST MUST IDENTIFY THE SET OF URI
20 #IT WANTS TO WORK WITH. MOREOVER, EVERY CLIENT MUST WORK WITH A DIFFERENT SET
21 #OF URI, I.E. EVERY PID MUST BE UNIQUE.
23 #CSC: WHAT IF THE CLIENTS ARE ON DIFFERENT MACHINES AND HAVE THE SAME PID?
25 while (my $c = $d->accept) {
26 while (my $r = $c->get_request) {
27 if ($r->method eq 'GET' and $r->url->path eq '/add_if_not_in') {
28 my $http_query = $r->url->equery;
29 my $cgi = new CGI("$http_query");
30 my $uri = $cgi->param('uri');
31 my $pid = $cgi->param('PID');
33 print(@{$uri_queues{$pid}} + 0);
35 my $tot = keys(%{$uri_sets{$pid}}) + 0;
36 $tot .= "*" if defined($overflowed{$pid});
40 if (!(defined($uri_sets{$pid}->{$uri}))) {
41 if ($tot + 1 > $size{$pid}) {
42 $res = "not_added_because_already_too_many";
43 $overflowed{$pid} = 1;
45 $uri_sets{$pid}->{$uri} = 1;
46 push @{$uri_queues{$pid}},$uri;
54 my $response = new HTTP::Response;
55 $response->content("<?xml version=\"1.0\"?>\n<$res/>\n");
56 $response->content_type('text/xml');
57 $c->send_response($response);
58 } elsif ($r->method eq 'GET' and $r->url->path eq '/is_overflowed') {
59 my $http_query = $r->url->equery;
60 my $cgi = new CGI("$http_query");
61 my $pid = $cgi->param('PID');
63 print(@{$uri_queues{$pid}} + 0);
65 print(keys(%{$uri_sets{$pid}}) + 0);
66 print "*" if defined($overflowed{$pid});
67 my $res = defined($overflowed{$pid}) ? "true" : "false";
68 print " is_overflowed: $res\n";
69 my $response = new HTTP::Response;
70 $response->content("<?xml version=\"1.0\"?>\n<$res/>\n");
71 $response->content_type('text/xml');
72 $c->send_response($response);
73 } elsif ($r->method eq 'GET' and $r->url->path eq '/set_uri_set_size') {
74 my $http_query = $r->url->equery;
75 my $cgi = new CGI("$http_query");
76 my $pid = $cgi->param('PID');
77 my $size = $cgi->param('size');
78 print "$pid: size := $size\n";
80 my $response = new HTTP::Response;
81 $response->content("<?xml version=\"1.0\"?>\n<done/>\n");
82 $response->content_type('text/xml');
83 $c->send_response($response);
84 } elsif ($r->method eq 'GET' and $r->url->path eq '/get_next') {
85 my $http_query = $r->url->equery;
86 my $cgi = new CGI("$http_query");
87 my $pid = $cgi->param('PID');
89 print(@{$uri_queues{$pid}} + 0);
91 print(keys(%{$uri_sets{$pid}}) + 0);
92 print "*" if defined($overflowed{$pid});
95 my $elem = shift @{$uri_queues{$pid}};
96 my $mark = $overflowed{$pid};
98 my $response = new HTTP::Response;
99 my $xml_header = "<?xml version=\"1.0\"?>\n";
100 if (!defined($elem)) {
101 print "is now empty\n";
102 $response->content("$xml_header<empty/>\n");
103 } elsif ($mark == 1) {
104 print "$elem (marked) removed\n";
105 $response->content("$xml_header<marked_uri value=\"$elem\"/>\n");
107 print "$elem removed\n";
108 $response->content("$xml_header<uri value=\"$elem\"/>\n");
110 $response->content_type('text/xml');
111 $c->send_response($response);
112 } elsif ($r->method eq 'GET' and $r->url->path eq '/reset_to_empty') {
113 my $pid = $r->url->query;
115 # Next loop for debugging purposes only
117 while (my $e = shift @{$uri_queues{$pid}}) {
118 print "#$count $e forced out of the set\n";
121 print "************\nThe URI set $pid is now empty again\n";
122 delete($uri_sets{$pid});
123 delete($overflowed{$pid});
125 my $response = new HTTP::Response;
126 $response->content("<?xml version=\"1.0\"?>\n<done/>\n");
127 $response->content_type('text/xml');
128 $c->send_response($response);
130 $c->send_error(RC_FORBIDDEN)