--- /dev/null
+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)
--- /dev/null
+#!/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).'¶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
+}
--- /dev/null
+#!/usr/bin/perl
+
+use URI::Escape;
+
+print <<EOT;
+<html>
+ <head>
+ <title>Graph</title>
+
+
+<script>
+function setParam(url,name,value)
+{
+ var urla = url.split("?");
+ var search = urla[1];
+ var args = search.split("&");
+
+ for (var i = 0 ; i < args.length ; i++) {
+ var couple = args[i].split("=");
+ if (couple[0] == name) args[i] = name + "=" + value;
+ }
+
+
+ return (urla[0] + "?" + args.join("&"));
+}
+
+function getParam0(search,name)
+{
+ var args = search.split("&");
+ var value = "???";
+
+ for (var i = 0 ; i < args.length ; i++) {
+ var couple = args[i].split("=");
+ if (couple[0] == name) value = couple[1];
+ }
+
+ if (value == "???") value = getDefaultParam(name);
+
+ return value;
+}
+
+function getParam(name)
+{
+ return getParam0(location.search.slice(1),name);
+}
+
+function getParam3(from,name)
+{
+ //var url = unescape(getParam('xmluri'));
+ //var tmp = url.split("?");
+ var tmp = from.split("?");
+
+ if (tmp.length > 1)
+ return getParam0(tmp[1],name);
+ else
+ return getDefaultParam(name);
+}
+</script>
+
+
+ </head>
+ <body bgcolor="white" onLoad="window.focus()">
+ <script>
+ var draw_graph_url =
+ location.protocol + '//' + location.host;
+ document.write('<img border="false" src="' + draw_graph_url + '/get_gif?pid=$ARGV[0]" usemap="#graphe">');
+ </script>
+ <map name="graphe">
+EOT
+
+while (<STDIN>) {
+ 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;
+# <area shape="rect" href="$url" coords="$point1x,$point2y,$point2x,$point1y">
+#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 <<EOT;
+ <script>
+ 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('<area shape="rect" href="' + url + '" coords="$point1x,$point2y,$point_1_5_x,$point1y">');
+ </script>
+EOT
+ print <<EOT;
+ <script>
+ 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('<area shape="rect" href="' + url + '" coords="$point_2_5_x,$point2y,$point_3_5_x,$point1y" target="cic">');
+ </script>
+EOT
+ print <<EOT;
+ <script>
+ 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('<area shape="rect" href="' + url + '" coords="$point_4_5_x,$point2y,$point2x,$point1y">');
+ </script>
+EOT
+}
+
+print <<EOT;
+ </map>
+ </img>
+ </body>
+</html>
+EOT
--- /dev/null
+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
--- /dev/null
+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
+;;
--- /dev/null
+#!/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:", $d->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("<?xml version=\"1.0\"?>\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 = "<?xml version=\"1.0\"?>\n";
+ if ($mark == 1) {
+ print "$elem removed\n";
+ $response->content("$xml_header<uri value=\"$elem\"/>\n");
+ } elsif ($mark == -1) {
+ print "$elem (marked) removed\n";
+ $response->content("$xml_header<marked_uri value=\"$elem\"/>\n");
+ } else {
+ print "is now empty\n";
+ $response->content("$xml_header<empty/>\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("<?xml version=\"1.0\"?>\n<done/>\n");
+ $response->content_type('text/xml');
+ $c->send_response($response);
+ } else {
+ $c->send_error(RC_FORBIDDEN)
+ }
+ }
+ $c->close;
+ undef($c);
+}
projects / helm.git / commitdiff