source: branches/blt4/gui/scripts/utils.tcl @ 1719

Last change on this file since 1719 was 1719, checked in by gah, 12 years ago
File size: 3.8 KB
Line 
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# ======================================================================
12namespace eval Rappture { # forward declaration }
13namespace 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# ----------------------------------------------------------------------
23proc 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 rval "<binary> [Rappture::utils::binsize [string length $newval]]"
34
35    if {$params(-lines) != "unlimited" && $params(-lines) <= 0} {
36        return $rval
37    }
38
39    append rval "\n\n"
40    set len [string length $newval]
41    for {set i 0} {$i < $len} {incr i 8} {
42        append rval [format "%#06x: " $i]
43        set ascii ""
44        for {set j 0} {$j < 8} {incr j} {
45            if {$i+$j < $len} {
46                set char [string index $newval [expr {$i+$j}]]
47                binary scan $char c ichar
48                set hexchar [format "%02x" [expr {0xff & $ichar}]]
49            } else {
50                set char " "
51                set hexchar "  "
52            }
53            append rval "$hexchar "
54            if {[regexp {[\000-\037\177-\377]} $char]} {
55                append ascii "."
56            } else {
57                append ascii $char
58            }
59        }
60        append rval " | $ascii\n"
61
62        if {"unlimited" != $params(-lines) && $i/8+1 >= $params(-lines)} {
63            if {$i < $len-1} {
64                append rval "more..."
65            }
66            break
67        }
68    }
69    return $rval
70}
71
72# ----------------------------------------------------------------------
73# USAGE: binsize <length>
74#
75# Returns a user-friendly expression of data size, like "12 kB" or
76# "144 MB".
77# ----------------------------------------------------------------------
78proc Rappture::utils::binsize {size} {
79    foreach {factor units} {
80        1073741824 GB
81        1048576 MB
82        1024 kB
83        1 bytes
84    } {
85        if {$size/$factor > 0} {
86            if {$factor > 1} {
87                set size [format "%.1f" [expr {double($size)/$factor}]]
88            }
89            break
90        }
91    }
92    return "$size $units"
93}
94
95# ----------------------------------------------------------------------
96# USAGE: datatype <binary>
97#
98# Examines the given <binary> string and returns a description of
99# the data format.
100# ----------------------------------------------------------------------
101proc Rappture::utils::datatype {binary} {
102    set fileprog [auto_execok file]
103    if {[string length $binary] == 0} {
104        set desc "Empty"
105    } elseif {"" != $fileprog} {
106        #
107        # Use Unix "file" program to get info about type
108        # HACK ALERT! must send binary data in by creating a tmp file
109        #   or else it gets corrupted and misunderstood
110        #
111        set id [pid]
112        while {[file exists /tmp/datatype$id]} {
113            incr id
114        }
115        set fname "/tmp/datatype$id"
116        set fid [open $fname w]
117        fconfigure $fid -translation binary -encoding binary
118        puts -nonewline $fid [string range $binary 0 1024]
119        close $fid
120        if {[catch {exec $fileprog -b $fname} desc]} {
121            set desc "Binary data"
122        }
123        catch {file delete $fname}
124    } else {
125        set desc "Binary data"
126    }
127    return $desc
128}
Note: See TracBrowser for help on using the repository browser.