[64183] trunk/base/src

jmr at macports.org jmr at macports.org
Wed Feb 24 12:19:28 PST 2010


Revision: 64183
          http://trac.macports.org/changeset/64183
Author:   jmr at macports.org
Date:     2010-02-24 12:19:26 -0800 (Wed, 24 Feb 2010)
Log Message:
-----------
more reg2 work, including setting date, default variants and portfile fields on entries, and handling path deps reasonably

Modified Paths:
--------------
    trunk/base/src/macports1.0/macports.tcl
    trunk/base/src/port1.0/portinstall.tcl
    trunk/base/src/port1.0/portutil.tcl
    trunk/base/src/registry2.0/entryobj.c
    trunk/base/src/registry2.0/receipt_sqlite.tcl

Modified: trunk/base/src/macports1.0/macports.tcl
===================================================================
--- trunk/base/src/macports1.0/macports.tcl	2010-02-24 19:54:03 UTC (rev 64182)
+++ trunk/base/src/macports1.0/macports.tcl	2010-02-24 20:19:26 UTC (rev 64183)
@@ -961,6 +961,8 @@
     $workername alias binaryInPath macports::binaryInPath
     $workername alias sysctl sysctl
     $workername alias realpath realpath
+    $workername alias _mportsearchpath _mportsearchpath
+    $workername alias _portnameactive _portnameactive
 
     # New Registry/Receipts stuff
     $workername alias registry_new registry::new_entry
@@ -975,6 +977,7 @@
     $workername alias registry_fileinfo_for_index registry::fileinfo_for_index
     $workername alias registry_bulk_register_files registry::register_bulk_files
     $workername alias registry_active registry::active
+    $workername alias registry_file_registered registry::file_registered
 
     # deferred options processing.
     $workername alias getoption macports::getoption
@@ -1342,96 +1345,7 @@
     }
 }
 
-### _libtest is private; subject to change without notice
-# XXX - Architecture specific
-# XXX - Rely on information from internal defines in cctools/dyld:
-# define DEFAULT_FALLBACK_FRAMEWORK_PATH
-# /Library/Frameworks:/Library/Frameworks:/Network/Library/Frameworks:/System/Library/Frameworks
-# define DEFAULT_FALLBACK_LIBRARY_PATH /lib:/usr/local/lib:/lib:/usr/lib
-#   -- Since /usr/local is bad, using /lib:/usr/lib only.
-# Environment variables DYLD_FRAMEWORK_PATH, DYLD_LIBRARY_PATH,
-# DYLD_FALLBACK_FRAMEWORK_PATH, and DYLD_FALLBACK_LIBRARY_PATH take precedence
 
-proc _libtest {mport depspec {return_match 0}} {
-    global env tcl_platform
-    set depline [lindex [split $depspec :] 1]
-    set prefix [_mportkey $mport prefix]
-    set frameworks_dir [_mportkey $mport frameworks_dir]
-
-    if {[info exists env(DYLD_FRAMEWORK_PATH)]} {
-        lappend search_path $env(DYLD_FRAMEWORK_PATH)
-    } else {
-        lappend search_path ${frameworks_dir} /Library/Frameworks /Network/Library/Frameworks /System/Library/Frameworks
-    }
-    if {[info exists env(DYLD_FALLBACK_FRAMEWORK_PATH)]} {
-        lappend search_path $env(DYLD_FALLBACK_FRAMEWORK_PATH)
-    }
-    if {[info exists env(DYLD_LIBRARY_PATH)]} {
-        lappend search_path $env(DYLD_LIBRARY_PATH)
-    }
-    lappend search_path /lib /usr/lib ${prefix}/lib
-    if {[info exists env(DYLD_FALLBACK_LIBRARY_PATH)]} {
-        lappend search_path $env(DYLD_FALLBACK_LIBRARY_PATH)
-    }
-
-    set i [string first . $depline]
-    if {$i < 0} {set i [string length $depline]}
-    set depname [string range $depline 0 [expr $i - 1]]
-    set depversion [string range $depline $i end]
-    regsub {\.} $depversion {\.} depversion
-    if {$tcl_platform(os) == "Darwin"} {
-        set depregex \^${depname}${depversion}\\.dylib\$
-    } else {
-        set depregex \^${depname}\\.so${depversion}\$
-    }
-
-    return [_mportsearchpath $depregex $search_path 0 $return_match]
-}
-
-### _bintest is private; subject to change without notice
-
-proc _bintest {mport depspec {return_match 0}} {
-    global env
-    set depregex [lindex [split $depspec :] 1]
-    set prefix [_mportkey $mport prefix]
-
-    set search_path [split $env(PATH) :]
-
-    set depregex \^$depregex\$
-
-    return [_mportsearchpath $depregex $search_path 1 $return_match]
-}
-
-### _pathtest is private; subject to change without notice
-
-proc _pathtest {mport depspec {return_match 0}} {
-    global env
-    set depregex [lindex [split $depspec :] 1]
-    set prefix [_mportkey $mport prefix]
-
-    # separate directory from regex
-    set fullname $depregex
-
-    regexp {^(.*)/(.*?)$} "$fullname" match search_path depregex
-
-    if {[string index $search_path 0] != "/"} {
-        # Prepend prefix if not an absolute path
-        set search_path "${prefix}/${search_path}"
-    }
-
-    set depregex \^$depregex\$
-
-    return [_mportsearchpath $depregex $search_path 0 $return_match]
-}
-
-### _porttest is private; subject to change without notice
-
-proc _porttest {mport depspec} {
-    # We don't actually look for the port, but just return false
-    # in order to let the mportdepends handle the dependency
-    return 0
-}
-
 ### _mportinstalled is private; may change without notice
 
 # Determine if a port is already *installed*, as in "in the registry".
