[109659] trunk/base/src
cal at macports.org
cal at macports.org
Mon Aug 19 08:09:48 PDT 2013
Revision: 109659
https://trac.macports.org/changeset/109659
Author: cal at macports.org
Date: 2013-08-19 08:09:48 -0700 (Mon, 19 Aug 2013)
Log Message:
-----------
macports1.0/port1.0: remove mports:// and non-tarball (?:https?|ftp):// sources, https://lists.macosforge.org/pipermail/macports-dev/2013-February/022133.html
Also:
- add doxygen comments to some of the mport* functions in macports1.0
- fix the --regex option of port search passing an invalid matchstyle to mportsearch
- remove the possibility to generate mports:// sources using portindex
Modified Paths:
--------------
trunk/base/src/macports1.0/Makefile
trunk/base/src/macports1.0/macports.tcl
trunk/base/src/port/port.tcl
trunk/base/src/port/portindex.tcl
Removed Paths:
-------------
trunk/base/src/macports1.0/macports_index.tcl
Modified: trunk/base/src/macports1.0/Makefile
===================================================================
--- trunk/base/src/macports1.0/Makefile 2013-08-19 15:07:19 UTC (rev 109658)
+++ trunk/base/src/macports1.0/Makefile 2013-08-19 15:09:48 UTC (rev 109659)
@@ -1,5 +1,5 @@
SRCS= macports.tcl macports_dlist.tcl macports_util.tcl \
- macports_autoconf.tcl macports_index.tcl macports_fastload.tcl
+ macports_autoconf.tcl macports_fastload.tcl
OBJS= macports.o get_systemconfiguration_proxies.o sysctl.o
SHLIB_NAME= MacPorts${SHLIB_SUFFIX}
Modified: trunk/base/src/macports1.0/macports.tcl
===================================================================
--- trunk/base/src/macports1.0/macports.tcl 2013-08-19 15:07:19 UTC (rev 109658)
+++ trunk/base/src/macports1.0/macports.tcl 2013-08-19 15:09:48 UTC (rev 109659)
@@ -35,7 +35,6 @@
#
package provide macports 1.0
package require macports_dlist 1.0
-package require macports_index 1.0
package require macports_util 1.0
namespace eval macports {
@@ -1459,37 +1458,21 @@
}
}
-# XXX: this really needs to be rethought in light of the remote index
-# I've added the destdir parameter. This is the location a remotely
-# fetched port will be downloaded to (currently only applies to
-# mports:// sources).
-proc macports::getportdir {url {destdir .}} {
- global macports::extracted_portdirs
+##
+# Return the directory where the port identified by the given \c url is
+# located. This used to be called with remote URLs, but this feature (and
+# a formerly existing second parameter) has been removed in MacPorts 2.3. Only
+# called with file:// port URLs at the moment.
+#
+# @param url URL identifying the port to be installed
+# @return normalized path to the port's directory, or error when called with an
+# unsupported protocl
+proc macports::getportdir {url} {
set protocol [macports::getprotocol $url]
switch -- $protocol {
file {
- set path [file normalize [string range $url [expr {[string length $protocol] + 3}] end]]
- if {![file isfile $path]} {
- return $path
- } else {
- # need to create a local dir for the exracted port, but only once
- if {![info exists macports::extracted_portdirs($url)]} {
- set macports::extracted_portdirs($url) [macports::fetch_port $path 1]
- }
- return $macports::extracted_portdirs($url)
- }
+ return [file normalize [string range $url [expr {[string length $protocol] + 3}] end]]
}
- mports {
- return [macports::index::fetch_port $url $destdir]
- }
- https -
- http -
- ftp {
- if {![info exists macports::extracted_portdirs($url)]} {
- set macports::extracted_portdirs($url) [macports::fetch_port $url 0]
- }
- return $macports::extracted_portdirs($url)
- }
default {
return -code error "Unsupported protocol $protocol"
}
@@ -1577,14 +1560,7 @@
return $mport
}
- array set options_array $options
- if {[info exists options_array(portdir)]} {
- set portdir $options_array(portdir)
- } else {
- set portdir {}
- }
-
- set portpath [macports::getportdir $porturl $portdir]
+ set portpath [macports::getportdir $porturl]
ui_debug "Changing to port directory: $portpath"
cd $portpath
if {![file isfile Portfile]} {
@@ -2260,9 +2236,6 @@
}
set needs_portindex 1
}
- {^mports$} {
- macports::index::sync $macports::portdbpath $source
- }
{^rsync$} {
# Where to, boss?
set indexfile [macports::getindex $source]
@@ -2396,73 +2369,80 @@
}
}
{^https?$|^ftp$} {
- if {[_source_is_snapshot $source filename extension]} {
- # sync a daily port snapshot tarball
- set indexfile [macports::getindex $source]
- set destdir [file dirname $indexfile]
- set tarpath [file join [file normalize [file join $destdir ..]] $filename]
+ if {![_source_is_snapshot $source filename extension]} {
+ ui_error "Synchronization using http, https and ftp only supported with tarballs."
+ ui_error "The source ${source} doesn't seem to point to a tarball."
+ ui_error "Please switch to a different sync protocol (e.g. rsync) in your sources.conf"
+ ui_error "Remove the line mentioned above from your sources.conf to silence this error."
+ incr numfailed
+ continue
+ }
+ # sync a daily port snapshot tarball
+ set indexfile [macports::getindex $source]
+ set destdir [file dirname $indexfile]
+ set tarpath [file join [file normalize [file join $destdir ..]] $filename]
- set updated 1
- if {[file isdirectory $destdir]} {
- set moddate [file mtime $destdir]
- if {[catch {set updated [curl isnewer $source $moddate]} error]} {
- ui_warn "Cannot check if $source was updated, ($error)"
- }
+ set updated 1
+ if {[file isdirectory $destdir]} {
+ set moddate [file mtime $destdir]
+ if {[catch {set updated [curl isnewer $source $moddate]} error]} {
+ ui_warn "Cannot check if $source was updated, ($error)"
}
+ }
- if {(![info exists options(ports_force)] || $options(ports_force) ne {yes}) && $updated <= 0} {
- ui_info "No updates for $source"
- continue
- }
+ if {(![info exists options(ports_force)] || $options(ports_force) ne {yes}) && $updated <= 0} {
+ ui_info "No updates for $source"
+ continue
+ }
- file mkdir $destdir
+ file mkdir $destdir
- set verboseflag {}
- if {$macports::portverbose eq {yes}} {
- set verboseflag -v
- }
+ set verboseflag {}
+ if {$macports::portverbose eq {yes}} {
+ set verboseflag -v
+ }
- if {[catch {eval curl fetch $verboseflag {$source} {$tarpath}} error]} {
- ui_error "Fetching $source failed ($error)"
- incr numfailed
- continue
- }
+ if {[catch {eval curl fetch $verboseflag {$source} {$tarpath}} error]} {
+ ui_error "Fetching $source failed ($error)"
+ incr numfailed
+ continue
+ }
- set extflag {}
- switch -- $extension {
- {tar.gz} {
- set extflag -z
- }
- {tar.bz2} {
- set extflag -j
- }
+ set extflag {}
+ switch -- $extension {
+ {tar.gz} {
+ set extflag -z
}
-
- set tar [macports::findBinary tar $macports::autoconf::tar_path]
- if {[catch {system "cd ${destdir}/.. && $tar $verboseflag $extflag -xf $filename"} error]} {
- ui_error "Extracting $source failed ($error)"
- incr numfailed
- continue
+ {tar.bz2} {
+ set extflag -j
}
+ }
- if {[catch {system "chmod -R a+r \"$destdir\""}]} {
- ui_warn "Setting world read permissions on parts of the ports tree failed, need root?"
- }
+ set tar [macports::findBinary tar $macports::autoconf::tar_path]
+ if {[catch {system "cd ${destdir}/.. && $tar $verboseflag $extflag -xf $filename"} error]} {
+ ui_error "Extracting $source failed ($error)"
+ incr numfailed
+ continue
+ }
- set platindex "PortIndex_${macports::os_platform}_${macports::os_major}_${macports::os_arch}/PortIndex"
- if {[file isfile ${destdir}/$platindex] && [file isfile ${destdir}/${platindex}.quick]} {
- file rename -force ${destdir}/$platindex ${destdir}/${platindex}.quick $destdir
- }
+ if {[catch {system "chmod -R a+r \"$destdir\""}]} {
+ ui_warn "Setting world read permissions on parts of the ports tree failed, need root?"
+ }
- file delete $tarpath
- } else {
- # sync just a PortIndex file
- set indexfile [macports::getindex $source]
- file mkdir [file dirname $indexfile]
- curl fetch ${source}/PortIndex $indexfile
- curl fetch ${source}/PortIndex.quick ${indexfile}.quick
+ set platindex "PortIndex_${macports::os_platform}_${macports::os_major}_${macports::os_arch}/PortIndex"
+ if {[file isfile ${destdir}/$platindex] && [file isfile ${destdir}/${platindex}.quick]} {
+ file rename -force ${destdir}/$platindex ${destdir}/${platindex}.quick $destdir
}
+
+ file delete $tarpath
}
+ {^mports$} {
+ ui_error "Synchronization using the mports protocol no longer supported."
+ ui_error "Please switch to a different sync protocol (e.g. rsync) in your sources.conf"
+ ui_error "Remove the line starting with mports:// from your sources.conf to silence this error."
+ incr numfailed
+ continue
+ }
default {
ui_warn "Unknown synchronization protocol for $source"
}
@@ -2490,8 +2470,46 @@
}
}
+##
+# Searches all configured port sources for a given pattern in a given field
+# using a given matching style and optional case-sensitivity.
+#
+# @param pattern pattern to search for; will be interpreted according to the \a
+# matchstyle parameter
+# @param case_sensitive "yes", if a case-sensitive search should be performed,
+# "no" otherwise. Defaults to "yes".
+# @param matchstyle One of the values \c exact, \c glob and \c regexp, where \c
+# exact performs a standard string comparison, \c glob
+# performs Tcl string matching using <tt>[string match]</tt>
+# and \c regexp interprets \a pattern as a regular
+# expression.
+# @param field name of the field to apply \a pattern to. Must be one of the
+# fields available in the used portindex. The portindex currently
+# contains
+# \li \c name (the default)
+# \li \c homepage
+# \li \c description
+# \li \c long_description
+# \li \c license
+# \li \c categories
+# \li \c platforms
+# \li \c maintainers
+# \li \c variants
+# \li \c portdir
+# \li all \c depends_* values
+# \li \c epoch
+# \li \c version
+# \li \c revision
+# \li \c replaced_by
+# \li \c installs_libs
+# @return a list where each even index (starting with 0) contains the name of
+# a matching port. Each entry at an odd index is followed by its
+# corresponding line from the portindex, which can be passed to
+# <tt>array set</tt>. The whole return value can also be passed to
+# <tt>array set</tt> to create an associate array where the port names
+# are the keys and the lines from portindex are the values.
proc mportsearch {pattern {case_sensitive yes} {matchstyle regexp} {field name}} {
- global macports::portdbpath macports::sources
+ global macports::sources
set matches [list]
set easy [expr {$field eq {name}}]
@@ -2499,87 +2517,90 @@
foreach source $sources {
set source [lindex $source 0]
set protocol [macports::getprotocol $source]
- if {$protocol eq {mports}} {
- set res [macports::index::search $macports::portdbpath $source [list name $pattern]]
- eval lappend matches $res
+ if {[catch {set fd [open [macports::getindex $source] r]} result]} {
+ ui_warn "Can't open index file for source: $source"
} else {
- if {[catch {set fd [open [macports::getindex $source] r]} result]} {
- ui_warn "Can't open index file for source: $source"
- } else {
- 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]
+ 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]
- if {$easy} {
- set target $name
- } else {
- array set portinfo $line
- if {![info exists portinfo($field)]} continue
- set target $portinfo($field)
+ if {$easy} {
+ set target $name
+ } else {
+ array set portinfo $line
+ if {![info exists portinfo($field)]} {
+ continue
}
+ set target $portinfo($field)
+ }
- switch -- $matchstyle {
- exact {
- set matchres [expr {0 == ($case_sensitive eq {yes} ? [string compare $pattern $target] : [string compare -nocase $pattern $target])}]
+ switch -- $matchstyle {
+ exact {
+ if {$case_sensitive eq yes} {
+ set compres [string compare $pattern $target]
+ } else {
+ set compres [string compare -nocase $pattern $target]
}
- glob {
- set matchres [expr {$case_sensitive eq {yes} ? [string match $pattern $target] : [string match -nocase $pattern $target]}]
+ set matchres [expr 0 == $compres]
+ }
+ glob {
+ if {$case_sensitive eq yes} {
+ set matchres [string match $pattern $target]
+ } else {
+ set matchres [string match -nocase $pattern $target]
}
- regexp -
- default {
- set matchres [expr {$case_sensitive eq {yes} ? [regexp -- $pattern $target] : [regexp -nocase -- $pattern $target]}]
+ }
+ regexp {
+ if {$case_sensitive eq yes} {
+ set matchres [regexp -- $pattern $target]
+ } else {
+ set matchres [regexp -nocase -- $pattern $target]
}
}
+ default {
+ return -code error "mportsearch: Unsupported matching style: ${matchstyle}."
+ }
+ }
- if {$matchres == 1} {
- if {$easy} {
- array set portinfo $line
+ if {$matchres == 1} {
+ if {$easy} {
+ array set portinfo $line
+ }
+ switch -- $protocol {
+ rsync {
+ # Rsync files are local
+ set source_url file://[macports::getsourcepath $source]
}
- switch -- $protocol {
- rsync {
- # Rsync files are local
- set source_url file://[macports::getsourcepath $source]
- }
- 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
- }
- }
- default {
- set source_url $source
- }
+ https -
+ http -
+ ftp {
+ # daily snapshot tarball
+ set source_url file://[macports::getsourcepath $source]
}
- if {[info exists portinfo(portarchive)]} {
- set porturl ${source_url}/$portinfo(portarchive)
- } elseif {[info exists portinfo(portdir)]} {
- set porturl ${source_url}/$portinfo(portdir)
+ default {
+ set source_url $source
}
- 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
}
+ if {[info exists portinfo(portdir)]} {
+ set porturl ${source_url}/$portinfo(portdir)
+ lappend line porturl $porturl
+ ui_debug "Found port in $porturl"
+ } else {
+ ui_debug "Found port info: $line"
+ }
+ lappend matches $name
+ lappend matches $line
}
- } catch * {
- ui_warn "It looks like your PortIndex file for $source may be corrupt."
- throw
- } finally {
- close $fd
}
+ } catch * {
+ ui_warn "It looks like your PortIndex file for $source may be corrupt."
+ throw
+ } finally {
+ close $fd
}
}
}
@@ -2590,86 +2611,79 @@
return $matches
}
+##
# Returns the PortInfo for a single named port. The info comes from the
# PortIndex, and name matching is case-insensitive. Unlike mportsearch, only
# the first match is returned, but the return format is otherwise identical.
-# The advantage is that mportlookup is much faster than mportsearch, due to
-# the use of the quick index.
+# The advantage is that mportlookup is usually much faster than mportsearch,
+# due to the use of the quick index, which is a name-based index into the
+# PortIndex.
+#
+# @param name name of the port to look up. Returns the first match while
+# traversing the sources in-order.
+# @return associative array in list form where the first field is the port name
+# and the second field is the line from PortIndex containing the port
+# info. See the return value of mportsearch().
+# @see mportsearch()
proc mportlookup {name} {
- global macports::portdbpath macports::sources
+ global macports::portdbpath macports::sources macports::quick_index
set sourceno 0
set matches [list]
foreach source $sources {
set source [lindex $source 0]
set protocol [macports::getprotocol $source]
- if {$protocol ne {mports}} {
- global macports::quick_index
- if {![info exists quick_index(${sourceno},[string tolower $name])]} {
- incr sourceno 1
- continue
- }
- # The quick index is keyed on the port name, and provides the
- # offset in the main PortIndex where the given port's PortInfo
- # line can be found.
- set offset $quick_index(${sourceno},[string tolower $name])
+ if {![info exists quick_index(${sourceno},[string tolower $name])]} {
+ # no entry in this source, advance to next source
incr sourceno 1
- if {[catch {set fd [open [macports::getindex $source] r]} result]} {
- ui_warn "Can't open index file for source: $source"
- } else {
- try {
- seek $fd $offset
- gets $fd line
- set name [lindex $line 0]
- set len [lindex $line 1]
- set line [read $fd $len]
+ continue
+ }
+ # The quick index is keyed on the port name, and provides the offset in
+ # the main PortIndex where the given port's PortInfo line can be found.
+ set offset $quick_index(${sourceno},[string tolower $name])
+ incr sourceno 1
+ if {[catch {set fd [open [macports::getindex $source] r]} result]} {
+ ui_warn "Can't open index file for source: $source"
+ } else {
+ try {
+ seek $fd $offset
+ gets $fd line
+ set name [lindex $line 0]
+ set len [lindex $line 1]
+ set line [read $fd $len]
- array set portinfo $line
+ 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
- }
+ switch -- $protocol {
+ rsync {
+ set source_url file://[macports::getsourcepath $source]
}
- if {[info exists portinfo(portarchive)]} {
- set porturl ${source_url}/$portinfo(portarchive)
- } elseif {[info exists portinfo(portdir)]} {
- set porturl ${source_url}/$portinfo(portdir)
+ https -
+ http -
+ ftp {
+ set source_url file://[macports::getsourcepath $source]
}
- if {[info exists porturl]} {
- lappend line porturl $porturl
+ default {
+ set source_url $source
}
- lappend matches $name
- lappend matches $line
+ }
+ if {[info exists portinfo(portdir)]} {
+ lappend line porturl ${source_url}/$portinfo(portdir)
+ }
+ lappend matches $name
+ lappend matches $line
+ close $fd
+ set fd -1
+ } catch * {
+ ui_warn "It looks like your PortIndex file for $source may be corrupt."
+ } finally {
+ if {$fd != -1} {
close $fd
- set fd -1
- } catch * {
- ui_warn "It looks like your PortIndex file for $source may be corrupt."
- } finally {
- if {$fd != -1} {
- close $fd
- }
}
- if {[llength $matches] > 0} {
- break
- }
}
- } else {
- set res [macports::index::search $macports::portdbpath $source [list name $name]]
- if {[llength $res] > 0} {
- eval lappend matches $res
+ if {[llength $matches] > 0} {
+ # if we have a match, exit. If we don't, continue with the next
+ # source.
break
}
}
@@ -2678,66 +2692,59 @@
return $matches
}
-# Returns all ports in the indices. Faster than 'mportsearch .*'
-proc mportlistall {args} {
- global macports::portdbpath macports::sources
+##
+# Returns all ports in the indices. Faster than 'mportsearch .*' because of the
+# lack of matching.
+#
+# @return associative array in list form where the first field is the port name
+# and the second field is the line from PortIndex containing the port
+# info. See the return value of mportsearch().
+# @see mportsearch()
+proc mportlistall {} {
+ global macports::sources
set matches [list]
set found 0
foreach source $sources {
set source [lindex $source 0]
set protocol [macports::getprotocol $source]
- if {$protocol ne {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]
+ 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
+ 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
- }
+ switch -- $protocol {
+ rsync {
+ set source_url file://[macports::getsourcepath $source]
}
- if {[info exists portinfo(portdir)]} {
- set porturl ${source_url}/$portinfo(portdir)
- } elseif {[info exists portinfo(portarchive)]} {
- set porturl ${source_url}/$portinfo(portarchive)
+ https -
+ http -
+ ftp {
+ set source_url file://[macports::getsourcepath $source]
}
- if {[info exists porturl]} {
- lappend line porturl $porturl
+ default {
+ set source_url $source
}
- lappend matches $name $line
}
- } catch * {
- ui_warn "It looks like your PortIndex file for $source may be corrupt."
- throw
- } finally {
- close $fd
+ if {[info exists portinfo(portdir)]} {
+ lappend line porturl ${source_url}/$portinfo(portdir)
+ }
+ lappend matches $name $line
}
- } else {
- ui_warn "Can't open index file for source: $source"
+ } catch * {
+ ui_warn "It looks like your PortIndex file for $source may be corrupt."
+ throw
+ } finally {
+ close $fd
}
} else {
- set res [macports::index::search $macports::portdbpath $source [list name .*]]
- eval lappend matches $res
+ ui_warn "Can't open index file for source: $source"
}
}
if {!$found} {
@@ -2747,10 +2754,11 @@
return $matches
}
-
-# Loads PortIndex.quick from each source into the quick_index, generating
-# it first if necessary.
-proc _mports_load_quickindex {args} {
+##
+# Loads PortIndex.quick from each source into the quick_index, generating it
+# first if necessary. Private API of macports1.0, do not use this from outside
+# macports1.0.
+proc _mports_load_quickindex {} {
global macports::sources macports::quick_index
unset -nocomplain macports::quick_index
@@ -2793,6 +2801,20 @@
}
}
+##
+# Generates a PortIndex.quick file from a PortIndex by using the name field as
+# key. This allows fast indexing into the PortIndex when using the port name as
+# key.
+#
+# @param index the PortIndex file to create the index for. The resulting quick
+# index will be in a file named like \a index, but with ".quick"
+# appended.
+# @return a list of entries written to the quick index file in the same format
+# if the file would just have been written.
+# @throws if the given \a index cannot be opened, the output file cannot be
+# opened, an error occurs while using the PortIndex (e.g., because it
+# is corrupt), or the quick index generation failed for some other
+# reason.
proc mports_generate_quickindex {index} {
if {[catch {set indexfd [open $index r]} result] || [catch {set quickfd [open ${index}.quick w]} result]} {
ui_warn "Can't open index file: $index"
Deleted: trunk/base/src/macports1.0/macports_index.tcl
===================================================================
--- trunk/base/src/macports1.0/macports_index.tcl 2013-08-19 15:07:19 UTC (rev 109658)
+++ trunk/base/src/macports1.0/macports_index.tcl 2013-08-19 15:09:48 UTC (rev 109659)
@@ -1,378 +0,0 @@
-# macports_index.tcl
-# $Id$
-#
-# Copyright (c) 2004 Apple Inc.
-# All rights reserved.
-#
-# Redistribution and use in source and binary forms, with or without
-# modification, are permitted provided that the following conditions
-# are met:
-# 1. Redistributions of source code must retain the above copyright
-# notice, this list of conditions and the following disclaimer.
-# 2. Redistributions in binary form must reproduce the above copyright
-# notice, this list of conditions and the following disclaimer in the
-# documentation and/or other materials provided with the distribution.
-# 3. Neither the name of Apple Inc. nor the names of its contributors
-# may be used to endorse or promote products derived from this software
-# without specific prior written permission.
-#
-# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
-# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
-# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-# POSSIBILITY OF SUCH DAMAGE.
-#
-# 31-Mar-2004
-# Kevin Van Vechten <kevin at opedarwin.org>
-#
-
-package provide macports_index 1.0
-
-namespace eval macports::index {
- variable has_sqlite {}
-}
-
-proc macports::index::init {} {
- global macports::index::has_sqlite macports::prefix
- if {$macports::index::has_sqlite == 1 ||
- [file exists ${macports::prefix}/lib/tclsqlite.dylib]} {
- load ${macports::prefix}/lib/tclsqlite.dylib Sqlite
- set macports::index::has_sqlite 1
- } else {
- return -code error "Sqlite must be installed to use a remote index. Use the tclsqlite port."
- }
-}
-
-proc macports::index::get_path {source} {
- global macports::portdbpath
- regsub {://} $source {.} source_dir
- regsub -all {/} $source_dir {_} source_dir
- return [file join $portdbpath sources $source_dir]
-}
-
-
-# macports::index::sync
-# Interact with the remote index at the specified URL.
-# Replays the SQL transactions contained in the remote
-# index file into a local database, creating it if it
-# does not yet exist. If it does already exist, only
-# the transactions newer than the last sync will be
-# downloaded and replayed.
-#
-# portdbpath - the path to which the local database should
-# be stored. "portindex/" and a unique hash based
-# on the url will be appended to this path.
-# url - the url of the remote index to synchronize with
-
-proc macports::index::sync {portdbpath url} {
- macports::index::init
-
- set indexpath [macports::index::get_path $url]
- if {[catch {file mkdir $indexpath} result]} {
- return -code error "$indexpath could not be created: $result"
- }
-
- set oldpath [pwd]
- cd $indexpath
-
- # We actually use http:// as the transport mechanism
- set url [regsub -- {^mports} $url {http}]
-
- # If the database didn't exist, initialize it.
- # The schema is available on the server in the initialize.sql file.
- if {![file exists [file join $indexpath database.sqlite]]} {
- puts "Initializing portindex"
- exec curl --silent -O "$url/index/initialize.sql"
- # XXX detect curl failures
-
- set fd [open initialize.sql r]
- set sql {}
- while {[gets $fd line] >= 0} {
- append sql " $line\n"
- }
- close $fd
- # Database file has the name database.sqlite
- sqlite DB database.sqlite
- DB eval $sql
- DB eval "CREATE TABLE priv_data (keyword text, value int);"
- DB eval "INSERT INTO priv_data (keyword, value) VALUES ('last_index', 1);"
- DB eval "INSERT INTO priv_data (keyword, value) VALUES ('last_trans', 0);"
- DB close
- }
-
- # Database file has the name database.sqlite
- sqlite DB database.sqlite
-
- ##
- # Download any new files
- ##
-
- # Get the last downloaded file index out of the database.
- set start_index [DB eval "SELECT value FROM priv_data WHERE keyword='last_index';"]
-
- # Get the current high-water mark from the server.
- exec curl --silent -O "$url/index/.last_index"
- # XXX detect curl failures
- set fd [open ".last_index" r]
- gets $fd last_index
- # XXX should validate the contents of $last_index
- close $fd
- # Re-fetch the last file we fetched (transactions may have
- # been appended to it) and any new files.
- for {set i $start_index} {$i <= $last_index} {incr i} {
- puts "Fetching portindex-$i"
- exec curl --silent -O "$url/index/portindex-$i.sql"
- # XXX detect curl failures
- DB eval "UPDATE priv_data SET value=$i WHERE keyword='last_index';\n"
- }
-
- ##
- # Replay the transactions
- ##
-
- # Get the last transaction ID out of the database.
- set last_trans [DB eval "SELECT value FROM priv_data WHERE keyword='last_trans';"]
-
- # Iterate through the files we just downloaded
- for {set i $start_index} {$i <= $last_index} {incr i} {
- puts "Processing portindex-$i"
- set fd [open "portindex-$i.sql" r]
- set sql {}
- while {[gets $fd line] >= 0} {
- append sql " $line\n"
- if {[regexp -- {^-- END TRANSACTION #([0-9]+)} $line unused trans_id] == 1} {
- # If this is a transaction we have not seen before, commit it.
- # Also update the last transaction number.
- if {$trans_id > $last_trans} {
- set last_trans $trans_id
- append sql " UPDATE priv_data SET value=$last_trans WHERE keyword='last_trans';\n"
- DB eval $sql
- }
- set sql {}
- }
- }
- close $fd
- }
-
- # Clean Up
- DB close
- cd $oldpath
-}
-
-# macports::index::search
-#
-# Searches the cached copy of the specified port index for
-# the Portfile satisfying the given query.
-#
-# Todo -- in the future we may want to do an implicit "port sync"
-# when this function is called.
-#
-# portdbpath - the path to which the local database should
-# be stored. "portindex/" and a unique hash based
-# on the url will be appended to this path.
-# url - the url of the remote index to search
-#
-# attrs - an array of the attributes to search for
-# currently only "name" is supported.
-
-proc macports::index::search {portdbpath url attrslist} {
- macports::index::init
- set indexpath [macports::index::get_path $url]
-
- if {![file exists $indexpath/database.sqlite]} {
- return -code error "Can't open index file for source $url. Have you synced your source indexes (port sync)?"
- }
-
- sqlite DB $indexpath/database.sqlite
- # Map some functions into the SQL namespace
- DB function regexp regexp
-
- # The guts of the search logic.
- # Precedence is as follows:
- # - If a name, version, and revision is specified return that single port.
- # - If a name and version is specified, return the highest revision
- # - If only a name is specified, return the highest revision of
- # all distinct name, version combinations.
- # - NOTE: it is an error to specify a revision without a version.
-
- set pids [list]
- array set attrs $attrslist
- if {[info exists attrs(name)]} {
- set name $attrs(name)
-
- # If version was not specified, find all distinct versions;
- # otherwise use the specified version.
- if {![info exists attrs(version)]} {
- set sql "SELECT version FROM ports WHERE regexp('--','$name',name) GROUP BY version ORDER BY version DESC"
- set versions [DB eval $sql]
- } else {
- set versions [list $attrs(version)]
- }
-
- # If revision was not specified, find the highest revision;
- # otherwise use the specified revision.
- if {![info exists attrs(revision)]} {
- foreach version $versions {
- set sql "SELECT max(revision) FROM ports WHERE regexp('--','$name',name) AND version LIKE '$version'"
- set revisions($version) [DB eval $sql]
- }
- } else {
- set revisions($version) $attrs(revision)
- }
-
- foreach version $versions {
- set sql "SELECT pid FROM ports WHERE regexp('--','$name',name) AND version LIKE '$version' AND revision LIKE '$revisions($version)'"
- lappend pids [DB eval $sql]
- }
- }
-
- # Historically mportsearch has returned a serialized list of arrays.
- # This is kinda gross and really needs to change to a more opaque
- # data type in the future, but to ease the transition we're it the old
- # way here. For each port that matched the query, build up an array
- # from the keywords table and append it to the list.
-
- set result [list]
-
- foreach pid $pids {
- set portinfo [list]
- set primary_key [DB eval "SELECT name,version,revision FROM ports WHERE pid=$pid"]
- set name [lindex $primary_key 0]
- set version [lindex $primary_key 1]
- set revision [lindex $primary_key 2]
- lappend portinfo name $name
- lappend portinfo version $version
- lappend portinfo revision $revision
-
- set auxiliary_keys [DB eval "SELECT keyword, value FROM keywords WHERE pid=$pid"]
- foreach {key value} $auxiliary_keys {
- # XXX - special case list types: categories, maintainers, master_sites
- lappend portinfo $key $value
- }
-
- # Craft a URL where the port can be found.
- lappend portinfo porturl $url/files/$name/$version/$revision/Portfile.tar.gz
-
- # Make a note of where this port came from.
- lappend portsource $url
-
- lappend result $name
- lappend result $portinfo
- }
-
- DB close
-
- return $result
-}
-
-
-
-# macports::index::fetch_port
-#
-# Checks for a locally cached copy of the port, or downloads the port
-# from the specified URL. The port is extracted into the current working
-# directory along with a .mports_source file containing the url of the
-# source the port came from.
-#
-# The cached portfiles are in the same directory as the cached remote index.
-#
-# TODO - the existing infrastructure only gives us a URL at this point,
-# but we really ought to have an opaque handle to a port. We want to
-# get the source URL and the Portfile.tar.gz md5 from this opaque handle.
-
-proc macports::index::fetch_port {url destdir} {
- global macports::sources
-
- set portsource ""
- set portname ""
- set portversion ""
- set portrevision ""
-
- # Iterate through the sources, to see which one this port is coming from.
- # If the port is not coming from a known source, return an error (for now).
-
- set indexpath ""
- set fetchpath ""
- foreach source $sources {
- if {[regexp -- "^$source" $url] == 1} {
- set portsource $source
- set indexpath [macports::index::get_path $source]
-
- # Extract the relative portion of the url,
- # and append it to the indexpath, this is where
- # we will store the cached Portfile.
- set dir [file dirname [regsub -- "$source/?" $url {}]]
-
- # XXX: crude hack to get port name and version, should realy come from opaque port handle.
- set portname [lindex [file split $dir] 1]
- set portversion [lindex [file split $dir] 2]
- set portrevision [lindex [file split $dir] 3]
-
- set fetchpath [file join $indexpath $dir]
- break
- }
- }
-
- if {$indexpath == "" || $fetchpath == ""} {
- return -code error "Port URL has unknown source: $url"
- }
-
- if {[catch {file mkdir $fetchpath} result]} {
- return -code error $result
- }
-
- # If the portdir already exists, we don't bother extracting again.
-
- # Look to see if the file exists in our cache, if it does, attempt
- # to extract it into the temporary directory that we will build in.
- # If it does not exist, or if the tar extraction fails, then attempt
- # to fetch it again.
-
-
- set portdir [file join "$destdir" "$portname-$portversion"]
-
- if {[file exists $portdir]} {
- return $portdir
- }
-
- if {[catch {file mkdir $portdir} result]} {
- return -code error $result
- }
-
- set fetchfile [file join $fetchpath [file tail $url]]
- set retries 2
- while {$retries > 0} {
- if {[file exists $fetchfile]} {
- set oldcwd [pwd]
- cd $portdir
-
- if {[catch {exec tar -zxf $fetchfile} result]} {
- return -code error "Could not unpack port file: $result"
- }
-
- set fd [open ".mports_source" w]
- puts $fd "source: $portsource"
- puts $fd "port: $portname"
- puts $fd "version: $portversion"
- puts $fd "revision: $portrevision"
- close $fd
-
- cd $oldcwd
- } else {
- # We actually use http:// as the transport mechanism
- set http_url [regsub -- {^mports} $url {http}]
- if {[catch {exec curl -L -s -S -o $fetchfile $http_url} result ]} {
- return -code error "Could not download port from remote index: $result"
- }
- }
- incr retries -1
- }
-
- return $portdir
-}
Modified: trunk/base/src/port/port.tcl
===================================================================
--- trunk/base/src/port/port.tcl 2013-08-19 15:07:19 UTC (rev 109658)
+++ trunk/base/src/port/port.tcl 2013-08-19 15:09:48 UTC (rev 109659)
@@ -3565,11 +3565,14 @@
}
switch -- $opt {
exact -
- glob -
- regex {
+ glob {
set filter_matchstyle $opt
continue
}
+ regex {
+ set filter_matchstyle regexp
+ continue
+ }
case-sensitive {
set filter_case yes
continue
@@ -3607,7 +3610,7 @@
# Map from friendly name
set opt [map_friendly_field_names $opt]
- if {[catch {eval set matches \[mportsearch \$searchstring $filter_case $matchstyle $opt\]} result]} {
+ if {[catch {eval set matches \[mportsearch \$searchstring $filter_case \$matchstyle $opt\]} result]} {
global errorInfo
ui_debug "$errorInfo"
break_softcontinue "search for name $portname failed: $result" 1 status
Modified: trunk/base/src/port/portindex.tcl
===================================================================
--- trunk/base/src/port/portindex.tcl 2013-08-19 15:07:19 UTC (rev 109658)
+++ trunk/base/src/port/portindex.tcl 2013-08-19 15:09:48 UTC (rev 109659)
@@ -12,7 +12,6 @@
package require Pextlib
# Globals
-set archive 0
set full_reindex 0
set stats(total) 0
set stats(failed) 0
@@ -29,7 +28,6 @@
proc print_usage args {
global argv0
puts "Usage: $argv0 \[-adf\] \[-p plat_ver_arch\] \[-o output directory\] \[directory\]"
- puts "-a:\tArchive port directories (for remote sites). Requires -o option"
puts "-o:\tOutput all files to specified directory"
puts "-d:\tOutput debugging information"
puts "-f:\tDo a full re-index instead of updating"
@@ -37,11 +35,11 @@
}
proc pindex {portdir} {
- global target oldfd oldmtime newest qindex fd directory archive outdir stats full_reindex \
+ global target oldfd oldmtime newest qindex fd directory outdir stats full_reindex \
ui_options port_options save_prefix keepkeys
# try to reuse the existing entry if it's still valid
- if {$full_reindex != "1" && $archive != "1" && [info exists qindex([string tolower [file tail $portdir]])]} {
+ if {$full_reindex != "1" && [info exists qindex([string tolower [file tail $portdir]])]} {
try {
set mtime [file mtime [file join $directory $portdir Portfile]]
if {$oldmtime >= $mtime} {
@@ -101,23 +99,6 @@
mportclose $interp
set portinfo(portdir) $portdir
puts "Adding port $portdir"
- if {$archive == "1"} {
- if {![file isdirectory [file join $outdir [file dirname $portdir]]]} {
- if {[catch {file mkdir [file join $outdir [file dirname $portdir]]} result]} {
- puts stderr "$result"
- exit 1
- }
- }
- set portinfo(portarchive) [file join [file dirname $portdir] [file tail $portdir]].tgz
- cd [file join $directory [file dirname $portinfo(portdir)]]
- puts "Archiving port $portinfo(name) to [file join $outdir $portinfo(portarchive)]"
- set tar [macports::findBinary tar $macports::autoconf::tar_path]
- set gzip [macports::findBinary gzip $macports::autoconf::gzip_path]
- if {[catch {exec $tar -cf - [file tail $portdir] | $gzip -c >[file join $outdir $portinfo(portarchive)]} result]} {
- puts stderr "Failed to create port archive $portinfo(portarchive): $result"
- exit 1
- }
- }
foreach availkey [array names portinfo] {
# store list of subports for top-level ports only
@@ -174,9 +155,7 @@
set arg [lindex $argv $i]
switch -regex -- $arg {
{^-.+} {
- if {$arg == "-a"} { # Turn on archiving
- set archive 1
- } elseif {$arg == "-d"} { # Turn on debug output
+ if {$arg == "-d"} { # Turn on debug output
set ui_options(ports_debug) yes
} elseif {$arg == "-o"} { # Set output directory
incr i
@@ -206,12 +185,6 @@
}
}
-if {$archive == 1 && ![info exists outdir]} {
- puts stderr "You must specify an output directory with -o when using the -a option"
- print_usage
- exit 1
-}
-
if {![info exists directory]} {
set directory .
}
@@ -264,7 +237,7 @@
foreach key {categories depends_fetch depends_extract depends_build \
depends_lib depends_run description epoch homepage \
long_description maintainers name platforms revision variants \
- version portdir portarchive replaced_by license installs_libs} {
+ version portdir replaced_by license installs_libs} {
set keepkeys($key) 1
}
mporttraverse pindex $directory
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.macosforge.org/pipermail/macports-changes/attachments/20130819/65142d35/attachment-0001.html>
More information about the macports-changes
mailing list