First release checked in

[helm.git] / helm / graphs / tools / uri_set_queue.cgi

diff --git a/helm/graphs/tools/uri_set_queue.cgi b/helm/graphs/tools/uri_set_queue.cgi
new file mode 100755 (executable)
index 0000000..4c66515
--- /dev/null
+++ b/helm/graphs/tools/uri_set_queue.cgi
@@ -0,0 +1,105 @@
+#!/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);
+}