1#!/usr/bin/env tclsh
2#$Id: UNIVERSAL.xotcl,v 1.8 2007/08/14 16:38:26 neumann Exp $
3package require XOTcl 1; namespace import -force xotcl::*
4array set opts {
5  -ssl 0 -instanceFile UNIVERSAL.rdf -cssFile UNIVERSAL.css -root . -pkgdir .}
6array set opts $argv
7
8@ @File {
9  description {
10    This is a demo of a Webserver that presents the contents of
11    an RDF source file in a friendly and easy readable manner.
12    <p>
13    The RDF file is parsed first into triples which
14    are added to the resource database RDFdb. This RDFdb used in this
15    example replaces the standard triple database of xoRDF by an
16    application specific version, which is easier to process. The triple 
17    database is the source of the Catalog, which displays a short, easy to read
18    summary of the entries. The database is used as well for the "detailed
19    view", which presents all the data of the triples through nested HTML tables. 
20    <p>
21    The demo program uses either HTTP or HTTPS (in which case you will require
22    the SSL/TLS extension of Tcl).
23  }
24}
25
26lappend auto_path $opts(-pkgdir)
27if {$opts(-ssl)} {
28  package require xotcl::actiweb::secureHtmlPlace
29  SecureHtmlPlace ::receiver -port 443 -root $opts(-root)
30} else {
31  package require xotcl::actiweb::htmlPlace
32  HtmlPlace ::receiver -port 8095 -root $opts(-root) -allowExit exit
33}
34package require xotcl::actiweb::webDocument
35
36# load RDF processing components
37package require xotcl::rdf::parser
38package require xotcl::rdf::triple
39package require xotcl::xml::printVisitor
40
41proc loadFile filename {
42  set F [open $filename r]; set c [read $F]; close $F
43  return $c
44}
45#
46# instantiate parser and parser an example text into a node tree
47#
48
49#puts stderr "parsing [loadFile $opts(-instanceFile)]"
50RDFParser R
51R parse [loadFile $opts(-instanceFile)]
52puts stderr "parsing done"
53
54#
55# load the nodetree from the parser into the triple database
56#
57#section Triples
58TripleVisitor tv -parser R
59tv proc interprete {} {
60  my instvar topNode parser
61  if {![my exists topNode]} {set topNode ${parser}::topNode1}
62  my reset
63  my interpretNodeTree $topNode
64}
65
66#### Define a simple Resource Database
67Class RDFdb -superclass RDFTripleDB
68RDFdb instproc isContainer c {
69  regexp ^[self]::rdfdoc\# $c
70}
71RDFdb instproc add {predicate subject object} {
72  set s [self]::$subject
73  if {[my info children $s] eq ""} {
74    #puts stderr "create new resource $s"
75    Resource create $s
76  }
77  $s set $predicate $object
78  next ;# for passing to RDFTripleDB (which provides e.g. prettyTriples)
79}
80RDFdb instproc reset {} {
81  foreach c [my info children] { $c destroy }
82  next
83}
84RDFdb instproc resources {} {
85  set result ""
86  foreach c [my info children] {
87    if {![my isContainer $c] && 
88	[$c istype Resource]} {lappend result $c}
89  }
90  return $result
91}
92RDFdb instproc querySubject {subject} {
93  set s [self]::$subject
94  set result ""
95  if {[my info children $s] ne ""} {
96    foreach att [lsort [$s info vars]] {
97      lappend result $att [$s set $att]
98    }
99  }
100  return $result
101}
102
103# create an Instance of the Resource Database 
104RDFdb tv::db
105
106
107
108# define Resources with its methods
109Class Resource
110Resource instproc dump {} {
111  foreach att [lsort [my info vars]] { puts stderr "\t$att = [my set $att]"  }
112}
113Resource instproc substitute {lines} {
114  set result ""
115  foreach line [split $lines \n] {
116    if {[regexp {^ *http:} $line]} {
117      set value ""
118      set o [self]
119      set line [string trim $line]
120      foreach step $line {
121	set value [$o set $step]
122	set o tv::db::$value
123      }
124      append result $value 
125    } else {
126      append result $line 
127    }
128  }
129  return $result
130}
131
132Resource instproc pretty {} {
133  set q [univ selfAction "details [namespace tail [self]]"]
134  my substitute "<b>
135  http://nm.wu-wien.ac.at/universal/rdf-lifecycle#Contribute \
136	http://nm.wu-wien.ac.at/universal/rdf-lifecycle#Entity
137</b>: <em><a href='$q'>
138  http://nm.wu-wien.ac.at/universal/rdf-general#Title 
139</a>,</em> 
140  http://nm.wu-wien.ac.at/universal/rdf-education#LearningResourceType
141, 
142  http://nm.wu-wien.ac.at/universal/rdf-education#TypicalLearningTime
143, 
144  http://nm.wu-wien.ac.at/universal/rdf-lifecycle#Contribute \
145        http://nm.wu-wien.ac.at/universal/rdf-lifecycle#Date 
146  ([my pretty-access])"
147}
148Resource instproc pretty-title {} {
149  my substitute "http://nm.wu-wien.ac.at/universal/rdf-general#Title"
150}
151Resource instproc pretty-access {} {
152  set tech http://nm.wu-wien.ac.at/universal/rdf-technical
153  set format [my substitute "$tech#Format"]
154  set location [my substitute "$tech#Location"]
155  if {$format eq "text/html"} {
156    set label "go" } else {
157    set label "Download [my substitute $tech#Size] bytes"
158  }
159  return "<A HREF='$location'>$label</A>"
160}
161
162
163
164### Definition of the Learning Resource Manager:
165Class LrManager -superclass WebDocument -parameter {
166  {defaultUrl http://nm.wu-wien.ac.at/Lehre/oo2/}
167}
168LrManager instproc html-title {t} {
169  my contentType text/html
170  return "<html><head><title>$t</title>\n<LINK REL='stylesheet' 
171	HREF='/$::opts(-cssFile)'></head>\n"
172}
173LrManager instproc html-head {t} {
174  return "<body><h2>$t</h2>\n"
175}
176
177LrManager instproc details {subject} {
178  set result [my html-title "Details about a Learning Resource"]
179  append result [my html-head "Details about the Learning Resource<br><em>'[::tv::db::$subject pretty-title]'</em>"]
180  #append result "The subject: '$subject' has the following properties:<p>\n"
181  append result [my attributeTable $subject outer] "</body></html>"
182}
183
184LrManager instproc attributeTable {subject cls} {
185  set result ""
186  set lastns ""
187  foreach {attr value} [tv::db querySubject $subject] {
188    if {[tv::db isContainer $value]} {
189      #set q [univ selfAction "details $value"]; set value "<A href='$q'>$value</A>"
190      set value [my attributeTable $value inner]
191    }
192    regexp {^(.*)\#(.*)$} $attr _ ns property
193    if {$ns != $lastns} {
194      if {$lastns ne ""} { append result </table><p>\n }
195      append result "<B class='$cls'>Attributes from namespace $ns:</B>\n<table border='1'>\n"
196      set lastns $ns
197    }
198    append result <tr> \
199        "<td><em>$property</em></td>" \
200        "<td>$value</td>" </tr>\n
201  }
202  append result "</table>\n"
203}
204
205
206LrManager instproc catalog {} {
207  set result [my html-title "Universal Resources"]
208  append result [my html-head "Local Learning Resources:"] <UL>\n
209  foreach r [lsort [tv::db resources]] {
210    append result "<LI>[$r pretty]<p></LI>\n"
211  }
212  return $result</UL></BODY></HTML>
213}
214
215LrManager instproc source {file} {
216  my contentType text/plain
217  return [loadFile $file]
218}
219
220LrManager instproc nav {} {
221  set right   [my selfAction "catalog"]
222  set result  [my html-title "Universal Navigation Bar"]
223  set rdfsrc  [my selfAction "source $::opts(-instanceFile)"]
224  set csssrc  [my selfAction "source $::opts(-root)/$::opts(-cssFile)"]
225  set src     [my selfAction "source [info script]"]
226  append result <BODY>\n \
227       "<IMG SRC= 'UNIVERSAL.jpg' align='center'  alt='UNIVERSAL HOME' border='0'> \n\
228      <p> <a href='$right' target='Rechts'>All local Resources</a></p>
229      <p> Search for Title</p>
230      <p> Search for Authors</p>
231	<hr>Internal Use only:
232      <p> <a href='$rdfsrc' target='Rechts'>XML:RDF Source</a></p> 
233      <p> <a href='$csssrc' target='Rechts'>CSS Source</a></p>
234      <p> <a href='$src' target='Rechts'>Source of Meta-Data Application Server</a></p>" 
235}
236
237LrManager instproc default {} {
238  set right  [my selfAction "catalog"]
239  set nav    [my selfAction "nav"]
240  set result [my html-title "Universal"]
241  append result "<frameset framespacing='0' border='false' frameborder='0' cols='200,*'>
242  <frame name='Links'  src='$nav'>
243  <frame name='Rechts' src='$right'  scrolling='auto'>
244  <noframes>
245  <body>\n\<h2>Query UNIVERSAL database for Resource:</h2>\n\
246  </noframes>
247</frameset>"
248}
249
250LrManager instproc init args {
251  next
252  ::receiver exportObjs [self]             ;# export object
253  my exportProcs details catalog nav source  ;# export methods
254}
255
256
257# create an instance of the Learning Resource manager
258LrManager univ
259receiver proc default {} {univ default}  ;# call it like index.html as default
260
261# Invoke Tiple Visitor to feed the database
262tv interprete
263#puts stderr [tv::db prettyTriples]
264
265
266receiver startEventLoop   ;# Start event loop
267
268