[Woc-commit] CVS: woc/src/woc/cgi-src/tree tree.pl,NONE,1.1

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 422-6466

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";
}