Changeset 4453 for trunk/base
- Timestamp:
- Jan 5, 2004, 2:45:21 AM (20 years ago)
- Location:
- trunk/base/src/port1.0
- Files:
-
- 14 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/base/src/port1.0/portbuild.tcl
r4399 r4453 71 71 set pbxbuild "pbxbuild" 72 72 set xcodebuild "xcodebuild" 73 73 74 74 if {[option os.platform] != "darwin"} { 75 75 return -code error "[format [msgcat::mc "This port requires 'pbxbuild/xcodebuild', which is not available on %s."] [option os.platform]]" 76 76 } 77 77 78 78 if {[catch {set xcodebuild [binaryInPath $xcodebuild]}] == 0} { 79 79 return $xcodebuild … … 93 93 proc build_start {args} { 94 94 global UI_PREFIX 95 95 96 96 ui_msg "$UI_PREFIX [format [msgcat::mc "Building %s with target %s"] [option portname] [option build.target]]" 97 97 } -
trunk/base/src/port1.0/portchecksum.tcl
r3295 r4453 54 54 proc checksum_start {args} { 55 55 global UI_PREFIX portname 56 56 57 57 ui_msg "$UI_PREFIX [format [msgcat::mc "Verifying checksum for %s"] $portname]" 58 58 } … … 60 60 proc checksum_main {args} { 61 61 global distpath all_dist_files UI_PREFIX 62 62 63 63 # If no files have been downloaded there is nothing to checksum 64 64 if {![info exists all_dist_files]} { 65 65 return 0 66 66 } 67 67 68 68 if {![exists checksums]} { 69 69 ui_error "[msgcat::mc "No checksums statement in Portfile. File checksums are:"]" … … 73 73 return -code error "[msgcat::mc "No checksums statement in Portfile."]" 74 74 } 75 75 76 76 # Optimization for the 2 argument case for checksums 77 77 if {[llength [option checksums]] == 2 && [llength $all_dist_files] == 1} { 78 78 option checksums [linsert [option checksums] 0 $all_dist_files] 79 79 } 80 80 81 81 foreach distfile $all_dist_files { 82 82 set checksum [md5 file $distpath/$distfile] -
trunk/base/src/port1.0/portclean.tcl
r2118 r4453 45 45 proc clean_start {args} { 46 46 global UI_PREFIX 47 47 48 48 ui_msg "$UI_PREFIX [format [msgcat::mc "Cleaning %s"] [option portname]]" 49 49 } -
trunk/base/src/port1.0/portconfigure.tcl
r3271 r4453 54 54 proc configure_start {args} { 55 55 global UI_PREFIX 56 56 57 57 ui_msg "$UI_PREFIX [format [msgcat::mc "Configuring %s"] [option portname]]" 58 58 } … … 61 61 global [info globals] 62 62 global configure configure.args configure.dir automake automake.env automake.args automake.dir autoconf autoconf.env autoconf.args autoconf.dir xmkmf libtool portname worksrcpath prefix workpath UI_PREFIX use_configure use_autoconf use_automake use_xmkmf 63 63 64 64 if {[tbool use_automake]} { 65 65 # XXX depend on automake … … 68 68 } 69 69 } 70 70 71 71 if {[tbool use_autoconf]} { 72 72 # XXX depend on autoconf … … 75 75 } 76 76 } 77 77 78 78 if {[tbool use_xmkmf]} { 79 79 # XXX depend on xmkmf -
trunk/base/src/port1.0/portdepends.tcl
r3304 r4453 50 50 set|append|delete { 51 51 foreach depspec $args { 52 53 54 55 56 57 58 59 60 61 52 if {[regexp {([A-Za-z\./0-9]+):([A-Za-z0-9_/\-\.$^\?\+\(\)\|\\]+):([-A-Za-z\./0-9_]+)} "$depspec" match deppath depregex portname]} { 53 switch $deppath { 54 lib {} 55 bin {} 56 path {} 57 default {return -code error [format [msgcat::mc "unknown depspec type: %s"] $deppath]} 58 } 59 } else { 60 return -code error [format [msgcat::mc "invalid depspec: %s"] $depspec] 61 } 62 62 } 63 63 } -
trunk/base/src/port1.0/portdestroot.tcl
r3891 r4453 56 56 proc destroot_start {args} { 57 57 global UI_PREFIX prefix portname destroot portresourcepath os.platform destroot.clean 58 58 59 59 ui_msg "$UI_PREFIX [format [msgcat::mc "Staging %s into destroot"] ${portname}]" 60 60 61 61 if { ${destroot.clean} == "yes" } { 62 62 system "rm -Rf \"${destroot}\"" 63 63 } 64 64 65 65 file mkdir "${destroot}" 66 66 if { ${os.platform} == "darwin" } { … … 78 78 proc destroot_finish {args} { 79 79 global destroot 80 80 81 81 # Prune empty directories in ${destroot} 82 82 catch {system "find \"${destroot}\" -depth -type d -print | xargs rmdir 2>/dev/null"} -
trunk/base/src/port1.0/portdmg.tcl
r4026 r4453 42 42 proc dmg_main {args} { 43 43 global portname portversion portrevision package.destpath UI_PREFIX 44 44 45 45 ui_msg "$UI_PREFIX [format [msgcat::mc "Creating disk image for %s-%s"] ${portname} ${portversion}]" 46 46 47 47 return [package_dmg $portname $portversion $portrevision] 48 48 } … … 50 50 proc package_dmg {portname portversion portrevision} { 51 51 global UI_PREFIX package.destpath portpath 52 52 53 53 if {[expr (${portrevision} > 0)]} { 54 54 set imagename "${portname}-${portversion}-${portrevision}" … … 56 56 set imagename "${portname}-${portversion}" 57 57 } 58 58 59 59 set tmp_image ${package.destpath}/${imagename}.tmp.dmg 60 60 set final_image ${package.destpath}/${imagename}.dmg 61 61 set pkgpath ${package.destpath}/${portname}-${portversion}.pkg 62 62 63 63 if {[file readable $final_image] && ([file mtime ${final_image}] >= [file mtime ${portpath}/Portfile])} { 64 64 ui_msg "$UI_PREFIX [format [msgcat::mc "Disk Image for %s-%s is up-to-date"] ${portname} ${portversion}]" 65 65 return 0 66 66 } 67 67 68 68 # size for .dmg 69 69 set size [dirSize ${pkgpath}] … … 75 75 set blocks [expr ($size/512) + ((($size/512)*3)/100)] 76 76 } 77 77 78 78 if {[system "hdiutil create -fs HFS+ -volname ${imagename} -size ${blocks}b ${tmp_image}"] != ""} { 79 79 return -code error [format [msgcat::mc "Failed to create temporary image: %s"] ${imagename}] … … 93 93 } 94 94 system "rm -f ${tmp_image}" 95 95 96 96 return 0 97 97 } -
trunk/base/src/port1.0/portextract.tcl
r4000 r4453 57 57 proc extract_init {args} { 58 58 global extract.only extract.dir extract.cmd extract.pre_args extract.post_args distfiles use_bzip2 use_zip workpath 59 59 60 60 if {[tbool use_bzip2]} { 61 61 option extract.cmd [binaryInPath "bzip2"] … … 69 69 proc extract_start {args} { 70 70 global UI_PREFIX 71 71 72 72 ui_msg "$UI_PREFIX [format [msgcat::mc "Extracting %s"] [option portname]]" 73 73 } … … 75 75 proc extract_main {args} { 76 76 global UI_PREFIX 77 77 78 78 if {![exists distfiles] && ![exists extract.only]} { 79 79 # nothing to do 80 80 return 0 81 81 } 82 82 83 83 foreach distfile [option extract.only] { 84 84 ui_info "$UI_PREFIX [format [msgcat::mc "Extracting %s"] $distfile]" -
trunk/base/src/port1.0/portfetch.tcl
r3977 r4453 156 156 return {} 157 157 } 158 158 159 159 set ret [list] 160 160 foreach element $portfetch::mirror_sites::sites($mirrors) { … … 164 164 set splitlist [split $element :] 165 165 if {[llength $splitlist] > 1} { 166 167 168 } 169 166 set element "[lindex $splitlist 0]:[lindex $splitlist 1]" 167 set mirror_tag "[lindex $splitlist 2]" 168 } 169 170 170 if {$subdir == "" && $mirror_tag != "nosubdir"} { 171 171 set subdir ${portname} 172 172 } 173 173 174 174 if {"$tag" != ""} { 175 175 eval append element "${subdir}:${tag}" … … 179 179 eval lappend ret $element 180 180 } 181 181 182 182 return $ret 183 183 } … … 192 192 master_sites filespath master_sites.mirror_subdir \ 193 193 patch_sites.mirror_subdir fallback_mirror_site 194 194 195 195 append master_sites " ${fallback_mirror_site}" 196 196 197 197 foreach list {master_sites patch_sites} { 198 198 upvar #0 $list uplist … … 228 228 } 229 229 } 230 230 231 231 if {[info exists patchfiles]} { 232 232 foreach file $patchfiles { … … 286 286 global distpath all_dist_files UI_PREFIX fetch_urls fetch.cmd os.platform fetch.pre_args 287 287 global distfile site 288 288 289 289 if {![file isdirectory $distpath]} { 290 290 if {[catch {file mkdir $distpath} result]} { … … 328 328 proc fetch_init {args} { 329 329 global distfiles distname distpath all_dist_files dist_subdir fetch.type 330 330 331 331 if {[info exist distpath] && [info exists dist_subdir]} { 332 332 set distpath ${distpath}/${dist_subdir} … … 339 339 proc fetch_start {args} { 340 340 global UI_PREFIX portname 341 341 342 342 ui_msg "$UI_PREFIX [format [msgcat::mc "Fetching %s"] $portname]" 343 343 } … … 349 349 proc fetch_main {args} { 350 350 global distname distpath all_dist_files fetch.type 351 351 352 352 # Check for files, download if neccesary 353 353 if {![info exists all_dist_files] && "${fetch.type}" == "standard"} { -
trunk/base/src/port1.0/portinstall.tcl
r3954 r4453 43 43 proc install_start {args} { 44 44 global UI_PREFIX portname portversion 45 46 # Check to make sure this port is not already installed. This is a 47 # general check of the portname only, so previous versions will fail 48 # as well. 49 if {[string length [registry_exists $portname]]} { 50 # Also check to see if it's this version or another 51 if {[string length [registry_exists $portname $portversion]]} { 52 return -code error [format [msgcat::mc "Port %s already registered as installed."] $portname] 53 } else { 54 return -code error [format [msgcat::mc "Another version of Port %s is already registered as installed. Please uninstall the port first."] $portname] 55 } 45 46 # Check to make sure this port is not already installed. This is a 47 # general check of the portname only, so previous versions will fail 48 # as well. 49 if {[string length [registry_exists $portname]]} { 50 # Also check to see if it's this version or another 51 if {[string length [registry_exists $portname $portversion]]} { 52 return -code error [format [msgcat::mc "Port %s already registered as installed."] $portname] 56 53 } else { 54 return -code error [format [msgcat::mc "Another version of Port %s is already registered as installed. Please uninstall the port first."] $portname] 55 } 56 } else { 57 57 ui_msg "$UI_PREFIX [format [msgcat::mc "Installing %s"] ${portname}]" 58 58 } 59 59 } 60 60 61 61 proc install_element {src_element dst_element} { 62 # don't recursively copy directories62 # don't recursively copy directories 63 63 if {[file isdirectory $src_element] && [file type $src_element] != "link"} { 64 64 file mkdir $dst_element … … 66 66 file copy -force $src_element $dst_element 67 67 } 68 68 69 69 # if the file is a symlink, do not try to set file attributes 70 70 # if the destination file is an existing directory, … … 90 90 return 91 91 } 92 92 93 93 foreach name [readdir .] { 94 94 if {[string match $name "."] || [string match $name ".."]} { … … 96 96 } 97 97 set element [file join $cwd $name] 98 98 99 99 # XXX jpm's cross-platform code to find file separator 100 100 # replace with [file seperator] with tcl 8.4 … … 108 108 } 109 109 } 110 110 111 111 set dst_element [file join $root $element] 112 112 set src_element [file join $rootdir $element] … … 126 126 proc install_main {args} { 127 127 global portname portversion portpath categories description long_description homepage depends_run installPlist package-install uninstall workdir worksrcdir prefix UI_PREFIX destroot 128 128 129 129 # Install ${destroot} contents into / 130 130 directory_dig ${destroot} ${destroot} 131 131 132 132 # Package installed successfully, so now we must register it 133 133 set rhandle [registry_new $portname $portversion] 134 134 135 135 registry_store $rhandle [list prefix $prefix] 136 136 registry_store $rhandle [list categories $categories] -
trunk/base/src/port1.0/portpatch.tcl
r3220 r4453 48 48 proc patch_main {args} { 49 49 global UI_PREFIX 50 50 51 51 # First make sure that patchfiles exists and isn't stubbed out. 52 52 if {![exists patchfiles]} { 53 53 return 0 54 54 } 55 55 56 56 foreach patch [option patchfiles] { 57 57 if {[file exists [option filespath]/$patch]} { -
trunk/base/src/port1.0/portrpmpackage.tcl
r3375 r4453 44 44 proc rpmpackage_main {args} { 45 45 global portname portversion portrevision UI_PREFIX 46 46 47 47 ui_msg "$UI_PREFIX [format [msgcat::mc "Creating RPM package for %s-%s"] ${portname} ${portversion}]" 48 48 49 49 return [rpmpackage_pkg $portname $portversion $portrevision] 50 50 } … … 52 52 proc rpmpackage_pkg {portname portversion portrevision} { 53 53 global UI_PREFIX package.destpath portdbpath destpath workpath prefix portresourcepath categories maintainers description long_description homepage epoch portpath 54 54 55 55 set rpmdestpath "" 56 56 if {![string equal ${package.destpath} ${workpath}] && ![string equal ${package.destpath} ""]} { … … 63 63 set rpmdestpath "--define '_topdir ${pkgpath}'" 64 64 } 65 65 66 66 foreach dir { "${prefix}/src/apple/RPMS" "/usr/src/apple/RPMS" "/darwinports/rpms/RPMS"} { 67 67 foreach arch {"ppc" "i386" "fat"} { … … 73 73 } 74 74 } 75 75 76 76 set specpath ${workpath}/${portname}.spec 77 77 # long_description, description, or homepage may not exist … … 85 85 set category [lindex [split $categories " "] 0] 86 86 set maintainer $maintainers 87 87 88 88 set dependencies {} 89 89 # get deplist … … 98 98 } 99 99 } 100 100 101 101 system "rm -f '${workpath}/${portname}.filelist' && touch '${workpath}/${portname}.filelist'" 102 102 #system "cd '${destpath}' && find . -type d | grep -v -E '^.$' | sed -e 's/\"/\\\"/g' -e 's/^./%dir \"/' -e 's/$/\"/' > '${workpath}/${portname}.filelist'" … … 105 105 write_spec ${specpath} $portname $portversion $portrevision $pkg_description $pkg_long_description $category $maintainer $destpath $dependencies $epoch 106 106 system "DP_USERECEIPTS='${portdbpath}/receipts' rpm -bb -v ${rpmdestpath} ${specpath}" 107 107 108 108 return 0 109 109 } … … 117 117 foreach {name array} $res { 118 118 array set portinfo $array 119 119 120 120 if {[info exists portinfo(depends_run)] || [info exists portinfo(depends_lib)]} { 121 121 # get the union of depends_run and depends_lib … … 124 124 if {[info exists portinfo(depends_run)]} { eval "lappend depends $portinfo(depends_run)" } 125 125 if {[info exists portinfo(depends_lib)]} { eval "lappend depends $portinfo(depends_lib)" } 126 126 127 127 foreach depspec $depends { 128 128 set dep [lindex [split $depspec :] 2] 129 129 130 130 # xxx: nasty hack 131 131 if {$dep != "XFree86"} { … … 144 144 set specfd [open ${specfile} w+] 145 145 if {[llength ${dependencies}] != 0} { 146 147 148 146 set requires [join ${dependencies} ", "] 147 regsub -all -- "\-" $requires "_" requires 148 set requires "Requires: ${requires}" 149 149 } else { 150 150 set requires "" 151 151 } 152 152 regsub -all -- "\-" $portversion "_" portversion -
trunk/base/src/port1.0/portuninstall.tcl
r4300 r4453 46 46 proc uninstall_start {args} { 47 47 global portname portversion UI_PREFIX 48 48 49 49 if {[string length [registry_exists $portname]]} { 50 50 ui_msg "$UI_PREFIX [format [msgcat::mc "Uninstalling %s"] $portname]" … … 54 54 proc uninstall_main {args} { 55 55 global portname portversion uninstall.force uninstall.nochecksum ports_force UI_PREFIX 56 56 57 57 # If global forcing is on, make it the same as a local force flag. 58 58 if {[tbool ports_force]} { 59 59 set uninstall.force "yes" 60 60 } 61 61 62 62 set rfile [registry_exists $portname] 63 63 if {[string length $rfile]} { … … 69 69 set entry [read $fd] 70 70 close $fd 71 71 72 72 # First look to see if the port has registered an uninstall procedure 73 73 set ix [lsearch $entry pkg_uninstall] … … 80 80 } 81 81 } 82 82 83 83 # Now look for a contents list 84 84 set ix [lsearch $entry contents] … … 90 90 set md5index [lsearch -regex [lrange $f 1 end] MD5] 91 91 if {$md5index != -1} { 92 92 set sumx [lindex $f [expr $md5index + 1]] 93 93 } else { 94 95 96 97 94 # XXX There is no MD5 listed, set sumx to an empty 95 # list, causing the next conditional to return a 96 # checksum error 97 set sumx {} 98 98 } 99 99 set sum1 [lindex $sumx [expr [llength $sumx] - 1]] … … 127 127 } 128 128 if {!$uninst_err || [tbool uninstall.force]} { 129 130 129 registry_delete $portname 130 return 0 131 131 } 132 132 } else { -
trunk/base/src/port1.0/portutil.tcl
r4422 r4453 65 65 66 66 proc option {name args} { 67 68 69 70 71 72 73 74 75 67 # XXX: right now we just transparently use globals 68 # eventually this will need to bridge the options between 69 # the Portfile's interpreter and the target's interpreters. 70 global $name 71 if {[llength $args] > 0} { 72 ui_debug "setting option $name to $args" 73 set $name [lindex $args 0] 74 } 75 return [set $name] 76 76 } 77 77 … … 82 82 83 83 proc exists {name} { 84 85 86 87 88 84 # XXX: right now we just transparently use globals 85 # eventually this will need to bridge the options between 86 # the Portfile's interpreter and the target's interpreters. 87 global $name 88 return [info exists $name] 89 89 } 90 90 … … 178 178 proc option_proc_trace {optionName index op} { 179 179 global option_procs 180 180 upvar $optionName optionValue 181 181 switch $op { 182 182 w { … … 303 303 304 304 # mode indicates what the arg is interpreted as. 305 306 307 305 # possible mode keywords are: requires, conflicts, provides 306 # The default mode is provides. Arguments are added to the 307 # most recently specified mode (left to right). 308 308 set mode "provides" 309 309 foreach arg $args { 310 311 312 313 314 310 switch -exact $arg { 311 provides { set mode "provides" } 312 requires { set mode "requires" } 313 conflicts { set mode "conflicts" } 314 default { ditem_append $ditem $mode $arg } 315 315 } 316 316 } 317 317 ditem_key $ditem name "[join [ditem_key $ditem provides] -]" 318 318 319 319 # make a user procedure named variant-blah-blah 320 320 # we will call this procedure during variant-run … … 349 349 proc variant_unset {name} { 350 350 global variations 351 351 352 352 set variations($name) - 353 353 } … … 358 358 # be more readable, and support arch and version specifics 359 359 proc platform {args} { 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 360 global all_variants PortInfo os.platform os.arch os.version 361 upvar $args upargs 362 363 set len [llength $args] 364 set code [lindex $args end] 365 set os [lindex $args 0] 366 set args [lrange $args 1 [expr $len - 2]] 367 368 set ditem [variant_new "temp-variant"] 369 370 foreach arg $args { 371 if {[regexp {(^[0-9]$)} $arg match result]} { 372 set release $result 373 } elseif {[regexp {([a-zA-Z0-9]*)} $arg match result]} { 374 set arch $result 375 } 376 } 377 378 # Add the variant for this platform 379 set platform $os 380 if {[info exists release]} { set platform ${platform}_${release} } 381 if {[info exists arch]} { set platform ${platform}_${arch} } 382 383 variant $platform $code 384 385 # Set the variant if this platform matches the platform we're on 386 if {[info exists os.platform] && ${os.platform} == $os} { 387 set sel_platform $os 388 if {[info exists os.version] && [info exists release]} { 389 regexp {([0-9]*)[0-9\.]?} ${os.version} match major 390 if {$major == $release } { 391 set sel_platform ${sel_platform}_${release} 392 } 393 } 394 if {[info exists os.arch] && [info exists arch] && ${os.arch} == $arch} { 395 set sel_platform $arch 396 } 397 variant_set $sel_platform 398 } 399 400 400 } 401 401 … … 432 432 return -code error "no value given for parameter \"file\" to \"reinplace\"" 433 433 } 434 434 435 435 foreach file $args { 436 436 if {[catch {set tmpfile [mkstemp "/tmp/[file tail $file].sed.XXXXXXXX"]} error]} { … … 443 443 set tmpfile [lindex $tmpfile 1] 444 444 } 445 445 446 446 if {[catch {exec sed $pattern < $file >@ $tmpfd} error]} { 447 447 ui_error "reinplace: $error" … … 449 449 return -code error "reinplace failed" 450 450 } 451 451 452 452 close $tmpfd 453 453 454 454 set attributes [file attributes $file] 455 455 # We need to overwrite this file … … 459 459 return -code error "reinplace failed" 460 460 } 461 461 462 462 if {[catch {exec cp $tmpfile $file} error]} { 463 463 ui_error "reinplace: $error" … … 482 482 proc filefindbypath {fname} { 483 483 global distpath filesdir workdir worksrcdir portpath 484 484 485 485 if {[file readable $portpath/$fname]} { 486 486 return $portpath/$fname … … 582 582 global targets target_state_fd portname 583 583 set dlist $targets 584 585 584 585 # Select the subset of targets under $target 586 586 if {$target != ""} { 587 587 set matches [dlist_search $dlist provides $target] 588 588 589 589 if {[llength $matches] > 0} { 590 591 592 593 590 set dlist [dlist_append_dependents $dlist [lindex $matches 0] [list]] 591 # Special-case 'all' 592 } elseif {$target != "all"} { 593 ui_error "unknown target: $target" 594 594 return 1 595 595 } 596 596 } 597 597 598 598 # Restore the state from a previous run. 599 599 set target_state_fd [open_statefile] 600 600 601 601 set dlist [dlist_eval $dlist "" target_run] 602 602 603 603 if {[llength $dlist] > 0} { 604 605 606 607 608 609 610 604 # somebody broke! 605 set errstring "Warning: the following items did not execute (for $portname):" 606 foreach ditem $dlist { 607 append errstring " [ditem_key $ditem name]" 608 } 609 ui_info $errstring 610 set result 1 611 611 } else { 612 613 } 614 612 set result 0 613 } 614 615 615 close $target_state_fd 616 616 return $result … … 628 628 set statefile [file join $workpath .darwinports.${portname}.state] 629 629 if {[file exists $statefile]} { 630 631 632 633 634 635 636 637 638 639 640 630 if {![file writable $statefile]} { 631 return -code error "$statefile is not writable - check permission on port directory" 632 } 633 if {!([info exists ports_ignore_older] && $ports_ignore_older == "yes") && [file mtime $statefile] < [file mtime ${portpath}/Portfile]} { 634 ui_msg "Portfile changed since last build; discarding previous state." 635 #file delete $statefile 636 exec rm -rf [file join $workpath] 637 exec mkdir [file join $workpath] 638 } 639 } 640 641 641 set fd [open $statefile a+] 642 642 if {[catch {flock $fd -exclusive -noblock} result]} { … … 658 658 proc check_statefile {class name fd} { 659 659 global portpath workdir 660 660 661 661 seek $fd 0 662 662 while {[gets $fd line] >= 0} { 663 664 665 663 if {$line == "$class: $name"} { 664 return 1 665 } 666 666 } 667 667 return 0 … … 672 672 proc write_statefile {class name fd} { 673 673 if {[check_statefile $class $name $fd]} { 674 674 return 0 675 675 } 676 676 seek $fd 0 end … … 682 682 # Check that recorded selection of variants match the current selection 683 683 proc check_statefile_variants {variations fd} { 684 685 684 upvar $variations upvariations 685 686 686 seek $fd 0 687 687 while {[gets $fd line] >= 0} { 688 if {[regexp "variant: (.*)" $line match name]} { 689 set oldvariations([string range $name 1 end]) [string range $name 0 0] 688 if {[regexp "variant: (.*)" $line match name]} { 689 set oldvariations([string range $name 1 end]) [string range $name 0 0] 690 } 691 } 692 693 set mismatch 0 694 if {[array size oldvariations] > 0} { 695 if {[array size oldvariations] != [array size upvariations]} { 696 set mismatch 1 697 } else { 698 foreach key [array names upvariations *] { 699 if {![info exists oldvariations($key)] || $upvariations($key) != $oldvariations($key)} { 700 set mismatch 1 701 break 690 702 } 691 } 692 693 set mismatch 0 694 if {[array size oldvariations] > 0} { 695 if {[array size oldvariations] != [array size upvariations]} { 696 set mismatch 1 697 } else { 698 foreach key [array names upvariations *] { 699 if {![info exists oldvariations($key)] || $upvariations($key) != $oldvariations($key)} { 700 set mismatch 1 701 break 702 } 703 } 704 } 705 } 706 707 return $mismatch 703 } 704 } 705 } 706 707 return $mismatch 708 708 } 709 709 … … 770 770 set name [ditem_key $ditem name] 771 771 ui_debug "Executing $name provides [ditem_key $ditem provides]" 772 773 774 775 776 777 778 779 780 772 773 # test for conflicting variants 774 foreach v [ditem_key $ditem conflicts] { 775 if {[variant_isset $v]} { 776 ui_error "Variant $name conflicts with $v" 777 return 1 778 } 779 } 780 781 781 # execute proc with same name as variant. 782 782 if {[catch "variant-${name}" result]} { … … 790 790 global all_variants ports_force 791 791 set dlist $all_variants 792 792 set result 0 793 793 upvar $variations upvariations 794 794 set chosen [choose_variants $dlist upvariations] … … 806 806 807 807 dlist_eval $newlist "" variant_run 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 808 809 # Make sure the variations match those stored in the statefile. 810 # If they don't match, print an error indicating a 'port clean' 811 # should be performed. 812 # - Skip this test if the statefile is empty. 813 # - Skip this test if performing a clean. 814 # - Skip this test if ports_force was specified. 815 816 if {$target != "clean" && 817 !([info exists ports_force] && $ports_force == "yes")} { 818 set state_fd [open_statefile] 819 820 if {[check_statefile_variants upvariations $state_fd]} { 821 ui_error "Requested variants do not match original selection.\nPlease perform 'port clean' or specify the force option." 822 set result 1 823 } else { 824 # Write variations out to the statefile 825 foreach key [array names upvariations *] { 826 write_statefile variant $upvariations($key)$key $state_fd 827 } 828 } 829 830 close $state_fd 831 } 832 833 return $result 834 834 } 835 835 … … 840 840 global targets 841 841 set ditem [ditem_create] 842 843 844 842 843 ditem_key $ditem name $name 844 ditem_key $ditem procedure $procedure 845 845 846 846 lappend targets $ditem … … 861 861 ui_debug "$ident registered provides \'$target\', a pre-existing procedure. Target override will not be provided" 862 862 } else { 863 863 eval "proc $target {args} \{ \n\ 864 864 variable proc_index \n\ 865 865 set proc_index \[llength \[ditem_key $ditem proc\]\] \n\ … … 927 927 928 928 proc target_runtype {ditem args} { 929 929 eval "ditem_append $ditem runtype $args" 930 930 } 931 931 … … 974 974 set options(workpath) ${newworkpath} 975 975 } 976 977 978 976 # Escape regex special characters 977 regsub -all "(\\(){1}|(\\)){1}|(\\{1}){1}|(\\+){1}|(\\{1}){1}|(\\{){1}|(\\}){1}|(\\^){1}|(\\$){1}|(\\.){1}|(\\\\){1}" $portname "\\\\&" search_string 978 979 979 set res [dportsearch ^$search_string\$] 980 980 if {[llength $res] < 2} { … … 982 982 return -1 983 983 } 984 984 985 985 array set portinfo [lindex $res 1] 986 986 set porturl $portinfo(porturl) … … 1013 1013 set home /dev/null 1014 1014 set shell /dev/null 1015 1015 1016 1016 foreach arg $args { 1017 1017 if {[regexp {([a-z]*)=(.*)} $arg match key val]} { … … 1020 1020 } 1021 1021 } 1022 1022 1023 1023 if {[existsuser ${name}] != 0 || [existsuser ${uid}] != 0} { 1024 1024 return 1025 1025 } 1026 1026 1027 1027 if {${os.platform} == "darwin"} { 1028 1028 system "niutil -create . /users/${name}" … … 1046 1046 set passwd {\*} 1047 1047 set users "" 1048 1048 1049 1049 foreach arg $args { 1050 1050 if {[regexp {([a-z]*)=(.*)} $arg match key val]} { … … 1053 1053 } 1054 1054 } 1055 1055 1056 1056 if {[existsgroup ${name}] != 0 || [existsgroup ${gid}] != 0} { 1057 1057 return 1058 1058 } 1059 1059 1060 1060 if {${os.platform} == "darwin"} { 1061 1061 system "niutil -create . /groups/${name}" … … 1097 1097 } 1098 1098 } 1099 1099 1100 1100 return -code error [format [msgcat::mc "Failed to locate '%s' in path: '%s'"] $binary $env(PATH)]; 1101 1101 }
Note: See TracChangeset
for help on using the changeset viewer.