Detailed metadata for $nFile

#!@PERL@ #---------------------------------------------------------------------- # displaySOIF - 20020218 beta version :) # # Take a SOIF file and print it # # (c) 2002 RedIRIS. The author may be contacted by the email # address: javier.masa @ rediris.es # # You can use, distribute and/or modifie this file under the # terms of the GNU General Public License as published by # the Free Software Foundation (http://www.fsf.org/copyleft/gpl.html). # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. #---------------------------------------------------------------------- use IO::File; use Socket; $prefixDir = "@prefix@"; $regFile = '^\@FILE { (.+)$'; $regLine = '(.*){(.+)}:\s*'; &ReadParse; $rFile = "$in{'object'}"; $rFile =~ s/\/Harvest/$prefixDir/; $searchText = $in{'query'}; print &Cabecera; #select STDERR ; $| = 1; #select STDOUT ; $| = 1; #--- We download the SOIF page using standard libraries # open FILE,"<$rFile"; $body = join "", ; close FILE; =We don't use this yet $sock = new IO::File; $rWebServer= $ENV{'SERVER_NAME'}; $rPort= $ENV{'SERVER_PORT'}; $rPage= $in{'object'}; $oldAlarmHandler = $SIG{'ALRM'} || 'DEFAULT'; $SIG{'ALRM'} = sub { $SIG{'ALRM'}=$oldAlarmHandler; print "ERR-ERR-2\n"; exit; }; alarm(9); $a=&connect($rWebServer, $rPort); if (defined $a) { alarm(0); $SIG{'ALRM'}=$oldAlarmHandler; print "ERR-ERR-1\n"; exit; } &_sock_write($sock, "GET $rPage HTTP/1.0\nHost: $rWebServer\n\n"); while (($line=<$sock>) && ($line ne "\r\n")) { # print "

