source: trunk/base/src/port/port.tcl @ 15731

Last change on this file since 15731 was 15731, checked in by jberry, 15 years ago

Merge changes for port from jberry-preview-13

  • Property svn:eol-style set to native
  • Property svn:executable set to *
File size: 61.8 KB
Line 
1#!/bin/sh
2#\
3exec @TCLSH@ "$0" "$@"
4# port.tcl
5# $Id: port.tcl,v 1.147 2006/01/07 23:10:22 jberry Exp $
6#
7# Copyright (c) 2002-2006 DarwinPorts organization
8# Copyright (c) 2004 Robert Shaw <rshaw@opendarwin.org>
9# Copyright (c) 2002 Apple Computer, Inc.
10# All rights reserved.
11#
12# Redistribution and use in source and binary forms, with or without
13# modification, are permitted provided that the following conditions
14# are met:
15# 1. Redistributions of source code must retain the above copyright
16#    notice, this list of conditions and the following disclaimer.
17# 2. Redistributions in binary form must reproduce the above copyright
18#    notice, this list of conditions and the following disclaimer in the
19#    documentation and/or other materials provided with the distribution.
20# 3. Neither the name of Apple Computer, Inc. nor the names of its contributors
21#    may be used to endorse or promote products derived from this software
22#    without specific prior written permission.
23#
24# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
25# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
26# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
27# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
28# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
29# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
30# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
31# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
32# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
33# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
34# POSSIBILITY OF SUCH DAMAGE.
35
36#
37#       TODO:
38#
39#               - Rename global_options to cmd_options
40#               - Rename global_options_base to global_options
41#               - Document -i, -F, -p, and -x
42#               - In interactive mode, we might need to blow some caches between commands
43#                 (do we cache anything except PortIndex?)
44#               - Add auto-completion of filenames?
45#
46
47catch {source \
48        [file join "@TCL_PACKAGE_DIR@" darwinports1.0 darwinports_fastload.tcl]}
49package require darwinports
50
51
52# UI Instantiations
53# ui_options(ports_debug) - If set, output debugging messages.
54# ui_options(ports_verbose) - If set, output info messages (ui_info)
55# ui_options(ports_quiet) - If set, don't output "standard messages"
56
57# ui_options accessor
58proc ui_isset {val} {
59        global ui_options
60        if {[info exists ui_options($val)]} {
61                if {$ui_options($val) == "yes"} {
62                        return 1
63                }
64        }
65        return 0
66}
67
68# global_options accessor
69proc global_option_isset {val} {
70        global global_options
71        if {[info exists global_options($val)]} {
72                if {$global_options($val) == "yes"} {
73                        return 1
74                }
75        }
76        return 0
77}
78
79# UI Callback
80proc ui_prefix {priority} {
81    switch $priority {
82        debug {
83                return "DEBUG: "
84        }
85        error {
86                return "Error: "
87        }
88        warn {
89                return "Warning: "
90        }
91        default {
92                return ""
93        }
94    }
95}
96
97proc ui_channels {priority} {
98    global logfd
99    switch $priority {
100        debug {
101            if {[ui_isset ports_debug]} {
102                return {stderr}
103            } else {
104                return {}
105            }
106        }
107        info {
108            if {[ui_isset ports_verbose]} {
109                return {stdout}
110            } else {
111                return {}
112                        }
113                }
114        msg {
115            if {[ui_isset ports_quiet]} {
116                return {}
117                        } else {
118                                return {stdout}
119                        }
120                }
121        error {
122                return {stderr}
123        }
124        default {
125                return {stdout}
126        }
127    }
128}
129
130
131# Standard procedures
132proc print_usage {args} {
133        global cmdname
134        set usage { [-vdqfonRsbcktu] [-D portdir] action [actionflags]
135[[portname|pseudo-portname|port-url] [@version] [+-variant]... [option=value]...]...
136}
137               
138        puts "Usage: $cmdname$usage"
139        puts "\"$cmdname help\" or \"man 1 port\" for more information."
140}
141
142
143proc print_help {args} {
144        global cmdname
145       
146        set help { [-vdqfonRsbcktu] [-D portdir] action [actionflags]
147[[portname|pseudo-portname|port-url] [@version] [+-variant]... [option=value]...]...
148       
149Valid actions are:
150        help, info, location, provides, activate, deactivate, selfupdate, upgrade,
151        version, compact, uncompact, uninstall, installed, outdated, contents, deps,
152        dependents, variants, search, list, echo, sync, dir, url, file, cat, edit,
153        fetch, patch, extract, build, destroot, install, test.
154       
155Pseudo-portnames:
156        Pseudo-portnames are words which may be used in place of a portname, and
157        which expand to some set of ports. The common pseudo-ports are:
158        all, current, active, inactive, installed, uninstalled, and outdated.
159        These pseudo-portnames expand to the set of ports named.
160       
161        Additional pseudo-portnames are:
162        variants:, variant:, description:, portdir:, homepage:, epoch:,
163        platforms:, platform:, name:, long_description:, maintainers:,
164        maintainer:, categories:, category:, version:, and revision:.
165        These each select a set of ports based on a regex search of metadata
166        about the ports. In all such cases, a standard regex pattern following
167        the colon will be used to select the set of ports to which the
168        pseudo-portname expands.
169       
170        portnames that contain standard glob characters will be expanded to the
171        set of ports matching the glob pattern.
172       
173Port expressions:
174        Portnames, port glob patterns, and pseudo-portnames may be logically combined
175        using expressions consisting of and, or, not, !, (, and ).
176       
177For more information:
178        See man pages: port(1), ports.conf(5), portfile(7), portgroup(7),
179        porthier(7), portstyle(7).
180       
181        }
182       
183        puts "$cmdname$help"
184}
185
186
187
188# Produce error message and exit
189proc fatal s {
190        global argv0
191        ui_error "$argv0: $s"
192        exit 1
193}
194
195
196# Produce an error message, and exit, unless
197# we're handling errors in a soft fashion, in which
198# case we continue
199proc fatal_softcontinue s {
200        if {[global_option_isset ports_force]} {
201                ui_error $s
202                return -code continue
203        } else {
204                fatal $s
205        }
206}
207
208
209# Produce an error message, and break, unless
210# we're handling errors in a soft fashion, in which
211# case we continue
212proc break_softcontinue { msg status name_status } {
213        upvar $name_status status_var
214        ui_error $msg
215        if {[ui_isset ports_processall]} {
216                set status_var 0
217                return -code continue
218        } else {
219                set status_var $status
220                return -code break
221        }
222}
223
224
225# Form a composite version as is sometimes used for registry functions
226proc composite_version {version variations {emptyVersionOkay 0}} {
227        # Form a composite version out of the version and variations
228       
229        # Select the variations into positive and negative
230        set pos {}
231        set neg {}
232        foreach { key val } $variations {
233                if {$val == "+"} {
234                        lappend pos $key
235                } elseif {$val == "-"} {
236                        lappend neg $key
237                }
238        }
239       
240        # If there is no version, we have nothing to do
241        set composite_version ""
242        if {$version != "" || $emptyVersionOkay} {
243                set pos_str ""
244                set neg_str ""
245               
246                if {[llength $pos]} {
247                        set pos_str "+[join [lsort -ascii $pos] "+"]"
248                }
249                if {[llength $neg]} {
250                        set neg_str "-[join [lsort -ascii $neg] "-"]"
251                }
252               
253                set composite_version "$version$pos_str$neg_str"
254        }
255       
256        return $composite_version
257}
258
259
260proc split_variants {variants} {
261        set result {}
262        set l [regexp -all -inline -- {([-+])([[:alpha:]_]+[\w\.]*)} $variants]
263        foreach { match sign variant } $l {
264                lappend result $variant $sign
265        }
266        return $result
267}
268
269
270proc registry_installed {portname {portversion ""}} {
271        set ilist [registry::installed $portname $portversion]
272        if { [llength $ilist] > 1 } {
273                puts "The following versions of $portname are currently installed:"
274                foreach i $ilist { 
275                        set iname [lindex $i 0]
276                        set iversion [lindex $i 1]
277                        set irevision [lindex $i 2]
278                        set ivariants [lindex $i 3]
279                        set iactive [lindex $i 4]
280                        if { $iactive == 0 } {
281                                puts "  $iname ${iversion}_${irevision}${ivariants}"
282                        } elseif { $iactive == 1 } {
283                                puts "  $iname ${iversion}_${irevision}${ivariants} (active)"
284                        }
285                }
286                return -code error "Registry error: Please specify the full version as recorded in the port registry."
287        } else {
288                return [lindex $ilist 0]
289        }
290}
291
292
293proc add_to_portlist {listname portentry} {
294        upvar $listname portlist
295        global global_options global_variations
296       
297        # The portlist currently has the following elements in it:
298        #       url                             if any
299        #       name
300        #       version                 (version_revision)
301        #       variants array  (variant=>+-)
302        #       options array   (key=>value)
303        #       fullname                (name/version_revision+-variants)
304       
305        array set port $portentry
306        if {![info exists port(url)]}           { set port(url) "" }
307        if {![info exists port(name)]}          { set port(name) "" }
308        if {![info exists port(version)]}       { set port(version) "" }
309        if {![info exists port(variants)]}      { set port(variants) "" }
310        if {![info exists port(options)]}       { set port(options) [array get global_options] }
311       
312        # If neither portname nor url is specified, then default to the current port
313        if { $port(url) == "" && $port(name) == "" } {
314                set url file://.
315                set portname [url_to_portname $url]
316                set port(url) $url
317                set port(name) $portname
318                if {$portname == ""} {
319                        ui_error "A default port name could not be supplied."
320                }
321        }
322       
323               
324        # Form the fully descriminated portname: portname/version_revison+-variants
325        set port(fullname) "$port(name)/[composite_version $port(version) $port(variants)]"
326       
327        # Add it to our portlist
328        lappend portlist [array get port]
329}
330
331
332proc add_ports_to_portlist {listname ports {overridelist ""}} {
333        upvar $listname portlist
334       
335        array set overrides $overridelist
336       
337        # Add each entry to the named portlist, overriding any values
338        # specified as overrides
339        foreach portentry $ports {
340                array set port $portentry
341                if ([info exists overrides(version)])   { set port(version) $overrides(version) }
342                if ([info exists overrides(variants)])  { set port(variants) $overrides(variants)       }
343                if ([info exists overrides(options)])   { set port(options) $overrides(options) }
344                add_to_portlist portlist [array get port]
345        }
346}
347
348
349proc url_to_portname { url {quiet 0} } {
350        # Save directory and restore the directory, since dportopen changes it
351        set savedir [pwd]
352        set portname ""
353        if {[catch {set ctx [dportopen $url]} result]} {
354                if {!$quiet} {
355                        puts stderr "Can't map the URL '$url' to a port description file (${result}). Please verify that the directory and portfile syntax are correct."
356                }
357        } else {
358                array set portinfo [dportinfo $ctx]
359                set portname $portinfo(name)
360                dportclose $ctx
361        }
362        cd $savedir
363        return $portname
364}
365
366
367# Supply a default porturl/portname if the portlist is empty
368proc require_portlist { nameportlist } {
369        upvar $nameportlist portlist
370       
371        if {[llength $portlist] == 0} {
372                set portlist [get_current_port]
373        }
374}
375
376
377# Execute the enclosed block once for every element in the portlist
378# When the block is entered, the variables portname, portversion, options, and variations
379# will have been set
380proc foreachport {portlist block} {
381        # Restore cwd after each port, since dportopen changes it, and relative
382        # urls will break on subsequent passes
383        set savedir [pwd]
384        foreach portspec $portlist {
385                uplevel 1 "array set portspec { $portspec }"
386                uplevel 1 {
387                        set porturl $portspec(url)
388                        set portname $portspec(name)
389                        set portversion $portspec(version)
390                        array unset variations
391                        array set variations $portspec(variants)
392                        array unset options
393                        array set options $portspec(options)
394                }
395                uplevel 1 $block
396                cd $savedir
397        }
398}
399
400
401proc portlist_compare { a b } {
402        array set a_ $a
403        array set b_ $b
404        return [string compare $a_(name) $b_(name)]
405}
406
407
408proc portlist_sort list {
409        return [lsort -command portlist_compare $list]
410}
411
412
413proc regex_pat_sanitize s {
414        set sanitized [regsub -all {[\\(){}+$.^]} $s {\\&}]
415        return $sanitized
416}
417
418
419##########################################
420# Port selection
421##########################################
422proc get_matching_ports {pattern {casesensitive no} {matchstyle glob} {field name}} {
423        if {[catch {set res [dportsearch $pattern $casesensitive $matchstyle $field]} result]} {
424                global errorInfo
425                ui_debug "$errorInfo"
426                fatal "search for portname $pattern failed: $result"
427        }
428
429        set results {}
430        foreach {name info} $res {
431                array set portinfo $info
432               
433                #set variants {}
434                #if {[info exists portinfo(variants)]} {
435                #       foreach variant $portinfo(variants) {
436                #               lappend variants $variant "+"
437                #       }
438                #}
439                # For now, don't include version or variants with all ports list
440                #"$portinfo(version)_$portinfo(revision)"
441                #$variants
442                add_to_portlist results [list url $portinfo(porturl) name $name]
443        }
444       
445        # Return the list of all ports, sorted
446        return [portlist_sort $results]
447}
448
449
450proc get_all_ports {} {
451        global all_ports_cache
452       
453        if {![info exists all_ports_cache]} {
454                set all_ports_cache [get_matching_ports "*"]
455        }
456        return $all_ports_cache
457}
458
459
460proc get_current_ports {} {
461        # This is just a synonym for get_current_port that
462        # works with the regex in element
463        return [get_current_port]
464}
465
466
467proc get_current_port {} {
468        set url file://.
469        set portname [url_to_portname $url]
470        if {$portname == ""} {
471                ui_error "To use the current port, you must be in a port's directory"
472        }
473       
474        set results {}
475        add_to_portlist results [list url $url name $portname]
476        return $results
477}
478
479
480proc get_installed_ports { {ignore_active yes} {active yes} } {
481        if { [catch {set ilist [registry::installed]} result] } {
482                if {$result == "Registry error: No ports registered as installed."} {
483                        fatal "No ports installed!"
484                } else {
485                        global errorInfo
486                        ui_debug "$errorInfo"
487                        fatal "port installed failed: $result"
488                }
489        }
490       
491        set results {}
492        foreach i $ilist {
493                set iname [lindex $i 0]
494                set iversion [lindex $i 1]
495                set irevision [lindex $i 2]
496                set ivariants [split_variants [lindex $i 3]]
497                set iactive [lindex $i 4]
498               
499                if { ${ignore_active} == "yes" || (${active} == "yes") == (${iactive} != 0) } {
500                        add_to_portlist results [list name $iname version "${iversion}_${irevision}" variants $ivariants]
501                }
502        }
503       
504        # Return the list of ports, sorted
505        return [portlist_sort $results]
506}
507
508
509proc get_uninstalled_ports {} {
510        # Return all - installed
511        set all [get_all_ports]
512        set installed [get_installed_ports]
513        return [opComplement $all $installed]
514}
515
516
517proc get_active_ports {} {
518        return [get_installed_ports no yes]
519}
520
521
522proc get_inactive_ports {} {
523        return [get_installed_ports no no]
524}
525
526
527proc get_outdated_ports {} {
528        # Get the list of install ports
529        if { [catch {set ilist [registry::installed]} result] } {
530                global errorInfo
531                ui_debug "$errorInfo"
532                fatal "can't get installed ports: $result"
533        }
534
535        # Now process the list, keeping only those ports that are outdated
536        set results {}
537        if { [llength $ilist] > 0 } {
538                foreach i $ilist {
539               
540                        # Get information about the installed port
541                        set portname                    [lindex $i 0]
542                        set installed_version   [lindex $i 1]
543                        set installed_revision  [lindex $i 2]
544                        set installed_compound  "${installed_version}_${installed_revision}"
545                        set installed_variants  [lindex $i 3]
546
547                        set is_active                   [lindex $i 4]
548                        if { $is_active == 0 } continue
549                        set installed_epoch             [lindex $i 5]
550
551                        # Get info about the port from the index
552                        if {[catch {set res [dportsearch $portname no exact]} result]} {
553                                global errorInfo
554                                ui_debug "$errorInfo"
555                                fatal "search for portname $portname failed: $result"
556                        }
557                        if {[llength $res] < 2} {
558                                if {[ui_isset ports_debug]} {
559                                        puts "$portname ($installed_compound is installed; the port was not found in the port index)"
560                                }
561                                continue
562                        }
563                        array set portinfo [lindex $res 1]
564                       
565                        # Get information about latest available version and revision
566                        set latest_version $portinfo(version)
567                        set latest_revision             0
568                        if {[info exists portinfo(revision)] && $portinfo(revision) > 0} { 
569                                set latest_revision     $portinfo(revision)
570                        }
571                        set latest_compound             "${latest_version}_${latest_revision}"
572                        set latest_epoch                0
573                        if {[info exists portinfo(epoch)]} { 
574                                set latest_epoch        $portinfo(epoch)
575                        }
576                       
577                        # Compare versions, first checking epoch, then the compound version string
578                        set comp_result [expr $installed_epoch - $latest_epoch]
579                        if { $comp_result == 0 } {
580                                set comp_result [rpm-vercomp $installed_compound $latest_compound]
581                        }
582                       
583                        # Add outdated ports to our results list
584                        if { $comp_result < 0 } {
585                                add_to_portlist results [list name $portname version $installed_compound variants [split_variants $installed_variants]]
586                        }
587                }
588        }
589
590        return $results
591}
592
593
594
595##########################################
596# Port expressions
597##########################################
598proc portExpr resname {
599        upvar $resname reslist
600        set result [seqExpr reslist]
601        return $result
602}
603
604
605proc seqExpr resname {
606        upvar $resname reslist
607       
608        # Evaluate a sequence of expressions a b c...
609        # These act the same as a or b or c
610
611        set result 1
612        while {$result} {
613                switch -- [lookahead] {
614                        ;               -
615                        )               -
616                        _EOF_   { break }
617                }
618               
619                set blist {}
620                set result [orExpr blist]
621                if {$result} {
622                        # Calculate the union of result and b
623                        set reslist [opUnion $reslist $blist]
624                }
625        }
626       
627        return $result
628}
629
630
631proc orExpr resname {
632        upvar $resname reslist
633       
634        set a [andExpr reslist]
635        while ($a) {
636                switch -- [lookahead] {
637                        or {
638                                        advance
639                                        set blist {}
640                                        if {![andExpr blist]} {
641                                                return 0
642                                        }
643                                               
644                                        # Calculate a union b
645                                        set reslist [opUnion $reslist $blist]
646                                }
647                        default {
648                                        return $a
649                                }
650                }
651        }
652       
653        return $a
654}
655
656
657proc andExpr resname {
658        upvar $resname reslist
659       
660        set a [unaryExpr reslist]
661        while {$a} {
662                switch -- [lookahead] {
663                        and {
664                                        advance
665                                       
666                                        set blist {}
667                                        set b [unaryExpr blist]
668                                        if {!$b} {
669                                                return 0
670                                        }
671                                       
672                                        # Calculate a intersect b
673                                        set reslist [opIntersection $reslist $blist]
674                                }
675                        default {
676                                        return $a
677                                }
678                }
679        }
680       
681        return $a
682}
683
684
685proc unaryExpr resname {
686        upvar $resname reslist
687        set result 0
688
689        switch -- [lookahead] {
690                !       -
691                not     {
692                                advance
693                                set blist {}
694                                set result [unaryExpr blist]
695                                if {$result} {
696                                        set all [get_all_ports]
697                                        set reslist [opComplement $all $blist]
698                                }
699                        }
700                default {
701                                set result [element reslist]
702                        }
703        }
704       
705        return $result
706}
707
708
709proc element resname {
710        upvar $resname reslist
711        set el 0
712       
713        set url ""
714        set name ""
715        set version ""
716        array unset variants
717        array unset options
718       
719        set token [lookahead]
720        switch -regex -- $token {
721                ^\\)$                   -
722                ^\;                             -
723                ^_EOF_$                 {       # End of expression/cmd/file
724                                                }
725                                               
726                ^\\($                   {       # Parenthesized Expression
727                                                        advance
728                                                        set el [portExpr reslist]
729                                                        if {!$el || ![match ")"]} {
730                                                                set el 0
731                                                        }
732                                                }
733                       
734                ^all(@.*)?$                     -
735                ^installed(@.*)?$               -
736                ^uninstalled(@.*)?$             -
737                ^active(@.*)?$                  -
738                ^inactive(@.*)?$                -
739                ^outdated(@.*)?$                -
740                ^current(@.*)?$ {
741                                                        # A simple pseudo-port name
742                                                        advance
743                                                       
744                                                        # Break off the version component, if there is one
745                                                        regexp {^(\w+)(@.*)?} $token matchvar name remainder
746                                                       
747                                                        add_multiple_ports reslist [get_${name}_ports] $remainder
748                                                       
749                                                        set el 1
750                                                }
751               
752                ^variants:              -
753                ^variant:               -
754                ^description:   -
755                ^portdir:               -
756                ^homepage:              -
757                ^epoch:                 -
758                ^platforms:             -
759                ^platform:              -
760                ^name:                  -
761                ^long_description:      -
762                ^maintainers:   -
763                ^maintainer:    -
764                ^categories:    -
765                ^category:              -
766                ^version:               -
767                ^revision:              {       # Handle special port selectors
768                                                        advance
769                                                       
770                                                        # Break up the token, because older Tcl switch doesn't support -matchvar
771                                                        regexp {^(\w+):(.*)} $token matchvar field pat
772                                                       
773                                                        # Remap friendly names to actual names
774                                                        switch -- $field {
775                                                                variant         -
776                                                                platform        -
777                                                                maintainer      { set field "${field}s" }
778                                                                category        { set field "categories" }
779                                                        }                                                       
780                                                        add_multiple_ports reslist [get_matching_ports $pat no regexp $field]
781                                                        set el 1
782                                                }
783                                               
784                [][?*]                  {       # Handle portname glob patterns
785                                                        advance; add_multiple_ports reslist [get_matching_ports $token no glob]
786                                                        set el 1
787                                                }
788                                               
789                ^\\w+:.+                {       # Handle a url by trying to open it as a port and mapping the name
790                                                        advance
791                                                        set name [url_to_portname $token]
792                                                        if {$name != ""} {
793                                                                parsePortSpec version variants options
794                                                                add_to_portlist reslist [list url $token \
795                                                                                                                        name $name \
796                                                                                                                        version $version \
797                                                                                                                        variants [array get variants] \
798                                                                                                                        options [array get options]]
799                                                        } else {
800                                                                ui_error "Can't open URL '$token' as a port"
801                                                                set el 0
802                                                        }
803                                                        set el 1
804                                                }
805                                               
806                default                 {       # Treat anything else as a portspec (portname, version, variants, options
807                                                        # or some combination thereof).
808                                                        parseFullPortSpec url name version variants options
809                                                        add_to_portlist reslist [list   url $url \
810                                                                                                                        name $name \
811                                                                                                                        version $version \
812                                                                                                                        variants [array get variants] \
813                                                                                                                        options [array get options]]
814                                                        set el 1
815                                                }
816        }
817       
818        return $el
819}
820
821
822proc add_multiple_ports { resname ports {remainder ""} } {
823        upvar $resname reslist
824       
825        set version ""
826        array unset variants
827        array unset options
828        parsePortSpec version variants options $remainder
829       
830        array unset overrides
831        if {$version != ""}                     { set overrides(version) $version }
832        if {[array size variants]}      { set overrides(variants) [array get variants] }
833        if {[array size options]}       { set overrides(options) [array get options] }
834
835        add_ports_to_portlist reslist $ports [array get overrides]
836}
837
838
839proc opUnion { a b } {
840        set result {}
841       
842        array unset onetime
843       
844        # Walk through each array, adding to result only those items that haven't
845        # been added before
846        foreach item $a {
847                array set port $item
848                if {[info exists onetime($port(fullname))]} continue
849                lappend result $item
850        }
851
852        foreach item $b {
853                array set port $item
854                if {[info exists onetime($port(fullname))]} continue
855                lappend result $item
856        }
857       
858        return $result
859}
860
861
862proc opIntersection { a b } {
863        set result {}
864       
865        # Rules we follow in performing the intersection of two port lists:
866        #
867        #       a/, a/                  ==> a/
868        #       a/, b/                  ==>
869        #       a/, a/1.0               ==> a/1.0
870        #       a/1.0, a/               ==> a/1.0
871        #       a/1.0, a/2.0    ==>
872        #
873        #       If there's an exact match, we take it.
874        #       If there's a match between simple and descriminated, we take the later.
875       
876        # First create a list of the fully descriminated names in b
877        array unset bfull
878        set i 0
879        foreach bitem $b {
880                array set port $bitem
881                set bfull($port(fullname)) $i
882                incr i
883        }
884       
885        # Walk through each item in a, matching against b
886        #
887        # Note: -regexp may not be present in all versions of Tcl we need to work
888        #               against, in which case we may have to fall back to a slower alternative
889        #               for those cases. I'm not worrying about that for now, however. -jdb
890        foreach aitem $a {
891                array set port $aitem
892               
893                # Quote the fullname and portname to avoid special characters messing up the regexp
894                set safefullname [regex_pat_sanitize $port(fullname)]
895               
896                set simpleform [expr { "$port(name)/" == $port(fullname) }]
897                if {$simpleform} {
898                        set pat "^${safefullname}"
899                } else {
900                        set safename [regex_pat_sanitize $port(name)]
901                        set pat "^${safefullname}$|^${safename}/$"
902                }
903               
904                set matches [array names bfull -regexp $pat]
905                foreach match $matches {
906                        if {$simpleform} {
907                                set i $bfull($match)
908                                lappend result [lindex $b $i]
909                        } else {
910                                lappend result $aitem
911                        }
912                }
913        }
914       
915        return $result
916}
917
918
919proc opComplement { a b } {
920        set result {}
921       
922        # Return all elements of a not matching elements in b
923       
924        # First create a list of the fully descriminated names in b
925        array unset bfull
926        set i 0
927        foreach bitem $b {
928                array set port $bitem
929                set bfull($port(fullname)) $i
930                incr i
931        }
932       
933        # Walk through each item in a, taking all those items that don't match b
934        #
935        # Note: -regexp may not be present in all versions of Tcl we need to work
936        #               against, in which case we may have to fall back to a slower alternative
937        #               for those cases. I'm not worrying about that for now, however. -jdb
938        foreach aitem $a {
939                array set port $aitem
940               
941                # Quote the fullname and portname to avoid special characters messing up the regexp
942                set safefullname [regex_pat_sanitize $port(fullname)]
943               
944                set simpleform [expr { "$port(name)/" == $port(fullname) }]
945                if {$simpleform} {
946                        set pat "^${safefullname}"
947                } else {
948                        set safename [regex_pat_sanitize $port(name)]
949                        set pat "^${safefullname}$|^${safename}/$"
950                }
951               
952                set matches [array names bfull -regexp $pat]
953
954                # We copy this element to result only if it didn't match against b
955                if {![llength $matches]} {
956                        lappend result $aitem
957                }
958        }
959       
960        return $result
961}
962
963
964proc parseFullPortSpec { urlname namename vername varname optname } {
965        upvar $urlname porturl
966        upvar $namename portname
967        upvar $vername portversion
968        upvar $varname portvariants
969        upvar $optname portoptions
970       
971        set portname ""
972        set portversion ""
973        array unset portvariants
974        array unset portoptions
975       
976        if { [moreargs] } {
977                # Look first for a potential portname
978                #
979                # We need to allow a wide variaty of tokens here, because of actions like "provides"
980                # so we take a rather lenient view of what a "portname" is. We allow
981                # anything that doesn't look like either a version, a variant, or an option
982                set token [lookahead]
983
984                set remainder ""
985                if {![regexp {^(@|[-+]|[[:alpha:]_]+[\w\.]*=)} $token match]} {
986                        advance
987                        regexp {^([^@]+)(@.*)?} $token match portname remainder
988                       
989                        # If the portname contains a /, then try to use it as a URL
990                        if {[string match "*/*" $portname]} {
991                                set url "file://$portname"
992                                set name [url_to_portname $url 1]
993                                if { $name != "" } {
994                                        # We mapped the url to valid port
995                                        set porturl $url
996                                        set portname $name
997                                        # Continue to parse rest of portspec....
998                                } else {
999                                        # We didn't map the url to a port; treat it
1000                                        # as a raw string for something like port contents
1001                                        # or cd
1002                                        set porturl ""
1003                                        # Since this isn't a port, we don't try to parse
1004                                        # any remaining portspec....
1005                                        return
1006                                }
1007                        }
1008                }
1009               
1010                # Now parse the rest of the spec
1011                parsePortSpec portversion portvariants portoptions $remainder
1012        }
1013}
1014
1015       
1016proc parsePortSpec { vername varname optname {remainder ""} } {
1017        upvar $vername portversion
1018        upvar $varname portvariants
1019        upvar $optname portoptions
1020       
1021        global global_options
1022       
1023        set portversion ""
1024        array unset portoptions
1025        array set portoptions [array get global_options]
1026        array unset portvariants
1027       
1028        # Parse port version/variants/options
1029        set opt $remainder
1030        set adv 0
1031        set consumed 0
1032        for {set firstTime 1} {$opt != "" || [moreargs]} {set firstTime 0} {
1033       
1034                # Refresh opt as needed
1035                if {$opt == ""} {
1036                        if {$adv} advance
1037                        set opt [lookahead]
1038                        set adv 1
1039                        set consumed 0
1040                }
1041               
1042                # Version must be first, if it's there at all
1043                if {$firstTime && [string match {@*} $opt]} {
1044                        # Parse the version
1045                       
1046                        # Strip the @
1047                        set opt [string range $opt 1 end]
1048                       
1049                        # Handle the version
1050                        set sepPos [string first "/" $opt]
1051                        if {$sepPos >= 0} {
1052                                # Version terminated by "/" to disambiguate -variant from part of version
1053                                set portversion [string range $opt 0 [expr $sepPos-1]]
1054                                set opt [string range $opt [expr $sepPos+1] end]
1055                        } else {
1056                                # Version terminated by "+", or else is complete
1057                                set sepPos [string first "+" $opt]
1058                                if {$sepPos >= 0} {
1059                                        # Version terminated by "+"
1060                                        set portversion [string range $opt 0 [expr $sepPos-1]]
1061                                        set opt [string range $opt $sepPos end]
1062                                } else {
1063                                        # Unterminated version
1064                                        set portversion $opt
1065                                        set opt ""
1066                                }
1067                        }
1068                        set consumed 1
1069                } else {
1070                        # Parse all other options
1071                       
1072                        # Look first for a variable setting: VARNAME=VALUE
1073                        if {[regexp {^([[:alpha:]_]+[\w\.]*)=(.*)} $opt match key val] == 1} {
1074                                # It's a variable setting
1075                                set portoptions($key) "\"$val\""
1076                                set opt ""
1077                                set consumed 1
1078                        } elseif {[regexp {^([-+])([[:alpha:]_]+[\w\.]*)} $opt match sign variant] == 1} {
1079                                # It's a variant
1080                                set portvariants($variant) $sign
1081                                set opt [string range $opt [expr [string length $variant]+1] end]
1082                                set consumed 1
1083                        } else {
1084                                # Not an option we recognize, so break from port option processing
1085                                if { $consumed && $adv } advance
1086                                break
1087                        }
1088                }
1089        }
1090}
1091
1092
1093##########################################
1094# Action Handlers
1095##########################################
1096
1097proc action_usage { action portlist opts } {
1098        print_usage
1099        return 0
1100}
1101
1102
1103proc action_help { action portlist opts } {
1104        print_help
1105        return 0
1106}
1107
1108
1109proc action_info { action portlist opts } {
1110        set status 0
1111        require_portlist portlist
1112        foreachport $portlist { 
1113                # Get information about the named port
1114                if {[catch {dportsearch $portname no exact} result]} {
1115                        global errorInfo
1116                        ui_debug "$errorInfo"
1117                        break_softcontinue "search for portname $portname failed: $result" 1 status
1118                }
1119       
1120                if {$result == ""} {
1121                        puts "No port $portname found."
1122                } else {
1123                        set found [expr [llength $result] / 2]
1124                        if {$found > 1} {
1125                                ui_warn "Found $found port $portname definitions, displaying first one."
1126                        }
1127                        array set portinfo [lindex $result 1]
1128
1129                        puts -nonewline "$portinfo(name) $portinfo(version)"
1130                        if {[info exists portinfo(revision)] && $portinfo(revision) > 0} { 
1131                                puts -nonewline ", Revision $portinfo(revision)" 
1132                        }
1133                        puts -nonewline ", $portinfo(portdir)" 
1134                        if {[info exists portinfo(variants)]} {
1135                                puts -nonewline " (Variants: "
1136                                for {set i 0} {$i < [llength $portinfo(variants)]} {incr i} {
1137                                        if {$i > 0} { puts -nonewline ", " }
1138                                        puts -nonewline "[lindex $portinfo(variants) $i]"
1139                                }
1140                                puts -nonewline ")"
1141                        }
1142                        puts ""
1143                        if {[info exists portinfo(homepage)]} { 
1144                                puts "$portinfo(homepage)"
1145                        }
1146       
1147                        if {[info exists portinfo(long_description)]} {
1148                                puts "\n$portinfo(long_description)\n"
1149                        }
1150
1151                        # find build dependencies
1152                        if {[info exists portinfo(depends_build)]} {
1153                                puts -nonewline "Build Dependencies: "
1154                                for {set i 0} {$i < [llength $portinfo(depends_build)]} {incr i} {
1155                                        if {$i > 0} { puts -nonewline ", " }
1156                                        puts -nonewline "[lindex [split [lindex $portinfo(depends_build) $i] :] end]"
1157                                }
1158                                set nodeps false
1159                                puts ""
1160                        }
1161       
1162                        # find library dependencies
1163                        if {[info exists portinfo(depends_lib)]} {
1164                                puts -nonewline "Library Dependencies: "
1165                                for {set i 0} {$i < [llength $portinfo(depends_lib)]} {incr i} {
1166                                        if {$i > 0} { puts -nonewline ", " }
1167                                        puts -nonewline "[lindex [split [lindex $portinfo(depends_lib) $i] :] end]"
1168                                }
1169                                set nodeps false
1170                                puts ""
1171                        }
1172       
1173                        # find runtime dependencies
1174                        if {[info exists portinfo(depends_run)]} {
1175                                puts -nonewline "Runtime Dependencies: "
1176                                for {set i 0} {$i < [llength $portinfo(depends_run)]} {incr i} {
1177                                        if {$i > 0} { puts -nonewline ", " }
1178                                        puts -nonewline "[lindex [split [lindex $portinfo(depends_run) $i] :] end]"
1179                                }
1180                                set nodeps false
1181                                puts ""
1182                        }
1183                        if {[info exists portinfo(platforms)]} { puts "Platforms: $portinfo(platforms)"}
1184                        if {[info exists portinfo(maintainers)]} { puts "Maintainers: $portinfo(maintainers)"}
1185                }
1186        }
1187       
1188        return $status
1189}
1190
1191
1192proc action_location { action portlist opts } {
1193        set status 0
1194        require_portlist portlist
1195        foreachport $portlist {
1196                if { [catch {set ilist [registry_installed $portname [composite_version $portversion [array get variations]]]} result] } {
1197                        global errorInfo
1198                        ui_debug "$errorInfo"
1199                        break_softcontinue "port location failed: $result" 1 status
1200                } else {
1201                        set version [lindex $ilist 1]
1202                        set revision [lindex $ilist 2]
1203                        set     variants [lindex $ilist 3]
1204                }
1205
1206                set ref [registry::open_entry $portname $version $revision $variants]
1207                if { [string equal [registry::property_retrieve $ref installtype] "image"] } {
1208                        set imagedir [registry::property_retrieve $ref imagedir]
1209                        puts "Port $portname ${version}_${revision}${variants} is installed as an image in:"
1210                        puts $imagedir
1211                } else {
1212                        break_softcontinue "Port $portname is not installed as an image." 1 status
1213                }
1214        }
1215       
1216        return $status
1217}
1218
1219
1220proc action_provides { action portlist opts } {
1221        # In this case, portname is going to be used for the filename... since
1222        # that is the first argument we expect... perhaps there is a better way
1223        # to do this?
1224        if { ![llength $portlist] } {
1225                ui_error "Please specify a filename to check which port provides that file."
1226                return 1
1227        }
1228        foreachport $portlist {
1229                set file [compat filenormalize $portname]
1230                if {[file exists $file]} {
1231                        if {![file isdirectory $file]} {
1232                                set port [registry::file_registered $file] 
1233                                if { $port != 0 } {
1234                                        puts "$file is provided by: $port"
1235                                } else {
1236                                        puts "$file is not provided by a DarwinPorts port."
1237                                }
1238                        } else {
1239                                puts "$file is a directory."
1240                        }
1241                } else {
1242                        puts "$file does not exist."
1243                }
1244        }
1245       
1246        return 0
1247}
1248
1249
1250proc action_activate { action portlist opts } {
1251        set status 0
1252        require_portlist portlist
1253        foreachport $portlist {
1254                if { [catch {portimage::activate $portname [composite_version $portversion [array get variations]] [array get options]} result] } {
1255                        global errorInfo
1256                        ui_debug "$errorInfo"
1257                        break_softcontinue "port activate failed: $result" 1 status
1258                }
1259        }
1260       
1261        return $status
1262}
1263
1264
1265proc action_deactivate { action portlist opts } {
1266        set status 0
1267        require_portlist portlist
1268        foreachport $portlist {
1269                if { [catch {portimage::deactivate $portname [composite_version $portversion [array get variations]] [array get options]} result] } {
1270                        global errorInfo
1271                        ui_debug "$errorInfo"
1272                        break_softcontinue "port deactivate failed: $result" 1 status
1273                }
1274        }
1275       
1276        return $status
1277}
1278
1279
1280proc action_selfupdate { action portlist opts } {
1281        if { [catch {darwinports::selfupdate [array get global_options]} result ] } {
1282                global errorInfo
1283                ui_debug "$errorInfo"
1284                fatal "selfupdate failed: $result"
1285        }
1286       
1287        return 0
1288}
1289
1290
1291proc action_upgrade { action portlist opts } {
1292        require_portlist portlist
1293        foreachport $portlist {
1294                # Merge global variations into the variations specified for this port
1295                foreach { variation value } [array get global_variations] {
1296                        if { ![info exists variations($variation)] } {
1297                                set variations($variation) $value
1298                        }
1299                }
1300               
1301                darwinports::upgrade $portname "port:$portname" [array get variations] [array get options]
1302        }
1303       
1304        return 0
1305}
1306
1307
1308proc action_version { action portlist opts } {
1309        puts "Version: [darwinports::version]"
1310        return 0
1311}
1312
1313
1314proc action_compact { action portlist opts } {
1315        set status 0
1316        require_portlist portlist
1317        foreachport $portlist {
1318                if { [catch {portimage::compact $portname [composite_version $portversion [array get variations]]} result] } {
1319                        global errorInfo
1320                        ui_debug "$errorInfo"
1321                        break_softcontinue "port compact failed: $result" 1 status
1322                }
1323        }
1324
1325        return $status
1326}
1327
1328
1329proc action_uncompact { action portlist opts } {
1330        set status 0
1331        require_portlist portlist
1332        foreachport $portlist {
1333                if { [catch {portimage::uncompact $portname [composite_version $portversion [array get variations]]} result] } {
1334                        global errorInfo
1335                        ui_debug "$errorInfo"
1336                        break_softcontinue "port uncompact failed: $result" 1 status
1337                }
1338        }
1339       
1340        return $status
1341}
1342
1343
1344
1345proc action_dependents { action portlist opts } {
1346        require_portlist portlist
1347        foreachport $portlist {
1348                registry::open_dep_map
1349                set deplist [registry::list_dependents $portname]
1350
1351                if { [llength $deplist] > 0 } {
1352                        set dl [list]
1353                        # Check the deps first
1354                        foreach dep $deplist {
1355                                set depport [lindex $dep 2]
1356                                ui_msg "$depport depends on $portname"
1357                                # xxx: Should look at making registry::installed return 0 or
1358                                # something instead  of erroring.
1359                                if { ![catch {set installed [registry::installed $depport]} res] } {
1360                                        if { [llength [registry::installed $depport]] > 0 } {
1361                                                lappend dl $depport
1362                                        }
1363                                }
1364                        }
1365                } else {
1366                        ui_msg "$portname has no dependents!"
1367                }
1368        }
1369}
1370
1371
1372proc action_uninstall { action portlist opts } {
1373        set status 0
1374        if {[info exists global_options(port_uninstall_old)]} {
1375                # if -u then uninstall all inactive ports
1376                # (union these to any other ports user has in the port list)
1377                set portlist [opUnion $portlist [get_inactive_ports]]
1378        } else {
1379                # Otherwise the user had better have supplied a portlist, or we'll default to the existing directory
1380                require_portlist portlist
1381        }
1382
1383        foreachport $portlist {
1384                if { [catch {portuninstall::uninstall $portname [composite_version $portversion [array get variations]] [array get options]} result] } {
1385                        global errorInfo
1386                        ui_debug "$errorInfo"
1387                        break_softcontinue "port uninstall failed: $result" 1 status
1388                }
1389        }
1390       
1391        return 0
1392}
1393
1394
1395proc action_installed { action portlist opts } {
1396        set status 0
1397        if { [llength $portlist] } {
1398                set ilist {}
1399                foreachport $portlist {
1400                        set composite_version [composite_version $portversion [array get variations]]
1401                        if { [catch {set ilist [concat $ilist [registry::installed $portname $composite_version]]} result] } {
1402                                if {[string match "* not registered as installed." $result]} {
1403                                        puts "Port $portname is not installed."
1404                                } else {
1405                                        global errorInfo
1406                                        ui_debug "$errorInfo"
1407                                        break_softcontinue "port installed failed: $result" 1 status
1408                                }
1409                        }
1410                }
1411        } else {
1412                if { [catch {set ilist [registry::installed]} result] } {
1413                        if {$result == "Registry error: No ports registered as installed."} {
1414                                set ilist {}
1415                                puts "No ports are installed!"
1416                        } else {
1417                                global errorInfo
1418                                ui_debug "$errorInfo"
1419                                ui_error "port installed failed: $result"
1420                                set status 1
1421                        }
1422                }
1423        }
1424        if { [llength $ilist] > 0 } {
1425                puts "The following ports are currently installed:"
1426                foreach i $ilist {
1427                        set iname [lindex $i 0]
1428                        set iversion [lindex $i 1]
1429                        set irevision [lindex $i 2]
1430                        set ivariants [lindex $i 3]
1431                        set iactive [lindex $i 4]
1432                        if { $iactive == 0 } {
1433                                puts "  $iname @${iversion}_${irevision}${ivariants}"
1434                        } elseif { $iactive == 1 } {
1435                                puts "  $iname @${iversion}_${irevision}${ivariants} (active)"
1436                        }
1437                }
1438        } else {
1439                puts "No ports are installed."
1440        }
1441       
1442        return $status
1443}
1444
1445
1446proc action_outdated { action portlist opts } {
1447        set status 0
1448        # If port names were supplied, limit ourselves to those port, else check all installed ports
1449        if { [llength $portlist] } {
1450                set ilist {}
1451                foreach portspec $portlist {
1452                        array set port $portspec
1453                        set portname $port(name)
1454                        set composite_version [composite_version $port(version) $port(variants)]
1455                        if { [catch {set ilist [concat $ilist [registry::installed $portname $composite_version]]} result] } {
1456                                if {![string match "* not registered as installed." $result]} {
1457                                        global errorInfo
1458                                        ui_debug "$errorInfo"
1459                                        break_softcontinue "port outdated failed: $result" 1 status
1460                                }
1461                        }
1462                }
1463        } else {
1464                if { [catch {set ilist [registry::installed]} result] } {
1465                        global errorInfo
1466                        ui_debug "$errorInfo"
1467                        ui_error "port outdated failed: $result"
1468                        set status 1
1469                }
1470        }
1471
1472        if { [llength $ilist] > 0 } {
1473                puts "The following installed ports are outdated:"
1474       
1475                foreach i $ilist { 
1476
1477                        # Get information about the installed port
1478                        set portname                    [lindex $i 0]
1479                        set installed_version   [lindex $i 1]
1480                        set installed_revision  [lindex $i 2]
1481                        set installed_compound  "${installed_version}_${installed_revision}"
1482
1483                        set is_active                   [lindex $i 4]
1484                        if { $is_active == 0 } {
1485                                continue
1486                        }
1487                        set installed_epoch             [lindex $i 5]
1488
1489                        # Get info about the port from the index
1490                        if {[catch {set res [dportsearch $portname no exact]} result]} {
1491                                global errorInfo
1492                                ui_debug "$errorInfo"
1493                                break_softcontinue "search for portname $portname failed: $result" 1 status
1494                        }
1495                        if {[llength $res] < 2} {
1496                                if {[ui_isset ports_debug]} {
1497                                        puts "$portname ($installed_compound is installed; the port was not found in the port index)"
1498                                }
1499                                continue
1500                        }
1501                        array set portinfo [lindex $res 1]
1502                       
1503                        # Get information about latest available version and revision
1504                        set latest_version $portinfo(version)
1505                        set latest_revision             0
1506                        if {[info exists portinfo(revision)] && $portinfo(revision) > 0} { 
1507                                set latest_revision     $portinfo(revision)
1508                        }
1509                        set latest_compound             "${latest_version}_${latest_revision}"
1510                        set latest_epoch                0
1511                        if {[info exists portinfo(epoch)]} { 
1512                                set latest_epoch        $portinfo(epoch)
1513                        }
1514                       
1515                        # Compare versions, first checking epoch, then the compound version string
1516                        set comp_result [expr $installed_epoch - $latest_epoch]
1517                        if { $comp_result == 0 } {
1518                                set comp_result [rpm-vercomp $installed_compound $latest_compound]
1519                        }
1520                       
1521                        # Report outdated (or, for verbose, predated) versions
1522                        if { $comp_result != 0 } {
1523                                                       
1524                                # Form a relation between the versions
1525                                set flag ""
1526                                if { $comp_result > 0 } {
1527                                        set relation ">"
1528                                        set flag "!"
1529                                } else {
1530                                        set relation "<"
1531                                }
1532                               
1533                                # Emit information
1534                                if {$comp_result < 0 || [ui_isset ports_verbose]} {
1535                                        puts [format "%-30s %-24s %1s" $portname "$installed_compound $relation $latest_compound" $flag]
1536                                }
1537                               
1538                        }
1539                }
1540        } else {
1541                puts "No installed ports are outdated."
1542        }
1543       
1544        return $status
1545}
1546
1547
1548proc action_contents { action portlist opts } {
1549        set status 0
1550        require_portlist portlist
1551        foreachport $portlist {
1552                set files [registry::port_registered $portname]
1553                if { $files != 0 } {
1554                        if { [llength $files] > 0 } {
1555                                puts "Port $portname contains:"
1556                                foreach file $files {
1557                                        puts "  $file"
1558                                }
1559                        } else {
1560                                puts "Port $portname does not contain any file or is not active."
1561                        }
1562                } else {
1563                        puts "Port $portname is not installed."
1564                }
1565        }
1566       
1567        return $status
1568}
1569
1570
1571proc action_deps { action portlist opts } {
1572        set status 0
1573        require_portlist portlist
1574        foreachport $portlist {
1575                # Get info about the port
1576                if {[catch {dportsearch $portname no exact} result]} {
1577                        global errorInfo
1578                        ui_debug "$errorInfo"
1579                        break_softcontinue "search for portname $portname failed: $result" 1 status
1580                }
1581
1582                if {$result == ""} {
1583                        break_softcontinue "No port $portname found." 1 status
1584                }
1585
1586                array set portinfo [lindex $result 1]
1587
1588                set depstypes {depends_build depends_lib depends_run}
1589                set depstypes_descr {"build" "library" "runtime"}
1590
1591                set nodeps true
1592                foreach depstype $depstypes depsdecr $depstypes_descr {
1593                        if {[info exists portinfo($depstype)] &&
1594                                $portinfo($depstype) != ""} {
1595                                puts "$portname has $depsdecr dependencies on:"
1596                                foreach i $portinfo($depstype) {
1597                                        puts "\t[lindex [split [lindex $i 0] :] end]"
1598                                }
1599                                set nodeps false
1600                        }
1601                }
1602               
1603                # no dependencies found
1604                if {$nodeps == "true"} {
1605                        puts "$portname has no dependencies"
1606                }
1607        }
1608       
1609        return $status
1610}
1611
1612
1613proc action_variants { action portlist opts } {
1614        set status 0
1615        require_portlist portlist
1616        foreachport $portlist {
1617                # search for port
1618                if {[catch {dportsearch $portname no exact} result]} {
1619                        global errorInfo
1620                        ui_debug "$errorInfo"
1621                        break_softcontinue "search for portname $portname failed: $result" 1 status
1622                }
1623       
1624                if {$result == ""} {
1625                        puts "No port $portname found."
1626                }
1627       
1628                array set portinfo [lindex $result 1]
1629       
1630                # if this fails the port doesn't have any variants
1631                if {![info exists portinfo(variants)]} {
1632                        puts "$portname has no variants"
1633                } else {
1634                        # print out all the variants
1635                        puts "$portname has the variants:"
1636                        for {set i 0} {$i < [llength $portinfo(variants)]} {incr i} {
1637                                puts "\t[lindex $portinfo(variants) $i]"
1638                        }
1639                }
1640        }
1641       
1642        return $status
1643}
1644
1645
1646proc action_search { action portlist opts } {
1647        set status 0
1648        if {![llength portlist]} {
1649                ui_error "You must specify a search pattern"
1650                return 1
1651        }
1652       
1653        foreachport $portlist {
1654                set portfound 0
1655                if {[catch {set res [dportsearch $portname no]} result]} {
1656                        global errorInfo
1657                        ui_debug "$errorInfo"
1658                        break_softcontinue "search for portname $portname failed: $result" 1 status
1659                }
1660                foreach {name array} $res {
1661                        array set portinfo $array
1662
1663                        # XXX is this the right place to verify an entry?
1664                        if {![info exists portinfo(name)]} {
1665                                puts "Invalid port entry, missing portname"
1666                                continue
1667                        }
1668                        if {![info exists portinfo(description)]} {
1669                                puts "Invalid port entry for $portinfo(name), missing description"
1670                                continue
1671                        }
1672                        if {![info exists portinfo(version)]} {
1673                                puts "Invalid port entry for $portinfo(name), missing version"
1674                                continue
1675                        }
1676                        if {![info exists portinfo(portdir)]} {
1677                                set output [format "%-30s %-12s %s" $portinfo(name) $portinfo(version) $portinfo(description)]
1678                        } else {
1679                                set output [format "%-30s %-14s %-12s %s" $portinfo(name) $portinfo(portdir) $portinfo(version) $portinfo(description)]
1680                        }
1681                        set portfound 1
1682                        puts $output
1683                        unset portinfo
1684                }
1685                if { !$portfound } {
1686                        ui_msg "No match for $portname found"
1687                }
1688        }
1689       
1690        return $status
1691}
1692
1693
1694proc action_list { action portlist opts } {
1695        set status 0
1696
1697        # Default to list all ports if no portnames are supplied
1698        if {![llength $portlist]} {
1699                add_to_portlist portlist [list name "-all-"]
1700        }
1701       
1702        foreachport $portlist {
1703                if {$portname == "-all-"} {
1704                        set search_string ".+"
1705                } else {
1706                        set search_string [regex_pat_sanitize $portname]
1707                }
1708               
1709                if {[catch {set res [dportsearch ^$search_string\$ no]} result]} {
1710                        global errorInfo
1711                        ui_debug "$errorInfo"
1712                        break_softcontinue "search for portname $search_string failed: $result" 1 status
1713                }
1714
1715                foreach {name array} $res {
1716                        array set portinfo $array
1717                        set outdir ""
1718                        if {[info exists portinfo(portdir)]} {
1719                                set outdir $portinfo(portdir)
1720                        }
1721                        puts [format "%-30s @%-14s %s" $portinfo(name) $portinfo(version) $outdir]
1722                }
1723        }
1724       
1725        return $status
1726}
1727
1728
1729proc action_echo { action portlist opts } {
1730        # Simply echo back the port specs given to this command
1731        foreachport $portlist {
1732                set opts {}
1733                foreach { key value } [array get options] {
1734                        lappend opts "$key=$value"
1735                }
1736               
1737                set composite_version [composite_version $portversion [array get variations] 1]
1738                if { $composite_version != "" } {
1739                        set ver_field "@$composite_version"
1740                } else {
1741                        set ver_field ""
1742                }
1743                puts [format "%-30s %s %s" $portname $ver_field  [join $opts " "]]
1744        }
1745       
1746        return 0
1747}
1748
1749
1750proc action_portcmds { action portlist opts } {
1751        # Operations on the port's directory and Portfile
1752        global env, boot_env
1753        global current_portdir
1754       
1755        set status 0
1756        require_portlist portlist
1757        foreachport $portlist {
1758                # If we have a url, use that, since it's most specific
1759                # otherwise try to map the portname to a url
1760                if {$porturl == ""} {
1761                        # Verify the portname, getting portinfo to map to a porturl
1762                        if {[catch {set res [dportsearch $portname no exact]} result]} {
1763                                global errorInfo
1764                                ui_debug "$errorInfo"
1765                                break_softcontinue "search for portname $portname failed: $result" 1 status
1766                        }
1767                        if {[llength $res] < 2} {
1768                                break_softcontinue "Port $portname not found" 1 status
1769                        }
1770                        array set portinfo [lindex $res 1]
1771                        set porturl $portinfo(porturl)
1772                }
1773               
1774                set portdir [file normalize [darwinports::getportdir $porturl]]
1775                set porturl "file://${portdir}";        # Rebuild url so it's fully qualified
1776                set portfile "${portdir}/Portfile"
1777               
1778                if {[file readable $portfile]} {
1779                        switch -- $action {
1780                                cat     {
1781                                        # Copy the portfile to standard output
1782                                        set f [open $portfile RDONLY]
1783                                        while { ![eof $f] } {
1784                                                puts [read $f 4096]
1785                                        }
1786                                        close $f
1787                                }
1788                               
1789                                ed - edit {
1790                                        # Edit the port's portfile with the user's editor
1791                                       
1792                                        # Restore our entire environment from start time.
1793                                        # We need it to evaluate the editor, and the editor
1794                                        # may want stuff from it as well, like TERM.
1795                                        array unset env_save; array set env_save [array get env]
1796                                        array unset env *; array set env [array get boot_env]
1797                                       
1798                                        # Find an editor to edit the portfile
1799                                        set editor ""
1800                                        foreach ed { VISUAL EDITOR } {
1801                                                if {[info exists env($ed)]} {
1802                                                        set editor $env($ed)
1803                                                        break
1804                                                }
1805                                        }
1806                                       
1807                                        # Invoke the editor
1808                                        if { $editor == "" } {
1809                                                break_softcontinue "No EDITOR is specified in your environment" 1 status
1810                                        } else {
1811                                                if {[catch {eval exec >/dev/stdout </dev/stdin $editor $portfile} result]} {
1812                                                        global errorInfo
1813                                                        ui_debug "$errorInfo"
1814                                                        break_softcontinue "unable to invoke editor $editor: $result" 1 status
1815                                                }
1816                                        }
1817                                       
1818                                        # Restore internal dp environment
1819                                        array unset env *; array set env [array get env_save]
1820                                }
1821                               
1822                                dir {
1823                                        # output the path to the port's directory
1824                                        puts $portdir
1825                                }
1826                               
1827                                cd {
1828                                        # Change to the port's directory, making it the default
1829                                        # port for any future commands
1830                                        set current_portdir $portdir
1831                                }
1832
1833                                url {
1834                                        # output the url of the port's directory, suitable to feed back in later as a port descriptor
1835                                        puts $porturl
1836                                }
1837
1838                                file {
1839                                        # output the path to the port's portfile
1840                                        puts $portfile
1841                                }
1842                        }
1843                } else {
1844                        break_softcontinue "Could not read $portfile" 1 status
1845                }
1846        }
1847       
1848        return $status
1849}
1850
1851
1852proc action_sync { action portlist opts } {
1853        set status 0
1854        if {[catch {dportsync} result]} {
1855                global errorInfo
1856                ui_debug "$errorInfo"
1857                ui_msg "port sync failed: $result"
1858                set status 1
1859        }
1860       
1861        return $status
1862}
1863
1864
1865proc action_target { action portlist opts } {
1866        set status 0
1867        require_portlist portlist
1868        foreachport $portlist {
1869                set target $action
1870
1871                # If we have a url, use that, since it's most specific
1872                # otherwise try to map the portname to a url
1873                if {$porturl == ""} {
1874                        # Verify the portname, getting portinfo to map to a porturl
1875                        if {[catch {set res [dportsearch $portname no exact]} result]} {
1876                                global errorInfo
1877                                ui_debug "$errorInfo"
1878                                break_softcontinue "search for portname $portname failed: $result" 1 status
1879                        }
1880                        if {[llength $res] < 2} {
1881                                break_softcontinue "Port $portname not found" 1 status
1882                        }
1883                        array set portinfo [lindex $res 1]
1884                        set porturl $portinfo(porturl)
1885                }
1886               
1887                # If this is the install target, add any global_variations to the variations
1888                # specified for the port
1889                if { $target == "install" } {
1890                        foreach { variation value } [array get global_variations] {
1891                                if { ![info exists variations($variation)] } {
1892                                        set variations($variation) $value
1893                                }
1894                        }
1895                }
1896
1897                # If version was specified, save it as a version glob for use
1898                # in port actions (e.g. clean).
1899                if {[string length $portversion]} {
1900                        set options(ports_version_glob) $portversion
1901                }
1902                if {[catch {set workername [dportopen $porturl [array get options] [array get variations]]} result]} {
1903                        global errorInfo
1904                        ui_debug "$errorInfo"
1905                        break_softcontinue "Unable to open port: $result" 1 status
1906                }
1907                if {[catch {set result [dportexec $workername $target]} result]} {
1908                        global errorInfo
1909                        dportclose $workername
1910                        ui_debug "$errorInfo"
1911                        break_softcontinue "Unable to execute port: $result" 1 status
1912                }
1913
1914                dportclose $workername
1915               
1916                # Process any error that wasn't thrown and handled already
1917                if {$result} {
1918                        break_softcontinue "Status $result encountered during processing." 1 status
1919                }
1920        }
1921       
1922        return $status
1923}
1924
1925
1926proc action_exit { action portlist opts } {
1927        # Return a semaphore telling the main loop to quit
1928        return -999
1929}
1930
1931
1932##########################################
1933# Command Parsing
1934##########################################
1935proc moreargs {} {
1936        global cmd_argn cmd_argc
1937        return [expr {$cmd_argn < $cmd_argc}]
1938}
1939
1940
1941proc lookahead {} {
1942        global cmd_argn cmd_argc cmd_argv
1943        if {$cmd_argn < $cmd_argc} {
1944                return [lindex $cmd_argv $cmd_argn]
1945        } else {
1946                return _EOF_
1947        }
1948}
1949
1950
1951proc advance {} {
1952        global cmd_argn
1953        incr cmd_argn
1954}
1955
1956
1957proc match s {
1958        if {[lookahead] == $s} {
1959                advance
1960                return 1
1961        }
1962        return 0
1963}
1964
1965
1966global action_array
1967array set action_array {
1968        usage           action_usage
1969        help            action_help
1970
1971        echo            action_echo
1972       
1973        info            action_info
1974        location        action_location
1975        provides        action_provides
1976       
1977        activate        action_activate
1978        deactivate      action_deactivate
1979       
1980        selfupdate      action_selfupdate
1981        upgrade         action_upgrade
1982       
1983        version         action_version
1984        compact         action_compact
1985        uncompact       action_uncompact
1986       
1987        uninstall       action_uninstall
1988       
1989        installed       action_installed
1990        outdated        action_outdated
1991        contents        action_contents
1992        dependents      action_dependents
1993        deps            action_deps
1994        variants        action_variants
1995       
1996        search          action_search
1997        list            action_list
1998       
1999        ed                      action_portcmds
2000        edit            action_portcmds
2001        cat                     action_portcmds
2002        dir                     action_portcmds
2003        cd                      action_portcmds
2004        url                     action_portcmds
2005        file            action_portcmds
2006       
2007        depends         action_target
2008        fetch           action_target
2009        checksum        action_target
2010        extract         action_target
2011        patch           action_target
2012        configure       action_target
2013        build           action_target
2014        destroot        action_target
2015        install         action_target
2016        clean           action_target
2017        test            action_target
2018        submit          action_target
2019        trace           action_target
2020        livecheck       action_target
2021
2022        archive         action_target
2023        unarchive       action_target
2024        dmg                     action_target
2025        dpkg            action_target
2026        mpkg            action_target
2027        pkg                     action_target
2028        rpmpackage      action_target
2029
2030        quit            action_exit
2031        exit            action_exit
2032}
2033
2034
2035proc find_action_proc { action } {
2036        global action_array
2037       
2038        set action_proc ""
2039        if { [info exists action_array($action)] } {
2040                set action_proc $action_array($action)
2041        }
2042       
2043        return $action_proc
2044}
2045
2046
2047# Parse global options
2048#
2049# Note that this is called several times:
2050#       (1) Initially, to parse options that will be constant across all commands
2051#               (options that come prior to any command, frozen into global_options_base)
2052#       (2) Following each command (to parse options that will be unique to that command
2053#               (the global_options array is reset to global_options_base prior to each command)
2054#
2055proc parse_options { action_name ui_options_name global_options_name } {
2056        upvar $action_name action
2057        upvar $ui_options_name ui_options
2058        upvar $global_options_name global_options
2059       
2060        while {[moreargs]} {
2061                set arg [lookahead]
2062               
2063                if {[string index $arg 0] != "-"} {
2064                        break
2065                } elseif {[string index $arg 1] == "-"} {
2066                        # Process long arguments
2067                        switch -- $arg {
2068                                --                      { # This is the options terminator; do no further option processing
2069                                                          advance; break
2070                                                        }
2071                                --version       { ui_warn "(please use \"$cmdname version\" to get version information)"; set action "version" }
2072                                default         {
2073                                                          set key [string range $arg 2 end]
2074                                                          set global_options(ports_${action}_${key}) yes
2075                                                        }
2076                        }
2077                } else {
2078                        # Process short arg(s)
2079                        set opts [string range $arg 1 end]
2080                        foreach c [split $opts {}] {
2081                                switch -- $c {
2082                                        v {     set ui_options(ports_verbose) yes                       }
2083                                        d { set ui_options(ports_debug) yes
2084                                                # debug implies verbose
2085                                                set ui_options(ports_verbose) yes
2086                                          }
2087                                        q { set ui_options(ports_quiet) yes
2088                                                set ui_options(ports_verbose) no
2089                                                set ui_options(ports_debug) no
2090                                          }
2091                                        i { # Always go to interactive mode
2092                                                lappend ui_options(ports_commandfiles) -        }
2093                                        p { # Ignore errors while processing within a command
2094                                                set ui_options(ports_processall) yes            }
2095                                        x { # Exit with error from any command while in batch/interactive mode
2096                                                set ui_options(ports_exit) yes                          }
2097                                       
2098                                        f { set global_options(ports_force) yes                 }
2099                                        o { set global_options(ports_ignore_older) yes  }
2100                                        n { set global_options(ports_nodeps) yes                }
2101                                        u { set global_options(port_uninstall_old) yes  }
2102                                        R { set global_options(ports_do_dependents) yes }
2103                                        s { set global_options(ports_source_only) yes   }
2104                                        b { set global_options(ports_binary_only) yes   }
2105                                        c { set global_options(ports_autoclean) yes             }
2106                                        k { set global_options(ports_autoclean) no              }
2107                                        t { set global_options(ports_trace) yes                 }
2108                                        F { # Name a command file to process
2109                                                advance
2110                                                if {[moreargs]} {
2111                                                        lappend ui_options(ports_commandfiles) [lookahead]
2112                                                }
2113                                          }
2114                                        D { advance
2115                                                if {[moreargs]} {
2116                                                        cd [lookahead]
2117                                                }
2118                                                break
2119                                          }
2120                                        default {
2121                                                print_usage; exit 1
2122                                          }
2123                                }
2124                        }
2125                }
2126               
2127                advance
2128        }
2129}
2130
2131
2132proc process_cmd { argv } {
2133        global cmd_argc cmd_argv cmd_argn
2134        global global_options global_options_base
2135        global current_portdir
2136        set cmd_argv $argv
2137        set cmd_argc [llength $argv]
2138        set cmd_argn 0
2139
2140        set action_status 0
2141
2142        # Process an action if there is one
2143        while {$action_status == 0 && [moreargs]} {
2144                set action [lookahead]
2145                advance
2146               
2147                # Handle command separator
2148                if { $action == ";" } {
2149                        continue
2150                }
2151               
2152                # Handle a comment
2153                if { [string index $action 0] == "#" } {
2154                        while { [moreargs] } { advance }
2155                        break
2156                }
2157               
2158                # Always start out processing an action in current_portdir
2159                cd $current_portdir
2160               
2161                # Reset global_options from base before each action, as we munge it just below...
2162                array set global_options $global_options_base
2163               
2164                # Parse options that will be unique to this action
2165                # (to avoid abiguity with -variants and a default port, either -- must be
2166                # used to terminate option processing, or the pseudo-port current must be specified).
2167                parse_options action ui_options global_options
2168               
2169                # Parse port specifications into portlist
2170                set portlist {}
2171                if {![portExpr portlist]} {
2172                        ui_error "Improper expression syntax while processing parameters"
2173                        set action_status 1
2174                        break
2175                }
2176
2177                # Find an action to execute
2178                set action_proc [find_action_proc $action]
2179                if { $action_proc != "" } {
2180                        set action_status [$action_proc $action $portlist [array get global_options]]
2181                } else {
2182                        puts "Unrecognized action \"$action\""
2183                        set action_status 1
2184                }
2185               
2186                # semaphore to exit
2187                if {$action_status == -999} break
2188
2189                # If we're not in exit mode then ignore the status from the command
2190                if { ![ui_isset ports_exit] } {
2191                        set action_status 0
2192                }
2193        }
2194       
2195        return $action_status
2196}
2197
2198
2199proc complete_portname { text state } { 
2200        global action_array
2201        global complete_choices complete_position
2202       
2203        if {$state == 0} {
2204                set complete_position 0
2205                set complete_choices {}
2206
2207                # Build a list of ports with text as their prefix
2208                if {[catch {set res [dportsearch "${text}*" false glob]} result]} {
2209                        global errorInfo
2210                        ui_debug "$errorInfo"
2211                        fatal "search for portname $pattern failed: $result"
2212                }
2213                foreach {name info} $res {
2214                        lappend complete_choices $name
2215                }
2216        }
2217       
2218        set word [lindex $complete_choices $complete_position]
2219        incr complete_position
2220       
2221        return $word
2222}
2223
2224
2225proc complete_action { text state } {   
2226        global action_array
2227        global complete_choices complete_position
2228       
2229        if {$state == 0} {
2230                set complete_position 0
2231                set complete_choices [array names action_array "[string tolower $text]*"]
2232        }
2233       
2234        set word [lindex $complete_choices $complete_position]
2235        incr complete_position
2236       
2237        return $word
2238}
2239
2240
2241proc attempt_completion { text word start end } {
2242        # If the word starts with '~', or contains '.' or '/', then use the build-in
2243        # completion to complete the word
2244        if { [regexp {^~|[/.]} $word] } {
2245                return ""
2246        }
2247
2248        # Decide how to do completion based on where we are in the string
2249        set prefix [string range $text 0 [expr $start - 1]]
2250       
2251        # If only whitespace characters preceed us, or if the
2252        # previous non-whitespace character was a ;, then we're
2253        # an action (the first word of a command)
2254        if { [regexp {(^\s*$)|(;\s*$)} $prefix] } {
2255                return complete_action
2256        }
2257       
2258        # Otherwise, do completion on portname
2259        return complete_portname
2260}
2261
2262
2263proc get_next_cmdline { in out use_readline prompt linename } {
2264        upvar $linename line
2265       
2266        set line ""
2267        while { $line == "" } {
2268       
2269                if {$use_readline} {
2270                        set len [readline read -attempted_completion attempt_completion line $prompt]
2271                } else {
2272                        puts -nonewline $out $prompt
2273                        set len [gets $in line]
2274                }
2275               
2276                if { $len < 0 } {
2277                        return -1
2278                }
2279               
2280                set line [string trim $line]
2281               
2282                if { $use_readline && $line != "" } {
2283                        rl_history add $line
2284                }
2285        }
2286       
2287        return [llength $line]
2288}
2289
2290
2291proc process_command_file { in } {
2292        global current_portdir
2293
2294        # Initialize readline
2295        set isstdin [string match $in "stdin"]
2296        set name "port"
2297        set use_readline [expr $isstdin && [readline init $name]]
2298        set history_file [file normalize "~/.${name}_history"]
2299       
2300        # Read readline history
2301        if {$use_readline} {
2302                rl_history read $history_file
2303                rl_history stifle 100
2304        }
2305       
2306        # Be noisy, if appropriate
2307        set noisy [expr $isstdin && ![ui_isset ports_quiet]]
2308        if { $noisy } {
2309                puts "DarwinPorts [darwinports::version]"
2310                puts "Entering interactive mode... (\"help\" for help)"
2311        }
2312       
2313        # Main command loop
2314        set exit_status 0
2315        while { $exit_status == 0 } {
2316       
2317                # Calculate our prompt
2318                if { $noisy } {
2319                        set shortdir [eval file join [lrange [file split $current_portdir] end-1 end]]
2320                        set prompt "\[$shortdir\] > "
2321                } else {
2322                        set prompt ""
2323                }
2324               
2325                # Get a command line
2326                if { [get_next_cmdline $in stdout $use_readline $prompt line] <= 0  } {
2327                        puts ""
2328                        break
2329                }
2330               
2331                # Process the command
2332                set exit_status [process_cmd $line]
2333               
2334                # Check for semaphore to exit
2335                if {$exit_status == -999} break
2336               
2337                # Ignore status unless we're in error-exit mode
2338                if { ![ui_isset ports_exit] } {
2339                        set exit_status 0
2340                }
2341        }
2342       
2343        # Save readine history
2344        if {$use_readline} {
2345                rl_history write $history_file
2346        }
2347       
2348        # Say goodbye
2349        if { $noisy } {
2350                puts "Goodbye"
2351        }
2352       
2353        return $exit_status
2354}
2355
2356
2357proc process_command_files { filelist } {
2358        set exit_status 0
2359       
2360        # For each file in the command list, process commands
2361        # in the file
2362        foreach file $filelist {
2363                if {$file == "-"} {
2364                        set in stdin
2365                } else {
2366                       
2367                        if {[catch {set in [open $file]} result]} {
2368                                fatal "Failed to open command file; $result"
2369                        }
2370                       
2371                }
2372               
2373                set exit_status [process_command_file $in]
2374               
2375                if {$in != "stdin"} {
2376                        close $in
2377                }
2378
2379                # Check for semaphore to exit
2380                if {$exit_status == -999} {
2381                        set exit_status 0
2382                        break
2383                }
2384               
2385                # Ignore status unless we're in error-exit mode
2386                if { ![ui_isset ports_exit] } {
2387                        set exit_status 0
2388                }
2389        }
2390       
2391        return $exit_status
2392}
2393
2394
2395##########################################
2396# Main
2397##########################################
2398
2399# globals
2400array set ui_options            {}
2401array set global_options        {}
2402array set global_variations     {}
2403
2404# Save off a copy of the environment before dportinit monkeys with it
2405global env boot_env
2406array set boot_env [array get env]
2407
2408global argv0
2409global cmdname
2410set cmdname [file tail $argv0]
2411
2412# Setp cmd_argv to match argv
2413global argc argv
2414global cmd_argc cmd_argv cmd_argn
2415set cmd_argv $argv
2416set cmd_argc $argc
2417set cmd_argn 0
2418
2419# If we've been invoked as portf, then the first argument is assumed
2420# to be the name of a command file (i.e., there is an implicit -F
2421# before any arguments).
2422if {[moreargs] && $cmdname == "portf"} {
2423        lappend ui_options(ports_commandfiles) [lookahead]
2424        advance
2425}
2426
2427# Parse global options that will affect all subsequent commands
2428parse_options default_action ui_options global_options
2429
2430# Get arguments remaining after option processing
2431set remaining_args [lrange $cmd_argv $cmd_argn end]
2432
2433# Initialize dport
2434# This must be done following parse of global options, as some options are
2435# evaluated by dportinit.
2436if {[catch {dportinit ui_options global_options global_variations} result]} {
2437        global errorInfo
2438        puts "$errorInfo"
2439        fatal "Failed to initialize ports system, $result"
2440}
2441
2442# If we have no arguments remaining after option processing then force
2443# interactive mode
2444if { [llength $remaining_args] == 0 && ![info exists ui_options(ports_commandfiles)] } {
2445        lappend ui_options(ports_commandfiles) -
2446}
2447
2448# Set up some global state for our code
2449global current_portdir
2450set current_portdir [pwd]
2451
2452# Freeze global_options into global_options_base; global_options
2453# will be reset to global_options_base prior to processing each command.
2454global global_options_base
2455set global_options_base [array get global_options]
2456
2457# First process any remaining args as action(s)
2458set exit_status 0
2459if { [llength $remaining_args] > 0 } {
2460
2461        # If there are remaining arguments, process those as a command
2462       
2463        # Exit immediately, by default, unless we're going to be processing command files
2464        if {![info exists ui_options(ports_commandfiles)]} {
2465                set ui_options(ports_exit) yes
2466        }
2467        set exit_status [process_cmd $remaining_args]
2468}
2469
2470# Process any prescribed command files, including standard input
2471if { $exit_status == 0 && [info exists ui_options(ports_commandfiles)] } {
2472        set exit_status [process_command_files $ui_options(ports_commandfiles)]
2473}
2474
2475# Return with exit_status
2476exit $exit_status
Note: See TracBrowser for help on using the repository browser.