# $Id: s.RDFTriple.xotcl 1.25 01/03/23 21:55:32+01:00 neumann@somewhere.wu-wien.ac.at $
package provide xotcl::rdf::triple 0.9

package require xotcl::rdf::parser

Class RDFTriple -parameter {
  predicate
  subject
  object
}

RDFTriple instproc dump {} {
  #set o [[self] object]; if {[info command $o] != ""} { $o showVars  }
  #return "P: [[self] predicate] S: [[self] subject] O: [[self] object]\n"
  return "[[self] subject] -[[self] predicate]-> '[[self] object]'\n"
}

Class NodeInfo -parameter {
  lastCurrentNode
  {aboutEach 0}
  {aboutEachPrefix 0}
  topID
  {statements ""}
}

Class DescriptionInfo -superclass NodeInfo -parameter {
  {bagID 0}
}

Class PropertyInfo -superclass NodeInfo -parameter {
  {reify 0}
  generatedParentID
}

Class AboutEachMgr

AboutEachMgr instproc init args {
  [self] array set entries {}
  next
}

AboutEachMgr instproc reset {} {
  foreach c [[self] info children] {$c destroy}
  [self] init
}

AboutEachMgr instproc addEntry {name} {
  [self] set entries($name) ""
}

AboutEachMgr instproc isEntry {name} {
  [self] exists entries($name)
}

AboutEachMgr instproc addTriple {name p s o} {
  if {[[self] exists entries($name)]} {
    set r [RDFTriple create [self]::[[self] autoname name%08d]]
    $r set predicate $p
    $r set subject $s
    $r set object $o
    lappend [self]::entries($name) $r
    return $r
  }
  return ""
}

AboutEachMgr instproc getTriples {name} {
  if {[[self] exists entries($name)]} {
    [self] set entries($name)
  } else {return ""}
}

Class RDFTripleDB
RDFTripleDB instproc add {p s o} {
  #[self] showCall
  set r [RDFTriple create [self]::[[self] autoname triple%08d]]
  $r set predicate $p
  $r set subject $s
  $r set object $o
  return $r
}
RDFTripleDB instproc dump {} {
  #[self] showCall
  set r ""
  foreach fact [[self] info children] {append r [$fact dump]}
  return $r
}
RDFTripleDB instproc getTriples {} {
  # for the time being: return only children of type RDFTriple
  set ch {}
  foreach c [[self] info children] {if {[$c info class] == "::RDFTriple"} {lappend ch $c}}
  return $ch
  #[self] info children
}
RDFTripleDB instproc reset {} {
  #[self] showCall
  foreach c [[self] info children] {$c destroy}
  [self] autoname -reset triple
  #[self] showMsg "children after reset: <[[self] info children]>'"
}
# return all triples that match the subject
RDFTripleDB instproc querySubject {s} {
  #[self] showCall
  set r ""
  foreach t [[self] info children] {
    if {[string match $s [$t subject]]} {
      lappend r $t
    }
  }
  return $r
}

RDFTripleDB instproc queryPredicate {p} {
  #[self] showCall
  set r ""
  foreach t [[self] info children] {
    if {[string match $p [$t predicate]]} {
      lappend r $t
    }
  }
  return $r
}

