From 0e27018083c7f6b690b5ce1a099cea5ae09f0216 Mon Sep 17 00:00:00 2001 From: Stefano Zacchiroli Date: Mon, 12 Nov 2001 13:46:05 +0000 Subject: [PATCH] - modified /getxslt method, now stylesheets are downloaded on the fly and may be kept on various servers - uncommented /getdtd method - removed /getstyleconf method - changed semantics of dbm variables, now ".db" suffix must be present in environment variables that reference dbm files --- helm/http_getter/http_getter.pl.in | 209 +++++++++++++++++------------ 1 file changed, 122 insertions(+), 87 deletions(-) diff --git a/helm/http_getter/http_getter.pl.in b/helm/http_getter/http_getter.pl.in index cf2052a02..48371bd27 100755 --- a/helm/http_getter/http_getter.pl.in +++ b/helm/http_getter/http_getter.pl.in @@ -30,7 +30,7 @@ my $VERSION = "@VERSION@"; # various variables my ($HELM_LIB_PATH); my $cgi_dir = "@HELM_CGI_DIR@"; -my (%map, %rdf_map); +my (%xml_map, %rdf_map, %xslt_map); # First of all, let's load HELM configuration use Env; @@ -54,12 +54,18 @@ if (($cachemode ne 'gzipped') and ($cachemode ne 'normal')) { die "Invalid HTTP_GETTER_CACHE_MODE environment variable, must be". "'normal' or 'gzipped'\n"; } + my $helm_rdf_dir = $ENV{'HTTP_GETTER_RDF_DIR'} || - "/usr/local/helm/rdf_library"; + "/usr/local/helm/rdf_library"; my $rdf_dbm = $ENV{'HTTP_GETTER_RDF_DBM'} || - "/usr/local/helm/rdf_urls_of_uris"; + "/usr/local/helm/rdf_urls_of_uris.db"; +my $xslt_dbm = $ENV{'HTTP_GETTER_XSLT_DBM'} || + "/usr/local/helm/xslt_urls_of_uris.db"; my $rdf_indexname = $ENV{'HTTP_GETTER_RDF_INDEXNAME'} || - "rdf_index.txt"; + "rdf_index.txt"; +my $xslt_indexname = $ENV{'HTTP_GETTER_XSLT_INDEXNAME'} || + "xslt_index.txt"; + # # Let's override the configuration file @@ -73,6 +79,7 @@ use LWP::UserAgent; use DB_File; use Compress::Zlib; use CGI; +use URI; use URI::Escape; #CSC: mancano i controlli sulle condizioni di errore di molte funzioni @@ -91,8 +98,9 @@ $myownurl =~ s/http:\/\/(.*):(.*)/$1/; ($myownurl) = gethostbyname($myownurl); $myownurl = "http://".$myownurl.":".$myownport; -tie(%map, 'DB_File', $uris_dbm.".db", O_RDWR, 0664); # open dbs -tie(%rdf_map, 'DB_File', $rdf_dbm.".db", O_RDWR, 0664); +tie(%xml_map, 'DB_File', $uris_dbm, O_RDWR, 0664); # open dbs +tie(%rdf_map, 'DB_File', $rdf_dbm, O_RDWR, 0664); +tie(%xslt_map, 'DB_File', $xslt_dbm, O_RDWR, 0664); print "\n"; print "HTTP Getter $VERSION\n"; # print hello information @@ -102,8 +110,8 @@ print "helm_dir: $helm_dir\n"; print "helm_rdf_dir: $helm_rdf_dir\n"; print "style_dir: $style_dir\n"; print "dtd_dir: $dtd_dir\n"; -print "urls_of_uris db: $uris_dbm.db\n"; -print "rdf db: $rdf_dbm.db\n"; +print "urls_of_uris db: $uris_dbm\n"; +print "rdf db: $rdf_dbm\n"; print "cache mode: $cachemode\n"; print "indexname: $indexname\n"; print "rdf_indexname: $rdf_indexname\n"; @@ -198,7 +206,7 @@ while (my $c = $d->accept) { } elsif ($http_method eq 'GET' and $http_path eq "/register") { my $inputurl = $cgi->param('url'); print "Register requested...\n"; - $map{$inputuri}=$inputurl; + $xml_map{$inputuri}=$inputurl; # Now let's clean the cache my $cicfilename = $inputuri; @@ -210,13 +218,13 @@ while (my $c = $d->accept) { unlink ($helm_dir.$cicfilename.".xml.gz"); kill(USR1,getppid()); # signal changes to parent - untie %map; + untie %xml_map; print "done.\n"; html_nice_answer($c,"Register done"); # "/resolve" works with rdf uri } elsif ($http_method eq 'GET' and $http_path eq "/resolve") { - #my $outputurl = $map{$inputuri}; + #my $outputurl = $xml_map{$inputuri}; my $outputurl = resolve($inputuri); $outputurl = "" if (not defined($outputurl)); $cont = "\n\n"; @@ -229,45 +237,9 @@ while (my $c = $d->accept) { } elsif ($http_method eq 'GET' and $http_path eq "/getdtd") { -# my $filename = $inputuri; -# $filename = $dtd_dir."/".$filename; -# print "DTD: $inputuri ==> ($filename)\n"; -# if (stat($filename)) { -# print "Using local copy\n"; -# open(FD, $filename) or die "Cannot open $filename\n"; -# $cont = ""; -# while() { -# # Vary bad heuristic for substituion of absolute URLs -# # for relative ones -# s/ENTITY (.*) SYSTEM\s+"/ENTITY $1 SYSTEM "$myownurl\/getdtd?uri=/g; -# $cont .= $_; -# } -# close(FD); -# answer($c,$cont,"text/xml",""); -# } else { -# die "Could not find DTD!"; -# } - - } elsif ($http_method eq 'GET' and $http_path eq "/getstyleconf") { - my $filename = $inputuri; - $filename = $style_dir."/config/".$filename; - if (stat($filename)) { - open(FD, $filename) or die "Cannot open $filename\n"; - $cont = ""; - while() { - s/DOCTYPE (.*) SYSTEM\s+"/DOCTYPE $1 SYSTEM "$myownurl\/getstyleconf?uri=/g; - $cont .= $_; - } - close(FD); - answer($c,$cont,"text/plain",""); - } else { - die "Could not find Style Configuration File!"; - } - - } elsif ($http_method eq 'GET' and $http_path eq "/getxslt") { my $filename = $inputuri; - $filename = $style_dir."/".$filename; - print "XSLT: $inputuri ==> ($filename)\n"; + $filename = $dtd_dir."/".$filename; + print "DTD: $inputuri ==> ($filename)\n"; if (stat($filename)) { print "Using local copy\n"; open(FD, $filename) or die "Cannot open $filename\n"; @@ -275,16 +247,57 @@ while (my $c = $d->accept) { while() { # Vary bad heuristic for substituion of absolute URLs # for relative ones - s/xsl:import\s+href="/xsl:import href="$myownurl\/getxslt?uri=/g ; - s/xsl:include\s+href="/xsl:include href="$myownurl\/getxslt?uri=/g ; - $cont .= $_; - } + s/ENTITY (.*) SYSTEM\s+"/ENTITY $1 SYSTEM "$myownurl\/getdtd?uri=/g; + $cont .= $_; + } close(FD); answer($c,$cont,"text/xml",""); } else { - die "Could not find XSLT!"; + die "Could not find DTD!"; } + } elsif ($http_method eq 'GET' and $http_path eq "/getxslt") { + + print "Downloading XSLT ...\n"; + helm_wget($tmp_dir, $inputuri); + print "XSLT downloaded!\n"; + $inputuri =~ s/.*\///; + my $filename = $tmp_dir . "/" . $inputuri; + my $cont; + die "Could not find XSLT!\n" unless stat($filename); + open(FD, $filename) or die "Can't open xslt local copy: '$filename'\n"; + while() { + s/xsl:import\s+href="/xsl:import href="$myownurl\/getxslt?uri=/g; + s/xsl:include\s+href="/xsl:include href="$myownurl\/getxslt?uri=/g; + $cont =. $_; + } + close(FD); + answer($c, $cont, "text/xml", ""); + unlink $filename or + print "Can't unlink XSLT temp file '$filename'"; + +# +# my $filename = $inputuri; +# $filename = $style_dir."/".$filename; +# print "XSLT: $inputuri ==> ($filename)\n"; +# if (stat($filename)) { +# print "Using local copy\n"; +# open(FD, $filename) or die "Cannot open $filename\n"; +# $cont = ""; +# while() { +# # Vary bad heuristic for substituion of absolute URLs +# # for relative ones +# s/xsl:import\s+href="/xsl:import href="$myownurl\/getxslt?uri=/g ; +# s/xsl:include\s+href="/xsl:include href="$myownurl\/getxslt?uri=/g ; +# $cont .= $_; +# } +# close(FD); +# answer($c,$cont,"text/xml",""); +# } else { +# die "Could not find XSLT!"; +# } +# + # "/update" works with rdf uri } elsif ($http_method eq 'GET' and $http_path eq "/update") { # rebuild urls_of_uris db and rdf uris db @@ -419,8 +432,8 @@ sub resolve { # resolve an uri in a url, work both with standard cic: or theory: return ($rdf_map{$uri}); } else { # standard cic: or theory: uri, resolve using std uri db print "IS NOT A RDF URI\n"; - print "I WILL RETURN '$map{$uri}'\n"; - return ($map{$uri}); + print "I WILL RETURN '$xml_map{$uri}'\n"; + return ($xml_map{$uri}); } } @@ -437,7 +450,7 @@ sub finduris { # find uris for cic and theory trees generation if (($uritype eq "cic") or ($uritype eq "theory")) { # get info only of one type: cic or theory - foreach (keys(%map)) { # select matching uris + foreach (keys(%xml_map)) { # select matching uris $uri = $_; if ($uri =~ /^$uritype:$uripattern(\/|$|\.)/) { if ($uri =~ /^$uritype:$uripattern\//) { # directory match @@ -574,12 +587,6 @@ sub print_request print "\n"; } -sub callback -{ - my ($data) = @_; - $cont .= $data; -} - sub gunzip { # gunzip a file and return the deflated content my ($filename) = @_; @@ -739,9 +746,14 @@ sub html_nice_answer { answer($c,$content,"text/html",""); } +sub callback { + my ($data) = @_; + $cont .= $data; +} + sub helm_wget { -#retrieve a file from an url and write it to a temp dir -#used for retrieve resource index from servers +# retrieve a file from an url and write it to a temp dir +# used for retrieve resource index from servers $cont = ""; my ($prefix, $URL) = @_; my $ua = LWP::UserAgent->new; @@ -756,30 +768,34 @@ sub helm_wget { sub update { # retie dbs - untie %map; - tie(%map, 'DB_File', $uris_dbm.".db", O_RDWR, 0664); + untie %xml_map; + tie(%xml_map, 'DB_File', $uris_dbm, O_RDWR, 0664); untie %rdf_map; - tie(%rdf_map, 'DB_File', $rdf_dbm.".db", O_RDWR, 0664); + tie(%rdf_map, 'DB_File', $rdf_dbm, O_RDWR, 0664); + untie %xslt_map; + tie(%xslt_map, 'DB_File', $xslt_dbm, O_RDWR, 0664); } sub update_dbs { # rebuild dbs fetching resource indexes from servers. -# Rebuild urls_of_uris db (1) and rdf db (2) +# Rebuild urls_of_uris db (1), rdf db (2) and xslt db (3) my ( $server, $idxfile, $rdf_idxfile, $uri, $url, $comp, $line, @servers, - %urls_of_uris, %rdf # local proxy of $map and $rdf_map + %urls_of_uris, %rdf, %xslt # local proxy of dbs ); - untie %map; + untie %xml_map; untie %rdf_map; - foreach my $file ($uris_dbm, $rdf_dbm) { # remove old db file - if (stat $file.".db") { # remove if exists - unlink ($file.".db") or die "can't unlink old db file: $file.db\n"; + untie %xslt_map; + foreach my $file ($uris_dbm, $rdf_dbm, $xslt_dbm) { # remove old db file + if (stat $file) { # remove if exists + unlink ($file) or die "can't unlink old db file: $file\n"; } } - tie(%urls_of_uris, 'DB_File', $uris_dbm.".db", O_RDWR|O_CREAT, 0664); - tie(%rdf, 'DB_File', $rdf_dbm.".db", O_RDWR|O_CREAT, 0664); + tie(%urls_of_uris, 'DB_File', $uris_dbm, O_RDWR|O_CREAT, 0664); + tie(%rdf, 'DB_File', $rdf_dbm, O_RDWR|O_CREAT, 0664); + tie(%xslt, 'DB_File', $xslt_dbm, O_RDWR|O_CREAT, 0664); open (SRVS, "< $servers_file") or die "cannot open servers file: $servers_file\n"; @@ -791,12 +807,15 @@ sub update_dbs { chomp $server; helm_wget($tmp_dir, $server."/".$indexname); # get index helm_wget($tmp_dir, $server."/".$rdf_indexname); # get rdf index + helm_wget($tmp_dir, $server."/".$xslt_indexname); # get xslt index $idxfile = $tmp_dir."/".$indexname; $rdf_idxfile = $tmp_dir."/".$rdf_indexname; + $xslt_idxfile = $tmp_dir . "/" . $xslt_indexname; - open (INDEX, "< $idxfile") or # (1) REBUILD URLS_OF_URIS DB + # (1) REBUILD URLS_OF_URIS DB + open (INDEX, "< $idxfile") or die "cannot open temporary index file: $idxfile\n"; - while ($line = ) { # parse index and add entry to urls_of_uris db + while (my $line = ) { # parse index and add entry to urls_of_uris db chomp $line; ($uri,$comp) = split /[ \t]+/, $line; # build url: @@ -810,9 +829,10 @@ sub update_dbs { $urls_of_uris{$uri} = $url; } - open (RDF_INDEX, "< $rdf_idxfile") or # (2) REBUILD RDF DB - die "cannot open temporary rdf index file: $rdf_idxfile\n"; - while ($line = ) { # parse index and add entry to rdf db + # (2) REBUILD RDF DB + open (RDF_INDEX, "< $rdf_idxfile") or + die "cannot open temporary RDF index file: $rdf_idxfile\n"; + while (my $line = ) { # parse index and add entry to rdf db chomp $line; ($uri,$comp) = split /[ \t]+/, $line; # comp is "gz" or nothing # build url: @@ -826,19 +846,34 @@ sub update_dbs { $rdf{$uri} = $url; } + # (3) REBUILD XSLT DB + open (XSLT_INDEX, "< $xslt_idxfile") or + die "cannot open temporary XSLT index file: $xslt_idxfile\n"; + while (my $line = ) { # parse index and add entry to xslt db + chomp $line; + my $stylesheet = $line; + my $url = $server . "/" . $stylesheet; + $xslt{$stylesheet} = $url; + } + close INDEX; # close indexes close RDF_INDEX; - die "cannot unlink temporary file: $idxfile\n" # remove temp files - if (unlink $idxfile) != 1; - die "cannot unlink temporary file: $rdf_idxfile\n" - if (unlink $rdf_idxfile) != 1; + close XSLT_INDEX; + + # remove temp files + foreach my $file in ($idxfile, $rdf_idxfile, $xslt_idxfile) { + print "cannot unlink temporary file: $file\n" if (unlink $file) != 1; + } } untie(%urls_of_uris); # untie local proxies untie(%rdf); - tie(%map, 'DB_File', $uris_dbm.".db", O_RDWR, 0664); # retie global ones - tie(%rdf_map, 'DB_File', $rdf_dbm.".db", O_RDWR, 0664); + untie(%xslt); + tie(%xml_map, 'DB_File', $uris_dbm, O_RDWR, 0664); # retie global ones + tie(%rdf_map, 'DB_File', $rdf_dbm, O_RDWR, 0664); + tie(%xslt_map, 'DB_File', $xslt_dbm, O_RDWR, 0664); + } # update_dbs # vim modline: do not remove! -- 2.39.2