[59838] branches/images-and-archives/base

blb at macports.org blb at macports.org
Fri Oct 23 14:21:01 PDT 2009


Revision: 59838
          http://trac.macports.org/changeset/59838
Author:   blb at macports.org
Date:     2009-10-23 14:20:58 -0700 (Fri, 23 Oct 2009)
Log Message:
-----------
Merge from trunk

Modified Paths:
--------------
    branches/images-and-archives/base/portmgr/autosubmit.tcl
    branches/images-and-archives/base/portmgr/jobs/PortIndex2MySQL.tcl
    branches/images-and-archives/base/portmgr/packaging/dpkgall.tcl
    branches/images-and-archives/base/src/macports1.0/macports.tcl
    branches/images-and-archives/base/src/port/port.tcl
    branches/images-and-archives/base/src/port1.0/portutil.tcl

Property Changed:
----------------
    branches/images-and-archives/base/


Property changes on: branches/images-and-archives/base
___________________________________________________________________
Modified: svn:mergeinfo
   - /branches/gsoc08-privileges/base:37343-46937
/branches/universal-sanity/base:51872-52323
/branches/variant-descs-14482/base:34469-34855,34900-37508,37511-37512,41040-41463,42575-42626,42640-42659
/trunk/base:50249-59811
/users/perry/base-bugs_and_notes:45682-46060
/users/perry/base-select:44044-44692
   + /branches/gsoc08-privileges/base:37343-46937
/branches/universal-sanity/base:51872-52323
/branches/variant-descs-14482/base:34469-34855,34900-37508,37511-37512,41040-41463,42575-42626,42640-42659
/trunk/base:50249-59837
/users/perry/base-bugs_and_notes:45682-46060
/users/perry/base-select:44044-44692

