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 $drawgraphport = $ENV{'DRAW_GRAPH_PORT'} || $drawgraphport;
  14
  15 my $d = new HTTP::Daemon LocalPort => $drawgraphport
  16  or die "Error: port $drawgraphport not available.";
  17 print "Please contact me at: <URL:", $d->url, ">\n";
  18
  19 $SIG{CHLD} = "IGNORE"; # do not accumulate defunct processes
  20
  21 while (my $c = $d->accept) {
  22  if (fork() == 0) {
  23     while (my $r = $c->get_request) {
  24         if ($r->method eq 'GET' && $r->url->path eq "/draw") {
  25             my $http_query = $r->url->equery;
  26             my $cgi = new CGI("$http_query");
  27             my $url = $cgi->param('url');
  28             $url = $url.'&param.PID='.$$;
  29             print "URL: $url\n";
  30
  31             my $ua = LWP::UserAgent->new;
  32             my $request = HTTP::Request->new(GET => "$url");
  33             my $response = $ua->request($request, "prova0.$$.dot");
  34
  35             if (system("make PID=$$ > log.$$") == 0) {
  36                $c->send_file_response("prova.$$.html");
  37             } else {
  38                 $c->send_error(RC_INTERNAL_SERVER_ERROR);
  39             }
  40         } elsif ($r->method eq 'GET' && $r->url->path eq "/get_gif") {
  41             my $http_query = $r->url->equery;
  42             my $cgi = new CGI("$http_query");
  43             my $pid = $cgi->param('pid');
  44             print "Returning GIF: $pid\n";
  45             $c->send_file_response("prova.$pid.gif");
  46             system("make PID=$pid clean ; rm -f prova0.$pid.dot");
  47         } elsif ($r->method eq 'GET' && $r->url->path eq "/help"){
  48            print "Help requested!\n";
  49            my $response = new HTTP::Response;
  50            $response->content("Graph Drawer Version: ???");
  51            $c->send_response($response);
  52         } else {
  53             $c->send_error(RC_FORBIDDEN)
  54         }
  55     }
  56     $c->close;
  57     undef($c);
  58     exit;
  59  } # fork
  60 }