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

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

tighten up variant parsing so that we don't accept first what we'll reject later

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