Ticket #17477: port.tcl.diff

port.tcl

@@ -1668 +1668 @@
     return $status
 }
 
+proc action_select { action portlist opts } {
+    if {[llength $portlist] < 2} {
+        ui_error "port select <module> <action> <options>"
+        return 1
+    }
+    set module [lindex $portlist 0]
+    set action [lindex $portlist 1]
+
+    # By default the $confpath is $prefix/etc/select/$module.
+    set confpath "$macports::prefix/etc/select/$module"
+    if {![file isdirectory $confpath]} {
+        ui_error "The specified module $module does not exist."
+        return 1
+    }
+
+    # Currently the only two valid actions are list and set.
+    switch -- $action {
+        list {
+            if {[catch {set versions [glob -directory $confpath *]}]} {
+                ui_error "No versions were found for $module"
+                return 1
+            }
+
+            puts "Available Versions:"
+            foreach version [lsort $versions] {
+                set version [file tail $version]
+                # Ignore base.
+                if {$version ne "base"} {
+                    puts "\t$version"
+                }
+            }
+        }
+        set {
+            # The set action expects a third argument: the version.
+            if {[llength $portlist] != 3} {
+                ui_error "Specify a version (e.g., port select $module set <version>)"
+                return 1;
+            }
+            set version [lindex $portlist 2]
+
+            if {[catch {set versions [glob -directory $confpath *]}]} {
+                ui_error "No versions were found for $module"
+                return 1
+            }
+
+            # Make sure the specified version is valid.
+            foreach v $versions {
+                set v [file tail $v]
+
+                if {$v ne "base" && $v eq $version} {
+                    puts "Selecting version $version for $module"
+
+                    # Use $confpath/$version to read in sources.
+                    if {[catch {set src_file [open [file join $confpath $version]]}]} {
+                        ui_error "Could not open $confpath/$version"
+                        return 1
+                    }
+                    set srcs [split [read -nonewline $src_file] "\n"]
+                    close $src_file
+
+                    # Use $confpath/base to read in targets.
+                    if {[catch {set tgt_file [open [file join $confpath "base"]]}]} {
+                        ui_error "Could not open $confpath/base"
+                        return 1
+                    }
+                    set tgts [split [read -nonewline $tgt_file] "\n"]
+                    close $tgt_file
+
+                    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]
+                    }
+                return 0
+                }
+            }
+            ui_error "The specified version $version is invalid"
+            return 1
+        }
+        default {
+            ui_error "The specified action $action does not exist"
+            return 1
+        }
+    }
+    return 0
+}
 
 proc action_selfupdate { action portlist opts } {
     global global_options
@@ -2624 +2734 @@
     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]] \
     \