Changeset 2084 for trunk/base

Timestamp:

Feb 26, 2003, 12:08:23 PM (21 years ago)

Author:

kevin

Message:

Re-use the Port API dependency engine for handling portfile dependencies.
Allow multiple Portfiles to be opened simultaneously.
Bug#: 333, 354

Location:

trunk/base/src/darwinports1.0

Files:

• darwinports.tcl (modified) (7 diffs)
• darwinports_dlist.tcl (modified) (5 diffs)

trunk/base/src/darwinports1.0/darwinports.tcl

@@ -30 +30 @@
 #
 package provide darwinports 1.0
+package require darwinports_dlist 1.0
 
 namespace eval darwinports {
-    namespace export bootstrap_options portinterp_options uniqid 0
+    namespace export bootstrap_options portinterp_options open_dports
     variable bootstrap_options "portdbpath libpath auto_path sources_conf prefix"
     variable portinterp_options "portdbpath portpath auto_path prefix portsharepath"
-    variable uniqid 0
+        
+        variable open_dports {}
 }
 
@@ -66 +68 @@
 
 proc dportinit {args} {
-    global auto_path env darwinports::portdbpath darwinports::bootstrap_options darwinports::uniqid darwinports::portinterp_options darwinports::portconf darwinports::sources darwinports::sources_conf darwinports::portsharepath
+    global auto_path env darwinports::portdbpath darwinports::bootstrap_options darwinports::portinterp_options darwinports::portconf darwinports::sources darwinports::sources_conf darwinports::portsharepath
 
     if {[llength [array names env HOME]] > 0} {
@@ -145 +147 @@
 
 proc darwinports::worker_init {workername portpath options variations} {
-    global darwinports::uniqid darwinports::portinterp_options auto_path
+    global darwinports::portinterp_options auto_path
 
     # Create package require abstraction procedure
@@ -167 +169 @@
             $workername eval set system_options($opt) \"[set $opt]\"
             $workername eval set $opt \"[set $opt]\"
-        }
+        } #"
     }
 
@@ -231 +233 @@
 }
 
+# dportopen
+# Opens a DarwinPorts portfile specified by a URL.  The portfile is
+# opened with the given list of options and variations.  The result
+# of this function should be treated as an opaque handle to a
+# DarwinPorts Portfile.
+
 proc dportopen {porturl {options ""} {variations ""}} {
-    global darwinports::uniqid darwinports::portinterp_options darwinports::portdbpath darwinports::portconf auto_path
-    set portdir [darwinports::getportdir $porturl]
-    cd $portdir
-    set portpath [pwd]
-    set workername workername[incr uniqid]
-    interp create $workername
+    global darwinports::portinterp_options darwinports::portdbpath darwinports::portconf darwinports::open_dports auto_path
+
+        # Look for an already-open DPort with the same URL.
+        # XXX: should compare options and variations here too.
+        # if found, return the existing reference and bump the refcount.
+        set dport [dlist_search $darwinports::open_dports porturl $porturl]
+        if {$dport != {}} {
+                set refcnt [ditem_key $dport refcnt]
+                incr refcnt
+                ditem_key $dport refcnt $refcnt
+                return $dport
+        }
+
+        set portdir [darwinports::getportdir $porturl]
+        cd $portdir
+        set portpath [pwd]
+        set workername [interp create]
+
+        set dport [ditem_create]
+        lappend darwinports::open_dports $dport
+        ditem_key $dport porturl $porturl
+        ditem_key $dport portpath $portpath
+        ditem_key $dport workername $workername
+        ditem_key $dport options $options
+        ditem_key $dport variations $variations
+        ditem_key $dport refcnt 1
+
     darwinports::worker_init $workername $portpath $options $variations
     if ![file isfile Portfile] {
         return -code error "Could not find Portfile in $portdir"
     }
+
     $workername eval source Portfile
-
-    return $workername
-}
-
-proc dportexec {workername target} {
-    global darwinports::portinterp_options darwinports::uniqid
-
+        
+        ditem_key $dport provides [$workername eval return \$portname]
+
+    return $dport
+}
+
+proc _dporttest {dport} {
+        # Check for the presense of the port in the registry
+        set workername [ditem_key $dport workername]
+        set res [$workername eval registry_exists \${portname} \${portversion}]
+        if {$res != ""} {
+                return 1
+        } else {
+                return 0
+        }
+}
+
+proc _dportexec {target dport} {
+        set workername [ditem_key $dport workername]
+        return [$workername eval eval_targets $target]
+}
+
+# dportexec
+# Execute the specified target of the given dport.
+
+proc dportexec {dport target} {
+    global darwinports::portinterp_options
+
+        set workername [ditem_key $dport workername]
+
+        # XXX: move this into dportopen?
         if {[$workername eval eval_variants variations $target] != 0} {
                 return 1
         }
-
-        return [$workername eval eval_targets $target]
+        
+        # Before we build the port, we must build its dependencies.
+        # XXX: need a more general way of comparing against targets
+        set dlist {}
+        if {$target == "configure" || $target == "build" || $target == "install" ||
+                $target == "package" || $target == "mpkg"} {
+
+                dportdepends $dport 1 1
+                
+                # Select out the dependents along the critical path
+                set dlist [dlist_append_dependents $darwinports::open_dports $dport {}]
+                
+                # install them
+                set dlist [dlist_eval $darwinports::open_dports _dporttest [list _dportexec "install"]]
+        }
+
+        if {$dlist != {}} {
+                ui_error "$target terminated due to an error while installing a dependency."
+        } else {
+                return [$workername eval eval_targets $target]
+        }
+        return 0
 }
 
