helm/graphs/tools/draw_graph.cgi

   1 #!/usr/bin/perl
   2
   3 use HTTP::Daemon;
   4 use HTTP::Status;
   5 use HTTP::Request;
   6 use LWP::UserAgent;
   7 use URI::Escape;
   8 use CGI;
   9 use FindBin;
  10
  11 chdir $FindBin::Bin; # chdir to the directory of this perl script
  12
  13 my $d = new HTTP::Daemon LocalPort => 8083;
  14 print "Please contact me at: <URL:", $d->url, ">\n";
  15
  16 $SIG{CHLD} = "IGNORE"; # do not accumulate defunct processes
  17
  18 while (my $c = $d->accept) {
  19  if (fork() == 0) {
  20     while (my $r = $c->get_request) {
  21         if ($r->method eq 'GET' && $r->url->path eq "/draw") {
  22             my $http_query = $r->url->equery;
  23             my $cgi = new CGI("$http_query");
  24             my $url = $cgi->param('url');
  25             $url = $url.'&param.PID='.$$;
  26             print "URL: $url\n";
  27
  28             my $ua = LWP::UserAgent->new;
  29             my $request = HTTP::Request->new(GET => "$url");
  30             my $response = $ua->request($request, "prova0.$$.dot");
  31
  32             if (system("make PID=$$ > log.$$") == 0) {
  33                $c->send_file_response("prova.$$.html");
  34             } else {
  35                 $c->send_error(RC_INTERNAL_SERVER_ERROR);
  36             }
  37         } elsif ($r->method eq 'GET' && $r->url->path eq "/get_gif") {
  38             my $http_query = $r->url->equery;
  39             my $cgi = new CGI("$http_query");
  40             my $pid = $cgi->param('pid');
  41             print "Returning GIF: $pid\n";
  42             $c->send_file_response("prova.$pid.gif");
  43             system("make PID=$pid clean ; rm -f prova0.$pid.dot");
  44         } elsif ($r->method eq 'GET' && $r->url->path eq "/help"){
  45            print "Help requested!\n";
  46            my $response = new HTTP::Response;
  47            $response->content("Graph Drawer Version: ???");
  48            $c->send_response($response);
  49         } else {
  50             $c->send_error(RC_FORBIDDEN)
  51         }
  52     }
  53     $c->close;
  54     undef($c);
  55     exit;
  56  } # fork
  57 }