**rl_json Extensions **

[Napier] (Dash Automation) - 11/27/2016

[rl_json] allows us to operate on json in a similar fashion (and speed) to operating on dict itself.  We use the [dict extensions] utility procedures often so we also wanted to move some of the options to be able to work on json as well.  The result are some very convenient options for operating on json objects! You must have
the rl_json extension for this to work!

The json namespace has an unknown proc defined to forward any unknown commands to ::rl_json::json so that you can run any of the json commands as if you imported it directly (json set ...) (json get_typed ...)

** GitHub Repo - Newest Versions **
[Napier] - 04/30/2017

I keep this up-to-date in the github repo I maintain for all the '''https://github.com/Dash-OS/tcl-modules%|%Tcl Modules%|%''' I create for our applications.

   * '''https://github.com/Dash-OS/tcl-modules/blob/master/json_tools-1.0.tm%|%JSON Tools Source%|%'''


**Summary of Commands**

**** json exists ''json_val'' ...?path? ... ****

======

# Summary:
# Extends the native rl_json exists to handle the quirk it has in handling
# of an empty string ({}).  Since a JSON object is valid when it is an empty
# but properly formatted json object, exists will not throw an error with this
# workaround and will perform as expected (returning false since nothing exists)

set j {{"foo": "bar"}}

puts [json exists $j foo]
# 0

======


**** json get? ''json_val'' ...?path? ... ****

======

# Summary:
# Attempt to get the json value (returned as a dict) of the path.  If the
# path does not exist, returns {} rather than an error.

set j {{"foo": "bar", "baz": null, "qux": true, "tux": 900}}

set v [json get? $j randomKey]
# {}

======

**** json validate ''json_val'' ****

======

# Summary:
# Attempt to validate that a given value is a json object.  This was taken from the
# tcllib json package so that it does not also need to be required for this package
# to operate properly.

set j {{"foo": "bar", "baz": null, "qux": true, "tux": 900}}

if { [json isjson $j] } {
  puts "Validated"
} else { puts "Not Validated" }
# "Validated"

======

**** json push varname ...?varname?... ****

''[escargo] - 2016-12-14'' This summary description seems to be a cut-and-paste error.

''[Napier] - 2016-12-15'' Thanks, fixed.
======

# Summary:
# Push local variables into the json object while optionally transforming 
# the keys and/or default value should the value of the variable be {}

set j {{"foo": "bar", "baz": null}}

set qux true
set value 900
set value2 {}

json push j qux {value tux} {value2 nux null}
# {"foo":"bar","baz":null,"qux":true,"tux":900,"nux":null}

======

**** json pull varname ...?varname?... ****

======

# Summary:
# Pull keys from the json object and create them as local variables in the
# callers scope.  Optionally provide the variables name, the default value 
# if the key was not found, and a path to the key.
# - Each element is either the name of the key or a list of $key $newName $default ...$path
#   where items in the list are optional.

set j {{ "foo": "bar", "baz": { "qux": true, "tux": 900 } }}

json pull j foo [list tux TUX {} baz]

puts $foo;  # bar
puts $TUX;  # 900

======


**** json pullFrom varname ...?varname?... ****

======

# Summary:
# Similar to json pull, this allows you to provide a list as the first 
# argument to define the path you wish to operate from as a root.
# - Each argument may still specify the same arguments as in json pull
#   except that it will operate from the given main path.

set j {{ "foo": "bar", "baz": { "qux": true, "tux": 900 } }}

json pullFrom [list j baz] qux tux

puts $qux;  # true
puts $tux;  # 900

======


**** json pick ''json_value'' ...?keyname?... ****

======

# Summary:
# Returns a new json object comprised of the given keys (if they existed in the
# original json object).  

set j {{ "foo": "bar", "baz": { "qux": true, "tux": 900 }, "yaz": null }}

set new [json pick $j foo baz some other values]
# {"foo":"bar","baz":{"qux":true,"tux":900}}

======


**** json withKey ''json_value'' key ****

