Menu
▾
▴
[Woc-commit] CVS: woc/cgi-bin/ssi laatste_tien.pl,NONE,1.1 topicmap.pl,NONE,1.1
|
From: Egon W. <eg...@us...> - 2002-07-29 10:53:05
|
Update of /cvsroot/woc/woc/cgi-bin/ssi
In directory usw-pr-cvs1:/tmp/cvs-serv13718/ssi
Added Files:
laatste_tien.pl topicmap.pl
Log Message:
Added some stuff.
--- NEW FILE: laatste_tien.pl ---
#!/usr/local/bin/perl -w
#
# Shows the last ten items that has been added or changed AND for which an *.shtml file
# is available.
#
# updated: 25-11-99 -> use real names instead of filenames, uses NAME Like...
# 07-04-01 -> use CODE instead of filenames
#
use strict;
use diagnostics;
print "Content-type: text/html\n\n";
my $root = "/vol/www/woc/web-docs";
my $dir = "/vol/www/woc/data/wml";
my @files = `ls -t1 $dir/*.xml`;
my $titel;
my $code;
my $i = 0;
while ( $i < 10) {
my $file = shift @files;
$file =~ s/.*?([\w|\-|\_]*).xml\n/$1/;
if (-e "$dir/$file.xml" && -r "$dir/$file.xml") {
open (FILE, "<$dir/$file.xml") || die "Error: $dir/$file.xml not found!";
$titel = "";
$code = "";
while (<FILE>) {
my $line = $_;
if ($line =~ m/ITEM.*NAME=\"(.*?)\"/i) {
$titel = $1;
}
if ($line =~ m/ITEM.*CODE=\"(.*?)\"/i) {
$code = $1;
}
}
close(FILE);
if ( $titel && -e "$root/gui/items/$code.shtml") {
$i++;
print "<a href=\"http://www-woc.sci.kun.nl/gui/items/$code.shtml\">$titel</a><br />$/";
} else {
# print "<!-- not found $code (was $titel, $file.xml) -->$/";
}
} else {
# print "<!-- cannot read/open $file -->$/";
}
}
--- NEW FILE: topicmap.pl ---
#!/usr/local/bin/perl -w
use strict;
## global vars ##
my $associations_indexfile = "../../bin/topic/associations_index";
my $xmlfiles_indexfile = "../../bin/topic/xmlfiles_index";
my $shtmlfiles_indexfile = "../../bin/topic/shtmlfiles_index";
my $wmldir = "../../data/wml";
my $verbose = ""; # False
my $debug = ""; # False
### MAIN ###
print "Content-type: text/plain\n\n\n";
my $associations_index = {()};
my $xmlfiles_index = {()};
my $shtmlfiles_index = {()};
if (@ARGV) {
while ($ARGV[0] =~ /^\-/) {
if ($ARGV[0] =~ /^\-d/i) {
$debug = "Active";
shift @ARGV;
}
if ($ARGV[0] =~ /^\-v/i) {
$verbose = "Active";
shift @ARGV;
}
}
$associations_index = &get_associations_index ($associations_indexfile);
$xmlfiles_index = &get_xmlfiles_index ($xmlfiles_indexfile);
$shtmlfiles_index = &get_shtmlfiles_index ($shtmlfiles_indexfile);
foreach my $file (@ARGV) {
&process_file ("$wmldir/$file", $associations_index, $xmlfiles_index, $shtmlfiles_index);
}
} else {
die "Usage: $0 [-v[erbose]] [-d[ebug]] <xml-files>\n";
}
### END of MAIN ###
sub get_associations_index {
my %associations_index = ();
if (open (INDEXFILE, $_[0])) {
my @indexfile = <INDEXFILE>;
foreach my $line (@indexfile) {
my ($assoc, @line) = split (/\s+/, $line);
$associations_index{$assoc} = join (" ", @line);
}
} else {
warn "The associations indexfile $_[0] cannot be read!\n";
}
return \%associations_index;
}
sub get_xmlfiles_index {
my %xmlfiles_index = ();
if (open (INDEXFILE, $_[0])) {
my @indexfile = <INDEXFILE>;
foreach my $line (@indexfile) {
my ($xmlfile, @name) = split (/\s+/, $line);
$xmlfiles_index{join (" ", @name)} = $xmlfile;
}
} else {
warn "The xmlfiles indexfile $_[0] cannot be read!\n";
}
return \%xmlfiles_index;
}
sub get_shtmlfiles_index {
my %shtmlfiles_index = ();
if (open (INDEXFILE, $_[0])) {
my @indexfile = <INDEXFILE>;
foreach my $line (@indexfile) {
my ($shtmlfile, @name) = split (/\s+/, $line);
$shtmlfiles_index{join (" ", @name)} = $shtmlfile;
}
} else {
warn "The shtmlfiles indexfile $_[0] cannot be read!\n";
}
return \%shtmlfiles_index;
}
sub process_file {
my ($file, $associations_index, $xmlfiles_index, $shtmlfiles_index) = @_;
## get topicname and associations ##
my $topicname = "";
my $associations = [];
if (open (XMLFILE, $_[0])) {
my @xmlfile = <XMLFILE>;
while (@xmlfile && $xmlfile[0] !~ /<ITEM/i) {
shift @xmlfile;
print "current line=$xmlfile[0]" if $debug;
}
$topicname = $1 if (@xmlfile && $xmlfile[0] =~ /NAME="(.+?)"/i);
while (@xmlfile) {
while (@xmlfile && $xmlfile[0] !~ /<tm:assoc\s/i) {
shift @xmlfile;
print "current line=$xmlfile[0]" if $debug && @xmlfile;
}
my $assoc = "";
if (@xmlfile && $xmlfile[0] =~ /id="(.+?)"/i) {
$assoc = $1;
print "Found association=$1\n" if $verbose;
}
shift @xmlfile if @xmlfile;
print "current line=$xmlfile[0]" if $debug && @xmlfile;
## get all associated files! ##
my @assocrl = ();
while (@xmlfile && $xmlfile[0] !~ /<\/tm:assoc>/i) {
while (@xmlfile && $xmlfile[0] !~ /<\/tm:assoc>/i && $xmlfile[0] !~ /<tm:assocrl\s/i) {
shift @xmlfile;
print "current line=$xmlfile[0]" if $debug;
}
if (@xmlfile && $xmlfile[0] =~ /xlink:href="(.+?)"/i) {
push (@assocrl, $1);
print "Found assoclink=$1\n" if $verbose;
} else {
print "No assoclink??\n" if $verbose && @xmlfile;
}
if (@xmlfile && $xmlfile[0] !~ /<\/tm:assoc>/i){
shift @xmlfile;
print "current line=$xmlfile[0]" if $debug;
}
}
if ($assoc && @assocrl) {
push (@$associations, [$assoc, \@assocrl]);
print "Pussing assoc=$assoc @assocrl\n" if $verbose;
} else {
print "Was last association\n" if $verbose && !@xmlfile;
}
}
} else {
warn "The xmlfile $_[0] cannot be read!\n";
}
## turn associations into HTML ##
my @result = ();
foreach my $assoc (@$associations) {
my $association = ($$associations_index{$$assoc[0]} || "");
print "Assoc: $association$/" if $debug;
if ($association =~ /\$.*?\$/) {
my @related_topics = @{$$assoc[1]};
my @related_files = ();
foreach my $related_topic (@related_topics) {
if (exists $$shtmlfiles_index{$related_topic}) {
push (@related_files, $$shtmlfiles_index{$related_topic});
} else {
push (@related_files, "");
}
}
$association =~ s/\$0\$/<I>$topicname<\/I>/g;
if ($association =~ /\$\*\$/) {
print "Substitute \*...$/" if $verbose;
while (@related_files) {
my $related_file = shift @related_files;
my $related_topic = shift @related_topics;
my $delim = ",";
$delim = " en" if (scalar @related_files == 1);
$delim = "" if (scalar @related_files == 0);
if ($related_file) {
# add link #
$related_file =~ s/\/vol\/www\/woc\/web-docs/\/woc/i;
$association =~ s/\$\*\$/ <A HREF=\"\/cgi-bin-woc\/topiclink\/link.pl?$related_file+$$assoc[0]\"><I>$related_topic<\/I><\/A>$delim\$\*\$/g;
} else {
# don't link #
$association =~ s/\$\*\$/ <I>$related_topic<\/I>\$\*\$/g;
}
}
print "New Assoc: $association$/" if $verbose;
}
$association =~ s/\$\*\$//g;
my $i = 1;
while ($association =~ /\$$i\$/) {
my $related_file = shift @related_files;
my $related_topic = shift @related_topics;
if ($related_file) {
# add link #
$related_file =~ s/\/vol\/www\/woc\/web-docs/\/woc/i;
$association =~ s/\$$i\$/<A HREF=\"\/cgi-bin-woc\/topiclink\/link.pl?$related_file\+$$assoc[0]\"><I>$related_topic<\/I><\/A>/g;
} else {
# don't link #
$association =~ s/\$$i\$/<I>$related_topic<\/I>/g;
}
$association =~ s/\$$i\$/<I>$topicname<\I>/g;
$i++
}
push (@result, "$association<BR />\n");
} elsif ($association) {
my @related_topics = @{$$assoc[1]};
my @related_files = ();
foreach my $related_topic (@related_topics) {
if (exists $$shtmlfiles_index{$related_topic}) {
push (@related_files, $$shtmlfiles_index{$related_topic});
} else {
push (@related_files, "");
}
}
push (@result, "<I>$topicname</I> $association");
my $related_file = shift @related_files;
my $related_topic = shift @related_topics;
if ($related_file) {
# add link #
$related_file =~ s/\/vol\/www\/woc\/web-docs/\/woc/i;
push (@result, " <A HREF=\"/cgi-bin-woc/topiclink/link.pl?$related_file\+$$assoc[0]\"><I>$related_topic</I></A>");
} else {
# don't link #
push (@result, " <I>$related_topic</I>");
}
while (@related_files) {
my $related_file = shift @related_files;
my $related_topic = shift @related_topics;
if (@related_files > 0) {
if ($related_file) {
# add link #
$related_file =~ s/\/vol\/www\/woc\/web-docs/\/woc/i;
push (@result, ", <A HREF=\"\/cgi-bin-woc\/topiclink\/link.pl?$related_file\+$$assoc[0]\"><I>$related_topic</I></A>");
} else {
# don't link #
push (@result, ", <I>$related_topic</I>");
}
} elsif (@related_files == 0) {
if ($related_file) {
# add link #
$related_file =~ s/\/vol\/www\/woc\/web-docs/\/woc/i;
push (@result, " en <A HREF=\"\/cgi-bin-woc\/topiclink\/link.pl?$related_file\+$$assoc[0]\"><I>$related_topic</I></A>");
} else {
# don't link #
push (@result, " en <I>$related_topic</I>");
}
}
}
push (@result, "<BR />\n");
}
}
foreach (@result) {
print;
}
}
|
