]> matita.cs.unibo.it Git - helm.git/blob - helm/graphs/tools/uri_set_queue.cgi
d84cdfde33f5b42b75148d325d53de9d354e7a3c
[helm.git] / helm / graphs / tools / uri_set_queue.cgi
1 #!/usr/bin/perl
2
3 use HTTP::Daemon;
4 use HTTP::Status;
5 use HTTP::Response;
6 use CGI;
7
8 my $d = new HTTP::Daemon LocalPort => 8084;
9 print "Please contact me at: <URL:", $d->url, ">\n";
10
11 $SIG{CHLD} = "IGNORE"; # do not accumulate defunct processes
12
13 my %uri_sets;
14 my %uri_queues;
15 my %overflowed;
16 my %size;
17
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.
22
23 #CSC: WHAT IF THE CLIENTS ARE ON DIFFERENT MACHINES AND HAVE THE SAME PID?
24
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');
32             print "$pid: ";
33             print(@{$uri_queues{$pid}} + 0);
34             print "/";
35             my $tot = keys(%{$uri_sets{$pid}}) + 0;
36             $tot .= "*" if defined($overflowed{$pid});
37             print "$tot $uri: ";
38
39             my $res;
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;
44                 } else {
45                    $uri_sets{$pid}->{$uri} = 1;
46                    push @{$uri_queues{$pid}},$uri;
47                    $res = "added";
48                 }
49             } else {
50                 $res = "already_in";
51             }
52             print $res."\n";
53
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');
62             print "$pid: ";
63             print(@{$uri_queues{$pid}} + 0);
64             print "/";
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";
79             $size{$pid} = $size;
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');
88             print "$pid: ";
89             print(@{$uri_queues{$pid}} + 0);
90             print "/";
91             print(keys(%{$uri_sets{$pid}}) + 0);
92             print "*" if defined($overflowed{$pid});
93             print " ";
94
95             my $elem = shift @{$uri_queues{$pid}};
96             my $mark = $overflowed{$pid};
97
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");
106             } else {
107                print "$elem removed\n";
108                $response->content("$xml_header<uri value=\"$elem\"/>\n");
109             }
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;
114             $pid =~ s/[^=]*=//;
115             # Next loop for debugging purposes only
116             my $count = 1;
117             while (my $e = shift @{$uri_queues{$pid}}) {
118              print "#$count $e forced out of the set\n";
119              $count++;
120             }
121             print "************\nThe URI set $pid is now empty again\n";
122             delete($uri_sets{$pid});
123             delete($overflowed{$pid});
124             delete($size{$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);
129         } elsif ($r->method eq 'GET' && $r->url->path eq "/help"){
130            print "Help requested!\n";
131            my $response = new HTTP::Response;
132            $response->content("URI-Set (Queue) Version: ???");
133            $c->send_response($response);
134         } else {
135             $c->send_error(RC_FORBIDDEN)
136         }
137     }
138     $c->close;
139     undef($c);
140 }