[65546] trunk/base/src

[jmr at macports.org]

Revision: 65546
          http://trac.macports.org/changeset/65546
Author:   jmr at macports.org
Date:     2010-03-27 01:06:37 -0700 (Sat, 27 Mar 2010)
Log Message:
-----------
add requested/unrequested pseudo-ports and setrequested/unsetrequested actions

Modified Paths:
--------------
    trunk/base/src/port/port.tcl
    trunk/base/src/registry2.0/receipt_sqlite.tcl

Modified: trunk/base/src/port/port.tcl
===================================================================
--- trunk/base/src/port/port.tcl	2010-03-27 07:54:36 UTC (rev 65545)
+++ trunk/base/src/port/port.tcl	2010-03-27 08:06:37 UTC (rev 65546)
@@ -820,7 +820,43 @@
     return [portlist_sort $results]
 }
 
+# return ports that have registry property $propname set to $propval
+proc get_ports_with_prop {propname propval} {
+    set ilist {}
+    if { [catch {set ilist [registry::installed]} result] } {
+        if {$result != "Registry error: No ports registered as installed."} {
+            global errorInfo
+            ui_debug "$errorInfo"
+            fatal "port installed failed: $result"
+        }
+    }
 
+    set results {}
+    foreach i $ilist {
+        set iname [lindex $i 0]
+        set iversion [lindex $i 1]
+        set irevision [lindex $i 2]
+        set ivariants [lindex $i 3]
+        set iepoch [lindex $i 5]
+        set regref [registry::open_entry $iname $iversion $irevision $ivariants $iepoch]
+        if {[registry::property_retrieve $regref $propname] == $propval} {
+            add_to_portlist results [list name $iname version "${iversion}_${irevision}" variants [split_variants $ivariants]]
+        }
+    }
+
+    # Return the list of ports, sorted
+    return [portlist_sort $results]
+}
+
+proc get_requested_ports {} {
+    return [get_ports_with_prop requested 1]
+}
+
+proc get_unrequested_ports {} {
+    return [get_ports_with_prop requested 0]
+}
+
+
 ##########################################
 # Port expressions
 ##########################################
@@ -967,6 +1003,8 @@
         ^inactive(@.*)?$    -
         ^outdated(@.*)?$    -
         ^obsolete(@.*)?$    -
+        ^requested(@.*)?$   -
+        ^unrequested(@.*)?$ -
         ^current(@.*)?$     {
             # A simple pseudo-port name
             advance
@@ -2183,6 +2221,32 @@
 }
 
 
+proc action_setrequested { action portlist opts } {
+    set status 0
+    if {[require_portlist portlist]} {
+        return 1
+    }
+    # set or unset?
+    set val [string equal $action setrequested]
+    foreachport $portlist {
+        set composite_version [composite_version $portversion [array get variations]]
+        if {![catch {set ilist [registry::installed $portname $composite_version]}]} {
+            ui_info "Setting requested flag for $portname to $val"
+            foreach i $ilist {
+                set regref [registry::entry open $portname [lindex $i 1] [lindex $i 2] [lindex $i 3] [lindex $i 5]]
+                registry::property_store $regref requested $val
+            }
+        } else {
+            global errorInfo
+            ui_debug "$errorInfo"
+            break_softcontinue "$result" 1 status
+        }
+    }
+    
+    return $status
+}
+
+
 proc action_upgrade { action portlist opts } {
     if {[require_portlist portlist]} {
         return 1
@@ -3232,6 +3296,9 @@
     sync        [list action_sync           [ACTION_ARGS_NONE]] \
     selfupdate  [list action_selfupdate     [ACTION_ARGS_NONE]] \
     \
+    setrequested   [list action_setrequested  [ACTION_ARGS_PORTS]] \
+    unsetrequested [list action_setrequested  [ACTION_ARGS_PORTS]] \
+    \
     upgrade     [list action_upgrade        [ACTION_ARGS_PORTS]] \
     \
     version     [list action_version        [ACTION_ARGS_NONE]] \

Modified: trunk/base/src/registry2.0/receipt_sqlite.tcl
===================================================================
--- trunk/base/src/registry2.0/receipt_sqlite.tcl	2010-03-27 07:54:36 UTC (rev 65545)
+++ trunk/base/src/registry2.0/receipt_sqlite.tcl	2010-03-27 08:06:37 UTC (rev 65546)
@@ -137,6 +137,30 @@
     return $ret
 }
 
+##
+# Store a property in a registry entry.
+#
+# ref			reference to the entry.
+# property		key for the property to set.
+# value         value to set it to.
+proc property_store {ref property value} {
+    switch $property {
+        active {
+            if {!$value} {
+                $ref state "imaged"
+            } else {
+                $ref state "installed"
+            }
+        }
+        imagedir {
+            $ref location $value
+        }
+        default {
+            $ref $property $value
+        }
+    }
+}
+
 # Return installed ports
 #
 # If version is "", return all ports of that name.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.macosforge.org/pipermail/macports-changes/attachments/20100327/25a0e434/attachment.html>