[45076] users/perry

[perry at macports.org]

Revision: 45076
          http://trac.macports.org/changeset/45076
Author:   perry at macports.org
Date:     2009-01-07 23:52:21 -0800 (Wed, 07 Jan 2009)
Log Message:
-----------
perry/port_cutleaves - Committed an initial version of port_cutleaves.

Added Paths:
-----------
    users/perry/port_cutleaves/
    users/perry/port_cutleaves/port_cutleaves

Added: users/perry/port_cutleaves/port_cutleaves
===================================================================
--- users/perry/port_cutleaves/port_cutleaves	                        (rev 0)
+++ users/perry/port_cutleaves/port_cutleaves	2009-01-08 07:52:21 UTC (rev 45076)
@@ -0,0 +1,118 @@
+#!/usr/bin/tclsh
+# $Id$
+
+catch {source [file join "/Library/Tcl" macports1.0 macports_fastload.tcl]}
+package require macports
+
+# Iterates through the list of ports, prompting the user to:
+#   * keep the specified port.
+#   * uninstall the specified port.
+#   * flush any uninstallation operations.
+#   * abort the procedure.
+# Upon flush or reaching the end of the list, (1) any ports marked for
+# uninstallation are uninstalled and (2) a summary is displayed.
+proc cut_leaves {ports} {
+    set current_port        1
+    set total_ports         [llength $ports]
+    set ports_to_uninstall  {}
+
+    if {$total_ports < 1} {
+        return
+    }
+    foreach port $ports {
+        set name                [lindex $port 0]
+        set version             [lindex $port 1]
+        set revision            [lindex $port 2]
+        set variants            [lindex $port 3]
+        set is_active           [lindex $port 4]
+        set composite_version   "${version}_${revision}${variants}"
+        set port                "$name @$composite_version"
+
+        if {$is_active == 0} {
+            set status " \(Inactive)"
+        } else {
+            set status " \(Active)"
+        }
+
+        puts "\[Port $current_port of $total_ports] ${port}${status}:"
+        puts -nonewline "  \[keep] / (u)install / (f)lush / (a)bort: "
+        flush stdout
+
+        gets stdin action
+        switch -glob $action {
+            a*      {
+                puts "** Aborting..."
+                exit 0
+            }
+            f*      {
+                puts "** Flushing...\n"
+                break
+            }
+            u*      {
+                puts "** Marked $port for uninstallation.\n"
+                lappend ports_to_uninstall [list $name $composite_version]
+            }
+            default { puts "** $port will be kept.\n" }
+        }
+
+        set current_port [expr {$current_port + 1}]
+    }
+
+    if {[llength $ports_to_uninstall] < 1} {
+        puts "No ports were marked for uninstallation."
+    } else {
+        set uninstalled_ports [uninstall $ports_to_uninstall]
+
+        if {[llength $uninstalled_ports] < 1} {
+            puts "\nNo ports were uninstalled."
+        } else {
+            puts "\nThe following ports were uninstalled:"
+            foreach port $uninstalled_ports {
+                puts "  $port"
+            }
+        }
+    }
+}
+
+# Returns the list of installed ports with no dependents.
+proc get_installed_with_no_dependents {} {
+    registry::open_dep_map
+
+    set ports {}
+    foreach port [registry::installed] {
+        set name [lindex $port 0]
+        set dependents [registry::list_dependents $name]
+
+        if {[llength $dependents] < 1} {
+            lappend ports $port
+        }
+    }
+    return $ports
+}
+
+# Uninstalls the specified ports, displaying any encountered errors on stderr.
+proc uninstall {ports} {
+    set uninstalled_ports {}
+
+    if {[llength $ports] < 1} {
+        return;
+    }
+    foreach port $ports {
+        set name              [lindex $port 0]
+        set composite_version [lindex $port 1]
+
+        if {[catch {portuninstall::uninstall $name $composite_version {}} \
+                   result]} {
+            puts stderr "portuninstall failed: $result"
+        } else {
+            lappend uninstalled_ports "$name @$composite_version"
+        }
+    }
+    return $uninstalled_ports;
+}
+
+if {[catch {mportinit} result]} {
+    puts stderr "mportinit failed: $result"
+    exit 1
+}
+cut_leaves [get_installed_with_no_dependents]


Property changes on: users/perry/port_cutleaves/port_cutleaves
___________________________________________________________________
Added: svn:executable
   + *
Added: svn:keywords
   + Id
Added: svn:eol-style
   + native
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.macosforge.org/pipermail/macports-changes/attachments/20090107/bd49f68e/attachment.html>