proc DumpObject_html {db obj} { # 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 } append ret "\n" } # close bracket append ret "}" } proc do_dir {chan path} { puts $chan [html_start "Directory listing of $path"] puts $chan [html_table_start "" "Directory listing of $path" "colspan=5"] puts $chan [tr "ALIGN=LEFT" [th "Name"] [th "Type"] [th "Id"] [th "Date Time"] [th "Size"]] ForeachMfsFile fsid name type $path "" { RetryTransaction { 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"] } } } if {[string range $path end end] != "/"} { append path "/" } puts -nonewline $chan "
" 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 [DumpObject_html $db $obj] } puts $chan " |