<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head><meta http-equiv="content-type" content="text/html; charset=utf-8" />
<title>[116900] users/cal/ports/macports/mpstats/files/mpstats.tcl</title>
</head>
<body>
<style type="text/css"><!--
#msg dl.meta { border: 1px #006 solid; background: #369; padding: 6px; color: #fff; }
#msg dl.meta dt { float: left; width: 6em; font-weight: bold; }
#msg dt:after { content:':';}
#msg dl, #msg dt, #msg ul, #msg li, #header, #footer, #logmsg { font-family: verdana,arial,helvetica,sans-serif; font-size: 10pt; }
#msg dl a { font-weight: bold}
#msg dl a:link { color:#fc3; }
#msg dl a:active { color:#ff0; }
#msg dl a:visited { color:#cc6; }
h3 { font-family: verdana,arial,helvetica,sans-serif; font-size: 10pt; font-weight: bold; }
#msg pre { overflow: auto; background: #ffc; border: 1px #fa0 solid; padding: 6px; }
#logmsg { background: #ffc; border: 1px #fa0 solid; padding: 1em 1em 0 1em; }
#logmsg p, #logmsg pre, #logmsg blockquote { margin: 0 0 1em 0; }
#logmsg p, #logmsg li, #logmsg dt, #logmsg dd { line-height: 14pt; }
#logmsg h1, #logmsg h2, #logmsg h3, #logmsg h4, #logmsg h5, #logmsg h6 { margin: .5em 0; }
#logmsg h1:first-child, #logmsg h2:first-child, #logmsg h3:first-child, #logmsg h4:first-child, #logmsg h5:first-child, #logmsg h6:first-child { margin-top: 0; }
#logmsg ul, #logmsg ol { padding: 0; list-style-position: inside; margin: 0 0 0 1em; }
#logmsg ul { text-indent: -1em; padding-left: 1em; }#logmsg ol { text-indent: -1.5em; padding-left: 1.5em; }
#logmsg > ul, #logmsg > ol { margin: 0 0 1em 0; }
#logmsg pre { background: #eee; padding: 1em; }
#logmsg blockquote { border: 1px solid #fa0; border-left-width: 10px; padding: 1em 1em 0 1em; background: white;}
#logmsg dl { margin: 0; }
#logmsg dt { font-weight: bold; }
#logmsg dd { margin: 0; padding: 0 0 0.5em 0; }
#logmsg dd:before { content:'\00bb';}
#logmsg table { border-spacing: 0px; border-collapse: collapse; border-top: 4px solid #fa0; border-bottom: 1px solid #fa0; background: #fff; }
#logmsg table th { text-align: left; font-weight: normal; padding: 0.2em 0.5em; border-top: 1px dotted #fa0; }
#logmsg table td { text-align: right; border-top: 1px dotted #fa0; padding: 0.2em 0.5em; }
#logmsg table thead th { text-align: center; border-bottom: 1px solid #fa0; }
#logmsg table th.Corner { text-align: left; }
#logmsg hr { border: none 0; border-top: 2px dashed #fa0; height: 1px; }
#header, #footer { color: #fff; background: #636; border: 1px #300 solid; padding: 6px; }
#patch { width: 100%; }
#patch h4 {font-family: verdana,arial,helvetica,sans-serif;font-size:10pt;padding:8px;background:#369;color:#fff;margin:0;}
#patch .propset h4, #patch .binary h4 {margin:0;}
#patch pre {padding:0;line-height:1.2em;margin:0;}
#patch .diff {width:100%;background:#eee;padding: 0 0 10px 0;overflow:auto;}
#patch .propset .diff, #patch .binary .diff {padding:10px 0;}
#patch span {display:block;padding:0 10px;}
#patch .modfile, #patch .addfile, #patch .delfile, #patch .propset, #patch .binary, #patch .copfile {border:1px solid #ccc;margin:10px 0;}
#patch ins {background:#dfd;text-decoration:none;display:block;padding:0 10px;}
#patch del {background:#fdd;text-decoration:none;display:block;padding:0 10px;}
#patch .lines, .info {color:#888;background:#fff;}
--></style>
<div id="msg">
<dl class="meta">
<dt>Revision</dt> <dd><a href="https://trac.macports.org/changeset/116900">116900</a></dd>
<dt>Author</dt> <dd>cal@macports.org</dd>
<dt>Date</dt> <dd>2014-02-09 13:05:51 -0800 (Sun, 09 Feb 2014)</dd>
</dl>
<h3>Log Message</h3>
<pre>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"</pre>
<h3>Modified Paths</h3>
<ul>
<li><a href="#userscalportsmacportsmpstatsfilesmpstatstcl">users/cal/ports/macports/mpstats/files/mpstats.tcl</a></li>
</ul>
</div>
<div id="patch">
<h3>Diff</h3>
<a id="userscalportsmacportsmpstatsfilesmpstatstcl"></a>
<div class="modfile"><h4>Modified: users/cal/ports/macports/mpstats/files/mpstats.tcl (116899 => 116900)</h4>
<pre class="diff"><span>
<span class="info">--- 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)
</span><span class="lines">@@ -29,7 +29,6 @@
</span><span class="cx"> # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
</span><span class="cx"> # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
</span><span class="cx">
</span><del>-set VERSION 0.1
</del><span class="cx"> set prefix /opt/local
</span><span class="cx">
</span><span class="cx"> if {[catch {source ${prefix}/share/macports/Tcl/macports1.0/macports_fastload.tcl} result]} {
</span><span class="lines">@@ -47,6 +46,13 @@
</span><span class="cx"> ui_msg "Usage: $::argv0 \[submit|show\]"
</span><span class="cx"> }
</span><span class="cx">
</span><ins>+##
+# 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.
</ins><span class="cx"> proc read_config {} {
</span><span class="cx"> global prefix stats_url stats_id
</span><span class="cx"> set conf_path "${prefix}/etc/macports/stats.conf"
</span><span class="lines">@@ -67,11 +73,10 @@
</span><span class="cx"> gets $fd stats_id
</span><span class="cx"> close $fd
</span><span class="cx"> if {[string length $stats_id] == 0} {
</span><del>- puts stderr "UUID file ${uuid_path} seems to be empty. Abort."
</del><ins>+ ui_error "UUID file ${uuid_path} seems to be empty."
</ins><span class="cx"> }
</span><span class="cx"> } else {
</span><del>- puts stderr "UUID file ${uuid_path} missing. Abort."
- exit 1
</del><ins>+ ui_error "UUID file ${uuid_path} missing."
</ins><span class="cx"> }
</span><span class="cx"> }
</span><span class="cx">
</span><span class="lines">@@ -105,8 +110,16 @@
</span><span class="cx">
</span><span class="cx"> ###### JSON Encoding helper procs ######
</span><span class="cx">
</span><ins>+##
</ins><span class="cx"> # Return JSON encoding of a flat "key":"value" dictionary
</span><del>-proc json_encode_dict { data } {
</del><ins>+#
+# @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 ""}} {
</ins><span class="cx"> upvar 1 $data db
</span><span class="cx">
</span><span class="cx"> set size [dict size $db]
</span><span class="lines">@@ -116,56 +129,79 @@
</span><span class="cx"> set json "\{"
</span><span class="cx">
</span><span class="cx"> dict for {key values} $db {
</span><del>- set line "\"$key\":\"[dict get $db $key]\""
</del><ins>+ set line "\n${indent} \"$key\": \"[dict get $db $key]\""
</ins><span class="cx">
</span><span class="cx"> # Check if there are any subsequent items
</span><span class="cx"> if {$i < $size} {
</span><del>- set line "$line, "
- }
</del><ins>+ append line ","
+ }
</ins><span class="cx">
</span><span class="cx"> # Add line to the JSON string
</span><del>- set json "$json$line"
</del><ins>+ append json $line
</ins><span class="cx">
</span><span class="cx"> incr i
</span><span class="cx"> }
</span><span class="cx">
</span><del>- set json "$json\}"
</del><ins>+ if {$size > 0} {
+ append json "\n${indent}"
+ }
+ append json "\}"
</ins><span class="cx">
</span><span class="cx"> return $json
</span><span class="cx"> }
</span><span class="cx">
</span><ins>+##
</ins><span class="cx"> # Encodes a list of strings as a JSON array
</span><del>-proc json_encode_list { data } {
</del><ins>+#
+# @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 ""}} {
</ins><span class="cx"> set size [llength $data]
</span><span class="cx"> set i 1
</span><span class="cx">
</span><span class="cx"> set json "\["
</span><span class="cx">
</span><span class="cx"> foreach item $data {
</span><del>- set json "$json$data"
</del><ins>+ append json "\n "
+ append json $data
</ins><span class="cx">
</span><span class="cx"> # Check if there are any subsequent items
</span><span class="cx"> if {$i < $size} {
</span><del>- set json "$json, "
</del><ins>+ append json ","
</ins><span class="cx"> }
</span><span class="cx">
</span><span class="cx"> incr i
</span><span class="cx"> }
</span><span class="cx">
</span><del>- set json "$json \]"
</del><ins>+ if {$size > 0} {
+ append json "\n${indent}"
+ }
+ append json "\]"
</ins><span class="cx">
</span><span class="cx"> return $json
</span><span class="cx"> }
</span><span class="cx">
</span><ins>+##
</ins><span class="cx"> # Encode a port (from a portlist entry) as a JSON object
</span><del>-proc json_encode_port { port_info } {
</del><ins>+#
+# @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 ""}} {
</ins><span class="cx"> upvar 1 $port_info port
</span><span class="cx">
</span><span class="cx"> set first true
</span><span class="cx">
</span><span class="cx"> set json "\{"
</span><del>- foreach name [array names port] {
-
</del><ins>+ foreach name {name version variants} {
</ins><span class="cx"> # Skip empty strings
</span><span class="cx"> if {$port($name) eq ""} {
</span><span class="cx"> continue
</span><span class="lines">@@ -174,50 +210,69 @@
</span><span class="cx"> # Prepend a comma if this isn't the first item that has been processed
</span><span class="cx"> if {!$first} {
</span><span class="cx"> # Add a comma
</span><del>- set json "$json, "
- } else {
- set first false
- }
</del><ins>+ append json ", "
+ } else {
+ set first false
+ }
</ins><span class="cx">
</span><span class="cx"> # Format the entry as "name_string":"value"
</span><del>- set entry "\"$name\":\"$port($name)\""
- set json "$json$entry"
</del><ins>+ append json "\"$name\": \"$port($name)\""
</ins><span class="cx"> }
</span><span class="cx">
</span><del>- set json "$json\}"
</del><ins>+ append json "\}"
</ins><span class="cx">
</span><span class="cx"> return $json
</span><span class="cx"> }
</span><span class="cx">
</span><ins>+##
</ins><span class="cx"> # Encode portlist as a JSON array of port objects
</span><del>-proc json_encode_portlist { portlist } {
</del><ins>+#
+# @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 ""}} {
</ins><span class="cx"> set json "\["
</span><span class="cx"> set first true
</span><span class="cx">
</span><span class="cx"> foreach i $portlist {
</span><span class="cx"> array set port $i
</span><span class="cx">
</span><del>- set encoded [json_encode_port port]
</del><ins>+ set encoded [json_encode_port port "${indent} "]
</ins><span class="cx">
</span><span class="cx"> # Prepend a comma if this isn't the first item that has been processed
</span><span class="cx"> if {!$first} {
</span><span class="cx"> # Add a comma
</span><del>- set json "$json, "
- } else {
- set first false
- }
</del><ins>+ append json ","
+ } else {
+ set first false
+ }
</ins><span class="cx">
</span><span class="cx"> # Append encoded json object
</span><del>- set json "$json$encoded"
</del><ins>+ append json "\n${indent} ${encoded}"
</ins><span class="cx"> }
</span><span class="cx">
</span><del>- set json "$json\]"
</del><ins>+ if {!$first} {
+ append json "\n${indent}"
+ }
+ append json "\]"
</ins><span class="cx">
</span><span class="cx"> return $json
</span><span class="cx"> }
</span><span class="cx">
</span><del>-# Top level container for os and port data
-# Returns a JSON Object with three
</del><ins>+##
+# 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
</ins><span class="cx"> proc json_encode_stats {id os_dict ports_dict} {
</span><span class="cx"> upvar 1 $os_dict os
</span><span class="cx"> upvar 1 $ports_dict ports
</span><span class="lines">@@ -227,28 +282,47 @@
</span><span class="cx"> set inactive_ports_json [json_encode_portlist [dict get $ports "inactive"]]
</span><span class="cx">
</span><span class="cx"> set json "\{"
</span><del>- 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\}"
</del><ins>+ 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\}"
</ins><span class="cx">
</span><span class="cx"> return $json
</span><span class="cx"> }
</span><span class="cx">
</span><ins>+##
+# 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.
</ins><span class="cx"> proc split_variants {variants} {
</span><span class="cx"> set result {}
</span><span class="cx"> set l [regexp -all -inline -- {([-+])([[:alpha:]_]+[\w\.]*)} $variants]
</span><del>- foreach { match sign variant } $l {
</del><ins>+ foreach {match sign variant} $l {
</ins><span class="cx"> lappend result $variant $sign
</span><span class="cx"> }
</span><span class="cx"> return $result
</span><span class="cx"> }
</span><span class="cx">
</span><ins>+##
+# 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".
</ins><span class="cx"> proc get_installed_ports {active} {
</span><span class="cx"> set ilist {}
</span><del>- if { [catch {set ilist [registry::installed]} result] } {
- if {$result != "Registry error: No ports registered as installed."} {
</del><ins>+ if {[catch {set ilist [registry::installed]} result]} {
+ if {$result ne "Registry error: No ports registered as installed."} {
</ins><span class="cx"> ui_debug "$::errorInfo"
</span><span class="cx"> return -code error "registry::installed failed: $result"
</span><span class="cx"> }
</span><span class="lines">@@ -258,7 +332,7 @@
</span><span class="cx"> foreach i $ilist {
</span><span class="cx"> set iactive [lindex $i 4]
</span><span class="cx">
</span><del>- if {(${active} == "yes") == (${iactive} != 0)} {
</del><ins>+ if {(${active} eq "yes") == (${iactive} != 0)} {
</ins><span class="cx"> set iname [lindex $i 0]
</span><span class="cx"> set iversion [lindex $i 1]
</span><span class="cx"> set irevision [lindex $i 2]
</span><span class="lines">@@ -270,32 +344,37 @@
</span><span class="cx"> return $results
</span><span class="cx"> }
</span><span class="cx">
</span><del>-
</del><ins>+##
+# 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
</ins><span class="cx"> proc action_stats {subcommands} {
</span><span class="cx"> global stats_url stats_id
</span><span class="cx">
</span><ins>+ # If no subcommands are given (subcommands is empty) print out usage message
+ if {[llength $subcommands] == 0} {
+ usage
+ return 1
+ }
+
</ins><span class="cx"> # Build dictionary of os information
</span><span class="cx"> dict set os macports_version [macports::version]
</span><span class="cx"> dict set os osx_version ${macports::macosx_version}
</span><del>- dict set os os_arch ${macports::os_arch}
</del><ins>+ dict set os os_arch ${macports::os_arch}
</ins><span class="cx"> dict set os os_platform ${macports::os_platform}
</span><span class="cx"> dict set os build_arch ${macports::build_arch}
</span><span class="cx"> dict set os gcc_version [getgccinfo]
</span><span class="cx"> dict set os xcode_version ${macports::xcodeversion}
</span><span class="cx">
</span><del>- # Build dictionary of port information
</del><ins>+ # Build dictionary of port information
</ins><span class="cx"> dict set ports active [get_installed_ports yes]
</span><span class="cx"> dict set ports inactive [get_installed_ports no]
</span><span class="cx">
</span><del>- # 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
- }
-
</del><span class="cx"> # Make sure there aren't too many subcommands
</span><span class="cx"> if {[llength $subcommands] > 1} {
</span><span class="cx"> ui_error "Please select only one subcommand."
</span><span class="lines">@@ -319,16 +398,18 @@
</span><span class="cx">
</span><span class="cx"> switch $cmd {
</span><span class="cx"> submit {
</span><del>- ui_notice "Submitting to $stats_url"
</del><ins>+ ui_notice "Submitting data to $stats_url ..."
</ins><span class="cx">
</span><span class="cx"> if {[catch {curl post "submission\[data\]=$json" $stats_url} value]} {
</span><span class="cx"> ui_error "$::errorInfo"
</span><span class="cx"> return 1
</span><span class="cx"> }
</span><ins>+
+ ui_notice "Success."
</ins><span class="cx"> }
</span><span class="cx"> show {
</span><del>- ui_notice "Would submit to $stats_url"
- ui_msg "submission\[data\]=$json"
</del><ins>+ ui_notice "Would submit the follwoing data to $stats_url:"
+ ui_msg "$json"
</ins><span class="cx"> }
</span><span class="cx"> default {
</span><span class="cx"> puts "Unknown subcommand."
</span><span class="lines">@@ -341,4 +422,4 @@
</span><span class="cx"> }
</span><span class="cx">
</span><span class="cx"> read_config
</span><del>-action_stats $argv
</del><ins>+exit [action_stats $argv]
</ins></span></pre>
</div>
</div>
</body>
</html>