Ticket #14533: port

File port, 81.5 KB (added by Russell.Stringer.Bell.RIP@…, 17 years ago)

port tclsh script from macports 1.6.0 - failed to locate unmatched brace

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