======

# Summary:
# Iterates through a json object and attempts to retrieve one of its childs
# value ($key) and assigns that as the main keys value.

set j {{ "foo": { "bar": null, "baz": 900 }, "qux": { "bar": true, "baz": 1800 } }}

set new [json withKey $j baz]
# {"foo":900,"qux":1800}

======

**** json modify varname ''dict_value'' ****

======

# Summary:
# Modifies a given json object in place. The value can be a dict or an even
# number of arguments.

set j {{"foo": "bar", "baz": null, "qux": true, "tux": 900}}

json modify j [dict create foo nux qux false new value]
# {"foo":"nux","baz":null,"qux":false,"tux":900,"new":"value"}

======


**** json typed value ..?opts?... ****

======

# Summary:
# Does a "best attempt" to discover and handle the value of an item and convert it
# to a json object or value.  Primitive support for properly built nested data 
# structures but should not be relied upon for that.  This is generally used to
# convert to a json value (example: hi -> "hi") and will first confirm the value
# is not already a json value (example: "hi" -> "hi")
# 
# This is a key ingredient to allowing many of the other functions to work.

json typed foo; # "foo"
json typed {"foo"} ; # "foo"
json typed [list one two three]; # ["one", "two", "three"]
json typed [dict create foo bar baz qux]; # {"foo": "bar", "baz": "qux"}
json typed [list [dict create foo bar] [dict create baz qux]]; # [ {"foo": "bar"} {"baz": "qux"} ]

======

-------------
**The Script**

======
package require fileutil
package require ensembled
package require json_tools
package require ip_tools

namespace eval ::unix {}
namespace eval ::unix::serialize { ensembled }

# {"cpu":[1132615,0,2401999,28616318,13,4775,24818,0,0,0],
# "cpu0":[1132615,0,2401999,28616318,13,4775,24818,0,0,0],"ctxt":1211610385,
# "btime":1481418495,"processes":2999236,"procs_running":2,"procs_blocked":0,
# "softirq":[58776092,0,10831297,2994611,6909044,434,0,4432284,0,1255,33607167]}
proc ::unix::serialize::procstat args {
  set rawCPU   [ ::fileutil::cat /proc/stat ]
  set lines    [ split $rawCPU \n ]
  set tempDict {{}}
  foreach line $lines {
    switch -glob -- $line {
      0* { continue }
      cpu* {
        set stats [lassign $line cpu]
        json set tempDict $cpu [json typed $stats]
      }
      ctxt* {
        set stats [lassign $line ctxt]
        json set tempDict $ctxt [json typed $stats]
      }
      btime* {
        set stats [lassign $line btime]
        json set tempDict $btime [json typed $stats]
      }
      process* {
        set stats [lassign $line processes]
        json set tempDict $processes [json typed $stats]
      }
      procs_r* {
        set stats [lassign $line procs_running]
        json set tempDict $procs_running [json typed $stats]
      }
      procs_b* {
        set stats [lassign $line procs_blocked]
        json set tempDict $procs_blocked [json typed $stats]
      }
      softirq* {
        set stats [lassign $line softirq]
        json set tempDict $softirq [json typed $stats]
      }
    }
  }
  return $tempDict
}

proc ::unix::serialize::meminfo args {
  set _meminfo [ string tolower [::fileutil::cat /proc/meminfo] ]
  set _meminfo [ dict create {*}[ string map { "kb" "" ":" "" } ${_meminfo} ] ]
  if { $args ne {} } { set _meminfo [dict pull meminfo {*}$args] }
  return [json typed ${_meminfo}]
}

proc ::unix::serialize::uptime args { 
  set json {{}}
  lassign [ ::fileutil::cat /proc/uptime ] uptime idle
  json set json uptime [json typed $uptime]
  json set json idle   [json typed $idle]
  return $json
}

