variable compat "2.1.b3"

proc DumpObject_html {db obj} {
  puts $chan "<table><tr><td><PRE>"

  RetryTransaction {
    if { [regexp {([0-9]*)/(.*)} $objectid junk fsid subobjid] } {
      set obj [db $::db openidconstruction $fsid $subobjid]
    } else {
      set obj [db $::db openid $objectid]
    }
  }
  puts $chan "</PRE></td></tr></table>"
  # Show type and open bracket
  append ret [dbobj $obj type] " " [dbobj $obj fsid] "/" [dbobj $obj subobjid] " {\n"

  # Show the construction status
  if { [dbobj $obj construction] } {
    append ret "  UNDER CONSTRUCTION\n"
  }

  # dump the body of the object
  foreach attr [dbobj $obj attrs] {
    if { [string match "0x*" $attr] } {
      append ret " (attribute $attr not in schema)\n"
      continue
    }
    append ret [format {  %-14s =} $attr]
    set val [dbobj $obj get $attr]
    if { [dbobj $obj attrtype $attr] == "object" } {
      foreach subObj [dbobj $obj gettarget $attr] {
        append ret " " [html_link "/object/$subObj" $subObj]
      }
    } elseif { [dbobj $obj attrtype $attr] == "file" && [catch {mfs streamsize $val}] } {
      if {[catch {mfs size $val}] == 0} {
        append ret " " [html_link "/object/$val" $val]
      } else {
        append ret " " $val
      }
    } else {
      append ret " " $val
      if {[string match "*Date" $attr]} {
        if {$::lang == "en"} {
          append ret " <small><i>(" [clock format [expr $val * 86400] -format "%1d/%1m/%Y"] ")</i></small>"
        } else {
          append ret " <small><i>(" [clock format [expr $val * 86400] -format "%1m/%1d/%Y"] ")</i></small>"
        }
      }
    }
    append ret "\n"
  }

  # close bracket
  append ret "}"
}

aproc mfs {
  set path /$path
  if {[catch {RetryTransaction {mfs find "$path"}} l] != 0} {
    puts $chan [html_start ""]
    puts $chan "PATH: $path<BR>"
    puts $chan $l
  } else {
    foreach {id type} $l break
    mfs_$type $chan $path $id $env
  }
}

##todo - make table header intback-links
proc mfs_tyDir {chan path id env} {
  set notime 0
  set f ""
  eval_env
  if {$notime} {set nts "?notime=1"} else {set nts ""}
  puts $chan [html_start "Directory listing of $path"]
  puts $chan [table "Directory listing of $path"]
  puts $chan [row -tag th -ALIGN LEFT "Name" "Type" "Id" "Date Time" "Size"]
  if {$path=="/Resource/Image"} {set img 1} else {set img 0}
  ForeachMfsFileTrans fsid name type $path $f 40 {
    if $notime {set size "n/a"; set date "n/a"
    } else {
      if {[catch {set size [FileSize $type $fsid]}] != 0} {
        set size "N/A"
      }
      if {[catch {set seconds [expr [mfs moddate $fsid]]}] != 0} {
        set date "N/A"
      } else {
        if {$::lang == "en"} {
          set date [ftime $seconds "%d/%m/%y %R"]
        } else {
          set date [ftime $seconds "%D %R"]
        }
      }
    }
    switch -exact $type {
      "tyDir" {set link "/mfs$path/$name/$nts" }
      "tyDb" {set link "/object/$fsid"}
      "tyFile" {set link "/$name-$fsid-.mfs" }
    }
    set names [html_link $link $name]
    if $img {set names "([html_link /$name.png png]) $name"}
    puts $chan [row $names $type $fsid $date $size]
  }
  puts -nonewline $chan [html_table_end]
}

proc mfs_tyFile {chan path objectid x} {
  action_.mfs $chan "-$objectid-" ""
}

proc mfs_tyDb {chan path id x} {
  foreach {type id sub constr fields} [mfs_dump_obj $id] break
  if {$constr} {set cons "   - Under Construction -"} else {set cons ""}
  puts $chan [html_start $path][table "Object: $path$cons"]
  foreach {attr islink atype val} $fields {
    if $islink {
      if {$atype=="file"} {
        set links [html_link "/$attr\{$val\}.[expr {($islink==1) ? "mfs" : "part.ty"}]" $val]
      } else {
        set links {}
        foreach v $val {
          append links "[html_link /object/$v $v] "
        }
      }
    } elseif {$atype=="int" && [string match "*Date" $attr]} {
      if {$::lang == "en"} {
        set links "$val <small><i>( [clock format [expr $val * 86400] -format "%1d/%1m/%Y"] )</i></small>"
      } else {
        set links "$val <small><i>( [clock format [expr $val * 86400] -format "%1m/%1d/%Y"] )</i></small>"
      }
    } elseif { $atype=="int" && $attr == "Dict" && 
	       [ catch {
		 set serial  [tvidl::dbtoserial $val]
		 set links "<pre>[string map {">" "&gt;" "<" "&lt;"} [tvdict::binarytoxml $serial]]</pre>"
	       } ] == 0 } {
	; # body in catch above
    } elseif { $atype=="int" && ([lindex $val 1] == 50344978) && 
	       [ catch  {
		 set links "<pre>[string map {">" "&gt;" "<" "&lt;"} [tvidl::dbtotext 1 $val]]</pre>"
	       } ] == 0 } {
	; # body in catch above
    } else {
      set links $val
    }
    puts $chan [row $attr $links]
  }
  puts $chan [table /]
}

aproc object {
  mfs_tyDb $chan $path $path $env
}

proc mfs_dump_obj id {
  set ret {}
  RetryTransaction {
    foreach {fsid sub} [split $id /] break
    if {$sub!=""} {
      set obj [db $::db openidconstruction $fsid $sub]
    } else {
      set obj [db $::db openid $fsid]
    }
    foreach attr [dbobj $obj attrs] {
      set link 0
      if { [string range $attr 0 1]=="0x" } {
        set val "(attribute $attr not in schema)"
        set type "bad"
      } else {
        set type [dbobj $obj attrtype $attr]
        switch -exact $type {
          "subobject" -
          "object"  {
              set val [dbobj $obj gettarget $attr]
              set link 1
            }
          "file" {
              set val [dbobj $obj get $attr]
              if [catch {mfs streamsize $val}] { set link 1 } else {set link 2}
            }
          default {
              set val [dbobj $obj get $attr]
            }
        }
      }
      lappend ret $attr $link $type $val
    }
    set ret [list [dbobj $obj type] [dbobj $obj fsid] [dbobj $obj subobjid] [dbobj $obj construction] $ret]
  }
  return $ret
}

aproc .mfs {
  set l [split $path -]
  if { [llength $l]!=3 } {return 404}
  set fsid [lindex $l 1]
  fconfigure $chan -translation binary
  print_html_header_200 $chan "application/octet-stream"
  set chunksize 32768
  RetryTransaction {
    set size [mfs size $fsid]
    set csize [expr $size % $chunksize]
    set size [expr $size-$csize]
    for {set i 0} {$i < $size} {incr i $chunksize} {
      puts -nonewline $chan [mfs getpart $fsid $i $chunksize]
    }
    puts -nonewline $chan [mfs getpart $fsid $i $csize]
  }
}

register_module "mfs" "MFS" "Browse through the MFS FileSystem"