Changeset 23238


Ignore:
Timestamp:
Mar 27, 2007, 9:49:49 PM (12 years ago)
Author:
pguyot@…
Message:

New logic for the environment that makes it much cleaner.
Note, however, that this doesn't solve the problem of ports that don't like
CFLAGS to be set (e.g. centericq) because of a bug in recursive autoconf (!).

Location:
trunk/base/src
Files:
10 edited

Legend:

Unmodified
Added
Removed
  • trunk/base/src/package1.0/portarchive.tcl

    r22585 r23238  
    325325
    326326                        ui_info "$UI_PREFIX [format [msgcat::mc "Creating %s"] ${archive.file}]"
    327                         system "[command archive]"
     327                        command_exec archive
    328328                        ui_info "$UI_PREFIX [format [msgcat::mc "Archive %s packaged"] ${archive.file}]"
    329329                }
  • trunk/base/src/package1.0/portunarchive.tcl

    r19376 r23238  
    269269        # Unpack the archive
    270270        ui_info "$UI_PREFIX [format [msgcat::mc "Extracting %s"] ${unarchive.file}]"
    271         system "[command unarchive]"
     271        command_exec unarchive
    272272
    273273        return 0
     
    314314        # Unpack the archive
    315315        ui_info "$UI_PREFIX [format [msgcat::mc "Extracting %s"] ${unarchive.file}]"
    316         system "[command unarchive]"
     316        command_exec unarchive
    317317
    318318        return 0
  • trunk/base/src/port1.0/portbuild.tcl

    r22003 r23238  
    103103
    104104proc build_main {args} {
    105     system "[command build]"
     105    command_exec build
    106106    return 0
    107107}
  • trunk/base/src/port1.0/portconfigure.tcl

    r23125 r23238  
    8484    if {[tbool use_automake]} {
    8585        # XXX depend on automake
    86         if {[catch {system "[command automake]"} result]} {
     86        if {[catch {command_exec automake} result]} {
    8787            return -code error "[format [msgcat::mc "%s failure: %s"] automake $result]"
    8888        }
     
    9191    if {[tbool use_autoconf]} {
    9292        # XXX depend on autoconf
    93         if {[catch {system "[command autoconf]"} result]} {
     93        if {[catch {command_exec autoconf} result]} {
    9494            return -code error "[format [msgcat::mc "%s failure: %s"] autoconf $result]"
    9595        }
     
    9898    if {[tbool use_xmkmf]} {
    9999                # XXX depend on xmkmf
    100                 if {[catch {system "[command xmkmf]"} result]} {
     100                if {[catch {command_exec xmkmf} result]} {
    101101                    return -code error "[format [msgcat::mc "%s failure: %s"] xmkmf $result]"
    102102                } else {
     
    107107        } elseif {[tbool use_configure]} {
    108108        # Merge (ld|c|cpp|cxx)flags into the environment variable.
    109         # Flatten the environment string.
    110         set env_str ""
    111         foreach str [set configure.env] {
    112                 set env_str "$env_str $str"
    113         }
    114         parse_environment $env_str parsed_env
     109        parse_environment configure
     110
    115111        # Append configure flags.
    116                 append_list_to_environment_value parsed_env "CFLAGS" ${configure.cflags}
    117                 append_list_to_environment_value parsed_env "CPPFLAGS" ${configure.cppflags}
    118                 append_list_to_environment_value parsed_env "CXXFLAGS" ${configure.cxxflags}
    119                 append_list_to_environment_value parsed_env "LDFLAGS" ${configure.ldflags}
    120                 set configure.env [environment_array_to_string parsed_env]
    121                 if {[catch {system "[command configure]"} result]} {
     112                append_list_to_environment_value configure "CFLAGS" ${configure.cflags}
     113                append_list_to_environment_value configure "CPPFLAGS" ${configure.cppflags}
     114                append_list_to_environment_value configure "CXXFLAGS" ${configure.cxxflags}
     115                append_list_to_environment_value configure "LDFLAGS" ${configure.ldflags}
     116
     117                # Execute the command (with the new environment).
     118                if {[catch {command_exec configure} result]} {
    122119                        return -code error "[format [msgcat::mc "%s failure: %s"] configure $result]"
    123120                }
  • trunk/base/src/port1.0/portdestroot.tcl

    r19376 r23238  
    100100
    101101proc destroot_main {args} {
    102     system "[command destroot]"
     102    command_exec destroot
    103103    return 0
    104104}
  • trunk/base/src/port1.0/portextract.tcl

    r22003 r23238  
    8585        ui_info "$UI_PREFIX [format [msgcat::mc "Extracting %s"] $distfile]"
    8686        option extract.args "[option distpath]/$distfile"
    87         if {[catch {system "[command extract]"} result]} {
     87        if {[catch {command_exec extract} result]} {
    8888            return -code error "$result"
    8989        }
  • trunk/base/src/port1.0/portfetch.tcl

    r22003 r23238  
    321321        set cvs.args login
    322322        set cvs.post_args ""
    323         if {[catch {system -notty "[command cvs] 2>&1"} result]} {
     323        if {[catch {command_exec cvs -notty "" "2>&1"} result]} {
    324324            return -code error [msgcat::mc "CVS login failed"]
    325325        }
     
    332332    }
    333333
    334     if {[catch {system "[command cvs] 2>&1"} result]} {
     334    if {[catch {command_exec cvs "" "2>&1"} result]} {
    335335        return -code error [msgcat::mc "CVS check out failed"]
    336336    }
     
    367367    }
    368368
    369     if {[catch {system "[command svn] 2>&1"} result]} {
     369    if {[catch {command_exec svn "" "2>&1"} result]} {
    370370                return -code error [msgcat::mc "Subversion check out failed"]
    371371    }
  • trunk/base/src/port1.0/portpatch.tcl

    r22003 r23238  
    8080        switch -glob -- [file tail $patch] {
    8181            *.Z -
    82             *.gz {system "$gzcat \"$patch\" | ([command patch])"}
    83             *.bz2 {system "bzcat \"$patch\" | ([command patch])"}
    84             default {system "[command patch] < \"$patch\""}
     82            *.gz {command_exec patch "$gzcat \"$patch\" | (" ")"}
     83            *.bz2 {command_exec patch "bzcat \"$patch\" | (" ")"}
     84            default {command_exec patch "" "< '$patch'"}
    8585        }
    8686    }
  • trunk/base/src/port1.0/porttest.tcl

    r19376 r23238  
    3131    global portname test.run
    3232    if {[tbool test.run]} {
    33         system "[command test]"
     33        command_exec test
    3434    } else {
    3535        return -code error [format [msgcat::mc "%s has no tests turned on. see 'test.run' in portfile(7)"] $portname]
  • trunk/base/src/port1.0/portutil.tcl

    r23098 r23238  
    203203}
    204204
    205 # command
    206 # Given a command name, command assembled a string
     205# Given a command name, assemble a command string
    207206# composed of the command options.
    208 proc command {command} {
     207proc command_string {command} {
    209208    global ${command}.dir ${command}.pre_args ${command}.args ${command}.post_args ${command}.env ${command}.type ${command}.cmd
    210209   
     
    212211    if {[info exists ${command}.dir]} {
    213212        set cmdstring "cd \"[set ${command}.dir]\" &&"
    214     }
    215    
    216     if {[info exists ${command}.env]} {
    217         foreach string [set ${command}.env] {
    218             set cmdstring "$cmdstring $string"
    219         }
    220213    }
    221214   
     
    236229    ui_debug "Assembled command: '$cmdstring'"
    237230    return $cmdstring
     231}
     232
     233# Given a command name, execute it with the options.
     234# command_exec command [-notty] [command_prefix [command_suffix]]
     235# command                       name of the command
     236# command_prefix        additional command prefix (typically pipe command)
     237# command_suffix        additional command suffix (typically redirection)
     238proc command_exec {command args} {
     239        global ${command}.env ${command}.env_array env
     240        set notty 0
     241        set command_prefix ""
     242        set command_suffix ""
     243
     244        if {[llength $args] > 0} {
     245                if {[lindex $args 0] == "-notty"} {
     246                        set notty 1
     247                        set args [lrange $args 1 end]
     248                }
     249
     250                if {[llength $args] > 0} {
     251                        set command_prefix [lindex $args 0]
     252                        if {[llength $args] > 1} {
     253                                set command_suffix [lindex $args 1]
     254                        }
     255                }
     256        }
     257       
     258        # Set the environment.
     259        # If the array doesn't exist, we create it with the value
     260        # coming from ${command}.env
     261        # Otherwise, it means the caller actually played with the environment
     262        # array already (e.g. configure flags).
     263        if {![array exists ${command}.env_array]} {
     264                parse_environment ${command}
     265        }
     266       
     267        # Debug that.
     268    ui_debug "Environment: [environment_array_to_string ${command}.env_array]"
     269
     270        # Get the command string.
     271        set cmdstring [command_string ${command}]
     272       
     273        # Call this command.
     274        # TODO: move that to the system native call?
     275        # Save the environment.
     276        set saved_env [array get env]
     277        # Set the overriden variables from the portfile.
     278        array set env [array get ${command}.env_array]
     279        # Call the command.
     280        set fullcmdstring "$command_prefix $cmdstring $command_suffix"
     281        if {$notty} {
     282                set code [catch {system -notty $fullcmdstring} result]
     283        } else {
     284                set code [catch {system $fullcmdstring} result]
     285        }
     286        # Unset the command array until next time.
     287        array unset ${command}.env_array
     288        # Restore the environment.
     289        array unset env
     290        array set env [array get saved_env]
     291
     292        # Return as if system had been called directly.
     293        return -code $code $result
    238294}
    239295
     
    404460########### Environment utility functions ###########
    405461
    406 # Parse an environment string, returning a list of key/value pairs.
    407 proc parse_environment {environment_str parsed_environment} {
    408         upvar 1 ${parsed_environment} env_array
    409         set the_environment ${environment_str}
    410         while {[regexp "^(?: *)(\[^= \]+)=(\\\\?(\"|'|))(\[^\"'\].*?)\\2(?: +|$)(.*)$" ${the_environment} matchVar key delimiter_full delimiter value remaining]} {
    411                 set the_environment ${remaining}
    412                 set env_array(${key}) ${delimiter}${value}${delimiter}
     462# Parse the environment string of a command, storing the values into the
     463# associated environment array.
     464proc parse_environment {command} {
     465        global ${command}.env ${command}.env_array
     466
     467        if {[info exists ${command}.env]} {
     468                # Flatten the environment string.
     469                set the_environment ""
     470                foreach str [set ${command}.env] {
     471                        set the_environment "$the_environment $str"
     472                }
     473       
     474                while {[regexp "^(?: *)(\[^= \]+)=(\"|'|)(\[^\"'\].*?)\\2(?: +|$)(.*)$" ${the_environment} matchVar key delimiter value remaining]} {
     475                        set the_environment ${remaining}
     476                        set ${command}.env_array(${key}) ${value}
     477                }
     478        } else {
     479                array set ${command}.env_array {}
    413480        }
    414481}
     
    416483# Append to the value in the parsed environment.
    417484# Leave the environment untouched if the value is empty.
    418 proc append_to_environment_value {parsed_environment key value} {
    419         upvar 1 ${parsed_environment} env_array
     485proc append_to_environment_value {command key value} {
     486        global ${command}.env_array
    420487
    421488        if {[string length $value] == 0} {
     
    423490        }
    424491
    425         if {[info exists env_array($key)]} {
    426                 set original_value $env_array($key)
    427                 set original_delim ""
    428                 if {[regexp {^("|')(.*)\1$} ${original_value} matchVar original_delim matchedValue]} {
    429                         set original_value $matchedValue
    430                 }
    431                 set append_delim ""
    432                 set append_value $value
    433                 if {[regexp {^("|')(.*)\1$} $append_value matchVar append_delim matchedValue]} {
    434                         set append_value $matchedValue
    435                 }
    436        
    437                 # Always honor original delimiter when appending, unless there isn't any.
    438                 if {[string length $original_delim] == 0} {
    439                         if {[string length $append_delim] == 0} {
    440                                 set new_delim "'"
    441                         } else {
    442                                 set new_delim $append_delim
    443                         }
    444                 } else {
    445                         set new_delim $original_delim
    446                 }
    447                
    448                 set space " "
    449                 set env_array($key) ${new_delim}${original_value}${space}${append_value}${new_delim}
     492        # Parse out any delimiter.
     493        set append_value $value
     494        if {[regexp {^("|')(.*)\1$} $append_value matchVar append_delim matchedValue]} {
     495                set append_value $matchedValue
     496        }
     497
     498        if {[info exists ${command}.env_array($key)]} {
     499                set original_value [set ${command}.env_array($key)]
     500                set ${command}.env_array($key) "${original_value} ${append_value}"
    450501        } else {
    451                 set env_array($key) $value
     502                set ${command}.env_array($key) $append_value
    452503        }
    453504}
    454505
    455506# Append several items to a value in the parsed environment.
    456 proc append_list_to_environment_value {parsed_environment key vallist} {
    457         upvar 1 ${parsed_environment} env_array
    458 
     507proc append_list_to_environment_value {command key vallist} {
    459508        foreach {value} $vallist {
    460                 append_to_environment_value env_array $key $value
    461         }
    462 }
    463 
    464 # Rebuild the environment as a string.
    465 proc environment_array_to_string {parsed_environment} {
    466         upvar 1 ${parsed_environment} env_array
     509                append_to_environment_value ${command} $key $value
     510        }
     511}
     512
     513# Build the environment as a string.
     514# Remark: this method is only used for debugging purposes.
     515proc environment_array_to_string {environment_array} {
     516        upvar 1 ${environment_array} env_array
     517       
    467518        set theString ""
    468519        foreach {key value} [array get env_array] {
    469                 set added_delim "'"
    470                 if {[regexp {^("|').*\1$} ${value} matchVar original_delim]} {
    471                         set added_delim ""
    472                 }
    473                 set value "${added_delim}${value}${added_delim}"
    474 
    475520                if {$theString == ""} {
    476                         set theString "$key=$value"
     521                        set theString "$key='$value'"
    477522                } else {
    478                         set theString "${theString} $key=$value"
     523                        set theString "${theString} $key='$value'"
    479524                }
    480525        }
Note: See TracChangeset for help on using the changeset viewer.