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

Last change on this file since 18784 was 18784, checked in by jberry, 14 years ago

Conversion to distinct functions for actions broke recognition of -f for selfupdate.
This change restores selfupdate's ability to recognize the -f flag, and also fixes
a similar bug for uninstall -u.

  • Property svn:eol-style set to native
  • Property svn:executable set to *
File size: 63.9 KB
Line 
1#!/bin/sh
2#\
3exec @TCLSH@ "$0" "$@"
4# port.tcl
5# $Id: port.tcl,v 1.161 2006/07/28 18:15:32 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        set ilist {}
498        if { [catch {set ilist [registry::installed]} result] } {
499                if {$result != "Registry error: No ports registered as installed."} {
500                        global errorInfo
501                        ui_debug "$errorInfo"
502                        fatal "port installed failed: $result"
503                }
504        }
505       
506        set results {}
507        foreach i $ilist {
508                set iname [lindex $i 0]
509                set iversion [lindex $i 1]
510                set irevision [lindex $i 2]
511                set ivariants [split_variants [lindex $i 3]]
512                set iactive [lindex $i 4]
513               
514                if { ${ignore_active} == "yes" || (${active} == "yes") == (${iactive} != 0) } {
515                        add_to_portlist results [list name $iname version "${iversion}_${irevision}" variants $ivariants]
516                }
517        }
518       
519        # Return the list of ports, sorted
520        return [portlist_sort $results]
521}
522
523
524proc get_uninstalled_ports {} {
525        # Return all - installed
526        set all [get_all_ports]
527        set installed [get_installed_ports]
528        return [opComplement $all $installed]
529}
530
531
532proc get_active_ports {} {
533        return [get_installed_ports no yes]
534}
535
536
537proc get_inactive_ports {} {
538        return [get_installed_ports no no]
539}
540
541
542proc get_outdated_ports {} {
543        global darwinports::registry.installtype
544        set is_image_mode [expr 0 == [string compare "image" ${darwinports::registry.installtype}]]
545       
546        # Get the list of installed ports
547        set ilist {}
548        if { [catch {set ilist [registry::installed]} result] } {
549                if {$result != "Registry error: No ports registered as installed."} {
550                        global errorInfo
551                        ui_debug "$errorInfo"
552                        fatal "port installed failed: $result"
553                }
554        }
555
556        # Now process the list, keeping only those ports that are outdated
557        set results {}
558        if { [llength $ilist] > 0 } {
559                foreach i $ilist {
560               
561                        # Get information about the installed port
562                        set portname                    [lindex $i 0]
563                        set installed_version   [lindex $i 1]
564                        set installed_revision  [lindex $i 2]
565                        set installed_compound  "${installed_version}_${installed_revision}"
566                        set installed_variants  [lindex $i 3]
567
568                        set is_active                   [lindex $i 4]
569                        if { $is_active == 0 && $is_image_mode } continue
570
571                        set installed_epoch             [lindex $i 5]
572
573                        # Get info about the port from the index
574                        if {[catch {set res [dportsearch $portname no exact]} result]} {
575                                global errorInfo
576                                ui_debug "$errorInfo"
577                                fatal "search for portname $portname failed: $result"
578                        }
579                        if {[llength $res] < 2} {
580                                if {[ui_isset ports_debug]} {
581                                        puts "$portname ($installed_compound is installed; the port was not found in the port index)"
582                                }
583                                continue
584                        }
585                        array set portinfo [lindex $res 1]
586                       
587                        # Get information about latest available version and revision
588                        set latest_version $portinfo(version)
589                        set latest_revision             0
590                        if {[info exists portinfo(revision)] && $portinfo(revision) > 0} { 
591                                set latest_revision     $portinfo(revision)
592                        }
593                        set latest_compound             "${latest_version}_${latest_revision}"
594                        set latest_epoch                0
595                        if {[info exists portinfo(epoch)]} { 
596                                set latest_epoch        $portinfo(epoch)
597                        }
598                       
599                        # Compare versions, first checking epoch, then the compound version string
600                        set comp_result [expr $installed_epoch - $latest_epoch]
601                        if { $comp_result == 0 } {
602                                set comp_result [rpm-vercomp $installed_compound $latest_compound]
603                        }
604                       
605                        # Add outdated ports to our results list
606                        if { $comp_result < 0 } {
607                                add_to_portlist results [list name $portname version $installed_compound variants [split_variants $installed_variants]]
608                        }
609                }
610        }
611
612        return $results
613}
614
615
616
617##########################################
618# Port expressions
619##########################################
620proc portExpr { resname } {
621        upvar $resname reslist
622        set result [seqExpr reslist]
623        return $result
624}
625
626
627proc seqExpr { resname } {
628        upvar $resname reslist
629       
630        # Evaluate a sequence of expressions a b c...
631        # These act the same as a or b or c
632
633        set result 1
634        while {$result} {
635                switch -- [lookahead] {
636                        ;               -
637                        )               -
638                        _EOF_   { break }
639                }
640               
641                set blist {}
642                set result [orExpr blist]
643                if {$result} {
644                        # Calculate the union of result and b
645                        set reslist [opUnion $reslist $blist]
646                }
647        }
648       
649        return $result
650}
651
652
653proc orExpr { resname } {
654        upvar $resname reslist
655       
656        set a [andExpr reslist]
657        while ($a) {
658                switch -- [lookahead] {
659                        or {
660                                        advance
661                                        set blist {}
662                                        if {![andExpr blist]} {
663                                                return 0
664                                        }
665                                               
666                                        # Calculate a union b
667                                        set reslist [opUnion $reslist $blist]
668                                }
669                        default {
670                                        return $a
671                                }
672                }
673        }
674       
675        return $a
676}
677
678
679proc andExpr { resname } {
680        upvar $resname reslist
681       
682        set a [unaryExpr reslist]
683        while {$a} {
684                switch -- [lookahead] {
685                        and {
686                                        advance
687                                       
688                                        set blist {}
689                                        set b [unaryExpr blist]
690                                        if {!$b} {
691                                                return 0
692                                        }
693                                       
694                                        # Calculate a intersect b
695                                        set reslist [opIntersection $reslist $blist]
696                                }
697                        default {
698                                        return $a
699                                }
700                }
701        }
702       
703        return $a
704}
705
706
707proc unaryExpr { resname } {
708        upvar $resname reslist
709        set result 0
710
711        switch -- [lookahead] {
712                !       -
713                not     {
714                                advance
715                                set blist {}
716                                set result [unaryExpr blist]
717                                if {$result} {
718                                        set all [get_all_ports]
719                                        set reslist [opComplement $all $blist]
720                                }
721                        }
722                default {
723                                set result [element reslist]
724                        }
725        }
726       
727        return $result
728}
729
730
731proc element { resname } {
732        upvar $resname reslist
733        set el 0
734       
735        set url ""
736        set name ""
737        set version ""
738        array unset variants
739        array unset options
740       
741        set token [lookahead]
742        switch -regex -- $token {
743                ^\\)$                   -
744                ^\;                             -
745                ^_EOF_$                 {       # End of expression/cmd/file
746                                                }
747                                               
748                ^\\($                   {       # Parenthesized Expression
749                                                        advance
750                                                        set el [portExpr reslist]
751                                                        if {!$el || ![match ")"]} {
752                                                                set el 0
753                                                        }
754                                                }
755                       
756                ^all(@.*)?$                     -
757                ^installed(@.*)?$               -
758                ^uninstalled(@.*)?$             -
759                ^active(@.*)?$                  -
760                ^inactive(@.*)?$                -
761                ^outdated(@.*)?$                -
762                ^current(@.*)?$ {
763                                                        # A simple pseudo-port name
764                                                        advance
765                                                       
766                                                        # Break off the version component, if there is one
767                                                        regexp {^(\w+)(@.*)?} $token matchvar name remainder
768                                                       
769                                                        add_multiple_ports reslist [get_${name}_ports] $remainder
770                                                       
771                                                        set el 1
772                                                }
773               
774                ^variants:              -
775                ^variant:               -
776                ^description:   -
777                ^portdir:               -
778                ^homepage:              -
779                ^epoch:                 -
780                ^platforms:             -
781                ^platform:              -
782                ^name:                  -
783                ^long_description:      -
784                ^maintainers:   -
785                ^maintainer:    -
786                ^categories:    -
787                ^category:              -
788                ^version:               -
789                ^revision:              {       # Handle special port selectors
790                                                        advance
791                                                       
792                                                        # Break up the token, because older Tcl switch doesn't support -matchvar
793                                                        regexp {^(\w+):(.*)} $token matchvar field pat
794                                                       
795                                                        # Remap friendly names to actual names
796                                                        switch -- $field {
797                                                                variant         -
798                                                                platform        -
799                                                                maintainer      { set field "${field}s" }
800                                                                category        { set field "categories" }
801                                                        }                                                       
802                                                        add_multiple_ports reslist [get_matching_ports $pat no regexp $field]
803                                                        set el 1
804                                                }
805                                               
806                [][?*]                  {       # Handle portname glob patterns
807                                                        advance; add_multiple_ports reslist [get_matching_ports $token no glob]
808                                                        set el 1
809                                                }
810                                               
811                ^\\w+:.+                {       # Handle a url by trying to open it as a port and mapping the name
812                                                        advance
813                                                        set name [url_to_portname $token]
814                                                        if {$name != ""} {
815                                                                parsePortSpec version variants options
816                                                                add_to_portlist reslist [list url $token \
817                                                                                                                        name $name \
818                                                                                                                        version $version \
819                                                                                                                        variants [array get variants] \
820                                                                                                                        options [array get options]]
821                                                        } else {
822                                                                ui_error "Can't open URL '$token' as a port"
823                                                                set el 0
824                                                        }
825                                                        set el 1
826                                                }
827                                               
828                default                 {       # Treat anything else as a portspec (portname, version, variants, options
829                                                        # or some combination thereof).
830                                                        parseFullPortSpec url name version variants options
831                                                        add_to_portlist reslist [list   url $url \
832                                                                                                                        name $name \
833                                                                                                                        version $version \
834                                                                                                                        variants [array get variants] \
835                                                                                                                        options [array get options]]
836                                                        set el 1
837                                                }
838        }
839       
840        return $el
841}
842
843
844proc add_multiple_ports { resname ports {remainder ""} } {
845        upvar $resname reslist
846       
847        set version ""
848        array unset variants
849        array unset options
850        parsePortSpec version variants options $remainder
851       
852        array unset overrides
853        if {$version != ""}                     { set overrides(version) $version }
854        if {[array size variants]}      { set overrides(variants) [array get variants] }
855        if {[array size options]}       { set overrides(options) [array get options] }
856
857        add_ports_to_portlist reslist $ports [array get overrides]
858}
859
860
861proc opUnion { a b } {
862        set result {}
863       
864        array unset onetime
865       
866        # Walk through each array, adding to result only those items that haven't
867        # been added before
868        foreach item $a {
869                array set port $item
870                if {[info exists onetime($port(fullname))]} continue
871                lappend result $item
872        }
873
874        foreach item $b {
875                array set port $item
876                if {[info exists onetime($port(fullname))]} continue
877                lappend result $item
878        }
879       
880        return $result
881}
882
883
884proc opIntersection { a b } {
885        set result {}
886       
887        # Rules we follow in performing the intersection of two port lists:
888        #
889        #       a/, a/                  ==> a/
890        #       a/, b/                  ==>
891        #       a/, a/1.0               ==> a/1.0
892        #       a/1.0, a/               ==> a/1.0
893        #       a/1.0, a/2.0    ==>
894        #
895        #       If there's an exact match, we take it.
896        #       If there's a match between simple and descriminated, we take the later.
897       
898        # First create a list of the fully descriminated names in b
899        array unset bfull
900        set i 0
901        foreach bitem $b {
902                array set port $bitem
903                set bfull($port(fullname)) $i
904                incr i
905        }
906       
907        # Walk through each item in a, matching against b
908        #
909        # Note: -regexp may not be present in all versions of Tcl we need to work
910        #               against, in which case we may have to fall back to a slower alternative
911        #               for those cases. I'm not worrying about that for now, however. -jdb
912        foreach aitem $a {
913                array set port $aitem
914               
915                # Quote the fullname and portname to avoid special characters messing up the regexp
916                set safefullname [regex_pat_sanitize $port(fullname)]
917               
918                set simpleform [expr { "$port(name)/" == $port(fullname) }]
919                if {$simpleform} {
920                        set pat "^${safefullname}"
921                } else {
922                        set safename [regex_pat_sanitize $port(name)]
923                        set pat "^${safefullname}$|^${safename}/$"
924                }
925               
926                set matches [array names bfull -regexp $pat]
927                foreach match $matches {
928                        if {$simpleform} {
929                                set i $bfull($match)
930                                lappend result [lindex $b $i]
931                        } else {
932                                lappend result $aitem
933                        }
934                }
935        }
936       
937        return $result
938}
939
940
941proc opComplement { a b } {
942        set result {}
943       
944        # Return all elements of a not matching elements in b
945       
946        # First create a list of the fully descriminated names in b
947        array unset bfull
948        set i 0
949        foreach bitem $b {
950                array set port $bitem
951                set bfull($port(fullname)) $i
952                incr i
953        }
954       
955        # Walk through each item in a, taking all those items that don't match b
956        #
957        # Note: -regexp may not be present in all versions of Tcl we need to work
958        #               against, in which case we may have to fall back to a slower alternative
959        #               for those cases. I'm not worrying about that for now, however. -jdb
960        foreach aitem $a {
961                array set port $aitem
962               
963                # Quote the fullname and portname to avoid special characters messing up the regexp
964                set safefullname [regex_pat_sanitize $port(fullname)]
965               
966                set simpleform [expr { "$port(name)/" == $port(fullname) }]
967                if {$simpleform} {
968                        set pat "^${safefullname}"
969                } else {
970                        set safename [regex_pat_sanitize $port(name)]
971                        set pat "^${safefullname}$|^${safename}/$"
972                }
973               
974                set matches [array names bfull -regexp $pat]
975
976                # We copy this element to result only if it didn't match against b
977                if {![llength $matches]} {
978                        lappend result $aitem
979                }
980        }
981       
982        return $result
983}
984
985
986proc parseFullPortSpec { urlname namename vername varname optname } {
987        upvar $urlname porturl
988        upvar $namename portname
989        upvar $vername portversion
990        upvar $varname portvariants
991        upvar $optname portoptions
992       
993        set portname ""
994        set portversion ""
995        array unset portvariants
996        array unset portoptions
997       
998        if { [moreargs] } {
999                # Look first for a potential portname
1000                #
1001                # We need to allow a wide variaty of tokens here, because of actions like "provides"
1002                # so we take a rather lenient view of what a "portname" is. We allow
1003                # anything that doesn't look like either a version, a variant, or an option
1004                set token [lookahead]
1005
1006                set remainder ""
1007                if {![regexp {^(@|[-+]([[:alpha:]_]+[\w\.]*)|[[:alpha:]_]+[\w\.]*=)} $token match]} {
1008                        advance
1009                        regexp {^([^@]+)(@.*)?} $token match portname remainder
1010                       
1011                        # If the portname contains a /, then try to use it as a URL
1012                        if {[string match "*/*" $portname]} {
1013                                set url "file://$portname"
1014                                set name [url_to_portname $url 1]
1015                                if { $name != "" } {
1016                                        # We mapped the url to valid port
1017                                        set porturl $url
1018                                        set portname $name
1019                                        # Continue to parse rest of portspec....
1020                                } else {
1021                                        # We didn't map the url to a port; treat it
1022                                        # as a raw string for something like port contents
1023                                        # or cd
1024                                        set porturl ""
1025                                        # Since this isn't a port, we don't try to parse
1026                                        # any remaining portspec....
1027                                        return
1028                                }
1029                        }
1030                }
1031               
1032                # Now parse the rest of the spec
1033                parsePortSpec portversion portvariants portoptions $remainder
1034        }
1035}
1036
1037       
1038proc parsePortSpec { vername varname optname {remainder ""} } {
1039        upvar $vername portversion
1040        upvar $varname portvariants
1041        upvar $optname portoptions
1042       
1043        global global_options
1044       
1045        set portversion ""
1046        array unset portoptions
1047        array set portoptions [array get global_options]
1048        array unset portvariants
1049       
1050        # Parse port version/variants/options
1051        set opt $remainder
1052        set adv 0
1053        set consumed 0
1054        for {set firstTime 1} {$opt != "" || [moreargs]} {set firstTime 0} {
1055       
1056                # Refresh opt as needed
1057                if {$opt == ""} {
1058                        if {$adv} advance
1059                        set opt [lookahead]
1060                        set adv 1
1061                        set consumed 0
1062                }
1063               
1064                # Version must be first, if it's there at all
1065                if {$firstTime && [string match {@*} $opt]} {
1066                        # Parse the version
1067                       
1068                        # Strip the @
1069                        set opt [string range $opt 1 end]
1070                       
1071                        # Handle the version
1072                        set sepPos [string first "/" $opt]
1073                        if {$sepPos >= 0} {
1074                                # Version terminated by "/" to disambiguate -variant from part of version
1075                                set portversion [string range $opt 0 [expr $sepPos-1]]
1076                                set opt [string range $opt [expr $sepPos+1] end]
1077                        } else {
1078                                # Version terminated by "+", or else is complete
1079                                set sepPos [string first "+" $opt]
1080                                if {$sepPos >= 0} {
1081                                        # Version terminated by "+"
1082                                        set portversion [string range $opt 0 [expr $sepPos-1]]
1083                                        set opt [string range $opt $sepPos end]
1084                                } else {
1085                                        # Unterminated version
1086                                        set portversion $opt
1087                                        set opt ""
1088                                }
1089                        }
1090                        set consumed 1
1091                } else {
1092                        # Parse all other options
1093                       
1094                        # Look first for a variable setting: VARNAME=VALUE
1095                        if {[regexp {^([[:alpha:]_]+[\w\.]*)=(.*)} $opt match key val] == 1} {
1096                                # It's a variable setting
1097                                set portoptions($key) "\"$val\""
1098                                set opt ""
1099                                set consumed 1
1100                        } elseif {[regexp {^([-+])([[:alpha:]_]+[\w\.]*)} $opt match sign variant] == 1} {
1101                                # It's a variant
1102                                set portvariants($variant) $sign
1103                                set opt [string range $opt [expr [string length $variant]+1] end]
1104                                set consumed 1
1105                        } else {
1106                                # Not an option we recognize, so break from port option processing
1107                                if { $consumed && $adv } advance
1108                                break
1109                        }
1110                }
1111        }
1112}
1113
1114
1115##########################################
1116# Action Handlers
1117##########################################
1118
1119proc action_usage { action portlist opts } {
1120        print_usage
1121        return 0
1122}
1123
1124
1125proc action_help { action portlist opts } {
1126        print_help
1127        return 0
1128}
1129
1130
1131proc action_info { action portlist opts } {
1132        set status 0
1133        require_portlist portlist
1134        foreachport $portlist { 
1135                # Get information about the named port
1136                if {[catch {dportsearch $portname no exact} result]} {
1137                        global errorInfo
1138                        ui_debug "$errorInfo"
1139                        break_softcontinue "search for portname $portname failed: $result" 1 status
1140                }
1141       
1142                if {$result == ""} {
1143                        puts "No port $portname found."
1144                } else {
1145                        set found [expr [llength $result] / 2]
1146                        if {$found > 1} {
1147                                ui_warn "Found $found port $portname definitions, displaying first one."
1148                        }
1149                        array set portinfo [lindex $result 1]
1150                       
1151                       
1152                        # Map from friendly to less-friendly but real names
1153                        array set name_map "
1154                                        category                categories
1155                                        maintainer              maintainers
1156                                        platform                platforms
1157                                        variant                 variants
1158                                        "
1159                                       
1160                        # Understand which info items are actually lists
1161                        # (this could be overloaded to provide a generic formatting code to
1162                        # allow us to, say, split off the prefix on libs)
1163                        array set list_map "
1164                                        categories              1
1165                                        depends_build   1
1166                                        depends_lib             1
1167                                        maintainers             1
1168                                        platforms               1
1169                                        variants                1
1170                                        "
1171                                       
1172                        # Set up our field separators
1173                        set show_label 1
1174                        set field_sep "\n"
1175                        set subfield_sep ", "
1176                       
1177                        # Tune for sort(1)
1178                        if {[info exists options(ports_info_line)]} {
1179                                array unset options ports_info_line
1180                                set show_label 0
1181                                set field_sep "\t"
1182                                set subfield_sep ","
1183                        }
1184
1185                        # Figure out whether to show field name
1186                        set quiet [ui_isset ports_quiet]
1187                        if {$quiet} {
1188                                set show_label 0
1189                        }
1190                       
1191                        # Spin through action options, emitting information for any found
1192                        set fields {}
1193                        foreach { option } [array names options ports_info_*] {
1194                                set opt [string range $option 11 end]
1195                               
1196                                # Map from friendly name
1197                                set ropt $opt
1198                                if {[info exists name_map($opt)]} {
1199                                        set ropt $name_map($opt)
1200                                }
1201                               
1202                                # If there's no such info, move on
1203                                if {![info exists portinfo($ropt)]} {
1204                                        if {!$quiet} {
1205                                                puts "no info for '$opt'"
1206                                        }
1207                                        continue
1208                                }
1209                               
1210                                # Calculate field label
1211                                set label ""
1212                                if {$show_label} {
1213                                        set label "$opt: "
1214                                }
1215                               
1216                                # Format the data
1217                                set inf $portinfo($ropt)
1218                                if [info exists list_map($ropt)] {
1219                                        set field [join $inf $subfield_sep]
1220                                } else {
1221                                        set field $inf
1222                                }
1223                               
1224                                lappend fields "$label$field"
1225                        }
1226                       
1227                        if {[llength $fields]} {
1228                                # Show specific fields
1229                                puts [join $fields $field_sep]
1230                        } else {
1231                       
1232                                # If we weren't asked to show any specific fields, then show general information
1233                                puts -nonewline "$portinfo(name) $portinfo(version)"
1234                                if {[info exists portinfo(revision)] && $portinfo(revision) > 0} { 
1235                                        puts -nonewline ", Revision $portinfo(revision)" 
1236                                }
1237                                puts -nonewline ", $portinfo(portdir)" 
1238                                if {[info exists portinfo(variants)]} {
1239                                        puts -nonewline " (Variants: "
1240                                        for {set i 0} {$i < [llength $portinfo(variants)]} {incr i} {
1241                                                if {$i > 0} { puts -nonewline ", " }
1242                                                puts -nonewline "[lindex $portinfo(variants) $i]"
1243                                        }
1244                                        puts -nonewline ")"
1245                                }
1246                                puts ""
1247                                if {[info exists portinfo(homepage)]} { 
1248                                        puts "$portinfo(homepage)"
1249                                }
1250               
1251                                if {[info exists portinfo(long_description)]} {
1252                                        puts "\n$portinfo(long_description)\n"
1253                                }
1254       
1255                                # find build dependencies
1256                                if {[info exists portinfo(depends_build)]} {
1257                                        puts -nonewline "Build Dependencies: "
1258                                        for {set i 0} {$i < [llength $portinfo(depends_build)]} {incr i} {
1259                                                if {$i > 0} { puts -nonewline ", " }
1260                                                puts -nonewline "[lindex [split [lindex $portinfo(depends_build) $i] :] end]"
1261                                        }
1262                                        set nodeps false
1263                                        puts ""
1264                                }
1265               
1266                                # find library dependencies
1267                                if {[info exists portinfo(depends_lib)]} {
1268                                        puts -nonewline "Library Dependencies: "
1269                                        for {set i 0} {$i < [llength $portinfo(depends_lib)]} {incr i} {
1270                                                if {$i > 0} { puts -nonewline ", " }
1271                                                puts -nonewline "[lindex [split [lindex $portinfo(depends_lib) $i] :] end]"
1272                                        }
1273                                        set nodeps false
1274                                        puts ""
1275                                }
1276               
1277                                # find runtime dependencies
1278                                if {[info exists portinfo(depends_run)]} {
1279                                        puts -nonewline "Runtime Dependencies: "
1280                                        for {set i 0} {$i < [llength $portinfo(depends_run)]} {incr i} {
1281                                                if {$i > 0} { puts -nonewline ", " }
1282                                                puts -nonewline "[lindex [split [lindex $portinfo(depends_run) $i] :] end]"
1283                                        }
1284                                        set nodeps false
1285                                        puts ""
1286                                }
1287                                if {[info exists portinfo(platforms)]} { puts "Platforms: $portinfo(platforms)"}
1288                                if {[info exists portinfo(maintainers)]} { puts "Maintainers: $portinfo(maintainers)"}
1289                        }
1290                }
1291        }
1292       
1293        return $status
1294}
1295
1296
1297proc action_location { action portlist opts } {
1298        set status 0
1299        require_portlist portlist
1300        foreachport $portlist {
1301                if { [catch {set ilist [registry_installed $portname [composite_version $portversion [array get variations]]]} result] } {
1302                        global errorInfo
1303                        ui_debug "$errorInfo"
1304                        break_softcontinue "port location failed: $result" 1 status
1305                } else {
1306                        set version [lindex $ilist 1]
1307                        set revision [lindex $ilist 2]
1308                        set     variants [lindex $ilist 3]
1309                }
1310
1311                set ref [registry::open_entry $portname $version $revision $variants]
1312                if { [string equal [registry::property_retrieve $ref installtype] "image"] } {
1313                        set imagedir [registry::property_retrieve $ref imagedir]
1314                        puts "Port $portname ${version}_${revision}${variants} is installed as an image in:"
1315                        puts $imagedir
1316                } else {
1317                        break_softcontinue "Port $portname is not installed as an image." 1 status
1318                }
1319        }
1320       
1321        return $status
1322}
1323
1324
1325proc action_provides { action portlist opts } {
1326        # In this case, portname is going to be used for the filename... since
1327        # that is the first argument we expect... perhaps there is a better way
1328        # to do this?
1329        if { ![llength $portlist] } {
1330                ui_error "Please specify a filename to check which port provides that file."
1331                return 1
1332        }
1333        foreachport $portlist {
1334                set file [compat filenormalize $portname]
1335                if {[file exists $file]} {
1336                        if {![file isdirectory $file]} {
1337                                set port [registry::file_registered $file] 
1338                                if { $port != 0 } {
1339                                        puts "$file is provided by: $port"
1340                                } else {
1341                                        puts "$file is not provided by a DarwinPorts port."
1342                                }
1343                        } else {
1344                                puts "$file is a directory."
1345                        }
1346                } else {
1347                        puts "$file does not exist."
1348                }
1349        }
1350       
1351        return 0
1352}
1353
1354
1355proc action_activate { action portlist opts } {
1356        set status 0
1357        require_portlist portlist
1358        foreachport $portlist {
1359                if { [catch {portimage::activate $portname [composite_version $portversion [array get variations]] [array get options]} result] } {
1360                        global errorInfo
1361                        ui_debug "$errorInfo"
1362                        break_softcontinue "port activate failed: $result" 1 status
1363                }
1364        }
1365       
1366        return $status
1367}
1368
1369
1370proc action_deactivate { action portlist opts } {
1371        set status 0
1372        require_portlist portlist
1373        foreachport $portlist {
1374                if { [catch {portimage::deactivate $portname [composite_version $portversion [array get variations]] [array get options]} result] } {
1375                        global errorInfo
1376                        ui_debug "$errorInfo"
1377                        break_softcontinue "port deactivate failed: $result" 1 status
1378                }
1379        }
1380       
1381        return $status
1382}
1383
1384
1385proc action_selfupdate { action portlist opts } {
1386        global global_options;
1387        if { [catch {darwinports::selfupdate [array get global_options]} result ] } {
1388                global errorInfo
1389                ui_debug "$errorInfo"
1390                fatal "selfupdate failed: $result"
1391        }
1392       
1393        return 0
1394}
1395
1396
1397proc action_upgrade { action portlist opts } {
1398        require_portlist portlist
1399        foreachport $portlist {
1400                # Merge global variations into the variations specified for this port
1401                foreach { variation value } [array get global_variations] {
1402                        if { ![info exists variations($variation)] } {
1403                                set variations($variation) $value
1404                        }
1405                }
1406               
1407                darwinports::upgrade $portname "port:$portname" [array get variations] [array get options]
1408        }
1409       
1410        return 0
1411}
1412
1413
1414proc action_version { action portlist opts } {
1415        puts "Version: [darwinports::version]"
1416        return 0
1417}
1418
1419
1420proc action_compact { action portlist opts } {
1421        set status 0
1422        require_portlist portlist
1423        foreachport $portlist {
1424                if { [catch {portimage::compact $portname [composite_version $portversion [array get variations]]} result] } {
1425                        global errorInfo
1426                        ui_debug "$errorInfo"
1427                        break_softcontinue "port compact failed: $result" 1 status
1428                }
1429        }
1430
1431        return $status
1432}
1433
1434
1435proc action_uncompact { action portlist opts } {
1436        set status 0
1437        require_portlist portlist
1438        foreachport $portlist {
1439                if { [catch {portimage::uncompact $portname [composite_version $portversion [array get variations]]} result] } {
1440                        global errorInfo
1441                        ui_debug "$errorInfo"
1442                        break_softcontinue "port uncompact failed: $result" 1 status
1443                }
1444        }
1445       
1446        return $status
1447}
1448
1449
1450
1451proc action_dependents { action portlist opts } {
1452        require_portlist portlist
1453        foreachport $portlist {
1454                registry::open_dep_map
1455                set deplist [registry::list_dependents $portname]
1456 
1457                if { [llength $deplist] > 0 } {
1458                        set dl [list]
1459                        # Check the deps first
1460                        foreach dep $deplist {
1461                                set depport [lindex $dep 2]
1462                                ui_msg "$depport depends on $portname"
1463                        }
1464                } else {
1465                        ui_msg "$portname has no dependents!"
1466                }
1467        }
1468        return 0
1469}
1470
1471
1472proc action_uninstall { action portlist opts } {
1473        set status 0
1474        if {[global_option_isset port_uninstall_old]} {
1475                # if -u then uninstall all inactive ports
1476                # (union these to any other ports user has in the port list)
1477                set portlist [opUnion $portlist [get_inactive_ports]]
1478        } else {
1479                # Otherwise the user had better have supplied a portlist, or we'll default to the existing directory
1480                require_portlist portlist
1481        }
1482
1483        foreachport $portlist {
1484                if { [catch {portuninstall::uninstall $portname [composite_version $portversion [array get variations]] [array get options]} result] } {
1485                        global errorInfo
1486                        ui_debug "$errorInfo"
1487                        break_softcontinue "port uninstall failed: $result" 1 status
1488                }
1489        }
1490       
1491        return 0
1492}
1493
1494
1495proc action_installed { action portlist opts } {
1496        set status 0
1497        set ilist {}
1498        if { [llength $portlist] } {
1499                foreachport $portlist {
1500                        set composite_version [composite_version $portversion [array get variations]]
1501                        if { [catch {set ilist [concat $ilist [registry::installed $portname $composite_version]]} result] } {
1502                                if {[string match "* not registered as installed." $result]} {
1503                                        puts "Port $portname is not installed."
1504                                } else {
1505                                        global errorInfo
1506                                        ui_debug "$errorInfo"
1507                                        break_softcontinue "port installed failed: $result" 1 status
1508                                }
1509                        }
1510                }
1511        } else {
1512                if { [catch {set ilist [registry::installed]} result] } {
1513                        if {$result != "Registry error: No ports registered as installed."} {
1514                                global errorInfo
1515                                ui_debug "$errorInfo"
1516                                ui_error "port installed failed: $result"
1517                                set status 1
1518                        }
1519                }
1520        }
1521        if { [llength $ilist] > 0 } {
1522                puts "The following ports are currently installed:"
1523                foreach i $ilist {
1524                        set iname [lindex $i 0]
1525                        set iversion [lindex $i 1]
1526                        set irevision [lindex $i 2]
1527                        set ivariants [lindex $i 3]
1528                        set iactive [lindex $i 4]
1529                        if { $iactive == 0 } {
1530                                puts "  $iname @${iversion}_${irevision}${ivariants}"
1531                        } elseif { $iactive == 1 } {
1532                                puts "  $iname @${iversion}_${irevision}${ivariants} (active)"
1533                        }
1534                }
1535        } else {
1536                puts "No ports are installed."
1537        }
1538       
1539        return $status
1540}
1541
1542
1543proc action_outdated { action portlist opts } {
1544        global darwinports::registry.installtype
1545        set is_image_mode [expr 0 == [string compare "image" ${darwinports::registry.installtype}]]
1546
1547        set status 0
1548
1549        # If port names were supplied, limit ourselves to those port, else check all installed ports
1550        set ilist {}
1551        if { [llength $portlist] } {
1552                foreach portspec $portlist {
1553                        array set port $portspec
1554                        set portname $port(name)
1555                        set composite_version [composite_version $port(version) $port(variants)]
1556                        if { [catch {set ilist [concat $ilist [registry::installed $portname $composite_version]]} result] } {
1557                                if {![string match "* not registered as installed." $result]} {
1558                                        global errorInfo
1559                                        ui_debug "$errorInfo"
1560                                        break_softcontinue "port outdated failed: $result" 1 status
1561                                }
1562                        }
1563                }
1564        } else {
1565                if { [catch {set ilist [registry::installed]} result] } {
1566                        if {$result != "Registry error: No ports registered as installed."} {
1567                                global errorInfo
1568                                ui_debug "$errorInfo"
1569                                ui_error "port installed failed: $result"
1570                                set status 1
1571                        }
1572                }
1573        }
1574
1575        if { [llength $ilist] > 0 } {
1576                puts "The following installed ports are outdated:"
1577       
1578                foreach i $ilist { 
1579               
1580                        # Get information about the installed port
1581                        set portname                    [lindex $i 0]
1582                        set installed_version   [lindex $i 1]
1583                        set installed_revision  [lindex $i 2]
1584                        set installed_compound  "${installed_version}_${installed_revision}"
1585
1586                        set is_active                   [lindex $i 4]
1587            if { $is_active == 0 && $is_image_mode } {
1588                                continue
1589                        }
1590                        set installed_epoch             [lindex $i 5]
1591
1592                        # Get info about the port from the index
1593                        if {[catch {set res [dportsearch $portname no exact]} result]} {
1594                                global errorInfo
1595                                ui_debug "$errorInfo"
1596                                break_softcontinue "search for portname $portname failed: $result" 1 status
1597                        }
1598                        if {[llength $res] < 2} {
1599                                if {[ui_isset ports_debug]} {
1600                                        puts "$portname ($installed_compound is installed; the port was not found in the port index)"
1601                                }
1602                                continue
1603                        }
1604                        array set portinfo [lindex $res 1]
1605                       
1606                        # Get information about latest available version and revision
1607                        set latest_version $portinfo(version)
1608                        set latest_revision             0
1609                        if {[info exists portinfo(revision)] && $portinfo(revision) > 0} { 
1610                                set latest_revision     $portinfo(revision)
1611                        }
1612                        set latest_compound             "${latest_version}_${latest_revision}"
1613                        set latest_epoch                0
1614                        if {[info exists portinfo(epoch)]} { 
1615                                set latest_epoch        $portinfo(epoch)
1616                        }
1617                       
1618                        # Compare versions, first checking epoch, then the compound version string
1619                        set comp_result [expr $installed_epoch - $latest_epoch]
1620                        if { $comp_result == 0 } {
1621                                set comp_result [rpm-vercomp $installed_compound $latest_compound]
1622                        }
1623                       
1624                        # Report outdated (or, for verbose, predated) versions
1625                        if { $comp_result != 0 } {
1626                                                       
1627                                # Form a relation between the versions
1628                                set flag ""
1629                                if { $comp_result > 0 } {
1630                                        set relation ">"
1631                                        set flag "!"
1632                                } else {
1633                                        set relation "<"
1634                                }
1635                               
1636                                # Emit information
1637                                if {$comp_result < 0 || [ui_isset ports_verbose]} {
1638                                        puts [format "%-30s %-24s %1s" $portname "$installed_compound $relation $latest_compound" $flag]
1639                                }
1640                               
1641                        }
1642                }
1643        } else {
1644                puts "No installed ports are outdated."
1645        }
1646       
1647        return $status
1648}
1649
1650
1651proc action_contents { action portlist opts } {
1652        set status 0
1653        require_portlist portlist
1654        foreachport $portlist {
1655                set files [registry::port_registered $portname]
1656                if { $files != 0 } {
1657                        if { [llength $files] > 0 } {
1658                                puts "Port $portname contains:"
1659                                foreach file $files {
1660                                        puts "  $file"
1661                                }
1662                        } else {
1663                                puts "Port $portname does not contain any file or is not active."
1664                        }
1665                } else {
1666                        puts "Port $portname is not installed."
1667                }
1668        }
1669       
1670        return $status
1671}
1672
1673
1674proc action_deps { action portlist opts } {
1675        set status 0
1676        require_portlist portlist
1677        foreachport $portlist {
1678                # Get info about the port
1679                if {[catch {dportsearch $portname no exact} result]} {
1680                        global errorInfo
1681                        ui_debug "$errorInfo"
1682                        break_softcontinue "search for portname $portname failed: $result" 1 status
1683                }
1684
1685                if {$result == ""} {
1686                        break_softcontinue "No port $portname found." 1 status
1687                }
1688
1689                array set portinfo [lindex $result 1]
1690
1691                set depstypes {depends_build depends_lib depends_run}
1692                set depstypes_descr {"build" "library" "runtime"}
1693
1694                set nodeps true
1695                foreach depstype $depstypes depsdecr $depstypes_descr {
1696                        if {[info exists portinfo($depstype)] &&
1697                                $portinfo($depstype) != ""} {
1698                                puts "$portname has $depsdecr dependencies on:"
1699                                foreach i $portinfo($depstype) {
1700                                        puts "\t[lindex [split [lindex $i 0] :] end]"
1701                                }
1702                                set nodeps false
1703                        }
1704                }
1705               
1706                # no dependencies found
1707                if {$nodeps == "true"} {
1708                        puts "$portname has no dependencies"
1709                }
1710        }
1711       
1712        return $status
1713}
1714
1715
1716proc action_variants { action portlist opts } {
1717        set status 0
1718        require_portlist portlist
1719        foreachport $portlist {
1720                # search for port
1721                if {[catch {dportsearch $portname no exact} result]} {
1722                        global errorInfo
1723                        ui_debug "$errorInfo"
1724                        break_softcontinue "search for portname $portname failed: $result" 1 status
1725                }
1726       
1727                if {$result == ""} {
1728                        puts "No port $portname found."
1729                }
1730       
1731                array set portinfo [lindex $result 1]
1732       
1733                # if this fails the port doesn't have any variants
1734                if {![info exists portinfo(variants)]} {
1735                        puts "$portname has no variants"
1736                } else {
1737                        # print out all the variants
1738                        puts "$portname has the variants:"
1739                        for {set i 0} {$i < [llength $portinfo(variants)]} {incr i} {
1740                                puts "\t[lindex $portinfo(variants) $i]"
1741                        }
1742                }
1743        }
1744       
1745        return $status
1746}
1747
1748
1749proc action_search { action portlist opts } {
1750        set status 0
1751        if {![llength portlist]} {
1752                ui_error "You must specify a search pattern"
1753                return 1
1754        }
1755       
1756        foreachport $portlist {
1757                set portfound 0
1758                if {[catch {set res [dportsearch $portname no]} result]} {
1759                        global errorInfo
1760                        ui_debug "$errorInfo"
1761                        break_softcontinue "search for portname $portname failed: $result" 1 status
1762                }
1763                foreach {name array} $res {
1764                        array set portinfo $array
1765
1766                        # XXX is this the right place to verify an entry?
1767                        if {![info exists portinfo(name)]} {
1768                                puts "Invalid port entry, missing portname"
1769                                continue
1770                        }
1771                        if {![info exists portinfo(description)]} {
1772                                puts "Invalid port entry for $portinfo(name), missing description"
1773                                continue
1774                        }
1775                        if {![info exists portinfo(version)]} {
1776                                puts "Invalid port entry for $portinfo(name), missing version"
1777                                continue
1778                        }
1779                        if {![info exists portinfo(portdir)]} {
1780                                set output [format "%-30s %-12s %s" $portinfo(name) $portinfo(version) $portinfo(description)]
1781                        } else {
1782                                set output [format "%-30s %-14s %-12s %s" $portinfo(name) $portinfo(portdir) $portinfo(version) $portinfo(description)]
1783                        }
1784                        set portfound 1
1785                        puts $output
1786                        unset portinfo
1787                }
1788                if { !$portfound } {
1789                        ui_msg "No match for $portname found"
1790                }
1791        }
1792       
1793        return $status
1794}
1795
1796
1797proc action_list { action portlist opts } {
1798        set status 0
1799
1800        # Default to list all ports if no portnames are supplied
1801        if {![llength $portlist]} {
1802                add_to_portlist portlist [list name "-all-"]
1803        }
1804       
1805        foreachport $portlist {
1806                if {$portname == "-all-"} {
1807                        set search_string ".+"
1808                } else {
1809                        set search_string [regex_pat_sanitize $portname]
1810                }
1811               
1812                if {[catch {set res [dportsearch ^$search_string\$ no]} result]} {
1813                        global errorInfo
1814                        ui_debug "$errorInfo"
1815                        break_softcontinue "search for portname $search_string failed: $result" 1 status
1816                }
1817
1818                foreach {name array} $res {
1819                        array set portinfo $array
1820                        set outdir ""
1821                        if {[info exists portinfo(portdir)]} {
1822                                set outdir $portinfo(portdir)
1823                        }
1824                        puts [format "%-30s @%-14s %s" $portinfo(name) $portinfo(version) $outdir]
1825                }
1826        }
1827       
1828        return $status
1829}
1830
1831
1832proc action_echo { action portlist opts } {
1833        # Simply echo back the port specs given to this command
1834        foreachport $portlist {
1835                set opts {}
1836                foreach { key value } [array get options] {
1837                        lappend opts "$key=$value"
1838                }
1839               
1840                set composite_version [composite_version $portversion [array get variations] 1]
1841                if { $composite_version != "" } {
1842                        set ver_field "@$composite_version"
1843                } else {
1844                        set ver_field ""
1845                }
1846                puts [format "%-30s %s %s" $portname $ver_field  [join $opts " "]]
1847        }
1848       
1849        return 0
1850}
1851
1852
1853proc action_portcmds { action portlist opts } {
1854        # Operations on the port's directory and Portfile
1855        global env, boot_env
1856        global current_portdir
1857       
1858        set status 0
1859        require_portlist portlist
1860        foreachport $portlist {
1861                # If we have a url, use that, since it's most specific
1862                # otherwise try to map the portname to a url
1863                if {$porturl == ""} {
1864                        # Verify the portname, getting portinfo to map to a porturl
1865                        if {[catch {set res [dportsearch $portname no exact]} result]} {
1866                                global errorInfo
1867                                ui_debug "$errorInfo"
1868                                break_softcontinue "search for portname $portname failed: $result" 1 status
1869                        }
1870                        if {[llength $res] < 2} {
1871                                break_softcontinue "Port $portname not found" 1 status
1872                        }
1873                        array set portinfo [lindex $res 1]
1874                        set porturl $portinfo(porturl)
1875                }
1876               
1877                set portdir [file normalize [darwinports::getportdir $porturl]]
1878                set porturl "file://${portdir}";        # Rebuild url so it's fully qualified
1879                set portfile "${portdir}/Portfile"
1880               
1881                if {[file readable $portfile]} {
1882                        switch -- $action {
1883                                cat     {
1884                                        # Copy the portfile to standard output
1885                                        set f [open $portfile RDONLY]
1886                                        while { ![eof $f] } {
1887                                                puts [read $f 4096]
1888                                        }
1889                                        close $f
1890                                }
1891                               
1892                                ed - edit {
1893                                        # Edit the port's portfile with the user's editor
1894                                       
1895                                        # Restore our entire environment from start time.
1896                                        # We need it to evaluate the editor, and the editor
1897                                        # may want stuff from it as well, like TERM.
1898                                        array unset env_save; array set env_save [array get env]
1899                                        array unset env *; array set env [array get boot_env]
1900                                       
1901                                        # Find an editor to edit the portfile
1902                                        set editor ""
1903                                        foreach ed { VISUAL EDITOR } {
1904                                                if {[info exists env($ed)]} {
1905                                                        set editor $env($ed)
1906                                                        break
1907                                                }
1908                                        }
1909                                       
1910                                        # Invoke the editor
1911                                        if { $editor == "" } {
1912                                                break_softcontinue "No EDITOR is specified in your environment" 1 status
1913                                        } else {
1914                                                if {[catch {eval exec >/dev/stdout </dev/stdin $editor $portfile} result]} {
1915                                                        global errorInfo
1916                                                        ui_debug "$errorInfo"
1917                                                        break_softcontinue "unable to invoke editor $editor: $result" 1 status
1918                                                }
1919                                        }
1920                                       
1921                                        # Restore internal dp environment
1922                                        array unset env *; array set env [array get env_save]
1923                                }
1924                               
1925                                dir {
1926                                        # output the path to the port's directory
1927                                        puts $portdir
1928                                }
1929                               
1930                                cd {
1931                                        # Change to the port's directory, making it the default
1932                                        # port for any future commands
1933                                        set current_portdir $portdir
1934                                }
1935
1936                                url {
1937                                        # output the url of the port's directory, suitable to feed back in later as a port descriptor
1938                                        puts $porturl
1939                                }
1940
1941                                file {
1942                                        # output the path to the port's portfile
1943                                        puts $portfile
1944                                }
1945                        }
1946                } else {
1947                        break_softcontinue "Could not read $portfile" 1 status
1948                }
1949        }
1950       
1951        return $status
1952}
1953
1954
1955proc action_sync { action portlist opts } {
1956        set status 0
1957        if {[catch {dportsync} result]} {
1958                global errorInfo
1959                ui_debug "$errorInfo"
1960                ui_msg "port sync failed: $result"
1961                set status 1
1962        }
1963       
1964        return $status
1965}
1966
1967
1968proc action_target { action portlist opts } {
1969        set status 0
1970        require_portlist portlist
1971        foreachport $portlist {
1972                set target $action
1973
1974                # If we have a url, use that, since it's most specific
1975                # otherwise try to map the portname to a url
1976                if {$porturl == ""} {
1977                        # Verify the portname, getting portinfo to map to a porturl
1978                        if {[catch {set res [dportsearch $portname no exact]} result]} {
1979                                global errorInfo
1980                                ui_debug "$errorInfo"
1981                                break_softcontinue "search for portname $portname failed: $result" 1 status
1982                        }
1983                        if {[llength $res] < 2} {
1984                                break_softcontinue "Port $portname not found" 1 status
1985                        }
1986                        array set portinfo [lindex $res 1]
1987                        set porturl $portinfo(porturl)
1988                }
1989               
1990                # If this is the install target, add any global_variations to the variations
1991                # specified for the port
1992                if { $target == "install" } {
1993                        foreach { variation value } [array get global_variations] {
1994                                if { ![info exists variations($variation)] } {
1995                                        set variations($variation) $value
1996                                }
1997                        }
1998                }
1999
2000                # If version was specified, save it as a version glob for use
2001                # in port actions (e.g. clean).
2002                if {[string length $portversion]} {
2003                        set options(ports_version_glob) $portversion
2004                }
2005                if {[catch {set workername [dportopen $porturl [array get options] [array get variations]]} result]} {
2006                        global errorInfo
2007                        ui_debug "$errorInfo"
2008                        break_softcontinue "Unable to open port: $result" 1 status
2009                }
2010                if {[catch {set result [dportexec $workername $target]} result]} {
2011                        global errorInfo
2012                        dportclose $workername
2013                        ui_debug "$errorInfo"
2014                        break_softcontinue "Unable to execute port: $result" 1 status
2015                }
2016
2017                dportclose $workername
2018               
2019                # Process any error that wasn't thrown and handled already
2020                if {$result} {
2021                        break_softcontinue "Status $result encountered during processing." 1 status
2022                }
2023        }
2024       
2025        return $status
2026}
2027
2028
2029proc action_exit { action portlist opts } {
2030        # Return a semaphore telling the main loop to quit
2031        return -999
2032}
2033
2034
2035##########################################
2036# Command Parsing
2037##########################################
2038proc moreargs {} {
2039        global cmd_argn cmd_argc
2040        return [expr {$cmd_argn < $cmd_argc}]
2041}
2042
2043
2044proc lookahead {} {
2045        global cmd_argn cmd_argc cmd_argv
2046        if {$cmd_argn < $cmd_argc} {
2047                return [lindex $cmd_argv $cmd_argn]
2048        } else {
2049                return _EOF_
2050        }
2051}
2052
2053
2054proc advance {} {
2055        global cmd_argn
2056        incr cmd_argn
2057}
2058
2059
2060proc match s {
2061        if {[lookahead] == $s} {
2062                advance
2063                return 1
2064        }
2065        return 0
2066}
2067
2068
2069global action_array
2070array set action_array {
2071        usage           action_usage
2072        help            action_help
2073
2074        echo            action_echo
2075       
2076        info            action_info
2077        location        action_location
2078        provides        action_provides
2079       
2080        activate        action_activate
2081        deactivate      action_deactivate
2082       
2083        sync            action_sync
2084        selfupdate      action_selfupdate
2085       
2086        upgrade         action_upgrade
2087       
2088        version         action_version
2089        compact         action_compact
2090        uncompact       action_uncompact
2091       
2092        uninstall       action_uninstall
2093       
2094        installed       action_installed
2095        outdated        action_outdated
2096        contents        action_contents
2097        dependents      action_dependents
2098        deps            action_deps
2099        variants        action_variants
2100       
2101        search          action_search
2102        list            action_list
2103       
2104        ed                      action_portcmds
2105        edit            action_portcmds
2106        cat                     action_portcmds
2107        dir                     action_portcmds
2108        cd                      action_portcmds
2109        url                     action_portcmds
2110        file            action_portcmds
2111       
2112        depends         action_target
2113        fetch           action_target
2114        checksum        action_target
2115        extract         action_target
2116        patch           action_target
2117        configure       action_target
2118        build           action_target
2119        destroot        action_target
2120        install         action_target
2121        clean           action_target
2122        test            action_target
2123        submit          action_target
2124        trace           action_target
2125        livecheck       action_target
2126        distcheck       action_target
2127        mirror          action_target
2128
2129        archive         action_target
2130        unarchive       action_target
2131        dmg                     action_target
2132        dpkg            action_target
2133        mpkg            action_target
2134        pkg                     action_target
2135        rpmpackage      action_target
2136
2137        quit            action_exit
2138        exit            action_exit
2139}
2140
2141
2142proc find_action_proc { action } {
2143        global action_array
2144       
2145        set action_proc ""
2146        if { [info exists action_array($action)] } {
2147                set action_proc $action_array($action)
2148        }
2149       
2150        return $action_proc
2151}
2152
2153
2154# Parse global options
2155#
2156# Note that this is called several times:
2157#       (1) Initially, to parse options that will be constant across all commands
2158#               (options that come prior to any command, frozen into global_options_base)
2159#       (2) Following each command (to parse options that will be unique to that command
2160#               (the global_options array is reset to global_options_base prior to each command)
2161#
2162proc parse_options { action ui_options_name global_options_name } {
2163        upvar $ui_options_name ui_options
2164        upvar $global_options_name global_options
2165        global cmdname
2166       
2167        while {[moreargs]} {
2168                set arg [lookahead]
2169               
2170                if {[string index $arg 0] != "-"} {
2171                        break
2172                } elseif {[string index $arg 1] == "-"} {
2173                        # Process long arguments
2174                        switch -- $arg {
2175                                --                      { # This is the options terminator; do no further option processing
2176                                                          advance; break
2177                                                        }
2178                                default         {
2179                                                          set key [string range $arg 2 end]
2180                                                          set global_options(ports_${action}_${key}) yes
2181                                                        }
2182                        }
2183                } else {
2184                        # Process short arg(s)
2185                        set opts [string range $arg 1 end]
2186                        foreach c [split $opts {}] {
2187                                switch -- $c {
2188                                        v {     set ui_options(ports_verbose) yes                       }
2189                                        d { set ui_options(ports_debug) yes
2190                                                # debug implies verbose
2191                                                set ui_options(ports_verbose) yes
2192                                          }
2193                                        q { set ui_options(ports_quiet) yes
2194                                                set ui_options(ports_verbose) no
2195                                                set ui_options(ports_debug) no
2196                                          }
2197                                        i { # Always go to interactive mode
2198                                                lappend ui_options(ports_commandfiles) -        }
2199                                        p { # Ignore errors while processing within a command
2200                                                set ui_options(ports_processall) yes            }
2201                                        x { # Exit with error from any command while in batch/interactive mode
2202                                                set ui_options(ports_exit) yes                          }
2203                                       
2204                                        f { set global_options(ports_force) yes                 }
2205                                        o { set global_options(ports_ignore_older) yes  }
2206                                        n { set global_options(ports_nodeps) yes                }
2207                                        u { set global_options(port_uninstall_old) yes  }
2208                                        R { set global_options(ports_do_dependents) yes }
2209                                        s { set global_options(ports_source_only) yes   }
2210                                        b { set global_options(ports_binary_only) yes   }
2211                                        c { set global_options(ports_autoclean) yes             }
2212                                        k { set global_options(ports_autoclean) no              }
2213                                        t { set global_options(ports_trace) yes                 }
2214                                        F { # Name a command file to process
2215                                                advance
2216                                                if {[moreargs]} {
2217                                                        lappend ui_options(ports_commandfiles) [lookahead]
2218                                                }
2219                                          }
2220                                        D { advance
2221                                                if {[moreargs]} {
2222                                                        cd [lookahead]
2223                                                }
2224                                                break
2225                                          }
2226                                        default {
2227                                                print_usage; exit 1
2228                                          }
2229                                }
2230                        }
2231                }
2232               
2233                advance
2234        }
2235}
2236
2237
2238proc process_cmd { argv } {
2239        global cmd_argc cmd_argv cmd_argn
2240        global global_options global_options_base
2241        global current_portdir
2242        set cmd_argv $argv
2243        set cmd_argc [llength $argv]
2244        set cmd_argn 0
2245
2246        set action_status 0
2247
2248        # Process an action if there is one
2249        while {$action_status == 0 && [moreargs]} {
2250                set action [lookahead]
2251                advance
2252               
2253                # Handle command separator
2254                if { $action == ";" } {
2255                        continue
2256                }
2257               
2258                # Handle a comment
2259                if { [string index $action 0] == "#" } {
2260                        while { [moreargs] } { advance }
2261                        break
2262                }
2263               
2264                # Always start out processing an action in current_portdir
2265                cd $current_portdir
2266               
2267                # Reset global_options from base before each action, as we munge it just below...
2268                array set global_options $global_options_base
2269               
2270                # Parse options that will be unique to this action
2271                # (to avoid abiguity with -variants and a default port, either -- must be
2272                # used to terminate option processing, or the pseudo-port current must be specified).
2273                parse_options $action ui_options global_options
2274               
2275                # Parse port specifications into portlist
2276                set portlist {}
2277                if {![portExpr portlist]} {
2278                        ui_error "Improper expression syntax while processing parameters"
2279                        set action_status 1
2280                        break
2281                }
2282
2283                # Find an action to execute
2284                set action_proc [find_action_proc $action]
2285                if { $action_proc != "" } {
2286                        set action_status [$action_proc $action $portlist [array get global_options]]
2287                } else {
2288                        puts "Unrecognized action \"$action\""
2289                        set action_status 1
2290                }
2291               
2292                # semaphore to exit
2293                if {$action_status == -999} break
2294
2295                # If we're not in exit mode then ignore the status from the command
2296                if { ![ui_isset ports_exit] } {
2297                        set action_status 0
2298                }
2299        }
2300       
2301        return $action_status
2302}
2303
2304
2305proc complete_portname { text state } { 
2306        global action_array
2307        global complete_choices complete_position
2308       
2309        if {$state == 0} {
2310                set complete_position 0
2311                set complete_choices {}
2312
2313                # Build a list of ports with text as their prefix
2314                if {[catch {set res [dportsearch "${text}*" false glob]} result]} {
2315                        global errorInfo
2316                        ui_debug "$errorInfo"
2317                        fatal "search for portname $pattern failed: $result"
2318                }
2319                foreach {name info} $res {
2320                        lappend complete_choices $name
2321                }
2322        }
2323       
2324        set word [lindex $complete_choices $complete_position]
2325        incr complete_position
2326       
2327        return $word
2328}
2329
2330
2331proc complete_action { text state } {   
2332        global action_array
2333        global complete_choices complete_position
2334       
2335        if {$state == 0} {
2336                set complete_position 0
2337                set complete_choices [array names action_array "[string tolower $text]*"]
2338        }
2339       
2340        set word [lindex $complete_choices $complete_position]
2341        incr complete_position
2342       
2343        return $word
2344}
2345
2346
2347proc attempt_completion { text word start end } {
2348        # If the word starts with '~', or contains '.' or '/', then use the build-in
2349        # completion to complete the word
2350        if { [regexp {^~|[/.]} $word] } {
2351                return ""
2352        }
2353
2354        # Decide how to do completion based on where we are in the string
2355        set prefix [string range $text 0 [expr $start - 1]]
2356       
2357        # If only whitespace characters preceed us, or if the
2358        # previous non-whitespace character was a ;, then we're
2359        # an action (the first word of a command)
2360        if { [regexp {(^\s*$)|(;\s*$)} $prefix] } {
2361                return complete_action
2362        }
2363       
2364        # Otherwise, do completion on portname
2365        return complete_portname
2366}
2367
2368
2369proc get_next_cmdline { in out use_readline prompt linename } {
2370        upvar $linename line
2371       
2372        set line ""
2373        while { $line == "" } {
2374       
2375                if {$use_readline} {
2376                        set len [readline read -attempted_completion attempt_completion line $prompt]
2377                } else {
2378                        puts -nonewline $out $prompt
2379                        set len [gets $in line]
2380                }
2381               
2382                if { $len < 0 } {
2383                        return -1
2384                }
2385               
2386                set line [string trim $line]
2387               
2388                if { $use_readline && $line != "" } {
2389                        rl_history add $line
2390                }
2391        }
2392       
2393        return [llength $line]
2394}
2395
2396
2397proc process_command_file { in } {
2398        global current_portdir
2399
2400        # Initialize readline
2401        set isstdin [string match $in "stdin"]
2402        set name "port"
2403        set use_readline [expr $isstdin && [readline init $name]]
2404        set history_file [file normalize "~/.${name}_history"]
2405       
2406        # Read readline history
2407        if {$use_readline} {
2408                rl_history read $history_file
2409                rl_history stifle 100
2410        }
2411       
2412        # Be noisy, if appropriate
2413        set noisy [expr $isstdin && ![ui_isset ports_quiet]]
2414        if { $noisy } {
2415                puts "DarwinPorts [darwinports::version]"
2416                puts "Entering interactive mode... (\"help\" for help, \"quit\" to quit)"
2417        }
2418       
2419        # Main command loop
2420        set exit_status 0
2421        while { $exit_status == 0 } {
2422       
2423                # Calculate our prompt
2424                if { $noisy } {
2425                        set shortdir [eval file join [lrange [file split $current_portdir] end-1 end]]
2426                        set prompt "\[$shortdir\] > "
2427                } else {
2428                        set prompt ""
2429                }
2430               
2431                # Get a command line
2432                if { [get_next_cmdline $in stdout $use_readline $prompt line] <= 0  } {
2433                        puts ""
2434                        break
2435                }
2436               
2437                # Process the command
2438                set exit_status [process_cmd $line]
2439               
2440                # Check for semaphore to exit
2441                if {$exit_status == -999} break
2442               
2443                # Ignore status unless we're in error-exit mode
2444                if { ![ui_isset ports_exit] } {
2445                        set exit_status 0
2446                }
2447        }
2448       
2449        # Save readine history
2450        if {$use_readline} {
2451                rl_history write $history_file
2452        }
2453       
2454        # Say goodbye
2455        if { $noisy } {
2456                puts "Goodbye"
2457        }
2458       
2459        return $exit_status
2460}
2461
2462
2463proc process_command_files { filelist } {
2464        set exit_status 0
2465       
2466        # For each file in the command list, process commands
2467        # in the file
2468        foreach file $filelist {
2469                if {$file == "-"} {
2470                        set in stdin
2471                } else {
2472                       
2473                        if {[catch {set in [open $file]} result]} {
2474                                fatal "Failed to open command file; $result"
2475                        }
2476                       
2477                }
2478               
2479                set exit_status [process_command_file $in]
2480               
2481                if {$in != "stdin"} {
2482                        close $in
2483                }
2484
2485                # Check for semaphore to exit
2486                if {$exit_status == -999} {
2487                        set exit_status 0
2488                        break
2489                }
2490               
2491                # Ignore status unless we're in error-exit mode
2492                if { ![ui_isset ports_exit] } {
2493                        set exit_status 0
2494                }
2495        }
2496       
2497        return $exit_status
2498}
2499
2500
2501##########################################
2502# Main
2503##########################################
2504
2505# globals
2506array set ui_options            {}
2507array set global_options        {}
2508array set global_variations     {}
2509
2510# Save off a copy of the environment before dportinit monkeys with it
2511global env boot_env
2512array set boot_env [array get env]
2513
2514global argv0
2515global cmdname
2516set cmdname [file tail $argv0]
2517
2518# Setp cmd_argv to match argv
2519global argc argv
2520global cmd_argc cmd_argv cmd_argn
2521set cmd_argv $argv
2522set cmd_argc $argc
2523set cmd_argn 0
2524
2525# If we've been invoked as portf, then the first argument is assumed
2526# to be the name of a command file (i.e., there is an implicit -F
2527# before any arguments).
2528if {[moreargs] && $cmdname == "portf"} {
2529        lappend ui_options(ports_commandfiles) [lookahead]
2530        advance
2531}
2532
2533# Parse global options that will affect all subsequent commands
2534parse_options "global" ui_options global_options
2535
2536# Get arguments remaining after option processing
2537set remaining_args [lrange $cmd_argv $cmd_argn end]
2538
2539# Initialize dport
2540# This must be done following parse of global options, as some options are
2541# evaluated by dportinit.
2542if {[catch {dportinit ui_options global_options global_variations} result]} {
2543        global errorInfo
2544        puts "$errorInfo"
2545        fatal "Failed to initialize ports system, $result"
2546}
2547
2548# If we have no arguments remaining after option processing then force
2549# interactive mode
2550if { [llength $remaining_args] == 0 && ![info exists ui_options(ports_commandfiles)] } {
2551        lappend ui_options(ports_commandfiles) -
2552}
2553
2554# Set up some global state for our code
2555global current_portdir
2556set current_portdir [pwd]
2557
2558# Freeze global_options into global_options_base; global_options
2559# will be reset to global_options_base prior to processing each command.
2560global global_options_base
2561set global_options_base [array get global_options]
2562
2563# First process any remaining args as action(s)
2564set exit_status 0
2565if { [llength $remaining_args] > 0 } {
2566
2567        # If there are remaining arguments, process those as a command
2568       
2569        # Exit immediately, by default, unless we're going to be processing command files
2570        if {![info exists ui_options(ports_commandfiles)]} {
2571                set ui_options(ports_exit) yes
2572        }
2573        set exit_status [process_cmd $remaining_args]
2574}
2575
2576# Process any prescribed command files, including standard input
2577if { $exit_status == 0 && [info exists ui_options(ports_commandfiles)] } {
2578        set exit_status [process_command_files $ui_options(ports_commandfiles)]
2579}
2580
2581# Return with exit_status
2582exit $exit_status
Note: See TracBrowser for help on using the repository browser.