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

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

Eliminate runtime error when a long option is presented globally

  • Property svn:eol-style set to native
  • Property svn:executable set to *
File size: 61.5 KB
Line 
1#!/bin/sh
2#\
3exec @TCLSH@ "$0" "$@"
4# port.tcl
5# $Id: port.tcl,v 1.154 2006/01/16 02:17:57 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\.]*=)} $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.