[3330] | 1 | # -*- mode: tcl; indent-tabs-mode: nil -*- |
---|
[702] | 2 | # ---------------------------------------------------------------------- |
---|
| 3 | # COMPONENT: utils - miscellaneous utilities |
---|
| 4 | # |
---|
| 5 | # Misc routines used throughout the GUI. |
---|
| 6 | # ====================================================================== |
---|
| 7 | # AUTHOR: Michael McLennan, Purdue University |
---|
[3177] | 8 | # Copyright (c) 2004-2012 HUBzero Foundation, LLC |
---|
[702] | 9 | # |
---|
| 10 | # See the file "license.terms" for information on usage and |
---|
| 11 | # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
---|
| 12 | # ====================================================================== |
---|
| 13 | namespace eval Rappture { # forward declaration } |
---|
| 14 | namespace eval Rappture::utils { # forward declaration } |
---|
| 15 | |
---|
| 16 | # ---------------------------------------------------------------------- |
---|
| 17 | # USAGE: hexdump ?-lines num? <data> |
---|
| 18 | # |
---|
| 19 | # Returns a hex dump for a blob of binary <data>. This is used to |
---|
| 20 | # represent the data in an input/output <string> object. The -lines |
---|
| 21 | # flag can be used to limit the output to the specified number of |
---|
| 22 | # lines. |
---|
| 23 | # ---------------------------------------------------------------------- |
---|
| 24 | proc Rappture::utils::hexdump {args} { |
---|
| 25 | Rappture::getopts args params { |
---|
[1828] | 26 | value -lines unlimited |
---|
[702] | 27 | } |
---|
| 28 | if {[llength $args] != 1} { |
---|
[1828] | 29 | error "wrong # args: should be \"hexdump ?-lines num? data\"" |
---|
[702] | 30 | } |
---|
| 31 | set newval [lindex $args 0] |
---|
| 32 | set args "" |
---|
| 33 | |
---|
[1715] | 34 | set rval "<binary> [Rappture::utils::binsize [string length $newval]]" |
---|
[702] | 35 | |
---|
| 36 | if {$params(-lines) != "unlimited" && $params(-lines) <= 0} { |
---|
[1828] | 37 | return $rval |
---|
[702] | 38 | } |
---|
| 39 | |
---|
| 40 | append rval "\n\n" |
---|
| 41 | set len [string length $newval] |
---|
| 42 | for {set i 0} {$i < $len} {incr i 8} { |
---|
[1828] | 43 | append rval [format "%#06x: " $i] |
---|
| 44 | set ascii "" |
---|
| 45 | for {set j 0} {$j < 8} {incr j} { |
---|
| 46 | if {$i+$j < $len} { |
---|
| 47 | set char [string index $newval [expr {$i+$j}]] |
---|
| 48 | binary scan $char c ichar |
---|
| 49 | set hexchar [format "%02x" [expr {0xff & $ichar}]] |
---|
| 50 | } else { |
---|
| 51 | set char " " |
---|
| 52 | set hexchar " " |
---|
| 53 | } |
---|
| 54 | append rval "$hexchar " |
---|
| 55 | if {[regexp {[\000-\037\177-\377]} $char]} { |
---|
| 56 | append ascii "." |
---|
| 57 | } else { |
---|
| 58 | append ascii $char |
---|
| 59 | } |
---|
| 60 | } |
---|
| 61 | append rval " | $ascii\n" |
---|
[702] | 62 | |
---|
[1828] | 63 | if {"unlimited" != $params(-lines) && $i/8+1 >= $params(-lines)} { |
---|
| 64 | if {$i < $len-1} { |
---|
| 65 | append rval "more..." |
---|
| 66 | } |
---|
| 67 | break |
---|
| 68 | } |
---|
[702] | 69 | } |
---|
| 70 | return $rval |
---|
| 71 | } |
---|
[1715] | 72 | |
---|
| 73 | # ---------------------------------------------------------------------- |
---|
| 74 | # USAGE: binsize <length> |
---|
| 75 | # |
---|
| 76 | # Returns a user-friendly expression of data size, like "12 kB" or |
---|
| 77 | # "144 MB". |
---|
| 78 | # ---------------------------------------------------------------------- |
---|
| 79 | proc Rappture::utils::binsize {size} { |
---|
| 80 | foreach {factor units} { |
---|
[1828] | 81 | 1073741824 GB |
---|
| 82 | 1048576 MB |
---|
| 83 | 1024 kB |
---|
| 84 | 1 bytes |
---|
[1715] | 85 | } { |
---|
[1828] | 86 | if {$size/$factor > 0} { |
---|
| 87 | if {$factor > 1} { |
---|
| 88 | set size [format "%.1f" [expr {double($size)/$factor}]] |
---|
| 89 | } |
---|
| 90 | break |
---|
| 91 | } |
---|
[1715] | 92 | } |
---|
| 93 | return "$size $units" |
---|
| 94 | } |
---|
| 95 | |
---|
| 96 | # ---------------------------------------------------------------------- |
---|
| 97 | # USAGE: datatype <binary> |
---|
| 98 | # |
---|
| 99 | # Examines the given <binary> string and returns a description of |
---|
| 100 | # the data format. |
---|
| 101 | # ---------------------------------------------------------------------- |
---|
| 102 | proc Rappture::utils::datatype {binary} { |
---|
| 103 | set fileprog [auto_execok file] |
---|
| 104 | if {[string length $binary] == 0} { |
---|
| 105 | set desc "Empty" |
---|
| 106 | } elseif {"" != $fileprog} { |
---|
| 107 | # |
---|
| 108 | # Use Unix "file" program to get info about type |
---|
| 109 | # HACK ALERT! must send binary data in by creating a tmp file |
---|
| 110 | # or else it gets corrupted and misunderstood |
---|
| 111 | # |
---|
| 112 | set id [pid] |
---|
| 113 | while {[file exists /tmp/datatype$id]} { |
---|
| 114 | incr id |
---|
| 115 | } |
---|
| 116 | set fname "/tmp/datatype$id" |
---|
| 117 | set fid [open $fname w] |
---|
| 118 | fconfigure $fid -translation binary -encoding binary |
---|
| 119 | puts -nonewline $fid [string range $binary 0 1024] |
---|
| 120 | close $fid |
---|
| 121 | if {[catch {exec $fileprog -b $fname} desc]} { |
---|
| 122 | set desc "Binary data" |
---|
| 123 | } |
---|
| 124 | catch {file delete $fname} |
---|
| 125 | } else { |
---|
| 126 | set desc "Binary data" |
---|
| 127 | } |
---|
| 128 | return $desc |
---|
| 129 | } |
---|
[1828] | 130 | |
---|
| 131 | # ---------------------------------------------------------------------- |
---|
| 132 | # USAGE: expandPath <path> |
---|
| 133 | # |
---|
| 134 | # Returns the true location of the provided path, |
---|
| 135 | # automatically expanding links to form an absolute path. |
---|
| 136 | # ---------------------------------------------------------------------- |
---|
| 137 | proc Rappture::utils::expandPath {args} { |
---|
| 138 | set path "" |
---|
| 139 | set dirs [file split [lindex $args 0]] |
---|
| 140 | |
---|
| 141 | while {[llength $dirs] > 0} { |
---|
| 142 | set d [lindex $dirs 0] |
---|
| 143 | set dirs [lrange $dirs 1 end] |
---|
| 144 | if {[catch {file link [file join $path $d]} out] == 0} { |
---|
| 145 | # directory d is a link, follow it |
---|
| 146 | set outdirs [file split $out] |
---|
| 147 | if {[string compare "/" [lindex $outdirs 0]] == 0} { |
---|
| 148 | # directory leads back to root |
---|
| 149 | # clear path |
---|
| 150 | # reset dirs list |
---|
| 151 | set path "" |
---|
| 152 | set dirs $outdirs |
---|
| 153 | } else { |
---|
| 154 | # relative path for the link |
---|
| 155 | # prepend directory to dirs list |
---|
| 156 | set dirs [concat $outdirs $dirs] |
---|
| 157 | } |
---|
| 158 | } else { |
---|
| 159 | set path [file join $path $d] |
---|
| 160 | } |
---|
| 161 | } |
---|
| 162 | return $path |
---|
| 163 | } |
---|
| 164 | |
---|