[79349] trunk/base/src/port

[jmr at macports.org]

Revision: 79349
          http://trac.macports.org/changeset/79349
Author:   jmr at macports.org
Date:     2011-06-09 23:39:14 -0700 (Thu, 09 Jun 2011)
Log Message:
-----------
add 'space' action to display disk space used by ports (#27244)

Modified Paths:
--------------
    trunk/base/src/port/port-help.tcl
    trunk/base/src/port/port.tcl

Modified: trunk/base/src/port/port-help.tcl
===================================================================
--- trunk/base/src/port/port-help.tcl	2011-06-10 05:26:31 UTC (rev 79348)
+++ trunk/base/src/port/port-help.tcl	2011-06-10 06:39:14 UTC (rev 79349)
@@ -293,6 +293,13 @@
 Upgrade MacPorts itself and run the sync target
 }
 
+set porthelp(space) {
+Show the disk space used by the given ports
+
+--units <units> Specify units to use. Accepted units are: B, kB, KiB, MB, MiB,
+                GB, GiB. The 'B' may be omitted.
+}
+
 set porthelp(srpm) {
 Creates a srpm for each of the given ports
 }

Modified: trunk/base/src/port/port.tcl
===================================================================
--- trunk/base/src/port/port.tcl	2011-06-10 05:26:31 UTC (rev 79348)
+++ trunk/base/src/port/port.tcl	2011-06-10 06:39:14 UTC (rev 79349)
@@ -154,7 +154,51 @@
 }
 
 
+# Format an integer representing bytes using given units
+proc bytesize {siz {unit {}}} {
+    if {$unit == {}} {
+        if {$siz > 0x40000000} {
+            set unit "GiB"
+        } elseif {$siz > 0x100000} {
+            set unit "MiB"
+        } elseif {$siz > 0x400} {
+            set unit "KiB"
+        } else {
+            set unit "B"
+        }
+    }
+    switch -- $unit {
+        KiB {
+            set siz [expr $siz / 1024.0]
+        }
+        kB {
+            set siz [expr $siz / 1000.0]
+        }
+        MiB {
+            set siz [expr $siz / 1048576.0]
+        }
+        MB {
+            set siz [expr $siz / 1000000.0]
+        }
+        GiB {
+            set siz [expr $siz / 1073741824.0]
+        }
+        GB {
+            set siz [expr $siz / 1000000000.0]
+        }
+        B { }
+        default {
+            ui_warn "Unknown file size unit '$unit' specified"
+            set unit "B"
+        }
+    }
+    if {[expr round($siz)] != $siz} {
+        set siz [format {%.3f} $siz]
+    }
+    return "$siz $unit"
+}
 
+
 # Produce an error message, and exit, unless
 # we're handling errors in a soft fashion, in which
 # case we continue
@@ -3086,6 +3130,64 @@
     return $status
 }
 
+# expand abbreviations of size units
+proc complete_size_units {units} {
+    if {$units == "K" || $units == "Ki"} {
+        return "KiB"
+    } elseif {$units == "k"} {
+        return "kB"
+    } elseif {$units == "Mi"} {
+        return "MiB"
+    } elseif {$units == "M"} {
+        return "MB"
+    } elseif {$units == "Gi"} {
+        return "GiB"
+    } elseif {$units == "G"} {
+        return "GB"
+    } else {
+        return $units
+    }
+}
+
+# Show space used by the given ports' files
+proc action_space {action portlist opts} {
+    global global_options
+    require_portlist portlist
+
+    set units {}
+    if {[info exists global_options(ports_space_units)]} {
+        set units [complete_size_units $global_options(ports_space_units)]
+    }
+    set spaceall 0.0
+    foreachport $portlist {
+        set space 0.0
+        set files [registry::port_registered $portname]
+        if { $files != 0 } {
+            if { [llength $files] > 0 } {
+                foreach file $files {
+                    catch {
+                        set space [expr $space + [file size $file] ]
+                    }
+                }
+                set msg "[bytesize $space $units] $portname"
+                if { $portversion != {} } {
+                    append msg " @$portversion"
+                }
+                puts $msg
+                set spaceall [expr $space + $spaceall]
+            } else {
+                puts "Port $portname does not contain any file or is not active."
+            }
+        } else {
+            puts "Port $portname is not installed."
+        }
+    }
+    if {[llength $portlist] > 1} {
+        puts "[bytesize $spaceall $units] total"
+    }
+    return 0
+}
+
 proc action_variants { action portlist opts } {
     global global_variations
     set status 0
@@ -3778,6 +3880,7 @@
     installed   [list action_installed      [ACTION_ARGS_PORTS]] \
     outdated    [list action_outdated       [ACTION_ARGS_PORTS]] \
     contents    [list action_contents       [ACTION_ARGS_PORTS]] \
+    space       [list action_space          [ACTION_ARGS_PORTS]] \
     dependents  [list action_dependents     [ACTION_ARGS_PORTS]] \
     rdependents [list action_dependents     [ACTION_ARGS_PORTS]] \
     deps        [list action_deps           [ACTION_ARGS_PORTS]] \
@@ -3919,6 +4022,7 @@
                  long_description maintainer maintainers name platform
                  platforms portdir regex revision variant variants version}
     selfupdate  {nosync}
+    space       {{units 1}}
     activate    {no-exec}
     deactivate  {no-exec}
     uninstall   {follow-dependents follow-dependencies no-exec}
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.macosforge.org/pipermail/macports-changes/attachments/20110609/870b65c1/attachment.html>