From e85bc43c20254aa85463748eeb95e2e60ed0ccf1 Mon Sep 17 00:00:00 2001 From: Claudio Sacerdoti Coen Date: Mon, 8 Oct 2001 12:00:27 +0000 Subject: [PATCH] First release checked in --- helm/graphs/tools/Makefile | 34 +++++ helm/graphs/tools/draw_graph.cgi | 52 +++++++ helm/graphs/tools/mk_html.pl | 140 ++++++++++++++++++ helm/graphs/tools/simplify_deps/Makefile | 12 ++ .../tools/simplify_deps/simplify_deps.ml | 97 ++++++++++++ helm/graphs/tools/uri_set_queue.cgi | 105 +++++++++++++ 6 files changed, 440 insertions(+) create mode 100644 helm/graphs/tools/Makefile create mode 100755 helm/graphs/tools/draw_graph.cgi create mode 100755 helm/graphs/tools/mk_html.pl create mode 100644 helm/graphs/tools/simplify_deps/Makefile create mode 100644 helm/graphs/tools/simplify_deps/simplify_deps.ml create mode 100755 helm/graphs/tools/uri_set_queue.cgi diff --git a/helm/graphs/tools/Makefile b/helm/graphs/tools/Makefile new file mode 100644 index 000000000..0635c4c26 --- /dev/null +++ b/helm/graphs/tools/Makefile @@ -0,0 +1,34 @@ +PID= +DOT=../gv1.7c/bin/dot +SED=sed "s/font-family:Times;//g" + +#OBJS=prova.$(PID).svg prova.$(PID).ps prova.$(PID).gif prova.$(PID).ismap prova.$(PID).imap prova.$(PID).html +OBJS=prova.$(PID).gif prova.$(PID).ismap prova.$(PID).html + +all: $(OBJS) + +prova.$(PID).dot: prova0.$(PID).dot + csplit --prefix=xx.$(PID) prova0.$(PID).dot 1 2 `expr \`wc -l prova0.$(PID).dot | sed 's/\([0123456789]\+\) prova0.$(PID).dot/\1/'\` + 1` + ./simplify_deps/simplify_deps.opt < xx.$(PID)02 > xx.$(PID)02n + cat xx.$(PID)01 xx.$(PID)02n xx.$(PID)03 > prova.$(PID).dot + +prova.$(PID).svg: prova.$(PID).dot + $(DOT) -Tsvg prova.$(PID).dot | $(SED) > prova.$(PID).svg + +prova.$(PID).ps: prova.$(PID).dot + $(DOT) -Tps prova.$(PID).dot > prova.$(PID).ps + +prova.$(PID).imap: prova.$(PID).dot + $(DOT) -Timap prova.$(PID).dot > prova.$(PID).imap + +prova.$(PID).gif: prova.$(PID).dot + $(DOT) -Tgif prova.$(PID).dot > prova.$(PID).gif + +prova.$(PID).ismap: prova.$(PID).dot + $(DOT) -Tismap prova.$(PID).dot > prova.$(PID).ismap + +prova.$(PID).html: prova.$(PID).ismap + cat xx.$(PID)00 prova.$(PID).ismap | ./mk_html.pl $(PID) > prova.$(PID).html + +clean: + rm -f $(OBJS) prova.$(PID).dot xx.$(PID)00 xx.$(PID)01 xx.$(PID)02 xx.$(PID)02n xx.$(PID)03 log.$(PID) diff --git a/helm/graphs/tools/draw_graph.cgi b/helm/graphs/tools/draw_graph.cgi new file mode 100755 index 000000000..9f24c7a07 --- /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, ">\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).'¶m.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 +} diff --git a/helm/graphs/tools/mk_html.pl b/helm/graphs/tools/mk_html.pl new file mode 100755 index 000000000..5c1daa5b8 --- /dev/null +++ b/helm/graphs/tools/mk_html.pl @@ -0,0 +1,140 @@ +#!/usr/bin/perl + +use URI::Escape; + +print < + + Graph + + + + + + + + + +EOT + +while () { + my (undef,$point1,$point2,$uri) = split; + my ($point1x,$point1y) = split /,/,$point1; + my ($point2x,$point2y) = split /,/,$point2; + $point1y = substr($point1y,0,-1); + $point2y = substr($point2y,0,-1); + $point1x = substr($point1x,1); + $point2x = substr($point2x,1); + +# Linea corretta se c'e' il menu +# print < +#EOT + +# In assenza di menu + my $point_1_5_x = $point1x + ($point2x - $point1x)/5; + my $point_2_5_x = $point1x + 2*($point2x - $point1x)/5; + my $point_3_5_x = $point1x + 3*($point2x - $point1x)/5; + my $point_4_5_x = $point1x + 4*($point2x - $point1x)/5; + print < + var iurl = unescape(getParam("url")); + var getterURL = getParam3(iurl,"param.getterURL"); + var interfaceURL = unescape(getParam3(iurl,"param.interfaceURL")); + var url = setParam(iurl,"keys","MDG"); + url = setParam(url,"xmluri", getterURL + "getxml%3Furi%3D$uri"); + url = setParam(url,"param.CICURI","$uri"); + url = setParam(url,"param.RDFURI","helm:rdf:www.cs.unibo.it/helm/rdf/rdfprova//$uri"); + var draw_graph_url = + location.protocol + '//' + location.host + location.pathname; + url = draw_graph_url + "?url=" + escape(url); + document.write(''); + +EOT + print < + var iurl = unescape(getParam("url")); + var getterURL = getParam3(iurl,"param.getterURL"); + var interfaceURL = unescape(getParam3(iurl,"param.interfaceURL")); + var url = setParam(iurl,"keys","d_c%2CC1%2CHC2%2CL"); + url = setParam(url,"xmluri", getterURL + "getxml%3Furi%3D$uri"); + url = setParam(url,"param.CICURI","$uri"); + url = setParam(url,"param.RDFURI","helm:rdf:www.cs.unibo.it/helm/rdf/rdfprova//$uri"); + url = interfaceURL + "?url=" + escape(url); + document.write(''); + +EOT + print < + var iurl = unescape(getParam("url")); + var getterURL = getParam3(iurl,"param.getterURL"); + var interfaceURL = unescape(getParam3(iurl,"param.interfaceURL")); + var url = setParam(iurl,"keys","MMG"); + url = setParam(url,"xmluri", getterURL + "getxml%3Furi%3Dhelm:rdf:www.cs.unibo.it/helm/rdf/rdfprova//$uri"); + url = setParam(url,"param.CICURI","$uri"); + url = setParam(url,"param.RDFURI","helm:rdf:www.cs.unibo.it/helm/rdf/rdfprova//$uri"); + var draw_graph_url = + location.protocol + '//' + location.host + location.pathname; + url = draw_graph_url + "?url=" + escape(url); + document.write(''); + +EOT +} + +print < + + + +EOT diff --git a/helm/graphs/tools/simplify_deps/Makefile b/helm/graphs/tools/simplify_deps/Makefile new file mode 100644 index 000000000..c56481957 --- /dev/null +++ b/helm/graphs/tools/simplify_deps/Makefile @@ -0,0 +1,12 @@ +OBJS = simplify_deps simplify_deps.opt + +all: $(OBJS) + +simplify_deps: simplify_deps.ml + ocamlc /usr/lib/ocaml/str.cma simplify_deps.ml -o simplify_deps + +simplify_deps.opt: simplify_deps.ml + ocamlopt /usr/lib/ocaml/str.cmxa simplify_deps.ml -o simplify_deps.opt + +clean: + rm -f $(OBJS) simplify_deps.cm[iox] simplify_deps.o diff --git a/helm/graphs/tools/simplify_deps/simplify_deps.ml b/helm/graphs/tools/simplify_deps/simplify_deps.ml new file mode 100644 index 000000000..c924218cb --- /dev/null +++ b/helm/graphs/tools/simplify_deps/simplify_deps.ml @@ -0,0 +1,97 @@ +type node = + Node of string * node list ref (* label, children *) + +let debug = false;; + +(************************************************) +(* SIMPLIFICATION AND PRETTY-PRINTING *) +(************************************************) + +let reachable target source_arcs = + let rec find s = + if s = target then true + else + let Node (_,arcs) = s in + List.fold_left (fun i n -> i or find n) false !arcs + in + List.fold_left + (fun i n -> + i or + (if n = target then + (* this is the arc we would like to get rid of *) + false + else + find n + ) + ) false source_arcs +;; + +let consider_arc (source,target) = + let Node (source_name,source_arcs) = source in + let Node (target_name,_) = target in + if not (reachable target !source_arcs) then + print_endline (source_name ^ " -> " ^ target_name) + else + if debug then + print_endline (source_name ^ " -> " ^ target_name ^ " [color=green];") +;; + +let simplify_deps_and_output_them = + List.iter consider_arc +;; + +(************************************************) +(* PARSING *) +(************************************************) + +let nodes = ref [];; +let arcs = ref [];; (* (source,target) *) + +let search_node s = + List.find (function Node (s',_) -> s' = s) !nodes +;; + +let parse () = + try + while true do + let line = read_line () in + if Str.string_match (Str.regexp " \([^ ]*\) -> \(.*\);") line 0 then + let source = Str.matched_group 1 line in + let target = Str.matched_group 2 line in + let tar = + try + search_node target + with + Not_found -> + let tar = Node (target,ref []) in + nodes := tar :: !nodes ; + tar + in + let sou = + try + let sou = search_node source in + let Node (_,ts) = sou in + ts := tar::!ts ; + sou + with + Not_found -> + let sou = Node (source,ref [tar]) in + nodes := sou :: !nodes ; + sou + in + arcs := (sou,tar)::!arcs + else + print_endline line + done + with + End_of_file -> () +;; + +(************************************************) +(* MAIN *) +(************************************************) + +let _ = + parse () ; + simplify_deps_and_output_them !arcs +;; diff --git a/helm/graphs/tools/uri_set_queue.cgi b/helm/graphs/tools/uri_set_queue.cgi new file mode 100755 index 000000000..4c6651528 --- /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, ">\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("\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 = "\n"; + if ($mark == 1) { + print "$elem removed\n"; + $response->content("$xml_header\n"); + } elsif ($mark == -1) { + print "$elem (marked) removed\n"; + $response->content("$xml_header\n"); + } else { + print "is now empty\n"; + $response->content("$xml_header\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("\n\n"); + $response->content_type('text/xml'); + $c->send_response($response); + } else { + $c->send_error(RC_FORBIDDEN) + } + } + $c->close; + undef($c); +} -- 2.39.2