[44676] users/perry/base-select/src
perry at macports.org
perry at macports.org
Thu Jan 1 18:39:47 PST 2009
Revision: 44676
http://trac.macports.org/changeset/44676
Author: perry at macports.org
Date: 2009-01-01 18:39:47 -0800 (Thu, 01 Jan 2009)
Log Message:
-----------
base-select/src - Cleaned up action_select and mportselect.
* action_select displays specific error message.
* mportselect returns with code 'error' on error.
Modified Paths:
--------------
users/perry/base-select/src/macports1.0/macports.tcl
users/perry/base-select/src/port/port.tcl
Modified: users/perry/base-select/src/macports1.0/macports.tcl
===================================================================
--- users/perry/base-select/src/macports1.0/macports.tcl 2009-01-02 02:39:02 UTC (rev 44675)
+++ users/perry/base-select/src/macports1.0/macports.tcl 2009-01-02 02:39:47 UTC (rev 44676)
@@ -2338,51 +2338,60 @@
}
# 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 confpath "$macports::prefix/etc/select/$group"
- if {![file isdirectory $confpath]} {
- ui_debug "The specified group '$group' does not exist."
- return ""
+ 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 $confpath *]}]} {
- ui_debug "No versions were found for the group '$group'."
- return ""
+ if {[catch {set versions [glob -directory $conf_path *]}]} {
+ return -code error [concat "No configurations associated " \
+ "with '$group' were found."]
}
- # Return the list of versions, excluding base.
+ # 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 ne "base"} {
- lappend lversions [file tail $v]
+ if {$v eq "base" || $v eq "current"} {
+ continue
}
+ lappend lversions [file tail $v]
}
- return $lversions
+ return [lsort $lversions]
}
set {
- # Use $confpath/$version to read in sources.
- if {[catch {set src_file [open "$confpath/$version"]}]} {
- ui_debug [concat "The file '$confpath/$version' could " \
- "not be opened. This likely means " \
- "that the specified version is invalid."]
- return ""
+ # 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 $confpath/base to read in targets.
- if {[catch {set tgt_file [open "$confpath/base"]}]} {
- ui_debug "The file '$confpath/base' could not be opened."
- return ""
+ # 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]
@@ -2414,16 +2423,15 @@
}
# Update the selected version.
- set selected_version "$confpath/current"
+ set selected_version "$conf_path/current"
if {[file exists $selected_version]} {
file delete $selected_version
}
symlink $version $selected_version
-
- return "Success"
+ return
}
show {
- set selected_version "$confpath/current"
+ set selected_version "$conf_path/current"
if {![file exists $selected_version]} {
return "none"
@@ -2432,5 +2440,5 @@
}
}
}
- return ""
+ return
}
Modified: users/perry/base-select/src/port/port.tcl
===================================================================
--- users/perry/base-select/src/port/port.tcl 2009-01-02 02:39:02 UTC (rev 44675)
+++ users/perry/base-select/src/port/port.tcl 2009-01-02 02:39:47 UTC (rev 44676)
@@ -1756,7 +1756,6 @@
proc action_select { action portlist opts } {
ui_debug "action_select \[$portlist] \[$opts]..."
- set commands [array names [array set {} $opts]]
# Error out if no group is specified.
if {[llength $portlist] < 1} {
ui_error "port select \[--list|--set|--show] \[<group> \[<version]]"
@@ -1764,15 +1763,16 @@
}
set group [lindex $portlist 0]
- # If no command (--set, --show, --list) is specified, *but* more than one
- # argument is specified, assume the user intended to use the set command.
+ 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, fall back to the show command.
+ # 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 " \
@@ -1794,14 +1794,12 @@
"arguments. Extra arguments will be ignored."]
}
- ui_debug "Executing mportselect(list, $group)..."
-
- # If "" is returned, an error occurred. Check the debug output.
- if {[set versions [mportselect $command $group]] eq ""} {
- ui_error [concat "The 'list' command failed. Enable " \
- "debug mode to see why."]
+ # 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"
@@ -1820,11 +1818,9 @@
}
set version [lindex $portlist 1]
- ui_debug "Executing mportselect($command, $group, $version)..."
-
puts -nonewline "Selecting '$version' for '$group' "
- if {[mportselect $command $group $version] eq ""} {
- puts "failed. Enable debug mode to see why."
+ if {[catch {mportselect $command $group $version} result]} {
+ puts "failed: $result"
return 1
}
puts "succeeded. '$version' is now active."
@@ -1836,12 +1832,8 @@
"arguments. Extra arguments will be ignored."]
}
- ui_debug "Executing mportselect($command, $group)..."
-
- # If "" is returned, an error occurred. Check the debug output.
- if {[set selected_version [mportselect $command $group]] eq ""} {
- ui_error [concat "The 'show' command failed. Enable " \
- "debug mode to see why."]
+ 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 " \
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.macosforge.org/pipermail/macports-changes/attachments/20090101/b80dd968/attachment-0001.html>
More information about the macports-changes
mailing list