RDFTripleDB instproc queryPredicateOnSubject {p s} {
  #[self] showCall
  foreach t [[self] querySubject $s] {
    if {[string match $p [$t predicate]]} {
      # there may be only one matching P on a S
      # return the triple
      return $t
    }
  }
  return ""
}
RDFTripleDB instproc prettyTriples {} {
  [self] instvar result
  if {[[self] exists table]} {[self] unset table}
  if {[[self] exists subjectPrinted]} {[self] unset subjectPrinted}
  set result ""

  foreach triple [lsort [[self] getTriples]] {
    set subject [$triple set subject]
    set predicate [$triple set predicate]
    set object [$triple set object]

    regexp {^http.*w3[.]org.*(\#.*)$} $predicate _ predicate
    regexp {^http.*w3[.]org.*(\#.*)$} $object _ object
    lappend [self]::table($subject) $predicate $object
  }
  foreach subject [lsort [array names [self]::table]] {
    if {![regexp {^rdfdoc\#} $subject]} { [self] prettyStatements "" $subject }
  }
  set r $result; set result ""
  foreach subject [lsort [array names [self]::table]] {
    if {![[self] exists subjectPrinted($subject)]} { 
      [self] prettyStatements "" $subject 
    }
  }
  if {$result != ""} {
    append r "\n=================== unreferenced:\n$result"
    
  }
  return $r
}
RDFTripleDB instproc prettyStatement {space subject predicate object} {
  append [self]::result "$space   [format %-35s $subject] [format %-25s $predicate] $object\n"
}
RDFTripleDB instproc prettyStatements {space subject} {
  if {![[self] exists table($subject)]} {
    append [self]::result "$space NO VALUE FOR $subject\n"
  } else {
    if {![[self] exists subjectPrinted($subject)]} {
      [self] set subjectPrinted($subject) 1
      foreach {predicate object} [[self] set table($subject)] {
	[self] prettyStatement $space $subject $predicate $object
	if {[regexp {^rdfdoc\#} $object]} {
	  [self] prettyStatements "$space  " $object
	}
      }
    }
  }
}


Class TripleVisitor -superclass NodeTreeVisitor -parameter {
  {descriptionAsBag 0}
  {currentNode ""}
  parser
  rdfNS
}

TripleVisitor instproc getInfo {} {
  [self] set openNode([[self] set currentNode])
}

TripleVisitor instproc getLastInfo {info} {
  [self] set openNode([$info set lastCurrentNode])
}

TripleVisitor instproc popInfo {objName} {
  set i [[self] getInfo]
  [self] set currentNode [$i set lastCurrentNode]
  [self] unset openNode($objName)
  return $i
}

TripleVisitor instproc pushInfo {objName ei} {
  set lce [$ei set lastCurrentNode [[self] set currentNode]]
  if {$lce != ""} {
    set lastInfo [[self] set openNode($lce)]
    $ei aboutEach [$lastInfo aboutEach]
    $ei aboutEachPrefix [$lastInfo aboutEachPrefix]
  }
  [self] set openNode($objName) $ei
  [self] set currentNode $objName
}

TripleVisitor instproc qualify {obj var} {
  [$obj resolveNS] getFullName $var
}

TripleVisitor instproc init args {
  [self] array set openNode {{} {}}
  RDFTripleDB create [self]::db
  AboutEachMgr create [self]::aboutEach
  AboutEachMgr create [self]::aboutEachPrefix
  next
}

TripleVisitor instproc resetWithoutDB args {
  [self]::aboutEach reset
  [self]::aboutEachPrefix reset
  next
}

TripleVisitor instproc reset args {
  [self]::db reset
  [self] resetWithoutDB
  next
}

TripleVisitor instproc addDB {p s o} {
  #puts "ADDDB: P<$p> S<$s> O<$o>"
  set info [[self] getInfo]
  if {$info != ""} {
    set topID [$info set topID]
    if {[$info aboutEach]} {
      return [[self]::aboutEach addTriple $topID $p $s $o]
    } elseif {[$info aboutEachPrefix]} {
      return [[self]::aboutEachPrefix addTriple $topID $p $s $o]
    }
  }
  return [[self]::db add $p $s $o]
}

TripleVisitor instproc checkReification {triple node} {
  # for statements that nest inside a description/property, we remember
  # the statement to be able to reify them
  # (e.g., bag created for description)
  if {$triple != "" && $node != ""} {
    set info [set [self]::openNode($node)]
    if {[[self] isobject $info] && [$info istype NodeInfo]} {
      lappend ${info}::statements $triple
    }
  }
}

TripleVisitor instproc qualifyWithBaseURL v {
  if {[string match "\#*" $v]} {
    return [[[self] set parser] baseURL]$v
  }
  return $v
}

TripleVisitor instproc RDFTag {objName} {
  set ns [$objName resolveNS]
  set rdfNS [$ns searchNamespaceByPrefix rdf]
  if {$rdfNS == ""} {
    set rdfNS [$ns searchNamespaceByPrefix xmlns]
  }
  [self] set rdfNS $rdfNS
}
TripleVisitor instproc DescriptionNode objName {
  set di [DescriptionInfo create [self]::[[self] autoname di]]
  $di topID [[self] qualifyWithBaseURL [$objName getSubject]]
  [self] pushInfo $objName $di
  #
  # if a description nests inside a Member, we need a triple
  # for the member index (connected to the Description topId)
  #
  if {[[set member [$objName info parent]] info class] == "::RDFMember"} {
    set bag_ID [[$member info parent] set ID]
    [self] addDB [[self] qualify $objName [$member set memberIndex]] \
      $bag_ID [$di set topID] 
  }
}

TripleVisitor instproc handlePCData {objName pcdata} {
  set info [[self] getInfo]

  if {[set lcn [$info set lastCurrentNode]] == ""} {
    #puts stderr "cannot determine lastCurrentNode from $info"
    #$info showVars
    set selector ""
  } else {
    set selector [$lcn info class]
  }
  
  switch -exact $selector {
    ::RDFDescription {
      set triple [[self] addDB \
		    [[self] qualify $objName [$objName set content]] \
		    [$info set topID] $pcdata]
      [self] checkReification $triple $lcn
    }
    ::RDFProperty {
      if {[set rAttr [$lcn getRDFAttribute resource]] != ""} {
	set triple [[self] addDB \
		      [[self] qualify $objName [$objName set content]] \
		      [$lcn set $rAttr] $pcdata]
	#$lcn showVars
      } else {
	set lastInfo [[self] getLastInfo $info]
	if {[$lastInfo exists generatedParentID]} {
	  set parentID [$lastInfo set generatedParentID]
	} else {
	  set parentID [[$objName info parent] set ID]
	}
	#set parentID [$lastInfo set generatedParentID]
	set triple [[self] addDB \
		      [[self] qualify $objName [$objName set content]] \
		      $parentID $pcdata]
      }
    }
    default {
      #puts stderr "create a generatedParentID for reification"
      $info set generatedParentID [[[self] set parser] makeID]
      set triple [[self] addDB \
		      [[self] qualify $objName [$objName set content]] \
		      [$info set generatedParentID] $pcdata]
      [self] checkReification $triple [[self] set currentNode]
    }
  }
  $info set tripleWritten 1
}

TripleVisitor instproc Property objName {
  set info [PropertyInfo create [self]::[[self] autoname pi]]
  ## if we find no subject and are in Container ->
  ## reifiy over generatedParentID
  set propSubject [$objName getSubject]

  $info topID [[self] qualifyWithBaseURL $propSubject]
  [self] pushInfo $objName $info
  
  if {[$objName exists pcdata]} {
    [self] handlePCData $objName [$objName getFirstPCData]
  } 
}

TripleVisitor instproc ContainerNode objName {
  set ID [[self] qualifyWithBaseURL [$objName set ID]]
  foreach t [$objName array names rdfTypes] {
    [self] addDB [[self] qualify $objName \
		      [$objName qualifyWithRdfNsPrefix type]] $ID $t
  }
}

TripleVisitor instproc Member objName {
  set container [$objName info parent]
  set resource [$objName qualifyWithRdfNsPrefix resource]
  set parseType [$objName qualifyWithRdfNsPrefix parseType]
  if {[$objName exists pcdata]} {
    set co [$objName getFirstPCData]
  } elseif {[$objName exists attributes(resource)]} {
    set co [$objName set attributes(resource)]
  } elseif {[$objName exists attributes($resource)]} {
    set co [$objName set attributes($resource)]
  }
  #puts stderr "CONTAINER = [info exists co]"
  if {[info exists co]} {
    [self] addDB \
      [[self] qualify $container [$objName set memberIndex]] \
      [$container set ID] $co
  } else {
    #$objName showVars
  }
}

TripleVisitor instproc visit objName {
  set cl [$objName info class]
  $objName instvar attributes
  set triple ""

  #puts "********Visit $objName -- $cl"

  switch -exact $cl {
    {::RDFTag} {[self] RDFTag $objName}
    {::RDFDescription} {[self] DescriptionNode $objName}
    {::RDFProperty} {[self] Property $objName}
    {::RDFBag} - {::RDFSeq} - {::RDFAlt} {[self] ContainerNode $objName}
    {::RDFMember} {[self] Member $objName}
  }

  foreach a [array names attributes] {
    regexp "^([$objName set rdfNSPrefix]:|)(.*)" $a _ __ an
    switch -exact $an {
      bagID {
	set info [[self] getInfo]
	$info set bagID 1
      }
      aboutEach {
	set info [[self] getInfo]
	if {[DescriptionInfo info instances $info] == ""} {
	  error "AboutEach not in description"
	}
	$info aboutEach 1
	[self]::aboutEach addEntry [[self] qualifyWithBaseURL [$objName getSubject]]
      }
      aboutEachPrefix {
	set info [[self] getInfo]
	if {[DescriptionInfo info instances $info] == ""} {
	  error "AboutEachPrefix not in description"
	}
	$info aboutEachPrefix 1
	[self]::aboutEachPrefix addEntry [[self] qualifyWithBaseURL [$objName getSubject]]
      }
      resource {
	if {$cl == "::RDFProperty"} {
	  [self] handlePCData $objName [set attributes($a)]
	}
      }
    }
  }
}

TripleVisitor instproc reificate {objName p s o} {
  set memberID [[[self] set parser] makeID]
  [self] addDB [[self] qualify $objName \
		  [$objName qualifyWithRdfNsPrefix predicate]] $memberID $p
  [self] addDB [[self] qualify $objName \
		[$objName qualifyWithRdfNsPrefix subject]] $memberID $s
  [self] addDB [[self] qualify $objName \
		[$objName qualifyWithRdfNsPrefix object]] $memberID $o
  [self] addDB [[self] qualify $objName \
		[$objName qualifyWithRdfNsPrefix type]] $memberID \
    [[self] qualify $objName [$objName qualifyWithRdfNsPrefix Statement]]
  return $memberID
}

TripleVisitor instproc visitEnd objName {
  switch -exact [$objName info class] {
    {::RDFDescription} {
      set di [[self] popInfo $objName]
      if {[[self] descriptionAsBag] || [$di set bagID]} {
	set bagID [$objName set bagID]
	[self] addDB [[self] qualify $objName [$objName qualifyWithRdfNsPrefix type]] \
	  $bagID [[self] qualify $objName [$objName qualifyWithRdfNsPrefix Bag]]
	
	set bagCount 0
	
	foreach s [$di set statements] {
	  set memberID [[self] reificate $objName \
			    [$s set predicate] [$s set subject] [$s set object]]
	  [self] addDB [[self] qualify $objName \
			    [$objName qualifyWithRdfNsPrefix _[incr bagCount]]] \
	      $bagID $memberID
	}
      }
      foreach t [$objName array names rdfTypes] {
	[self] addDB [[self] qualify $objName [$objName qualifyWithRdfNsPrefix "type"]] \
	    [$objName getSubject] $t
      }
      $di destroy
    }
    {::RDFProperty} {
      set info [[self] popInfo $objName]
      if {![$info exists tripleWritten]} {
	set triple ""
	foreach fc [$objName info children] {
	  switch -exact [$fc info class] {
	    {::RDFDescription} {
	      set triple [[self] addDB \
			    [[self] qualify $objName [$objName set content]] \
			    [[self] qualifyWithBaseURL [$objName getSubject]] [$fc getSubject]]
	      break
	    }
	    {::RDFBag} - {::RDFSeq} - {::RDFAlt} {
	      set triple [[self] addDB \
			    [[self] qualify $objName [$objName set content]] \
			    [[self] qualifyWithBaseURL [$objName getSubject]] [$fc set ID]]
	      break
	    }
	  }
	}
	if {$triple != ""} {
	  [self] checkReification $triple [[self] set currentNode]
	}
      }
      $info destroy
    }
  }
}

TripleVisitor instproc evaluateAboutEach {} {
  set triplesWritten ""
  set rdfNSFullName [[[self] rdfNS] searchPrefix rdf]

  foreach entry [array names [self]::aboutEach::entries] {
    # matching entry triples should be bag types and their
    # members -> duplication of aboutEach statements for the
    # members
    foreach entryTriple [lsort [[self]::db querySubject $entry]] {
      if {[regexp "^${rdfNSFullName}_\[0-9\]*$" [$entryTriple predicate]]} {
	foreach t [[self]::aboutEach getTriples $entry] {
	  set subject [$t subject]
	  # if this is a toplevel elt of an about each tree -> its
	  # subject is the object of the container member
	  if {$subject == $entry} {
	    [self]::db add [$t predicate] [$entryTriple object] [$t object]
	  } elseif {[lsearch $triplesWritten $t] == -1} {
	    [self]::db add [$t predicate] $subject [$t object]
	    lappend triplesWritten $t
	  }
	}
      }
    }
  }
}

TripleVisitor instproc interpretNodeTree {node} {
  [self] set parser [$node set parser]
  $node accept [self]
  [self] evaluateAboutEach
}
