Update of /cvsroot/woc/woc/src/woc/cgi-src/tree
In directory usw-pr-cvs1:/tmp/cvs-serv23171/woc/cgi-src/tree
Added Files:
tree.pl
Log Message:
--- NEW FILE: tree.pl ---
#!/usr/local/bin/perl -w
use strict;
use diagnostics;
use LWP;
use CGI qw(:standard);
print "Content-type: text/html$/$/";
my $zoekarg = param("query");
my $repos = param("repos");
my $root = "/vol/www/woc/web-docs/";
my $dir = "/vol/www/woc/data/wml/";
my $destdir = "gui/items/";
my $baseurl = "http://www-woc.sci.kun.nl/";
if ($repos eq "iupac") {
$dir = "/vol/www/woc/web-docs/iupac/data/wml";
$destdir = "iupac/gui/items/";
$baseurl = "http://www-woc.sci.kun.nl/";
}
my %hash;
my %filenames;
my %indices;
my @files = <$dir/*.xml>;
foreach my $file (@files) {
$file =~ s/.*?([\w|\-|\_]*).xml/$1/;
if (open (OPENFILE, "<$dir/$file.xml")) {
my $itemname;
my @groupnames;
while ( <OPENFILE> ) {
if (/<ITEM.*?>/) {
/NAME=\"(.*?)\"/i;
$itemname = $1;
/CODE=\"(.*?)\"/i;
$filenames{$itemname} = $1;
/ID=\"(.*?)\"/;
my $id = $1;
$indices{$1} = $itemname;
}
if (/<GROUP.*?>(.*)<\/GROUP>/) {
push (@groupnames, $1);
# is er een groep?
# zo ja, voeg $itemname toe aan array in hash
}
}
foreach my $group (@groupnames) {
if (exists $hash{$group}) {
$hash{$group} = [@{$hash{$group}}, $itemname];
} else {
$hash{$group} = [$itemname];
}
}
print "$/";
}
#close (OPENFILE);
}
print "<html>\n";
print "<head>\n";
print " <title>Woordenboek Organische Chemie</title>\n";
print " <base href=\"$baseurl\">\n";
print " <link rel=\"stylesheet\" href=\"gui/styles/woc.css\" type=\"text/css\">\n";
print " <script src=\"gui/javascript/isframe.js\"></script>\n";
print " <script src=\"gui/javascript/location.js\"></script>\n";
print " <script>\n";
print " <!--\n";
print " setLocation(\"Zoekresultaten\");\n";
print " // -->\n";
print " </script>\n";
print "</head>\n";
print "<body class=\"main\">\n";
print " <h1>Onderwerpenboom</h1>\n<hr>\n";
if ($zoekarg =~ /^WOC/ || $zoekarg =~ /^IUPAC/) {
# get real argument
$zoekarg = $indices{$zoekarg};
}
print "<b>$zoekarg</b>\n";
printBoom(0, $zoekarg, \%hash);
print "</body>\n</html>\n";
sub printBoom {
my ($indent, $key, $boom) = @_;
print "<ul>\n";
foreach my $item (@{$$boom{$key}}) {
my $file = $filenames{$item};
if (-f "$root$destdir$file.shtml") {
print "<a href=\"$baseurl$destdir$file.shtml\">$item</a><br>\n";
} else {
print "$item<br>\n";
}
print "<!-- $file.shtml gezocht.. -->\n";
if (exists $$boom{$item} && $key ne $item) {
printBoom($indent+2,$item, $boom);
}
}
print "</ul>\n";
}
|