$line"; } $body = join "", <$sock>; &disconnect(); alarm(0); $SIG{'ALRM'}=$oldAlarmHandler; =cut @a = ($body =~ /$regFile/comig); $nFile = $a[0]; $len = length("\@FILE { ")+length($nFile); if ("$in{'style'}" ne "plain") { print_formatted (); } else { print_plain (); } print_footer (); exit; sub print_formatted { #--- We print the header # print << "HEADER"; Detailed metadata for $nFile

Detailed metadata for
$nFile HEADER #--- Searched text # print "

Searched text

\n"; $searchText =~ s/ AND | OR | NOT / /g; #--- If $searchText is like: aceite AND toxico # If $searchText is like: guerra AND civil OR ( "url" : "hispanianova\.rediris\.es" ) $searchText =~ s/$|$|:|"//g; $searchText =~ s/[ ]+/ /g; @colorQuery = split / /, $searchText; #--- We need to order elements in searched text in reverse lenght order # to avoid problems in coloring texts like "de" and "index" @colorQuery = sort bylength @colorQuery; print "Search terms are colored in order to ease their identification in the text. Click on one of these elements to directly access its first occurrence in the document.

"; print " "; for ($xx=0; $xx<= $#colorQuery; $xx++) { print " $colorQuery[$xx] "; } #--- We add key and lenght # update-time{10} .... # @b = ($body =~ /$regLine/comig); $i = "1"; foreach $m (@b) { if ($i eq "1") { $tagName=$m; $i="0"; } else { $aux{$tagName}=$m; $i="1"; } $x++; } #--- Print Meta-tags index in 3 columns # print "\n\n\n"; print "

Meta-tags index

\n"; print "

\n"; print "\n\n\n\n\n\n

\n"; $x = 0; $numElem = keys %aux; foreach $key (sort keys %aux) { print "

\n" if ($x == int($numElem/3)+1); print "

\n" if ($x == int($numElem*2/3)+1); if ($key eq "") { #--- No tag name print "

ż?\n"; } else { print "

$key\n"; } $x++; } print "

\n"; print "

\n"; $i = "1"; foreach $m (@b) { if ($i eq "1") { $tagName=$m; $len = $len + length($m) +1; $i = "0"; } else { $len = $len + length($m) + 4 ; $cadena = substr ($body, $len, $m); #--- Color search text # # Hay que tener en cuenta que si se busca "de" "indexada" no se # coloreará bien "indexada" ya que la cadena "de" que contiene # se coloreará en su lugar. # $cadena =~ s/($searchText)/$1<\/b><\/font>/ig; # @colorQuery = split / /, $searchText; # @colorQuery = sort bylength @colorQuery; $cadena =~ s///ig; #--- Para que no nos putee el código HTML for ($xx=0; $xx<= $#colorQuery; $xx++) { $cadena =~ s/$colorQuery[$xx]/<\/a> $colorQuery[$xx] <\/b><\/span>/ig; } $cadena =~ s/\r//ig; $cadena =~ s/\n/
/ig; $cadena =~ s/

/\n
/ig; $cadena =~ s/
\|//ig; $aux{$tagName}=$cadena; $len = $len + $m; $i = "1"; } } #--- Metadata print # print "\n\n\n"; print "
Indexed data
\n"; foreach $key (sort keys %aux) { $txt = $key; $txt = "no_name" if ($key eq ""); print "\n
\n"; print "
$txt\n"; print "
\n"; print "$aux{$key}\n"; print "
\n"; } } sub print_plain { print "\n\nSOIF Object for: $nFile\n\n\n"; print "
SOIF Object for: $nFile
\n"; print "
\n"; print $body; print "
\n"; } sub print_footer { my $referer = "$ENV{'HTTP_REFERER'}"; if ($referer ne '') { print "Back\n"; } print "\n\n"; } #---------------------------------------------------------------------- # #---------------------------------------------------------------------- sub bylength { length($b) <=> length($a) } #---------------------------------------------------------------------- # ReadParse #---------------------------------------------------------------------- sub ReadParse { if ($ENV{'REQUEST_METHOD'} eq "GET") { $in = $ENV{'QUERY_STRING'}; } elsif ($ENV{'REQUEST_METHOD'} eq "POST") { for ($i = 0; $i < $ENV{'CONTENT_LENGTH'}; $i++) { $in .= getc; } } @in = split (/&/, $in); foreach $i (0 .. $#in) { $in[$i] =~ s/\+/ /g; $in[$i] =~ s/%(..)/pack("c", hex ($1))/ge; $loc = index ($in[$i], "="); $key = substr ($in[$i], 0, $loc); $val = substr ($in[$i], $loc + 1); $in{$key} .= '\0' if (defined ($in{$key})); $in{$key} .= $val; } } #---------------------------------------------------------------------- # Cabecera #---------------------------------------------------------------------- sub Cabecera { return "Content-type: text/html\n\n"; } #---------------------------------------------------------------------- # connect #---------------------------------------------------------------------- sub connect { my $host = $_[0]; my $rPort = $_[1]; my ($iaddr, $paddr, $proto); if ($host eq "") { return "no host defined"; } if (!defined ($iaddr = inet_aton ($host))) { return "could not resolve host"; } if (!defined ($paddr = sockaddr_in ($rPort, $iaddr))) { return "could not generate sockaddr"; } if (!defined ($proto = getprotobyname ('tcp'))) { return "could not getprotobyname for tcp"; } if (!defined socket ($sock, PF_INET, SOCK_STREAM, $proto)) { return "socket failed, $!"; } if (!defined connect ($sock, $paddr)) { return "connect failed, $!"; } return undef; } #---------------------------------------------------------------------- # disconnect #---------------------------------------------------------------------- sub disconnect { if (!defined close ($sock)) { return "could not close: $!"; } return undef; } #---------------------------------------------------------------------- # _sock_write #---------------------------------------------------------------------- sub _sock_write { my ($sock, $buf) = @_; my ($nleft, $nwritten); $nleft = length ($buf); while ($nleft) { $nwritten = syswrite ($sock, $buf, $nleft); return undef if (!defined ($nwritten)); $nleft -= $nwritten; substr ($buf, 0, $nwritten) = ""; } } #---------------------------------------------------------------------- # _sock_readline #---------------------------------------------------------------------- sub _sock_readline { my ($sock) = @_; my $l = <$sock>; return $l; } #---------------------------------------------------------------------- # End #----------------------------------------------------------------------