[702] | 1 | # ---------------------------------------------------------------------- |
---|
| 2 | # COMPONENT: utils - miscellaneous utilities |
---|
| 3 | # |
---|
| 4 | # Misc routines used throughout the GUI. |
---|
| 5 | # ====================================================================== |
---|
| 6 | # AUTHOR: Michael McLennan, Purdue University |
---|
| 7 | # Copyright (c) 2004-2005 Purdue Research Foundation |
---|
| 8 | # |
---|
| 9 | # See the file "license.terms" for information on usage and |
---|
| 10 | # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
---|
| 11 | # ====================================================================== |
---|
| 12 | namespace eval Rappture { # forward declaration } |
---|
| 13 | namespace eval Rappture::utils { # forward declaration } |
---|
| 14 | |
---|
| 15 | # ---------------------------------------------------------------------- |
---|
| 16 | # USAGE: hexdump ?-lines num? <data> |
---|
| 17 | # |
---|
| 18 | # Returns a hex dump for a blob of binary <data>. This is used to |
---|
| 19 | # represent the data in an input/output <string> object. The -lines |
---|
| 20 | # flag can be used to limit the output to the specified number of |
---|
| 21 | # lines. |
---|
| 22 | # ---------------------------------------------------------------------- |
---|
| 23 | proc Rappture::utils::hexdump {args} { |
---|
| 24 | Rappture::getopts args params { |
---|
| 25 | value -lines unlimited |
---|
| 26 | } |
---|
| 27 | if {[llength $args] != 1} { |
---|
| 28 | error "wrong # args: should be \"hexdump ?-lines num? data\"" |
---|
| 29 | } |
---|
| 30 | set newval [lindex $args 0] |
---|
| 31 | set args "" |
---|
| 32 | |
---|
| 33 | set size [string length $newval] |
---|
| 34 | foreach {factor units} { |
---|
| 35 | 1073741824 GB |
---|
| 36 | 1048576 MB |
---|
| 37 | 1024 kB |
---|
| 38 | 1 bytes |
---|
| 39 | } { |
---|
| 40 | if {$size/$factor > 0} { |
---|
| 41 | if {$factor > 1} { |
---|
| 42 | set size [format "%.2f" [expr {double($size)/$factor}]] |
---|
| 43 | } |
---|
| 44 | break |
---|
| 45 | } |
---|
| 46 | } |
---|
| 47 | |
---|
| 48 | set rval "<binary> $size $units" |
---|
| 49 | |
---|
| 50 | if {$params(-lines) != "unlimited" && $params(-lines) <= 0} { |
---|
| 51 | return $rval |
---|
| 52 | } |
---|
| 53 | |
---|
| 54 | append rval "\n\n" |
---|
| 55 | set len [string length $newval] |
---|
| 56 | for {set i 0} {$i < $len} {incr i 8} { |
---|
| 57 | append rval [format "%#06x: " $i] |
---|
| 58 | set ascii "" |
---|
| 59 | for {set j 0} {$j < 8} {incr j} { |
---|
| 60 | if {$i+$j < $len} { |
---|
| 61 | set char [string index $newval [expr {$i+$j}]] |
---|
| 62 | binary scan $char c ichar |
---|
| 63 | set hexchar [format "%02x" [expr {0xff & $ichar}]] |
---|
| 64 | } else { |
---|
| 65 | set char " " |
---|
| 66 | set hexchar " " |
---|
| 67 | } |
---|
| 68 | append rval "$hexchar " |
---|
| 69 | if {[regexp {[\000-\037\177-\377]} $char]} { |
---|
| 70 | append ascii "." |
---|
| 71 | } else { |
---|
| 72 | append ascii $char |
---|
| 73 | } |
---|
| 74 | } |
---|
| 75 | append rval " | $ascii\n" |
---|
| 76 | |
---|
| 77 | if {"unlimited" != $params(-lines) && $i/8+1 >= $params(-lines)} { |
---|
| 78 | if {$i < $len-1} { |
---|
| 79 | append rval "more..." |
---|
| 80 | } |
---|
| 81 | break |
---|
| 82 | } |
---|
| 83 | } |
---|
| 84 | return $rval |
---|
| 85 | } |
---|