[45294] users/perry/port_cutleaves/port_cutleaves
perry at macports.org
perry at macports.org
Mon Jan 12 20:44:50 PST 2009
Revision: 45294
http://trac.macports.org/changeset/45294
Author: perry at macports.org
Date: 2009-01-12 20:44:49 -0800 (Mon, 12 Jan 2009)
Log Message:
-----------
perry/port_cutleaves - Added two new options and the ability to exclude leaves.
* -F: Specify a different file to read exclusions from <~/.port_leaves.exclude>
* -l: List leaves and exit
Modified Paths:
--------------
users/perry/port_cutleaves/port_cutleaves
Modified: users/perry/port_cutleaves/port_cutleaves
===================================================================
--- users/perry/port_cutleaves/port_cutleaves 2009-01-13 03:52:09 UTC (rev 45293)
+++ users/perry/port_cutleaves/port_cutleaves 2009-01-13 04:44:49 UTC (rev 45294)
@@ -5,17 +5,25 @@
set VERSION 0.1
+# - Procedures ---------------------------------------------------------------
+
+proc composite_version {port} {
+ return [version $port]_[revision $port][variants $port]
+}
+
proc cut_leaves {leaves {processed_leaves {}}} {
- # TODO: Use an array rather than a list.
+ # Filter out already processed leaves.
set to_process {}
foreach leaf $leaves {
- if {[lsearch -exact $processed_leaves $leaf] != -1} {
+ set full_name [full_name $leaf]
+ if {[lsearch -glob $processed_leaves $full_name] != -1} {
continue
}
- lappend processed_leaves $leaf
+ lappend processed_leaves $full_name
lappend to_process $leaf
}
+ # Return if there are no new leaves to process.
set total_leaves [llength $to_process]
if {$total_leaves < 1} {
puts "There are no new leaves to process."
@@ -25,25 +33,21 @@
set current_leaf 1
set to_uninstall {}
+ # Process each leaf.
foreach leaf $to_process {
- set name [lindex $leaf 0]
- set version [lindex $leaf 1]
- set revision [lindex $leaf 2]
- set variants [lindex $leaf 3]
- set is_active [lindex $leaf 4]
+ set composite_version [composite_version $leaf]
+ set full_name [full_name $leaf]
+ set name [name $leaf]
- set composite_version ${version}_${revision}${variants}
- set leaf "$name @$composite_version"
-
set status Active
- if {$is_active == 0} {
+ if {![is_active $leaf]} {
set status Inactive
}
- puts "\[Leaf $current_leaf of $total_leaves] $leaf ($status):"
+ # Execute the specified action.
+ puts "\[Leaf $current_leaf of $total_leaves] $full_name ($status):"
puts -nonewline " \[keep] / (u)ninstall / (f)lush / (a)bort: "
flush stdout
-
gets stdin action
switch -glob $action {
a* {
@@ -55,15 +59,16 @@
break
}
u* {
- puts "** $leaf will be uninstalled.\n"
- lappend to_uninstall [list $name $composite_version]
+ puts "** $full_name will be uninstalled.\n"
+ lappend to_uninstall $leaf
}
- default { puts "** $leaf will be kept.\n" }
+ default { puts "** $full_name will be kept.\n" }
}
set current_leaf [expr $current_leaf + 1]
}
+ # Uninstall the specified leaves.
if {[llength $to_uninstall] < 1} {
puts "No leaves were marked for uninstallation."
return 0
@@ -78,75 +83,132 @@
puts " $port"
}
+ # Search for new leaves.
puts "\nSearch for new leaves?"
puts -nonewline " \[no] / (y)es: "
flush stdout
-
gets stdin choice
if {[regexp {^y} $choice]} {
puts {}
return [cut_leaves [leaves] $processed_leaves]
}
+
return 0
}
+proc exclusions {file} {
+ if {![file exists $file]} {
+ return {}
+ } elseif {[catch {set exclusions_file [open $file]} result]} {
+ puts stderr "Warning: open failed: $result"
+ return {}
+ }
+ set exclusions [split [read -nonewline $exclusions_file] \n]
+ close $exclusions_file
+ return $exclusions
+}
+
+proc full_name {port} {
+ return "[name $port] @[composite_version $port]"
+}
+
+proc is_active {port} {
+ return [lindex $port 4]
+}
+
proc leaves {} {
registry::open_dep_map
- set leaves {}
+ # Return a list of installed ports with no dependents.
if {[catch {set installed [registry::installed]} result]} {
puts stderr "Error: registry::installed failed: $result"
- } else {
- foreach port $installed {
- set name [lindex $port 0]
- if {[llength [registry::list_dependents $name]] < 1} {
- lappend leaves $port
- }
+ return {}
+ }
+ set leaves {}
+ foreach port $installed {
+ if {[llength [registry::list_dependents [name $port]]] < 1} {
+ lappend leaves $port
}
}
return $leaves
}
+proc list_leaves {{exclusions {}}} {
+ foreach leaf [leaves] {
+ set full_name [full_name $leaf]
+ if {[lsearch -exact $exclusions $full_name] != -1} {
+ continue
+ }
+ puts $full_name
+ }
+}
+
+proc name {port} {
+ return [lindex $port 0]
+}
+
+proc revision {port} {
+ return [lindex $port 2]
+}
+
proc uninstall {ports} {
set uninstalled {}
foreach port $ports {
- set name [lindex $port 0]
- set composite_version [lindex $port 1]
-
- if {[catch {portuninstall::uninstall $name $composite_version {}} \
+ if {[catch {portuninstall::uninstall [name $port] \
+ [composite_version $port] {}} \
result]} {
puts stderr "Error: portuninstall:uninstall failed: $result"
} else {
- lappend uninstalled "$name @$composite_version"
+ lappend uninstalled [full_name $port]
}
}
return $uninstalled
}
+proc variants {port} {
+ return [lindex $port 3]
+}
+
+proc version {port} {
+ return [lindex $port 1]
+}
+
+# - Main ---------------------------------------------------------------------
+
+# Parse the command line arguments.
package require cmdline
set options {
+ { F.arg ~/.port_leaves.exclude \
+ "Specify a different file to read exclusions from" }
+ { l "List leaves and exit"}
{ t.arg /Library/Tcl \
"Specify a different location for the base MacPorts Tcl file" }
{ V "Display version information and exit" }
}
-set usage "\[-t value] \[-V] \[-help] \[-?]\n\nOptions:"
-if {[catch {array set parameters [::cmdline::getoptions argv $options]}]} {
+set usage "\[-F value] \[-l] \[-t value] \[-V] \[-help] \[-?]\n\nOptions:"
+if {[catch {array set option [::cmdline::getoptions argv $options]}]} {
puts [::cmdline::usage $options $usage]
exit 1
}
-if {[catch {source $parameters(t)/macports1.0/macports_fastload.tcl} \
+# Initialize the MacPorts system.
+if {[catch {source $option(t)/macports1.0/macports_fastload.tcl} \
result]} {
puts stderr "Error: source failed: $result"
exit 1
}
package require macports
-
-if {$parameters(V) == 1} {
- puts port_cutleaves-$VERSION
- exit 0
-} elseif {[catch {mportinit} result]} {
+if {[catch {mportinit} result]} {
puts stderr "Error: mportinit failed: $result"
exit 1
}
-exit [cut_leaves [leaves]]
+
+# Execute the specified action.
+if {$option(V)} {
+ puts port_cutleaves-$VERSION
+} elseif {$option(l)} {
+ list_leaves [exclusions $option(F)]
+} else {
+ exit [cut_leaves [leaves] [exclusions $option(F)]]
+}
+exit 0
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.macosforge.org/pipermail/macports-changes/attachments/20090112/a72693e7/attachment.html>
More information about the macports-changes
mailing list