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

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

Fix a bug that prevented some editors from being launched correctly; the env wasn't being properly restored for the editor. Who put that comma there? ;)

  • 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.164 2006/08/05 00:28:27 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.darwinports.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 DarwinPorts 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 "DarwinPorts [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.