# $Id: s.WebDocument.xotcl 1.7 01/03/23 21:55:31+01:00 neumann@somewhere.wu-wien.ac.at $
package provide xotcl::awo::webDocument 0.8

package require xotcl::mos::webObject
package require xotcl::comm::httpAccess
package require xotcl::mixinStrategy
package require xotcl::mos::sendStrategy

Class WebDocument -superclass WebObject \
  -parameter {
    {content ""}
    filename
  }


WebDocument instproc init args {
  [self] exportProcs content contentType
  next
  [self] mixinStrategy Send=TypedString
}

WebDocument instproc attachFile filename {
  [self] filename $filename
  [self] set oldSendStrategy [[self] mixinStrategy Send=File]
  [self] contentType [Mime guessContentType $filename]
}

WebDocument instproc detachFile {} {
  [self] mixinStrategy [[self] set oldSendStrategy]
  unset [self]::contentType
  unset [self]::filename
}

WebDocument instproc default args {
  if {[info exists [self]::content]} {
    return [[self] content]
  }
  return ""
}
#WebDocument instproc contentLength {} {
#  [self] showCall
#  return [expr {[string length [[self] content]] + 1}]
#}


Class TextDocument -superclass WebDocument
TextDocument instproc init args {
  next
  [self] contentType text/plain
}


Class HtmlDocument -superclass TextDocument
HtmlDocument instproc init args {
  next
  [self] contentType text/html
}

Class FileDocument -superclass WebDocument

#
# class factory creates classes on the fly if they do not exist
# already, otherwise return exisiting class
#
# auch flyweigth
Class DocumentClassFactory
DocumentClassFactory abstract instproc getClass contentType

Class FileDocumentClassFactory -superclass DocumentClassFactory
FileDocumentClassFactory instproc getClass contentType {
  if {[FileDocument info classchildren $contentType] == ""} {
    Class ::FileDocument::${contentType} -superclass FileDocument
  }
  return ::FileDocument::${contentType}
}

Class DocumentFactory
DocumentFactory abstract instproc create {name args}  

Class FileDocumentFactory -superclass DocumentFactory
FileDocumentFactory instproc create {name class filename} {
  $class $name
  #$name contentType [$class set contentType]
  $name attachFile $filename
  return $name
}

Class FileObjectifier 

FileObjectifier instproc init args {
  next
  FileDocumentClassFactory [self]::clFactory
  FileDocumentFactory [self]::objFactory
}

#
# filename must be given with full path ->
# create objects with filename's tail (prefix can be used to
# give object name a preceding dir)
#
FileObjectifier instproc objectifyFile {place filename {prefix ""}} {
  set obj ""
  if {[file isfile $filename]} {
    set type [Mime guessContentType $filename]
    #if {$type != "unknown/unknown"} {
    set fn [string trimleft $prefix/[file tail $filename] /]
    set class [[self]::clFactory getClass $type]
    set obj [[self]::objFactory create $fn $class $filename]
    $place exportObjs $obj
    #puts stderr "...objectified:  $obj of class $class"
    #}
  }
  return $obj
}

#
# objectify a whole directory tree
#
FileObjectifier instproc objectifyTree {place dir {prefix ""}} {
  if {[file isdirectory $dir]} {
    foreach f [glob  -nocomplain $dir/*] {
      if {[file isfile $f]} {
	[self] objectifyFile $place $f $prefix
      } elseif {[file isdirectory $f]} {
	[self] objectifyTree $place $f $prefix/[file tail $f]
      }
    }
  }
}


Class GraphicDirectoryObjectifier -superclass FileObjectifier \
    -parameter {{thumbnaildir /tmp}}
GraphicDirectoryObjectifier instproc objectifyTree {place dir {prefix ""}} {
  if {[file isdirectory $dir]} {
    set indexpage ""
    set title ""
    set date ""
    foreach f [lsort [glob -nocomplain $dir/* $dir/{.date,.title}]] {
      set exportedfn [string trimleft $prefix/[file tail $f] /]
      if {[file isfile $f]} {
	set type [Mime guessContentType $f]
	if {[string match image/* $type]} {
	  set class [[self]::clFactory getClass $type]
	  $class $exportedfn -init -attachFile $f
	  $place exportObjs $exportedfn
	  #puts stderr "...objectified:  FN=$exportedfn cl=$class d=$dir o=$exportedfn"
	  ######
	  set expThumbnaildir [file dirname $exportedfn]/.thumbnail
	  set thumbnaildir    [file dirname $f]/.thumbnail
	  if {![file isdirectory $thumbnaildir]} {
	    file mkdir $thumbnaildir
	  }
	  set thumbnail $thumbnaildir/[file tail $f]
	  set expThumbnail $expThumbnaildir/[file tail $f]
	  if {![file exists $thumbnail]} {
	    catch {exec djpeg -pnm $f | \
		       pnmscale -xscale .2 -yscale .2 | ppmquant 256 | \
		       ppmtogif > $thumbnail}
	  }
	  $class $expThumbnail -init -attachFile $thumbnail
	  $place exportObjs $expThumbnail
	  ####
	  append indexpage "<A href='/$exportedfn'>" \
	      "<IMG SRC='/$expThumbnail'>$exportedfn</A><br>\n"
	} elseif {[string match *.title $exportedfn]} {
	  set title [[self] fileContent $f]
	} elseif {[string match *.date $exportedfn]} {
	  set date <H4>[[self] fileContent $f]</H4>
	}
      } elseif {[file isdirectory $f]} {
	if {[file exists $f/.title]} {
	  set desc ": [[self] fileContent $f/.title]"
	} else {
	  set desc ""
	}
	append indexpage "<A href='/$exportedfn/gindex.html'>" \
	    "$exportedfn</A>$desc<br>\n"
	[self] objectifyTree $place $f $exportedfn
      }
      set gindex [string trimleft $prefix/gindex.html /]
      HtmlDocument $gindex -content \
	  "<HTML><TITLE>$title</TITLE><H1>$title</H1>\
		<BODY>$date$indexpage</BODY></HTML>"
      #puts stderr "mixins of HtmlDocument=<[$gindex info mixins]>"
      $gindex mixinStrategy Send=TypedString
      #$gindex showVars
      receiver exportObjs $gindex
    }
  }
}
GraphicDirectoryObjectifier instproc fileContent {f} {
  set FILE [open $f r]
  set content [read $FILE]
  close $FILE
  return $content
}



Class HtmlProxy -superclass HtmlDocument  -parameter realSubject
HtmlProxy instproc init args {
  next
  [Place getInstance] exportObjs [self]
}
HtmlProxy instproc unknown {m args} {
  [self] instvar realSubject
  ::eval $realSubject $m $args
  return [[self] default]
}
