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

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

Update some UI strings and docs to use the MacPorts name, rather than darwinports.

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