proc ::unix::serialize::loadavg args {
  set json {{}}
  set loadAvg [ ::fileutil::cat /proc/loadavg ]
  lassign $loadAvg 1 5 15 kernel lastPID
  json set json 1  [json typed $1]
  json set json 5  [json typed $5]
  json set json 15 [json typed $15]
  return $json
}

proc ::unix::serialize::process_files {pid {files {}}} {
  set fds [ glob -nocomplain -directory /proc/${pid}/fd * ]
  foreach fd $fds { lappend files [file readlink $fd] }
  return [json object create \
    total [llength $fds] \
    files $files
  ]
}

proc ::unix::serialize::ifconfig { {iface eth0} } {
  return [json typed [dict create {*}[::tuapi::syscall::ifconfig $iface]]]
}

proc ::unix::serialize::stat_serializer path {
  set netstat [ ::fileutil::cat $path ]
  set lines [split $netstat \n]
  set tempDict {{}}
  foreach line $lines {
    set stats [lassign $line key]
    set key   [string map {":" ""} $key]
    if { $key eq {} || $stats eq {} } { continue }
    if { [json exists $tempDict $key] } {
      foreach k $keys s $stats {
        json set tempDict $key $k [json typed $s]
      }
    } else {
      json set tempDict $key {{}}
      set  keys $stats
    }
  }
  return $tempDict
}

proc ::unix::serialize::route { {iface eth0} } {
        set data      [unix get route]
        set lines     [lrange [split $data \n] 1 end]
        set tempDict  {}
        foreach line $lines {
                set gatewayIP     {}
          set netMask       {} 
          set destinationIP {}
                lassign $line iface dest gateway flags refcnt use metric mask mtu window irtt
                # We need to do this so the reprentation is a pure string
                append gatewayIP     [ip hex2dec $gateway]
                append netMask       [ip hex2dec $mask]
                append destinationIP [ip hex2dec $dest]
                if {$gateway ne "00000000"} { dict set tempDict $iface gatewayIP     $gatewayIP      }
                if {$mask    ne "00000000"} { dict set tempDict $iface netMask       $netMask        }
                if {$dest    ne "00000000"} { dict set tempDict $iface destinationIP $destinationIP  }
        }
        if { [dict exists $tempDict $iface] } {
          return [json typed [dict get $tempDict $iface]]
        }
}

proc ::unix::serialize::netstat {} { tailcall [namespace current]::stat_serializer /proc/net/netstat }
proc ::unix::serialize::snmp {} { tailcall [namespace current]::stat_serializer /proc/net/snmp }


proc ::unix::serialize::netdev {} {
  set dev   [::fileutil::cat /proc/net/dev]
  set lines [lrange [split $dev \n] 1 end]
  set stats [lassign $lines keys]
  set keys  [split $keys |]
  set tempDict {}
  lassign $keys -> rxKeys txKeys
  foreach interface [string trim $stats] {
    set stats [lassign $interface iface]
    set iface [string map {":" ""} $iface]
    if { $iface eq {} || $stats eq {} } { continue }
    foreach rxStat $rxKeys {
      set stats [lassign $stats stat]
      dict set tempDict $iface rx $rxStat $stat
    }
    foreach txStat $txKeys {
      set stats [lassign $stats stat]
      dict set tempDict $iface tx $txStat $stat
    }
  }
  return $tempDict
}

proc ::unix::serialize::processes args {
  try {
    set processes [ unix get ps ]
    set lines [split $processes \n]
    set lines [lrange $lines 1 end]
    foreach line $lines {
      set line [string map {{<} {} {>} {} {*} {}} $line]
      set pid  [lindex $line 0]
      set user [lindex $line 1]
      set virtualSize [lindex $line 2]
      if {[string match "*m" $virtualSize]} {
        set virtualSize [string map {"m" ""} $virtualSize]
        set virtualSize [expr {$virtualSize * 1000}]
      }
      set stat [lindex $line 3]
      set name [lrange $line 4 end]
    }
  } on error { result options } {
    ::onError $result $options "While getting System Processes"
  }
}


======

<<categories>> Data Structure | Command