[44052] users/perry/base-select/src

[perry at macports.org]

Revision: 44052
          http://trac.macports.org/changeset/44052
Author:   perry at macports.org
Date:     2008-12-19 22:30:12 -0800 (Fri, 19 Dec 2008)
Log Message:
-----------
base-select/src - Implemented --list and --set.

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	2008-12-20 05:09:46 UTC (rev 44051)
+++ users/perry/base-select/src/macports1.0/macports.tcl	2008-12-20 06:30:12 UTC (rev 44052)
@@ -2270,9 +2270,85 @@
 }
 
 # mportselect
-proc mportselect {action group {version ""}} {
-    ui_debug "mportselect \[$action] \[$group] \[$version]"
-    ui_warn "This is a stub."
+proc mportselect {command group {version ""}} {
+    ui_debug "mportselect \[$command] \[$group] \[$version]"
 
-    return 1
+    set confpath "$macports::prefix/etc/select/$group"
+    if {![file isdirectory $confpath]} {
+        ui_debug "The specified group '$group' does not exist."
+        return ""
+    }
+
+    switch -- $command {
+        list {
+            if {[catch {set versions [glob -directory $confpath *]}]} {
+                ui_debug "No versions were found for the group '$group'."
+                return ""
+            }
+
+            # Return the list of versions, excluding base.
+            set lversions {}
+            foreach v $versions {
+                if {$versions ne "base"} {
+                    lappend lversions [file tail $v]
+                }
+            }
+            return $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 ""
+            }
+            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 ""
+            }
+            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 "Success"
+        }
+        show {
+            ui_debug "The 'show' command has not been implemented yet."
+            return ""
+        }
+    }
+    return ""
 }

Modified: users/perry/base-select/src/port/port.tcl
===================================================================
--- users/perry/base-select/src/port/port.tcl	2008-12-20 05:09:46 UTC (rev 44051)
+++ users/perry/base-select/src/port/port.tcl	2008-12-20 06:30:12 UTC (rev 44052)
@@ -1704,7 +1704,18 @@
             }
 
             ui_debug "Executing mportselect(list, $group)..."
-            return [mportselect $command $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."]
+                return 1
+            }
+            puts "Available Versions:"
+            foreach v $versions {
+                puts "\t$v"
+            }
+            return 0
         }
         set {
             if {[llength $portlist] < 2} {
@@ -1719,7 +1730,14 @@
             set version [lindex $portlist 1]
 
             ui_debug "Executing mportselect($command, $group, $version)..."
-            return [mportselect $command $group $version]
+
+            puts -nonewline "Selecting '$version' for '$group' "
+            if {[mportselect $command $group $version] eq ""} {
+                puts "failed. Enable debug mode to see why."
+                return 1
+            }
+            puts "succeeded. '$version' is now active."
+            return 0
         }
         show {
             if {[llength $portlist] > 1} {
@@ -1728,7 +1746,16 @@
             }
 
             ui_debug "Executing mportselect($command, $group)..."
-            return [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."]
+                return 1
+            }
+            puts [concat "The currently selected version for '$group' is " \
+                         "'$selected_version'."]
+            return 0
         }
         default {
             ui_error "An unknown command '$command' was specified."
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.macosforge.org/pipermail/macports-changes/attachments/20081219/accee7c0/attachment.html>