Modified: branches/images-and-archives/base/portmgr/autosubmit.tcl
===================================================================
--- branches/images-and-archives/base/portmgr/autosubmit.tcl	2009-10-23 21:16:57 UTC (rev 59837)
+++ branches/images-and-archives/base/portmgr/autosubmit.tcl	2009-10-23 21:20:58 UTC (rev 59838)
@@ -34,7 +34,7 @@
 proc submit_ports {} {
 	global prefix submit_options verbose
 
-	if {[catch {set res [mportsearch "^.*\$"]} result]} {
+	if {[catch {set res [mportlistall]} result]} {
 		puts "port search failed: $result"
 		exit 1
 	}

Modified: branches/images-and-archives/base/portmgr/jobs/PortIndex2MySQL.tcl
===================================================================
--- branches/images-and-archives/base/portmgr/jobs/PortIndex2MySQL.tcl	2009-10-23 21:16:57 UTC (rev 59837)
+++ branches/images-and-archives/base/portmgr/jobs/PortIndex2MySQL.tcl	2009-10-23 21:20:58 UTC (rev 59838)
@@ -230,7 +230,7 @@
 }
 
 # Load every port in the index through a search that matches everything.
-if {[catch {set ports [mportsearch ".+"]} errstr]} {
+if {[catch {set ports [mportlistall]} errstr]} {
     ui_error "${::errorInfo}"
     ui_error "port search failed: $errstr"
     cleanup sqlfile lockfile

Modified: branches/images-and-archives/base/portmgr/packaging/dpkgall.tcl
===================================================================
--- branches/images-and-archives/base/portmgr/packaging/dpkgall.tcl	2009-10-23 21:16:57 UTC (rev 59837)
+++ branches/images-and-archives/base/portmgr/packaging/dpkgall.tcl	2009-10-23 21:20:58 UTC (rev 59838)
@@ -347,7 +347,7 @@
 
 	# If no portlist file was specified, create a portlist that includes all ports
 	if {[llength $portlist] == 0 || "$buildall_flag" == "true"} {
-		set res [mportsearch {.*}]
+		set res [mportlistall]
 		foreach {name array} $res {
 			lappend portlist $name
 		}
@@ -757,7 +757,7 @@
 
 proc get_portinfo {port} {
 	set searchstring [regex_escape_portname $port]
-	set res [mportsearch "^${searchstring}\$"]
+	set res [mportlookup ${searchstring}]
 
 	if {[llength $res] < 2} {
 		return -code error "Port \"$port\" not found in index."

Modified: branches/images-and-archives/base/src/macports1.0/macports.tcl
===================================================================
--- branches/images-and-archives/base/src/macports1.0/macports.tcl	2009-10-23 21:16:57 UTC (rev 59837)
+++ branches/images-and-archives/base/src/macports1.0/macports.tcl	2009-10-23 21:20:58 UTC (rev 59838)
@@ -216,6 +216,14 @@
     proc ui_$priority {args} [subst { eval macports::ui_init $priority \$args }]
 }
 
+proc ui_warn_once {id msg} {
+    variable macports::warning_done
+    if {![info exists macports::warning_done($id)]} {
+        ui_warn $msg
+        set macports::warning_done($id) 1
+    }
+}
+
 # Replace puts to catch errors (typically broken pipes when being piped to head)
 rename puts tcl::puts
 proc puts {args} {
@@ -797,6 +805,8 @@
     }
     $workername alias ui_prefix ui_prefix
     $workername alias ui_channels ui_channels
+    
+    $workername alias ui_warn_once ui_warn_once
 
     # Export some utility functions defined here.
     $workername alias macports_create_thread macports::create_thread
@@ -940,23 +950,22 @@
 # fetched port will be downloaded to (currently only applies to
 # mports:// sources).
 proc macports::getportdir {url {destdir "."}} {
-    if {[regexp {(?x)([^:]+)://(.+)} $url match protocol string] == 1} {
-        switch -regexp -- ${protocol} {
-            {^file$} {
-                return [file normalize $string]
-            }
-            {^mports$} {
-                return [macports::index::fetch_port $url $destdir]
-            }
-            {^https?$|^ftp$} {
-                return [macports::fetch_port $url]
-            }
-            default {
-                return -code error "Unsupported protocol $protocol"
-            }
+    set protocol [macports::getprotocol $url]
+    switch ${protocol} {
+        file {
+            return [file normalize [string range $url [expr [string length $protocol] + 3] end]]
         }
-    } else {
-        return -code error "Can't parse url $url"
+        mports {
+            return [macports::index::fetch_port $url $destdir]
+        }
+        https -
+        http -
+        ftp {
+            return [macports::fetch_port $url]
+        }
+        default {
+            return -code error "Unsupported protocol $protocol"
+        }
     }
 }
 
@@ -1696,11 +1705,10 @@
 
     set found 0
     foreach source $sources {
-        set flags [lrange $source 1 end]
         set source [lindex $source 0]
-        if {[macports::getprotocol $source] == "mports"} {
-            array set attrs [list name $pattern]
-            set res [macports::index::search $macports::portdbpath $source [array get attrs]]
+        set protocol [macports::getprotocol $source]
+        if {$protocol == "mports"} {
+            set res [macports::index::search $macports::portdbpath $source [list name $pattern]]
             eval lappend matches $res
         } else {
             if {[catch {set fd [open [macports::getindex $source] r]} result]} {
@@ -1739,12 +1747,14 @@
                             if {$easy} {
                                 array set portinfo $line
                             }
-                            switch -regexp -- [macports::getprotocol ${source}] {
-                                {^rsync$} {
+                            switch $protocol {
+                                rsync {
                                     # Rsync files are local
                                     set source_url "file://[macports::getsourcepath $source]"
                                 }
-                                {^https?$|^ftp$} {
+                                https -
+                                http -
+                                ftp {
                                     if {[_source_is_snapshot $source filename extension]} {
                                         # daily snapshot tarball
                                         set source_url "file://[macports::getsourcepath $source]"
@@ -1798,7 +1808,8 @@
     set matches [list]
     foreach source $sources {
         set source [lindex $source 0]
-        if {[macports::getprotocol $source] != "mports"} {
+        set protocol [macports::getprotocol $source]
+        if {$protocol != "mports"} {
             global macports::quick_index
             if {![info exists quick_index($sourceno,[string tolower $name])]} {
                 incr sourceno 1
@@ -1821,17 +1832,16 @@
 
                     array set portinfo $line
 
-                    switch -regexp -- [macports::getprotocol ${source}] {
-                        {^rsync$} {
-                            # Rsync files are local
+                    switch $protocol {
+                        rsync {
                             set source_url "file://[macports::getsourcepath $source]"
                         }
-                        {^https?$|^ftp$} {
+                        https -
+                        http -
+                        ftp {
                             if {[_source_is_snapshot $source filename extension]} {
-                                # daily snapshot tarball
                                 set source_url "file://[macports::getsourcepath $source]"
                              } else {
-                                # default action
                                 set source_url $source
                              }
                         }
@@ -1844,9 +1854,6 @@
                     }
                     if {[info exists porturl]} {
                         lappend line porturl $porturl
-                        ui_debug "Found port in $porturl"
-                    } else {
-                        ui_debug "Found port info: $line"
                     }
                     lappend matches $name
                     lappend matches $line
@@ -1864,8 +1871,7 @@
                 }
             }
         } else {
-            array set attrs [list name $name]
-            set res [macports::index::search $macports::portdbpath $source [array get attrs]]
+            set res [macports::index::search $macports::portdbpath $source [list name $name]]
             if {[llength $res] > 0} {
                 eval lappend matches $res
                 break
@@ -1876,6 +1882,76 @@
     return $matches
 }
 
+# Returns all ports in the indices. Faster than 'mportsearch .*'
+proc mportlistall {args} {
+    global macports::portdbpath macports::sources
+    set matches [list]
+
+    set found 0
+    foreach source $sources {
+        set source [lindex $source 0]
+        set protocol [macports::getprotocol $source]
+        if {$protocol != "mports"} {
+            if {![catch {set fd [open [macports::getindex $source] r]} result]} {
+                try {
+                    incr found 1
+                    while {[gets $fd line] >= 0} {
+                        array unset portinfo
+                        set name [lindex $line 0]
+                        set len [lindex $line 1]
+                        set line [read $fd $len]
+
+                        array set portinfo $line
+
+                        switch $protocol {
+                            rsync {
+                                set source_url "file://[macports::getsourcepath $source]"
+                            }
+                            https -
+                            http -
+                            ftp {
+                                if {[_source_is_snapshot $source filename extension]} {
+                                    set source_url "file://[macports::getsourcepath $source]"
+                                } else {
+                                    set source_url $source
+                                }
+                            }
+                            default {
+                                set source_url $source
+                            }
+                        }
+                        if {[info exists portinfo(portdir)]} {
+                            set porturl ${source_url}/$portinfo(portdir)
+                        } elseif {[info exists portinfo(portarchive)]} {
+                            set porturl ${source_url}/$portinfo(portarchive)
+                        }
+                        if {[info exists porturl]} {
+                            lappend line porturl $porturl
+                        }
+                        lappend matches $name $line
+                    }
+                } catch {*} {
+                    ui_warn "It looks like your PortIndex file for $source may be corrupt."
+                    throw
+                } finally {
+                    close $fd
+                }
+            } else {
+                ui_warn "Can't open index file for source: $source"
+            }
+        } else {
+            set res [macports::index::search $macports::portdbpath $source [list name .*]]
+            eval lappend matches $res
+        }
+    }
+    if {!$found} {
+        return -code error "No index(es) found! Have you synced your source indexes?"
+    }
+
+    return $matches
+}
+
+
 # Loads PortIndex.quick from each source into the quick_index, generating
 # it first if necessary.
 proc _mports_load_quickindex {args} {

Modified: branches/images-and-archives/base/src/port/port.tcl
===================================================================
--- branches/images-and-archives/base/src/port/port.tcl	2009-10-23 21:16:57 UTC (rev 59837)
+++ branches/images-and-archives/base/src/port/port.tcl	2009-10-23 21:20:58 UTC (rev 59838)
@@ -588,7 +588,19 @@
     global all_ports_cache
 
     if {![info exists all_ports_cache]} {
-        set all_ports_cache [get_matching_ports "*"]
+         if {[catch {set res [mportlistall]} result]} {
+            global errorInfo
+            ui_debug "$errorInfo"
+            fatal "listing all ports failed: $result"
+        }
+        set results {}
+        foreach {name info} $res {
+            array unset portinfo
+            array set portinfo $info
+            add_to_portlist results [list url $portinfo(porturl) name $name]
+        }
+
+        set all_ports_cache [portlist_sort $results]
     }
     return $all_ports_cache
 }
@@ -2595,16 +2607,19 @@
     
     foreachport $portlist {
         if {$portname == "-all-"} {
-            set search_string ".+"
+           if {[catch {set res [mportlistall]} result]} {
+                global errorInfo
+                ui_debug "$errorInfo"
+                break_softcontinue "listing all ports failed: $result" 1 status
+            }
         } else {
             set search_string [regex_pat_sanitize $portname]
+            if {[catch {set res [mportsearch ^$search_string\$ no]} result]} {
+                global errorInfo
+                ui_debug "$errorInfo"
+                break_softcontinue "search for portname $search_string failed: $result" 1 status
+            }
         }
-        
-        if {[catch {set res [mportsearch ^$search_string\$ no]} result]} {
-            global errorInfo
-            ui_debug "$errorInfo"
-            break_softcontinue "search for portname $search_string failed: $result" 1 status
-        }
 
         foreach {name array} $res {
             array unset portinfo

Modified: branches/images-and-archives/base/src/port1.0/portutil.tcl
===================================================================
--- branches/images-and-archives/base/src/port1.0/portutil.tcl	2009-10-23 21:16:57 UTC (rev 59837)
+++ branches/images-and-archives/base/src/port1.0/portutil.tcl	2009-10-23 21:20:58 UTC (rev 59838)
@@ -1494,7 +1494,7 @@
     }
     
     if { [getuid] != 0 } {
-        ui_msg "MacPorts running without privileges.\
+        ui_warn_once "privileges" "MacPorts running without privileges.\
                 You may be unable to complete certain actions (e.g. install)."
     }
     
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.macosforge.org/pipermail/macports-changes/attachments/20091023/cff3e35b/attachment.html>


More information about the macports-changes mailing list