@@ -325 +399 @@
 }
 
-proc dportinfo {workername} {
+proc dportinfo {dport} {
+        set workername [ditem_key $dport workername]
     return [$workername eval array get PortInfo]
 }
 
-proc dportclose {workername} {
-    interp delete $workername
+proc dportclose {dport} {
+        global darwinports::open_dports
+        set refcnt [ditem_key $dport refcnt]
+        incr refcnt -1
+        ditem_key $dport refcnt $refcnt
+        if {$refcnt == 0} {
+                dlist_delete darwinports::open_dports $dport
+                set workername [ditem_key $dport workername]
+                interp delete $workername
+        }
 }
 
@@ -337 +420 @@
 ##### "
 
-# dportdepends returns a list of port names which the given port depends on.
-# xxx: should return the depspec itself once we have better depspec processing.
+# dportdepends returns a list of dports which the given port depends on.
 # - optionally includes the build dependencies in the list.
 # - optionally recurses through the dependencies, looking for dependencies
 #       of dependencies.
 
-proc dportdepends {portname includeBuildDeps recurseDeps} {
-        set result {}
-
-        if {[catch {set res [dportsearch "^$portname\$"]} error]} {
-                ui_puts err "Internal error: port search failed: $error"
-                return
-        }
-
-        foreach {name array} $res {
-                array set portinfo $array
-                set depends {}
-                if {[info exists portinfo(depends_run)]} { eval "lappend depends $portinfo(depends_run)" }
-                if {[info exists portinfo(depends_lib)]} { eval "lappend depends $portinfo(depends_lib)" }
-                if {$includeBuildDeps != "" && [info exists portinfo(depends_build)]} {
-                        eval "lappend depends $portinfo(depends_build)"
+proc dportdepends {dport includeBuildDeps recurseDeps} {
+        array set portinfo [dportinfo $dport]
+        set depends {}
+        if {[info exists portinfo(depends_run)]} { eval "lappend depends $portinfo(depends_run)" }
+        if {[info exists portinfo(depends_lib)]} { eval "lappend depends $portinfo(depends_lib)" }
+        if {$includeBuildDeps != "" && [info exists portinfo(depends_build)]} {
+                eval "lappend depends $portinfo(depends_build)"
+        }
+
+        foreach depspec $depends {
+                # grab the portname portion of the depspec
+                set portname [lindex [split $depspec :] 2]
+                
+                # Find the porturl
+                if {[catch {set res [dportsearch "^$portname\$"]} error]} {
+                        ui_puts err "Internal error: port search failed: $error"
+                        return 1
                 }
-                foreach depspec $depends {
-                        # grab the portname portion of the depspec
-                        set dep [lindex [split $depspec :] 2]
-                        
-                        lappend result $dep
-                        
-                        if {$recurseDeps != ""} {
-                                set rdeps [dportdepends $dep $includeBuildDeps $recurseDeps]
-                                if {$rdeps == -1} {
-                                        return -1
-                                } else {
-                                        eval "lappend result $rdeps"
-                                }
+                foreach {name array} $res {
+                        array set portinfo $array
+                        if {[info exists portinfo(porturl)]} {
+                                set porturl $portinfo(porturl)
+                                break
                         }
                 }
+
+                set options [ditem_key $dport options]
+                set variations [ditem_key $dport variations]
+                
+                set subport [dportopen $porturl $options $variations]
+
+                # Append the sub-port's provides to the port's requirements list.
+                ditem_append $dport requires "[ditem_key $subport provides]"
+
+                if {$recurseDeps != ""} {
+                        set res [dportdepends $subport $includeBuildDeps $recurseDeps]
+                        if {$res != 0} {
+                                return $res
+                        }
+                }
         }
         
-        return $result
-}
+        return 0
+}

trunk/base/src/darwinports1.0/darwinports_dlist.tcl

@@ -69 +69 @@
 }
 
+# dlist_delete
+# Deletes the specified ditem from the dlist.
+#       dlist - the list to search
+#       ditem - the item to delete
+proc dlist_delete {dlist ditem} {
+    upvar $dlist uplist
+    set ix [lsearch -exact $uplist $ditem]
+    if {$ix >= 0} {
+                set uplist [lreplace $uplist $ix $ix]
+    }
+}
+
 # dlist_has_pending
 # Returns true if the dlist contains ditems
@@ -225 +237 @@
 # or {} if all ditems were evaluated.
 #       dlist    - the dependency list to evaluate
+#       testcond - test condition to populate the status dictionary
+#                  should return {-1, 0, 1}
 #       handler  - the handler to invoke on each ditem
+#       canfail  - If 1, then progress will not stop when a failure
+#                  occures; if 0, then dlist_eval will return on the
+#                  first failure
 #       selector - the selector for determining eligibility
 
-proc dlist_eval {dlist handler {selector "dlist_get_next"}} {
+proc dlist_eval {dlist testcond handler {canfail "0"} {selector "dlist_get_next"}} {
         array set statusdict [list]
         
         # Do a pre-run seeing if any items automagically
         # can evaluate to true.
-        foreach ditem $dlist {
-                #if test ditem
-                if {0} {
-                        foreach token [dlist_key $ditem provides] {
-                                set statusdict($name) 1
+        if {$testcond != ""} {
+                foreach ditem $dlist {
+                        if {[eval "expr \[\$testcond \$ditem\] == 1"]} {
+                                foreach token [ditem_key $ditem provides] {
+                                        set statusdict($token) 1
+                                }
+                                dlist_delete dlist $ditem
                         }
-                        ldelete dlist $ditem
                 }
         }
@@ -252 +270 @@
                         # $handler should return a unix status code, 0 for success.
                         # statusdict notation is 1 for success
-                        if {[catch {$handler $ditem} result]} {
+                        if {[catch {eval "$handler $ditem"} result]} {
                                 puts $result
                                 return $dlist
@@ -263 +281 @@
                         }
                         
+                        # Abort if we're not allowed to fail
+                        if {$canfail == 0 && $result != 0} {
+                                return $dlist
+                        }
+                        
                         # Delete the ditem from the waiting list.
-                        darwinports_dlist::ldelete dlist $ditem
+                        dlist_delete dlist $ditem
                 }
         }
@@ -331 +354 @@
 }
 
-proc ldelete {list value} {
-    upvar $list uplist
-    set ix [lsearch -exact $uplist $value]
-    if {$ix >= 0} {
-        set uplist [lreplace $uplist $ix $ix]
-    }
-}
-
 # End of darwinports_dlist namespace
 }