@@ -1482,12 +1396,13 @@
     } else {
         # The receipt test failed, use one of the depspec regex mechanisms
         ui_debug "Didn't find receipt, going to depspec regex for: $portname"
+        set workername [ditem_key $mport workername]
         set type [lindex [split $depspec :] 0]
         switch $type {
-            lib { return [_libtest $mport $depspec] }
-            bin { return [_bintest $mport $depspec] }
-            path { return [_pathtest $mport $depspec] }
-            port { return [_porttest $mport $depspec] }
+            lib { return [$workername eval _libtest $depspec] }
+            bin { return [$workername eval _bintest $depspec] }
+            path { return [$workername eval _pathtest $depspec] }
+            port { return 0 }
             default {return -code error "unknown depspec type: $type"}
         }
         return 0
@@ -1678,7 +1593,8 @@
     }
     
     foreach depspec $depends {
-        set dep_portname [_get_dep_port $mport $depspec]
+        set workername [ditem_key $mport workername]
+        set dep_portname [$workername eval _get_dep_port $depspec]
         if {$dep_portname != "" && ![info exists depscache(port:$dep_portname)] && [registry::entry_exists_for_name $dep_portname]} {
             set status [macports::upgrade $dep_portname "port:$dep_portname" {} $options depscache]
             # status 2 means the port was not found in the index
@@ -1689,43 +1605,6 @@
     }
 }
 
