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

Last change on this file since 117702 was 117702, checked in by cal@…, 7 years ago

port select --summary: format all lines equally, sort the "none" option to the back

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 178.6 KB
Line 
1#!@TCLSH@
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
3# $Id: port.tcl 117702 2014-03-08 17:24:15Z cal@macports.org $
4#
5# Copyright (c) 2004-2013 The MacPorts Project
6# Copyright (c) 2004 Robert Shaw <rshaw@opendarwin.org>
7# Copyright (c) 2002-2003 Apple Inc.
8# All rights reserved.
9#
10# Redistribution and use in source and binary forms, with or without
11# modification, are permitted provided that the following conditions
12# are met:
13# 1. Redistributions of source code must retain the above copyright
14#    notice, this list of conditions and the following disclaimer.
15# 2. Redistributions in binary form must reproduce the above copyright
16#    notice, this list of conditions and the following disclaimer in the
17#    documentation and/or other materials provided with the distribution.
18# 3. Neither the name of Apple Inc. nor the names of its contributors
19#    may be used to endorse or promote products derived from this software
20#    without specific prior written permission.
21#
22# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
23# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
24# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
25# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
26# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
27# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
28# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
29# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
30# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
31# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
32# POSSIBILITY OF SUCH DAMAGE.
33
34# Create a namespace for some local variables
35namespace eval portclient::progress {
36    ##
37    # Indicate whether the term::ansi::send tcllib package is available and was
38    # imported. "yes", if the package is available, "no" otherwise.
39    variable hasTermAnsiSend no
40}
41
42if {![catch {package require term::ansi::send}]} {
43    set portclient::progress::hasTermAnsiSend yes
44}
45
46source [file join "@macports_tcl_dir@" macports1.0 macports_fastload.tcl]
47package require macports
48package require Pextlib 1.0
49
50# Standard procedures
51proc print_usage {{verbose 1}} {
52    global cmdname
53    set syntax {
54        [-bcdfknopqRstuvy] [-D portdir] [-F cmdfile] action [privopts] [actionflags]
55        [[portname|pseudo-portname|port-url] [@version] [+-variant]... [option=value]...]...
56    }
57
58    if {$verbose} {
59        puts stderr "Usage: $cmdname$syntax"
60        puts stderr "\"$cmdname help\" or \"man 1 port\" for more information."
61    } else {
62        puts stderr "$cmdname$syntax"
63    }
64}
65
66proc print_help {args} {
67    global action_array
68
69    print_usage 0
70
71    # Generate and format the command list from the action_array
72    set cmds ""
73    set lineLen 0
74    foreach cmd [lsort [array names action_array]] {
75        if {$lineLen > 65} {
76            set cmds "$cmds,\n"
77            set lineLen 0
78        }
79        if {$lineLen == 0} {
80            set new "$cmd"
81        } else {
82            set new ", $cmd"
83        }
84        incr lineLen [string length $new]
85        set cmds "$cmds$new"
86    }
87
88    set cmdText "Supported actions
89------------------
90$cmds
91"
92
93    set text {
94Pseudo-portnames
95----------------
96Pseudo-portnames are words that may be used in place of a portname, and
97which expand to some set of ports. The common pseudo-portnames are:
98all, current, active, inactive, actinact, installed, uninstalled, outdated,
99obsolete, requested, unrequested and leaves.
100These pseudo-portnames expand to the set of ports named.
101
102Pseudo-portnames starting with variants:, variant:, description:, depends:,
103depends_lib:, depends_run:, depends_build:, depends_fetch:, depends_extract:,
104portdir:, homepage:, epoch:, platforms:, platform:, name:, long_description:,
105maintainers:, maintainer:, categories:, category:, version:, revision:, and
106license: each select a set of ports based on a regex search of metadata
107about the ports. In all such cases, a standard regex pattern following
108the colon will be used to select the set of ports to which the
109pseudo-portname expands.
110
111Pseudo-portnames starting with depof:, rdepof:, dependentof:, and rdependentof:
112select ports that are direct or recursive dependencies or dependents of the
113following portname, respectively.
114
115Portnames that contain standard glob characters will be expanded to the
116set of ports matching the glob pattern.
117   
118Port expressions
119----------------
120Portnames, port glob patterns, and pseudo-portnames may be logically
121combined using expressions consisting of and, or, not, !, (, and ).
122   
123For more information
124--------------------
125See man pages: port(1), macports.conf(5), portfile(7), portgroup(7),
126porthier(7), portstyle(7). Also, see http://www.macports.org.
127    }
128
129    puts "$cmdText$text"
130}
131
132
133# Produce error message and exit
134proc fatal s {
135    global argv0
136    ui_error "$argv0: $s"
137    exit 1
138}
139
140##
141# Helper function to define constants
142#
143# Constants defined with const can simply be accessed in the same way as
144# calling a proc.
145#
146# Example:
147# const FOO 42
148# puts [FOO]
149#
150# @param name variable name
151# @param value constant variable value
152proc const {name args} {
153    interp alias {} $name {} _const [expr $args]
154}
155
156##
157# Helper function to define constants
158#
159# @see const
160proc _const value {
161    return $value
162}
163
164
165# Format an integer representing bytes using given units
166proc bytesize {siz {unit {}} {format {%.3f}}} {
167    if {$unit == {}} {
168        if {$siz > 0x40000000} {
169            set unit "GiB"
170        } elseif {$siz > 0x100000} {
171            set unit "MiB"
172        } elseif {$siz > 0x400} {
173            set unit "KiB"
174        } else {
175            set unit "B"
176        }
177    }
178    switch -- $unit {
179        KiB {
180            set siz [expr {$siz / 1024.0}]
181        }
182        kB {
183            set siz [expr {$siz / 1000.0}]
184        }
185        MiB {
186            set siz [expr {$siz / 1048576.0}]
187        }
188        MB {
189            set siz [expr {$siz / 1000000.0}]
190        }
191        GiB {
192            set siz [expr {$siz / 1073741824.0}]
193        }
194        GB {
195            set siz [expr {$siz / 1000000000.0}]
196        }
197        B { }
198        default {
199            ui_warn "Unknown file size unit '$unit' specified"
200            set unit "B"
201        }
202    }
203    if {[expr {round($siz)}] != $siz} {
204        set siz [format $format $siz]
205    }
206    return "$siz $unit"
207}
208
209proc filesize {fil {unit {}}} {
210    set siz {@}
211    catch {
212        set siz [bytesize [file size $fil] $unit]
213    }
214    return $siz
215}
216
217# Produce an error message, and exit, unless
218# we're handling errors in a soft fashion, in which
219# case we continue
220proc fatal_softcontinue s {
221    if {[macports::global_option_isset ports_force]} {
222        ui_error $s
223        return -code continue
224    } else {
225        fatal $s
226    }
227}
228
229
230# Produce an error message, and break, unless
231# we're handling errors in a soft fashion, in which
232# case we continue
233proc break_softcontinue { msg status name_status } {
234    upvar $name_status status_var
235    ui_error $msg
236    if {[macports::ui_isset ports_processall]} {
237        set status_var 0
238        return -code continue
239    } else {
240        set status_var $status
241        return -code break
242    }
243}
244
245# show the URL for the ticket reporting instructions
246proc print_tickets_url {args} {
247    if {${macports::prefix} ne "/usr/local" && ${macports::prefix} ne "/usr"} {
248        ui_notice "To report a bug, follow the instructions in the guide:\n    http://guide.macports.org/#project.tickets"
249    }
250}
251
252# Form a composite version as is sometimes used for registry functions
253# This function sorts the variants and presents them in a canonical representation
254proc composite_version {version variations {emptyVersionOkay 0}} {
255    # Form a composite version out of the version and variations
256   
257    # Select the variations into positive and negative
258    set pos {}
259    set neg {}
260    foreach { key val } $variations {
261        if {$val eq "+"} {
262            lappend pos $key
263        } elseif {$val eq "-"} {
264            lappend neg $key
265        }
266    }
267
268    # If there is no version, we have nothing to do
269    set composite_version ""
270    if {$version ne "" || $emptyVersionOkay} {
271        set pos_str ""
272        set neg_str ""
273
274        if {[llength $pos]} {
275            set pos_str "+[join [lsort -ascii $pos] "+"]"
276        }
277        if {[llength $neg]} {
278            set neg_str "-[join [lsort -ascii $neg] "-"]"
279        }
280
281        set composite_version "$version$pos_str$neg_str"
282    }
283
284    return $composite_version
285}
286
287
288proc split_variants {variants} {
289    set result {}
290    set l [regexp -all -inline -- {([-+])([[:alpha:]_]+[\w\.]*)} $variants]
291    foreach { match sign variant } $l {
292        lappend result $variant $sign
293    }
294    return $result
295}
296
297
298##
299# Maps friendly field names to their real name
300# Names which do not need mapping are not changed.
301#
302# @param field friendly name
303# @return real name
304proc map_friendly_field_names { field } {
305    switch -- $field {
306        variant -
307        platform -
308        maintainer -
309        subport {
310            set field "${field}s"
311        }
312        category {
313            set field "categories"
314        }
315    }
316
317    return $field
318}
319
320
321proc registry_installed {portname {portversion ""}} {
322    set ilist [registry::installed $portname $portversion]
323    if { [llength $ilist] > 1 } {
324        # set portname again since the one we were passed may not have had the correct case
325        set portname [lindex $ilist 0 0]
326        ui_notice "The following versions of $portname are currently installed:"
327        foreach i [portlist_sortint $ilist] { 
328            set iname [lindex $i 0]
329            set iversion [lindex $i 1]
330            set irevision [lindex $i 2]
331            set ivariants [lindex $i 3]
332            set iactive [lindex $i 4]
333            if { $iactive == 0 } {
334                puts "  $iname @${iversion}_${irevision}${ivariants}"
335            } elseif { $iactive == 1 } {
336                puts "  $iname @${iversion}_${irevision}${ivariants} (active)"
337            }
338        }
339        return -code error "Registry error: Please specify the full version as recorded in the port registry."
340    } else {
341        return [lindex $ilist 0]
342    }
343}
344
345
346proc entry_for_portlist {portentry} {
347    global global_options global_variations
348
349    # Each portlist entry currently has the following elements in it:
350    #   url             if any
351    #   name
352    #   version         (version_revision)
353    #   variants array  (variant=>+-)
354    #   requested_variants array  (variant=>+-)
355    #   options array   (key=>value)
356    #   fullname        (name/version_revision+-variants)
357
358    array set port $portentry
359    if {![info exists port(url)]}       { set port(url) "" }
360    if {![info exists port(name)]}      { set port(name) "" }
361    if {![info exists port(version)]}   { set port(version) "" }
362    if {![info exists port(variants)]}  { set port(variants) "" }
363    if {![info exists port(requested_variants)]}  { set port(requested_variants) "" }
364    if {![info exists port(options)]}   { set port(options) [array get global_options] }
365
366    # If neither portname nor url is specified, then default to the current port
367    if { $port(url) eq "" && $port(name) eq "" } {
368        set url file://.
369        set portname [url_to_portname $url]
370        set port(url) $url
371        set port(name) $portname
372        if {$portname eq ""} {
373            ui_error "A default port name could not be supplied."
374        }
375    }
376
377    # Form the fully discriminated portname: portname/version_revison+-variants
378    set port(fullname) "$port(name)/[composite_version $port(version) $port(variants)]"
379   
380    return [array get port]
381}
382
383
384proc add_to_portlist {listname portentry} {
385    upvar $listname portlist
386   
387    # Form portlist entry and add to portlist
388    lappend portlist [entry_for_portlist $portentry]
389}
390
391
392proc add_ports_to_portlist {listname ports {overridelist ""}} {
393    upvar $listname portlist
394
395    array set overrides $overridelist
396
397    # Add each entry to the named portlist, overriding any values
398    # specified as overrides
399    foreach portentry $ports {
400        array set port $portentry
401        if ([info exists overrides(version)])   { set port(version) $overrides(version) }
402        if ([info exists overrides(variants)])  { set port(variants) $overrides(variants) }
403        if ([info exists overrides(requested_variants)])  { set port(requested_variants) $overrides(requested_variants) }
404        if ([info exists overrides(options)])   { set port(options) $overrides(options) }
405        add_to_portlist portlist [array get port]
406    }
407}
408
409
410proc url_to_portname { url {quiet 0} } {
411    # Save directory and restore the directory, since mportopen changes it
412    set savedir [pwd]
413    set portname ""
414    if {[catch {set ctx [mportopen $url]} result]} {
415        if {!$quiet} {
416            ui_msg "Can't map the URL '$url' to a port description file (\"${result}\")."
417            ui_msg "Please verify that the directory and portfile syntax are correct."
418        }
419    } else {
420        array set portinfo [mportinfo $ctx]
421        set portname $portinfo(name)
422        mportclose $ctx
423    }
424    cd $savedir
425    return $portname
426}
427
428
429# Supply a default porturl/portname if the portlist is empty
430proc require_portlist { nameportlist {is_upgrade "no"} } {
431    global private_options
432    upvar $nameportlist portlist
433
434    if {[llength $portlist] == 0 && (![info exists private_options(ports_no_args)] || $private_options(ports_no_args) eq "no")} {
435        if {${is_upgrade} == "yes"} {
436            # $> port upgrade outdated
437            # Error: No ports matched the given expression
438            # is not very user friendly - if we're in the special case of
439            # "upgrade", let's print a message that's a little easier to
440            # understand and less alarming.
441            ui_msg "Nothing to upgrade."
442            return 1
443        }
444        ui_error "No ports matched the given expression"
445        return 1
446    }
447
448    if {[llength $portlist] == 0} {
449        set portlist [get_current_port]
450
451        if {[llength $portlist] == 0} {
452            # there was no port in current directory
453            return 1
454        }
455    }
456
457    return 0
458}
459
460
461# Execute the enclosed block once for every element in the portlist
462# When the block is entered, the following variables will have been set:
463#   portspec, porturl, portname, portversion, options, variations, requested_variations
464proc foreachport {portlist block} {
465    set savedir [pwd]
466    foreach portspec $portlist {
467   
468        # Set the variables for the block
469        uplevel 1 "array unset portspec; array set portspec { $portspec }"
470        uplevel 1 {
471            set porturl $portspec(url)
472            set portname $portspec(name)
473            set portversion $portspec(version)
474            array unset variations
475            array set variations $portspec(variants)
476            array unset requested_variations
477            array set requested_variations $portspec(requested_variants)
478            array unset options
479            array set options $portspec(options)
480        }
481       
482        # Invoke block
483        uplevel 1 $block
484       
485        # Restore cwd after each port, since mportopen changes it, and otherwise relative
486        # urls would break on subsequent passes
487        if {[file exists $savedir]} {
488            cd $savedir
489        } else {
490            cd ~
491        }
492    }
493}
494
495
496proc portlist_compare { a b } {
497    array set a_ $a
498    array set b_ $b
499    set namecmp [string equal -nocase $a_(name) $b_(name)]
500    if {$namecmp != 1} {
501        if {$a_(name) eq [lindex [lsort -dictionary [list $a_(name) $b_(name)]] 0]} {
502            return -1
503        }
504        return 1
505    }
506    set avr_ [split $a_(version) "_"]
507    set bvr_ [split $b_(version) "_"]
508    set versioncmp [vercmp [lindex $avr_ 0] [lindex $bvr_ 0]]
509    if {$versioncmp != 0} {
510        return $versioncmp
511    }
512    set ar_ [lindex $avr_ 1]
513    set br_ [lindex $bvr_ 1]
514    if {$ar_ < $br_} {
515        return -1
516    } elseif {$ar_ > $br_} {
517        return 1
518    } else {
519        return 0
520    }
521}
522
523# Sort two ports in NVR (name@version_revision) order
524proc portlist_sort { list } {
525    return [lsort -command portlist_compare $list]
526}
527
528proc portlist_compareint { a b } {
529    array set a_ [list "name" [lindex $a 0] "version" "[lindex $a 1]_[lindex $a 2]"]
530    array set b_ [list "name" [lindex $b 0] "version" "[lindex $b 1]_[lindex $b 2]"]
531    return [portlist_compare [array get a_] [array get b_]]
532}
533
534# Same as portlist_sort, but with numeric indexes {name version revision}
535proc portlist_sortint { list } {
536    return [lsort -command portlist_compareint $list]
537}
538
539# sort portlist so dependents come before their dependencies
540proc portlist_sortdependents { portlist } {
541    foreach p $portlist {
542        array set pvals $p
543        lappend entries($pvals(name)) $p
544        if {![info exists dependents($pvals(name))]} {
545            set dependents($pvals(name)) {}
546            foreach result [registry::list_dependents $pvals(name)] {
547                lappend dependents($pvals(name)) [lindex $result 2]
548            }
549        }
550        array unset pvals
551    }
552    set ret {}
553    foreach p $portlist {
554        portlist_sortdependents_helper $p entries dependents seen ret
555    }
556    return $ret
557}
558
559proc portlist_sortdependents_helper {p up_entries up_dependents up_seen up_retlist} {
560    upvar $up_seen seen
561    if {![info exists seen($p)]} {
562        set seen($p) 1
563        upvar $up_entries entries $up_dependents dependents $up_retlist retlist
564        array set pvals $p
565        foreach dependent $dependents($pvals(name)) {
566            if {[info exists entries($dependent)]} {
567                foreach entry $entries($dependent) {
568                    portlist_sortdependents_helper $entry entries dependents seen retlist
569                }
570            }
571        }
572        lappend retlist $p
573    }
574}
575
576proc regex_pat_sanitize { s } {
577    set sanitized [regsub -all {[\\(){}+$.^]} $s {\\&}]
578    return $sanitized
579}
580
581##
582# Makes sure we get the current terminal size
583proc term_init_size {} {
584    global env
585
586    if {![info exists env(COLUMNS)] || ![info exists env(LINES)]} {
587        if {[isatty stdout]} {
588            set size [term_get_size stdout]
589
590            if {![info exists env(LINES)] && [lindex $size 0] > 0} {
591                set env(LINES) [lindex $size 0]
592            }
593
594            if {![info exists env(COLUMNS)] && [lindex $size 1] > 0} {
595                set env(COLUMNS) [lindex $size 1]
596            }
597        }
598    }
599}
600
601##
602# Wraps a multi-line string at specified textwidth
603#
604# @see wrapline
605#
606# @param string input string
607# @param maxlen text width (0 defaults to current terminal width)
608# @param indent prepend to every line
609# @return wrapped string
610proc wrap {string maxlen {indent ""} {indentfirstline 1}} {
611    global env
612
613    if {$maxlen == 0} {
614        if {![info exists env(COLUMNS)]} {
615            # no width for wrapping
616            return $string
617        }
618        set maxlen $env(COLUMNS)
619    }
620
621    set splitstring {}
622    set indentline $indentfirstline
623    foreach line [split $string "\n"] {
624        lappend splitstring [wrapline $line $maxlen $indent $indentline]
625        set indentline 1
626    }
627    return [join $splitstring "\n"]
628}
629
630##
631# Wraps a line at specified textwidth
632#
633# @see wrap
634#
635# @param line input line
636# @param maxlen text width (0 defaults to current terminal width)
637# @param indent prepend to every line
638# @return wrapped string
639proc wrapline {line maxlen {indent ""} {indentfirstline 1}} {
640    global env
641
642    if {$maxlen == 0} {
643        if {![info exists env(COLUMNS)]} {
644            # no width for wrapping
645            return $string
646        }
647        set maxlen $env(COLUMNS)
648    }
649
650    set string [split $line " "]
651    if {$indentfirstline == 0} {
652        set newline ""
653        set maxlen [expr {$maxlen - [string length $indent]}]
654    } else {
655        set newline $indent
656    }
657    append newline [lindex $string 0]
658    set joiner " "
659    set first 1
660    foreach word [lrange $string 1 end] {
661        if {[string length $newline]+[string length $word] >= $maxlen} {
662            lappend lines $newline
663            set newline $indent
664            set joiner ""
665            # If indentfirstline is set to 0, reset maxlen to its
666            # original length after appending the first line to lines.
667            if {$first == 1 && $indentfirstline == 0} {
668                set maxlen [expr {$maxlen + [string length $indent]}]
669            }
670            set first 0
671        }
672        append newline $joiner $word
673        set joiner " "
674    }
675    lappend lines $newline
676    return [join $lines "\n"]
677}
678
679##
680# Wraps a line at a specified width with a label in front
681#
682# @see wrap
683#
684# @param label label for output
685# @param string input string
686# @param maxlen text width (0 defaults to current terminal width)
687# @return wrapped string
688proc wraplabel {label string maxlen {indent ""}} {
689    append label ": [string repeat " " [expr {[string length $indent] - [string length "$label: "]}]]"
690    return "$label[wrap $string $maxlen $indent 0]"
691}
692
693proc unobscure_maintainers { list } {
694    set result {}
695    foreach m $list {
696        if {[string first "@" $m] < 0} {
697            if {[string first ":" $m] >= 0} {
698                set m [regsub -- "(.*):(.*)" $m "\\2@\\1"] 
699            } else {
700                set m "$m@macports.org"
701            }
702        }
703        lappend result $m
704    }
705    return $result
706}
707
708
709##########################################
710# Port selection
711##########################################
712proc unique_results_to_portlist {infos} {
713    set result {}
714    array unset unique
715    foreach {name info} $infos {
716        array unset portinfo
717        array set portinfo $info
718       
719        set portentry [entry_for_portlist [list url $portinfo(porturl) name $name]]
720       
721        array unset entry
722        array set entry $portentry
723       
724        if {[info exists unique($entry(fullname))]} continue
725        set unique($entry(fullname)) 1
726       
727        lappend result $portentry
728    }
729    return $result
730}
731
732
733proc get_matching_ports {pattern {casesensitive no} {matchstyle glob} {field name}} {
734    if {[catch {set res [mportsearch $pattern $casesensitive $matchstyle $field]} result]} {
735        global errorInfo
736        ui_debug "$errorInfo"
737        fatal "search for portname $pattern failed: $result"
738    }
739    set results [unique_results_to_portlist $res]
740   
741    # Return the list of all ports, sorted
742    return [portlist_sort $results]
743}
744
745
746proc get_all_ports {} {
747    global all_ports_cache
748
749    if {![info exists all_ports_cache]} {
750         if {[catch {set res [mportlistall]} result]} {
751            global errorInfo
752            ui_debug "$errorInfo"
753            fatal "listing all ports failed: $result"
754        }
755        set results [unique_results_to_portlist $res]
756        set all_ports_cache [portlist_sort $results]
757    }
758    return $all_ports_cache
759}
760
761
762proc get_current_ports {} {
763    # This is just a synonym for get_current_port that
764    # works with the regex in element
765    return [get_current_port]
766}
767
768
769proc get_current_port {} {
770    set url file://.
771    set portname [url_to_portname $url]
772    if {$portname eq ""} {
773        ui_msg "To use the current port, you must be in a port's directory."
774        return [list]
775    }
776
777    set results {}
778    add_to_portlist results [list url $url name $portname]
779    return $results
780}
781
782
783proc get_installed_ports { {ignore_active yes} {active yes} } {
784    set ilist {}
785    if { [catch {set ilist [registry::installed]} result] } {
786        if {$result ne "Registry error: No ports registered as installed."} {
787            global errorInfo
788            ui_debug "$errorInfo"
789            fatal "port installed failed: $result"
790        }
791    }
792
793    set results {}
794    foreach i $ilist {
795        set iname [lindex $i 0]
796        set iversion [lindex $i 1]
797        set irevision [lindex $i 2]
798        set ivariants [split_variants [lindex $i 3]]
799        set iactive [lindex $i 4]
800
801        if { ${ignore_active} == "yes" || (${active} == "yes") == (${iactive} != 0) } {
802            add_to_portlist results [list name $iname version "${iversion}_${irevision}" variants $ivariants]
803        }
804    }
805
806    # Return the list of ports, sorted
807    return [portlist_sort $results]
808}
809
810
811proc get_uninstalled_ports {} {
812    # Return all - installed
813    set all [get_all_ports]
814    set installed [get_installed_ports]
815    return [opComplement $all $installed]
816}
817
818
819proc get_active_ports {} {
820    return [get_installed_ports no yes]
821}
822
823
824proc get_inactive_ports {} {
825    return [get_installed_ports no no]
826}
827
828proc get_actinact_ports {} {
829    set inactive_ports [get_inactive_ports]
830    set active_ports [get_active_ports]
831    set results {}
832
833    foreach port $inactive_ports {
834        array set portspec $port
835        set portname $portspec(name)
836        lappend inact($portname) $port
837    }
838
839    foreach port $active_ports {
840        array set portspec $port
841        set portname $portspec(name)
842
843        if {[info exists inact($portname)]} {
844            if {![info exists added_inact($portname)]} {
845                foreach inact_spec $inact($portname) {
846                    lappend results $inact_spec
847                }
848                set added_inact($portname) 1
849            }
850            lappend results $port
851        }
852    }
853    return $results
854}
855
856
857proc get_outdated_ports {} {
858    # Get the list of installed ports
859    set ilist {}
860    if { [catch {set ilist [registry::installed]} result] } {
861        if {$result ne "Registry error: No ports registered as installed."} {
862            global errorInfo
863            ui_debug "$errorInfo"
864            fatal "port installed failed: $result"
865        }
866    }
867
868    # Now process the list, keeping only those ports that are outdated
869    set results {}
870    if { [llength $ilist] > 0 } {
871        foreach i $ilist {
872
873            # Get information about the installed port
874            set portname            [lindex $i 0]
875            set installed_version   [lindex $i 1]
876            set installed_revision  [lindex $i 2]
877            set installed_compound  "${installed_version}_${installed_revision}"
878            set installed_variants  [lindex $i 3]
879
880            set is_active           [lindex $i 4]
881            if {$is_active == 0} continue
882
883            set installed_epoch     [lindex $i 5]
884
885            # Get info about the port from the index
886            if {[catch {set res [mportlookup $portname]} result]} {
887                global errorInfo
888                ui_debug "$errorInfo"
889                fatal "lookup of portname $portname failed: $result"
890            }
891            if {[llength $res] < 2} {
892                if {[macports::ui_isset ports_debug]} {
893                    puts stderr "$portname ($installed_compound is installed; the port was not found in the port index)"
894                }
895                continue
896            }
897            array unset portinfo
898            array set portinfo [lindex $res 1]
899
900            # Get information about latest available version and revision
901            set latest_version $portinfo(version)
902            set latest_revision     0
903            if {[info exists portinfo(revision)] && $portinfo(revision) > 0} { 
904                set latest_revision $portinfo(revision)
905            }
906            set latest_compound     "${latest_version}_${latest_revision}"
907            set latest_epoch        0
908            if {[info exists portinfo(epoch)]} { 
909                set latest_epoch    $portinfo(epoch)
910            }
911
912            # Compare versions, first checking epoch, then version, then revision
913            set comp_result 0
914            if {$installed_version != $latest_version} {
915                set comp_result [expr {$installed_epoch - $latest_epoch}]
916                if { $comp_result == 0 } {
917                    set comp_result [vercmp $installed_version $latest_version]
918                }
919            }
920            if { $comp_result == 0 } {
921                set comp_result [expr {$installed_revision - $latest_revision}]
922            }
923            if {$comp_result == 0} {
924                set regref [registry::open_entry $portname $installed_version $installed_revision $installed_variants $installed_epoch]
925                set os_platform_installed [registry::property_retrieve $regref os_platform]
926                set os_major_installed [registry::property_retrieve $regref os_major]
927                if {$os_platform_installed ne "" && $os_platform_installed != 0
928                    && $os_major_installed ne "" && $os_major_installed != 0
929                    && ($os_platform_installed != ${macports::os_platform} || $os_major_installed != ${macports::os_major})} {
930                    set comp_result -1
931                }
932            }
933
934            # Add outdated ports to our results list
935            if { $comp_result < 0 } {
936                add_to_portlist results [list name $portname version $installed_compound variants [split_variants $installed_variants]]
937            }
938        }
939    }
940
941    return [portlist_sort $results]
942}
943
944
945proc get_obsolete_ports {} {
946    set ilist [get_installed_ports]
947    set results {}
948
949    foreach i $ilist {
950        array set port $i
951
952        if {[catch {mportlookup $port(name)} result]} {
953            ui_debug "$::errorInfo"
954            break_softcontinue "lookup of portname $portname failed: $result" 1 status
955        }
956
957        if {[llength $result] < 2} {
958            lappend results $i
959        }
960    }
961
962    # Return the list of ports, already sorted
963    return [portlist_sort $results]
964}
965
966# return ports that have registry property $propname set to $propval
967proc get_ports_with_prop {propname propval} {
968    set ilist {}
969    if { [catch {set ilist [registry::installed]} result] } {
970        if {$result ne "Registry error: No ports registered as installed."} {
971            global errorInfo
972            ui_debug "$errorInfo"
973            fatal "port installed failed: $result"
974        }
975    }
976
977    set results {}
978    foreach i $ilist {
979        set iname [lindex $i 0]
980        set iversion [lindex $i 1]
981        set irevision [lindex $i 2]
982        set ivariants [lindex $i 3]
983        set iepoch [lindex $i 5]
984        set regref [registry::open_entry $iname $iversion $irevision $ivariants $iepoch]
985        if {[registry::property_retrieve $regref $propname] == $propval} {
986            add_to_portlist results [list name $iname version "${iversion}_${irevision}" variants [split_variants $ivariants]]
987        }
988    }
989
990    # Return the list of ports, sorted
991    return [portlist_sort $results]
992}
993
994proc get_requested_ports {} {
995    return [get_ports_with_prop requested 1]
996}
997
998proc get_unrequested_ports {} {
999    return [get_ports_with_prop requested 0]
1000}
1001
1002proc get_leaves_ports {} {
1003    set ilist {}
1004    if { [catch {set ilist [registry::installed]} result] } {
1005        if {$result ne "Registry error: No ports registered as installed."} {
1006            global errorInfo
1007            ui_debug "$errorInfo"
1008            fatal "port installed failed: $result"
1009        }
1010    }
1011    registry::open_dep_map
1012    set results {}
1013    foreach i $ilist {
1014        set iname [lindex $i 0]
1015        if {[registry::list_dependents $iname] eq ""} {
1016            add_to_portlist results [list name $iname version "[lindex $i 1]_[lindex $i 2]" variants [split_variants [lindex $i 3]]]
1017        }
1018    }
1019    return [portlist_sort [opIntersection $results [get_unrequested_ports]]]
1020}
1021
1022proc get_dependent_ports {portname recursive} {
1023    registry::open_dep_map
1024    set deplist [registry::list_dependents $portname]
1025    # could return specific versions here using registry2.0 features
1026    set results {}
1027    foreach dep $deplist {
1028        add_to_portlist results [list name [lindex $dep 2]]
1029    }
1030
1031    # actually do this iteratively to avoid hitting Tcl's recursion limit
1032    if {$recursive} {
1033        while 1 {
1034            set rportlist {}
1035            set newlist {}
1036            foreach dep $deplist {
1037                set depname [lindex $dep 2]
1038                if {![info exists seen($depname)]} {
1039                    set seen($depname) 1
1040                    set rdeplist [registry::list_dependents $depname]
1041                    foreach rdep $rdeplist {
1042                        lappend newlist $rdep
1043                        add_to_portlist rportlist [list name [lindex $rdep 2]]
1044                    }
1045                }
1046            }
1047            if {[llength $rportlist] > 0} {
1048                set results [opUnion $results $rportlist]
1049                set deplist $newlist
1050            } else {
1051                break
1052            }
1053        }
1054    }
1055
1056    return [portlist_sort $results]
1057}
1058
1059
1060proc get_dep_ports {portname recursive} {
1061    global global_variations
1062
1063    # look up portname
1064    if {[catch {mportlookup $portname} result]} {
1065        ui_debug "$::errorInfo"
1066        return -code error "lookup of portname $portname failed: $result"
1067    }
1068    if {[llength $result] < 2} {
1069        return -code error "Port $portname not found"
1070    }
1071    array unset portinfo
1072    array set portinfo [lindex $result 1]
1073    set porturl $portinfo(porturl)
1074
1075    # open portfile
1076    if {[catch {set mport [mportopen $porturl [list subport $portinfo(name)] [array get global_variations]]} result]} {
1077        ui_debug "$::errorInfo"
1078        return -code error "Unable to open port: $result"
1079    }
1080    array unset portinfo
1081    array set portinfo [mportinfo $mport]
1082    mportclose $mport
1083
1084    # gather its deps
1085    set results {}
1086    set deptypes {depends_fetch depends_extract depends_build depends_lib depends_run}
1087
1088    set deplist {}
1089    foreach type $deptypes {
1090        if {[info exists portinfo($type)]} {
1091            foreach dep $portinfo($type) {
1092                add_to_portlist results [list name [lindex [split $dep :] end]]
1093                lappend deplist $dep
1094            }
1095        }
1096    }
1097
1098    # actually do this iteratively to avoid hitting Tcl's recursion limit
1099    if {$recursive} {
1100        while 1 {
1101            set rportlist {}
1102            set newlist {}
1103            foreach dep $deplist {
1104                set depname [lindex [split $dep :] end]
1105                if {![info exists seen($depname)]} {
1106                    set seen($depname) 1
1107
1108                    # look up the dep
1109                    if {[catch {mportlookup $depname} result]} {
1110                        ui_debug "$::errorInfo"
1111                        return -code error "lookup of portname $depname failed: $result"
1112                    }
1113                    if {[llength $result] < 2} {
1114                        ui_error "Port $depname not found"
1115                        continue
1116                    }
1117                    array unset portinfo
1118                    array set portinfo [lindex $result 1]
1119                    set porturl $portinfo(porturl)
1120               
1121                    # open its portfile
1122                    if {[catch {set mport [mportopen $porturl [list subport $portinfo(name)] [array get global_variations]]} result]} {
1123                        ui_debug "$::errorInfo"
1124                        ui_error "Unable to open port: $result"
1125                        continue
1126                    }
1127                    array unset portinfo
1128                    array set portinfo [mportinfo $mport]
1129                    mportclose $mport
1130
1131                    # collect its deps
1132                    set rdeplist {}
1133                    foreach type $deptypes {
1134                        if {[info exists portinfo($type)]} {
1135                            foreach rdep $portinfo($type) {
1136                                add_to_portlist results [list name [lindex [split $rdep :] end]]
1137                                lappend rdeplist $rdep
1138                            }
1139                        }
1140                    }
1141
1142                    # add them to the lists
1143                    foreach rdep $rdeplist {
1144                        lappend newlist $rdep
1145                        add_to_portlist rportlist [list name [lindex [split $rdep :] end]]
1146                    }
1147                }
1148            }
1149            if {[llength $rportlist] > 0} {
1150                set results [opUnion $results $rportlist]
1151                set deplist $newlist
1152            } else {
1153                break
1154            }
1155        }
1156    }
1157
1158    return [portlist_sort $results]
1159}
1160
1161proc get_subports {portname} {
1162    global global_variations
1163
1164    # look up portname
1165    if {[catch {mportlookup $portname} result]} {
1166        ui_debug "$::errorInfo"
1167        return -code error "lookup of portname $portname failed: $result"
1168    }
1169    if {[llength $result] < 2} {
1170        return -code error "Port $portname not found"
1171    }
1172    array unset portinfo
1173    array set portinfo [lindex $result 1]
1174    set porturl $portinfo(porturl)
1175
1176    # open portfile
1177    if {[catch {set mport [mportopen $porturl [list subport $portinfo(name)] [array get global_variations]]} result]} {
1178        ui_debug "$::errorInfo"
1179        return -code error "Unable to open port: $result"
1180    }
1181    array unset portinfo
1182    array set portinfo [mportinfo $mport]
1183    mportclose $mport
1184
1185    # gather its subports
1186    set results {}
1187
1188    if {[info exists portinfo(subports)]} {
1189        foreach subport $portinfo(subports) {
1190            add_to_portlist results [list name $subport]
1191        }
1192    }
1193
1194    return [portlist_sort $results]
1195}
1196
1197
1198##########################################
1199# Port expressions
1200##########################################
1201proc portExpr { resname } {
1202    upvar $resname reslist
1203    set result [seqExpr reslist]
1204    return $result
1205}
1206
1207
1208proc seqExpr { resname } {
1209    upvar $resname reslist
1210   
1211    # Evaluate a sequence of expressions a b c...
1212    # These act the same as a or b or c
1213
1214    set result 1
1215    while {$result} {
1216        switch -- [lookahead] {
1217            ;       -
1218            )       -
1219            _EOF_   { break }
1220        }
1221
1222        set blist {}
1223        set result [orExpr blist]
1224        if {$result} {
1225            # Calculate the union of result and b
1226            set reslist [opUnion $reslist $blist]
1227        }
1228    }
1229   
1230    return $result
1231}
1232
1233
1234proc orExpr { resname } {
1235    upvar $resname reslist
1236   
1237    set a [andExpr reslist]
1238    while ($a) {
1239        switch -- [lookahead] {
1240            or {
1241                    advance
1242                    set blist {}
1243                    if {![andExpr blist]} {
1244                        return 0
1245                    }
1246                       
1247                    # Calculate a union b
1248                    set reslist [opUnion $reslist $blist]
1249                }
1250            default {
1251                    return $a
1252                }
1253        }
1254    }
1255   
1256    return $a
1257}
1258
1259
1260proc andExpr { resname } {
1261    upvar $resname reslist
1262   
1263    set a [unaryExpr reslist]
1264    while {$a} {
1265        switch -- [lookahead] {
1266            and {
1267                    advance
1268                   
1269                    set blist {}
1270                    set b [unaryExpr blist]
1271                    if {!$b} {
1272                        return 0
1273                    }
1274                   
1275                    # Calculate a intersect b
1276                    set reslist [opIntersection $reslist $blist]
1277                }
1278            default {
1279                    return $a
1280                }
1281        }
1282    }
1283   
1284    return $a
1285}
1286
1287
1288proc unaryExpr { resname } {
1289    upvar $resname reslist
1290    set result 0
1291
1292    switch -- [lookahead] {
1293        !   -
1294        not {
1295                advance
1296                set blist {}
1297                set result [unaryExpr blist]
1298                if {$result} {
1299                    set all [get_all_ports]
1300                    set reslist [opComplement $all $blist]
1301                }
1302            }
1303        default {
1304                set result [element reslist]
1305            }
1306    }
1307   
1308    return $result
1309}
1310
1311
1312proc element { resname } {
1313    upvar $resname reslist
1314    set el 0
1315   
1316    set url ""
1317    set name ""
1318    set version ""
1319    array unset requested_variants
1320    array unset options
1321   
1322    set token [lookahead]
1323    switch -regex -- $token {
1324        ^\\)$               -
1325        ^\;                 -
1326        ^_EOF_$             { # End of expression/cmd/file
1327        }
1328
1329        ^\\($               { # Parenthesized Expression
1330            advance
1331            set el [portExpr reslist]
1332            if {!$el || ![match ")"]} {
1333                set el 0
1334            }
1335        }
1336
1337        ^all(@.*)?$         -
1338        ^installed(@.*)?$   -
1339        ^uninstalled(@.*)?$ -
1340        ^active(@.*)?$      -
1341        ^inactive(@.*)?$    -
1342        ^actinact(@.*)?$    -
1343        ^leaves(@.*)?$      -
1344        ^outdated(@.*)?$    -
1345        ^obsolete(@.*)?$    -
1346        ^requested(@.*)?$   -
1347        ^unrequested(@.*)?$ -
1348        ^current(@.*)?$     {
1349            # A simple pseudo-port name
1350            advance
1351
1352            # Break off the version component, if there is one
1353            regexp {^(\w+)(@.*)?} $token matchvar name remainder
1354
1355            add_multiple_ports reslist [get_${name}_ports] $remainder
1356
1357            set el 1
1358        }
1359
1360        ^variants:          -
1361        ^variant:           -
1362        ^description:       -
1363        ^portdir:           -
1364        ^homepage:          -
1365        ^epoch:             -
1366        ^platforms:         -
1367        ^platform:          -
1368        ^name:              -
1369        ^long_description:  -
1370        ^maintainers:       -
1371        ^maintainer:        -
1372        ^categories:        -
1373        ^category:          -
1374        ^version:           -
1375        ^depends_lib:       -
1376        ^depends_build:     -
1377        ^depends_run:       -
1378        ^depends_extract:   -
1379        ^depends_fetch:     -
1380        ^replaced_by:       -
1381        ^revision:          -
1382        ^subport:           -
1383        ^subports:          -
1384        ^license:           { # Handle special port selectors
1385            advance
1386
1387            # Break up the token, because older Tcl switch doesn't support -matchvar
1388            regexp {^(\w+):(.*)} $token matchvar field pat
1389
1390            # Remap friendly names to actual names
1391            set field [map_friendly_field_names $field]
1392
1393            add_multiple_ports reslist [get_matching_ports $pat no regexp $field]
1394            set el 1
1395        }
1396
1397        ^depends:           { # A port selector shorthand for depends_{lib,build,run,fetch,extract}
1398            advance
1399
1400            # Break up the token, because older Tcl switch doesn't support -matchvar
1401            regexp {^(\w+):(.*)} $token matchvar field pat
1402
1403            add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_lib"]
1404            add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_build"]
1405            add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_run"]
1406            add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_extract"]
1407            add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_fetch"]
1408
1409            set el 1
1410        }
1411
1412        ^dependentof:       -
1413        ^rdependentof:      {
1414            advance
1415
1416            # Break up the token, because older Tcl switch doesn't support -matchvar
1417            regexp {^(\w+):(.*)} $token matchvar selector portname
1418
1419            set recursive [string equal $selector "rdependentof"]
1420            add_multiple_ports reslist [get_dependent_ports $portname $recursive]
1421           
1422            set el 1
1423        }
1424       
1425        ^depof:             -
1426        ^rdepof:            {
1427            advance
1428
1429            # Break up the token, because older Tcl switch doesn't support -matchvar
1430            regexp {^(\w+):(.*)} $token matchvar selector portname
1431
1432            set recursive [string equal $selector "rdepof"]
1433            add_multiple_ports reslist [get_dep_ports $portname $recursive]
1434           
1435            set el 1
1436        }
1437
1438        ^subportof:         {
1439            advance
1440
1441            # Break up the token, because older Tcl switch doesn't support -matchvar
1442            regexp {^(\w+):(.*)} $token matchvar selector portname
1443
1444            add_multiple_ports reslist [get_subports $portname]
1445
1446            set el 1
1447        }
1448
1449        [][?*]              { # Handle portname glob patterns
1450            advance; add_multiple_ports reslist [get_matching_ports $token no glob]
1451            set el 1
1452        }
1453
1454        ^\\w+:.+            { # Handle a url by trying to open it as a port and mapping the name
1455            advance
1456            set name [url_to_portname $token]
1457            if {$name ne ""} {
1458                parsePortSpec version requested_variants options
1459                add_to_portlist reslist [list url $token \
1460                  name $name \
1461                  version $version \
1462                  requested_variants [array get requested_variants] \
1463                  variants [array get requested_variants] \
1464                  options [array get options]]
1465                set el 1
1466            } else {
1467                ui_error "Can't open URL '$token' as a port"
1468                set el 0
1469            }
1470        }
1471
1472        default             { # Treat anything else as a portspec (portname, version, variants, options
1473            # or some combination thereof).
1474            parseFullPortSpec url name version requested_variants options
1475            add_to_portlist reslist [list url $url \
1476              name $name \
1477              version $version \
1478              requested_variants [array get requested_variants] \
1479              variants [array get requested_variants] \
1480              options [array get options]]
1481            set el 1
1482        }
1483    }
1484
1485    return $el
1486}
1487
1488
1489proc add_multiple_ports { resname ports {remainder ""} } {
1490    upvar $resname reslist
1491   
1492    set version ""
1493    array unset variants
1494    array unset options
1495    parsePortSpec version variants options $remainder
1496   
1497    array unset overrides
1498    if {$version ne ""} { set overrides(version) $version }
1499    if {[array size variants]} {
1500        # we always record the requested variants separately,
1501        # but requested ones always override existing ones
1502        set overrides(requested_variants) [array get variants]
1503        set overrides(variants) [array get variants]
1504    }
1505    if {[array size options]} { set overrides(options) [array get options] }
1506
1507    add_ports_to_portlist reslist $ports [array get overrides]
1508}
1509
1510
1511proc unique_entries { entries } {
1512    # Form the list of all the unique elements in the list a,
1513    # considering only the port fullname, and taking the first
1514    # found element first
1515    set result {}
1516    array unset unique
1517    foreach item $entries {
1518        array set port $item
1519        if {[info exists unique($port(fullname))]} continue
1520        set unique($port(fullname)) 1
1521        lappend result $item
1522    }
1523    return $result
1524}
1525
1526
1527proc opUnion { a b } {
1528    # Return the unique elements in the combined two lists
1529    return [unique_entries [concat $a $b]]
1530}
1531
1532
1533proc opIntersection { a b } {
1534    set result {}
1535   
1536    # Rules we follow in performing the intersection of two port lists:
1537    #
1538    #   a/, a/          ==> a/
1539    #   a/, b/          ==>
1540    #   a/, a/1.0       ==> a/1.0
1541    #   a/1.0, a/       ==> a/1.0
1542    #   a/1.0, a/2.0    ==>
1543    #
1544    #   If there's an exact match, we take it.
1545    #   If there's a match between simple and discriminated, we take the later.
1546   
1547    # First create a list of the fully discriminated names in b
1548    array unset bfull
1549    set i 0
1550    foreach bitem [unique_entries $b] {
1551        array set port $bitem
1552        set bfull($port(fullname)) $i
1553        incr i
1554    }
1555   
1556    # Walk through each item in a, matching against b
1557    foreach aitem [unique_entries $a] {
1558        array set port $aitem
1559       
1560        # Quote the fullname and portname to avoid special characters messing up the regexp
1561        set safefullname [regex_pat_sanitize $port(fullname)]
1562       
1563        set simpleform [expr { "$port(name)/" == $port(fullname) }]
1564        if {$simpleform} {
1565            set pat "^${safefullname}"
1566        } else {
1567            set safename [regex_pat_sanitize $port(name)]
1568            set pat "^${safefullname}$|^${safename}/$"
1569        }
1570       
1571        set matches [array names bfull -regexp $pat]
1572        foreach match $matches {
1573            if {$simpleform} {
1574                set i $bfull($match)
1575                lappend result [lindex $b $i]
1576            } else {
1577                lappend result $aitem
1578            }
1579        }
1580    }
1581   
1582    return $result
1583}
1584
1585
1586proc opComplement { a b } {
1587    set result {}
1588   
1589    # Return all elements of a not matching elements in b
1590   
1591    # First create a list of the fully discriminated names in b
1592    array unset bfull
1593    set i 0
1594    foreach bitem $b {
1595        array set port $bitem
1596        set bfull($port(fullname)) $i
1597        incr i
1598    }
1599   
1600    # Walk through each item in a, taking all those items that don't match b
1601    foreach aitem $a {
1602        array set port $aitem
1603       
1604        # Quote the fullname and portname to avoid special characters messing up the regexp
1605        set safefullname [regex_pat_sanitize $port(fullname)]
1606       
1607        set simpleform [expr { "$port(name)/" == $port(fullname) }]
1608        if {$simpleform} {
1609            set pat "^${safefullname}"
1610        } else {
1611            set safename [regex_pat_sanitize $port(name)]
1612            set pat "^${safefullname}$|^${safename}/$"
1613        }
1614       
1615        set matches [array names bfull -regexp $pat]
1616
1617        # We copy this element to result only if it didn't match against b
1618        if {![llength $matches]} {
1619            lappend result $aitem
1620        }
1621    }
1622   
1623    return $result
1624}
1625
1626
1627proc parseFullPortSpec { urlname namename vername varname optname } {
1628    upvar $urlname porturl
1629    upvar $namename portname
1630    upvar $vername portversion
1631    upvar $varname portvariants
1632    upvar $optname portoptions
1633   
1634    set portname ""
1635    set portversion ""
1636    array unset portvariants
1637    array unset portoptions
1638   
1639    if { [moreargs] } {
1640        # Look first for a potential portname
1641        #
1642        # We need to allow a wide variety of tokens here, because of actions like "provides"
1643        # so we take a rather lenient view of what a "portname" is. We allow
1644        # anything that doesn't look like either a version, a variant, or an option
1645        set token [lookahead]
1646
1647        set remainder ""
1648        if {![regexp {^(@|[-+]([[:alpha:]_]+[\w\.]*)|[[:alpha:]_]+[\w\.]*=)} $token match]} {
1649            advance
1650            regexp {^([^@]+)(@.*)?} $token match portname remainder
1651           
1652            # If the portname contains a /, then try to use it as a URL
1653            if {[string match "*/*" $portname]} {
1654                set url "file://$portname"
1655                set name [url_to_portname $url 1]
1656                if { $name ne "" } {
1657                    # We mapped the url to valid port
1658                    set porturl $url
1659                    set portname $name
1660                    # Continue to parse rest of portspec....
1661                } else {
1662                    # We didn't map the url to a port; treat it
1663                    # as a raw string for something like port contents
1664                    # or cd
1665                    set porturl ""
1666                    # Since this isn't a port, we don't try to parse
1667                    # any remaining portspec....
1668                    return
1669                }
1670            }
1671        }
1672       
1673        # Now parse the rest of the spec
1674        parsePortSpec portversion portvariants portoptions $remainder
1675    }
1676}
1677
1678# check if the install prefix is writable
1679# should be called by actions that will modify it
1680proc prefix_unwritable {} {
1681    global macports::portdbpath
1682    if {[file writable $portdbpath]} {
1683        return 0
1684    } else {
1685        ui_error "Insufficient privileges to write to MacPorts install prefix."
1686        return 1
1687    }
1688}
1689
1690   
1691proc parsePortSpec { vername varname optname {remainder ""} } {
1692    upvar $vername portversion
1693    upvar $varname portvariants
1694    upvar $optname portoptions
1695   
1696    global global_options
1697   
1698    set portversion ""
1699    array unset portoptions
1700    array set portoptions [array get global_options]
1701    array unset portvariants
1702   
1703    # Parse port version/variants/options
1704    set opt $remainder
1705    set adv 0
1706    set consumed 0
1707    for {set firstTime 1} {$opt ne "" || [moreargs]} {set firstTime 0} {
1708   
1709        # Refresh opt as needed
1710        if {$opt eq ""} {
1711            if {$adv} advance
1712            set opt [lookahead]
1713            set adv 1
1714            set consumed 0
1715        }
1716       
1717        # Version must be first, if it's there at all
1718        if {$firstTime && [string match {@*} $opt]} {
1719            # Parse the version
1720           
1721            # Strip the @
1722            set opt [string range $opt 1 end]
1723           
1724            # Handle the version
1725            set sepPos [string first "/" $opt]
1726            if {$sepPos >= 0} {
1727                # Version terminated by "/" to disambiguate -variant from part of version
1728                set portversion [string range $opt 0 [expr {$sepPos - 1}]]
1729                set opt [string range $opt [expr {$sepPos + 1}] end]
1730            } else {
1731                # Version terminated by "+", or else is complete
1732                set sepPos [string first "+" $opt]
1733                if {$sepPos >= 0} {
1734                    # Version terminated by "+"
1735                    set portversion [string range $opt 0 [expr {$sepPos - 1}]]
1736                    set opt [string range $opt $sepPos end]
1737                } else {
1738                    # Unterminated version
1739                    set portversion $opt
1740                    set opt ""
1741                }
1742            }
1743            set consumed 1
1744        } else {
1745            # Parse all other options
1746           
1747            # Look first for a variable setting: VARNAME=VALUE
1748            if {[regexp {^([[:alpha:]_]+[\w\.]*)=(.*)} $opt match key val] == 1} {
1749                # It's a variable setting
1750                set portoptions($key) "\"$val\""
1751                set opt ""
1752                set consumed 1
1753            } elseif {[regexp {^([-+])([[:alpha:]_]+[\w\.]*)} $opt match sign variant] == 1} {
1754                # It's a variant
1755                set portvariants($variant) $sign
1756                set opt [string range $opt [expr {[string length $variant] + 1}] end]
1757                set consumed 1
1758            } else {
1759                # Not an option we recognize, so break from port option processing
1760                if { $consumed && $adv } advance
1761                break
1762            }
1763        }
1764    }
1765}
1766
1767
1768##########################################
1769# Action Handlers
1770##########################################
1771
1772proc action_get_usage { action } {
1773    global action_array cmd_opts_array
1774
1775    if {[info exists action_array($action)]} {
1776        set cmds ""
1777        if {[info exists cmd_opts_array($action)]} {
1778            foreach opt $cmd_opts_array($action) {
1779                if {[llength $opt] == 1} {
1780                    set name $opt
1781                    set optc 0
1782                } else {
1783                    set name [lindex $opt 0]
1784                    set optc [lindex $opt 1]
1785                }
1786
1787                append cmds " --$name"
1788
1789                for {set i 1} {$i <= $optc} {incr i} {
1790                    append cmds " <arg$i>"
1791                }
1792            }
1793        }
1794        set args ""
1795        set needed [action_needs_portlist $action]
1796        if {[ACTION_ARGS_STRINGS] == $needed} {
1797            set args " <arguments>"
1798        } elseif {[ACTION_ARGS_STRINGS] == $needed} {
1799            set args " <portlist>"
1800        }
1801
1802        set ret "Usage: "
1803        set len [string length $action]
1804        append ret [wrap "$action$cmds$args" 0 [string repeat " " [expr {8 + $len}]] 0]
1805        append ret "\n"
1806
1807        return $ret
1808    }
1809
1810    return -1
1811}
1812
1813proc action_usage { action portlist opts } {
1814    if {[llength $portlist] == 0} {
1815        print_usage
1816        return 0
1817    }
1818
1819    foreach topic $portlist {
1820        set usage [action_get_usage $topic]
1821        if {$usage != -1} {
1822           puts -nonewline stderr $usage
1823        } else {
1824            ui_error "No usage for topic $topic"
1825            return 1
1826        }
1827    }
1828    return 0
1829}
1830
1831
1832proc action_help { action portlist opts } {
1833    set helpfile "$macports::prefix/var/macports/port-help.tcl"
1834
1835    if {[llength $portlist] == 0} {
1836        print_help
1837        return 0
1838    }
1839
1840    if {[file exists $helpfile]} {
1841        if {[catch {source $helpfile} err]} {
1842            puts stderr "Error reading helpfile $helpfile: $err"
1843            return 1
1844        }
1845    } else {
1846        puts stderr "Unable to open help file $helpfile"
1847        return 1
1848    }
1849
1850    foreach topic $portlist {
1851        if {![info exists porthelp($topic)]} {
1852            puts stderr "No help for topic $topic"
1853            return 1
1854        }
1855
1856        set usage [action_get_usage $topic]
1857        if {$usage != -1} {
1858           puts -nonewline stderr $usage
1859        } else {
1860            ui_error "No usage for topic $topic"
1861            return 1
1862        }
1863
1864        puts stderr $porthelp($topic)
1865    }
1866
1867    return 0
1868}
1869
1870
1871proc action_log { action portlist opts } {
1872    global global_options
1873    if {[require_portlist portlist]} {
1874        return 1
1875    }
1876    foreachport $portlist {
1877        # If we have a url, use that, since it's most specific
1878        # otherwise try to map the portname to a url
1879        if {$porturl eq ""} {
1880        # Verify the portname, getting portinfo to map to a porturl
1881            if {[catch {mportlookup $portname} result]} {
1882                ui_debug "$::errorInfo"
1883                break_softcontinue "lookup of portname $portname failed: $result" 1 status
1884            }
1885            if {[llength $result] < 2} {
1886                break_softcontinue "Port $portname not found" 1 status
1887            }
1888            array unset portinfo
1889            array set portinfo [lindex $result 1]
1890            set porturl $portinfo(porturl)
1891            set portdir $portinfo(portdir)
1892            set portname $portinfo(name)
1893        } elseif {$porturl ne "file://."} {
1894            # Extract the portdir from porturl and use it to search PortIndex.
1895            # Only the last two elements of the path (porturl) make up the
1896            # portdir.
1897            set portdir [file split [macports::getportdir $porturl]]
1898            set lsize [llength $portdir]
1899            set portdir \
1900                [file join [lindex $portdir [expr {$lsize - 2}]] \
1901                           [lindex $portdir [expr {$lsize - 1}]]]
1902            if {[catch {mportsearch $portdir no exact portdir} result]} {
1903                ui_debug "$::errorInfo"
1904                break_softcontinue "Portdir $portdir not found" 1 status
1905            }
1906            if {[llength $result] < 2} {
1907                break_softcontinue "Portdir $portdir not found" 1 status
1908            }
1909            array unset portinfo
1910            set matchindex [lsearch -exact -nocase $result $portname]
1911            if {$matchindex != -1} {
1912                array set portinfo [lindex $result [incr matchindex]]
1913            } else {
1914                ui_warn "Portdir $portdir doesn't seem to belong to portname $portname"
1915                array set portinfo [lindex $result 1]
1916            }
1917            set portname $portinfo(name)
1918        }
1919        set portpath [macports::getportdir $porturl]
1920        set logfile [file join [macports::getportlogpath $portpath $portname] "main.log"]
1921        if {[file exists $logfile]} {
1922            if {[catch {set fp [open $logfile r]} result]} {
1923                break_softcontinue "Could not open file $logfile: $result" 1 status
1924            }
1925            set data [read $fp]
1926            set data [split $data "\n"]
1927
1928            if {[info exists global_options(ports_log_phase)]} {
1929                set phase $global_options(ports_log_phase);
1930            } else {
1931                set phase "\[a-z\]*"
1932            }
1933
1934            if {[info exists global_options(ports_log_level)]} {
1935                set index [lsearch -exact ${macports::ui_priorities} $global_options(ports_log_level)]
1936                if {$index == -1} {
1937                    set prefix ""
1938                } else {
1939                    set prefix [join [lrange ${macports::ui_priorities} 0 $index] "|"]
1940                }
1941            } else {
1942                set prefix "\[a-z\]*"
1943            }
1944            foreach line $data {
1945                set exp "^:($prefix|any):($phase|any) (.*)$"
1946                if {[regexp $exp $line -> lpriority lphase lmsg] == 1} {
1947                    puts "[macports::ui_prefix_default $lpriority]$lmsg"
1948                }
1949            }
1950
1951            close $fp
1952        } else {
1953            break_softcontinue "Log file for port $portname not found" 1 status
1954        }
1955    }
1956    return 0
1957}
1958
1959
1960proc action_info { action portlist opts } {
1961    global global_variations
1962    set status 0
1963    if {[require_portlist portlist]} {
1964        return 1
1965    }
1966
1967    set separator ""
1968    foreachport $portlist {
1969        set index_only 0
1970        if {[info exists options(ports_info_index)] && $options(ports_info_index)} {
1971            set index_only 1
1972        }
1973        puts -nonewline $separator
1974        array unset portinfo
1975        # If we have a url, use that, since it's most specific
1976        # otherwise try to map the portname to a url
1977        if {$porturl eq "" || $index_only} {
1978        # Verify the portname, getting portinfo to map to a porturl
1979            if {[catch {mportlookup $portname} result]} {
1980                ui_debug "$::errorInfo"
1981                break_softcontinue "lookup of portname $portname failed: $result" 1 status
1982            }
1983            if {[llength $result] < 2} {
1984                break_softcontinue "Port $portname not found" 1 status
1985            }
1986            array set portinfo [lindex $result 1]
1987            set porturl $portinfo(porturl)
1988            set portdir $portinfo(portdir)
1989        }
1990
1991        if {!$index_only} {
1992            # Add any global_variations to the variations
1993            # specified for the port (so we get e.g. dependencies right)
1994            array unset merged_variations
1995            array set merged_variations [array get variations]
1996            foreach { variation value } [array get global_variations] { 
1997                if { ![info exists merged_variations($variation)] } { 
1998                    set merged_variations($variation) $value 
1999                } 
2000            }
2001            if {![info exists options(subport)]} {
2002                if {[info exists portinfo(name)]} {
2003                    set options(subport) $portinfo(name)
2004                } else {
2005                    set options(subport) $portname
2006                }
2007            }
2008 
2009            if {[catch {set mport [mportopen $porturl [array get options] [array get merged_variations]]} result]} {
2010                ui_debug "$::errorInfo"
2011                break_softcontinue "Unable to open port: $result" 1 status
2012            }
2013            unset options(subport)
2014            array unset portinfo
2015            array set portinfo [mportinfo $mport]
2016            mportclose $mport
2017            if {[info exists portdir]} {
2018                set portinfo(portdir) $portdir
2019            }
2020        } elseif {![info exists portinfo]} {
2021            ui_warn "no PortIndex entry found for $portname"
2022            continue
2023        }
2024        array unset options ports_info_index
2025
2026        # Understand which info items are actually lists
2027        # (this could be overloaded to provide a generic formatting code to
2028        # allow us to, say, split off the prefix on libs)
2029        array set list_map "
2030            categories      1
2031            depends_fetch   1
2032            depends_extract 1
2033            depends_build   1
2034            depends_lib     1
2035            depends_run     1
2036            maintainers     1
2037            platforms       1
2038            variants        1
2039            conflicts       1
2040            subports        1
2041        "
2042
2043        # Label map for pretty printing
2044        array set pretty_label {
2045            heading     ""
2046            variants    Variants
2047            depends_fetch "Fetch Dependencies"
2048            depends_extract "Extract Dependencies"
2049            depends_build "Build Dependencies"
2050            depends_run "Runtime Dependencies"
2051            depends_lib "Library Dependencies"
2052            description "Brief Description"
2053            long_description "Description"
2054            fullname    "Full Name: "
2055            homepage    Homepage
2056            platforms   Platforms
2057            maintainers Maintainers
2058            license     License
2059            conflicts   "Conflicts with"
2060            replaced_by "Replaced by"
2061            subports    "Sub-ports"
2062        }
2063
2064        # Wrap-length map for pretty printing
2065        array set pretty_wrap {
2066            heading 0
2067            replaced_by 22
2068            variants 22
2069            depends_fetch 22
2070            depends_extract 22
2071            depends_build 22
2072            depends_run 22
2073            depends_lib 22
2074            description 22
2075            long_description 22
2076            homepage 22
2077            platforms 22
2078            license 22
2079            conflicts 22
2080            maintainers 22
2081            subports 22
2082        }
2083
2084        # Interpret a convenient field abbreviation
2085        if {[info exists options(ports_info_depends)] && $options(ports_info_depends) eq "yes"} {
2086            array unset options ports_info_depends
2087            set options(ports_info_depends_fetch) yes
2088            set options(ports_info_depends_extract) yes
2089            set options(ports_info_depends_build) yes
2090            set options(ports_info_depends_lib) yes
2091            set options(ports_info_depends_run) yes
2092        }
2093               
2094        # Set up our field separators
2095        set show_label 1
2096        set field_sep "\n"
2097        set subfield_sep ", "
2098        set pretty_print 0
2099       
2100        # For human-readable summary, which is the default with no options
2101        if {[llength [array get options ports_info_*]] == 0} {
2102            set pretty_print 1
2103        } elseif {[info exists options(ports_info_pretty)]} {
2104            set pretty_print 1
2105            array unset options ports_info_pretty
2106        }
2107
2108        # Tune for sort(1)
2109        if {[info exists options(ports_info_line)]} {
2110            array unset options ports_info_line
2111            set noseparator 1
2112            set show_label 0
2113            set field_sep "\t"
2114            set subfield_sep ","
2115        }
2116       
2117        # Figure out whether to show field name
2118        set quiet [macports::ui_isset ports_quiet]
2119        if {$quiet} {
2120            set show_label 0
2121        }
2122        # In pretty-print mode we also suppress messages, even though we show
2123        # most of the labels:
2124        if {$pretty_print} {
2125            set quiet 1
2126        }
2127
2128        # Spin through action options, emitting information for any found
2129        set fields {}
2130        set opts_todo [array names options ports_info_*]
2131        set fields_tried {}
2132        if {![llength $opts_todo]} {
2133            set opts_todo {ports_info_heading
2134                ports_info_replaced_by
2135                ports_info_subports
2136                ports_info_variants 
2137                ports_info_skip_line
2138                ports_info_long_description ports_info_homepage
2139                ports_info_skip_line ports_info_depends_fetch
2140                ports_info_depends_extract ports_info_depends_build
2141                ports_info_depends_lib ports_info_depends_run
2142                ports_info_conflicts
2143                ports_info_platforms ports_info_license
2144                ports_info_maintainers
2145            }
2146        }
2147        foreach { option } $opts_todo {
2148            set opt [string range $option 11 end]
2149            # Artificial field name for formatting
2150            if {$pretty_print && $opt eq "skip_line"} {
2151                lappend fields ""
2152                continue
2153            }
2154            # Artificial field names to reproduce prettyprinted summary
2155            if {$opt eq "heading"} {
2156                set inf "$portinfo(name) @$portinfo(version)"
2157                set ropt "heading"
2158                if {[info exists portinfo(revision)] && $portinfo(revision) > 0} {
2159                    append inf "_$portinfo(revision)"
2160                }
2161                if {[info exists portinfo(categories)]} {
2162                    append inf " ([join $portinfo(categories) ", "])"
2163                }
2164            } elseif {$opt eq "fullname"} {
2165                set inf "$portinfo(name) @"
2166                append inf [composite_version $portinfo(version) $portinfo(active_variants)]
2167                set ropt "fullname"
2168            } else {
2169                # Map from friendly name
2170                set ropt [map_friendly_field_names $opt]
2171               
2172                # If there's no such info, move on
2173                if {![info exists portinfo($ropt)]} {
2174                    set inf ""
2175                } else {
2176                    set inf [join $portinfo($ropt)]
2177                }
2178            }
2179
2180            # Calculate field label
2181            set label ""
2182            if {$pretty_print} {
2183                if {[info exists pretty_label($ropt)]} {
2184                    set label $pretty_label($ropt)
2185                } else {
2186                    set label $opt
2187                }
2188            } elseif {$show_label} {
2189                set label "$opt: "
2190            }
2191           
2192            # Format the data
2193            if { $ropt eq "maintainers" } {
2194                set inf [unobscure_maintainers $inf]
2195            }
2196            #     ... special formatting for certain fields when prettyprinting
2197            if {$pretty_print} {
2198                if {$ropt eq "variants"} {
2199                    # Use the new format for variants iff it exists in
2200                    # PortInfo. This key currently does not exist outside of
2201                    # trunk (1.8.0).
2202                    array unset vinfo
2203                    if {[info exists portinfo(vinfo)]} {
2204                        array set vinfo $portinfo(vinfo)
2205                    }
2206
2207                    set pi_vars $inf
2208                    set inf {}
2209                    foreach v [lsort $pi_vars] {
2210                        set varmodifier ""
2211                        if {[info exists variations($v)]} {
2212                            # selected by command line, prefixed with +/-
2213                            set varmodifier $variations($v)
2214                        } elseif {[info exists global_variations($v)]} {
2215                            # selected by variants.conf, prefixed with (+)/(-)
2216                            set varmodifier "($global_variations($v))"
2217                            # Retrieve additional information from the new key.
2218                        } elseif {[info exists vinfo]} {
2219                            array unset variant
2220                            array set variant $vinfo($v)
2221                            if {[info exists variant(is_default)]} {
2222                                set varmodifier "\[$variant(is_default)]"
2223                            }
2224                        }
2225                        lappend inf "$varmodifier$v"
2226                    }
2227                } elseif {[string match "depend*" $ropt] 
2228                          && ![macports::ui_isset ports_verbose]} {
2229                    set pi_deps $inf
2230                    set inf {}
2231                    foreach d $pi_deps {
2232                        lappend inf [lindex [split $d :] end]
2233                    }
2234                }
2235            } 
2236            #End of special pretty-print formatting for certain fields
2237            if {[info exists list_map($ropt)]} {
2238                set field [join $inf $subfield_sep]
2239            } else {
2240                set field $inf
2241            }
2242           
2243            # Assemble the entry
2244            if {$pretty_print} {
2245                # The two special fields are considered headings and are
2246                # emitted immediately, rather than waiting. Also they are not
2247                # recorded on the list of fields tried
2248                if {$ropt eq "heading" || $ropt eq "fullname"} {
2249                    puts "$label$field"
2250                    continue
2251                }
2252            }
2253            lappend fields_tried $label
2254            if {$pretty_print} {
2255                if {$field eq ""} {
2256                    continue
2257                }
2258                if {$label eq ""} {
2259                    set wrap_len 0
2260                    if {[info exists pretty_wrap($ropt)]} {
2261                        set wrap_len $pretty_wrap($ropt)
2262                    }
2263                    lappend fields [wrap $field 0 [string repeat " " $wrap_len]]
2264                } else {
2265                    set wrap_len [string length $label]
2266                    if {[info exists pretty_wrap($ropt)]} {
2267                        set wrap_len $pretty_wrap($ropt)
2268                    }
2269                    lappend fields [wraplabel $label $field 0 [string repeat " " $wrap_len]]
2270                }
2271
2272            } else { # Not pretty print
2273                lappend fields "$label$field"
2274            }
2275        }
2276
2277        # Now output all that information:
2278        if {[llength $fields]} {
2279            puts [join $fields $field_sep]
2280        } else {
2281            if {$pretty_print && [llength $fields_tried]} {
2282                puts -nonewline "$portinfo(name) has no "
2283                puts [join $fields_tried ", "]
2284            }
2285        }
2286        if {![info exists noseparator]} {
2287            set separator "--\n"
2288        }
2289    }
2290   
2291    return $status
2292}
2293
2294
2295proc action_location { action portlist opts } {
2296    set status 0
2297    if {[require_portlist portlist]} {
2298        return 1
2299    }
2300    foreachport $portlist {
2301        if { [catch {set ilist [registry_installed $portname [composite_version $portversion [array get variations]]]} result] } {
2302            global errorInfo
2303            ui_debug "$errorInfo"
2304            break_softcontinue "port location failed: $result" 1 status
2305        } else {
2306            # set portname again since the one we were passed may not have had the correct case
2307            set portname [lindex $ilist 0]
2308            set version [lindex $ilist 1]
2309            set revision [lindex $ilist 2]
2310            set variants [lindex $ilist 3]
2311            set epoch [lindex $ilist 5]
2312        }
2313
2314        set ref [registry::open_entry $portname $version $revision $variants $epoch]
2315        set imagedir [registry::property_retrieve $ref location]
2316        ui_notice "Port $portname ${version}_${revision}${variants} is installed as an image in:"
2317        puts $imagedir
2318    }
2319   
2320    return $status
2321}
2322
2323
2324proc action_notes { action portlist opts } {
2325    if {[require_portlist portlist]} {
2326        return 1
2327    }
2328
2329    set status 0
2330    foreachport $portlist {
2331        array unset portinfo
2332        if {$porturl eq ""} {
2333            # Look up the port.
2334            if {[catch {mportlookup $portname} result]} {
2335                ui_debug $::errorInfo
2336                break_softcontinue "The lookup of '$portname' failed: $result" \
2337                                1 status
2338            }
2339            if {[llength $result] < 2} {
2340                break_softcontinue "The port '$portname' was not found" 1 status
2341            }
2342
2343            # Retrieve the port's URL.
2344            array set portinfo [lindex $result 1]
2345            set porturl $portinfo(porturl)
2346        }
2347       
2348        # Add any global_variations to the variations
2349        # specified for the port
2350        array unset merged_variations
2351        array set merged_variations [array get variations]
2352        foreach { variation value } [array get global_variations] { 
2353            if { ![info exists merged_variations($variation)] } { 
2354                set merged_variations($variation) $value 
2355            } 
2356        }
2357        if {![info exists options(subport)]} {
2358            if {[info exists portinfo(name)]} {
2359                set options(subport) $portinfo(name)
2360            } else {
2361                set options(subport) $portname
2362            }
2363        }
2364
2365        # Open the Portfile associated with this port.
2366        if {[catch {set mport [mportopen $porturl [array get options] \
2367                                         [array get merged_variations]]} \
2368                   result]} {
2369            ui_debug $::errorInfo
2370            break_softcontinue [concat "The URL '$porturl' could not be" \
2371                                       "opened: $result"] 1 status
2372        }
2373        array unset portinfo
2374        array set portinfo [mportinfo $mport]
2375        mportclose $mport
2376
2377        # Return the notes associated with this Portfile.
2378        if {[info exists portinfo(notes)]} {
2379            set portnotes $portinfo(notes)
2380        } else {
2381            set portnotes {}
2382        }
2383
2384        # Retrieve the port's name once more to ensure it has the proper case.
2385        set portname $portinfo(name)
2386
2387        # Display the notes.
2388        if {$portnotes ne {}} {
2389            ui_notice "$portname has the following notes:"
2390            foreach note $portnotes {
2391                puts [wrap $note 0 "  " 1]
2392            }
2393        } else {
2394            puts "$portname has no notes."
2395        }
2396    }
2397    return $status
2398}
2399
2400
2401proc action_provides { action portlist opts } {
2402    # In this case, portname is going to be used for the filename... since
2403    # that is the first argument we expect... perhaps there is a better way
2404    # to do this?
2405    if { ![llength $portlist] } {
2406        ui_error "Please specify a filename to check which port provides that file."
2407        return 1
2408    }
2409    foreach filename $portlist {
2410        set file [file normalize $filename]
2411        if {[file exists $file] || ![catch {file type $file}]} {
2412            if {![file isdirectory $file] || [file type $file] eq "link"} {
2413                set port [registry::file_registered $file]
2414                if { $port != 0 } {
2415                    puts "$file is provided by: $port"
2416                } else {
2417                    puts "$file is not provided by a MacPorts port."
2418                }
2419            } else {
2420                puts "$file is a directory."
2421            }
2422        } else {
2423            puts "$file does not exist."
2424        }
2425    }
2426    registry::close_file_map
2427   
2428    return 0
2429}
2430
2431
2432proc action_activate { action portlist opts } {
2433    set status 0
2434    if {[require_portlist portlist] || [prefix_unwritable]} {
2435        return 1
2436    }
2437    foreachport $portlist {
2438        set composite_version [composite_version $portversion [array get variations]]
2439        if {![info exists options(ports_activate_no-exec)]
2440            && ![catch {set ilist [registry::installed $portname $composite_version]}]
2441            && [llength $ilist] == 1} {
2442
2443            set i [lindex $ilist 0]
2444            set regref [registry::entry open $portname [lindex $i 1] [lindex $i 2] [lindex $i 3] [lindex $i 5]]
2445            if {[$regref installtype] eq "image" && [registry::run_target $regref activate [array get options]]} {
2446                continue
2447            }
2448        }
2449        if {![macports::global_option_isset ports_dryrun]} {
2450            if { [catch {portimage::activate_composite $portname $composite_version [array get options]} result] } {
2451                global errorInfo
2452                ui_debug "$errorInfo"
2453                break_softcontinue "port activate failed: $result" 1 status
2454            }
2455        } else {
2456            ui_msg "Skipping activate $portname (dry run)"
2457        }
2458    }
2459   
2460    return $status
2461}
2462
2463
2464proc action_deactivate { action portlist opts } {
2465    set status 0
2466    if {[require_portlist portlist] || [prefix_unwritable]} {
2467        return 1
2468    }
2469    set portlist [portlist_sortdependents $portlist]
2470    foreachport $portlist {
2471        set composite_version [composite_version $portversion [array get variations]]
2472        if {![info exists options(ports_deactivate_no-exec)]
2473            && ![catch {set ilist [registry::active $portname]}]} {
2474
2475            set i [lindex $ilist 0]
2476            set iversion [lindex $i 1]
2477            set irevision [lindex $i 2]
2478            set ivariants [lindex $i 3]
2479            if {$composite_version eq "" || $composite_version == "${iversion}_${irevision}${ivariants}"} {
2480                set regref [registry::entry open $portname $iversion $irevision $ivariants [lindex $i 5]]
2481                if {[$regref installtype] eq "image" && [registry::run_target $regref deactivate [array get options]]} {
2482                    continue
2483                }
2484            }
2485        }
2486        if {![macports::global_option_isset ports_dryrun]} {
2487            if { [catch {portimage::deactivate_composite $portname $composite_version [array get options]} result] } {
2488                global errorInfo
2489                ui_debug "$errorInfo"
2490                break_softcontinue "port deactivate failed: $result" 1 status
2491            }
2492        } else {
2493            ui_msg "Skipping deactivate $portname (dry run)"
2494        }
2495    }
2496   
2497    return $status
2498}
2499
2500
2501proc action_select { action portlist opts } {
2502    ui_debug "action_select \[$portlist] \[$opts]..."
2503
2504    array set opts_array $opts
2505    set commands [array names opts_array ports_select_*]
2506    array unset opts_array
2507
2508    # Error out if no group is specified or command is not --summary.
2509    if {[llength $portlist] < 1 && [string map {ports_select_ ""} [lindex $commands 0]] != "summary"} {
2510        ui_error "port select \[--list|--set|--show|--summary] \<group> \[<version>]"
2511        return 1
2512    }
2513
2514    set group [lindex $portlist 0]
2515   
2516    # If no command (--set, --show, --list, --summary) is specified *but*
2517    #  more than one argument is specified, default to the set command.
2518    if {[llength $commands] < 1 && [llength $portlist] > 1} {
2519        set command set
2520        ui_debug [concat "Although no command was specified, more than " \
2521                         "one argument was specified.  Defaulting to the " \
2522                         "'set' command..."]
2523    # If no command (--set, --show, --list) is specified *and* less than two
2524    # argument are specified, default to the list command.
2525    } elseif {[llength $commands] < 1} {
2526        set command list
2527        ui_debug [concat "No command was specified. Defaulting to the " \
2528                         "'list' command..."]
2529    # Only allow one command to be specified at a time.
2530    } elseif {[llength $commands] > 1} {
2531        ui_error [concat "Multiple commands were specified. Only one " \
2532                         "command may be specified at a time."]
2533        return 1
2534    } else {
2535        set command [string map {ports_select_ ""} [lindex $commands 0]]
2536        ui_debug "The '$command' command was specified."
2537    }
2538
2539    switch -- $command {
2540        list {
2541            if {[llength $portlist] > 1} {
2542                ui_warn [concat "The 'list' command does not expect any " \
2543                                "arguments. Extra arguments will be ignored."]
2544            }
2545
2546            if {[catch {mportselect show $group} selected_version]} {
2547                global errorInfo
2548                ui_debug $errorInfo
2549                ui_warn "Unable to get active selected version: $selected_version"
2550            }
2551
2552            # On error mportselect returns with the code 'error'.
2553            if {[catch {mportselect $command $group} versions]} {
2554                ui_error "The 'list' command failed: $versions"
2555                return 1
2556            }
2557
2558            ui_notice "Available versions for $group:"
2559            foreach v $versions {
2560                ui_notice -nonewline "\t"
2561                if {$selected_version == $v} {
2562                    ui_msg "$v (active)"
2563                } else {
2564                    ui_msg "$v"
2565                }
2566            }
2567            return 0
2568        }
2569        set {
2570            if {[llength $portlist] < 2} {
2571                ui_error [concat "The 'set' command expects two " \
2572                                 "arguments: <group>, <version>"]
2573                return 1
2574            } elseif {[llength $portlist] > 2} {
2575                ui_warn [concat "The 'set' command only expects two " \
2576                                "arguments. Extra arguments will be " \
2577                                "ignored."]
2578            }
2579            set version [lindex $portlist 1]
2580
2581            ui_msg -nonewline "Selecting '$version' for '$group' "
2582            if {[catch {mportselect $command $group $version} result]} {
2583                ui_msg "failed: $result"
2584                return 1
2585            }
2586            ui_msg "succeeded. '$version' is now active."
2587            return 0
2588        }
2589        show {
2590            if {[llength $portlist] > 1} {
2591                ui_warn [concat "The 'show' command does not expect any " \
2592                                "arguments. Extra arguments will be ignored."]
2593            }
2594
2595            if {[catch {mportselect $command $group} selected_version]} {
2596                ui_error "The 'show' command failed: $selected_version"
2597                return 1
2598            }
2599            puts [concat "The currently selected version for '$group' is " \
2600                         "'$selected_version'."]
2601            return 0
2602        }
2603        summary {
2604            if {[llength $portlist] > 0} {
2605                ui_warn [concat "The 'summary' command does not expect any " \
2606                                "arguments. Extra arguments will be ignored."]
2607            }
2608
2609            if {[catch {mportselect $command} portgroups]} {
2610                ui_error "The 'summary' command failed: $portgroups"
2611                return 1
2612            }
2613
2614            set w1 4
2615            set w2 8
2616            set formatStr "%-*s  %-*s  %s"
2617
2618            set groups [list]
2619            foreach pg $portgroups {
2620                array set groupdesc {}
2621                set groupdesc(name) [string trim $pg]
2622
2623                if {[catch {mportselect list $pg} versions]} {
2624                    ui_warn "The list of options for the select group $pg could not be obtained: $versions"
2625                    continue
2626                }
2627                # remove "none", sort the list, append none at the end
2628                set noneidx [lsearch -exact $versions "none"]
2629                set versions [lsort [lreplace $versions $noneidx $noneidx]]
2630                lappend versions "none"
2631                set groupdesc(versions) $versions
2632
2633                if {[catch {mportselect show $pg} selected_version]} {
2634                    ui_warn "The currently selected option for the select group $pg could not be obtained: $selected_version"
2635                    continue
2636                }
2637                set groupdesc(selected) $selected_version
2638
2639                set w1 [expr {max($w1, [string length $pg])}]
2640                set w2 [expr {max($w2, [string length $selected_version])}]
2641
2642                lappend groups [array get groupdesc]
2643                array unset groupdesc
2644            }
2645            puts [format $formatStr $w1 "Name" $w2 "Selected" "Options"]
2646            puts [format $formatStr $w1 "====" $w2 "========" "======="]
2647            foreach groupdesc $groups {
2648                array set groupd $groupdesc
2649                puts [format $formatStr $w1 $groupd(name) $w2 $groupd(selected) [join $groupd(versions) " "]]
2650                array unset groupd
2651            }
2652            return 0
2653        }
2654        default {
2655            ui_error "An unknown command '$command' was specified."
2656            return 1
2657        }
2658    }
2659}
2660
2661
2662proc action_selfupdate { action portlist opts } {
2663    global global_options
2664    if { [catch {macports::selfupdate [array get global_options] base_updated} result ] } {
2665        global errorInfo
2666        ui_debug "$errorInfo"
2667        ui_error "$result"
2668        if {![macports::ui_isset ports_verbose]} {
2669            ui_msg "Please run `port -v selfupdate' for details."
2670        } else {
2671            # Let's only print the ticket URL if the user has followed the
2672            # advice we printed earlier.
2673            print_tickets_url
2674        }
2675        fatal "port selfupdate failed: $result"
2676    }
2677   
2678    if {$base_updated} {
2679        # exit immediately if in batch/interactive mode
2680        return -999
2681    } else {
2682        return 0
2683    }
2684}
2685
2686
2687proc action_setrequested { action portlist opts } {
2688    set status 0
2689    if {[require_portlist portlist] || [prefix_unwritable]} {
2690        return 1
2691    }
2692    # set or unset?
2693    set val [string equal $action "setrequested"]
2694    foreachport $portlist {
2695        set composite_version [composite_version $portversion [array get variations]]
2696        if {![catch {set ilist [registry::installed $portname $composite_version]} result]} {
2697            ui_info "Setting requested flag for $portname to $val"
2698            foreach i $ilist {
2699                set regref [registry::open_entry $portname [lindex $i 1] [lindex $i 2] [lindex $i 3] [lindex $i 5]]
2700                registry::property_store $regref requested $val
2701            }
2702        } else {
2703            global errorInfo
2704            ui_debug "$errorInfo"
2705            break_softcontinue "$result" 1 status
2706        }
2707    }
2708   
2709    return $status
2710}
2711
2712
2713proc action_upgrade { action portlist opts } {
2714    if {[require_portlist portlist "yes"] || ([prefix_unwritable] && ![macports::global_option_isset ports_dryrun])} {
2715        return 1
2716    }
2717
2718    # shared depscache for all ports in the list
2719    array set depscache {}
2720    set status 0
2721    foreachport $portlist {
2722        if {![info exists depscache(port:$portname)]} {
2723            set status [macports::upgrade $portname "port:$portname" [array get requested_variations] [array get options] depscache]
2724            # status 2 means the port was not found in the index,
2725            # status 3 means the port is not installed
2726            if {$status != 0 && $status != 2 && $status != 3 && ![macports::ui_isset ports_processall]} {
2727                break
2728            }
2729        }
2730    }
2731   
2732    if {$status != 0 && $status != 2 && $status != 3} {
2733        print_tickets_url
2734    } elseif {$status == 0} {
2735        array set options $opts
2736        if {![info exists options(ports_upgrade_no-rev-upgrade)] && ${macports::revupgrade_autorun} && ![macports::global_option_isset ports_dryrun]} {
2737            set status [action_revupgrade $action $portlist $opts]
2738        }
2739    }
2740
2741    return $status
2742}
2743
2744proc action_revupgrade { action portlist opts } {
2745    set status [macports::revupgrade $opts]
2746    if {$status != 0} {
2747        print_tickets_url
2748    }
2749    return $status
2750}
2751
2752
2753proc action_version { action portlist opts } {
2754    if {![macports::ui_isset ports_quiet]} {
2755        puts -nonewline "Version: "
2756    }
2757    puts [macports::version]
2758    return 0
2759}
2760
2761
2762proc action_platform { action portlist opts } {
2763    if {![macports::ui_isset ports_quiet]} {
2764        puts -nonewline "Platform: "
2765    }
2766    puts "${macports::os_platform} ${macports::os_major} ${macports::os_arch}"
2767    return 0
2768}
2769
2770
2771proc action_dependents { action portlist opts } {
2772    if {[require_portlist portlist]} {
2773        return 1
2774    }
2775    set ilist {}
2776
2777    registry::open_dep_map
2778
2779    set status 0
2780    foreachport $portlist {
2781        set composite_version [composite_version $portversion [array get variations]]
2782        if { [catch {set ilist [registry::installed $portname $composite_version]} result] } {
2783            global errorInfo
2784            ui_debug "$errorInfo"
2785            break_softcontinue "$result" 1 status
2786        } else {
2787            # choose the active version if there is one
2788            set index 0
2789            foreach i $ilist {
2790                if {[lindex $i 4]} {
2791                    set found 1
2792                    break
2793                }
2794                incr index
2795            }
2796            if {![info exists found]} {
2797                set index 0
2798            }
2799            # set portname again since the one we were passed may not have had the correct case
2800            set portname [lindex $ilist $index 0]
2801            set iversion [lindex $ilist $index 1]
2802            set irevision [lindex $ilist $index 2]
2803            set ivariants [lindex $ilist $index 3]
2804        }
2805       
2806        set deplist [registry::list_dependents $portname $iversion $irevision $ivariants]
2807        if { [llength $deplist] > 0 } {
2808            if {$action eq "rdependents"} {
2809                set toplist $deplist
2810                while 1 {
2811                    set newlist {}
2812                    foreach dep $deplist {
2813                        set depname [lindex $dep 2]
2814                        if {![info exists seen($depname)]} {
2815                            set seen($depname) 1
2816                            set rdeplist [registry::list_dependents $depname]
2817                            foreach rdep $rdeplist {
2818                                lappend newlist $rdep
2819                            }
2820                            set dependentsof($depname) $rdeplist
2821                        }
2822                    }
2823                    if {[llength $newlist] > 0} {
2824                        set deplist $newlist
2825                    } else {
2826                        break
2827                    }
2828                }
2829                set portstack [list $toplist]
2830                set pos_stack [list 0]
2831                array unset seen
2832                ui_notice "The following ports are dependent on ${portname}:"
2833                while 1 {
2834                    set cur_portlist [lindex $portstack end]
2835                    set cur_pos [lindex $pos_stack end]
2836                    if {$cur_pos >= [llength $cur_portlist]} {
2837                        set portstack [lreplace $portstack end end]
2838                        set pos_stack [lreplace $pos_stack end end]
2839                        if {[llength $portstack] <= 0} {
2840                            break
2841                        } else {
2842                            continue
2843                        }
2844                    }
2845                    set cur_port [lindex $cur_portlist $cur_pos]
2846                    set cur_portname [lindex $cur_port 2]
2847                    set spaces [string repeat " " [expr {[llength $pos_stack] * 2}]]
2848                    if {![info exists seen($cur_portname)] || ([info exists options(ports_rdependents_full)] && [string is true -strict $options(ports_rdependents_full)])} {
2849                        puts "${spaces}${cur_portname}"
2850                        set seen($cur_portname) 1
2851                        incr cur_pos
2852                        set pos_stack [lreplace $pos_stack end end $cur_pos]
2853                        if {[info exists dependentsof($cur_portname)]} {
2854                            lappend portstack $dependentsof($cur_portname)
2855                            lappend pos_stack 0
2856                        }
2857                        continue
2858                    }
2859                    incr cur_pos
2860                    set pos_stack [lreplace $pos_stack end end $cur_pos]
2861                }
2862            } else {
2863                foreach dep $deplist {
2864                    set depport [lindex $dep 2]
2865                    if {[macports::ui_isset ports_quiet]} {
2866                        ui_msg "$depport"
2867                    } elseif {![macports::ui_isset ports_verbose]} {
2868                        ui_msg "$depport depends on $portname"
2869                    } else {
2870                        ui_msg "$depport depends on $portname (by [lindex $dep 1]:)"
2871                    }
2872                }
2873            }
2874        } else {
2875            ui_notice "$portname has no dependents."
2876        }
2877    }
2878    return $status
2879}
2880
2881
2882proc action_deps { action portlist opts } {
2883    global global_variations
2884    set status 0
2885    if {[require_portlist portlist]} {
2886        return 1
2887    }
2888    set separator ""
2889
2890    foreachport $portlist {
2891        if {[info exists options(ports_${action}_no-build)] && [string is true -strict $options(ports_${action}_no-build)]} {
2892            set deptypes {depends_lib depends_run}
2893        } else {
2894            set deptypes {depends_fetch depends_extract depends_build depends_lib depends_run}
2895        }
2896
2897        array unset portinfo
2898        # If we have a url, use that, since it's most specific
2899        # otherwise try to map the portname to a url
2900        if {$porturl eq ""} {
2901        # Verify the portname, getting portinfo to map to a porturl
2902            if {[catch {mportlookup $portname} result]} {
2903                ui_debug "$::errorInfo"
2904                break_softcontinue "lookup of portname $portname failed: $result" 1 status
2905            }
2906            if {[llength $result] < 2} {
2907                break_softcontinue "Port $portname not found" 1 status
2908            }
2909            array set portinfo [lindex $result 1]
2910            set porturl $portinfo(porturl)
2911        } elseif {$porturl ne "file://."} {
2912            # Extract the portdir from porturl and use it to search PortIndex.
2913            # Only the last two elements of the path (porturl) make up the
2914            # portdir.
2915            set portdir [file split [macports::getportdir $porturl]]
2916            set lsize [llength $portdir]
2917            set portdir \
2918                [file join [lindex $portdir [expr {$lsize - 2}]] \
2919                           [lindex $portdir [expr {$lsize - 1}]]]
2920            if {[catch {mportsearch $portdir no exact portdir} result]} {
2921                ui_debug "$::errorInfo"
2922                break_softcontinue "Portdir $portdir not found" 1 status
2923            }
2924            if {[llength $result] < 2} {
2925                break_softcontinue "Portdir $portdir not found" 1 status
2926            }
2927            set matchindex [lsearch -exact -nocase $result $portname]
2928            if {$matchindex != -1} {
2929                array set portinfo [lindex $result [incr matchindex]]
2930            } else {
2931                ui_warn "Portdir $portdir doesn't seem to belong to portname $portname"
2932                array set portinfo [lindex $result 1]
2933            }
2934        }
2935
2936        if {!([info exists options(ports_${action}_index)] && $options(ports_${action}_index) eq "yes")} {
2937            # Add any global_variations to the variations
2938            # specified for the port, so we get dependencies right
2939            array unset merged_variations
2940            array set merged_variations [array get variations]
2941            foreach { variation value } [array get global_variations] { 
2942                if { ![info exists merged_variations($variation)] } { 
2943                    set merged_variations($variation) $value 
2944                } 
2945            }
2946            if {![info exists options(subport)]} {
2947                if {[info exists portinfo(name)]} {
2948                    set options(subport) $portinfo(name)
2949                } else {
2950                    set options(subport) $portname
2951                }
2952            }
2953            if {[catch {set mport [mportopen $porturl [array get options] [array get merged_variations]]} result]} {
2954                ui_debug "$::errorInfo"
2955                break_softcontinue "Unable to open port: $result" 1 status
2956            }
2957            array unset portinfo
2958            array set portinfo [mportinfo $mport]
2959            mportclose $mport
2960        } elseif {![info exists portinfo]} {
2961            ui_warn "port ${action} --index does not work with the 'current' pseudo-port"
2962            continue
2963        }
2964        set portname $portinfo(name)
2965
2966        set deplist {}
2967        set deps_output {}
2968        set ndeps 0
2969        array set labeldict {depends_fetch Fetch depends_extract Extract depends_build Build depends_lib Library depends_run Runtime}
2970        # get list of direct deps
2971        foreach type $deptypes {
2972            if {[info exists portinfo($type)]} {
2973                if {$action eq "rdeps" || [macports::ui_isset ports_verbose]} {
2974                    foreach dep $portinfo($type) {
2975                        lappend deplist $dep
2976                    }
2977                } else {
2978                    foreach dep $portinfo($type) {
2979                        lappend deplist [lindex [split $dep :] end]
2980                    }
2981                }
2982                if {$action eq "deps"} {
2983                    set label "$labeldict($type) Dependencies"
2984                    lappend deps_output [wraplabel $label [join $deplist ", "] 0 [string repeat " " 22]]
2985                    incr ndeps [llength $deplist]
2986                    set deplist {}
2987                }
2988            }
2989        }
2990
2991        set version $portinfo(version)
2992        set revision $portinfo(revision)
2993        if {[info exists portinfo(canonical_active_variants)]} {
2994            set variants $portinfo(canonical_active_variants)
2995        } else {
2996            set variants {}
2997        }
2998
2999        puts -nonewline $separator
3000        if {$action eq "deps"} {
3001            if {$ndeps == 0} {
3002                ui_notice "$portname @${version}_${revision}${variants} has no dependencies."
3003            } else {
3004                ui_notice "Full Name: $portname @${version}_${revision}${variants}"
3005                puts [join $deps_output "\n"]
3006            }
3007            set separator "--\n"
3008            continue
3009        }
3010
3011        set toplist $deplist
3012        # gather all the deps
3013        while 1 {
3014            set newlist {}
3015            foreach dep $deplist {
3016                set depname [lindex [split $dep :] end]
3017                if {![info exists seen($depname)]} {
3018                    set seen($depname) 1
3019                   
3020                    # look up the dep
3021                    if {[catch {mportlookup $depname} result]} {
3022                        ui_debug "$::errorInfo"
3023                        break_softcontinue "lookup of portname $depname failed: $result" 1 status
3024                    }
3025                    if {[llength $result] < 2} {
3026                        break_softcontinue "Port $depname not found" 1 status
3027                    }
3028                    array unset portinfo
3029                    array set portinfo [lindex $result 1]
3030                    set porturl $portinfo(porturl)
3031                    set options(subport) $portinfo(name)
3032                   
3033                    # open the portfile if requested
3034                    if {!([info exists options(ports_${action}_index)] && $options(ports_${action}_index) eq "yes")} {
3035                        if {[catch {set mport [mportopen $porturl [array get options] [array get merged_variations]]} result]} {
3036                            ui_debug "$::errorInfo"
3037                            break_softcontinue "Unable to open port: $result" 1 status
3038                        }
3039                        array unset portinfo
3040                        array set portinfo [mportinfo $mport]
3041                        mportclose $mport
3042                    }
3043                   
3044                    # get list of the dep's deps
3045                    set rdeplist {}
3046                    foreach type $deptypes {
3047                        if {[info exists portinfo($type)]} {
3048                            foreach rdep $portinfo($type) {
3049                                lappend rdeplist $rdep
3050                                lappend newlist $rdep
3051                            }
3052                        }
3053                    }
3054                    set depsof($depname) $rdeplist
3055                }
3056            }
3057            if {[llength $newlist] > 0} {
3058                set deplist $newlist
3059            } else {
3060                break
3061            }
3062        }
3063        set portstack [list $toplist]
3064        set pos_stack [list 0]
3065        array unset seen
3066        if {[llength $toplist] > 0} {
3067            ui_notice "The following ports are dependencies of $portname @${version}_${revision}${variants}:"
3068        } else {
3069            ui_notice "$portname @${version}_${revision}${variants} has no dependencies."
3070        }
3071        while 1 {
3072            set cur_portlist [lindex $portstack end]
3073            set cur_pos [lindex $pos_stack end]
3074            if {$cur_pos >= [llength $cur_portlist]} {
3075                set portstack [lreplace $portstack end end]
3076                set pos_stack [lreplace $pos_stack end end]
3077                if {[llength $portstack] <= 0} {
3078                    break
3079                } else {
3080                    continue
3081                }
3082            }
3083            set cur_port [lindex $cur_portlist $cur_pos]
3084            set cur_portname [lindex [split $cur_port :] end]
3085            set spaces [string repeat " " [expr {[llength $pos_stack] * 2}]]
3086            if {![info exists seen($cur_portname)] || ([info exists options(ports_${action}_full)] && [string is true -strict $options(ports_${action}_full)])} {
3087                if {[macports::ui_isset ports_verbose]} {
3088                    puts "${spaces}${cur_port}"
3089                } else {
3090                    puts "${spaces}${cur_portname}"
3091                }
3092                set seen($cur_portname) 1
3093                incr cur_pos
3094                set pos_stack [lreplace $pos_stack end end $cur_pos]
3095                if {[info exists depsof($cur_portname)]} {
3096                    lappend portstack $depsof($cur_portname)
3097                    lappend pos_stack 0
3098                }
3099                continue
3100            }
3101            incr cur_pos
3102            set pos_stack [lreplace $pos_stack end end $cur_pos]
3103        }
3104        set separator "--\n"
3105    }
3106    return $status
3107}
3108
3109
3110proc action_uninstall { action portlist opts } {
3111    set status 0
3112    if {[macports::global_option_isset port_uninstall_old]} {
3113        # if -u then uninstall all inactive ports
3114        # (union these to any other ports user has in the port list)
3115        set portlist [opUnion $portlist [get_inactive_ports]]
3116    } else {
3117        # Otherwise the user hopefully supplied a portlist, or we'll default to the existing directory
3118        if {[require_portlist portlist]} {
3119            return 1
3120        }
3121    }
3122    if {[prefix_unwritable]} {
3123        return 1
3124    }
3125
3126    set portlist [portlist_sortdependents $portlist]
3127
3128    foreachport $portlist {
3129        if {![registry::entry_exists_for_name $portname]} {
3130            # if the code path arrives here the port either isn't installed, or
3131            # it doesn't exist at all. We can't be sure, but we can check the
3132            # portindex whether a port by that name exists (in which case not
3133            # uninstalling it is probably no problem). If there is no port by
3134            # that name, alert the user in case of typos.
3135            ui_info "$portname is not installed"
3136            if {[catch {set res [mportlookup $portname]} result] || [llength $res] == 0} {
3137                ui_warn "no such port: $portname, skipping uninstall"
3138            }
3139            continue
3140        }
3141        set composite_version [composite_version $portversion [array get variations]]
3142        if {![info exists options(ports_uninstall_no-exec)]
3143            && ![catch {set ilist [registry::installed $portname $composite_version]}]
3144            && [llength $ilist] == 1} {
3145
3146            set i [lindex $ilist 0]
3147            set iactive [lindex $i 4]
3148            set regref [registry::entry open $portname [lindex $i 1] [lindex $i 2] [lindex $i 3] [lindex $i 5]]
3149            if {[registry::run_target $regref uninstall [array get options]]} {
3150                continue
3151            }
3152        }
3153
3154        if { [catch {registry_uninstall::uninstall_composite $portname $composite_version [array get options]} result] } {
3155            global errorInfo
3156            ui_debug "$errorInfo"
3157            break_softcontinue "port uninstall failed: $result" 1 status
3158        }
3159    }
3160
3161    return $status
3162}
3163
3164
3165proc action_installed { action portlist opts } {
3166    global private_options
3167    set status 0
3168    set restrictedList 0
3169    set ilist {}
3170   
3171    if { [llength $portlist] || (![info exists private_options(ports_no_args)] || $private_options(ports_no_args) eq "no")} {
3172        set restrictedList 1
3173        foreachport $portlist {
3174            set composite_version [composite_version $portversion [array get variations]]
3175            if { [catch {set ilist [concat $ilist [registry::installed $portname $composite_version]]} result] } {
3176                if {![string match "* not registered as installed." $result]} {
3177                    global errorInfo
3178                    ui_debug "$errorInfo"
3179                    break_softcontinue "port installed failed: $result" 1 status
3180                }
3181            }
3182        }
3183    } else {
3184        if { [catch {set ilist [registry::installed]} result] } {
3185            if {$result ne "Registry error: No ports registered as installed."} {
3186                global errorInfo
3187                ui_debug "$errorInfo"
3188                ui_error "port installed failed: $result"
3189                set status 1
3190            }
3191        }
3192    }
3193    if { [llength $ilist] > 0 } {
3194        ui_notice "The following ports are currently installed:"
3195        foreach i [portlist_sortint $ilist] {
3196            set iname [lindex $i 0]
3197            set iversion [lindex $i 1]
3198            set irevision [lindex $i 2]
3199            set ivariants [lindex $i 3]
3200            set iactive [lindex $i 4]
3201            set extra ""
3202            set nvariants ""
3203            if {[macports::ui_isset ports_verbose]} {
3204                set regref [registry::open_entry $iname $iversion $irevision $ivariants [lindex $i 5]]
3205                set nvariants [registry::property_retrieve $regref negated_variants]
3206                if {$nvariants == 0} {
3207                    set nvariants ""
3208                }
3209                set os_platform [registry::property_retrieve $regref os_platform]
3210                set os_major [registry::property_retrieve $regref os_major]
3211                set archs [registry::property_retrieve $regref archs]
3212                if {$os_platform != 0 && $os_platform ne "" && $os_major != 0 && $os_major ne ""} {
3213                    append extra " platform='$os_platform $os_major'"
3214                }
3215                if {$archs != 0 && $archs ne ""} {
3216                    append extra " archs='$archs'"
3217                }
3218            }
3219            if { $iactive == 0 } {
3220                puts "  $iname @${iversion}_${irevision}${ivariants}${nvariants}${extra}"
3221            } elseif { $iactive == 1 } {
3222                puts "  $iname @${iversion}_${irevision}${ivariants}${nvariants} (active)${extra}"
3223            }
3224        }
3225    } elseif { $restrictedList } {
3226        ui_notice "None of the specified ports are installed."
3227    } else {
3228        ui_notice "No ports are installed."
3229    }
3230
3231    return $status
3232}
3233
3234
3235proc action_outdated { action portlist opts } {
3236    global private_options
3237    set status 0
3238
3239    # If port names were supplied, limit ourselves to those ports, else check all installed ports
3240    set ilist {}
3241    set restrictedList 0
3242    if { [llength $portlist] || (![info exists private_options(ports_no_args)] || $private_options(ports_no_args) eq "no")} {
3243        set restrictedList 1
3244        foreach portspec $portlist {
3245            array set port $portspec
3246            set portname $port(name)
3247            set composite_version [composite_version $port(version) $port(variants)]
3248            if { [catch {set ilist [concat $ilist [registry::installed $portname $composite_version]]} result] } {
3249                if {![string match "* not registered as installed." $result]} {
3250                    global errorInfo
3251                    ui_debug "$errorInfo"
3252                    break_softcontinue "port outdated failed: $result" 1 status
3253                }
3254            }
3255        }
3256    } else {
3257        if { [catch {set ilist [registry::installed]} result] } {
3258            if {$result ne "Registry error: No ports registered as installed."} {
3259                global errorInfo
3260                ui_debug "$errorInfo"
3261                ui_error "port installed failed: $result"
3262                set status 1
3263            }
3264        }
3265    }
3266
3267    set num_outdated 0
3268    if { [llength $ilist] > 0 } {
3269        foreach i [portlist_sortint $ilist] {
3270       
3271            # Get information about the installed port
3272            set portname [lindex $i 0]
3273            set installed_version [lindex $i 1]
3274            set installed_revision [lindex $i 2]
3275            set installed_compound "${installed_version}_${installed_revision}"
3276
3277            set is_active [lindex $i 4]
3278            if {$is_active == 0} {
3279                continue
3280            }
3281            set installed_epoch [lindex $i 5]
3282
3283            # Get info about the port from the index
3284            if {[catch {set res [mportlookup $portname]} result]} {
3285                global errorInfo
3286                ui_debug "$errorInfo"
3287                break_softcontinue "search for portname $portname failed: $result" 1 status
3288            }
3289            if {[llength $res] < 2} {
3290                if {[macports::ui_isset ports_debug]} {
3291                    puts "$portname ($installed_compound is installed; the port was not found in the port index)"
3292                }
3293                continue
3294            }
3295            array unset portinfo
3296            array set portinfo [lindex $res 1]
3297           
3298            # Get information about latest available version and revision
3299            if {![info exists portinfo(version)]} {
3300                ui_warn "$portname has no version field"
3301                continue
3302            }
3303            set latest_version $portinfo(version)
3304            set latest_revision 0
3305            if {[info exists portinfo(revision)] && $portinfo(revision) > 0} { 
3306                set latest_revision $portinfo(revision)
3307            }
3308            set latest_compound "${latest_version}_${latest_revision}"
3309            set latest_epoch 0
3310            if {[info exists portinfo(epoch)]} { 
3311                set latest_epoch $portinfo(epoch)
3312            }
3313           
3314            # Compare versions, first checking epoch, then version, then revision
3315            set epoch_comp_result [expr {$installed_epoch - $latest_epoch}]
3316            set comp_result [vercmp $installed_version $latest_version]
3317            if { $comp_result == 0 } {
3318                set comp_result [expr {$installed_revision - $latest_revision}]
3319            }
3320            set reason ""
3321            if {$epoch_comp_result != 0 && $installed_version != $latest_version} {
3322                if {($comp_result >= 0 && $epoch_comp_result < 0) || ($comp_result <= 0 && $epoch_comp_result > 0)} {
3323                    set reason { (epoch $installed_epoch $relation $latest_epoch)}
3324                }
3325                set comp_result $epoch_comp_result
3326            } elseif {$comp_result == 0} {
3327                set regref [registry::open_entry $portname $installed_version $installed_revision [lindex $i 3] $installed_epoch]
3328                set os_platform_installed [registry::property_retrieve $regref os_platform]
3329                set os_major_installed [registry::property_retrieve $regref os_major]
3330                if {$os_platform_installed ne "" && $os_platform_installed != 0
3331                    && $os_major_installed ne "" && $os_major_installed != 0
3332                    && ($os_platform_installed != ${macports::os_platform} || $os_major_installed != ${macports::os_major})} {
3333                    set comp_result -1
3334                    set reason { (platform $os_platform_installed $os_major_installed != ${macports::os_platform} ${macports::os_major})}
3335                }
3336            }
3337           
3338            # Report outdated (or, for verbose, predated) versions
3339            if { $comp_result != 0 } {
3340                           
3341                # Form a relation between the versions
3342                set flag ""
3343                if { $comp_result > 0 } {
3344                    set relation ">"
3345                    set flag "!"
3346                } else {
3347                    set relation "<"
3348                }
3349               
3350                # Emit information
3351                if {$comp_result < 0 || [macports::ui_isset ports_verbose]} {
3352               
3353                    if {$num_outdated == 0} {
3354                        ui_notice "The following installed ports are outdated:"
3355                    }
3356                    incr num_outdated
3357
3358                    puts [format "%-30s %-24s %1s" $portname "$installed_compound $relation $latest_compound [subst $reason]" $flag]
3359                }
3360               
3361            }
3362        }
3363       
3364        if {$num_outdated == 0} {
3365            ui_notice "No installed ports are outdated."
3366        }
3367    } elseif { $restrictedList } {
3368        ui_notice "None of the specified ports are outdated."
3369    } else {
3370        ui_notice "No ports are installed."
3371    }
3372   
3373    return $status
3374}
3375
3376
3377proc action_contents { action portlist opts } {
3378    global global_options
3379    if {[require_portlist portlist]} {
3380        return 1
3381    }
3382    if {[info exists global_options(ports_contents_size)]} {
3383        set units {}
3384        if {[info exists global_options(ports_contents_units)]} {
3385            set units [complete_size_units $global_options(ports_contents_units)]
3386        }
3387        set outstring {[format "%12s $file" [filesize $file $units]]}
3388    } else {
3389        set outstring {  $file}
3390    }
3391
3392    foreachport $portlist {
3393        if { ![catch {set ilist [registry::installed $portname]} result] } {
3394            # set portname again since the one we were passed may not have had the correct case
3395            set portname [lindex $ilist 0 0]
3396        }
3397        set files [registry::port_registered $portname]
3398        if { $files != 0 } {
3399            if { [llength $files] > 0 } {
3400                ui_notice "Port $portname contains:"
3401                foreach file $files {
3402                    puts [subst $outstring]
3403                }
3404            } else {
3405                ui_notice "Port $portname does not contain any files or is not active."
3406            }
3407        } else {
3408            ui_notice "Port $portname is not installed."
3409        }
3410    }
3411    registry::close_file_map
3412
3413    return 0
3414}
3415
3416# expand abbreviations of size units
3417proc complete_size_units {units} {
3418    if {$units eq "K" || $units eq "Ki"} {
3419        return "KiB"
3420    } elseif {$units eq "k"} {
3421        return "kB"
3422    } elseif {$units eq "Mi"} {
3423        return "MiB"
3424    } elseif {$units eq "M"} {
3425        return "MB"
3426    } elseif {$units eq "Gi"} {
3427        return "GiB"
3428    } elseif {$units eq "G"} {
3429        return "GB"
3430    } else {
3431        return $units
3432    }
3433}
3434
3435# Show space used by the given ports' files
3436proc action_space {action portlist opts} {
3437    global global_options
3438    require_portlist portlist
3439
3440    set units {}
3441    if {[info exists global_options(ports_space_units)]} {
3442        set units [complete_size_units $global_options(ports_space_units)]
3443    }
3444    set spaceall 0.0
3445    foreachport $portlist {
3446        set space 0.0
3447        set files [registry::port_registered $portname]
3448        if { $files != 0 } {
3449            if { [llength $files] > 0 } {
3450                foreach file $files {
3451                    catch {
3452                        set space [expr {$space + [file size $file]}]
3453                    }
3454                }
3455                if {![info exists options(ports_space_total)] || $options(ports_space_total) ne "yes"} {
3456                    set msg "[bytesize $space $units] $portname"
3457                    if { $portversion != {} } {
3458                        append msg " @$portversion"
3459                    }
3460                    puts $msg
3461                }
3462                set spaceall [expr {$space + $spaceall}]
3463            } else {
3464                puts stderr "Port $portname does not contain any file or is not active."
3465            }
3466        } else {
3467            puts stderr "Port $portname is not installed."
3468        }
3469    }
3470    if {[llength $portlist] > 1 || ([info exists options(ports_space_total)] && $options(ports_space_total) eq "yes")} {
3471        puts "[bytesize $spaceall $units] total"
3472    }
3473    return 0
3474}
3475
3476proc action_variants { action portlist opts } {
3477    global global_variations
3478    set status 0
3479    if {[require_portlist portlist]} {
3480        return 1
3481    }
3482    foreachport $portlist {
3483        array unset portinfo
3484        if {$porturl eq ""} {
3485            # look up port
3486            if {[catch {mportlookup $portname} result]} {
3487                global errorInfo
3488                ui_debug "$errorInfo"
3489                break_softcontinue "lookup of portname $portname failed: $result" 1 status
3490            }
3491            if {[llength $result] < 2} {
3492                break_softcontinue "Port $portname not found" 1 status
3493            }
3494
3495            array set portinfo [lindex $result 1]
3496
3497            set porturl $portinfo(porturl)
3498            set portdir $portinfo(portdir)
3499        }
3500
3501        if {!([info exists options(ports_variants_index)] && $options(ports_variants_index) eq "yes")} {
3502            if {![info exists options(subport)]} {
3503                if {[info exists portinfo(name)]} {
3504                    set options(subport) $portinfo(name)
3505                } else {
3506                    set options(subport) $portname
3507                }
3508            }
3509            if {[catch {set mport [mportopen $porturl [array get options] [array get variations]]} result]} {
3510                ui_debug "$::errorInfo"
3511                break_softcontinue "Unable to open port: $result" 1 status
3512            }
3513            array unset portinfo
3514            array set portinfo [mportinfo $mport]
3515            mportclose $mport
3516            if {[info exists portdir]} {
3517                set portinfo(portdir) $portdir
3518            }
3519        } elseif {![info exists portinfo]} {
3520            ui_warn "port variants --index does not work with 'current' pseudo-port"
3521            continue
3522        }
3523
3524        # set portname again since the one we were passed may not have had the correct case
3525        set portname $portinfo(name)
3526
3527        # if this fails the port doesn't have any variants
3528        if {![info exists portinfo(variants)]} {
3529            ui_notice "$portname has no variants"
3530        } else {
3531            array unset vinfo
3532            # Use the new format if it exists.
3533            if {[info exists portinfo(vinfo)]} {
3534                array set vinfo $portinfo(vinfo)
3535            # Otherwise fall back to the old format.
3536            } elseif {[info exists portinfo(variant_desc)]} {
3537                array set vdescriptions $portinfo(variant_desc)
3538            }
3539
3540            # print out all the variants
3541            ui_notice "$portname has the variants:"
3542            foreach v [lsort $portinfo(variants)] {
3543                unset -nocomplain vconflicts vdescription vrequires
3544                set varmodifier "   "
3545                # Retrieve variants' information from the new format.
3546                if {[info exists vinfo]} {
3547                    array unset variant
3548                    array set variant $vinfo($v)
3549
3550                    # Retrieve conflicts, description, is_default, and
3551                    # vrequires.
3552                    if {[info exists variant(conflicts)]} {
3553                        set vconflicts $variant(conflicts)
3554                    }
3555                    if {[info exists variant(description)]} {
3556                        set vdescription $variant(description)
3557                    }
3558
3559                    # XXX Keep these varmodifiers in sync with action_info, or create a wrapper for it
3560                    if {[info exists variations($v)]} {
3561                        set varmodifier "  $variations($v)"
3562                    } elseif {[info exists global_variations($v)]} {
3563                        # selected by variants.conf, prefixed with (+)/(-)
3564                        set varmodifier "($global_variations($v))"
3565                    } elseif {[info exists variant(is_default)]} {
3566                        set varmodifier "\[$variant(is_default)\]"
3567                    }
3568                    if {[info exists variant(requires)]} {
3569                        set vrequires $variant(requires)
3570                    }
3571                # Retrieve variants' information from the old format,
3572                # which only consists of the description.
3573                } elseif {[info exists vdescriptions($v)]} {
3574                    set vdescription $vdescriptions($v)
3575                }
3576
3577                if {[info exists vdescription]} {
3578                    puts [wraplabel "$varmodifier$v" [string trim $vdescription] 0 [string repeat " " [expr 5 + [string length $v]]]]
3579                } else {
3580                    puts "$varmodifier$v"
3581                }
3582                if {[info exists vconflicts]} {
3583                    puts "     * conflicts with [string trim $vconflicts]"
3584                }
3585                if {[info exists vrequires]} {
3586                    puts "     * requires [string trim $vrequires]"
3587                }
3588            }
3589        }
3590    }
3591
3592    return $status
3593}
3594
3595
3596proc action_search { action portlist opts } {
3597    global private_options global_options
3598    set status 0
3599    if {![llength $portlist] && [info exists private_options(ports_no_args)] && $private_options(ports_no_args) eq "yes"} {
3600        ui_error "You must specify a search pattern"
3601        return 1
3602    }
3603
3604    # Copy global options as we are going to modify the array
3605    array set options [array get global_options]
3606
3607    if {[info exists options(ports_search_depends)] && $options(ports_search_depends) eq "yes"} {
3608        array unset options ports_search_depends
3609        set options(ports_search_depends_fetch) yes
3610        set options(ports_search_depends_extract) yes
3611        set options(ports_search_depends_build) yes
3612        set options(ports_search_depends_lib) yes
3613        set options(ports_search_depends_run) yes
3614    }
3615
3616    # Array to hold given filters
3617    array set filters {}
3618    # Default matchstyle
3619    set filter_matchstyle "none"
3620    set filter_case no
3621    foreach { option } [array names options ports_search_*] {
3622        set opt [string range $option 13 end]
3623
3624        if { $options($option) ne "yes" } {
3625            continue
3626        }
3627        switch -- $opt {
3628            exact -
3629            glob {
3630                set filter_matchstyle $opt
3631                continue
3632            }
3633            regex {
3634                set filter_matchstyle regexp
3635                continue
3636            }
3637            case-sensitive {
3638                set filter_case yes
3639                continue
3640            }
3641            line {
3642                continue
3643            }
3644        }
3645
3646        set filters($opt) "yes"
3647    }
3648    # Set default search filter if none was given
3649    if { [array size filters] == 0 } {
3650        set filters(name) "yes"
3651        set filters(description) "yes"
3652    }
3653
3654    set separator ""
3655    foreach portname $portlist {
3656        puts -nonewline $separator
3657
3658        set searchstring $portname
3659        set matchstyle $filter_matchstyle
3660        if {$matchstyle eq "none"} {
3661            # Guess if the given string was a glob expression, if not do a substring search
3662            if {[string first "*" $portname] == -1 && [string first "?" $portname] == -1} {
3663                set searchstring "*$portname*"
3664            }
3665            set matchstyle glob
3666        }
3667
3668        set res {}
3669        set portfound 0
3670        foreach { opt } [array get filters] {
3671            # Map from friendly name
3672            set opt [map_friendly_field_names $opt]
3673
3674            if {[catch {eval set matches \[mportsearch \$searchstring $filter_case \$matchstyle $opt\]} result]} {
3675                global errorInfo
3676                ui_debug "$errorInfo"
3677                break_softcontinue "search for name $portname failed: $result" 1 status
3678            }
3679
3680            set tmp {}
3681            foreach {name info} $matches {
3682                add_to_portlist tmp [concat [list name $name] $info]
3683            }
3684            set res [opUnion $res $tmp]
3685        }
3686        set res [portlist_sort $res]
3687
3688        set joiner ""
3689        foreach info $res {
3690            array unset portinfo
3691            array set portinfo $info
3692
3693            # XXX is this the right place to verify an entry?
3694            if {![info exists portinfo(name)]} {
3695                puts stderr "Invalid port entry, missing portname"
3696                continue
3697            }
3698            if {![info exists portinfo(description)]} {
3699                puts stderr "Invalid port entry for $portinfo(name), missing description"
3700                continue
3701            }
3702            if {![info exists portinfo(version)]} {
3703                puts stderr "Invalid port entry for $portinfo(name), missing version"
3704                continue
3705            }
3706
3707            if {[macports::ui_isset ports_quiet]} {
3708                puts $portinfo(name)
3709            } else {
3710                if {[info exists options(ports_search_line)]
3711                        && $options(ports_search_line) eq "yes"} {
3712                    # check for ports without category, e.g. replaced_by stubs
3713                    if {[info exists portinfo(categories)]} {
3714                        puts "$portinfo(name)\t$portinfo(version)\t$portinfo(categories)\t$portinfo(description)"
3715                    } else {
3716                        # keep two consecutive tabs in order to provide consistent columns' content
3717                        puts "$portinfo(name)\t$portinfo(version)\t\t$portinfo(description)"
3718                    }
3719                } else {
3720                    puts -nonewline $joiner
3721
3722                    puts -nonewline "$portinfo(name) @$portinfo(version)"
3723                    if {[info exists portinfo(revision)] && $portinfo(revision) > 0} {
3724                        puts -nonewline "_$portinfo(revision)"
3725                    }
3726                    if {[info exists portinfo(categories)]} {
3727                        puts -nonewline " ([join $portinfo(categories) ", "])"
3728                    }
3729                    puts ""
3730                    puts [wrap [join $portinfo(description)] 0 [string repeat " " 4]]
3731                }
3732            }
3733
3734            set joiner "\n"
3735            set portfound 1
3736        }
3737        if { !$portfound } {
3738            ui_notice "No match for $portname found"
3739        } elseif {[llength $res] > 1} {
3740            if {(![info exists global_options(ports_search_line)]
3741                    || $global_options(ports_search_line) ne "yes")} {
3742                ui_notice "\nFound [llength $res] ports."
3743            }
3744        }
3745
3746        set separator "--\n"
3747    }
3748
3749    array unset options
3750    array unset filters
3751
3752    return $status
3753}
3754
3755
3756proc action_list { action portlist opts } {
3757    global private_options
3758    set status 0
3759   
3760    # Default to list all ports if no portnames are supplied
3761    if { ![llength $portlist] && [info exists private_options(ports_no_args)] && $private_options(ports_no_args) eq "yes"} {
3762        add_to_portlist portlist [list name "-all-"]
3763    }
3764   
3765    foreachport $portlist {
3766        if {$portname eq "-all-"} {
3767           if {[catch {set res [mportlistall]} result]} {
3768                global errorInfo
3769                ui_debug "$errorInfo"
3770                break_softcontinue "listing all ports failed: $result" 1 status
3771            }
3772        } else {
3773            set search_string [regex_pat_sanitize $portname]
3774            if {[catch {set res [mportsearch ^$search_string\$ no]} result]} {
3775                global errorInfo
3776                ui_debug "$errorInfo"
3777                break_softcontinue "search for portname $search_string failed: $result" 1 status
3778            }
3779        }
3780
3781        foreach {name array} $res {
3782            array unset portinfo
3783            array set portinfo $array
3784            set outdir ""
3785            if {[info exists portinfo(portdir)]} {
3786                set outdir $portinfo(portdir)
3787            }
3788            puts [format "%-30s @%-14s %s" $portinfo(name) $portinfo(version) $outdir]
3789        }
3790    }
3791   
3792    return $status
3793}
3794
3795
3796proc action_echo { action portlist opts } {
3797    global global_options
3798
3799    # Simply echo back the port specs given to this command
3800    foreachport $portlist {
3801        if {![macports::ui_isset ports_quiet]} {
3802            set opts {}
3803            foreach { key value } [array get options] {
3804                if {![info exists global_options($key)]} {
3805                    lappend opts "$key=$value"
3806                }
3807            }
3808
3809            set composite_version [composite_version $portversion [array get variations] 1]
3810            if { $composite_version ne "" } {
3811                set ver_field "@$composite_version"
3812            } else {
3813                set ver_field ""
3814            }
3815            puts [format "%-30s %s %s" $portname $ver_field  [join $opts " "]]
3816        } else {
3817            puts "$portname"
3818        }
3819    }
3820
3821    return 0
3822}
3823
3824
3825proc action_portcmds { action portlist opts } {
3826    # Operations on the port's directory and Portfile
3827    global env boot_env current_portdir
3828
3829    array set local_options $opts
3830   
3831    set status 0
3832    if {[require_portlist portlist]} {
3833        return 1
3834    }
3835    foreachport $portlist {
3836        array unset portinfo
3837        # If we have a url, use that, since it's most specific, otherwise try to map the portname to a url
3838        if {$porturl eq ""} {
3839       
3840            # Verify the portname, getting portinfo to map to a porturl
3841            if {[catch {set res [mportlookup $portname]} result]} {
3842                global errorInfo
3843                ui_debug "$errorInfo"
3844                break_softcontinue "lookup of portname $portname failed: $result" 1 status
3845            }
3846            if {[llength $res] < 2} {
3847                break_softcontinue "Port $portname not found" 1 status
3848            }
3849            array set portinfo [lindex $res 1]
3850            set porturl $portinfo(porturl)
3851            set portname $portinfo(name)
3852        }
3853       
3854       
3855        # Calculate portdir, porturl, and portfile from initial porturl
3856        set portdir [file normalize [macports::getportdir $porturl]]
3857        set porturl "file://${portdir}";    # Rebuild url so it's fully qualified
3858        set portfile "${portdir}/Portfile"
3859       
3860        # Now execute the specific action
3861        if {[file readable $portfile]} {
3862            switch -- $action {
3863                cat {
3864                    # Copy the portfile to standard output
3865                    set f [open $portfile RDONLY]
3866                    while { ![eof $f] } {
3867                        puts -nonewline [read $f 4096]
3868                    }
3869                    close $f
3870                }
3871               
3872                edit {
3873                    # Edit the port's portfile with the user's editor
3874                   
3875                    # Restore our entire environment from start time.
3876                    # We need it to evaluate the editor, and the editor
3877                    # may want stuff from it as well, like TERM.
3878                    array unset env_save; array set env_save [array get env]
3879                    array unset env *
3880                    if {${macports::macosx_version} eq "10.5"} {
3881                        unsetenv *
3882                    }
3883                    array set env [array get boot_env]
3884                   
3885                    # Find an editor to edit the portfile
3886                    set editor ""
3887                    set editor_var "ports_${action}_editor"
3888                    if {[info exists local_options($editor_var)]} {
3889                        set editor [join $local_options($editor_var)]
3890                    } else {
3891                        foreach ed { MP_EDITOR VISUAL EDITOR } {
3892                            if {[info exists env($ed)]} {
3893                                set editor $env($ed)
3894                                break
3895                            }
3896                        }
3897                    }
3898                   
3899                    # Use a reasonable canned default if no editor specified or set in env
3900                    if { $editor eq "" } { set editor "/usr/bin/vi" }
3901                   
3902                    # Invoke the editor
3903                    if {[catch {eval exec >@stdout <@stdin 2>@stderr $editor {$portfile}} result]} {
3904                        global errorInfo
3905                        ui_debug "$errorInfo"
3906                        break_softcontinue "unable to invoke editor $editor: $result" 1 status
3907                    }
3908                   
3909                    # Restore internal MacPorts environment
3910                    array unset env *
3911                    if {${macports::macosx_version} eq "10.5"} {
3912                        unsetenv *
3913                    }
3914                    array set env [array get env_save]
3915                }
3916
3917                dir {
3918                    # output the path to the port's directory
3919                    puts $portdir
3920                }
3921
3922                work {
3923                    # output the path to the port's work directory
3924                    set workpath [macports::getportworkpath_from_portdir $portdir $portname]
3925                    if {[file exists $workpath]} {
3926                        puts $workpath
3927                    }
3928                }
3929
3930                cd {
3931                    # Change to the port's directory, making it the default
3932                    # port for any future commands
3933                    set current_portdir $portdir
3934                }
3935
3936                url {
3937                    # output the url of the port's directory, suitable to feed back in later as a port descriptor
3938                    puts $porturl
3939                }
3940
3941                file {
3942                    # output the path to the port's portfile
3943                    puts $portfile
3944                }
3945
3946                logfile {
3947                    set logfile [file join [macports::getportlogpath $portdir $portname] "main.log"]
3948                    if {[file isfile $logfile]} {
3949                        puts $logfile
3950                    } else {
3951                        ui_error "Log file not found for port in $portdir"
3952                    }
3953                }
3954
3955                gohome {
3956                    set homepage ""
3957
3958                    # Get the homepage as read from PortIndex
3959                    if {[info exists portinfo(homepage)]} {
3960                        set homepage $portinfo(homepage)
3961                    }
3962
3963                    # If not available, get the homepage for the port by opening the Portfile
3964                    if {$homepage eq "" && ![catch {set ctx [mportopen $porturl]} result]} {
3965                        array set portinfo [mportinfo $ctx]
3966                        if {[info exists portinfo(homepage)]} {
3967                            set homepage $portinfo(homepage)
3968                        }
3969                        mportclose $ctx
3970                    }
3971
3972                    # Try to open a browser to the homepage for the given port
3973                    if { $homepage ne "" } {
3974                        if {[catch {system "${macports::autoconf::open_path} '$homepage'"} result]} {
3975                            global errorInfo
3976                            ui_debug "$errorInfo"
3977                            break_softcontinue "unable to invoke browser using ${macports::autoconf::open_path}: $result" 1 status
3978                        }
3979                    } else {
3980                        ui_error [format "No homepage for %s" $portname]
3981                    }
3982                }
3983            }
3984        } else {
3985            break_softcontinue "Could not read $portfile" 1 status
3986        }
3987    }
3988   
3989    return $status
3990}
3991
3992
3993proc action_sync { action portlist opts } {
3994    global global_options
3995
3996    set status 0
3997    if {[catch {mportsync [array get global_options]} result]} {
3998        global errorInfo
3999        ui_debug "$errorInfo"
4000        ui_msg "port sync failed: $result"
4001        set status 1
4002    }
4003   
4004    return $status
4005}
4006
4007
4008proc action_target { action portlist opts } {
4009    global global_variations
4010    set status 0
4011    if {[require_portlist portlist]} {
4012        return 1
4013    }
4014    if {($action eq "install" || $action eq "archive") && [prefix_unwritable] && ![macports::global_option_isset ports_dryrun]} {
4015        return 1
4016    }
4017    foreachport $portlist {
4018        array unset portinfo
4019        # If we have a url, use that, since it's most specific
4020        # otherwise try to map the portname to a url
4021        if {$porturl eq ""} {
4022            # Verify the portname, getting portinfo to map to a porturl
4023            if {[catch {set res [mportlookup $portname]} result]} {
4024                global errorInfo
4025                ui_debug "$errorInfo"
4026                break_softcontinue "lookup of portname $portname failed: $result" 1 status
4027            }
4028            if {[llength $res] < 2} {
4029                # don't error for ports that are installed but not in the tree
4030                if {[registry::entry_exists_for_name $portname]} {
4031                    ui_warn "Skipping $portname (not in the ports tree)"
4032                    continue
4033                } else {
4034                    break_softcontinue "Port $portname not found" 1 status
4035                }
4036            }
4037            array set portinfo [lindex $res 1]
4038            set porturl $portinfo(porturl)
4039        }
4040
4041        # use existing variants iff none were explicitly requested
4042        if {[array get requested_variations] eq "" && [array get variations] ne ""} {
4043            array unset requested_variations
4044            array set requested_variations [array get variations]
4045        }
4046
4047        # Add any global_variations to the variations
4048        # specified for the port
4049        foreach { variation value } [array get global_variations] {
4050            if { ![info exists requested_variations($variation)] } {
4051                set requested_variations($variation) $value
4052            }
4053        }
4054
4055        # If version was specified, save it as a version glob for use
4056        # in port actions (e.g. clean).
4057        if {[string length $portversion]} {
4058            set options(ports_version_glob) $portversion
4059        }
4060        # if installing, mark the port as explicitly requested
4061        if {$action eq "install"} {
4062            if {![info exists options(ports_install_unrequested)]} {
4063                set options(ports_requested) 1
4064            }
4065            # we actually activate as well
4066            set target activate
4067        } elseif {$action eq "archive"} {
4068            set target install
4069        } else {
4070            set target $action
4071        }
4072        if {![info exists options(subport)]} {
4073            if {[info exists portinfo(name)]} {
4074                set options(subport) $portinfo(name)
4075            } else {
4076                set options(subport) $portname
4077            }
4078        }
4079        if {[catch {set workername [mportopen $porturl [array get options] [array get requested_variations]]} result]} {
4080            global errorInfo
4081            ui_debug "$errorInfo"
4082            break_softcontinue "Unable to open port: $result" 1 status
4083        }
4084        if {[catch {set result [mportexec $workername $target]} result]} {
4085            global errorInfo
4086            mportclose $workername
4087            ui_debug "$errorInfo"
4088            break_softcontinue "Unable to execute port: $result" 1 status
4089        }
4090
4091        mportclose $workername
4092       
4093        # Process any error that wasn't thrown and handled already
4094        if {$result} {
4095            print_tickets_url
4096            break_softcontinue "Processing of port $portname failed" 1 status
4097        }
4098    }
4099   
4100    if {$status == 0 && $action eq "install" && ![macports::global_option_isset ports_dryrun]} {
4101        array set options $opts
4102        if {![info exists options(ports_nodeps)] && ![info exists options(ports_install_no-rev-upgrade)] && ${macports::revupgrade_autorun}} {
4103            set status [action_revupgrade $action $portlist $opts]
4104        }
4105    }
4106   
4107    return $status
4108}
4109
4110
4111proc action_exit { action portlist opts } {
4112    # Return a semaphore telling the main loop to quit
4113    return -999
4114}
4115
4116
4117##########################################
4118# Command Parsing
4119##########################################
4120proc moreargs {} {
4121    global cmd_argn cmd_argc
4122    return [expr {$cmd_argn < $cmd_argc}]
4123}
4124
4125
4126proc lookahead {} {
4127    global cmd_argn cmd_argc cmd_argv
4128    if {$cmd_argn < $cmd_argc} {
4129        return [lindex $cmd_argv $cmd_argn]
4130    } else {
4131        return _EOF_
4132    }
4133}
4134
4135
4136proc advance {} {
4137    global cmd_argn
4138    incr cmd_argn
4139}
4140
4141
4142proc match s {
4143    if {[lookahead] == $s} {
4144        advance
4145        return 1
4146    }
4147    return 0
4148}
4149
4150# action_array specifies which action to run on the given command
4151# and if the action wants an expanded portlist.
4152# The value is a list of the form {action expand},
4153# where action is a string and expand a value:
4154#   0 none        Does not expect any text argument
4155#   1 strings     Expects some strings as text argument
4156#   2 ports       Wants an expanded list of ports as text argument
4157global action_array
4158
4159# Define global constants
4160const ACTION_ARGS_NONE 0
4161const ACTION_ARGS_STRINGS 1
4162const ACTION_ARGS_PORTS 2
4163
4164array set action_array [list \
4165    usage       [list action_usage          [ACTION_ARGS_STRINGS]] \
4166    help        [list action_help           [ACTION_ARGS_STRINGS]] \
4167    \
4168    echo        [list action_echo           [ACTION_ARGS_PORTS]] \
4169    \
4170    info        [list action_info           [ACTION_ARGS_PORTS]] \
4171    location    [list action_location       [ACTION_ARGS_PORTS]] \
4172    notes       [list action_notes          [ACTION_ARGS_PORTS]] \
4173    provides    [list action_provides       [ACTION_ARGS_STRINGS]] \
4174    log         [list action_log            [ACTION_ARGS_PORTS]] \
4175    \
4176    activate    [list action_activate       [ACTION_ARGS_PORTS]] \
4177    deactivate  [list action_deactivate     [ACTION_ARGS_PORTS]] \
4178    \
4179    select      [list action_select         [ACTION_ARGS_STRINGS]] \
4180    \
4181    sync        [list action_sync           [ACTION_ARGS_NONE]] \
4182    selfupdate  [list action_selfupdate     [ACTION_ARGS_NONE]] \
4183    \
4184    setrequested   [list action_setrequested  [ACTION_ARGS_PORTS]] \
4185    unsetrequested [list action_setrequested  [ACTION_ARGS_PORTS]] \
4186    \
4187    upgrade     [list action_upgrade        [ACTION_ARGS_PORTS]] \
4188    rev-upgrade [list action_revupgrade     [ACTION_ARGS_NONE]] \
4189    \
4190    version     [list action_version        [ACTION_ARGS_NONE]] \
4191    platform    [list action_platform       [ACTION_ARGS_NONE]] \
4192    \
4193    uninstall   [list action_uninstall      [ACTION_ARGS_PORTS]] \
4194    \
4195    installed   [list action_installed      [ACTION_ARGS_PORTS]] \
4196    outdated    [list action_outdated       [ACTION_ARGS_PORTS]] \
4197    contents    [list action_contents       [ACTION_ARGS_PORTS]] \
4198    space       [list action_space          [ACTION_ARGS_PORTS]] \
4199    dependents  [list action_dependents     [ACTION_ARGS_PORTS]] \
4200    rdependents [list action_dependents     [ACTION_ARGS_PORTS]] \
4201    deps        [list action_deps           [ACTION_ARGS_PORTS]] \
4202    rdeps       [list action_deps           [ACTION_ARGS_PORTS]] \
4203    variants    [list action_variants       [ACTION_ARGS_PORTS]] \
4204    \
4205    search      [list action_search         [ACTION_ARGS_STRINGS]] \
4206    list        [list action_list           [ACTION_ARGS_PORTS]] \
4207    \
4208    edit        [list action_portcmds       [ACTION_ARGS_PORTS]] \
4209    cat         [list action_portcmds       [ACTION_ARGS_PORTS]] \
4210    dir         [list action_portcmds       [ACTION_ARGS_PORTS]] \
4211    work        [list action_portcmds       [ACTION_ARGS_PORTS]] \
4212    cd          [list action_portcmds       [ACTION_ARGS_PORTS]] \
4213    url         [list action_portcmds       [ACTION_ARGS_PORTS]] \
4214    file        [list action_portcmds       [ACTION_ARGS_PORTS]] \
4215    logfile     [list action_portcmds       [ACTION_ARGS_PORTS]] \
4216    gohome      [list action_portcmds       [ACTION_ARGS_PORTS]] \
4217    \
4218    fetch       [list action_target         [ACTION_ARGS_PORTS]] \
4219    checksum    [list action_target         [ACTION_ARGS_PORTS]] \
4220    extract     [list action_target         [ACTION_ARGS_PORTS]] \
4221    patch       [list action_target         [ACTION_ARGS_PORTS]] \
4222    configure   [list action_target         [ACTION_ARGS_PORTS]] \
4223    build       [list action_target         [ACTION_ARGS_PORTS]] \
4224    destroot    [list action_target         [ACTION_ARGS_PORTS]] \
4225    install     [list action_target         [ACTION_ARGS_PORTS]] \
4226    clean       [list action_target         [ACTION_ARGS_PORTS]] \
4227    test        [list action_target         [ACTION_ARGS_PORTS]] \
4228    lint        [list action_target         [ACTION_ARGS_PORTS]] \
4229    livecheck   [list action_target         [ACTION_ARGS_PORTS]] \
4230    distcheck   [list action_target         [ACTION_ARGS_PORTS]] \
4231    mirror      [list action_target         [ACTION_ARGS_PORTS]] \
4232    load        [list action_target         [ACTION_ARGS_PORTS]] \
4233    unload      [list action_target         [ACTION_ARGS_PORTS]] \
4234    distfiles   [list action_target         [ACTION_ARGS_PORTS]] \
4235    \
4236    archivefetch [list action_target         [ACTION_ARGS_PORTS]] \
4237    archive     [list action_target         [ACTION_ARGS_PORTS]] \
4238    unarchive   [list action_target         [ACTION_ARGS_PORTS]] \
4239    dmg         [list action_target         [ACTION_ARGS_PORTS]] \
4240    mdmg        [list action_target         [ACTION_ARGS_PORTS]] \
4241    dpkg        [list action_target         [ACTION_ARGS_PORTS]] \
4242    mpkg        [list action_target         [ACTION_ARGS_PORTS]] \
4243    pkg         [list action_target         [ACTION_ARGS_PORTS]] \
4244    portpkg     [list action_target         [ACTION_ARGS_PORTS]] \
4245    rpm         [list action_target         [ACTION_ARGS_PORTS]] \
4246    srpm        [list action_target         [ACTION_ARGS_PORTS]] \
4247    \
4248    quit        [list action_exit           [ACTION_ARGS_NONE]] \
4249    exit        [list action_exit           [ACTION_ARGS_NONE]] \
4250]
4251
4252# Expand "action".
4253# Returns an action proc, or a list of matching action procs, or the action passed in
4254proc find_action { action } {
4255    global action_array
4256   
4257    if { ! [info exists action_array($action)] } {
4258        set guess [guess_action $action]
4259        if { [info exists action_array($guess)] } {
4260            return $guess
4261        }
4262        return $guess
4263    }
4264   
4265    return $action
4266}
4267
4268# Expand action
4269# If there's more than one match, return the next possibility
4270proc find_action_proc { action } {
4271    global action_array
4272   
4273    set action_proc ""
4274    if { [info exists action_array($action)] } {
4275        set action_proc [lindex $action_array($action) 0]
4276    } else {
4277        set action [complete_action $action]
4278        if { [info exists action_array($action)] } {
4279            set action_proc [lindex $action_array($action) 0]
4280        }
4281    }
4282   
4283    return $action_proc
4284}
4285
4286proc get_action_proc { action } {
4287    global action_array
4288   
4289    set action_proc ""
4290    if { [info exists action_array($action)] } {
4291        set action_proc [lindex $action_array($action) 0]
4292    }
4293   
4294    return $action_proc
4295}
4296
4297# Returns whether an action expects text arguments at all,
4298# expects text arguments or wants an expanded list of ports
4299# Return values are constants:
4300#   [ACTION_ARGS_NONE]     Does not expect any text argument
4301#   [ACTION_ARGS_STRINGS]  Expects some strings as text argument
4302#   [ACTION_ARGS_PORTS]    Wants an expanded list of ports as text argument
4303proc action_needs_portlist { action } {
4304    global action_array
4305
4306    set ret 0
4307    if {[info exists action_array($action)]} {
4308        set ret [lindex $action_array($action) 1]
4309    }
4310
4311    return $ret
4312}
4313
4314# cmd_opts_array specifies which arguments the commands accept
4315# Commands not listed here do not accept any arguments
4316# Syntax if {option argn}
4317# Where option is the name of the option and argn specifies how many arguments
4318# this argument takes
4319global cmd_opts_array
4320array set cmd_opts_array {
4321    edit        {{editor 1}}
4322    info        {category categories depends_fetch depends_extract
4323                 depends_build depends_lib depends_run
4324                 depends description epoch fullname heading homepage index license
4325                 line long_description
4326                 maintainer maintainers name platform platforms portdir pretty
4327                 replaced_by revision subports variant variants version}
4328    contents    {size {units 1}}
4329    deps        {index no-build}
4330    rdeps       {index no-build full}
4331    rdependents {full}
4332    search      {case-sensitive category categories depends_fetch
4333                 depends_extract depends_build depends_lib depends_run
4334                 depends description epoch exact glob homepage line
4335                 long_description maintainer maintainers name platform
4336                 platforms portdir regex revision variant variants version}
4337    selfupdate  {nosync}
4338    space       {{units 1} total}
4339    activate    {no-exec}
4340    deactivate  {no-exec}
4341    install     {no-rev-upgrade unrequested}
4342    uninstall   {follow-dependents follow-dependencies no-exec}
4343    variants    {index}
4344    clean       {all archive dist work logs}
4345    mirror      {new}
4346    lint        {nitpick}
4347    select      {list set show summary}
4348    log         {{phase 1} {level 1}}
4349    upgrade     {force enforce-variants no-replace no-rev-upgrade}
4350    rev-upgrade {id-loadcmd-check}
4351}
4352
4353##
4354# Checks whether the given option is valid
4355#
4356# @param action for which action
4357# @param option the prefix of the option to check
4358# @return list of pairs {name argc} for all matching options
4359proc cmd_option_matches {action option} {
4360    global cmd_opts_array
4361
4362    # This could be so easy with lsearch -index,
4363    # but that's only available as of Tcl 8.5
4364
4365    if {![info exists cmd_opts_array($action)]} {
4366        return {}
4367    }
4368
4369    set result {}
4370
4371    foreach item $cmd_opts_array($action) {
4372        if {[llength $item] == 1} {
4373            set name $item
4374            set argc 0
4375        } else {
4376            set name [lindex $item 0]
4377            set argc [lindex $item 1]
4378        }
4379
4380        if {$name == $option} {
4381            set result [list [list $name $argc]]
4382            break
4383        } elseif {[string first $option $name] == 0} {
4384            lappend result [list $name $argc]
4385        }
4386    }
4387
4388    return $result
4389}
4390
4391# Parse global options
4392#
4393# Note that this is called several times:
4394#   (1) Initially, to parse options that will be constant across all commands
4395#       (options that come prior to any command, frozen into global_options_base)
4396#   (2) Following each command (to parse options that will be unique to that command
4397#       (the global_options array is reset to global_options_base prior to each command)
4398#
4399proc parse_options { action ui_options_name global_options_name } {
4400    upvar $ui_options_name ui_options
4401    upvar $global_options_name global_options
4402    global cmdname cmd_opts_array
4403   
4404    while {[moreargs]} {
4405        set arg [lookahead]
4406       
4407        if {[string index $arg 0] ne "-"} {
4408            break
4409        } elseif {[string index $arg 1] eq "-"} {
4410            # Process long arguments
4411            switch -- $arg {
4412                -- { # This is the options terminator; do no further option processing
4413                    advance; break
4414                }
4415                default {
4416                    set key [string range $arg 2 end]
4417                    set kopts [cmd_option_matches $action $key]
4418                    if {[llength $kopts] == 0} {
4419                        return -code error "${action} does not accept --${key}"
4420                    } elseif {[llength $kopts] > 1} {
4421                        set errlst {}
4422                        foreach e $kopts {
4423                            lappend errlst "--[lindex $e 0]"
4424                        }
4425                        return -code error "\"port ${action} --${key}\" is ambiguous: \n  port ${action} [join $errlst "\n  port ${action} "]"
4426                    }
4427                    set key   [lindex $kopts 0 0]
4428                    set kargc [lindex $kopts 0 1]
4429                    if {$kargc == 0} {
4430                        set global_options(ports_${action}_${key}) yes
4431                    } else {
4432                        set args {}
4433                        while {[moreargs] && $kargc > 0} {
4434                            advance
4435                            lappend args [lookahead]
4436                            set kargc [expr {$kargc - 1}]
4437                        }
4438                        if {$kargc > 0} {
4439                            return -code error "--${key} expects [expr {$kargc + [llength $args]}] parameters!"
4440                        }
4441                        set global_options(ports_${action}_${key}) $args
4442                    }
4443                }
4444            }
4445        } else {
4446            # Process short arg(s)
4447            set opts [string range $arg 1 end]
4448            foreach c [split $opts {}] {
4449                switch -- $c {
4450                    v {
4451                        set ui_options(ports_verbose) yes
4452                    }
4453                    d {
4454                        set ui_options(ports_debug) yes
4455                        # debug implies verbose
4456                        set ui_options(ports_verbose) yes
4457                    }
4458                    q {
4459                        set ui_options(ports_quiet) yes
4460                    }
4461                    p {
4462                        # Ignore errors while processing within a command
4463                        set ui_options(ports_processall) yes
4464                    }
4465                    f {
4466                        set global_options(ports_force) yes
4467                    }
4468                    o {
4469                        set global_options(ports_ignore_different) yes
4470                    }
4471                    n {
4472                        set global_options(ports_nodeps) yes
4473                    }
4474                    u {
4475                        set global_options(port_uninstall_old) yes
4476                    }
4477                    R {
4478                        set global_options(ports_do_dependents) yes
4479                    }
4480                    s {
4481                        set global_options(ports_source_only) yes
4482                    }
4483                    b {
4484                        set global_options(ports_binary_only) yes
4485                    }
4486                    c {
4487                        set global_options(ports_autoclean) yes
4488                    }
4489                    k {
4490                        set global_options(ports_autoclean) no
4491                    }
4492                    t {
4493                        set global_options(ports_trace) yes
4494                    }
4495                    y {
4496                        set global_options(ports_dryrun) yes
4497                    }
4498                    F {
4499                        # Name a command file to process
4500                        advance
4501                        if {[moreargs]} {
4502                            lappend ui_options(ports_commandfiles) [lookahead]
4503                        }
4504                    }
4505                    D {
4506                        advance
4507                        if {[moreargs]} {
4508                            cd [lookahead]
4509                        }
4510                        break
4511                    }
4512                    default {
4513                        print_usage; exit 1
4514                    }
4515                }
4516            }
4517        }
4518
4519        advance
4520    }
4521}
4522
4523# acquire exclusive registry lock for actions that need it
4524# returns 1 if locked, 0 otherwise
4525proc lock_reg_if_needed {action} {
4526    switch -- $action {
4527        activate -
4528        deactivate -
4529        setrequested -
4530        unsetrequested -
4531        upgrade -
4532        uninstall -
4533        install {
4534            registry::exclusive_lock
4535            return 1
4536        }
4537    }
4538    return 0
4539}
4540
4541proc process_cmd { argv } {
4542    global cmd_argc cmd_argv cmd_argn \
4543           global_options global_options_base private_options ui_options \
4544           current_portdir
4545    set cmd_argv $argv
4546    set cmd_argc [llength $argv]
4547    set cmd_argn 0
4548
4549    set action_status 0
4550
4551    # Process an action if there is one
4552    while {($action_status == 0 || [macports::ui_isset ports_processall]) && [moreargs]} {
4553        set action [lookahead]
4554        advance
4555       
4556        # Handle command separator
4557        if { $action == ";" } {
4558            continue
4559        }
4560       
4561        # Handle a comment
4562        if { [string index $action 0] == "#" } {
4563            while { [moreargs] } { advance }
4564            break
4565        }
4566
4567        set locked [lock_reg_if_needed $action]
4568        # Always start out processing an action in current_portdir
4569        cd $current_portdir
4570       
4571        # Reset global_options from base before each action, as we munge it just below...
4572        array unset global_options
4573        array set global_options $global_options_base
4574       
4575        # Find an action to execute
4576        set actions [find_action $action]
4577        if {[llength $actions] == 1} {
4578            set action [lindex $actions 0]
4579            set action_proc [get_action_proc $action]
4580        } else {
4581            if {[llength $actions] > 1} {
4582                ui_error "\"port ${action}\" is ambiguous: \n  port [join $actions "\n  port "]"
4583            } else {
4584                ui_error "Unrecognized action \"port $action\""
4585            }
4586            set action_status 1
4587            break
4588        }
4589
4590        # Parse options that will be unique to this action
4591        # (to avoid abiguity with -variants and a default port, either -- must be
4592        # used to terminate option processing, or the pseudo-port current must be specified).
4593        if {[catch {parse_options $action ui_options global_options} result]} {
4594            global errorInfo
4595            ui_debug "$errorInfo"
4596            ui_error $result
4597            set action_status 1
4598            break
4599        }
4600
4601        # What kind of arguments does the command expect?
4602        set expand [action_needs_portlist $action]
4603
4604        # Parse action arguments, setting a special flag if there were none
4605        # We otherwise can't tell the difference between arguments that evaluate
4606        # to the empty set, and the empty set itself.
4607        set portlist {}
4608        switch -- [lookahead] {
4609            ;       -
4610            _EOF_ {
4611                set private_options(ports_no_args) yes
4612            }
4613            default {
4614                if {[ACTION_ARGS_NONE] == $expand} {
4615                    ui_error "$action does not accept string arguments"
4616                    set action_status 1
4617                    break
4618                } elseif {[ACTION_ARGS_STRINGS] == $expand} {
4619                    while { [moreargs] && ![match ";"] } {
4620                        lappend portlist [lookahead]
4621                        advance
4622                    }
4623                } elseif {[ACTION_ARGS_PORTS] == $expand} {
4624                    # Parse port specifications into portlist
4625                    if {![portExpr portlist]} {
4626                        ui_error "Improper expression syntax while processing parameters"
4627                        set action_status 1
4628                        break
4629                    }
4630                }
4631            }
4632        }
4633       
4634        # execute the action
4635        set action_status [$action_proc $action $portlist [array get global_options]]
4636
4637        # unlock if needed
4638        if {$locked} {
4639            registry::exclusive_unlock
4640        }
4641
4642        # semaphore to exit
4643        if {$action_status == -999} break
4644    }
4645   
4646    return $action_status
4647}
4648
4649
4650proc complete_portname { text state } { 
4651    global complete_choices complete_position
4652   
4653    if {$state == 0} {
4654        set complete_position 0
4655        set complete_choices {}
4656
4657        # Build a list of ports with text as their prefix
4658        if {[catch {set res [mportsearch "${text}*" false glob]} result]} {
4659            global errorInfo
4660            ui_debug "$errorInfo"
4661            fatal "search for portname $pattern failed: $result"
4662        }
4663        foreach {name info} $res {
4664            lappend complete_choices $name
4665        }
4666    }
4667   
4668    set word [lindex $complete_choices $complete_position]
4669    incr complete_position
4670   
4671    return $word
4672}
4673
4674
4675# return text action beginning with $text
4676proc complete_action { text state } {   
4677    global action_array complete_choices complete_position
4678
4679    if {$state == 0} {
4680        set complete_position 0
4681        set complete_choices [array names action_array "[string tolower $text]*"]
4682    }
4683
4684    set word [lindex $complete_choices $complete_position]
4685    incr complete_position
4686
4687    return $word
4688}
4689
4690# return all actions beginning with $text
4691proc guess_action { text } {   
4692    global action_array
4693
4694    return [array names action_array "[string tolower $text]*"]
4695
4696    if { [llength $complete_choices ] == 1 } {
4697        return [lindex $complete_choices 0]
4698    }
4699
4700    return {}
4701}
4702
4703proc attempt_completion { text word start end } {
4704    # If the word starts with '~', or contains '.' or '/', then use the build-in
4705    # completion to complete the word
4706    if { [regexp {^~|[/.]} $word] } {
4707        return ""
4708    }
4709
4710    # Decide how to do completion based on where we are in the string
4711    set prefix [string range $text 0 [expr {$start - 1}]]
4712   
4713    # If only whitespace characters preceed us, or if the
4714    # previous non-whitespace character was a ;, then we're
4715    # an action (the first word of a command)
4716    if { [regexp {(^\s*$)|(;\s*$)} $prefix] } {
4717        return complete_action
4718    }
4719   
4720    # Otherwise, do completion on portname
4721    return complete_portname
4722}
4723
4724
4725proc get_next_cmdline { in out use_readline prompt linename } {
4726    upvar $linename line
4727   
4728    set line ""
4729    while { $line eq "" } {
4730
4731        if {$use_readline} {
4732            set len [readline read -attempted_completion attempt_completion line $prompt]
4733        } else {
4734            puts -nonewline $out $prompt
4735            flush $out
4736            set len [gets $in line]
4737        }
4738
4739        if { $len < 0 } {
4740            return -1
4741        }
4742       
4743        set line [string trim $line]
4744
4745        if { $use_readline && $line ne "" } {
4746            rl_history add $line
4747        }
4748    }
4749   
4750    return [llength $line]
4751}
4752
4753
4754proc process_command_file { in } {
4755    global current_portdir
4756
4757    # Initialize readline
4758    set isstdin [string match $in "stdin"]
4759    set name "port"
4760    set use_readline [expr {$isstdin && [readline init $name]}]
4761    set history_file [file normalize "${macports::macports_user_dir}/history"]
4762
4763    # Read readline history
4764    if {$use_readline && [file isdirectory $macports::macports_user_dir]} {
4765        rl_history read $history_file
4766        rl_history stifle 100
4767    }
4768
4769    # Be noisy, if appropriate
4770    set noisy [expr $isstdin && ![macports::ui_isset ports_quiet]]
4771    if { $noisy } {
4772        puts "MacPorts [macports::version]"
4773        puts "Entering interactive mode... (\"help\" for help, \"quit\" to quit)"
4774    }
4775
4776    # Main command loop
4777    set exit_status 0
4778    while { $exit_status == 0 || $isstdin || [macports::ui_isset ports_processall] } {
4779
4780        # Calculate our prompt
4781        if { $noisy } {
4782            set shortdir [eval file join [lrange [file split $current_portdir] end-1 end]]
4783            set prompt "\[$shortdir\] > "
4784        } else {
4785            set prompt ""
4786        }
4787
4788        # Get a command line
4789        if { [get_next_cmdline $in stdout $use_readline $prompt line] <= 0  } {
4790            puts ""
4791            break
4792        }
4793
4794        # Process the command
4795        set exit_status [process_cmd $line]
4796       
4797        # Check for semaphore to exit
4798        if {$exit_status == -999} {
4799            set exit_status 0
4800            break
4801        }
4802    }
4803
4804    # Create macports user directory if it does not exist yet
4805    if {$use_readline && ![file isdirectory $macports::macports_user_dir]} {
4806        file mkdir $macports::macports_user_dir
4807    }
4808    # Save readine history
4809    if {$use_readline && [file isdirectory $macports::macports_user_dir]} {
4810        rl_history write $history_file
4811    }
4812
4813    # Say goodbye
4814    if { $noisy } {
4815        puts "Goodbye"
4816    }
4817
4818    return $exit_status
4819}
4820
4821
4822proc process_command_files { filelist } {
4823    set exit_status 0
4824
4825    # For each file in the command list, process commands
4826    # in the file
4827    foreach file $filelist {
4828        if {$file eq "-"} {
4829            set in stdin
4830        } else {
4831            if {[catch {set in [open $file]} result]} {
4832                fatal "Failed to open command file; $result"
4833            }
4834        }
4835
4836        set exit_status [process_command_file $in]
4837
4838        if {$in ne "stdin"} {
4839            close $in
4840        }
4841
4842        # Exit on first failure unless -p was given
4843        if {$exit_status != 0 && ![macports::ui_isset ports_processall]} {
4844            return $exit_status
4845        }
4846    }
4847
4848    return $exit_status
4849}
4850
4851namespace eval portclient::progress {
4852    ##
4853    # Maximum width of the progress bar or indicator when displaying it.
4854    variable maxWidth 50
4855
4856    ##
4857    # The start time of the last progress callback as returned by [clock time].
4858    # Since only one progress indicator is active at a time, this variable is
4859    # shared between the different variants of progress functions.
4860    variable startTime
4861
4862    ##
4863    # Delay in milliseconds after the start of the operation before deciding
4864    # that showing a progress bar makes sense.
4865    variable showTimeThreshold 500
4866
4867    ##
4868    # Percentage value between 0 and 1 that must not have been reached yet when
4869    # $showTimeThreshold has passed for a progress bar to be shown. If the
4870    # operation has proceeded above e.g. 75% after 500ms we won't bother
4871    # displaying a progress indicator anymore -- the operation will be finished
4872    # in well below a second anyway.
4873    variable showPercentageThreshold 0.75
4874
4875    ##
4876    # Boolean indication whether the progress indicator should be shown or is
4877    # still hidden because the current operation didn't need enough time for
4878    # a progress indicator to make sense, yet.
4879    variable show no
4880
4881    ##
4882    # Initialize the progress bar display delay; call this from the start
4883    # action of the progress functions.
4884    proc initDelay {} {
4885        variable show
4886        variable startTime
4887
4888        set startTime [clock milliseconds]
4889        set show no
4890    }
4891
4892    ##
4893    # Determine whether a progress bar should be shown for the current
4894    # operation in its current state. You must have called initDelay for the
4895    # current operation before calling this method.
4896    #
4897    # @param cur
4898    #        Current progress in abstract units.
4899    # @param total
4900    #        Total number of abstract units to be processed, if known. Pass
4901    #        0 if unknown.
4902    # @return
4903    #        "yes", if the progress indicator should be shown, "no" otherwise.
4904    proc showProgress {cur total} {
4905        variable show
4906        variable startTime
4907        variable showTimeThreshold
4908        variable showPercentageThreshold
4909
4910        if {$show eq yes} {
4911            return yes
4912        } else {
4913            if {[expr {[clock milliseconds] - $startTime}] > $showTimeThreshold &&
4914                ($total == 0 || [expr {double($cur) / double($total)}] < $showPercentageThreshold)} {
4915                set show yes
4916            }
4917            return $show
4918        }
4919    }
4920
4921    ##
4922    # Progress callback for generic operations executed by macports 1.0.
4923    #
4924    # @param action
4925    #        One of "start", "update", "intermission" or "finish", where start
4926    #        will be called before any number of update calls, interrupted by
4927    #        any number of intermission calls (called because other output is
4928    #        being produced), followed by one call to finish.
4929    # @param args
4930    #        A list of variadic args that differ for each action. For "start",
4931    #        "intermission" and "finish", the args are empty and unused. For
4932    #        "update", args contains $cur and $total, where $cur is the current
4933    #        number of units processed and $total is the total number of units
4934    #        to be processed. If the total is not known, it is 0.
4935    proc generic {action args} {
4936        global env
4937        variable maxWidth
4938
4939        switch -nocase -- $action {
4940            start {
4941                initDelay
4942            }
4943            update {
4944                # the for loop is a simple hack because Tcl 8.4 doesn't have
4945                # lassign
4946                foreach {now total} $args {
4947                    if {[showProgress $now $total] eq yes} {
4948                        set barPrefix "      "
4949                        set barPrefixLen [string length $barPrefix]
4950                        if {$total != 0} {
4951                            progressbar $now $total [expr {min($maxWidth, $env(COLUMNS) - $barPrefixLen)}] $barPrefix
4952                        } else {
4953                            unprogressbar [expr {min($maxWidth, $env(COLUMNS) - $barPrefixLen)}] $barPrefix
4954                        }
4955                    }
4956                }
4957            }
4958            intermission -
4959            finish {
4960                # erase to start of line
4961                ::term::ansi::send::esol
4962                # return cursor to start of line
4963                puts -nonewline "\r"
4964                flush stdout
4965            }
4966        }
4967
4968        return 0
4969    }
4970
4971    ##
4972    # Progress callback for downloads executed by macports 1.0.
4973    #
4974    # This is essentially a cURL progress callback.
4975    #
4976    # @param action
4977    #        One of "start", "update" or "finish", where start will be called
4978    #        before any number of update calls, followed by one call to finish.
4979    # @param args
4980    #        A list of variadic args that differ for each action. For "start",
4981    #        contains a single argument "ul" or "dl" indicating whether this is
4982    #        an up- or download. For "update", contains the arguments
4983    #        ("ul"|"dl") $total $now $speed where ul/dl are as for start, and
4984    #        total, now and speed are doubles indicating the total transfer
4985    #        size, currently transferred amount and average speed per second in
4986    #        bytes. Unused for "finish".
4987    proc download {action args} {
4988        global env
4989        variable maxWidth
4990
4991        switch -nocase -- $action {
4992            start {
4993                initDelay
4994            }
4995            update {
4996                # the for loop is a simple hack because Tcl 8.4 doesn't have
4997                # lassign
4998                foreach {type total now speed} $args {
4999                    if {[showProgress $now $total] eq yes} {
5000                        set barPrefix "      "
5001                        set barPrefixLen [string length $barPrefix]
5002                        if {$total != 0} {
5003                            set barSuffix [format "        speed: %-13s" "[bytesize $speed {} "%.1f"]/s"]
5004                            set barSuffixLen [string length $barSuffix]
5005
5006                            set barLen [expr {min($maxWidth, $env(COLUMNS) - $barPrefixLen - $barSuffixLen)}]
5007                            progressbar $now $total $barLen $barPrefix $barSuffix
5008                        } else {
5009                            set barSuffix [format " %-10s     speed: %-13s" [bytesize $now {} "%6.1f"] "[bytesize $speed {} "%.1f"]/s"]
5010                            set barSuffixLen [string length $barSuffix]
5011
5012                            set barLen [expr {min($maxWidth, $env(COLUMNS) - $barPrefixLen - $barSuffixLen)}]
5013                            unprogressbar $barLen $barPrefix $barSuffix
5014                        }
5015                    }
5016                }
5017            }
5018            finish {
5019                # erase to start of line
5020                ::term::ansi::send::esol
5021                # return cursor to start of line
5022                puts -nonewline "\r"
5023                flush stdout
5024            }
5025        }
5026
5027        return 0
5028    }
5029
5030    ##
5031    # Draw a progress bar using unicode block drawing characters
5032    #
5033    # @param current
5034    #        The current progress value.
5035    # @param total
5036    #        The progress value representing 100%.
5037    # @param width
5038    #        The width in characters of the progress bar. This includes percentage
5039    #        output, which takes up 8 characters.
5040    # @param prefix
5041    #        Prefix to be printed in front of the progress bar.
5042    # @param suffix
5043    #        Suffix to be printed after the progress bar.
5044    proc progressbar {current total width {prefix ""} {suffix ""}} {
5045        # Subtract the width of the percentage output, also subtract the two
5046        # characters [ and ] bounding the progress bar.
5047        set percentageWidth 8
5048        set barWidth      [expr entier($width) - $percentageWidth - 2]
5049
5050        # Map the range (0, $total) to (0, 4 * $width) where $width is the maximum
5051        # numebr of characters to be printed for the progress bar. Multiply the
5052        # upper bound with 8 because we have 8 sub-states per character.
5053        set barProgress   [expr {entier(round(($current * $barWidth * 8) / $total))}]
5054
5055        set barInteger    [expr {$barProgress / 8}]
5056        #set barRemainder  [expr {$barProgress % 8}]
5057
5058        # Finally, also provide a percentage value to print behind the progress bar
5059        set percentage [expr {double($current) * 100 / double($total)}]
5060
5061        # clear the current line, enable reverse video
5062        set progressbar "\033\[7m"
5063        for {set i 0} {$i < $barInteger} {incr i} {
5064            # U+2588 FULL BLOCK doesn't match the other blocks in some fonts :/
5065            # Two half blocks work better in some fonts, but not in others (because
5066            # they leave ugly spaces). So, one or the other choice isn't better or
5067            # worse and even just using full blocks looks ugly in a few fonts.
5068
5069            # Use pure ASCII until somebody fixes most of the default terminal fonts :/
5070            append progressbar " "
5071        }
5072        # back to normal output
5073        append progressbar "\033\[0m"
5074
5075        #switch $barRemainder {
5076        #    0 {
5077        #        if {$barInteger < $barWidth} {
5078        #            append progressbar " "
5079        #        }
5080        #    }
5081        #    1 {
5082        #        # U+258F LEFT ONE EIGHTH BLOCK
5083        #        append progressbar "\u258f"
5084        #    }
5085        #    2 {
5086        #        # U+258E LEFT ONE QUARTER BLOCK
5087        #        append progressbar "\u258e"
5088        #    }
5089        #    3 {
5090        #        # U+258D LEFT THREE EIGHTHS BLOCK
5091        #        append progressbar "\u258d"
5092        #    }
5093        #    3 {
5094        #        # U+258D LEFT THREE EIGHTHS BLOCK
5095        #        append progressbar "\u258d"
5096        #    }
5097        #    4 {
5098        #        # U+258C LEFT HALF BLOCK
5099        #        append progressbar "\u258c"
5100        #    }
5101        #    5 {
5102        #        # U+258B LEFT FIVE EIGHTHS BLOCK
5103        #        append progressbar "\u258b"
5104        #    }
5105        #    6 {
5106        #        # U+258A LEFT THREE QUARTERS BLOCK
5107        #        append progressbar "\u258a"
5108        #    }
5109        #    7 {
5110        #        # U+2589 LEFT SEVEN EIGHTHS BLOCK
5111        #        append progressbar "\u2589"
5112        #    }
5113        #}
5114
5115        # Fill the progress bar with spaces
5116        for {set i $barInteger} {$i < $barWidth} {incr i} {
5117            append progressbar " "
5118        }
5119
5120        # Format the percentage using the space that has been reserved for it
5121        set percentagesuffix [format " %[expr $percentageWidth - 3].1f %%" $percentage]
5122
5123        puts -nonewline "\r${prefix}\[${progressbar}\]${percentagesuffix}${suffix}"
5124        flush stdout
5125    }
5126
5127
5128    ##
5129    # Internal state of the progress indicator; unless you're hacking the
5130    # unprogressbar code you should never touch this.
5131    variable unprogressState 0
5132
5133    ##
5134    # Draw a progress indicator
5135    #
5136    # @param width
5137    #        The width in characters of the progress indicator.
5138    # @param prefix
5139    #        Prefix to be printed in front of the progress indicator.
5140    # @param suffix
5141    #        Suffix to be printed after the progress indicator.
5142    proc unprogressbar {width {prefix ""} {suffix ""}} {
5143        variable unprogressState
5144
5145        # Subtract the two characters [ and ] bounding the progress indicator
5146        # from the width.
5147        set barWidth [expr {int($width) - 2}]
5148
5149        # Number of states of the progress bar, or rather: the number of
5150        # characters before the sequence repeats.
5151        set numStates 4
5152
5153        set unprogressState [expr {($unprogressState + 1) % $numStates}]
5154
5155        set progressbar ""
5156        for {set i 0} {$i < $barWidth} {incr i} {
5157            if {[expr {$i % $numStates}] == $unprogressState} {
5158                # U+2022 BULLET
5159                append progressbar "\u2022"
5160            } else {
5161                append progressbar " "
5162            }
5163        }
5164
5165        puts -nonewline "\r${prefix}\[${progressbar}\]${suffix}"
5166        flush stdout
5167    }
5168}
5169
5170
5171##########################################
5172# Main
5173##########################################
5174
5175# Global arrays passed to the macports1.0 layer
5176array set ui_options        {}
5177array set global_options    {}
5178array set global_variations {}
5179
5180# Global options private to this script
5181array set private_options {}
5182
5183# Make sure we get the size of the terminal
5184# We do this here to save it in the boot_env, in case we determined it manually
5185term_init_size
5186
5187global env boot_env argv0 cmdname argc argv cmd_argc cmd_argv cmd_argn \
5188       current_portdir global_options_base exit_status
5189
5190# Save off a copy of the environment before mportinit monkeys with it
5191array set boot_env [array get env]
5192
5193set cmdname [file tail $argv0]
5194
5195# Setp cmd_argv to match argv
5196set cmd_argv $argv
5197set cmd_argc $argc
5198set cmd_argn 0
5199
5200# make sure we're using a sane umask
5201umask 022
5202
5203# If we've been invoked as portf, then the first argument is assumed
5204# to be the name of a command file (i.e., there is an implicit -F
5205# before any arguments).
5206if {[moreargs] && $cmdname eq "portf"} {
5207    lappend ui_options(ports_commandfiles) [lookahead]
5208    advance
5209}
5210
5211# Parse global options that will affect all subsequent commands
5212if {[catch {parse_options "global" ui_options global_options} result]} {
5213    puts "Error: $result"
5214    print_usage
5215    exit 1
5216}
5217
5218if {[isatty stdout]
5219    && $portclient::progress::hasTermAnsiSend eq yes
5220    && (![info exists ui_options(ports_quiet)] || $ui_options(ports_quiet) ne "yes")} {
5221    set ui_options(progress_download) portclient::progress::download
5222    set ui_options(progress_generic)  portclient::progress::generic
5223}
5224
5225# Get arguments remaining after option processing
5226set remaining_args [lrange $cmd_argv $cmd_argn end]
5227
5228# If we have no arguments remaining after option processing then force
5229# interactive mode
5230if { [llength $remaining_args] == 0 && ![info exists ui_options(ports_commandfiles)] } {
5231    lappend ui_options(ports_commandfiles) -
5232} elseif {[lookahead] eq "selfupdate" || [lookahead] eq "sync"} {
5233    # tell mportinit not to tell the user they should selfupdate
5234    set ui_options(ports_no_old_index_warning) 1
5235}
5236
5237# Initialize mport
5238# This must be done following parse of global options, as some options are
5239# evaluated by mportinit.
5240if {[catch {mportinit ui_options global_options global_variations} result]} {
5241    global errorInfo
5242    puts "$errorInfo"
5243    fatal "Failed to initialize MacPorts, $result"
5244}
5245
5246# Set up some global state for our code
5247set current_portdir [pwd]
5248
5249# Freeze global_options into global_options_base; global_options
5250# will be reset to global_options_base prior to processing each command.
5251set global_options_base [array get global_options]
5252
5253# First process any remaining args as action(s)
5254set exit_status 0
5255if { [llength $remaining_args] > 0 } {
5256
5257    # If there are remaining arguments, process those as a command
5258    set exit_status [process_cmd $remaining_args]
5259}
5260
5261# Process any prescribed command files, including standard input
5262if { ($exit_status == 0 || [macports::ui_isset ports_processall]) && [info exists ui_options(ports_commandfiles)] } {
5263    set exit_status [process_command_files $ui_options(ports_commandfiles)]
5264}
5265if {$exit_status == -999} {
5266    set exit_status 0
5267}
5268
5269# shut down macports1.0
5270mportshutdown
5271
5272# Return with exit_status
5273exit $exit_status
Note: See TracBrowser for help on using the repository browser.