Ignore:
Timestamp:
Dec 8, 2007, 4:25:07 AM (11 years ago)
Author:
jmpp@…
Message:

Massive whitespace cleanups to the portutil.tcl file, add modeline.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/base/src/port1.0/portutil.tcl

    r31353 r31805  
    1 # et:ts=4
     1# -*- 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
    22# portutil.tcl
    33# $Id$
     
    5555# This is an accessor for Portfile options.  Targets may use
    5656# this in the same style as the standard Tcl "set" procedure.
    57 #       name  - the name of the option to read or write
    58 #       value - an optional value to assign to the option
     57#   name  - the name of the option to read or write
     58#   value - an optional value to assign to the option
    5959
    6060proc option {name args} {
     
    6464    global $name
    6565    if {[llength $args] > 0} {
    66         ui_debug "setting option $name to $args"
    67         set $name [lindex $args 0]
     66        ui_debug "setting option $name to $args"
     67        set $name [lindex $args 0]
    6868    }
    6969    return [set $name]
     
    7373# This is an accessor for Portfile options.  Targets may use
    7474# this procedure to test for the existence of a Portfile option.
    75 #       name - the name of the option to test for existence
     75#   name - the name of the option to test for existence
    7676
    7777proc exists {name} {
     
    209209proc commands {args} {
    210210    foreach option $args {
    211         options use_${option} ${option}.dir ${option}.pre_args ${option}.args ${option}.post_args ${option}.env ${option}.type ${option}.cmd
     211        options use_${option} ${option}.dir ${option}.pre_args ${option}.args ${option}.post_args ${option}.env ${option}.type ${option}.cmd
    212212    }
    213213}
     
    219219   
    220220    if {[info exists ${command}.dir]} {
    221         append cmdstring "cd \"[set ${command}.dir]\" &&"
     221        append cmdstring "cd \"[set ${command}.dir]\" &&"
    222222    }
    223223   
    224224    if {[info exists ${command}.cmd]} {
    225         foreach string [set ${command}.cmd] {
    226             append cmdstring " $string"
    227         }
     225        foreach string [set ${command}.cmd] {
     226            append cmdstring " $string"
     227        }
    228228    } else {
    229         append cmdstring " ${command}"
     229        append cmdstring " ${command}"
    230230    }
    231231
    232232    foreach var "${command}.pre_args ${command}.args ${command}.post_args" {
    233         if {[info exists $var]} {
    234             foreach string [set ${var}] {
    235                 append cmdstring " ${string}"
    236             }
    237         }
     233        if {[info exists $var]} {
     234            foreach string [set ${var}] {
     235                append cmdstring " ${string}"
     236            }
     237        }
    238238    }
    239239
     
    244244# Given a command name, execute it with the options.
    245245# command_exec command [-notty] [command_prefix [command_suffix]]
    246 # command                       name of the command
    247 # command_prefix        additional command prefix (typically pipe command)
    248 # command_suffix        additional command suffix (typically redirection)
     246# command           name of the command
     247# command_prefix    additional command prefix (typically pipe command)
     248# command_suffix    additional command suffix (typically redirection)
    249249proc command_exec {command args} {
    250         global ${command}.env ${command}.env_array env
    251         set notty 0
    252         set command_prefix ""
    253         set command_suffix ""
    254 
    255         if {[llength $args] > 0} {
    256                 if {[lindex $args 0] == "-notty"} {
    257                         set notty 1
    258                         set args [lrange $args 1 end]
    259                 }
    260 
    261                 if {[llength $args] > 0} {
    262                         set command_prefix [lindex $args 0]
    263                         if {[llength $args] > 1} {
    264                                 set command_suffix [lindex $args 1]
    265                         }
    266                 }
    267         }
    268        
    269         # Set the environment.
    270         # If the array doesn't exist, we create it with the value
    271         # coming from ${command}.env
    272         # Otherwise, it means the caller actually played with the environment
    273         # array already (e.g. configure flags).
    274         if {![array exists ${command}.env_array]} {
    275                 parse_environment ${command}
    276         }
    277         if {[option macosx_deployment_target] ne ""} {
    278         append_list_to_environment_value ${command} "MACOSX_DEPLOYMENT_TARGET" [option macosx_deployment_target]
    279         }
    280        
    281         # Debug that.
     250    global ${command}.env ${command}.env_array env
     251    set notty 0
     252    set command_prefix ""
     253    set command_suffix ""
     254
     255    if {[llength $args] > 0} {
     256        if {[lindex $args 0] == "-notty"} {
     257            set notty 1
     258            set args [lrange $args 1 end]
     259        }
     260
     261        if {[llength $args] > 0} {
     262            set command_prefix [lindex $args 0]
     263            if {[llength $args] > 1} {
     264                set command_suffix [lindex $args 1]
     265            }
     266        }
     267    }
     268   
     269    # Set the environment.
     270    # If the array doesn't exist, we create it with the value
     271    # coming from ${command}.env
     272    # Otherwise, it means the caller actually played with the environment
     273    # array already (e.g. configure flags).
     274    if {![array exists ${command}.env_array]} {
     275        parse_environment ${command}
     276    }
     277    if {[option macosx_deployment_target] ne ""} {
     278        append_list_to_environment_value ${command} "MACOSX_DEPLOYMENT_TARGET" [option macosx_deployment_target]
     279    }
     280   
     281    # Debug that.
    282282    ui_debug "Environment: [environment_array_to_string ${command}.env_array]"
    283283
    284         # Get the command string.
    285         set cmdstring [command_string ${command}]
    286        
    287         # Call this command.
    288         # TODO: move that to the system native call?
    289         # Save the environment.
    290         array set saved_env [array get env]
    291         # Set the overriden variables from the portfile.
    292         array set env [array get ${command}.env_array]
    293         # Call the command.
    294         set fullcmdstring "$command_prefix $cmdstring $command_suffix"
    295         if {$notty} {
    296                 set code [catch {system -notty $fullcmdstring} result]
    297         } else {
    298                 set code [catch {system $fullcmdstring} result]
    299         }
    300         # Unset the command array until next time.
    301         array unset ${command}.env_array
    302        
    303         # Restore the environment.
    304         array unset env *
    305         array set env [array get saved_env]
    306 
    307         # Return as if system had been called directly.
    308         return -code $code $result
     284    # Get the command string.
     285    set cmdstring [command_string ${command}]
     286   
     287    # Call this command.
     288    # TODO: move that to the system native call?
     289    # Save the environment.
     290    array set saved_env [array get env]
     291    # Set the overriden variables from the portfile.
     292    array set env [array get ${command}.env_array]
     293    # Call the command.
     294    set fullcmdstring "$command_prefix $cmdstring $command_suffix"
     295    if {$notty} {
     296        set code [catch {system -notty $fullcmdstring} result]
     297    } else {
     298        set code [catch {system $fullcmdstring} result]
     299    }
     300    # Unset the command array until next time.
     301    array unset ${command}.env_array
     302   
     303    # Restore the environment.
     304    array unset env *
     305    array set env [array get saved_env]
     306
     307    # Return as if system had been called directly.
     308    return -code $code $result
    309309}
    310310
     
    316316    global $option option_defaults
    317317    if {[info exists option_defaults($option)]} {
    318         ui_debug "Re-registering default for $option"
    319         # remove the old trace
    320         trace vdelete $option rwu default_check
     318        ui_debug "Re-registering default for $option"
     319        # remove the old trace
     320        trace vdelete $option rwu default_check
    321321    } else {
    322         # If option is already set and we did not set it
    323         # do not reset the value
    324         if {[info exists $option]} {
    325             return
    326         }
     322        # If option is already set and we did not set it
     323        # do not reset the value
     324        if {[info exists $option]} {
     325            return
     326        }
    327327    }
    328328    set option_defaults($option) $val
     
    337337    global option_defaults $optionName
    338338    switch $op {
    339         w {
    340             unset option_defaults($optionName)
    341             trace vdelete $optionName rwu default_check
    342             return
    343         }
    344         r {
    345             upvar $optionName option
    346             uplevel #0 set $optionName $option_defaults($optionName)
    347             return
    348         }
    349         u {
    350             unset option_defaults($optionName)
    351             trace vdelete $optionName rwu default_check
    352             return
    353         }
     339        w {
     340            unset option_defaults($optionName)
     341            trace vdelete $optionName rwu default_check
     342            return
     343        }
     344        r {
     345            upvar $optionName option
     346            uplevel #0 set $optionName $option_defaults($optionName)
     347            return
     348        }
     349        u {
     350            unset option_defaults($optionName)
     351            trace vdelete $optionName rwu default_check
     352            return
     353        }
    354354    }
    355355}
     
    372372    set mode "provides"
    373373    foreach arg $args {
    374         switch -exact $arg {
    375             description -
    376             provides -
    377             requires -
    378             conflicts { set mode $arg }
    379             default { ditem_append $ditem $mode $arg }         
     374        switch -exact $arg {
     375            description -
     376            provides -
     377            requires -
     378            conflicts { set mode $arg }
     379            default { ditem_append $ditem $mode $arg }     
    380380        }
    381381    }
    382382    ditem_key $ditem name "[join [ditem_key $ditem provides] -]"
    383    
     383
    384384    # make a user procedure named variant-blah-blah
    385385    # we will call this procedure during variant-run
     
    391391    set variant_provides [ditem_key $ditem provides]
    392392    if {[variant_exists $variant_provides]} {
    393                 # This variant was already defined. Remove it from the dlist.
    394                 variant_remove_ditem $variant_provides
    395         } else {
    396             lappend PortInfo(variants) $variant_provides
    397             set vdesc [join [ditem_key $ditem description]]
    398             if {$vdesc != ""} {
    399                     lappend PortInfo(variant_desc) $variant_provides $vdesc
    400                 }
    401         }
    402 
    403         # Finally append the ditem to the dlist.
     393        # This variant was already defined. Remove it from the dlist.
     394        variant_remove_ditem $variant_provides
     395    } else {
     396        lappend PortInfo(variants) $variant_provides
     397        set vdesc [join [ditem_key $ditem description]]
     398        if {$vdesc != ""} {
     399            lappend PortInfo(variant_desc) $variant_provides $vdesc
     400        }
     401    }
     402
     403    # Finally append the ditem to the dlist.
    404404    lappend all_variants $ditem
    405405}
     
    411411   
    412412    if {[info exists variations($name)] && $variations($name) == "+"} {
    413         return 1
     413        return 1
    414414    }
    415415    return 0
     
    420420proc variant_set {name} {
    421421    global variations
    422    
    423422    set variations($name) +
    424423}
     
    440439    array unset variations $name
    441440
    442         # Remove the variant from the portinfo.
    443         if {[info exists PortInfo(variants)]} {
    444                 set variant_index [lsearch -exact $PortInfo(variants) $name]
    445                 if {$variant_index >= 0} {
    446                         set new_list [lreplace $PortInfo(variants) $variant_index $variant_index]
    447                         if {"$new_list" == {}} {
    448                                 unset PortInfo(variants)
    449                         } else {
    450                                 set PortInfo(variants) $new_list
    451                         }
    452                 }
    453         }
    454        
    455         # And from the dlist.
    456         variant_remove_ditem $name
     441    # Remove the variant from the portinfo.
     442    if {[info exists PortInfo(variants)]} {
     443        set variant_index [lsearch -exact $PortInfo(variants) $name]
     444        if {$variant_index >= 0} {
     445            set new_list [lreplace $PortInfo(variants) $variant_index $variant_index]
     446            if {"$new_list" == {}} {
     447                unset PortInfo(variants)
     448            } else {
     449                set PortInfo(variants) $new_list
     450            }
     451        }
     452    }
     453   
     454    # And from the dlist.
     455    variant_remove_ditem $name
    457456}
    458457
     
    460459# Remove variant name's ditem from the all_variants dlist
    461460proc variant_remove_ditem {name} {
    462         global all_variants
    463         set item_index 0
    464         foreach variant_item $all_variants {
    465                 set item_provides [ditem_key $variant_item provides]
    466                 if {$item_provides == $name} {
    467                         set all_variants [lreplace $all_variants $item_index $item_index]
    468                         break
    469                 }
    470                
    471                 incr item_index
    472         }
     461    global all_variants
     462    set item_index 0
     463    foreach variant_item $all_variants {
     464        set item_provides [ditem_key $variant_item provides]
     465        if {$item_provides == $name} {
     466            set all_variants [lreplace $all_variants $item_index $item_index]
     467            break
     468        }
     469       
     470        incr item_index
     471    }
    473472}
    474473
     
    476475# determine if a variant exists.
    477476proc variant_exists {name} {
    478         global PortInfo
    479         if {[info exists PortInfo(variants)] &&
    480                 [lsearch -exact $PortInfo(variants) $name] >= 0} {
    481                 return 1
    482         }
    483        
    484         return 0
     477    global PortInfo
     478    if {[info exists PortInfo(variants)] &&
     479      [lsearch -exact $PortInfo(variants) $name] >= 0} {
     480        return 1
     481    }
     482
     483    return 0
    485484}
    486485
     
    500499   
    501500    foreach arg $args {
    502         if {[regexp {(^[0-9]$)} $arg match result]} {
    503             set release $result
    504         } elseif {[regexp {([a-zA-Z0-9]*)} $arg match result]} {
    505             set arch $result
    506         }
     501        if {[regexp {(^[0-9]$)} $arg match result]} {
     502            set release $result
     503        } elseif {[regexp {([a-zA-Z0-9]*)} $arg match result]} {
     504            set arch $result
     505        }
    507506    }
    508507   
     
    514513    # Pick up a unique name.
    515514    if {[variant_exists $platform]} {
    516         set suffix 1
    517         while {[variant_exists "$platform-$suffix"]} {
    518                 incr suffix
    519         }
    520        
    521         set platform "$platform-$suffix"
     515        set suffix 1
     516        while {[variant_exists "$platform-$suffix"]} {
     517            incr suffix
     518        }
     519       
     520        set platform "$platform-$suffix"
    522521    }
    523522    variant $platform $code
     
    526525    set matches 1
    527526    if {[info exists os.platform] && ${os.platform} == $os} {
    528         set sel_platform $os
    529         if {[info exists os.major] && [info exists release]} {
    530             if {${os.major} == $release } {
    531                 set sel_platform ${sel_platform}_${release}
    532             } else {
    533                     set matches 0
    534             }
    535         }
    536         if {$matches == 1 && [info exists arch] && [info exists os.arch]} {
    537                 if {${os.arch} == $arch} {
    538                         set sel_platform ${sel_platform}_${arch}
    539                 } else {
    540                         set matches 0
    541                 }
    542     }
    543     if {$matches == 1} {
    544         variant_set $sel_platform
    545     }
     527    set sel_platform $os
     528        if {[info exists os.major] && [info exists release]} {
     529            if {${os.major} == $release } {
     530                set sel_platform ${sel_platform}_${release}
     531            } else {
     532                set matches 0
     533            }
     534        }
     535        if {$matches == 1 && [info exists arch] && [info exists os.arch]} {
     536            if {${os.arch} == $arch} {
     537                set sel_platform ${sel_platform}_${arch}
     538            } else {
     539                set matches 0
     540            }
     541        }
     542        if {$matches == 1} {
     543            variant_set $sel_platform
     544        }
    546545    }
    547546}
     
    552551# associated environment array.
    553552proc parse_environment {command} {
    554         global ${command}.env ${command}.env_array
    555 
    556         if {[info exists ${command}.env]} {
    557                 # Flatten the environment string.
    558                 set the_environment [join [set ${command}.env]]
    559        
    560                 while {[regexp "^(?: *)(\[^= \]+)=(\"|'|)(\[^\"'\]*?)\\2(?: +|$)(.*)$" ${the_environment} matchVar key delimiter value remaining]} {
    561                         set the_environment ${remaining}
    562                         set ${command}.env_array(${key}) ${value}
    563                 }
    564         } else {
    565                 array set ${command}.env_array {}
    566         }
     553    global ${command}.env ${command}.env_array
     554
     555    if {[info exists ${command}.env]} {
     556        # Flatten the environment string.
     557        set the_environment [join [set ${command}.env]]
     558   
     559        while {[regexp "^(?: *)(\[^= \]+)=(\"|'|)(\[^\"'\]*?)\\2(?: +|$)(.*)$" ${the_environment} matchVar key delimiter value remaining]} {
     560            set the_environment ${remaining}
     561            set ${command}.env_array(${key}) ${value}
     562        }
     563    } else {
     564        array set ${command}.env_array {}
     565    }
    567566}
    568567
     
    570569# Leave the environment untouched if the value is empty.
    571570proc append_to_environment_value {command key value} {
    572         global ${command}.env_array
    573 
    574         if {[string length $value] == 0} {
    575                 return
    576         }
    577 
    578         # Parse out any delimiter.
    579         set append_value $value
    580         if {[regexp {^("|')(.*)\1$} $append_value matchVar append_delim matchedValue]} {
    581                 set append_value $matchedValue
    582         }
    583 
    584         if {[info exists ${command}.env_array($key)]} {
    585                 set original_value [set ${command}.env_array($key)]
    586                 set ${command}.env_array($key) "${original_value} ${append_value}"
    587         } else {
    588                 set ${command}.env_array($key) $append_value
    589         }
     571    global ${command}.env_array
     572
     573    if {[string length $value] == 0} {
     574        return
     575    }
     576
     577    # Parse out any delimiter.
     578    set append_value $value
     579    if {[regexp {^("|')(.*)\1$} $append_value matchVar append_delim matchedValue]} {
     580        set append_value $matchedValue
     581    }
     582
     583    if {[info exists ${command}.env_array($key)]} {
     584        set original_value [set ${command}.env_array($key)]
     585        set ${command}.env_array($key) "${original_value} ${append_value}"
     586    } else {
     587        set ${command}.env_array($key) $append_value
     588    }
    590589}
    591590
    592591# Append several items to a value in the parsed environment.
    593592proc append_list_to_environment_value {command key vallist} {
    594         foreach {value} $vallist {
    595                 append_to_environment_value ${command} $key $value
    596         }
     593    foreach {value} $vallist {
     594        append_to_environment_value ${command} $key $value
     595    }
    597596}
    598597
     
    600599# Remark: this method is only used for debugging purposes.
    601600proc environment_array_to_string {environment_array} {
    602         upvar 1 ${environment_array} env_array
    603        
    604         set theString ""
    605         foreach {key value} [array get env_array] {
    606                 if {$theString == ""} {
    607                         set theString "$key='$value'"
    608                 } else {
    609                         set theString "${theString} $key='$value'"
    610                 }
    611         }
    612        
    613         return $theString
     601    upvar 1 ${environment_array} env_array
     602   
     603    set theString ""
     604    foreach {key value} [array get env_array] {
     605        if {$theString == ""} {
     606            set theString "$key='$value'"
     607        } else {
     608            set theString "${theString} $key='$value'"
     609        }
     610    }
     611   
     612    return $theString
    614613}
    615614
     
    691690   
    692691    foreach file $files {
    693         if {[catch {set tmpfile [mkstemp "/tmp/[file tail $file].sed.XXXXXXXX"]} error]} {
    694                 global errorInfo
    695                 ui_debug "$errorInfo"
    696             ui_error "reinplace: $error"
    697             return -code error "reinplace failed"
    698         } else {
    699             # Extract the Tcl Channel number
    700             set tmpfd [lindex $tmpfile 0]
    701             # Set tmpfile to only the file name
    702             set tmpfile [lindex $tmpfile 1]
    703         }
    704        
    705         set cmdline $portutil::autoconf::sed_command
    706         if {$extended} {
    707             lappend cmdline $portutil::autoconf::sed_ext_flag
    708         }
    709         set cmdline [concat $cmdline [list $pattern < $file >@ $tmpfd]]
    710         if {[catch {eval exec $cmdline} error]} {
    711                 global errorInfo
    712                 ui_debug "$errorInfo"
    713             ui_error "reinplace: $error"
    714             file delete "$tmpfile"
    715             close $tmpfd
    716             return -code error "reinplace sed(1) failed"
    717         }
    718        
    719         close $tmpfd
    720        
    721         set attributes [file attributes $file]
    722         # We need to overwrite this file
    723         if {[catch {file attributes $file -permissions u+w} error]} {
    724                 global errorInfo
    725                 ui_debug "$errorInfo"
    726             ui_error "reinplace: $error"
    727             file delete "$tmpfile"
    728             return -code error "reinplace permissions failed"
    729         }
    730        
    731         if {[catch {exec cp $tmpfile $file} error]} {
    732                 global errorInfo
    733                 ui_debug "$errorInfo"
    734             ui_error "reinplace: $error"
    735             file delete "$tmpfile"
    736             return -code error "reinplace copy failed"
    737         }
    738        
    739         for {set i 0} {$i < [llength attributes]} {incr i} {
    740             set opt [lindex $attributes $i]
    741             incr i
    742             set arg [lindex $attributes $i]
    743             file attributes $file $opt $arg
    744         }
    745        
    746         file delete "$tmpfile"
     692        if {[catch {set tmpfile [mkstemp "/tmp/[file tail $file].sed.XXXXXXXX"]} error]} {
     693            global errorInfo
     694            ui_debug "$errorInfo"
     695            ui_error "reinplace: $error"
     696            return -code error "reinplace failed"
     697        } else {
     698            # Extract the Tcl Channel number
     699            set tmpfd [lindex $tmpfile 0]
     700            # Set tmpfile to only the file name
     701            set tmpfile [lindex $tmpfile 1]
     702        }
     703   
     704        set cmdline $portutil::autoconf::sed_command
     705        if {$extended} {
     706            lappend cmdline $portutil::autoconf::sed_ext_flag
     707        }
     708        set cmdline [concat $cmdline [list $pattern < $file >@ $tmpfd]]
     709        if {[catch {eval exec $cmdline} error]} {
     710            global errorInfo
     711            ui_debug "$errorInfo"
     712            ui_error "reinplace: $error"
     713            file delete "$tmpfile"
     714            close $tmpfd
     715            return -code error "reinplace sed(1) failed"
     716        }
     717   
     718        close $tmpfd
     719   
     720        set attributes [file attributes $file]
     721        # We need to overwrite this file
     722        if {[catch {file attributes $file -permissions u+w} error]} {
     723            global errorInfo
     724            ui_debug "$errorInfo"
     725            ui_error "reinplace: $error"
     726            file delete "$tmpfile"
     727            return -code error "reinplace permissions failed"
     728        }
     729   
     730        if {[catch {exec cp $tmpfile $file} error]} {
     731            global errorInfo
     732            ui_debug "$errorInfo"
     733            ui_error "reinplace: $error"
     734            file delete "$tmpfile"
     735            return -code error "reinplace copy failed"
     736        }
     737   
     738        for {set i 0} {$i < [llength attributes]} {incr i} {
     739            set opt [lindex $attributes $i]
     740            incr i
     741            set arg [lindex $attributes $i]
     742            file attributes $file $opt $arg
     743        }
     744       
     745        file delete "$tmpfile"
    747746    }
    748747    return
     
    946945   
    947946    if {[file readable $portpath/$fname]} {
    948         return $portpath/$fname
     947        return $portpath/$fname
    949948    } elseif {[file readable $portpath/$filesdir/$fname]} {
    950         return $portpath/$filesdir/$fname
     949        return $portpath/$filesdir/$fname
    951950    } elseif {[file readable $distpath/$fname]} {
    952         return $distpath/$fname
     951        return $distpath/$fname
    953952    }
    954953    return ""
     
    960959    set tgt [filefindbypath $fname]
    961960    if {[string length $tgt]} {
    962         uplevel "source $tgt"
     961        uplevel "source $tgt"
    963962    } else {
    964         return -code error "Unable to find include file $fname"
     963        return -code error "Unable to find include file $fname"
    965964    }
    966965}
     
    10101009# unobscure maintainer addresses as used in Portfiles
    10111010# We allow two obscured forms:
    1012 #       (1) User name only with no domain:
    1013 #                       foo implies foo@macports.org
    1014 #       (2) Mangled name:
    1015 #                       subdomain.tld:username implies username@subdomain.tld
     1011#   (1) User name only with no domain:
     1012#           foo implies foo@macports.org
     1013#   (2) Mangled name:
     1014#           subdomain.tld:username implies username@subdomain.tld
    10161015#
    10171016proc unobscure_maintainers { list } {
    1018         set result {}
    1019         foreach m $list {
    1020                 if {[string first "@" $m] < 0} {
    1021                         if {[string first ":" $m] >= 0} {
    1022                                 set m [regsub -- "(.*):(.*)" $m "\\2@\\1"]
    1023                         } else {
    1024                                 set m "$m@macports.org"
    1025                         }
    1026                 }
    1027                 lappend result $m
    1028         }
    1029         return $result
     1017    set result {}
     1018    foreach m $list {
     1019        if {[string first "@" $m] < 0} {
     1020            if {[string first ":" $m] >= 0} {
     1021                set m [regsub -- "(.*):(.*)" $m "\\2@\\1"]
     1022            } else {
     1023                set m "$m@macports.org"
     1024            }
     1025        }
     1026        lappend result $m
     1027    }
     1028    return $result
    10301029}
    10311030
     
    10411040    set procedure [ditem_key $ditem procedure]
    10421041    if {$procedure != ""} {
    1043         set name [ditem_key $ditem name]
    1044        
    1045         if {[ditem_contains $ditem init]} {
    1046             set result [catch {[ditem_key $ditem init] $name} errstr]
    1047         }
    1048        
    1049         if {$result == 0} {
    1050                 # Skip the step if required and explain why through ui_debug.
    1051                 # 1st case: the step was already done (as mentioned in the state file)
    1052                 if {[check_statefile target $name $target_state_fd]} {
    1053                     ui_debug "Skipping completed $name ($portname)"
    1054                     set skipped 1
    1055                 # 2nd case: the step is not to always be performed
    1056                 # and this exact port/version/revision/variants is already installed
    1057                 # and user didn't mention -f
    1058                 # and portfile didn't change since installation.
    1059                 } elseif {[ditem_key $ditem runtype] != "always"
    1060                         && [registry_exists $portname $portversion $portrevision $portvariants]
    1061                         && !([info exists ports_force] && $ports_force == "yes")} {
    1062                                                
    1063                         # Did the Portfile change since installation?
    1064                         set regref [registry_open $portname $portversion $portrevision $portvariants]
    1065                        
    1066                         set installdate [registry_prop_retr $regref date]
    1067                         if { $installdate != 0
    1068                                 && $installdate < [file mtime ${portpath}/Portfile]} {
    1069                                 ui_debug "Portfile changed since installation"
    1070                         } else {
    1071                                 # Say we're skipping.
    1072                                 set skipped 1
    1073                                
    1074                                 ui_debug "Skipping $name ($portname) since this port is already installed"
    1075                         }
    1076                        
    1077                         # Something to close the registry entry may be called here, if it existed.
    1078                 # 3rd case: the same port/version/revision/Variants is already active
    1079                 # and user didn't mention -f
    1080                 } elseif {$name == "org.macports.activate"
    1081                         && [registry_exists $portname $portversion $portrevision $portvariants]
    1082                         && !([info exists ports_force] && $ports_force == "yes")} {
    1083                        
    1084                         # Is port active?
    1085                         set regref [registry_open $portname $portversion $portrevision $portvariants]
    1086                        
    1087                         if { [registry_prop_retr $regref active] != 0 } {
    1088                                 # Say we're skipping.
    1089                                 set skipped 1
    1090                                
    1091                                 ui_msg "Skipping $name ($portname $portvariants) since this port is already active"
    1092                         }
    1093                        
    1094                 }
    1095                        
    1096                 # otherwise execute the task.
    1097                 if {$skipped == 0} {
    1098                         set target [ditem_key $ditem provides]
    1099                        
    1100                         # Execute pre-run procedure
    1101                         if {[ditem_contains $ditem prerun]} {
    1102                         set result [catch {[ditem_key $ditem prerun] $name} errstr]
    1103                         }               
    1104                        
    1105                         #start tracelib
    1106                         if {($result ==0
    1107                             && [info exists ports_trace]
    1108                                 && $ports_trace == "yes"
    1109                                 && $target != "clean")} {
    1110                                 trace_start $workpath
    1111 
    1112                                 # Enable the fence to prevent any creation/modification
    1113                                 # outside the sandbox.
    1114                                 if {$target != "activate"
    1115                                         && $target != "archive"
    1116                                         && $target != "fetch"
    1117                                         && $target != "install"} {
    1118                                         trace_enable_fence
    1119                                 }
    1120                        
    1121                                 # collect deps
    1122                                
    1123                                 # Don't check dependencies for extract (they're not honored
    1124                                 # anyway). This avoids warnings about bzip2.
    1125                                 if {$target != "extract"} {
    1126                                         set depends {}
    1127                                         set deptypes {}
    1128                                        
    1129                                         # Determine deptypes to look for based on target
    1130                                         switch $target {
    1131                                                 configure       { set deptypes "depends_lib depends_build" }
    1132                                                
    1133                                                 build           { set deptypes "depends_lib depends_build" }
    1134                                                
    1135                                                 test            -
    1136                                                 destroot        -
    1137                                                 install         -
    1138                                                 archive         -
    1139                                                 pkg                     -
    1140                                                 mpkg            -
    1141                                                 rpm                     -
    1142                                                 srpm            -
    1143                                                 dpkg            -
    1144                                                 activate    -
    1145                                                 ""                      { set deptypes "depends_lib depends_build depends_run" }
    1146                                         }
    1147                                        
    1148                                         # Gather the dependencies for deptypes
    1149                                         foreach deptype $deptypes {
    1150                                                 # Add to the list of dependencies if the option exists and isn't empty.
    1151                                                 if {[info exists PortInfo($deptype)] && $PortInfo($deptype) != ""} {
    1152                                                         set depends [concat $depends $PortInfo($deptype)]
    1153                                                 }
    1154                                         }
    1155        
    1156                                         # Dependencies are in the form verb:[param:]port
    1157                                         set depsPorts {}
    1158                                         foreach depspec $depends {
    1159                                                 # grab the portname portion of the depspec
    1160                                                 set dep_portname [lindex [split $depspec :] end]
    1161                                                 lappend depsPorts $dep_portname
    1162                                         }
    1163                                        
    1164                                         set portlist $depsPorts
    1165                                         foreach depName $depsPorts {
    1166                                                 set portlist [concat $portlist [recursive_collect_deps $depName $deptypes]]
    1167                                         }
    1168                                         #uniquer from http://aspn.activestate.com/ASPN/Cookbook/Tcl/Recipe/147663
    1169                                         array set a [split "[join $portlist {::}]:" {:}]
    1170                                         set depsPorts [array names a]
    1171                                        
    1172                                         if {[llength $deptypes] > 0} {tracelib setdeps $depsPorts}
    1173                                 }
    1174                         }
    1175                        
    1176                         if {$result == 0} {
    1177                         foreach pre [ditem_key $ditem pre] {
    1178                                 ui_debug "Executing $pre"
    1179                                 set result [catch {$pre $name} errstr]
    1180                                 if {$result != 0} { break }
    1181                         }
    1182                         }
    1183                        
    1184                         if {$result == 0} {
    1185                         ui_debug "Executing $name ($portname)"
    1186                         set result [catch {$procedure $name} errstr]
    1187                         }
    1188                        
    1189                         if {$result == 0} {
    1190                         foreach post [ditem_key $ditem post] {
    1191                                 ui_debug "Executing $post"
    1192                                 set result [catch {$post $name} errstr]
    1193                                 if {$result != 0} { break }
    1194                         }
    1195                         }
    1196                         # Execute post-run procedure
    1197                         if {[ditem_contains $ditem postrun] && $result == 0} {
    1198                         set postrun [ditem_key $ditem postrun]
    1199                         ui_debug "Executing $postrun"
    1200                         set result [catch {$postrun $name} errstr]
    1201                         }
    1202 
    1203                         # Check dependencies & file creations outside workpath.
    1204                         if {[info exists ports_trace]
    1205                                 && $ports_trace == "yes"
    1206                                 && $target!="clean"} {
    1207                                
    1208                                 tracelib closesocket
    1209                                
    1210                                 trace_check_violations
    1211                                
    1212                                 # End of trace.
    1213                                 trace_stop
    1214                         }
    1215                 }
    1216         }
    1217         if {$result == 0} {
    1218                 # Only write to state file if:
    1219                 # - we indeed performed this step.
    1220                 # - this step is not to always be performed
    1221                 # - this step must be written to file
    1222                 if {$skipped == 0
    1223             && [ditem_key $ditem runtype] != "always"
    1224             && [ditem_key $ditem state] != "no"} {
    1225                 write_statefile target $name $target_state_fd
    1226             }
    1227         } else {
    1228             ui_error "Target $name returned: $errstr"
    1229             set result 1
    1230         }
    1231        
     1042        set name [ditem_key $ditem name]
     1043   
     1044        if {[ditem_contains $ditem init]} {
     1045            set result [catch {[ditem_key $ditem init] $name} errstr]
     1046        }
     1047   
     1048        if {$result == 0} {
     1049            # Skip the step if required and explain why through ui_debug.
     1050            # 1st case: the step was already done (as mentioned in the state file)
     1051            if {[check_statefile target $name $target_state_fd]} {
     1052                ui_debug "Skipping completed $name ($portname)"
     1053                set skipped 1
     1054            # 2nd case: the step is not to always be performed
     1055            # and this exact port/version/revision/variants is already installed
     1056            # and user didn't mention -f
     1057            # and portfile didn't change since installation.
     1058            } elseif {[ditem_key $ditem runtype] != "always"
     1059              && [registry_exists $portname $portversion $portrevision $portvariants]
     1060              && !([info exists ports_force] && $ports_force == "yes")} {
     1061                       
     1062                # Did the Portfile change since installation?
     1063                set regref [registry_open $portname $portversion $portrevision $portvariants]
     1064           
     1065                set installdate [registry_prop_retr $regref date]
     1066                if { $installdate != 0
     1067                  && $installdate < [file mtime ${portpath}/Portfile]} {
     1068                    ui_debug "Portfile changed since installation"
     1069                } else {
     1070                    # Say we're skipping.
     1071                    set skipped 1
     1072               
     1073                    ui_debug "Skipping $name ($portname) since this port is already installed"
     1074                }
     1075           
     1076                # Something to close the registry entry may be called here, if it existed.
     1077                # 3rd case: the same port/version/revision/Variants is already active
     1078                # and user didn't mention -f
     1079            } elseif {$name == "org.macports.activate"
     1080              && [registry_exists $portname $portversion $portrevision $portvariants]
     1081              && !([info exists ports_force] && $ports_force == "yes")} {
     1082           
     1083                # Is port active?
     1084                set regref [registry_open $portname $portversion $portrevision $portvariants]
     1085           
     1086                if { [registry_prop_retr $regref active] != 0 } {
     1087                    # Say we're skipping.
     1088                    set skipped 1
     1089               
     1090                    ui_msg "Skipping $name ($portname $portvariants) since this port is already active"
     1091                }
     1092               
     1093            }
     1094           
     1095            # otherwise execute the task.
     1096            if {$skipped == 0} {
     1097                set target [ditem_key $ditem provides]
     1098           
     1099                # Execute pre-run procedure
     1100                if {[ditem_contains $ditem prerun]} {
     1101                    set result [catch {[ditem_key $ditem prerun] $name} errstr]
     1102                }
     1103           
     1104                #start tracelib
     1105                if {($result ==0
     1106                  && [info exists ports_trace]
     1107                  && $ports_trace == "yes"
     1108                  && $target != "clean")} {
     1109                    trace_start $workpath
     1110
     1111                    # Enable the fence to prevent any creation/modification
     1112                    # outside the sandbox.
     1113                    if {$target != "activate"
     1114                      && $target != "archive"
     1115                      && $target != "fetch"
     1116                      && $target != "install"} {
     1117                        trace_enable_fence
     1118                    }
     1119           
     1120                    # collect deps
     1121                   
     1122                    # Don't check dependencies for extract (they're not honored
     1123                    # anyway). This avoids warnings about bzip2.
     1124                    if {$target != "extract"} {
     1125                        set depends {}
     1126                        set deptypes {}
     1127                   
     1128                        # Determine deptypes to look for based on target
     1129                        switch $target {
     1130                            configure   { set deptypes "depends_lib depends_build" }
     1131                           
     1132                            build       { set deptypes "depends_lib depends_build" }
     1133                       
     1134                            test        -
     1135                            destroot    -
     1136                            install     -
     1137                            archive     -
     1138                            pkg         -
     1139                            mpkg        -
     1140                            rpm         -
     1141                            srpm        -
     1142                            dpkg        -
     1143                            activate    -
     1144                            ""          { set deptypes "depends_lib depends_build depends_run" }
     1145                        }
     1146                   
     1147                        # Gather the dependencies for deptypes
     1148                        foreach deptype $deptypes {
     1149                            # Add to the list of dependencies if the option exists and isn't empty.
     1150                            if {[info exists PortInfo($deptype)] && $PortInfo($deptype) != ""} {
     1151                                set depends [concat $depends $PortInfo($deptype)]
     1152                            }
     1153                        }
     1154   
     1155                        # Dependencies are in the form verb:[param:]port
     1156                        set depsPorts {}
     1157                        foreach depspec $depends {
     1158                            # grab the portname portion of the depspec
     1159                            set dep_portname [lindex [split $depspec :] end]
     1160                            lappend depsPorts $dep_portname
     1161                        }
     1162                   
     1163                        set portlist $depsPorts
     1164                        foreach depName $depsPorts {
     1165                            set portlist [concat $portlist [recursive_collect_deps $depName $deptypes]]
     1166                        }
     1167                        #uniquer from http://aspn.activestate.com/ASPN/Cookbook/Tcl/Recipe/147663
     1168                        array set a [split "[join $portlist {::}]:" {:}]
     1169                        set depsPorts [array names a]
     1170                   
     1171                        if {[llength $deptypes] > 0} {tracelib setdeps $depsPorts}
     1172                    }
     1173                }
     1174           
     1175                if {$result == 0} {
     1176                    foreach pre [ditem_key $ditem pre] {
     1177                        ui_debug "Executing $pre"
     1178                        set result [catch {$pre $name} errstr]
     1179                        if {$result != 0} { break }
     1180                    }
     1181                }
     1182           
     1183                if {$result == 0} {
     1184                ui_debug "Executing $name ($portname)"
     1185                set result [catch {$procedure $name} errstr]
     1186                }
     1187           
     1188                if {$result == 0} {
     1189                    foreach post [ditem_key $ditem post] {
     1190                        ui_debug "Executing $post"
     1191                        set result [catch {$post $name} errstr]
     1192                        if {$result != 0} { break }
     1193                    }
     1194                }
     1195                # Execute post-run procedure
     1196                if {[ditem_contains $ditem postrun] && $result == 0} {
     1197                    set postrun [ditem_key $ditem postrun]
     1198                    ui_debug "Executing $postrun"
     1199                    set result [catch {$postrun $name} errstr]
     1200                }
     1201
     1202                # Check dependencies & file creations outside workpath.
     1203                if {[info exists ports_trace]
     1204                  && $ports_trace == "yes"
     1205                  && $target!="clean"} {
     1206               
     1207                    tracelib closesocket
     1208               
     1209                    trace_check_violations
     1210               
     1211                    # End of trace.
     1212                    trace_stop
     1213                }
     1214            }
     1215        }
     1216        if {$result == 0} {
     1217            # Only write to state file if:
     1218            # - we indeed performed this step.
     1219            # - this step is not to always be performed
     1220            # - this step must be written to file
     1221            if {$skipped == 0
     1222          && [ditem_key $ditem runtype] != "always"
     1223          && [ditem_key $ditem state] != "no"} {
     1224            write_statefile target $name $target_state_fd
     1225            }
     1226        } else {
     1227            ui_error "Target $name returned: $errstr"
     1228            set result 1
     1229        }
     1230   
    12321231    } else {
    1233         ui_info "Warning: $name does not have a registered procedure"
    1234         set result 1
     1232        ui_info "Warning: $name does not have a registered procedure"
     1233        set result 1
    12351234    }
    12361235   
     
    12421241proc recursive_collect_deps {portname deptypes} \
    12431242{
    1244         set res [mport_search ^$portname\$]
     1243    set res [mport_search ^$portname\$]
    12451244    if {[llength $res] < 2} \
    1246         {
     1245    {
    12471246        return {}
    12481247    }
    12491248
    1250         set depends {}
    1251 
    1252         array set portinfo [lindex $res 1]
    1253         foreach deptype $deptypes \
    1254         {
    1255                 if {[info exists portinfo($deptype)] && $portinfo($deptype) != ""} \
    1256                 {
    1257                         set depends [concat $depends $portinfo($deptype)]
    1258                 }
    1259         }
    1260        
    1261         set portdeps {}
    1262         foreach depspec $depends \
    1263         {
    1264                 set portname [lindex [split $depspec :] end]
    1265                 lappend portdeps $portname
    1266                 set portdeps [concat $portdeps [recursive_collect_deps $portname $deptypes]]
    1267         }
    1268         return $portdeps
     1249    set depends {}
     1250
     1251    array set portinfo [lindex $res 1]
     1252    foreach deptype $deptypes \
     1253    {
     1254        if {[info exists portinfo($deptype)] && $portinfo($deptype) != ""} \
     1255        {
     1256            set depends [concat $depends $portinfo($deptype)]
     1257        }
     1258    }
     1259   
     1260    set portdeps {}
     1261    foreach depspec $depends \
     1262    {
     1263        set portname [lindex [split $depspec :] end]
     1264        lappend portdeps $portname
     1265        set portdeps [concat $portdeps [recursive_collect_deps $portname $deptypes]]
     1266    }
     1267    return $portdeps
    12691268}
    12701269
     
    12771276    if {$target != ""} {
    12781277        set matches [dlist_search $dlist provides $target]
    1279        
     1278   
    12801279        if {[llength $matches] > 0} {
    1281             set dlist [dlist_append_dependents $dlist [lindex $matches 0] [list]]
    1282             # Special-case 'all'
    1283         } elseif {$target != "all"} {
    1284             ui_error "unknown target: $target"
     1280            set dlist [dlist_append_dependents $dlist [lindex $matches 0] [list]]
     1281            # Special-case 'all'
     1282        } elseif {$target != "all"} {
     1283            ui_error "unknown target: $target"
    12851284            return 1
    12861285        }
     
    12931292   
    12941293    if {[llength $dlist] > 0} {
    1295         # somebody broke!
    1296         set errstring "Warning: the following items did not execute (for $portname):"
    1297         foreach ditem $dlist {
    1298             append errstring " [ditem_key $ditem name]"
    1299         }
    1300         ui_info $errstring
    1301         set result 1
     1294        # somebody broke!
     1295        set errstring "Warning: the following items did not execute (for $portname):"
     1296        foreach ditem $dlist {
     1297            append errstring " [ditem_key $ditem name]"
     1298        }
     1299        ui_info $errstring
     1300        set result 1
    13021301    } else {
    1303         set result 0
     1302        set result 0
    13041303    }
    13051304   
     
    13141313   
    13151314    if {![file isdirectory $workpath]} {
    1316         file mkdir $workpath
     1315        file mkdir $workpath
    13171316    }
    13181317    # flock Portfile
    13191318    set statefile [file join $workpath .macports.${portname}.state]
    13201319    if {[file exists $statefile]} {
    1321         if {![file writable $statefile]} {
    1322             return -code error "$statefile is not writable - check permission on port directory"
    1323         }
    1324         if {!([info exists ports_ignore_older] && $ports_ignore_older == "yes") && [file mtime $statefile] < [file mtime ${portpath}/Portfile]} {
    1325             ui_msg "Portfile changed since last build; discarding previous state."
    1326             #file delete $statefile
    1327             exec rm -rf [file join $workpath]
    1328             exec mkdir [file join $workpath]
    1329         }
     1320        if {![file writable $statefile]} {
     1321            return -code error "$statefile is not writable - check permission on port directory"
     1322        }
     1323        if {!([info exists ports_ignore_older] && $ports_ignore_older == "yes") && [file mtime $statefile] < [file mtime ${portpath}/Portfile]} {
     1324            ui_msg "Portfile changed since last build; discarding previous state."
     1325            #file delete $statefile
     1326            exec rm -rf [file join $workpath]
     1327            exec mkdir [file join $workpath]
     1328        }
    13301329    }
    13311330
    13321331    # Create a symlink to the workpath for port authors
    13331332    if {[tbool place_worksymlink] && ![file isdirectory $worksymlink]} {
    1334             exec ln -sf $workpath $worksymlink
     1333        exec ln -sf $workpath $worksymlink
    13351334    }
    13361335   
     
    13391338        if {"$result" == "EAGAIN"} {
    13401339            ui_msg "Waiting for lock on $statefile"
    1341         } elseif {"$result" == "EOPNOTSUPP"} {
    1342             # Locking not supported, just return
    1343             return $fd
     1340    } elseif {"$result" == "EOPNOTSUPP"} {
     1341        # Locking not supported, just return
     1342        return $fd
    13441343        } else {
    13451344            return -code error "$result obtaining lock on $statefile"
     
    13551354    seek $fd 0
    13561355    while {[gets $fd line] >= 0} {
    1357         if {$line == "$class: $name"} {
    1358             return 1
    1359         }
     1356        if {$line == "$class: $name"} {
     1357            return 1
     1358        }
    13601359    }
    13611360    return 0
     
    13661365proc write_statefile {class name fd} {
    13671366    if {[check_statefile $class $name $fd]} {
    1368         return 0
     1367        return 0
    13691368    }
    13701369    seek $fd 0 end
     
    13801379    seek $fd 0
    13811380    while {[gets $fd line] >= 0} {
    1382         if {[regexp "variant: (.*)" $line match name]} {
    1383             set oldvariations([string range $name 1 end]) [string range $name 0 0]
    1384         }
     1381        if {[regexp "variant: (.*)" $line match name]} {
     1382            set oldvariations([string range $name 1 end]) [string range $name 0 0]
     1383        }
    13851384    }
    13861385   
    13871386    set mismatch 0
    13881387    if {[array size oldvariations] > 0} {
    1389         if {[array size oldvariations] != [array size upvariations]} {
    1390             set mismatch 1
    1391         } else {
    1392             foreach key [array names upvariations *] {
    1393                 if {![info exists oldvariations($key)] || $upvariations($key) != $oldvariations($key)} {
    1394                     set mismatch 1
    1395                     break
    1396                 }
    1397             }
    1398         }
     1388        if {[array size oldvariations] != [array size upvariations]} {
     1389            set mismatch 1
     1390        } else {
     1391            foreach key [array names upvariations *] {
     1392                if {![info exists oldvariations($key)] || $upvariations($key) != $oldvariations($key)} {
     1393                set mismatch 1
     1394                break
     1395                }
     1396            }
     1397        }
    13991398    }
    14001399   
     
    14121411   
    14131412    foreach ditem $dlist {
    1414         # Enumerate through the provides, tallying the pros and cons.
    1415         set pros 0
    1416         set cons 0
    1417         set ignored 0
    1418         foreach flavor [ditem_key $ditem provides] {
    1419             if {[info exists upvariations($flavor)]} {
    1420                 if {$upvariations($flavor) == "+"} {
    1421                     incr pros
    1422                 } elseif {$upvariations($flavor) == "-"} {
    1423                     incr cons
    1424                 }
    1425             } else {
    1426                 incr ignored
    1427             }
    1428         }
    1429        
    1430         if {$cons > 0} { continue }
    1431        
    1432         if {$pros > 0 && $ignored == 0} {
    1433             lappend selected $ditem
    1434         }
     1413        # Enumerate through the provides, tallying the pros and cons.
     1414        set pros 0
     1415        set cons 0
     1416        set ignored 0
     1417        foreach flavor [ditem_key $ditem provides] {
     1418            if {[info exists upvariations($flavor)]} {
     1419                if {$upvariations($flavor) == "+"} {
     1420                    incr pros
     1421                } elseif {$upvariations($flavor) == "-"} {
     1422                    incr cons
     1423                }
     1424            } else {
     1425                incr ignored
     1426            }
     1427        }
     1428   
     1429        if {$cons > 0} { continue }
     1430   
     1431        if {$pros > 0 && $ignored == 0} {
     1432            lappend selected $ditem
     1433        }
    14351434    }
    14361435    return $selected
     
    14431442    # test for conflicting variants
    14441443    foreach v [ditem_key $ditem conflicts] {
    1445         if {[variant_isset $v]} {
    1446             ui_error "Variant $name conflicts with $v"
    1447             return 1
    1448         }
     1444        if {[variant_isset $v]} {
     1445            ui_error "Variant $name conflicts with $v"
     1446            return 1
     1447        }
    14491448    }
    14501449   
    14511450    # execute proc with same name as variant.
    14521451    if {[catch "variant-${name}" result]} {
    1453         global errorInfo
    1454         ui_debug "$errorInfo"
    1455         ui_error "Error executing $name: $result"
    1456         return 1
     1452        global errorInfo
     1453        ui_debug "$errorInfo"
     1454        ui_error "Error executing $name: $result"
     1455        return 1
    14571456    }
    14581457    return 0
     
    14881487    upvar $variations upvariations
    14891488    set chosen [choose_variants $dlist upvariations]
    1490         set portname $PortInfo(name)
    1491 
    1492         # Check to make sure the requested variations are available with this
    1493         # port, if one is not, warn the user and remove the variant from the
    1494         # array.
    1495         foreach key [array names upvariations *] {
    1496                 if {![info exists PortInfo(variants)] ||
    1497                         [lsearch $PortInfo(variants) $key] == -1} {
    1498                         ui_debug "Requested variant $key is not provided by port $portname."
    1499                         array unset upvariations $key
    1500                 }
    1501         }
     1489    set portname $PortInfo(name)
     1490
     1491    # Check to make sure the requested variations are available with this
     1492    # port, if one is not, warn the user and remove the variant from the
     1493    # array.
     1494    foreach key [array names upvariations *] {
     1495        if {![info exists PortInfo(variants)] ||
     1496            [lsearch $PortInfo(variants) $key] == -1} {
     1497            ui_debug "Requested variant $key is not provided by port $portname."
     1498            array unset upvariations $key
     1499        }
     1500    }
    15021501
    15031502    # now that we've selected variants, change all provides [a b c] to [a-b-c]
     
    15091508    set newlist [list]
    15101509    foreach variant $chosen {
    1511                 set newlist [dlist_append_dependents $dlist $variant $newlist]
     1510        set newlist [dlist_append_dependents $dlist $variant $newlist]
    15121511    }
    15131512   
    15141513    set dlist [dlist_eval $newlist "" variant_run]
    15151514    if {[llength $dlist] > 0} {
    1516                 return 1
     1515        return 1
    15171516    }
    15181517
     
    15681567   
    15691568    if { [lsearch "clean submit" $target] < 0 &&
    1570                 !([info exists ports_force] && $ports_force == "yes")} {
    1571                
    1572                 set state_fd [open_statefile]
    1573        
    1574                 if {[check_statefile_variants upvariations $state_fd]} {
    1575                         ui_error "Requested variants do not match original selection.\nPlease perform 'port clean $portname' or specify the force option."
    1576                         set result 1
    1577                 } else {
    1578                         # Write variations out to the statefile
    1579                         foreach key [array names upvariations *] {
    1580                         write_statefile variant $upvariations($key)$key $state_fd
    1581                         }
    1582                 }
    1583                
    1584                 close $state_fd
     1569        !([info exists ports_force] && $ports_force == "yes")} {
     1570       
     1571        set state_fd [open_statefile]
     1572   
     1573        if {[check_statefile_variants upvariations $state_fd]} {
     1574            ui_error "Requested variants do not match original selection.\nPlease perform 'port clean $portname' or specify the force option."
     1575            set result 1
     1576        } else {
     1577            # Write variations out to the statefile
     1578            foreach key [array names upvariations *] {
     1579            write_statefile variant $upvariations($key)$key $state_fd
     1580            }
     1581        }
     1582       
     1583        close $state_fd
    15851584    }
    15861585   
     
    17041703    global variations
    17051704    switch -regex $action {
    1706         set|append {
    1707             foreach v $value {
    1708                 if {[regexp {([-+])([-A-Za-z0-9_]+)} $v whole val variant]} {
    1709                     if {![info exists variations($variant)]} {
    1710                         set variations($variant) $val
    1711                     }
    1712                 }
    1713             }
    1714         }
    1715         delete {
    1716             # xxx
    1717         }
     1705        set|append {
     1706            foreach v $value {
     1707                if {[regexp {([-+])([-A-Za-z0-9_]+)} $v whole val variant]} {
     1708                    if {![info exists variations($variant)]} {
     1709                    set variations($variant) $val
     1710                    }
     1711                }
     1712            }
     1713        }
     1714        delete {
     1715            # xxx
     1716        }
    17181717    }
    17191718}
     
    17441743    set porturl $portinfo(porturl)
    17451744    if {[catch {set worker [mport_open $porturl [array get options] $variations]} result]} {
    1746                 global errorInfo
    1747                 ui_debug "$errorInfo"
     1745        global errorInfo
     1746        ui_debug "$errorInfo"
    17481747        ui_error "Opening $portname $target failed: $result"
    17491748        return -1
    17501749    }
    17511750    if {[catch {mport_exec $worker $target} result] || $result != 0} {
    1752                 global errorInfo
    1753                 ui_debug "$errorInfo"
     1751        global errorInfo
     1752        ui_debug "$errorInfo"
    17541753        ui_error "Execution $portname $target failed: $result"
    17551754        mport_close $worker
     
    18381837    set size    0;
    18391838    foreach file [readdir $dir] {
    1840         if {[file type [file join $dir $file]] == "link" } {
    1841             continue
    1842         }
    1843         if {[file isdirectory [file join $dir $file]]} {
    1844             incr size [dirSize [file join $dir $file]]
    1845         } else {
    1846             incr size [file size [file join $dir $file]];
    1847         }
     1839        if {[file type [file join $dir $file]] == "link" } {
     1840            continue
     1841        }
     1842        if {[file isdirectory [file join $dir $file]]} {
     1843            incr size [dirSize [file join $dir $file]]
     1844        } else {
     1845            incr size [file size [file join $dir $file]];
     1846        }
    18481847    }
    18491848    return $size;
     
    18551854    global env
    18561855    foreach dir [split $env(PATH) :] {
    1857         if {[file executable [file join $dir $binary]]} {
    1858             return [file join $dir $binary]
    1859         }
     1856        if {[file executable [file join $dir $binary]]} {
     1857            return [file join $dir $binary]
     1858        }
    18601859    }
    18611860   
     
    18651864# Set the UI prefix to something standard (so it can be grepped for in output)
    18661865proc set_ui_prefix {} {
    1867         global UI_PREFIX env
    1868         if {[info exists env(UI_PREFIX)]} {
    1869                 set UI_PREFIX $env(UI_PREFIX)
    1870         } else {
    1871                 set UI_PREFIX "---> "
    1872         }
     1866    global UI_PREFIX env
     1867    if {[info exists env(UI_PREFIX)]} {
     1868        set UI_PREFIX $env(UI_PREFIX)
     1869    } else {
     1870        set UI_PREFIX "---> "
     1871    }
    18731872}
    18741873
    18751874# Use a specified group/version.
    18761875proc PortGroup {group version} {
    1877         global portresourcepath
    1878 
    1879         set groupFile ${portresourcepath}/group/${group}-${version}.tcl
    1880 
    1881         if {[file exists $groupFile]} {
    1882                 uplevel "source $groupFile"
    1883         } else {
    1884                 ui_warn "Group file could not be located."
    1885         }
     1876    global portresourcepath
     1877
     1878    set groupFile ${portresourcepath}/group/${group}-${version}.tcl
     1879
     1880    if {[file exists $groupFile]} {
     1881        uplevel "source $groupFile"
     1882    } else {
     1883        ui_warn "Group file could not be located."
     1884    }
    18861885}
    18871886
     
    18901889proc archiveTypeIsSupported {type} {
    18911890    global os.platform os.version
    1892         set errmsg ""
    1893         switch -regex $type {
    1894                 cp(io|gz) {
    1895                         set pax "pax"
    1896                         if {[catch {set pax [binaryInPath $pax]} errmsg] == 0} {
    1897                                 if {[regexp {z$} $type]} {
    1898                                         set gzip "gzip"
    1899                                         if {[catch {set gzip [binaryInPath $gzip]} errmsg] == 0} {
    1900                                                 return 0
    1901                                         }
    1902                                 } else {
    1903                                         return 0
    1904                                 }
    1905                         }
    1906                 }
    1907                 t(ar|bz|lz|gz) {
    1908                         set tar "tar"
    1909                         if {[catch {set tar [binaryInPath $tar]} errmsg] == 0} {
    1910                                 if {[regexp {z2?$} $type]} {
    1911                                         if {[regexp {bz2?$} $type]} {
    1912                                                 set gzip "bzip2"
    1913                                         } elseif {[regexp {lz$} $type]} {
    1914                                                 set gzip "lzma"
    1915                                         } else {
    1916                                                 set gzip "gzip"
    1917                                         }
    1918                                         if {[catch {set gzip [binaryInPath $gzip]} errmsg] == 0} {
    1919                                                 return 0
    1920                                         }
    1921                                 } else {
    1922                                         return 0
    1923                                 }
    1924                         }
    1925                 }
    1926                 xar {
    1927                         set xar "xar"
    1928                         if {[catch {set xar [binaryInPath $xar]} errmsg] == 0} {
    1929                                 return 0
    1930                         }
    1931                 }
    1932                 zip {
    1933                         set zip "zip"
    1934                         if {[catch {set zip [binaryInPath $zip]} errmsg] == 0} {
    1935                                 set unzip "unzip"
    1936                                 if {[catch {set unzip [binaryInPath $unzip]} errmsg] == 0} {
    1937                                         return 0
    1938                                 }
    1939                         }
    1940                 }
    1941                 default {
    1942                         return -code error [format [msgcat::mc "Invalid port archive type '%s' specified!"] $type]
    1943                 }
    1944         }
    1945         return -code error [format [msgcat::mc "Unsupported port archive type '%s': %s"] $type $errmsg]
     1891    set errmsg ""
     1892    switch -regex $type {
     1893        cp(io|gz) {
     1894            set pax "pax"
     1895            if {[catch {set pax [binaryInPath $pax]} errmsg] == 0} {
     1896                if {[regexp {z$} $type]} {
     1897                    set gzip "gzip"
     1898                    if {[catch {set gzip [binaryInPath $gzip]} errmsg] == 0} {
     1899                        return 0
     1900                    }
     1901                } else {
     1902                    return 0
     1903                }
     1904            }
     1905        }
     1906        t(ar|bz|lz|gz) {
     1907            set tar "tar"
     1908            if {[catch {set tar [binaryInPath $tar]} errmsg] == 0} {
     1909                if {[regexp {z2?$} $type]} {
     1910                    if {[regexp {bz2?$} $type]} {
     1911                        set gzip "bzip2"
     1912                    } elseif {[regexp {lz$} $type]} {
     1913                        set gzip "lzma"
     1914                    } else {
     1915                        set gzip "gzip"
     1916                    }
     1917                    if {[catch {set gzip [binaryInPath $gzip]} errmsg] == 0} {
     1918                        return 0
     1919                    }
     1920                } else {
     1921                    return 0
     1922                }
     1923            }
     1924        }
     1925        xar {
     1926            set xar "xar"
     1927            if {[catch {set xar [binaryInPath $xar]} errmsg] == 0} {
     1928                return 0
     1929            }
     1930        }
     1931        zip {
     1932            set zip "zip"
     1933            if {[catch {set zip [binaryInPath $zip]} errmsg] == 0} {
     1934                set unzip "unzip"
     1935                if {[catch {set unzip [binaryInPath $unzip]} errmsg] == 0} {
     1936                    return 0
     1937                }
     1938            }
     1939        }
     1940        default {
     1941            return -code error [format [msgcat::mc "Invalid port archive type '%s' specified!"] $type]
     1942        }
     1943    }
     1944    return -code error [format [msgcat::mc "Unsupported port archive type '%s': %s"] $type $errmsg]
    19461945}
    19471946
     
    19511950# this will merge the directories $destroot/i386 & $destroot/ppc into $destroot
    19521951proc merge args {
    1953         global workpath prefix destroot
    1954         set all_args "-i ${destroot} -o ${destroot} -v debug"
    1955         set architectures ""
    1956 
    1957         # check existance of given architectures in $destroot
    1958         foreach arg $args {
    1959                 if [file exists ${destroot}/${arg}] {
    1960                         ui_debug "found architecture '${arg}'"
    1961                         set architectures "${architectures} $arg"
    1962                 } else {
    1963                         ui_error "could not find directory for architecture '${arg}'"
    1964                 }
    1965         }
    1966         set all_args "${all_args} ${architectures}"
    1967 
    1968         # call merge.rb
    1969         ui_debug "executing merge.rb with '${all_args}'"
    1970         set fullcmdstring "${prefix}/bin/merge.rb $all_args"
    1971         set code [catch {system $fullcmdstring} result]
    1972         ui_debug "merge returned: '${result}'"
    1973 
    1974         foreach arg ${architectures} {
    1975                 ui_debug "removing arch directory \"$arg\""
    1976                 file delete -force ${destroot}/${arg}
    1977         }
    1978 
    1979         return -code $code $result
    1980 }
    1981 
     1952    global workpath prefix destroot
     1953    set all_args "-i ${destroot} -o ${destroot} -v debug"
     1954    set architectures ""
     1955
     1956    # check existance of given architectures in $destroot
     1957    foreach arg $args {
     1958        if [file exists ${destroot}/${arg}] {
     1959            ui_debug "found architecture '${arg}'"
     1960            set architectures "${architectures} $arg"
     1961        } else {
     1962            ui_error "could not find directory for architecture '${arg}'"
     1963        }
     1964    }
     1965    set all_args "${all_args} ${architectures}"
     1966
     1967    # call merge.rb
     1968    ui_debug "executing merge.rb with '${all_args}'"
     1969    set fullcmdstring "${prefix}/bin/merge.rb $all_args"
     1970    set code [catch {system $fullcmdstring} result]
     1971    ui_debug "merge returned: '${result}'"
     1972
     1973    foreach arg ${architectures} {
     1974        ui_debug "removing arch directory \"$arg\""
     1975        file delete -force ${destroot}/${arg}
     1976    }
     1977
     1978    return -code $code $result
     1979}
     1980
Note: See TracChangeset for help on using the changeset viewer.