[116900] users/cal/ports/macports/mpstats/files/mpstats.tcl
cal at macports.org
cal at macports.org
Sun Feb 9 13:05:51 PST 2014
Revision: 116900
https://trac.macports.org/changeset/116900
Author: cal at macports.org
Date: 2014-02-09 13:05:51 -0800 (Sun, 09 Feb 2014)
Log Message:
-----------
mpstats: add documentation for each proc, format JSON to be human-readable for ./mpstats show, make sure only name, version and variants are submitted, print success notice, set exit code, use append instead of set foo "$foo$bar"
Modified Paths:
--------------
users/cal/ports/macports/mpstats/files/mpstats.tcl
Modified: users/cal/ports/macports/mpstats/files/mpstats.tcl
===================================================================
--- users/cal/ports/macports/mpstats/files/mpstats.tcl 2014-02-09 20:54:43 UTC (rev 116899)
+++ users/cal/ports/macports/mpstats/files/mpstats.tcl 2014-02-09 21:05:51 UTC (rev 116900)
@@ -29,7 +29,6 @@
# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-set VERSION 0.1
set prefix /opt/local
if {[catch {source ${prefix}/share/macports/Tcl/macports1.0/macports_fastload.tcl} result]} {
@@ -47,6 +46,13 @@
ui_msg "Usage: $::argv0 \[submit|show\]"
}
+##
+# Reads the configuration from the statistics config file at $prefix/etc/macports/stats.conf and the
+# UUID file $prefix/var/macports/stats-uiud. Stores the configured values in global variables.
+# Currently, the follwing configuration variables are supported:
+# - stats_url The URL that will be used for POST submission of the statistics
+# - stats_id The UUID of this MacPorts installation; to be read from the UUID file
+# Prints an error message (but doesn't abort) if the UUID is empty.
proc read_config {} {
global prefix stats_url stats_id
set conf_path "${prefix}/etc/macports/stats.conf"
@@ -67,11 +73,10 @@
gets $fd stats_id
close $fd
if {[string length $stats_id] == 0} {
- puts stderr "UUID file ${uuid_path} seems to be empty. Abort."
+ ui_error "UUID file ${uuid_path} seems to be empty."
}
} else {
- puts stderr "UUID file ${uuid_path} missing. Abort."
- exit 1
+ ui_error "UUID file ${uuid_path} missing."
}
}
@@ -105,8 +110,16 @@
###### JSON Encoding helper procs ######
+##
# Return JSON encoding of a flat "key":"value" dictionary
-proc json_encode_dict { data } {
+#
+# @param data
+# the variable name of the dict to encode
+# @param indent
+# an optional indentation string that will be printed at the start of each new line
+# @returns
+# the given dict, as JSON-formatted string
+proc json_encode_dict {data {indent ""}} {
upvar 1 $data db
set size [dict size $db]
@@ -116,56 +129,79 @@
set json "\{"
dict for {key values} $db {
- set line "\"$key\":\"[dict get $db $key]\""
+ set line "\n${indent} \"$key\": \"[dict get $db $key]\""
# Check if there are any subsequent items
if {$i < $size} {
- set line "$line, "
- }
+ append line ","
+ }
# Add line to the JSON string
- set json "$json$line"
+ append json $line
incr i
}
- set json "$json\}"
+ if {$size > 0} {
+ append json "\n${indent}"
+ }
+ append json "\}"
return $json
}
+##
# Encodes a list of strings as a JSON array
-proc json_encode_list { data } {
+#
+# @param data
+# the list to be encoded in JSON
+# @param indent
+# an optional indentation string that will be printed at the start of each new line
+# @returns
+# the given list, as JSON-formatted string
+proc json_encode_list {data {indent ""}} {
set size [llength $data]
set i 1
set json "\["
foreach item $data {
- set json "$json$data"
+ append json "\n "
+ append json $data
# Check if there are any subsequent items
if {$i < $size} {
- set json "$json, "
+ append json ","
}
incr i
}
- set json "$json \]"
+ if {$size > 0} {
+ append json "\n${indent}"
+ }
+ append json "\]"
return $json
}
+##
# Encode a port (from a portlist entry) as a JSON object
-proc json_encode_port { port_info } {
+#
+# @param data
+# the name of the portinfo variable for the port to be encoded
+# @param indent
+# an optional indentation string that will be printed at the start of each new line
+# @returns
+# the given port, represented as JSON object with the keys name, version and variants, if
+# present
+proc json_encode_port {port_info {indent ""}} {
upvar 1 $port_info port
set first true
set json "\{"
- foreach name [array names port] {
-
+ foreach name {name version variants} {
# Skip empty strings
if {$port($name) eq ""} {
continue
@@ -174,50 +210,69 @@
# Prepend a comma if this isn't the first item that has been processed
if {!$first} {
# Add a comma
- set json "$json, "
- } else {
- set first false
- }
+ append json ", "
+ } else {
+ set first false
+ }
# Format the entry as "name_string":"value"
- set entry "\"$name\":\"$port($name)\""
- set json "$json$entry"
+ append json "\"$name\": \"$port($name)\""
}
- set json "$json\}"
+ append json "\}"
return $json
}
+##
# Encode portlist as a JSON array of port objects
-proc json_encode_portlist { portlist } {
+#
+# @param data
+# the list of ports to be encoded in JSON
+# @param indent
+# an optional indentation string that will be printed at the start of each new line
+# @returns
+# the given list of ports, encoded as JSON array of return values of json_encode_port
+proc json_encode_portlist {portlist {indent ""}} {
set json "\["
set first true
foreach i $portlist {
array set port $i
- set encoded [json_encode_port port]
+ set encoded [json_encode_port port "${indent} "]
# Prepend a comma if this isn't the first item that has been processed
if {!$first} {
# Add a comma
- set json "$json, "
- } else {
- set first false
- }
+ append json ","
+ } else {
+ set first false
+ }
# Append encoded json object
- set json "$json$encoded"
+ append json "\n${indent} ${encoded}"
}
- set json "$json\]"
+ if {!$first} {
+ append json "\n${indent}"
+ }
+ append json "\]"
return $json
}
-# Top level container for os and port data
-# Returns a JSON Object with three
+##
+# Encodes the collected statistics as JSON
+#
+# @param id
+# the statistics UUID for this installation
+# @param os_dict
+# the variable name of the dict holding statistics about the OS
+# @param ports_dict
+# the variable name of the dict holding statistics about the installed ports
+# @returns
+# a JSON-encoded string in the format required by the statistics server ready for submission
proc json_encode_stats {id os_dict ports_dict} {
upvar 1 $os_dict os
upvar 1 $ports_dict ports
@@ -227,28 +282,47 @@
set inactive_ports_json [json_encode_portlist [dict get $ports "inactive"]]
set json "\{"
- set json "$json \"id\":\"$id\","
- set json "$json \"os\":$os_json,"
- set json "$json \"active_ports\":$active_ports_json,"
- set json "$json \"inactive_ports\":$inactive_ports_json"
- set json "$json\}"
+ append json "\n \"id\": \"$id\","
+ append json "\n \"os\": [json_encode_dict os " "],"
+ append json "\n \"active_ports\": [json_encode_portlist [dict get $ports "active"] " "],"
+ append json "\n \"inactive_ports\": [json_encode_portlist [dict get $ports "inactive"] " "]"
+ append json "\n\}"
return $json
}
+##
+# Helper proc to encode the variants list in a canonical way
+#
+# @param variants
+# the string of all variants for any given port
+# @returns
+# a Tcl array object converted to a list where the keys are variant names and the values
+# are either + or -, depending on whether the variant was selected, or not.
proc split_variants {variants} {
set result {}
set l [regexp -all -inline -- {([-+])([[:alpha:]_]+[\w\.]*)} $variants]
- foreach { match sign variant } $l {
+ foreach {match sign variant} $l {
lappend result $variant $sign
}
return $result
}
+##
+# Helper proc to build a list of all installed ports
+#
+# @param active
+# "yes", if the proc should collect all active ports, any other string to cause the
+# collection of inactive ports
+# @returns
+# a list of installed ports chosen according to the \a active parameter, where each entry is
+# the list representation of a Tcl array with the keys name, version and variants. The
+# variants value is encoded using \c split_variants, the version entry has the form
+# "$version_$revision".
proc get_installed_ports {active} {
set ilist {}
- if { [catch {set ilist [registry::installed]} result] } {
- if {$result != "Registry error: No ports registered as installed."} {
+ if {[catch {set ilist [registry::installed]} result]} {
+ if {$result ne "Registry error: No ports registered as installed."} {
ui_debug "$::errorInfo"
return -code error "registry::installed failed: $result"
}
@@ -258,7 +332,7 @@
foreach i $ilist {
set iactive [lindex $i 4]
- if {(${active} == "yes") == (${iactive} != 0)} {
+ if {(${active} eq "yes") == (${iactive} != 0)} {
set iname [lindex $i 0]
set iversion [lindex $i 1]
set irevision [lindex $i 2]
@@ -270,32 +344,37 @@
return $results
}
-
+##
+# The main entry point of mpstats.tcl. Collects and prints or submits statistics.
+#
+# @param subcommands
+# The list of commands to be executed by this proc. This list can either be empty, which will
+# cause printing a usage message, ["show"], which will diplay the JSON-encoded data to be
+# submitted, or ["submit"] to send the data to the configured statistics server.
+# @returns
+# 0 on success and a non-zero value on error
proc action_stats {subcommands} {
global stats_url stats_id
+ # If no subcommands are given (subcommands is empty) print out usage message
+ if {[llength $subcommands] == 0} {
+ usage
+ return 1
+ }
+
# Build dictionary of os information
dict set os macports_version [macports::version]
dict set os osx_version ${macports::macosx_version}
- dict set os os_arch ${macports::os_arch}
+ dict set os os_arch ${macports::os_arch}
dict set os os_platform ${macports::os_platform}
dict set os build_arch ${macports::build_arch}
dict set os gcc_version [getgccinfo]
dict set os xcode_version ${macports::xcodeversion}
- # Build dictionary of port information
+ # Build dictionary of port information
dict set ports active [get_installed_ports yes]
dict set ports inactive [get_installed_ports no]
- # If no subcommands are given (subcommands is empty) print out OS information
- if {$subcommands eq ""} {
- # Print information from os dictionary
- dict for {key values} $os {
- puts "$key: [dict get $os $key]"
- }
- return 0
- }
-
# Make sure there aren't too many subcommands
if {[llength $subcommands] > 1} {
ui_error "Please select only one subcommand."
@@ -319,16 +398,18 @@
switch $cmd {
submit {
- ui_notice "Submitting to $stats_url"
+ ui_notice "Submitting data to $stats_url ..."
if {[catch {curl post "submission\[data\]=$json" $stats_url} value]} {
ui_error "$::errorInfo"
return 1
}
+
+ ui_notice "Success."
}
show {
- ui_notice "Would submit to $stats_url"
- ui_msg "submission\[data\]=$json"
+ ui_notice "Would submit the follwoing data to $stats_url:"
+ ui_msg "$json"
}
default {
puts "Unknown subcommand."
@@ -341,4 +422,4 @@
}
read_config
-action_stats $argv
+exit [action_stats $argv]
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://lists.macosforge.org/pipermail/macports-changes/attachments/20140209/8489eeb3/attachment-0001.html>
More information about the macports-changes
mailing list