[31805] trunk/base/src/port1.0/portutil.tcl
jmpp at macports.org
jmpp at macports.org
Fri Dec 7 20:25:09 PST 2007
Revision: 31805
http://trac.macosforge.org/projects/macports/changeset/31805
Author: jmpp at macports.org
Date: 2007-12-07 20:25:07 -0800 (Fri, 07 Dec 2007)
Log Message:
-----------
Massive whitespace cleanups to the portutil.tcl file, add modeline.
Modified Paths:
--------------
trunk/base/src/port1.0/portutil.tcl
Modified: trunk/base/src/port1.0/portutil.tcl
===================================================================
--- trunk/base/src/port1.0/portutil.tcl 2007-12-08 03:14:52 UTC (rev 31804)
+++ trunk/base/src/port1.0/portutil.tcl 2007-12-08 04:25:07 UTC (rev 31805)
@@ -1,4 +1,4 @@
-# et:ts=4
+# -*- coding: utf-8; mode: tcl; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- vim:fenc=utf-8:filetype=tcl:et:sw=4:ts=4:sts=4
# portutil.tcl
# $Id$
#
@@ -54,8 +54,8 @@
# option
# This is an accessor for Portfile options. Targets may use
# this in the same style as the standard Tcl "set" procedure.
-# name - the name of the option to read or write
-# value - an optional value to assign to the option
+# name - the name of the option to read or write
+# value - an optional value to assign to the option
proc option {name args} {
# XXX: right now we just transparently use globals
@@ -63,8 +63,8 @@
# the Portfile's interpreter and the target's interpreters.
global $name
if {[llength $args] > 0} {
- ui_debug "setting option $name to $args"
- set $name [lindex $args 0]
+ ui_debug "setting option $name to $args"
+ set $name [lindex $args 0]
}
return [set $name]
}
@@ -72,7 +72,7 @@
# exists
# This is an accessor for Portfile options. Targets may use
# this procedure to test for the existence of a Portfile option.
-# name - the name of the option to test for existence
+# name - the name of the option to test for existence
proc exists {name} {
# XXX: right now we just transparently use globals
@@ -208,7 +208,7 @@
# and used to form a standard set of command options.
proc commands {args} {
foreach option $args {
- options use_${option} ${option}.dir ${option}.pre_args ${option}.args ${option}.post_args ${option}.env ${option}.type ${option}.cmd
+ options use_${option} ${option}.dir ${option}.pre_args ${option}.args ${option}.post_args ${option}.env ${option}.type ${option}.cmd
}
}
@@ -218,23 +218,23 @@
global ${command}.dir ${command}.pre_args ${command}.args ${command}.post_args ${command}.cmd
if {[info exists ${command}.dir]} {
- append cmdstring "cd \"[set ${command}.dir]\" &&"
+ append cmdstring "cd \"[set ${command}.dir]\" &&"
}
if {[info exists ${command}.cmd]} {
- foreach string [set ${command}.cmd] {
- append cmdstring " $string"
- }
+ foreach string [set ${command}.cmd] {
+ append cmdstring " $string"
+ }
} else {
- append cmdstring " ${command}"
+ append cmdstring " ${command}"
}
foreach var "${command}.pre_args ${command}.args ${command}.post_args" {
- if {[info exists $var]} {
- foreach string [set ${var}] {
- append cmdstring " ${string}"
- }
- }
+ if {[info exists $var]} {
+ foreach string [set ${var}] {
+ append cmdstring " ${string}"
+ }
+ }
}
ui_debug "Assembled command: '$cmdstring'"
@@ -243,69 +243,69 @@
# Given a command name, execute it with the options.
# command_exec command [-notty] [command_prefix [command_suffix]]
-# command name of the command
-# command_prefix additional command prefix (typically pipe command)
-# command_suffix additional command suffix (typically redirection)
+# command name of the command
+# command_prefix additional command prefix (typically pipe command)
+# command_suffix additional command suffix (typically redirection)
proc command_exec {command args} {
- global ${command}.env ${command}.env_array env
- set notty 0
- set command_prefix ""
- set command_suffix ""
+ global ${command}.env ${command}.env_array env
+ set notty 0
+ set command_prefix ""
+ set command_suffix ""
- if {[llength $args] > 0} {
- if {[lindex $args 0] == "-notty"} {
- set notty 1
- set args [lrange $args 1 end]
- }
+ if {[llength $args] > 0} {
+ if {[lindex $args 0] == "-notty"} {
+ set notty 1
+ set args [lrange $args 1 end]
+ }
- if {[llength $args] > 0} {
- set command_prefix [lindex $args 0]
- if {[llength $args] > 1} {
- set command_suffix [lindex $args 1]
- }
- }
- }
-
- # Set the environment.
- # If the array doesn't exist, we create it with the value
- # coming from ${command}.env
- # Otherwise, it means the caller actually played with the environment
- # array already (e.g. configure flags).
- if {![array exists ${command}.env_array]} {
- parse_environment ${command}
- }
- if {[option macosx_deployment_target] ne ""} {
- append_list_to_environment_value ${command} "MACOSX_DEPLOYMENT_TARGET" [option macosx_deployment_target]
- }
-
- # Debug that.
+ if {[llength $args] > 0} {
+ set command_prefix [lindex $args 0]
+ if {[llength $args] > 1} {
+ set command_suffix [lindex $args 1]
+ }
+ }
+ }
+
+ # Set the environment.
+ # If the array doesn't exist, we create it with the value
+ # coming from ${command}.env
+ # Otherwise, it means the caller actually played with the environment
+ # array already (e.g. configure flags).
+ if {![array exists ${command}.env_array]} {
+ parse_environment ${command}
+ }
+ if {[option macosx_deployment_target] ne ""} {
+ append_list_to_environment_value ${command} "MACOSX_DEPLOYMENT_TARGET" [option macosx_deployment_target]
+ }
+
+ # Debug that.
ui_debug "Environment: [environment_array_to_string ${command}.env_array]"
- # Get the command string.
- set cmdstring [command_string ${command}]
-
- # Call this command.
- # TODO: move that to the system native call?
- # Save the environment.
- array set saved_env [array get env]
- # Set the overriden variables from the portfile.
- array set env [array get ${command}.env_array]
- # Call the command.
- set fullcmdstring "$command_prefix $cmdstring $command_suffix"
- if {$notty} {
- set code [catch {system -notty $fullcmdstring} result]
- } else {
- set code [catch {system $fullcmdstring} result]
- }
- # Unset the command array until next time.
- array unset ${command}.env_array
-
- # Restore the environment.
- array unset env *
- array set env [array get saved_env]
+ # Get the command string.
+ set cmdstring [command_string ${command}]
+
+ # Call this command.
+ # TODO: move that to the system native call?
+ # Save the environment.
+ array set saved_env [array get env]
+ # Set the overriden variables from the portfile.
+ array set env [array get ${command}.env_array]
+ # Call the command.
+ set fullcmdstring "$command_prefix $cmdstring $command_suffix"
+ if {$notty} {
+ set code [catch {system -notty $fullcmdstring} result]
+ } else {
+ set code [catch {system $fullcmdstring} result]
+ }
+ # Unset the command array until next time.
+ array unset ${command}.env_array
+
+ # Restore the environment.
+ array unset env *
+ array set env [array get saved_env]
- # Return as if system had been called directly.
- return -code $code $result
+ # Return as if system had been called directly.
+ return -code $code $result
}
# default
@@ -315,15 +315,15 @@
proc default {option val} {
global $option option_defaults
if {[info exists option_defaults($option)]} {
- ui_debug "Re-registering default for $option"
- # remove the old trace
- trace vdelete $option rwu default_check
+ ui_debug "Re-registering default for $option"
+ # remove the old trace
+ trace vdelete $option rwu default_check
} else {
- # If option is already set and we did not set it
- # do not reset the value
- if {[info exists $option]} {
- return
- }
+ # If option is already set and we did not set it
+ # do not reset the value
+ if {[info exists $option]} {
+ return
+ }
}
set option_defaults($option) $val
set $option $val
@@ -336,21 +336,21 @@
proc default_check {optionName index op} {
global option_defaults $optionName
switch $op {
- w {
- unset option_defaults($optionName)
- trace vdelete $optionName rwu default_check
- return
- }
- r {
- upvar $optionName option
- uplevel #0 set $optionName $option_defaults($optionName)
- return
- }
- u {
- unset option_defaults($optionName)
- trace vdelete $optionName rwu default_check
- return
- }
+ w {
+ unset option_defaults($optionName)
+ trace vdelete $optionName rwu default_check
+ return
+ }
+ r {
+ upvar $optionName option
+ uplevel #0 set $optionName $option_defaults($optionName)
+ return
+ }
+ u {
+ unset option_defaults($optionName)
+ trace vdelete $optionName rwu default_check
+ return
+ }
}
}
@@ -371,16 +371,16 @@
# most recently specified mode (left to right).
set mode "provides"
foreach arg $args {
- switch -exact $arg {
- description -
- provides -
- requires -
- conflicts { set mode $arg }
- default { ditem_append $ditem $mode $arg }
+ switch -exact $arg {
+ description -
+ provides -
+ requires -
+ conflicts { set mode $arg }
+ default { ditem_append $ditem $mode $arg }
}
}
ditem_key $ditem name "[join [ditem_key $ditem provides] -]"
-
+
# make a user procedure named variant-blah-blah
# we will call this procedure during variant-run
makeuserproc "variant-[ditem_key $ditem name]" \{$code\}
@@ -390,17 +390,17 @@
# with universal or group code).
set variant_provides [ditem_key $ditem provides]
if {[variant_exists $variant_provides]} {
- # This variant was already defined. Remove it from the dlist.
- variant_remove_ditem $variant_provides
- } else {
- lappend PortInfo(variants) $variant_provides
- set vdesc [join [ditem_key $ditem description]]
- if {$vdesc != ""} {
- lappend PortInfo(variant_desc) $variant_provides $vdesc
- }
- }
+ # This variant was already defined. Remove it from the dlist.
+ variant_remove_ditem $variant_provides
+ } else {
+ lappend PortInfo(variants) $variant_provides
+ set vdesc [join [ditem_key $ditem description]]
+ if {$vdesc != ""} {
+ lappend PortInfo(variant_desc) $variant_provides $vdesc
+ }
+ }
- # Finally append the ditem to the dlist.
+ # Finally append the ditem to the dlist.
lappend all_variants $ditem
}
@@ -410,7 +410,7 @@
global variations
if {[info exists variations($name)] && $variations($name) == "+"} {
- return 1
+ return 1
}
return 0
}
@@ -419,7 +419,6 @@
# Sets variant to run for current portfile
proc variant_set {name} {
global variations
-
set variations($name) +
}
@@ -439,49 +438,49 @@
# Remove it from the list of selected variations.
array unset variations $name
- # Remove the variant from the portinfo.
- if {[info exists PortInfo(variants)]} {
- set variant_index [lsearch -exact $PortInfo(variants) $name]
- if {$variant_index >= 0} {
- set new_list [lreplace $PortInfo(variants) $variant_index $variant_index]
- if {"$new_list" == {}} {
- unset PortInfo(variants)
- } else {
- set PortInfo(variants) $new_list
- }
- }
- }
-
- # And from the dlist.
- variant_remove_ditem $name
+ # Remove the variant from the portinfo.
+ if {[info exists PortInfo(variants)]} {
+ set variant_index [lsearch -exact $PortInfo(variants) $name]
+ if {$variant_index >= 0} {
+ set new_list [lreplace $PortInfo(variants) $variant_index $variant_index]
+ if {"$new_list" == {}} {
+ unset PortInfo(variants)
+ } else {
+ set PortInfo(variants) $new_list
+ }
+ }
+ }
+
+ # And from the dlist.
+ variant_remove_ditem $name
}
# variant_remove_ditem name
# Remove variant name's ditem from the all_variants dlist
proc variant_remove_ditem {name} {
- global all_variants
- set item_index 0
- foreach variant_item $all_variants {
- set item_provides [ditem_key $variant_item provides]
- if {$item_provides == $name} {
- set all_variants [lreplace $all_variants $item_index $item_index]
- break
- }
-
- incr item_index
- }
+ global all_variants
+ set item_index 0
+ foreach variant_item $all_variants {
+ set item_provides [ditem_key $variant_item provides]
+ if {$item_provides == $name} {
+ set all_variants [lreplace $all_variants $item_index $item_index]
+ break
+ }
+
+ incr item_index
+ }
}
# variant_exists name
# determine if a variant exists.
proc variant_exists {name} {
- global PortInfo
- if {[info exists PortInfo(variants)] &&
- [lsearch -exact $PortInfo(variants) $name] >= 0} {
- return 1
- }
-
- return 0
+ global PortInfo
+ if {[info exists PortInfo(variants)] &&
+ [lsearch -exact $PortInfo(variants) $name] >= 0} {
+ return 1
+ }
+
+ return 0
}
# platform <os> [<release>] [<arch>]
@@ -499,11 +498,11 @@
set ditem [variant_new "temp-variant"]
foreach arg $args {
- if {[regexp {(^[0-9]$)} $arg match result]} {
- set release $result
- } elseif {[regexp {([a-zA-Z0-9]*)} $arg match result]} {
- set arch $result
- }
+ if {[regexp {(^[0-9]$)} $arg match result]} {
+ set release $result
+ } elseif {[regexp {([a-zA-Z0-9]*)} $arg match result]} {
+ set arch $result
+ }
}
# Add the variant for this platform
@@ -513,37 +512,37 @@
# Pick up a unique name.
if {[variant_exists $platform]} {
- set suffix 1
- while {[variant_exists "$platform-$suffix"]} {
- incr suffix
- }
-
- set platform "$platform-$suffix"
+ set suffix 1
+ while {[variant_exists "$platform-$suffix"]} {
+ incr suffix
+ }
+
+ set platform "$platform-$suffix"
}
variant $platform $code
# Set the variant if this platform matches the platform we're on
set matches 1
if {[info exists os.platform] && ${os.platform} == $os} {
- set sel_platform $os
- if {[info exists os.major] && [info exists release]} {
- if {${os.major} == $release } {
- set sel_platform ${sel_platform}_${release}
- } else {
- set matches 0
- }
- }
- if {$matches == 1 && [info exists arch] && [info exists os.arch]} {
- if {${os.arch} == $arch} {
- set sel_platform ${sel_platform}_${arch}
- } else {
- set matches 0
- }
+ set sel_platform $os
+ if {[info exists os.major] && [info exists release]} {
+ if {${os.major} == $release } {
+ set sel_platform ${sel_platform}_${release}
+ } else {
+ set matches 0
+ }
+ }
+ if {$matches == 1 && [info exists arch] && [info exists os.arch]} {
+ if {${os.arch} == $arch} {
+ set sel_platform ${sel_platform}_${arch}
+ } else {
+ set matches 0
+ }
+ }
+ if {$matches == 1} {
+ variant_set $sel_platform
+ }
}
- if {$matches == 1} {
- variant_set $sel_platform
- }
- }
}
########### Environment utility functions ###########
@@ -551,66 +550,66 @@
# Parse the environment string of a command, storing the values into the
# associated environment array.
proc parse_environment {command} {
- global ${command}.env ${command}.env_array
+ global ${command}.env ${command}.env_array
- if {[info exists ${command}.env]} {
- # Flatten the environment string.
- set the_environment [join [set ${command}.env]]
-
- while {[regexp "^(?: *)(\[^= \]+)=(\"|'|)(\[^\"'\]*?)\\2(?: +|$)(.*)$" ${the_environment} matchVar key delimiter value remaining]} {
- set the_environment ${remaining}
- set ${command}.env_array(${key}) ${value}
- }
- } else {
- array set ${command}.env_array {}
- }
+ if {[info exists ${command}.env]} {
+ # Flatten the environment string.
+ set the_environment [join [set ${command}.env]]
+
+ while {[regexp "^(?: *)(\[^= \]+)=(\"|'|)(\[^\"'\]*?)\\2(?: +|$)(.*)$" ${the_environment} matchVar key delimiter value remaining]} {
+ set the_environment ${remaining}
+ set ${command}.env_array(${key}) ${value}
+ }
+ } else {
+ array set ${command}.env_array {}
+ }
}
# Append to the value in the parsed environment.
# Leave the environment untouched if the value is empty.
proc append_to_environment_value {command key value} {
- global ${command}.env_array
+ global ${command}.env_array
- if {[string length $value] == 0} {
- return
- }
+ if {[string length $value] == 0} {
+ return
+ }
- # Parse out any delimiter.
- set append_value $value
- if {[regexp {^("|')(.*)\1$} $append_value matchVar append_delim matchedValue]} {
- set append_value $matchedValue
- }
+ # Parse out any delimiter.
+ set append_value $value
+ if {[regexp {^("|')(.*)\1$} $append_value matchVar append_delim matchedValue]} {
+ set append_value $matchedValue
+ }
- if {[info exists ${command}.env_array($key)]} {
- set original_value [set ${command}.env_array($key)]
- set ${command}.env_array($key) "${original_value} ${append_value}"
- } else {
- set ${command}.env_array($key) $append_value
- }
+ if {[info exists ${command}.env_array($key)]} {
+ set original_value [set ${command}.env_array($key)]
+ set ${command}.env_array($key) "${original_value} ${append_value}"
+ } else {
+ set ${command}.env_array($key) $append_value
+ }
}
# Append several items to a value in the parsed environment.
proc append_list_to_environment_value {command key vallist} {
- foreach {value} $vallist {
- append_to_environment_value ${command} $key $value
- }
+ foreach {value} $vallist {
+ append_to_environment_value ${command} $key $value
+ }
}
# Build the environment as a string.
# Remark: this method is only used for debugging purposes.
proc environment_array_to_string {environment_array} {
- upvar 1 ${environment_array} env_array
-
- set theString ""
- foreach {key value} [array get env_array] {
- if {$theString == ""} {
- set theString "$key='$value'"
- } else {
- set theString "${theString} $key='$value'"
- }
- }
-
- return $theString
+ upvar 1 ${environment_array} env_array
+
+ set theString ""
+ foreach {key value} [array get env_array] {
+ if {$theString == ""} {
+ set theString "$key='$value'"
+ } else {
+ set theString "${theString} $key='$value'"
+ }
+ }
+
+ return $theString
}
########### Distname utility functions ###########
@@ -690,60 +689,60 @@
set files [lrange $args 1 end]
foreach file $files {
- if {[catch {set tmpfile [mkstemp "/tmp/[file tail $file].sed.XXXXXXXX"]} error]} {
- global errorInfo
- ui_debug "$errorInfo"
- ui_error "reinplace: $error"
- return -code error "reinplace failed"
- } else {
- # Extract the Tcl Channel number
- set tmpfd [lindex $tmpfile 0]
- # Set tmpfile to only the file name
- set tmpfile [lindex $tmpfile 1]
- }
-
- set cmdline $portutil::autoconf::sed_command
- if {$extended} {
- lappend cmdline $portutil::autoconf::sed_ext_flag
- }
- set cmdline [concat $cmdline [list $pattern < $file >@ $tmpfd]]
- if {[catch {eval exec $cmdline} error]} {
- global errorInfo
- ui_debug "$errorInfo"
- ui_error "reinplace: $error"
- file delete "$tmpfile"
- close $tmpfd
- return -code error "reinplace sed(1) failed"
- }
-
- close $tmpfd
-
- set attributes [file attributes $file]
- # We need to overwrite this file
- if {[catch {file attributes $file -permissions u+w} error]} {
- global errorInfo
- ui_debug "$errorInfo"
- ui_error "reinplace: $error"
- file delete "$tmpfile"
- return -code error "reinplace permissions failed"
- }
-
- if {[catch {exec cp $tmpfile $file} error]} {
- global errorInfo
- ui_debug "$errorInfo"
- ui_error "reinplace: $error"
- file delete "$tmpfile"
- return -code error "reinplace copy failed"
- }
-
- for {set i 0} {$i < [llength attributes]} {incr i} {
- set opt [lindex $attributes $i]
- incr i
- set arg [lindex $attributes $i]
- file attributes $file $opt $arg
- }
-
- file delete "$tmpfile"
+ if {[catch {set tmpfile [mkstemp "/tmp/[file tail $file].sed.XXXXXXXX"]} error]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ ui_error "reinplace: $error"
+ return -code error "reinplace failed"
+ } else {
+ # Extract the Tcl Channel number
+ set tmpfd [lindex $tmpfile 0]
+ # Set tmpfile to only the file name
+ set tmpfile [lindex $tmpfile 1]
+ }
+
+ set cmdline $portutil::autoconf::sed_command
+ if {$extended} {
+ lappend cmdline $portutil::autoconf::sed_ext_flag
+ }
+ set cmdline [concat $cmdline [list $pattern < $file >@ $tmpfd]]
+ if {[catch {eval exec $cmdline} error]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ ui_error "reinplace: $error"
+ file delete "$tmpfile"
+ close $tmpfd
+ return -code error "reinplace sed(1) failed"
+ }
+
+ close $tmpfd
+
+ set attributes [file attributes $file]
+ # We need to overwrite this file
+ if {[catch {file attributes $file -permissions u+w} error]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ ui_error "reinplace: $error"
+ file delete "$tmpfile"
+ return -code error "reinplace permissions failed"
+ }
+
+ if {[catch {exec cp $tmpfile $file} error]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ ui_error "reinplace: $error"
+ file delete "$tmpfile"
+ return -code error "reinplace copy failed"
+ }
+
+ for {set i 0} {$i < [llength attributes]} {incr i} {
+ set opt [lindex $attributes $i]
+ incr i
+ set arg [lindex $attributes $i]
+ file attributes $file $opt $arg
+ }
+
+ file delete "$tmpfile"
}
return
}
@@ -945,11 +944,11 @@
global distpath filesdir worksrcdir portpath
if {[file readable $portpath/$fname]} {
- return $portpath/$fname
+ return $portpath/$fname
} elseif {[file readable $portpath/$filesdir/$fname]} {
- return $portpath/$filesdir/$fname
+ return $portpath/$filesdir/$fname
} elseif {[file readable $distpath/$fname]} {
- return $distpath/$fname
+ return $distpath/$fname
}
return ""
}
@@ -959,9 +958,9 @@
proc include {fname} {
set tgt [filefindbypath $fname]
if {[string length $tgt]} {
- uplevel "source $tgt"
+ uplevel "source $tgt"
} else {
- return -code error "Unable to find include file $fname"
+ return -code error "Unable to find include file $fname"
}
}
@@ -1009,24 +1008,24 @@
# unobscure maintainer addresses as used in Portfiles
# We allow two obscured forms:
-# (1) User name only with no domain:
-# foo implies foo at macports.org
-# (2) Mangled name:
-# subdomain.tld:username implies username at subdomain.tld
+# (1) User name only with no domain:
+# foo implies foo at macports.org
+# (2) Mangled name:
+# subdomain.tld:username implies username at subdomain.tld
#
proc unobscure_maintainers { list } {
- set result {}
- foreach m $list {
- if {[string first "@" $m] < 0} {
- if {[string first ":" $m] >= 0} {
- set m [regsub -- "(.*):(.*)" $m "\\2@\\1"]
- } else {
- set m "$m at macports.org"
- }
- }
- lappend result $m
- }
- return $result
+ set result {}
+ foreach m $list {
+ if {[string first "@" $m] < 0} {
+ if {[string first ":" $m] >= 0} {
+ set m [regsub -- "(.*):(.*)" $m "\\2@\\1"]
+ } else {
+ set m "$m at macports.org"
+ }
+ }
+ lappend result $m
+ }
+ return $result
}
@@ -1040,198 +1039,198 @@
set skipped 0
set procedure [ditem_key $ditem procedure]
if {$procedure != ""} {
- set name [ditem_key $ditem name]
-
- if {[ditem_contains $ditem init]} {
- set result [catch {[ditem_key $ditem init] $name} errstr]
- }
-
- if {$result == 0} {
- # Skip the step if required and explain why through ui_debug.
- # 1st case: the step was already done (as mentioned in the state file)
- if {[check_statefile target $name $target_state_fd]} {
- ui_debug "Skipping completed $name ($portname)"
- set skipped 1
- # 2nd case: the step is not to always be performed
- # and this exact port/version/revision/variants is already installed
- # and user didn't mention -f
- # and portfile didn't change since installation.
- } elseif {[ditem_key $ditem runtype] != "always"
- && [registry_exists $portname $portversion $portrevision $portvariants]
- && !([info exists ports_force] && $ports_force == "yes")} {
-
- # Did the Portfile change since installation?
- set regref [registry_open $portname $portversion $portrevision $portvariants]
-
- set installdate [registry_prop_retr $regref date]
- if { $installdate != 0
- && $installdate < [file mtime ${portpath}/Portfile]} {
- ui_debug "Portfile changed since installation"
- } else {
- # Say we're skipping.
- set skipped 1
-
- ui_debug "Skipping $name ($portname) since this port is already installed"
- }
-
- # Something to close the registry entry may be called here, if it existed.
- # 3rd case: the same port/version/revision/Variants is already active
- # and user didn't mention -f
- } elseif {$name == "org.macports.activate"
- && [registry_exists $portname $portversion $portrevision $portvariants]
- && !([info exists ports_force] && $ports_force == "yes")} {
-
- # Is port active?
- set regref [registry_open $portname $portversion $portrevision $portvariants]
-
- if { [registry_prop_retr $regref active] != 0 } {
- # Say we're skipping.
- set skipped 1
-
- ui_msg "Skipping $name ($portname $portvariants) since this port is already active"
- }
-
- }
-
- # otherwise execute the task.
- if {$skipped == 0} {
- set target [ditem_key $ditem provides]
-
- # Execute pre-run procedure
- if {[ditem_contains $ditem prerun]} {
- set result [catch {[ditem_key $ditem prerun] $name} errstr]
- }
-
- #start tracelib
- if {($result ==0
- && [info exists ports_trace]
- && $ports_trace == "yes"
- && $target != "clean")} {
- trace_start $workpath
+ set name [ditem_key $ditem name]
+
+ if {[ditem_contains $ditem init]} {
+ set result [catch {[ditem_key $ditem init] $name} errstr]
+ }
+
+ if {$result == 0} {
+ # Skip the step if required and explain why through ui_debug.
+ # 1st case: the step was already done (as mentioned in the state file)
+ if {[check_statefile target $name $target_state_fd]} {
+ ui_debug "Skipping completed $name ($portname)"
+ set skipped 1
+ # 2nd case: the step is not to always be performed
+ # and this exact port/version/revision/variants is already installed
+ # and user didn't mention -f
+ # and portfile didn't change since installation.
+ } elseif {[ditem_key $ditem runtype] != "always"
+ && [registry_exists $portname $portversion $portrevision $portvariants]
+ && !([info exists ports_force] && $ports_force == "yes")} {
+
+ # Did the Portfile change since installation?
+ set regref [registry_open $portname $portversion $portrevision $portvariants]
+
+ set installdate [registry_prop_retr $regref date]
+ if { $installdate != 0
+ && $installdate < [file mtime ${portpath}/Portfile]} {
+ ui_debug "Portfile changed since installation"
+ } else {
+ # Say we're skipping.
+ set skipped 1
+
+ ui_debug "Skipping $name ($portname) since this port is already installed"
+ }
+
+ # Something to close the registry entry may be called here, if it existed.
+ # 3rd case: the same port/version/revision/Variants is already active
+ # and user didn't mention -f
+ } elseif {$name == "org.macports.activate"
+ && [registry_exists $portname $portversion $portrevision $portvariants]
+ && !([info exists ports_force] && $ports_force == "yes")} {
+
+ # Is port active?
+ set regref [registry_open $portname $portversion $portrevision $portvariants]
+
+ if { [registry_prop_retr $regref active] != 0 } {
+ # Say we're skipping.
+ set skipped 1
+
+ ui_msg "Skipping $name ($portname $portvariants) since this port is already active"
+ }
+
+ }
+
+ # otherwise execute the task.
+ if {$skipped == 0} {
+ set target [ditem_key $ditem provides]
+
+ # Execute pre-run procedure
+ if {[ditem_contains $ditem prerun]} {
+ set result [catch {[ditem_key $ditem prerun] $name} errstr]
+ }
+
+ #start tracelib
+ if {($result ==0
+ && [info exists ports_trace]
+ && $ports_trace == "yes"
+ && $target != "clean")} {
+ trace_start $workpath
- # Enable the fence to prevent any creation/modification
- # outside the sandbox.
- if {$target != "activate"
- && $target != "archive"
- && $target != "fetch"
- && $target != "install"} {
- trace_enable_fence
- }
-
- # collect deps
-
- # Don't check dependencies for extract (they're not honored
- # anyway). This avoids warnings about bzip2.
- if {$target != "extract"} {
- set depends {}
- set deptypes {}
-
- # Determine deptypes to look for based on target
- switch $target {
- configure { set deptypes "depends_lib depends_build" }
-
- build { set deptypes "depends_lib depends_build" }
-
- test -
- destroot -
- install -
- archive -
- pkg -
- mpkg -
- rpm -
- srpm -
- dpkg -
- activate -
- "" { set deptypes "depends_lib depends_build depends_run" }
- }
-
- # Gather the dependencies for deptypes
- foreach deptype $deptypes {
- # Add to the list of dependencies if the option exists and isn't empty.
- if {[info exists PortInfo($deptype)] && $PortInfo($deptype) != ""} {
- set depends [concat $depends $PortInfo($deptype)]
- }
- }
-
- # Dependencies are in the form verb:[param:]port
- set depsPorts {}
- foreach depspec $depends {
- # grab the portname portion of the depspec
- set dep_portname [lindex [split $depspec :] end]
- lappend depsPorts $dep_portname
- }
-
- set portlist $depsPorts
- foreach depName $depsPorts {
- set portlist [concat $portlist [recursive_collect_deps $depName $deptypes]]
- }
- #uniquer from http://aspn.activestate.com/ASPN/Cookbook/Tcl/Recipe/147663
- array set a [split "[join $portlist {::}]:" {:}]
- set depsPorts [array names a]
-
- if {[llength $deptypes] > 0} {tracelib setdeps $depsPorts}
- }
- }
-
- if {$result == 0} {
- foreach pre [ditem_key $ditem pre] {
- ui_debug "Executing $pre"
- set result [catch {$pre $name} errstr]
- if {$result != 0} { break }
- }
- }
-
- if {$result == 0} {
- ui_debug "Executing $name ($portname)"
- set result [catch {$procedure $name} errstr]
- }
-
- if {$result == 0} {
- foreach post [ditem_key $ditem post] {
- ui_debug "Executing $post"
- set result [catch {$post $name} errstr]
- if {$result != 0} { break }
- }
- }
- # Execute post-run procedure
- if {[ditem_contains $ditem postrun] && $result == 0} {
- set postrun [ditem_key $ditem postrun]
- ui_debug "Executing $postrun"
- set result [catch {$postrun $name} errstr]
- }
+ # Enable the fence to prevent any creation/modification
+ # outside the sandbox.
+ if {$target != "activate"
+ && $target != "archive"
+ && $target != "fetch"
+ && $target != "install"} {
+ trace_enable_fence
+ }
+
+ # collect deps
+
+ # Don't check dependencies for extract (they're not honored
+ # anyway). This avoids warnings about bzip2.
+ if {$target != "extract"} {
+ set depends {}
+ set deptypes {}
+
+ # Determine deptypes to look for based on target
+ switch $target {
+ configure { set deptypes "depends_lib depends_build" }
+
+ build { set deptypes "depends_lib depends_build" }
+
+ test -
+ destroot -
+ install -
+ archive -
+ pkg -
+ mpkg -
+ rpm -
+ srpm -
+ dpkg -
+ activate -
+ "" { set deptypes "depends_lib depends_build depends_run" }
+ }
+
+ # Gather the dependencies for deptypes
+ foreach deptype $deptypes {
+ # Add to the list of dependencies if the option exists and isn't empty.
+ if {[info exists PortInfo($deptype)] && $PortInfo($deptype) != ""} {
+ set depends [concat $depends $PortInfo($deptype)]
+ }
+ }
+
+ # Dependencies are in the form verb:[param:]port
+ set depsPorts {}
+ foreach depspec $depends {
+ # grab the portname portion of the depspec
+ set dep_portname [lindex [split $depspec :] end]
+ lappend depsPorts $dep_portname
+ }
+
+ set portlist $depsPorts
+ foreach depName $depsPorts {
+ set portlist [concat $portlist [recursive_collect_deps $depName $deptypes]]
+ }
+ #uniquer from http://aspn.activestate.com/ASPN/Cookbook/Tcl/Recipe/147663
+ array set a [split "[join $portlist {::}]:" {:}]
+ set depsPorts [array names a]
+
+ if {[llength $deptypes] > 0} {tracelib setdeps $depsPorts}
+ }
+ }
+
+ if {$result == 0} {
+ foreach pre [ditem_key $ditem pre] {
+ ui_debug "Executing $pre"
+ set result [catch {$pre $name} errstr]
+ if {$result != 0} { break }
+ }
+ }
+
+ if {$result == 0} {
+ ui_debug "Executing $name ($portname)"
+ set result [catch {$procedure $name} errstr]
+ }
+
+ if {$result == 0} {
+ foreach post [ditem_key $ditem post] {
+ ui_debug "Executing $post"
+ set result [catch {$post $name} errstr]
+ if {$result != 0} { break }
+ }
+ }
+ # Execute post-run procedure
+ if {[ditem_contains $ditem postrun] && $result == 0} {
+ set postrun [ditem_key $ditem postrun]
+ ui_debug "Executing $postrun"
+ set result [catch {$postrun $name} errstr]
+ }
- # Check dependencies & file creations outside workpath.
- if {[info exists ports_trace]
- && $ports_trace == "yes"
- && $target!="clean"} {
-
- tracelib closesocket
-
- trace_check_violations
-
- # End of trace.
- trace_stop
- }
- }
- }
- if {$result == 0} {
- # Only write to state file if:
- # - we indeed performed this step.
- # - this step is not to always be performed
- # - this step must be written to file
- if {$skipped == 0
- && [ditem_key $ditem runtype] != "always"
- && [ditem_key $ditem state] != "no"} {
- write_statefile target $name $target_state_fd
- }
- } else {
- ui_error "Target $name returned: $errstr"
- set result 1
- }
-
+ # Check dependencies & file creations outside workpath.
+ if {[info exists ports_trace]
+ && $ports_trace == "yes"
+ && $target!="clean"} {
+
+ tracelib closesocket
+
+ trace_check_violations
+
+ # End of trace.
+ trace_stop
+ }
+ }
+ }
+ if {$result == 0} {
+ # Only write to state file if:
+ # - we indeed performed this step.
+ # - this step is not to always be performed
+ # - this step must be written to file
+ if {$skipped == 0
+ && [ditem_key $ditem runtype] != "always"
+ && [ditem_key $ditem state] != "no"} {
+ write_statefile target $name $target_state_fd
+ }
+ } else {
+ ui_error "Target $name returned: $errstr"
+ set result 1
+ }
+
} else {
- ui_info "Warning: $name does not have a registered procedure"
- set result 1
+ ui_info "Warning: $name does not have a registered procedure"
+ set result 1
}
return $result
@@ -1241,31 +1240,31 @@
# It isn't ideal, because it scan many ports multiple time
proc recursive_collect_deps {portname deptypes} \
{
- set res [mport_search ^$portname\$]
+ set res [mport_search ^$portname\$]
if {[llength $res] < 2} \
- {
+ {
return {}
}
- set depends {}
+ set depends {}
- array set portinfo [lindex $res 1]
- foreach deptype $deptypes \
- {
- if {[info exists portinfo($deptype)] && $portinfo($deptype) != ""} \
- {
- set depends [concat $depends $portinfo($deptype)]
- }
- }
-
- set portdeps {}
- foreach depspec $depends \
- {
- set portname [lindex [split $depspec :] end]
- lappend portdeps $portname
- set portdeps [concat $portdeps [recursive_collect_deps $portname $deptypes]]
- }
- return $portdeps
+ array set portinfo [lindex $res 1]
+ foreach deptype $deptypes \
+ {
+ if {[info exists portinfo($deptype)] && $portinfo($deptype) != ""} \
+ {
+ set depends [concat $depends $portinfo($deptype)]
+ }
+ }
+
+ set portdeps {}
+ foreach depspec $depends \
+ {
+ set portname [lindex [split $depspec :] end]
+ lappend portdeps $portname
+ set portdeps [concat $portdeps [recursive_collect_deps $portname $deptypes]]
+ }
+ return $portdeps
}
@@ -1276,12 +1275,12 @@
# Select the subset of targets under $target
if {$target != ""} {
set matches [dlist_search $dlist provides $target]
-
+
if {[llength $matches] > 0} {
- set dlist [dlist_append_dependents $dlist [lindex $matches 0] [list]]
- # Special-case 'all'
- } elseif {$target != "all"} {
- ui_error "unknown target: $target"
+ set dlist [dlist_append_dependents $dlist [lindex $matches 0] [list]]
+ # Special-case 'all'
+ } elseif {$target != "all"} {
+ ui_error "unknown target: $target"
return 1
}
}
@@ -1292,15 +1291,15 @@
set dlist [dlist_eval $dlist "" target_run]
if {[llength $dlist] > 0} {
- # somebody broke!
- set errstring "Warning: the following items did not execute (for $portname):"
- foreach ditem $dlist {
- append errstring " [ditem_key $ditem name]"
- }
- ui_info $errstring
- set result 1
+ # somebody broke!
+ set errstring "Warning: the following items did not execute (for $portname):"
+ foreach ditem $dlist {
+ append errstring " [ditem_key $ditem name]"
+ }
+ ui_info $errstring
+ set result 1
} else {
- set result 0
+ set result 0
}
close $target_state_fd
@@ -1313,34 +1312,34 @@
global workpath worksymlink place_worksymlink portname portpath ports_ignore_older
if {![file isdirectory $workpath]} {
- file mkdir $workpath
+ file mkdir $workpath
}
# flock Portfile
set statefile [file join $workpath .macports.${portname}.state]
if {[file exists $statefile]} {
- if {![file writable $statefile]} {
- return -code error "$statefile is not writable - check permission on port directory"
- }
- if {!([info exists ports_ignore_older] && $ports_ignore_older == "yes") && [file mtime $statefile] < [file mtime ${portpath}/Portfile]} {
- ui_msg "Portfile changed since last build; discarding previous state."
- #file delete $statefile
- exec rm -rf [file join $workpath]
- exec mkdir [file join $workpath]
- }
+ if {![file writable $statefile]} {
+ return -code error "$statefile is not writable - check permission on port directory"
+ }
+ if {!([info exists ports_ignore_older] && $ports_ignore_older == "yes") && [file mtime $statefile] < [file mtime ${portpath}/Portfile]} {
+ ui_msg "Portfile changed since last build; discarding previous state."
+ #file delete $statefile
+ exec rm -rf [file join $workpath]
+ exec mkdir [file join $workpath]
+ }
}
# Create a symlink to the workpath for port authors
if {[tbool place_worksymlink] && ![file isdirectory $worksymlink]} {
- exec ln -sf $workpath $worksymlink
+ exec ln -sf $workpath $worksymlink
}
set fd [open $statefile a+]
if {[catch {flock $fd -exclusive -noblock} result]} {
if {"$result" == "EAGAIN"} {
ui_msg "Waiting for lock on $statefile"
- } elseif {"$result" == "EOPNOTSUPP"} {
- # Locking not supported, just return
- return $fd
+ } elseif {"$result" == "EOPNOTSUPP"} {
+ # Locking not supported, just return
+ return $fd
} else {
return -code error "$result obtaining lock on $statefile"
}
@@ -1354,9 +1353,9 @@
proc check_statefile {class name fd} {
seek $fd 0
while {[gets $fd line] >= 0} {
- if {$line == "$class: $name"} {
- return 1
- }
+ if {$line == "$class: $name"} {
+ return 1
+ }
}
return 0
}
@@ -1365,7 +1364,7 @@
# Set target $name completed in the state file
proc write_statefile {class name fd} {
if {[check_statefile $class $name $fd]} {
- return 0
+ return 0
}
seek $fd 0 end
puts $fd "$class: $name"
@@ -1379,23 +1378,23 @@
seek $fd 0
while {[gets $fd line] >= 0} {
- if {[regexp "variant: (.*)" $line match name]} {
- set oldvariations([string range $name 1 end]) [string range $name 0 0]
- }
+ if {[regexp "variant: (.*)" $line match name]} {
+ set oldvariations([string range $name 1 end]) [string range $name 0 0]
+ }
}
set mismatch 0
if {[array size oldvariations] > 0} {
- if {[array size oldvariations] != [array size upvariations]} {
- set mismatch 1
- } else {
- foreach key [array names upvariations *] {
- if {![info exists oldvariations($key)] || $upvariations($key) != $oldvariations($key)} {
- set mismatch 1
- break
- }
- }
- }
+ if {[array size oldvariations] != [array size upvariations]} {
+ set mismatch 1
+ } else {
+ foreach key [array names upvariations *] {
+ if {![info exists oldvariations($key)] || $upvariations($key) != $oldvariations($key)} {
+ set mismatch 1
+ break
+ }
+ }
+ }
}
return $mismatch
@@ -1411,27 +1410,27 @@
set selected [list]
foreach ditem $dlist {
- # Enumerate through the provides, tallying the pros and cons.
- set pros 0
- set cons 0
- set ignored 0
- foreach flavor [ditem_key $ditem provides] {
- if {[info exists upvariations($flavor)]} {
- if {$upvariations($flavor) == "+"} {
- incr pros
- } elseif {$upvariations($flavor) == "-"} {
- incr cons
- }
- } else {
- incr ignored
- }
- }
-
- if {$cons > 0} { continue }
-
- if {$pros > 0 && $ignored == 0} {
- lappend selected $ditem
- }
+ # Enumerate through the provides, tallying the pros and cons.
+ set pros 0
+ set cons 0
+ set ignored 0
+ foreach flavor [ditem_key $ditem provides] {
+ if {[info exists upvariations($flavor)]} {
+ if {$upvariations($flavor) == "+"} {
+ incr pros
+ } elseif {$upvariations($flavor) == "-"} {
+ incr cons
+ }
+ } else {
+ incr ignored
+ }
+ }
+
+ if {$cons > 0} { continue }
+
+ if {$pros > 0 && $ignored == 0} {
+ lappend selected $ditem
+ }
}
return $selected
}
@@ -1442,18 +1441,18 @@
# test for conflicting variants
foreach v [ditem_key $ditem conflicts] {
- if {[variant_isset $v]} {
- ui_error "Variant $name conflicts with $v"
- return 1
- }
+ if {[variant_isset $v]} {
+ ui_error "Variant $name conflicts with $v"
+ return 1
+ }
}
# execute proc with same name as variant.
if {[catch "variant-${name}" result]} {
- global errorInfo
- ui_debug "$errorInfo"
- ui_error "Error executing $name: $result"
- return 1
+ global errorInfo
+ ui_debug "$errorInfo"
+ ui_error "Error executing $name: $result"
+ return 1
}
return 0
}
@@ -1487,18 +1486,18 @@
set dlist $all_variants
upvar $variations upvariations
set chosen [choose_variants $dlist upvariations]
- set portname $PortInfo(name)
+ set portname $PortInfo(name)
- # Check to make sure the requested variations are available with this
- # port, if one is not, warn the user and remove the variant from the
- # array.
- foreach key [array names upvariations *] {
- if {![info exists PortInfo(variants)] ||
- [lsearch $PortInfo(variants) $key] == -1} {
- ui_debug "Requested variant $key is not provided by port $portname."
- array unset upvariations $key
- }
- }
+ # Check to make sure the requested variations are available with this
+ # port, if one is not, warn the user and remove the variant from the
+ # array.
+ foreach key [array names upvariations *] {
+ if {![info exists PortInfo(variants)] ||
+ [lsearch $PortInfo(variants) $key] == -1} {
+ ui_debug "Requested variant $key is not provided by port $portname."
+ array unset upvariations $key
+ }
+ }
# now that we've selected variants, change all provides [a b c] to [a-b-c]
# this will eliminate ambiguity between item a, b, and a-b while fulfilling requirments.
@@ -1508,12 +1507,12 @@
set newlist [list]
foreach variant $chosen {
- set newlist [dlist_append_dependents $dlist $variant $newlist]
+ set newlist [dlist_append_dependents $dlist $variant $newlist]
}
set dlist [dlist_eval $newlist "" variant_run]
if {[llength $dlist] > 0} {
- return 1
+ return 1
}
# Now compute the true active array of variants. Note we do not
@@ -1567,21 +1566,21 @@
# - Skip this test if ports_force was specified.
if { [lsearch "clean submit" $target] < 0 &&
- !([info exists ports_force] && $ports_force == "yes")} {
-
- set state_fd [open_statefile]
-
- if {[check_statefile_variants upvariations $state_fd]} {
- ui_error "Requested variants do not match original selection.\nPlease perform 'port clean $portname' or specify the force option."
- set result 1
- } else {
- # Write variations out to the statefile
- foreach key [array names upvariations *] {
- write_statefile variant $upvariations($key)$key $state_fd
- }
- }
-
- close $state_fd
+ !([info exists ports_force] && $ports_force == "yes")} {
+
+ set state_fd [open_statefile]
+
+ if {[check_statefile_variants upvariations $state_fd]} {
+ ui_error "Requested variants do not match original selection.\nPlease perform 'port clean $portname' or specify the force option."
+ set result 1
+ } else {
+ # Write variations out to the statefile
+ foreach key [array names upvariations *] {
+ write_statefile variant $upvariations($key)$key $state_fd
+ }
+ }
+
+ close $state_fd
}
return $result
@@ -1703,18 +1702,18 @@
proc handle_default_variants {option action {value ""}} {
global variations
switch -regex $action {
- set|append {
- foreach v $value {
- if {[regexp {([-+])([-A-Za-z0-9_]+)} $v whole val variant]} {
- if {![info exists variations($variant)]} {
- set variations($variant) $val
- }
- }
- }
- }
- delete {
- # xxx
- }
+ set|append {
+ foreach v $value {
+ if {[regexp {([-+])([-A-Za-z0-9_]+)} $v whole val variant]} {
+ if {![info exists variations($variant)]} {
+ set variations($variant) $val
+ }
+ }
+ }
+ }
+ delete {
+ # xxx
+ }
}
}
@@ -1743,14 +1742,14 @@
array set portinfo [lindex $res 1]
set porturl $portinfo(porturl)
if {[catch {set worker [mport_open $porturl [array get options] $variations]} result]} {
- global errorInfo
- ui_debug "$errorInfo"
+ global errorInfo
+ ui_debug "$errorInfo"
ui_error "Opening $portname $target failed: $result"
return -1
}
if {[catch {mport_exec $worker $target} result] || $result != 0} {
- global errorInfo
- ui_debug "$errorInfo"
+ global errorInfo
+ ui_debug "$errorInfo"
ui_error "Execution $portname $target failed: $result"
mport_close $worker
return -1
@@ -1837,14 +1836,14 @@
proc dirSize {dir} {
set size 0;
foreach file [readdir $dir] {
- if {[file type [file join $dir $file]] == "link" } {
- continue
- }
- if {[file isdirectory [file join $dir $file]]} {
- incr size [dirSize [file join $dir $file]]
- } else {
- incr size [file size [file join $dir $file]];
- }
+ if {[file type [file join $dir $file]] == "link" } {
+ continue
+ }
+ if {[file isdirectory [file join $dir $file]]} {
+ incr size [dirSize [file join $dir $file]]
+ } else {
+ incr size [file size [file join $dir $file]];
+ }
}
return $size;
}
@@ -1854,9 +1853,9 @@
proc binaryInPath {binary} {
global env
foreach dir [split $env(PATH) :] {
- if {[file executable [file join $dir $binary]]} {
- return [file join $dir $binary]
- }
+ if {[file executable [file join $dir $binary]]} {
+ return [file join $dir $binary]
+ }
}
return -code error [format [msgcat::mc "Failed to locate '%s' in path: '%s'"] $binary $env(PATH)];
@@ -1864,85 +1863,85 @@
# Set the UI prefix to something standard (so it can be grepped for in output)
proc set_ui_prefix {} {
- global UI_PREFIX env
- if {[info exists env(UI_PREFIX)]} {
- set UI_PREFIX $env(UI_PREFIX)
- } else {
- set UI_PREFIX "---> "
- }
+ global UI_PREFIX env
+ if {[info exists env(UI_PREFIX)]} {
+ set UI_PREFIX $env(UI_PREFIX)
+ } else {
+ set UI_PREFIX "---> "
+ }
}
# Use a specified group/version.
proc PortGroup {group version} {
- global portresourcepath
+ global portresourcepath
- set groupFile ${portresourcepath}/group/${group}-${version}.tcl
+ set groupFile ${portresourcepath}/group/${group}-${version}.tcl
- if {[file exists $groupFile]} {
- uplevel "source $groupFile"
- } else {
- ui_warn "Group file could not be located."
- }
+ if {[file exists $groupFile]} {
+ uplevel "source $groupFile"
+ } else {
+ ui_warn "Group file could not be located."
+ }
}
# check if archive type is supported by current system
# returns an error code if it is not
proc archiveTypeIsSupported {type} {
global os.platform os.version
- set errmsg ""
- switch -regex $type {
- cp(io|gz) {
- set pax "pax"
- if {[catch {set pax [binaryInPath $pax]} errmsg] == 0} {
- if {[regexp {z$} $type]} {
- set gzip "gzip"
- if {[catch {set gzip [binaryInPath $gzip]} errmsg] == 0} {
- return 0
- }
- } else {
- return 0
- }
- }
- }
- t(ar|bz|lz|gz) {
- set tar "tar"
- if {[catch {set tar [binaryInPath $tar]} errmsg] == 0} {
- if {[regexp {z2?$} $type]} {
- if {[regexp {bz2?$} $type]} {
- set gzip "bzip2"
- } elseif {[regexp {lz$} $type]} {
- set gzip "lzma"
- } else {
- set gzip "gzip"
- }
- if {[catch {set gzip [binaryInPath $gzip]} errmsg] == 0} {
- return 0
- }
- } else {
- return 0
- }
- }
- }
- xar {
- set xar "xar"
- if {[catch {set xar [binaryInPath $xar]} errmsg] == 0} {
- return 0
- }
- }
- zip {
- set zip "zip"
- if {[catch {set zip [binaryInPath $zip]} errmsg] == 0} {
- set unzip "unzip"
- if {[catch {set unzip [binaryInPath $unzip]} errmsg] == 0} {
- return 0
- }
- }
- }
- default {
- return -code error [format [msgcat::mc "Invalid port archive type '%s' specified!"] $type]
- }
- }
- return -code error [format [msgcat::mc "Unsupported port archive type '%s': %s"] $type $errmsg]
+ set errmsg ""
+ switch -regex $type {
+ cp(io|gz) {
+ set pax "pax"
+ if {[catch {set pax [binaryInPath $pax]} errmsg] == 0} {
+ if {[regexp {z$} $type]} {
+ set gzip "gzip"
+ if {[catch {set gzip [binaryInPath $gzip]} errmsg] == 0} {
+ return 0
+ }
+ } else {
+ return 0
+ }
+ }
+ }
+ t(ar|bz|lz|gz) {
+ set tar "tar"
+ if {[catch {set tar [binaryInPath $tar]} errmsg] == 0} {
+ if {[regexp {z2?$} $type]} {
+ if {[regexp {bz2?$} $type]} {
+ set gzip "bzip2"
+ } elseif {[regexp {lz$} $type]} {
+ set gzip "lzma"
+ } else {
+ set gzip "gzip"
+ }
+ if {[catch {set gzip [binaryInPath $gzip]} errmsg] == 0} {
+ return 0
+ }
+ } else {
+ return 0
+ }
+ }
+ }
+ xar {
+ set xar "xar"
+ if {[catch {set xar [binaryInPath $xar]} errmsg] == 0} {
+ return 0
+ }
+ }
+ zip {
+ set zip "zip"
+ if {[catch {set zip [binaryInPath $zip]} errmsg] == 0} {
+ set unzip "unzip"
+ if {[catch {set unzip [binaryInPath $unzip]} errmsg] == 0} {
+ return 0
+ }
+ }
+ }
+ default {
+ return -code error [format [msgcat::mc "Invalid port archive type '%s' specified!"] $type]
+ }
+ }
+ return -code error [format [msgcat::mc "Unsupported port archive type '%s': %s"] $type $errmsg]
}
@@ -1950,32 +1949,32 @@
# this is intended to be called during destroot, e.g. 'merge i386 ppc'
# this will merge the directories $destroot/i386 & $destroot/ppc into $destroot
proc merge args {
- global workpath prefix destroot
- set all_args "-i ${destroot} -o ${destroot} -v debug"
- set architectures ""
+ global workpath prefix destroot
+ set all_args "-i ${destroot} -o ${destroot} -v debug"
+ set architectures ""
- # check existance of given architectures in $destroot
- foreach arg $args {
- if [file exists ${destroot}/${arg}] {
- ui_debug "found architecture '${arg}'"
- set architectures "${architectures} $arg"
- } else {
- ui_error "could not find directory for architecture '${arg}'"
- }
- }
- set all_args "${all_args} ${architectures}"
+ # check existance of given architectures in $destroot
+ foreach arg $args {
+ if [file exists ${destroot}/${arg}] {
+ ui_debug "found architecture '${arg}'"
+ set architectures "${architectures} $arg"
+ } else {
+ ui_error "could not find directory for architecture '${arg}'"
+ }
+ }
+ set all_args "${all_args} ${architectures}"
- # call merge.rb
- ui_debug "executing merge.rb with '${all_args}'"
- set fullcmdstring "${prefix}/bin/merge.rb $all_args"
- set code [catch {system $fullcmdstring} result]
- ui_debug "merge returned: '${result}'"
+ # call merge.rb
+ ui_debug "executing merge.rb with '${all_args}'"
+ set fullcmdstring "${prefix}/bin/merge.rb $all_args"
+ set code [catch {system $fullcmdstring} result]
+ ui_debug "merge returned: '${result}'"
- foreach arg ${architectures} {
- ui_debug "removing arch directory \"$arg\""
- file delete -force ${destroot}/${arg}
- }
+ foreach arg ${architectures} {
+ ui_debug "removing arch directory \"$arg\""
+ file delete -force ${destroot}/${arg}
+ }
- return -code $code $result
+ return -code $code $result
}
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://lists.macosforge.org/pipermail/macports-changes/attachments/20071207/8b0cf2f5/attachment-0001.html
More information about the macports-changes
mailing list