-# returns the name of the port that will actually be satisfying $depspec
-proc macports::_get_dep_port {mport depspec} {
-    set speclist [split $depspec :]
-    set portname [lindex $speclist end]
-    if {[string equal ${macports::registry.installtype} "image"]} {
-        set res [_portnameactive $portname]
-    } else {
-        set res [registry::entry_exists_for_name $portname]
-    }
-    if {$res != 0} {
-        return $portname
-    }
-    
-    set depfile ""
-    switch [lindex $speclist 0] {
-        bin {
-            set depfile [_bintest $mport $depspec 1]
-        }
-        lib {
-            set depfile [_libtest $mport $depspec 1]
-        }
-        path {
-            set depfile [_pathtest $mport $depspec 1]
-        }
-    }
-    if {$depfile == ""} {
-        return $portname
-    } else {
-        set theport [registry::file_registered $depfile]
-        if {$theport != 0} {
-            return $theport
-        } else {
-            return ""
-        }
-    }
-}
-
 proc macports::getsourcepath {url} {
     global macports::portdbpath
 
@@ -3089,7 +2968,8 @@
     foreach dtype $dtypes {
         if {[info exists portinfo($dtype)]} {
             foreach i $portinfo($dtype) {
-                set d [_get_dep_port $parentworker $i]
+                set parent_interp [ditem_key $parentworker workername]
+                set d [$parent_interp eval _get_dep_port $i]
                 if {![llength [array get depscache port:${d}]] && ![llength [array get depscache $i]]} {
                     if {$d != ""} {
                         set dspec port:$d

Modified: trunk/base/src/port1.0/portinstall.tcl
===================================================================
--- trunk/base/src/port1.0/portinstall.tcl	2010-02-24 19:54:03 UTC (rev 64182)
+++ trunk/base/src/port1.0/portinstall.tcl	2010-02-24 20:19:26 UTC (rev 64183)
@@ -136,7 +136,7 @@
     global name version portpath categories description long_description \
     homepage depends_run installPlist package-install uninstall workdir \
     worksrcdir UI_PREFIX destroot revision maintainers ports_force \
-    portvariants targets depends_lib PortInfo epoch license \
+    portvariants default_variants targets depends_lib PortInfo epoch license \
     registry.installtype registry.path registry.format
 
     if {[string equal ${registry.format} "receipt_sqlite"]} {
@@ -144,18 +144,23 @@
         registry::write {
 
             set regref [registry::entry create $name $version $revision $portvariants $epoch]
+            
+            # Trick to have a portable GMT-POSIX epoch-based time.
+            $regref date [expr [clock scan now -gmt true] - [clock scan "1970-1-1 00:00:00" -gmt true]]
+            if {[info exists default_variants} {
+                $regref default_variants $default_variants
+            }
 
-            # XXX this fails to describe path deps
-            if {[info exists depends_run]} {
-                foreach dep $depends_run {
-                    $regref depends [lindex [split $dep :] end]
+            foreach deplist {depends_lib depends_run} {
+                if {[info exists $deplist]} {
+                    foreach dep [set $deplist] {
+                        set dep_portname [_get_dep_port $dep]
+                        if {$dep_portname != ""} {
+                            $regref depends $dep_portname
+                        }
+                    }
                 }
             }
-            if {[info exists depends_lib]} {
-                foreach dep $depends_lib {
-                    $regref depends [lindex [split $dep :] end]
-                }
-            }
 
             if {${registry.installtype} == "image"} {
                 $regref installtype image
@@ -175,6 +180,11 @@
                 # register files
                 $regref map $installPlist
             }
+            
+            # store portfile
+            set fd [open [file join ${portpath} Portfile]]
+            $regref portfile [read $fd]
+            close $fd
         }
     } else {
         # Begin the registry entry

Modified: trunk/base/src/port1.0/portutil.tcl
===================================================================
--- trunk/base/src/port1.0/portutil.tcl	2010-02-24 19:54:03 UTC (rev 64182)
+++ trunk/base/src/port1.0/portutil.tcl	2010-02-24 20:19:26 UTC (rev 64183)
@@ -2427,3 +2427,120 @@
     }
 }
 
+# dependency analysis helpers
+
+### _libtest is private; subject to change without notice
+# XXX - Architecture specific
+# XXX - Rely on information from internal defines in cctools/dyld:
+# define DEFAULT_FALLBACK_FRAMEWORK_PATH
+# /Library/Frameworks:/Library/Frameworks:/Network/Library/Frameworks:/System/Library/Frameworks
+# define DEFAULT_FALLBACK_LIBRARY_PATH /lib:/usr/local/lib:/lib:/usr/lib
+#   -- Since /usr/local is bad, using /lib:/usr/lib only.
+# Environment variables DYLD_FRAMEWORK_PATH, DYLD_LIBRARY_PATH,
+# DYLD_FALLBACK_FRAMEWORK_PATH, and DYLD_FALLBACK_LIBRARY_PATH take precedence
+
+proc _libtest {depspec {return_match 0}} {
+    global env prefix frameworks_dir os.platform
+    set depline [lindex [split $depspec :] 1]
+
+    if {[info exists env(DYLD_FRAMEWORK_PATH)]} {
+        lappend search_path $env(DYLD_FRAMEWORK_PATH)
+    } else {
+        lappend search_path ${frameworks_dir} /Library/Frameworks /Network/Library/Frameworks /System/Library/Frameworks
+    }
+    if {[info exists env(DYLD_FALLBACK_FRAMEWORK_PATH)]} {
+        lappend search_path $env(DYLD_FALLBACK_FRAMEWORK_PATH)
+    }
+    if {[info exists env(DYLD_LIBRARY_PATH)]} {
+        lappend search_path $env(DYLD_LIBRARY_PATH)
+    }
+    lappend search_path /lib /usr/lib ${prefix}/lib
+    if {[info exists env(DYLD_FALLBACK_LIBRARY_PATH)]} {
+        lappend search_path $env(DYLD_FALLBACK_LIBRARY_PATH)
+    }
+
+    set i [string first . $depline]
+    if {$i < 0} {set i [string length $depline]}
+    set depname [string range $depline 0 [expr $i - 1]]
+    set depversion [string range $depline $i end]
+    regsub {\.} $depversion {\.} depversion
+    if {${os.platform} == "darwin"} {
+        set depregex \^${depname}${depversion}\\.dylib\$
+    } else {
+        set depregex \^${depname}\\.so${depversion}\$
+    }
+
+    return [_mportsearchpath $depregex $search_path 0 $return_match]
+}
+
+### _bintest is private; subject to change without notice
+
+proc _bintest {depspec {return_match 0}} {
+    global env prefix
+    set depregex [lindex [split $depspec :] 1]
+
+    set search_path [split $env(PATH) :]
+
+    set depregex \^$depregex\$
+
+    return [_mportsearchpath $depregex $search_path 1 $return_match]
+}
+
+### _pathtest is private; subject to change without notice
+
+proc _pathtest {depspec {return_match 0}} {
+    global env prefix
+    set depregex [lindex [split $depspec :] 1]
+
+    # separate directory from regex
+    set fullname $depregex
+
+    regexp {^(.*)/(.*?)$} "$fullname" match search_path depregex
+
+    if {[string index $search_path 0] != "/"} {
+        # Prepend prefix if not an absolute path
+        set search_path "${prefix}/${search_path}"
+    }
+
+    set depregex \^$depregex\$
+
+    return [_mportsearchpath $depregex $search_path 0 $return_match]
+}
+
+# returns the name of the port that will actually be satisfying $depspec
+proc _get_dep_port {depspec} {
+    global registry.installtype
+    set speclist [split $depspec :]
+    set portname [lindex $speclist end]
+    if {[string equal ${registry.installtype} "image"]} {
+        set res [_portnameactive $portname]
+    } else {
+        set res [registry_exists_for_name $portname]
+    }
+    if {$res != 0} {
+        return $portname
+    }
+    
+    set depfile ""
+    switch [lindex $speclist 0] {
+        bin {
+            set depfile [_bintest $depspec 1]
+        }
+        lib {
+            set depfile [_libtest $depspec 1]
+        }
+        path {
+            set depfile [_pathtest $depspec 1]
+        }
+    }
+    if {$depfile == ""} {
+        return $portname
+    } else {
+        set theport [registry::file_registered $depfile]
+        if {$theport != 0} {
+            return $theport
+        } else {
+            return ""
+        }
+    }
+}

Modified: trunk/base/src/registry2.0/entryobj.c
===================================================================
--- trunk/base/src/registry2.0/entryobj.c	2010-02-24 19:54:03 UTC (rev 64182)
+++ trunk/base/src/registry2.0/entryobj.c	2010-02-24 20:19:26 UTC (rev 64183)
@@ -278,7 +278,7 @@
         int objc, Tcl_Obj* CONST objv[]) {
     reg_registry* reg = registry_for(interp, reg_attached);
     if (objc != 2) {
-        Tcl_WrongNumArgs(interp, 1, objv, "dependents");
+        Tcl_WrongNumArgs(interp, 1, objv, "dependencies");
         return TCL_ERROR;
     } else if (reg == NULL) {
         return TCL_ERROR;

Modified: trunk/base/src/registry2.0/receipt_sqlite.tcl
===================================================================
--- trunk/base/src/registry2.0/receipt_sqlite.tcl	2010-02-24 19:54:03 UTC (rev 64182)
+++ trunk/base/src/registry2.0/receipt_sqlite.tcl	2010-02-24 20:19:26 UTC (rev 64183)
@@ -189,7 +189,6 @@
     foreach port $ports {
         set dependents [$port dependents]
         foreach dependent $dependents {
-            # XXX need to store path deps
             lappend rlist [list [$port name] port [$dependent name]]
         }
     }
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.macosforge.org/pipermail/macports-changes/attachments/20100224/0ca879f5/attachment.html>


More information about the macports-changes mailing list