<pre style='margin:0'>
Joshua Root (jmroot) pushed a commit to branch master
in repository macports-base.
</pre>
<p><a href="https://github.com/macports/macports-base/commit/b81bcbbdb4f6ace3da420b3984ae61e76536568a">https://github.com/macports/macports-base/commit/b81bcbbdb4f6ace3da420b3984ae61e76536568a</a></p>
<pre style="white-space: pre; background: #F8F8F8">The following commit(s) were added to refs/heads/master by this push:
<span style='display:block; white-space:pre;color:#404040;'> new b81bcbb Keep repeatedly-used regexes in variables
</span>b81bcbb is described below
<span style='display:block; white-space:pre;color:#808000;'>commit b81bcbbdb4f6ace3da420b3984ae61e76536568a
</span>Author: Joshua Root <jmr@macports.org>
AuthorDate: Sat Jun 29 17:50:38 2019 +1000
<span style='display:block; white-space:pre;color:#404040;'> Keep repeatedly-used regexes in variables
</span><span style='display:block; white-space:pre;color:#404040;'>
</span><span style='display:block; white-space:pre;color:#404040;'> This ensures that Tcl will store the compiled regex along with the string
</span><span style='display:block; white-space:pre;color:#404040;'> representation of the variable.
</span>---
src/macports1.0/macports.tcl | 33 ++++++++++++++++++++++-----------
src/port/port.tcl | 9 +++++----
src/port1.0/fetch_common.tcl | 12 +++++++-----
src/port1.0/portdestroot.tcl | 18 ++++++++++++------
src/port1.0/portutil.tcl | 24 ++++++++++++++++--------
src/registry2.0/portimage.tcl | 3 ++-
6 files changed, 64 insertions(+), 35 deletions(-)
<span style='display:block; white-space:pre;color:#808080;'>diff --git a/src/macports1.0/macports.tcl b/src/macports1.0/macports.tcl
</span><span style='display:block; white-space:pre;color:#808080;'>index 7ef9bf0..c26f066 100644
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>--- a/src/macports1.0/macports.tcl
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>+++ b/src/macports1.0/macports.tcl
</span><span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -747,12 +747,13 @@ proc mportinit {{up_ui_options {}} {up_options {}} {up_variations {}}} {
</span> }
# Process all configuration files we find on conf_files list
<span style='display:block; white-space:pre;background:#e0ffe0;'>+ set conf_option_re {^(\w+)([ \t]+(.*))?$}
</span> foreach file $conf_files {
if {[file exists $file]} {
set portconf $file
set fd [open $file r]
while {[gets $fd line] >= 0} {
<span style='display:block; white-space:pre;background:#ffe0e0;'>- if {[regexp {^(\w+)([ \t]+(.*))?$} $line match option ignore val] == 1} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[regexp $conf_option_re $line match option ignore val] == 1} {
</span> if {$option in $bootstrap_options} {
set macports::$option [string trim $val]
global macports::$option
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -768,7 +769,7 @@ proc mportinit {{up_ui_options {}} {up_options {}} {up_variations {}}} {
</span> if {[file exists $per_user]} {
set fd [open $per_user r]
while {[gets $fd line] >= 0} {
<span style='display:block; white-space:pre;background:#ffe0e0;'>- if {[regexp {^(\w+)([ \t]+(.*))?$} $line match option ignore val] == 1} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[regexp $conf_option_re $line match option ignore val] == 1} {
</span> if {$option in $user_options} {
set macports::$option $val
global macports::$option
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -781,11 +782,13 @@ proc mportinit {{up_ui_options {}} {up_options {}} {up_variations {}}} {
</span> if {![info exists sources_conf]} {
return -code error "sources_conf must be set in ${macports_conf_path}/macports.conf or in your ${macports_user_dir}/macports.conf file"
}
<span style='display:block; white-space:pre;background:#e0ffe0;'>+ set sources_conf_comment_re {^\s*#|^$}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set sources_conf_source_re {^([\w-]+://\S+)(?:\s+\[(\w+(?:,\w+)*)\])?$}
</span> set fd [open $sources_conf r]
while {[gets $fd line] >= 0} {
set line [string trimright $line]
<span style='display:block; white-space:pre;background:#ffe0e0;'>- if {![regexp {^\s*#|^$} $line]} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if {[regexp {^([\w-]+://\S+)(?:\s+\[(\w+(?:,\w+)*)\])?$} $line _ url flags]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {![regexp $sources_conf_comment_re $line]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[regexp $sources_conf_source_re $line _ url flags]} {
</span> set flags [split $flags ,]
foreach flag $flags {
if {$flag ni [list nosync default]} {
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -825,14 +828,17 @@ Please edit sources.conf and change '$url' to '[string range $url 0 end-6]tarbal
</span> set sources_default [lindex $sources end]
}
<span style='display:block; white-space:pre;background:#e0ffe0;'>+ # regex also used by pubkeys.conf
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set variants_conf_comment_re {^[\ \t]*#.*$|^$}
</span> if {[info exists variants_conf]} {
if {[file exists $variants_conf]} {
<span style='display:block; white-space:pre;background:#e0ffe0;'>+ set variants_conf_setting_re {^([-+])([-A-Za-z0-9_+\.]+)$}
</span> set fd [open $variants_conf r]
while {[gets $fd line] >= 0} {
set line [string trimright $line]
<span style='display:block; white-space:pre;background:#ffe0e0;'>- if {![regexp {^[\ \t]*#.*$|^$} $line]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {![regexp $variants_conf_comment_re $line]} {
</span> foreach arg [split $line " \t"] {
<span style='display:block; white-space:pre;background:#ffe0e0;'>- if {[regexp {^([-+])([-A-Za-z0-9_+\.]+)$} $arg match sign opt] == 1} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[regexp $variants_conf_setting_re $arg match sign opt] == 1} {
</span> if {![info exists variations($opt)]} {
set variations($opt) $sign
}
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -856,7 +862,7 @@ Please edit sources.conf and change '$url' to '[string range $url 0 end-6]tarbal
</span> set fd [open [file join $macports_conf_path pubkeys.conf] r]
while {[gets $fd line] >= 0} {
set line [string trim $line]
<span style='display:block; white-space:pre;background:#ffe0e0;'>- if {![regexp {^[\ \t]*#.*$|^$} $line]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {![regexp $variants_conf_comment_re $line]} {
</span> lappend macports::archivefetch_pubkeys $line
}
}
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -1665,8 +1671,9 @@ proc macports::fetch_port {url {local 0}} {
</span> return [file join $fetchdir $portname]
}
<span style='display:block; white-space:pre;background:#e0ffe0;'>+set macports::getprotocol_re {(?x)([^:]+)://.+}
</span> proc macports::getprotocol {url} {
<span style='display:block; white-space:pre;background:#ffe0e0;'>- if {[regexp {(?x)([^:]+)://.+} $url match protocol] == 1} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[regexp $::macports::getprotocol_re $url match protocol] == 1} {
</span> return $protocol
} else {
return -code error "Can't parse url $url"
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -1771,6 +1778,8 @@ proc macports::getdefaultportresourcepath {{path {}}} {
</span> }
<span style='display:block; white-space:pre;background:#e0ffe0;'>+set macports::file_porturl_re {^file://(.*)}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span> ##
# Opens a MacPorts portfile specified by a URL. The URL can be local (starting
# with file://), or remote (http, https, or ftp). In the local case, the URL
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -1796,7 +1805,7 @@ proc mportopen {porturl {options {}} {variations {}} {nocache {}}} {
</span> global macports::portdbpath macports::portconf macports::open_mports auto_path
# normalize porturl for local files
<span style='display:block; white-space:pre;background:#ffe0e0;'>- if {[regexp {^file://(.*)} $porturl -> path]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[regexp $::macports::file_porturl_re $porturl -> path]} {
</span> set realporturl "file://[file normalize $path]"
if {$porturl ne $realporturl} {
set porturl $realporturl
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -2394,6 +2403,7 @@ proc macports::getsourcepath {url} {
</span> return [file join $portdbpath sources [lindex $source_path 3] [lindex $source_path 4] [lindex $source_path 5]]
}
<span style='display:block; white-space:pre;background:#e0ffe0;'>+set macports::source_is_snapshot_re {^((?:https?|ftp|rsync)://.+/)(.+\.(tar\.gz|tar\.bz2|tar))$}
</span> ##
# Checks whether a supplied source URL is for a snapshot tarball
# (private)
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -2407,7 +2417,7 @@ proc _source_is_snapshot {url {filename {}} {extension {}} {rooturl {}}} {
</span> upvar $filename myfilename
upvar $extension myextension
<span style='display:block; white-space:pre;background:#ffe0e0;'>- if {[regexp {^((?:https?|ftp|rsync)://.+/)(.+\.(tar\.gz|tar\.bz2|tar))$} $url -> u f e]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[regexp $::macports::source_is_snapshot_re $url -> u f e]} {
</span> set myrooturl $u
set myfilename $f
set myextension $e
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -5386,10 +5396,11 @@ proc macports::get_archive_sites_conf_values {} {
</span> array set defaults $defaults_list
set conf_file ${macports_conf_path}/archive_sites.conf
set conf_options {applications_dir cxx_stdlib delete_la_files frameworks_dir name prefix type urls}
<span style='display:block; white-space:pre;background:#e0ffe0;'>+ set line_re {^(\w+)([ \t]+(.*))?$}
</span> if {[file isfile $conf_file]} {
set fd [open $conf_file r]
while {[gets $fd line] >= 0} {
<span style='display:block; white-space:pre;background:#ffe0e0;'>- if {[regexp {^(\w+)([ \t]+(.*))?$} $line match option ignore val] == 1} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[regexp $line_re $line match option ignore val] == 1} {
</span> if {$option in $conf_options} {
if {$option eq "name"} {
set cur_name $val
<span style='display:block; white-space:pre;color:#808080;'>diff --git a/src/port/port.tcl b/src/port/port.tcl
</span><span style='display:block; white-space:pre;color:#808080;'>index 18fe1b2..05ed3b7 100755
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>--- a/src/port/port.tcl
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>+++ b/src/port/port.tcl
</span><span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -155,10 +155,10 @@ proc composite_version {version variations {emptyVersionOkay 0}} {
</span> return $composite_version
}
<span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+set port_split_variants_re {([-+])([[:alpha:]_]+[\w\.]*)}
</span> proc split_variants {variants} {
set result {}
<span style='display:block; white-space:pre;background:#ffe0e0;'>- set l [regexp -all -inline -- {([-+])([[:alpha:]_]+[\w\.]*)} $variants]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set l [regexp -all -inline -- $::port_split_variants_re $variants]
</span> foreach { match sign variant } $l {
lappend result $variant $sign
}
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -1895,8 +1895,8 @@ proc action_log { action portlist opts } {
</span> } else {
set prefix "\[a-z\]*"
}
<span style='display:block; white-space:pre;background:#e0ffe0;'>+ set exp "^:($prefix|any):($phase|any) (.*)$"
</span> foreach line $data {
<span style='display:block; white-space:pre;background:#ffe0e0;'>- set exp "^:($prefix|any):($phase|any) (.*)$"
</span> if {[regexp $exp $line -> lpriority lphase lmsg] == 1} {
puts "[macports::ui_prefix_default $lpriority]$lmsg"
}
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -5553,10 +5553,11 @@ namespace eval portclient::questions {
</span> set selected_opt []
set err_flag 1
<span style='display:block; white-space:pre;background:#e0ffe0;'>+ set range_re {(\d+)-(\d+)}
</span> foreach num $input {
if {[string is wideinteger -strict $num] && $num <= [llength $ports] && $num > 0} {
lappend selected_opt [expr {$num -1}]
<span style='display:block; white-space:pre;background:#ffe0e0;'>- } elseif {[regexp {(\d+)-(\d+)} $input _ start end]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ } elseif {[regexp $range_re $input _ start end]
</span> && $start <= [llength $ports]
&& $start > 0
&& $end <= [llength $ports]
<span style='display:block; white-space:pre;color:#808080;'>diff --git a/src/port1.0/fetch_common.tcl b/src/port1.0/fetch_common.tcl
</span><span style='display:block; white-space:pre;color:#808080;'>index 0e49dce..591f760 100644
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>--- a/src/port1.0/fetch_common.tcl
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>+++ b/src/port1.0/fetch_common.tcl
</span><span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -97,6 +97,7 @@ proc portfetch::mirror_sites {mirrors tag subdir mirrorfile} {
</span> }
set ret [list]
<span style='display:block; white-space:pre;background:#e0ffe0;'>+ set name_re {\$(?:name\y|\{name\})}
</span> foreach element $portfetch::mirror_sites::sites($mirrors) {
# here we have the chance to take a look at tags, that possibly
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -113,7 +114,6 @@ proc portfetch::mirror_sites {mirrors tag subdir mirrorfile} {
</span> set mirror_tag ""
}
<span style='display:block; white-space:pre;background:#ffe0e0;'>- set name_re {\$(?:name\y|\{name\})}
</span> # if the URL has $name embedded, kill any mirror_tag that may have been added
# since a mirror_tag and $name are incompatible
if {[regexp $name_re $element]} {
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -153,6 +153,8 @@ proc portfetch::mirror_sites {mirrors tag subdir mirrorfile} {
</span> proc portfetch::checksites {sitelists mirrorfile} {
global env
variable urlmap
<span style='display:block; white-space:pre;background:#e0ffe0;'>+ set url_re {([a-zA-Z]+://.+)}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set tagged_url_re {([a-zA-Z]+://.+/?):([0-9A-Za-z_-]+)$}
</span>
foreach {listname extras} $sitelists {
upvar #0 $listname $listname
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -175,7 +177,7 @@ proc portfetch::checksites {sitelists mirrorfile} {
</span>
set site_list [list]
foreach site $full_list {
<span style='display:block; white-space:pre;background:#ffe0e0;'>- if {[regexp {([a-zA-Z]+://.+)} $site match site]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[regexp $url_re $site match site]} {
</span> set site_list [concat $site_list $site]
} else {
set splitlist [split $site :]
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -194,7 +196,7 @@ proc portfetch::checksites {sitelists mirrorfile} {
</span>
# add in the global and user-defined mirrors for each tag
foreach site $site_list {
<span style='display:block; white-space:pre;background:#ffe0e0;'>- if {[regexp {([a-zA-Z]+://.+/?):([0-9A-Za-z_-]+)$} $site match site tag] && ![info exists extras_added($tag)]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[regexp $tagged_url_re $site match site tag] && ![info exists extras_added($tag)]} {
</span> if {$sglobal ne ""} {
set site_list [concat $site_list [mirror_sites $sglobal $tag "" $mirrorfile]]
}
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -206,7 +208,7 @@ proc portfetch::checksites {sitelists mirrorfile} {
</span> }
foreach site $site_list {
<span style='display:block; white-space:pre;background:#ffe0e0;'>- if {[regexp {([a-zA-Z]+://.+/?):([0-9A-Za-z_-]+)$} $site match site tag]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[regexp $tagged_url_re $site match site tag]} {
</span> lappend urlmap($tag) $site
} else {
lappend urlmap($listname) $site
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -220,6 +222,7 @@ proc portfetch::sortsites {urls default_listvar} {
</span> global $default_listvar
upvar $urls fetch_urls
variable urlmap
<span style='display:block; white-space:pre;background:#e0ffe0;'>+ set hostregex {[a-zA-Z]+://([a-zA-Z0-9\.\-_]+)}
</span>
foreach {url_var distfile} $fetch_urls {
if {![info exists urlmap($url_var)]} {
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -232,7 +235,6 @@ proc portfetch::sortsites {urls default_listvar} {
</span> }
set urllist $urlmap($url_var)
set hosts {}
<span style='display:block; white-space:pre;background:#ffe0e0;'>- set hostregex {[a-zA-Z]+://([a-zA-Z0-9\.\-_]+)}
</span>
if {[llength $urllist] <= 1} {
# there is only one mirror, no need to ping or sort
<span style='display:block; white-space:pre;color:#808080;'>diff --git a/src/port1.0/portdestroot.tcl b/src/port1.0/portdestroot.tcl
</span><span style='display:block; white-space:pre;color:#808080;'>index 26b4d2e..35c5f80 100644
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>--- a/src/port1.0/portdestroot.tcl
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>+++ b/src/port1.0/portdestroot.tcl
</span><span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -207,25 +207,30 @@ proc portdestroot::destroot_finish {args} {
</span> ui_info "$UI_PREFIX [format [msgcat::mc "Compressing man pages for %s"] ${subport}]"
set found 0
set manlinks [list]
<span style='display:block; white-space:pre;background:#e0ffe0;'>+ set mandir_re {^(cat|man)(.)$}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span> foreach mandir [readdir "${manpath}"] {
<span style='display:block; white-space:pre;background:#ffe0e0;'>- if {![regexp {^(cat|man)(.)$} ${mandir} match ignore manindex]} { continue }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {![regexp ${mandir_re} ${mandir} match ignore manindex]} { continue }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set gzfile_re "^(.*\[.\]${manindex}\[a-z\]*)\[.\]gz\$"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set bz2file_re "^(.*\[.\]${manindex}\[a-z\]*)\[.\]bz2\$"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set normalfile_re "\[.\]${manindex}\[a-z\]*\$"
</span> set mandirpath [file join ${manpath} ${mandir}]
if {[file isdirectory ${mandirpath}] && [file type ${mandirpath}] eq "directory"} {
ui_debug "Scanning ${mandir}"
foreach manfile [readdir ${mandirpath}] {
set manfilepath [file join ${mandirpath} ${manfile}]
if {[file isfile ${manfilepath}] && [file type ${manfilepath}] eq "file"} {
<span style='display:block; white-space:pre;background:#ffe0e0;'>- if {[regexp "^(.*\[.\]${manindex}\[a-z\]*)\[.\]gz\$" ${manfile} gzfile manfile]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[regexp ${gzfile_re} ${manfile} gzfile manfile]} {
</span> set found 1
system -W ${manpath} \
"$gunzip -f [file join ${mandir} ${gzfile}] && \
$gzip -9vnf [file join ${mandir} ${manfile}]"
<span style='display:block; white-space:pre;background:#ffe0e0;'>- } elseif {[regexp "^(.*\[.\]${manindex}\[a-z\]*)\[.\]bz2\$" ${manfile} bz2file manfile]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ } elseif {[regexp ${bz2file_re} ${manfile} bz2file manfile]} {
</span> set found 1
system -W ${manpath} \
"$bunzip2 -f [file join ${mandir} ${bz2file}] && \
$gzip -9vnf [file join ${mandir} ${manfile}]"
<span style='display:block; white-space:pre;background:#ffe0e0;'>- } elseif {[regexp "\[.\]${manindex}\[a-z\]*\$" ${manfile}]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ } elseif {[regexp ${normalfile_re} ${manfile}]} {
</span> set found 1
system -W ${manpath} \
"$gzip -9vnf [file join ${mandir} ${manfile}]"
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -248,11 +253,12 @@ proc portdestroot::destroot_finish {args} {
</span> }
if {$found == 1} {
# check man page links and rename/repoint them if necessary
<span style='display:block; white-space:pre;background:#e0ffe0;'>+ set gzext_re "\[.\]gz\$"
</span> foreach manlink $manlinks {
set manlinkpath [file join $manpath $manlink]
# if link destination is not gzipped, check it
set manlinksrc [file readlink $manlinkpath]
<span style='display:block; white-space:pre;background:#ffe0e0;'>- if {![regexp "\[.\]gz\$" ${manlinksrc}]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {![regexp ${gzext_re} ${manlinksrc}]} {
</span> set mandir [file dirname $manlink]
set mandirpath [file join $manpath $mandir]
set pwd [pwd]
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -268,7 +274,7 @@ proc portdestroot::destroot_finish {args} {
</span> # if gzipped destination exists, fix link
if {[file isfile ${mls_check}.gz]} {
# if actual link name does not end with gz, rename it
<span style='display:block; white-space:pre;background:#ffe0e0;'>- if {![regexp "\[.\]gz\$" ${manlink}]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {![regexp ${gzext_re} ${manlink}]} {
</span> ui_debug "renaming link: $manlink to ${manlink}.gz"
file rename $manlinkpath ${manlinkpath}.gz
set manlink ${manlink}.gz
<span style='display:block; white-space:pre;color:#808080;'>diff --git a/src/port1.0/portutil.tcl b/src/port1.0/portutil.tcl
</span><span style='display:block; white-space:pre;color:#808080;'>index 068d3e6..6911c8a 100644
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>--- a/src/port1.0/portutil.tcl
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>+++ b/src/port1.0/portutil.tcl
</span><span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -773,10 +773,12 @@ proc platform {args} {
</span> set os [lindex $args 0]
set args [lrange $args 1 [expr {$len - 2}]]
<span style='display:block; white-space:pre;background:#e0ffe0;'>+ set release_re {(^[0-9]+$)}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set arch_re {([a-zA-Z0-9]*)}
</span> foreach arg $args {
<span style='display:block; white-space:pre;background:#ffe0e0;'>- if {[regexp {(^[0-9]+$)} $arg match result]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[regexp $release_re $arg match result]} {
</span> set release $result
<span style='display:block; white-space:pre;background:#ffe0e0;'>- } elseif {[regexp {([a-zA-Z0-9]*)} $arg match result]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ } elseif {[regexp $arch_re $arg match result]} {
</span> set arch $result
}
}
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -1794,9 +1796,10 @@ proc open_statefile {args} {
</span> # $result, if any. Returns 1 if a line matched, 0 otherwise
proc get_statefile_value {class fd result} {
upvar $result upresult
<span style='display:block; white-space:pre;background:#e0ffe0;'>+ set line_re "$class: (.*)"
</span> seek $fd 0
while {[gets $fd line] >= 0} {
<span style='display:block; white-space:pre;background:#ffe0e0;'>- if {[regexp "$class: (.*)" $line match value]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[regexp $line_re $line match value]} {
</span> set upresult $value
return 1
}
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -1861,13 +1864,15 @@ proc check_statefile_variants {variations oldvariations fd} {
</span>
set variants_found no
set targets_found no
<span style='display:block; white-space:pre;background:#e0ffe0;'>+ set variant_re "variant: (.*)"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set target_re "target: .*"
</span> seek $fd 0
while {[gets $fd line] >= 0} {
<span style='display:block; white-space:pre;background:#ffe0e0;'>- if {[regexp "variant: (.*)" $line match name]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[regexp $variant_re $line match name]} {
</span> set upoldvariations([string range $name 1 end]) [string range $name 0 0]
set variants_found yes
}
<span style='display:block; white-space:pre;background:#ffe0e0;'>- if {[regexp "target: .*" $line]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[regexp $target_re $line]} {
</span> set targets_found yes
}
}
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -2239,8 +2244,9 @@ proc handle_default_variants {option action {value ""}} {
</span> set PortInfo(vinfo) {}
}
array set vinfo $PortInfo(vinfo)
<span style='display:block; white-space:pre;background:#e0ffe0;'>+ set re {([-+])([-A-Za-z0-9_.]+)}
</span> foreach v $value {
<span style='display:block; white-space:pre;background:#ffe0e0;'>- if {[regexp {([-+])([-A-Za-z0-9_.]+)} $v whole val variant]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[regexp $re $v whole val variant]} {
</span> # Retrieve the information associated with this variant.
if {![info exists vinfo($variant)]} {
set vinfo($variant) {}
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -2307,8 +2313,9 @@ proc adduser {name args} {
</span> set home /var/empty
set shell /usr/bin/false
<span style='display:block; white-space:pre;background:#e0ffe0;'>+ set keyval_re {([a-z]*)=(.*)}
</span> foreach arg $args {
<span style='display:block; white-space:pre;background:#ffe0e0;'>- if {[regexp {([a-z]*)=(.*)} $arg match key val]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[regexp $keyval_re $arg match key val]} {
</span> set $key $val
}
}
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -2415,8 +2422,9 @@ proc addgroup {name args} {
</span> set passwd {*}
set users ""
<span style='display:block; white-space:pre;background:#e0ffe0;'>+ set keyval_re {([a-z]*)=(.*)}
</span> foreach arg $args {
<span style='display:block; white-space:pre;background:#ffe0e0;'>- if {[regexp {([a-z]*)=(.*)} $arg match key val]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[regexp $keyval_re $arg match key val]} {
</span> set $key $val
}
}
<span style='display:block; white-space:pre;color:#808080;'>diff --git a/src/registry2.0/portimage.tcl b/src/registry2.0/portimage.tcl
</span><span style='display:block; white-space:pre;color:#808080;'>index 6d0c1a8..20d429b 100644
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>--- a/src/registry2.0/portimage.tcl
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>+++ b/src/registry2.0/portimage.tcl
</span><span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -464,6 +464,7 @@ proc _activate_contents {port {rename_list {}}} {
</span> set location [$port location]
set imagefiles [$port imagefiles]
set extracted_dir [extract_archive_to_tmpdir $location]
<span style='display:block; white-space:pre;background:#e0ffe0;'>+ set replaced_by_re "(?i)^[$port name]\$"
</span>
set backups [list]
# This is big and hairy and probably could be done better.
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -493,7 +494,7 @@ proc _activate_contents {port {rename_list {}}} {
</span> set result [mportlookup [$owner name]]
array unset portinfo
array set portinfo [lindex $result 1]
<span style='display:block; white-space:pre;background:#ffe0e0;'>- if {[info exists portinfo(replaced_by)] && [lsearch -regexp $portinfo(replaced_by) "(?i)^[$port name]\$"] != -1} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[info exists portinfo(replaced_by)] && [lsearch -regexp $portinfo(replaced_by) $replaced_by_re] != -1} {
</span> # we'll deactivate the owner later, but before activating our files
set todeactivate($owner) yes
set owner "replaced"
</pre><pre style='margin:0'>
</pre>