[44693] trunk/base
perry at macports.org
perry at macports.org
Thu Jan 1 20:12:40 PST 2009
Revision: 44693
http://trac.macports.org/changeset/44693
Author: perry at macports.org
Date: 2009-01-01 20:12:40 -0800 (Thu, 01 Jan 2009)
Log Message:
-----------
base/src - Merged in perry/base-select, which integrates *_select into port.
* Adds action_select (port.tcl) and mportselect (macports.tcl).
* Addresses Ticket #17477.
Modified Paths:
--------------
trunk/base/src/macports1.0/macports.tcl
trunk/base/src/port/port.tcl
Property Changed:
----------------
trunk/base/
Property changes on: trunk/base
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/variant-descs-14482/base:34469-34855,34900-37508,37511-37512,41040-41463,42575-42626,42640-42659
+ /branches/variant-descs-14482/base:34469-34855,34900-37508,37511-37512,41040-41463,42575-42626,42640-42659
/users/perry/base-select:44044-44692
Modified: trunk/base/src/macports1.0/macports.tcl
===================================================================
--- trunk/base/src/macports1.0/macports.tcl 2009-01-02 03:59:50 UTC (rev 44692)
+++ trunk/base/src/macports1.0/macports.tcl 2009-01-02 04:12:40 UTC (rev 44693)
@@ -2336,3 +2336,109 @@
# close the port handle
mportclose $workername
}
+
+# mportselect
+# * command: The only valid commands are list, set and show
+# * group: This argument should correspond to a directory under
+# $macports::prefix/etc/select.
+# * version: This argument is only used by the 'set' command.
+# On error mportselect returns with the code 'error'.
+proc mportselect {command group {version ""}} {
+ ui_debug "mportselect \[$command] \[$group] \[$version]"
+
+ set conf_path "$macports::prefix/etc/select/$group"
+ if {![file isdirectory $conf_path]} {
+ return -code error "The specified group '$group' does not exist."
+ }
+
+ switch -- $command {
+ list {
+ if {[catch {set versions [glob -directory $conf_path *]}]} {
+ return -code error [concat "No configurations associated " \
+ "with '$group' were found."]
+ }
+
+ # Return the sorted list of versions (excluding base and current).
+ set lversions {}
+ foreach v $versions {
+ # Only the file name corresponds to the version name.
+ set v [file tail $v]
+ if {$v eq "base" || $v eq "current"} {
+ continue
+ }
+ lappend lversions [file tail $v]
+ }
+ return [lsort $lversions]
+ }
+ set {
+ # Use $conf_path/$version to read in sources.
+ if {[catch {set src_file [open "$conf_path/$version"]}]} {
+ return -code error [concat "Verify that the specified " \
+ "version '$version' is valid " \
+ "(i.e., Is it listed when you " \
+ "specify the --list command?)."]
+ }
+ set srcs [split [read -nonewline $src_file] "\n"]
+ close $src_file
+
+ # Use $conf_path/base to read in targets.
+ if {[catch {set tgt_file [open "$conf_path/base"]}]} {
+ return -code error [concat "The configuration file " \
+ "'$conf_path/base' could not be " \
+ "opened."]
+ }
+ set tgts [split [read -nonewline $tgt_file] "\n"]
+ close $tgt_file
+
+ # Iterate through the configuration files executing the specified
+ # actions.
+ set i 0
+ foreach tgt $tgts {
+ set src [lindex $srcs $i]
+
+ switch -glob -- $src {
+ - {
+ # The source is unavailable for this file.
+ set tgt [file join $macports::prefix $tgt]
+ file delete $tgt
+ ui_debug "rm -f $tgt"
+ }
+ /* {
+ # The source is an absolute path.
+ set tgt [file join $macports::prefix $tgt]
+ file delete $tgt
+ file link -symbolic $tgt $src
+ ui_debug "ln -sf $src $tgt"
+ }
+ default {
+ # The source is a relative path.
+ set src [file join $macports::prefix $src]
+ set tgt [file join $macports::prefix $tgt]
+ file delete $tgt
+ file link -symbolic $tgt $src
+ ui_debug "ln -sf $src $tgt"
+ }
+ }
+ set i [expr $i+1]
+ }
+
+ # Update the selected version.
+ set selected_version "$conf_path/current"
+ if {[file exists $selected_version]} {
+ file delete $selected_version
+ }
+ symlink $version $selected_version
+ return
+ }
+ show {
+ set selected_version "$conf_path/current"
+
+ if {![file exists $selected_version]} {
+ return "none"
+ } else {
+ return [file readlink $selected_version]
+ }
+ }
+ }
+ return
+}
Modified: trunk/base/src/port/port.tcl
===================================================================
--- trunk/base/src/port/port.tcl 2009-01-02 03:59:50 UTC (rev 44692)
+++ trunk/base/src/port/port.tcl 2009-01-02 04:12:40 UTC (rev 44693)
@@ -1753,6 +1753,101 @@
}
+proc action_select { action portlist opts } {
+ ui_debug "action_select \[$portlist] \[$opts]..."
+
+ # Error out if no group is specified.
+ if {[llength $portlist] < 1} {
+ ui_error "port select \[--list|--set|--show] <group> \[<version>]"
+ return 1
+ }
+ set group [lindex $portlist 0]
+
+ set commands [array names [array set {} $opts]]
+ # If no command (--set, --show, --list) is specified *but* more than one
+ # argument is specified, default to the set command.
+ if {[llength $commands] < 1 && [llength $portlist] > 1} {
+ set command set
+ ui_debug [concat "Although no command was specified, more than " \
+ "one argument was specified. Defaulting to the " \
+ "'set' command..."]
+ # If no command (--set, --show, --list) is specified *and* less than two
+ # argument are specified, default to the show command.
+ } elseif {[llength $commands] < 1} {
+ set command show
+ ui_debug [concat "No command was specified. Defaulting to the " \
+ "'show' command..."]
+ # Only allow one command to be specified at a time.
+ } elseif {[llength $commands] > 1} {
+ ui_error [concat "Multiple commands were specified. Only one " \
+ "command may be specified at a time."]
+ return 1
+ } else {
+ set command [string map {ports_select_ ""} [lindex $commands 0]]
+ ui_debug "The '$command' command was specified."
+ }
+
+ switch -- $command {
+ list {
+ if {[llength $portlist] > 1} {
+ ui_warn [concat "The 'list' command does not expect any " \
+ "arguments. Extra arguments will be ignored."]
+ }
+
+ # On error mportselect returns with the code 'error'.
+ if {[catch {mportselect $command $group} versions]} {
+ ui_error "The 'list' command failed: $versions"
+ return 1
+ }
+
+ puts "Available Versions:"
+ foreach v $versions {
+ puts "\t$v"
+ }
+ return 0
+ }
+ set {
+ if {[llength $portlist] < 2} {
+ ui_error [concat "The 'set' command expects two " \
+ "arguments: <group>, <version>"]
+ return 1
+ } elseif {[llength $portlist] > 2} {
+ ui_warn [concat "The 'set' command only expects two " \
+ "arguments. Extra arguments will be " \
+ "ignored."]
+ }
+ set version [lindex $portlist 1]
+
+ puts -nonewline "Selecting '$version' for '$group' "
+ if {[catch {mportselect $command $group $version} result]} {
+ puts "failed: $result"
+ return 1
+ }
+ puts "succeeded. '$version' is now active."
+ return 0
+ }
+ show {
+ if {[llength $portlist] > 1} {
+ ui_warn [concat "The 'show' command does not expect any " \
+ "arguments. Extra arguments will be ignored."]
+ }
+
+ if {[catch {mportselect $command $group} selected_version]} {
+ ui_error "The 'show' command failed: $selected_version"
+ return 1
+ }
+ puts [concat "The currently selected version for '$group' is " \
+ "'$selected_version'."]
+ return 0
+ }
+ default {
+ ui_error "An unknown command '$command' was specified."
+ return 1
+ }
+ }
+}
+
+
proc action_selfupdate { action portlist opts } {
global global_options
if { [catch {macports::selfupdate [array get global_options]} result ] } {
@@ -2685,6 +2780,8 @@
activate [list action_activate [action_args_const ports]] \
deactivate [list action_deactivate [action_args_const ports]] \
\
+ select [list action_select [action_args_const strings]] \
+ \
sync [list action_sync [action_args_const none]] \
selfupdate [list action_selfupdate [action_args_const none]] \
\
@@ -2805,6 +2902,7 @@
clean {all archive dist work}
mirror {new}
lint {nitpick}
+ select {list set show}
}
global cmd_implied_options
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.macosforge.org/pipermail/macports-changes/attachments/20090101/099290db/attachment.html>
More information about the macports-changes
mailing list