First release checked in

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

diff --git a/helm/graphs/tools/draw_graph.cgi b/helm/graphs/tools/draw_graph.cgi
new file mode 100755 (executable)
index 0000000..9f24c7a
--- /dev/null
+++ b/helm/graphs/tools/draw_graph.cgi
@@ -0,0 +1,52 @@
+#!/usr/bin/perl
+
+use HTTP::Daemon;
+use HTTP::Status;
+use HTTP::Request;
+use LWP::UserAgent;
+use URI::Escape;
+use CGI;
+use FindBin;
+
+chdir $FindBin::Bin; # chdir to the directory of this perl script
+
+my $d = new HTTP::Daemon LocalPort => 8083;
+print "Please contact me at: <URL:", $d->url, ">\n";
+
+$SIG{CHLD} = "IGNORE"; # do not accumulate defunct processes
+
+while (my $c = $d->accept) {
+ if (fork() == 0) {
+    while (my $r = $c->get_request) {
+        if ($r->method eq 'GET' && $r->url->path eq "/draw") {
+            my $http_query = $r->url->equery;
+            my $cgi = new CGI("$http_query");
+            my $url = $cgi->param('url');
+           $url = uri_unescape($url).'&param.PID='.$$;
+           print "URL: $url\n";
+
+            my $ua = LWP::UserAgent->new;
+            my $request = HTTP::Request->new(GET => "$url");
+            my $response = $ua->request($request, "prova0.$$.dot");
+
+           if (system("make PID=$$ > log.$$") == 0) {
+               $c->send_file_response("prova.$$.html");
+           } else {
+               $c->send_error(RC_INTERNAL_SERVER_ERROR);
+           }
+        } elsif ($r->method eq 'GET' && $r->url->path eq "/get_gif") {
+            my $http_query = $r->url->equery;
+            my $cgi = new CGI("$http_query");
+            my $pid = $cgi->param('pid');
+           print "Returning GIF: $pid\n";
+            $c->send_file_response("prova.$pid.gif");
+           system("make PID=$pid clean ; rm -f prova0.$pid.dot");
+        } else {
+            $c->send_error(RC_FORBIDDEN)
+        }
+    }
+    $c->close;
+    undef($c);
+    exit;
+ } # fork
+}