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

Last change on this file since 64641 was 64641, checked in by jmr@…, 11 years ago

fix multiple portuninstall namespace confusion

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 128.2 KB
Line 
1#!/bin/sh
2# -*- coding: utf-8; mode: tcl; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- vim:fenc=utf-8:filetype=tcl:et:sw=4:ts=4:sts=4
3# Run the Tcl interpreter \
4exec @TCLSH@ "$0" "$@"
5# port.tcl
6# $Id: port.tcl 64641 2010-03-12 17:52:53Z jmr@macports.org $
7#
8# Copyright (c) 2002-2007 The MacPorts Project.
9# Copyright (c) 2004 Robert Shaw <rshaw@opendarwin.org>
10# Copyright (c) 2002 Apple Computer, Inc.
11# All rights reserved.
12#
13# Redistribution and use in source and binary forms, with or without
14# modification, are permitted provided that the following conditions
15# are met:
16# 1. Redistributions of source code must retain the above copyright
17#    notice, this list of conditions and the following disclaimer.
18# 2. Redistributions in binary form must reproduce the above copyright
19#    notice, this list of conditions and the following disclaimer in the
20#    documentation and/or other materials provided with the distribution.
21# 3. Neither the name of Apple Computer, Inc. nor the names of its contributors
22#    may be used to endorse or promote products derived from this software
23#    without specific prior written permission.
24#
25# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
26# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
27# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
28# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
29# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
30# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
31# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
32# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
33# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
34# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
35# POSSIBILITY OF SUCH DAMAGE.
36
37catch {source \
38    [file join "@TCL_PACKAGE_DIR@" macports1.0 macports_fastload.tcl]}
39package require macports
40package require Pextlib 1.0
41
42
43# Standard procedures
44proc print_usage {{verbose 1}} {
45    global cmdname
46    set syntax {
47        [-bcdfknopqRstuvy] [-D portdir] [-F cmdfile] action [privopts] [actionflags]
48        [[portname|pseudo-portname|port-url] [@version] [+-variant]... [option=value]...]...
49    }
50
51    if {$verbose} {
52        puts stderr "Usage: $cmdname$syntax"
53        puts stderr "\"$cmdname help\" or \"man 1 port\" for more information."
54    } else {
55        puts stderr "$cmdname$syntax"
56    }
57}
58
59proc print_help {args} {
60    global action_array
61
62    print_usage 0
63
64    # Generate and format the command list from the action_array
65    set cmds ""
66    set lineLen 0
67    foreach cmd [lsort [array names action_array]] {
68        if {$lineLen > 65} {
69            set cmds "$cmds,\n"
70            set lineLen 0
71        }
72        if {$lineLen == 0} {
73            set new "$cmd"
74        } else {
75            set new ", $cmd"
76        }
77        incr lineLen [string length $new]
78        set cmds "$cmds$new"
79    }
80
81    set cmdText "Supported commands
82------------------
83$cmds
84"
85
86    set text {
87Pseudo-portnames
88----------------
89Pseudo-portnames are words that may be used in place of a portname, and
90which expand to some set of ports. The common pseudo-portnames are:
91all, current, active, inactive, installed, uninstalled, outdated and obsolete.
92These pseudo-portnames expand to the set of ports named.
93
94Additional pseudo-portnames start with...
95variants:, variant:, description:, depends:, depends_lib:, depends_run:,
96depends_build:, depends_fetch:, depends_extract:, portdir:, homepage:, epoch:,
97platforms:, platform:, name:, long_description:, maintainers:, maintainer:,
98categories:, category:, version:, and revision:.
99These each select a set of ports based on a regex search of metadata
100about the ports. In all such cases, a standard regex pattern following
101the colon will be used to select the set of ports to which the
102pseudo-portname expands.
103
104Portnames that contain standard glob characters will be expanded to the
105set of ports matching the glob pattern.
106   
107Port expressions
108----------------
109Portnames, port glob patterns, and pseudo-portnames may be logically
110combined using expressions consisting of and, or, not, !, (, and ).
111   
112For more information
113--------------------
114See man pages: port(1), macports.conf(5), portfile(7), portgroup(7),
115porthier(7), portstyle(7). Also, see http://www.macports.org.
116    }
117
118    puts "$cmdText$text"
119}
120
121
122# Produce error message and exit
123proc fatal s {
124    global argv0
125    ui_error "$argv0: $s"
126    exit 1
127}
128
129##
130# Helper function to define constants
131#
132# Constants defined with const can simply be accessed in the same way as
133# calling a proc.
134#
135# Example:
136# const FOO 42
137# puts [FOO]
138#
139# @param name variable name
140# @param value constant variable value
141proc const {name args} {
142    interp alias {} $name {} _const [expr $args]
143}
144
145##
146# Helper function to define constants
147#
148# @see const
149proc _const value {
150    return $value
151}
152
153
154
155# Produce an error message, and exit, unless
156# we're handling errors in a soft fashion, in which
157# case we continue
158proc fatal_softcontinue s {
159    if {[macports::global_option_isset ports_force]} {
160        ui_error $s
161        return -code continue
162    } else {
163        fatal $s
164    }
165}
166
167
168# Produce an error message, and break, unless
169# we're handling errors in a soft fashion, in which
170# case we continue
171proc break_softcontinue { msg status name_status } {
172    upvar $name_status status_var
173    ui_error $msg
174    if {[macports::ui_isset ports_processall]} {
175        set status_var 0
176        return -code continue
177    } else {
178        set status_var $status
179        return -code break
180    }
181}
182
183# show the URL for the ticket reporting instructions
184proc print_tickets_url {args} {
185    if {![macports::ui_isset ports_quiet]} {
186        ui_msg "To report a bug, see <http://guide.macports.org/#project.tickets>"
187    }
188}
189
190# Form a composite version as is sometimes used for registry functions
191proc composite_version {version variations {emptyVersionOkay 0}} {
192    # Form a composite version out of the version and variations
193   
194    # Select the variations into positive and negative
195    set pos {}
196    set neg {}
197    foreach { key val } $variations {
198        if {$val == "+"} {
199            lappend pos $key
200        } elseif {$val == "-"} {
201            lappend neg $key
202        }
203    }
204
205    # If there is no version, we have nothing to do
206    set composite_version ""
207    if {$version != "" || $emptyVersionOkay} {
208        set pos_str ""
209        set neg_str ""
210
211        if {[llength $pos]} {
212            set pos_str "+[join [lsort -ascii $pos] "+"]"
213        }
214        if {[llength $neg]} {
215            set neg_str "-[join [lsort -ascii $neg] "-"]"
216        }
217
218        set composite_version "$version$pos_str$neg_str"
219    }
220
221    return $composite_version
222}
223
224
225proc split_variants {variants} {
226    set result {}
227    set l [regexp -all -inline -- {([-+])([[:alpha:]_]+[\w\.]*)} $variants]
228    foreach { match sign variant } $l {
229        lappend result $variant $sign
230    }
231    return $result
232}
233
234
235##
236# Maps friendly field names to their real name
237# Names which do not need mapping are not changed.
238#
239# @param field friendly name
240# @return real name
241proc map_friendly_field_names { field } {
242    switch -- $field {
243        variant -
244        platform -
245        maintainer {
246            set field "${field}s"
247        }
248        category {
249            set field "categories"
250        }
251    }
252
253    return $field
254}
255
256
257proc registry_installed {portname {portversion ""}} {
258    set ilist [registry::installed $portname $portversion]
259    if { [llength $ilist] > 1 } {
260        # set portname again since the one we were passed may not have had the correct case
261        set portname [lindex [lindex $ilist 0] 0]
262        if {![macports::ui_isset ports_quiet] && [isatty stdout]} {
263            puts "The following versions of $portname are currently installed:"
264        }
265        foreach i [portlist_sortint $ilist] { 
266            set iname [lindex $i 0]
267            set iversion [lindex $i 1]
268            set irevision [lindex $i 2]
269            set ivariants [lindex $i 3]
270            set iactive [lindex $i 4]
271            if { $iactive == 0 } {
272                puts "  $iname ${iversion}_${irevision}${ivariants}"
273            } elseif { $iactive == 1 } {
274                puts "  $iname ${iversion}_${irevision}${ivariants} (active)"
275            }
276        }
277        return -code error "Registry error: Please specify the full version as recorded in the port registry."
278    } else {
279        return [lindex $ilist 0]
280    }
281}
282
283
284proc add_to_portlist {listname portentry} {
285    upvar $listname portlist
286    global global_options global_variations
287
288    # The portlist currently has the following elements in it:
289    #   url             if any
290    #   name
291    #   version         (version_revision)
292    #   variants array  (variant=>+-)
293    #   requested_variants array  (variant=>+-)
294    #   options array   (key=>value)
295    #   fullname        (name/version_revision+-variants)
296
297    array set port $portentry
298    if {![info exists port(url)]}       { set port(url) "" }
299    if {![info exists port(name)]}      { set port(name) "" }
300    if {![info exists port(version)]}   { set port(version) "" }
301    if {![info exists port(variants)]}  { set port(variants) "" }
302    if {![info exists port(requested_variants)]}  { set port(requested_variants) "" }
303    if {![info exists port(options)]}   { set port(options) [array get global_options] }
304
305    # If neither portname nor url is specified, then default to the current port
306    if { $port(url) == "" && $port(name) == "" } {
307        set url file://.
308        set portname [url_to_portname $url]
309        set port(url) $url
310        set port(name) $portname
311        if {$portname == ""} {
312            ui_error "A default port name could not be supplied."
313        }
314    }
315
316
317    # Form the fully descriminated portname: portname/version_revison+-variants
318    set port(fullname) "$port(name)/[composite_version $port(version) $port(variants)]"
319   
320    # Add it to our portlist
321    lappend portlist [array get port]
322}
323
324
325proc add_ports_to_portlist {listname ports {overridelist ""}} {
326    upvar $listname portlist
327
328    array set overrides $overridelist
329
330    # Add each entry to the named portlist, overriding any values
331    # specified as overrides
332    foreach portentry $ports {
333        array set port $portentry
334        if ([info exists overrides(version)])   { set port(version) $overrides(version) }
335        if ([info exists overrides(variants)])  { set port(variants) $overrides(variants) }
336        if ([info exists overrides(requested_variants)])  { set port(requested_variants) $overrides(requested_variants) }
337        if ([info exists overrides(options)])   { set port(options) $overrides(options) }
338        add_to_portlist portlist [array get port]
339    }
340}
341
342
343proc url_to_portname { url {quiet 0} } {
344    # Save directory and restore the directory, since mportopen changes it
345    set savedir [pwd]
346    set portname ""
347    if {[catch {set ctx [mportopen $url]} result]} {
348        if {!$quiet} {
349            ui_msg "Can't map the URL '$url' to a port description file (\"${result}\")."
350            ui_msg "Please verify that the directory and portfile syntax are correct."
351        }
352    } else {
353        array set portinfo [mportinfo $ctx]
354        set portname $portinfo(name)
355        mportclose $ctx
356    }
357    cd $savedir
358    return $portname
359}
360
361
362# Supply a default porturl/portname if the portlist is empty
363proc require_portlist { nameportlist } {
364    global private_options
365    upvar $nameportlist portlist
366
367    if {[llength $portlist] == 0 && (![info exists private_options(ports_no_args)] || $private_options(ports_no_args) == "no")} {
368        ui_error "No ports matched the given expression"
369        return 1
370    }
371
372    if {[llength $portlist] == 0} {
373        set portlist [get_current_port]
374
375        if {[llength $portlist] == 0} {
376            # there was no port in current directory
377            return 1
378        }
379    }
380
381    return 0
382}
383
384
385# Execute the enclosed block once for every element in the portlist
386# When the block is entered, the variables portname, portversion, options, and variations
387# will have been set
388proc foreachport {portlist block} {
389    # Restore cwd after each port, since mportopen changes it, and relative
390    # urls will break on subsequent passes
391    set savedir [pwd]
392    foreach portspec $portlist {
393        uplevel 1 "array set portspec { $portspec }"
394        uplevel 1 {
395            set porturl $portspec(url)
396            set portname $portspec(name)
397            set portversion $portspec(version)
398            array unset variations
399            array set variations $portspec(variants)
400            array unset requested_variations
401            array set requested_variations $portspec(requested_variants)
402            array unset options
403            array set options $portspec(options)
404        }
405        uplevel 1 $block
406        if {[file exists $savedir]} {
407            cd $savedir
408        } else {
409            cd ~
410        }
411    }
412}
413
414
415proc portlist_compare { a b } {
416    array set a_ $a
417    array set b_ $b
418    set namecmp [string compare -nocase $a_(name) $b_(name)]
419    if {$namecmp != 0} {
420        return $namecmp
421    }
422    set avr_ [split $a_(version) "_"]
423    set bvr_ [split $b_(version) "_"]
424    set vercmp [rpm-vercomp [lindex $avr_ 0] [lindex $bvr_ 0]]
425    if {$vercmp != 0} {
426        return $vercmp
427    }
428    set ar_ [lindex $avr_ 1]
429    set br_ [lindex $bvr_ 1]
430    if {$ar_ < $br_} {
431        return -1
432    } elseif {$ar_ > $br_} {
433        return 1
434    } else {
435        return 0
436    }
437}
438
439# Sort two ports in NVR (name@version_revision) order
440proc portlist_sort { list } {
441    return [lsort -command portlist_compare $list]
442}
443
444proc portlist_compareint { a b } {
445    array set a_ [list "name" [lindex $a 0] "version" "[lindex $a 1]_[lindex $a 2]"]
446    array set b_ [list "name" [lindex $b 0] "version" "[lindex $b 1]_[lindex $b 2]"]
447    return [portlist_compare [array get a_] [array get b_]]
448}
449
450# Same as portlist_sort, but with numeric indexes {name version revision}
451proc portlist_sortint { list } {
452    return [lsort -command portlist_compareint $list]
453}
454
455proc regex_pat_sanitize { s } {
456    set sanitized [regsub -all {[\\(){}+$.^]} $s {\\&}]
457    return $sanitized
458}
459
460##
461# Makes sure we get the current terminal size
462proc term_init_size {} {
463    global env
464
465    if {![info exists env(COLUMNS)] || ![info exists env(LINES)]} {
466        if {[isatty stdout]} {
467            set size [term_get_size stdout]
468
469            if {![info exists env(LINES)] && [lindex $size 0] > 0} {
470                set env(LINES) [lindex $size 0]
471            }
472
473            if {![info exists env(COLUMNS)] && [lindex $size 1] > 0} {
474                set env(COLUMNS) [lindex $size 1]
475            }
476        }
477    }
478}
479
480##
481# Wraps a multi-line string at specified textwidth
482#
483# @see wrapline
484#
485# @param string input string
486# @param maxlen text width (0 defaults to current terminal width)
487# @param indent prepend to every line
488# @return wrapped string
489proc wrap {string maxlen {indent ""} {indentfirstline 1}} {
490    global env
491
492    if {$maxlen == 0} {
493        if {![info exists env(COLUMNS)]} {
494            # no width for wrapping
495            return $string
496        }
497        set maxlen $env(COLUMNS)
498    }
499
500    set splitstring {}
501    foreach line [split $string "\n"] {
502        lappend splitstring [wrapline $line $maxlen $indent $indentfirstline]
503    }
504    return [join $splitstring "\n"]
505}
506
507##
508# Wraps a line at specified textwidth
509#
510# @see wrap
511#
512# @param line input line
513# @param maxlen text width (0 defaults to current terminal width)
514# @param indent prepend to every line
515# @return wrapped string
516proc wrapline {line maxlen {indent ""} {indentfirstline 1}} {
517    global env
518
519    if {$maxlen == 0} {
520        if {![info exists env(COLUMNS)]} {
521            # no width for wrapping
522            return $string
523        }
524        set maxlen $env(COLUMNS)
525    }
526
527    set string [split $line " "]
528    if {$indentfirstline == 0} {
529        set newline ""
530        set maxlen [expr $maxlen - [string length $indent]]
531    } else {
532        set newline $indent
533    }
534    append newline [lindex $string 0]
535    set joiner " "
536    set first 1
537    foreach word [lrange $string 1 end] {
538        if {[string length $newline]+[string length $word] >= $maxlen} {
539            lappend lines $newline
540            set newline $indent
541            set joiner ""
542            # If indentfirstline is set to 0, reset maxlen to its
543            # original length after appending the first line to lines.
544            if {$first == 1 && $indentfirstline == 0} {
545                set maxlen [expr $maxlen + [string length $indent]]
546            }
547            set first 0
548        }
549        append newline $joiner $word
550        set joiner " "
551    }
552    lappend lines $newline
553    return [join $lines "\n"]
554}
555
556##
557# Wraps a line at a specified width with a label in front
558#
559# @see wrap
560#
561# @param label label for output
562# @param string input string
563# @param maxlen text width (0 defaults to current terminal width)
564# @return wrapped string
565proc wraplabel {label string maxlen {indent ""}} {
566    append label ": [string repeat " " [expr [string length $indent] - [string length "$label: "]]]"
567    return "$label[wrap $string $maxlen $indent 0]"
568}
569
570proc unobscure_maintainers { list } {
571    set result {}
572    foreach m $list {
573        if {[string first "@" $m] < 0} {
574            if {[string first ":" $m] >= 0} {
575                set m [regsub -- "(.*):(.*)" $m "\\2@\\1"] 
576            } else {
577                set m "$m@macports.org"
578            }
579        }
580        lappend result $m
581    }
582    return $result
583}
584
585
586##########################################
587# Port selection
588##########################################
589proc get_matching_ports {pattern {casesensitive no} {matchstyle glob} {field name}} {
590    if {[catch {set res [mportsearch $pattern $casesensitive $matchstyle $field]} result]} {
591        global errorInfo
592        ui_debug "$errorInfo"
593        fatal "search for portname $pattern failed: $result"
594    }
595
596    set results {}
597    foreach {name info} $res {
598        array unset portinfo
599        array set portinfo $info
600
601        #set variants {}
602        #if {[info exists portinfo(variants)]} {
603        #   foreach variant $portinfo(variants) {
604        #       lappend variants $variant "+"
605        #   }
606        #}
607        # For now, don't include version or variants with all ports list
608        #"$portinfo(version)_$portinfo(revision)"
609        #$variants
610        add_to_portlist results [list url $portinfo(porturl) name $name]
611    }
612
613    # Return the list of all ports, sorted
614    return [portlist_sort $results]
615}
616
617
618proc get_all_ports {} {
619    global all_ports_cache
620
621    if {![info exists all_ports_cache]} {
622         if {[catch {set res [mportlistall]} result]} {
623            global errorInfo
624            ui_debug "$errorInfo"
625            fatal "listing all ports failed: $result"
626        }
627        set results {}
628        foreach {name info} $res {
629            array unset portinfo
630            array set portinfo $info
631            add_to_portlist results [list url $portinfo(porturl) name $name]
632        }
633
634        set all_ports_cache [portlist_sort $results]
635    }
636    return $all_ports_cache
637}
638
639
640proc get_current_ports {} {
641    # This is just a synonym for get_current_port that
642    # works with the regex in element
643    return [get_current_port]
644}
645
646
647proc get_current_port {} {
648    set url file://.
649    set portname [url_to_portname $url]
650    if {$portname == ""} {
651        ui_msg "To use the current port, you must be in a port's directory."
652        ui_msg "(you might also see this message if a pseudo-port such as"
653        ui_msg "outdated or installed expands to no ports)."
654        return [list]
655    }
656
657    set results {}
658    add_to_portlist results [list url $url name $portname]
659    return $results
660}
661
662
663proc get_installed_ports { {ignore_active yes} {active yes} } {
664    set ilist {}
665    if { [catch {set ilist [registry::installed]} result] } {
666        if {$result != "Registry error: No ports registered as installed."} {
667            global errorInfo
668            ui_debug "$errorInfo"
669            fatal "port installed failed: $result"
670        }
671    }
672
673    set results {}
674    foreach i $ilist {
675        set iname [lindex $i 0]
676        set iversion [lindex $i 1]
677        set irevision [lindex $i 2]
678        set ivariants [split_variants [lindex $i 3]]
679        set iactive [lindex $i 4]
680
681        if { ${ignore_active} == "yes" || (${active} == "yes") == (${iactive} != 0) } {
682            add_to_portlist results [list name $iname version "${iversion}_${irevision}" variants $ivariants]
683        }
684    }
685
686    # Return the list of ports, sorted
687    return [portlist_sort $results]
688}
689
690
691proc get_uninstalled_ports {} {
692    # Return all - installed
693    set all [get_all_ports]
694    set installed [get_installed_ports]
695    return [opComplement $all $installed]
696}
697
698
699proc get_active_ports {} {
700    return [get_installed_ports no yes]
701}
702
703
704proc get_inactive_ports {} {
705    return [get_installed_ports no no]
706}
707
708
709proc get_outdated_ports {} {
710    global macports::registry.installtype
711    set is_image_mode [expr 0 == [string compare "image" ${macports::registry.installtype}]]
712
713    # Get the list of installed ports
714    set ilist {}
715    if { [catch {set ilist [registry::installed]} result] } {
716        if {$result != "Registry error: No ports registered as installed."} {
717            global errorInfo
718            ui_debug "$errorInfo"
719            fatal "port installed failed: $result"
720        }
721    }
722
723    # Now process the list, keeping only those ports that are outdated
724    set results {}
725    if { [llength $ilist] > 0 } {
726        foreach i $ilist {
727
728            # Get information about the installed port
729            set portname            [lindex $i 0]
730            set installed_version   [lindex $i 1]
731            set installed_revision  [lindex $i 2]
732            set installed_compound  "${installed_version}_${installed_revision}"
733            set installed_variants  [lindex $i 3]
734
735            set is_active           [lindex $i 4]
736            if { $is_active == 0 && $is_image_mode } continue
737
738            set installed_epoch     [lindex $i 5]
739
740            # Get info about the port from the index
741            if {[catch {set res [mportlookup $portname]} result]} {
742                global errorInfo
743                ui_debug "$errorInfo"
744                fatal "lookup of portname $portname failed: $result"
745            }
746            if {[llength $res] < 2} {
747                if {[macports::ui_isset ports_debug]} {
748                    puts stderr "$portname ($installed_compound is installed; the port was not found in the port index)"
749                }
750                continue
751            }
752            array unset portinfo
753            array set portinfo [lindex $res 1]
754
755            # Get information about latest available version and revision
756            set latest_version $portinfo(version)
757            set latest_revision     0
758            if {[info exists portinfo(revision)] && $portinfo(revision) > 0} { 
759                set latest_revision $portinfo(revision)
760            }
761            set latest_compound     "${latest_version}_${latest_revision}"
762            set latest_epoch        0
763            if {[info exists portinfo(epoch)]} { 
764                set latest_epoch    $portinfo(epoch)
765            }
766
767            # Compare versions, first checking epoch, then version, then revision
768            set comp_result [expr $installed_epoch - $latest_epoch]
769            if { $comp_result == 0 } {
770                set comp_result [rpm-vercomp $installed_version $latest_version]
771                if { $comp_result == 0 } {
772                    set comp_result [rpm-vercomp $installed_revision $latest_revision]
773                }
774            }
775
776            # Add outdated ports to our results list
777            if { $comp_result < 0 } {
778                add_to_portlist results [list name $portname version $installed_compound variants [split_variants $installed_variants]]
779            }
780        }
781    }
782
783    return $results
784}
785
786
787proc get_obsolete_ports {} {
788    set ilist [get_installed_ports]
789    set results {}
790
791    foreach i $ilist {
792        array set port $i
793
794        if {[catch {mportlookup $port(name)} result]} {
795            ui_debug "$::errorInfo"
796            break_softcontinue "lookup of portname $portname failed: $result" 1 status
797        }
798
799        if {[llength $result] < 2} {
800            lappend results $i
801        }
802    }
803
804    # Return the list of ports, already sorted
805    return [portlist_sort $results]
806}
807
808
809##########################################
810# Port expressions
811##########################################
812proc portExpr { resname } {
813    upvar $resname reslist
814    set result [seqExpr reslist]
815    return $result
816}
817
818
819proc seqExpr { resname } {
820    upvar $resname reslist
821   
822    # Evaluate a sequence of expressions a b c...
823    # These act the same as a or b or c
824
825    set result 1
826    while {$result} {
827        switch -- [lookahead] {
828            ;       -
829            )       -
830            _EOF_   { break }
831        }
832
833        set blist {}
834        set result [orExpr blist]
835        if {$result} {
836            # Calculate the union of result and b
837            set reslist [opUnion $reslist $blist]
838        }
839    }
840
841    return $result
842}
843
844
845proc orExpr { resname } {
846    upvar $resname reslist
847   
848    set a [andExpr reslist]
849    while ($a) {
850        switch -- [lookahead] {
851            or {
852                    advance
853                    set blist {}
854                    if {![andExpr blist]} {
855                        return 0
856                    }
857                       
858                    # Calculate a union b
859                    set reslist [opUnion $reslist $blist]
860                }
861            default {
862                    return $a
863                }
864        }
865    }
866   
867    return $a
868}
869
870
871proc andExpr { resname } {
872    upvar $resname reslist
873   
874    set a [unaryExpr reslist]
875    while {$a} {
876        switch -- [lookahead] {
877            and {
878                    advance
879                   
880                    set blist {}
881                    set b [unaryExpr blist]
882                    if {!$b} {
883                        return 0
884                    }
885                   
886                    # Calculate a intersect b
887                    set reslist [opIntersection $reslist $blist]
888                }
889            default {
890                    return $a
891                }
892        }
893    }
894   
895    return $a
896}
897
898
899proc unaryExpr { resname } {
900    upvar $resname reslist
901    set result 0
902
903    switch -- [lookahead] {
904        !   -
905        not {
906                advance
907                set blist {}
908                set result [unaryExpr blist]
909                if {$result} {
910                    set all [get_all_ports]
911                    set reslist [opComplement $all $blist]
912                }
913            }
914        default {
915                set result [element reslist]
916            }
917    }
918   
919    return $result
920}
921
922
923proc element { resname } {
924    upvar $resname reslist
925    set el 0
926   
927    set url ""
928    set name ""
929    set version ""
930    array unset requested_variants
931    array unset options
932   
933    set token [lookahead]
934    switch -regex -- $token {
935        ^\\)$               -
936        ^\;                 -
937        ^_EOF_$             { # End of expression/cmd/file
938        }
939
940        ^\\($               { # Parenthesized Expression
941            advance
942            set el [portExpr reslist]
943            if {!$el || ![match ")"]} {
944                set el 0
945            }
946        }
947
948        ^all(@.*)?$         -
949        ^installed(@.*)?$   -
950        ^uninstalled(@.*)?$ -
951        ^active(@.*)?$      -
952        ^inactive(@.*)?$    -
953        ^outdated(@.*)?$    -
954        ^obsolete(@.*)?$    -
955        ^current(@.*)?$     {
956            # A simple pseudo-port name
957            advance
958
959            # Break off the version component, if there is one
960            regexp {^(\w+)(@.*)?} $token matchvar name remainder
961
962            add_multiple_ports reslist [get_${name}_ports] $remainder
963
964            set el 1
965        }
966
967        ^variants:          -
968        ^variant:           -
969        ^description:       -
970        ^portdir:           -
971        ^homepage:          -
972        ^epoch:             -
973        ^platforms:         -
974        ^platform:          -
975        ^name:              -
976        ^long_description:  -
977        ^maintainers:       -
978        ^maintainer:        -
979        ^categories:        -
980        ^category:          -
981        ^version:           -
982        ^depends_lib:       -
983        ^depends_build:     -
984        ^depends_run:       -
985        ^depends_extract:   -
986        ^depends_fetch:     -
987        ^revision:          { # Handle special port selectors
988            advance
989
990            # Break up the token, because older Tcl switch doesn't support -matchvar
991            regexp {^(\w+):(.*)} $token matchvar field pat
992
993            # Remap friendly names to actual names
994            set field [map_friendly_field_names $field]
995
996            add_multiple_ports reslist [get_matching_ports $pat no regexp $field]
997            set el 1
998        }
999
1000        ^depends:           { # A port selector shorthand for depends_{lib,build,run,fetch,extract}
1001            advance
1002
1003            # Break up the token, because older Tcl switch doesn't support -matchvar
1004            regexp {^(\w+):(.*)} $token matchvar field pat
1005
1006            add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_lib"]
1007            add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_build"]
1008            add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_run"]
1009            add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_extract"]
1010            add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_fetch"]
1011
1012            set el 1
1013        }
1014
1015        [][?*]              { # Handle portname glob patterns
1016            advance; add_multiple_ports reslist [get_matching_ports $token no glob]
1017            set el 1
1018        }
1019
1020        ^\\w+:.+            { # Handle a url by trying to open it as a port and mapping the name
1021            advance
1022            set name [url_to_portname $token]
1023            if {$name != ""} {
1024                parsePortSpec version requested_variants options
1025                add_to_portlist reslist [list url $token \
1026                  name $name \
1027                  version $version \
1028                  requested_variants [array get requested_variants] \
1029                  variants [array get requested_variants] \
1030                  options [array get options]]
1031            } else {
1032                ui_error "Can't open URL '$token' as a port"
1033                set el 0
1034            }
1035            set el 1
1036        }
1037
1038        default             { # Treat anything else as a portspec (portname, version, variants, options
1039            # or some combination thereof).
1040            parseFullPortSpec url name version requested_variants options
1041            add_to_portlist reslist [list url $url \
1042              name $name \
1043              version $version \
1044              requested_variants [array get requested_variants] \
1045              variants [array get requested_variants] \
1046              options [array get options]]
1047            set el 1
1048        }
1049    }
1050
1051    return $el
1052}
1053
1054
1055proc add_multiple_ports { resname ports {remainder ""} } {
1056    upvar $resname reslist
1057   
1058    set version ""
1059    array unset variants
1060    array unset options
1061    parsePortSpec version variants options $remainder
1062   
1063    array unset overrides
1064    if {$version != ""} { set overrides(version) $version }
1065    if {[array size variants]} {
1066        # we always record the requested variants separately,
1067        # but requested ones always override existing ones
1068        set overrides(requested_variants) [array get variants]
1069        set overrides(variants) [array get variants]
1070    }
1071    if {[array size options]} { set overrides(options) [array get options] }
1072
1073    add_ports_to_portlist reslist $ports [array get overrides]
1074}
1075
1076
1077proc opUnion { a b } {
1078    set result {}
1079   
1080    array unset onetime
1081   
1082    # Walk through each array, adding to result only those items that haven't
1083    # been added before
1084    foreach item $a {
1085        array set port $item
1086        if {[info exists onetime($port(fullname))]} continue
1087        set onetime($port(fullname)) 1
1088        lappend result $item
1089    }
1090
1091    foreach item $b {
1092        array set port $item
1093        if {[info exists onetime($port(fullname))]} continue
1094        set onetime($port(fullname)) 1
1095        lappend result $item
1096    }
1097   
1098    return $result
1099}
1100
1101
1102proc opIntersection { a b } {
1103    set result {}
1104   
1105    # Rules we follow in performing the intersection of two port lists:
1106    #
1107    #   a/, a/          ==> a/
1108    #   a/, b/          ==>
1109    #   a/, a/1.0       ==> a/1.0
1110    #   a/1.0, a/       ==> a/1.0
1111    #   a/1.0, a/2.0    ==>
1112    #
1113    #   If there's an exact match, we take it.
1114    #   If there's a match between simple and descriminated, we take the later.
1115   
1116    # First create a list of the fully descriminated names in b
1117    array unset bfull
1118    set i 0
1119    foreach bitem $b {
1120        array set port $bitem
1121        set bfull($port(fullname)) $i
1122        incr i
1123    }
1124   
1125    # Walk through each item in a, matching against b
1126    foreach aitem $a {
1127        array set port $aitem
1128       
1129        # Quote the fullname and portname to avoid special characters messing up the regexp
1130        set safefullname [regex_pat_sanitize $port(fullname)]
1131       
1132        set simpleform [expr { "$port(name)/" == $port(fullname) }]
1133        if {$simpleform} {
1134            set pat "^${safefullname}"
1135        } else {
1136            set safename [regex_pat_sanitize $port(name)]
1137            set pat "^${safefullname}$|^${safename}/$"
1138        }
1139       
1140        set matches [array names bfull -regexp $pat]
1141        foreach match $matches {
1142            if {$simpleform} {
1143                set i $bfull($match)
1144                lappend result [lindex $b $i]
1145            } else {
1146                lappend result $aitem
1147            }
1148        }
1149    }
1150   
1151    return $result
1152}
1153
1154
1155proc opComplement { a b } {
1156    set result {}
1157   
1158    # Return all elements of a not matching elements in b
1159   
1160    # First create a list of the fully descriminated names in b
1161    array unset bfull
1162    set i 0
1163    foreach bitem $b {
1164        array set port $bitem
1165        set bfull($port(fullname)) $i
1166        incr i
1167    }
1168   
1169    # Walk through each item in a, taking all those items that don't match b
1170    #
1171    # Note: -regexp may not be present in all versions of Tcl we need to work
1172    #       against, in which case we may have to fall back to a slower alternative
1173    #       for those cases. I'm not worrying about that for now, however. -jdb
1174    foreach aitem $a {
1175        array set port $aitem
1176       
1177        # Quote the fullname and portname to avoid special characters messing up the regexp
1178        set safefullname [regex_pat_sanitize $port(fullname)]
1179       
1180        set simpleform [expr { "$port(name)/" == $port(fullname) }]
1181        if {$simpleform} {
1182            set pat "^${safefullname}"
1183        } else {
1184            set safename [regex_pat_sanitize $port(name)]
1185            set pat "^${safefullname}$|^${safename}/$"
1186        }
1187       
1188        set matches [array names bfull -regexp $pat]
1189
1190        # We copy this element to result only if it didn't match against b
1191        if {![llength $matches]} {
1192            lappend result $aitem
1193        }
1194    }
1195   
1196    return $result
1197}
1198
1199
1200proc parseFullPortSpec { urlname namename vername varname optname } {
1201    upvar $urlname porturl
1202    upvar $namename portname
1203    upvar $vername portversion
1204    upvar $varname portvariants
1205    upvar $optname portoptions
1206   
1207    set portname ""
1208    set portversion ""
1209    array unset portvariants
1210    array unset portoptions
1211   
1212    if { [moreargs] } {
1213        # Look first for a potential portname
1214        #
1215        # We need to allow a wide variaty of tokens here, because of actions like "provides"
1216        # so we take a rather lenient view of what a "portname" is. We allow
1217        # anything that doesn't look like either a version, a variant, or an option
1218        set token [lookahead]
1219
1220        set remainder ""
1221        if {![regexp {^(@|[-+]([[:alpha:]_]+[\w\.]*)|[[:alpha:]_]+[\w\.]*=)} $token match]} {
1222            advance
1223            regexp {^([^@]+)(@.*)?} $token match portname remainder
1224           
1225            # If the portname contains a /, then try to use it as a URL
1226            if {[string match "*/*" $portname]} {
1227                set url "file://$portname"
1228                set name [url_to_portname $url 1]
1229                if { $name != "" } {
1230                    # We mapped the url to valid port
1231                    set porturl $url
1232                    set portname $name
1233                    # Continue to parse rest of portspec....
1234                } else {
1235                    # We didn't map the url to a port; treat it
1236                    # as a raw string for something like port contents
1237                    # or cd
1238                    set porturl ""
1239                    # Since this isn't a port, we don't try to parse
1240                    # any remaining portspec....
1241                    return
1242                }
1243            }
1244        }
1245       
1246        # Now parse the rest of the spec
1247        parsePortSpec portversion portvariants portoptions $remainder
1248    }
1249}
1250
1251   
1252proc parsePortSpec { vername varname optname {remainder ""} } {
1253    upvar $vername portversion
1254    upvar $varname portvariants
1255    upvar $optname portoptions
1256   
1257    global global_options
1258   
1259    set portversion ""
1260    array unset portoptions
1261    array set portoptions [array get global_options]
1262    array unset portvariants
1263   
1264    # Parse port version/variants/options
1265    set opt $remainder
1266    set adv 0
1267    set consumed 0
1268    for {set firstTime 1} {$opt != "" || [moreargs]} {set firstTime 0} {
1269   
1270        # Refresh opt as needed
1271        if {$opt == ""} {
1272            if {$adv} advance
1273            set opt [lookahead]
1274            set adv 1
1275            set consumed 0
1276        }
1277       
1278        # Version must be first, if it's there at all
1279        if {$firstTime && [string match {@*} $opt]} {
1280            # Parse the version
1281           
1282            # Strip the @
1283            set opt [string range $opt 1 end]
1284           
1285            # Handle the version
1286            set sepPos [string first "/" $opt]
1287            if {$sepPos >= 0} {
1288                # Version terminated by "/" to disambiguate -variant from part of version
1289                set portversion [string range $opt 0 [expr $sepPos-1]]
1290                set opt [string range $opt [expr $sepPos+1] end]
1291            } else {
1292                # Version terminated by "+", or else is complete
1293                set sepPos [string first "+" $opt]
1294                if {$sepPos >= 0} {
1295                    # Version terminated by "+"
1296                    set portversion [string range $opt 0 [expr $sepPos-1]]
1297                    set opt [string range $opt $sepPos end]
1298                } else {
1299                    # Unterminated version
1300                    set portversion $opt
1301                    set opt ""
1302                }
1303            }
1304            set consumed 1
1305        } else {
1306            # Parse all other options
1307           
1308            # Look first for a variable setting: VARNAME=VALUE
1309            if {[regexp {^([[:alpha:]_]+[\w\.]*)=(.*)} $opt match key val] == 1} {
1310                # It's a variable setting
1311                set portoptions($key) "\"$val\""
1312                set opt ""
1313                set consumed 1
1314            } elseif {[regexp {^([-+])([[:alpha:]_]+[\w\.]*)} $opt match sign variant] == 1} {
1315                # It's a variant
1316                set portvariants($variant) $sign
1317                set opt [string range $opt [expr [string length $variant]+1] end]
1318                set consumed 1
1319            } else {
1320                # Not an option we recognize, so break from port option processing
1321                if { $consumed && $adv } advance
1322                break
1323            }
1324        }
1325    }
1326}
1327
1328
1329##########################################
1330# Action Handlers
1331##########################################
1332
1333proc action_get_usage { action } {
1334    global action_array cmd_opts_array
1335
1336    if {[info exists action_array($action)]} {
1337        set cmds ""
1338        if {[info exists cmd_opts_array($action)]} {
1339            foreach opt $cmd_opts_array($action) {
1340                if {[llength $opt] == 1} {
1341                    set name $opt
1342                    set optc 0
1343                } else {
1344                    set name [lindex $opt 0]
1345                    set optc [lindex $opt 1]
1346                }
1347
1348                append cmds " --$name"
1349
1350                for {set i 1} {$i <= $optc} {incr i} {
1351                    append cmds " <arg$i>"
1352                }
1353            }
1354        }
1355        set args ""
1356        set needed [action_needs_portlist $action]
1357        if {[ACTION_ARGS_STRINGS] == $needed} {
1358            set args " <arguments>"
1359        } elseif {[ACTION_ARGS_STRINGS] == $needed} {
1360            set args " <portlist>"
1361        }
1362
1363        set ret "Usage: "
1364        set len [string length $action]
1365        append ret [wrap "$action$cmds$args" 0 [string repeat " " [expr 8 + $len]] 0]
1366        append ret "\n"
1367
1368        return $ret
1369    }
1370
1371    return -1
1372}
1373
1374proc action_usage { action portlist opts } {
1375    if {[llength $portlist] == 0} {
1376        print_usage
1377        return 0
1378    }
1379
1380    foreach topic $portlist {
1381        set usage [action_get_usage $topic]
1382        if {$usage != -1} {
1383           puts -nonewline stderr $usage
1384        } else {
1385            ui_error "No usage for topic $topic"
1386            return 1
1387        }
1388    }
1389    return 0
1390}
1391
1392
1393proc action_help { action portlist opts } {
1394    set helpfile "$macports::prefix/var/macports/port-help.tcl"
1395
1396    if {[llength $portlist] == 0} {
1397        print_help
1398        return 0
1399    }
1400
1401    if {[file exists $helpfile]} {
1402        if {[catch {source $helpfile} err]} {
1403            puts stderr "Error reading helpfile $helpfile: $err"
1404            return 1
1405        }
1406    } else {
1407        puts stderr "Unable to open help file $helpfile"
1408        return 1
1409    }
1410
1411    foreach topic $portlist {
1412        if {![info exists porthelp($topic)]} {
1413            puts stderr "No help for topic $topic"
1414            return 1
1415        }
1416
1417        set usage [action_get_usage $topic]
1418        if {$usage != -1} {
1419           puts -nonewline stderr $usage
1420        } else {
1421            ui_error "No usage for topic $topic"
1422            return 1
1423        }
1424
1425        puts stderr $porthelp($topic)
1426    }
1427
1428    return 0
1429}
1430
1431
1432proc action_log { action portlist opts } {
1433    global global_options
1434    if {[require_portlist portlist]} {
1435        return 1
1436    }
1437    foreachport $portlist {
1438        # If we have a url, use that, since it's most specific
1439        # otherwise try to map the portname to a url
1440        if {$porturl eq ""} {
1441        # Verify the portname, getting portinfo to map to a porturl
1442            if {[catch {mportlookup $portname} result]} {
1443                ui_debug "$::errorInfo"
1444                break_softcontinue "lookup of portname $portname failed: $result" 1 status
1445            }
1446            if {[llength $result] < 2} {
1447                break_softcontinue "Port $portname not found" 1 status
1448            }
1449            array unset portinfo
1450            array set portinfo [lindex $result 1]
1451            set porturl $portinfo(porturl)
1452            set portdir $portinfo(portdir)
1453        } elseif {$porturl ne "file://."} {
1454            # Extract the portdir from porturl and use it to search PortIndex.
1455            # Only the last two elements of the path (porturl) make up the
1456            # portdir.
1457            set portdir [file split [macports::getportdir $porturl]]
1458            set lsize [llength $portdir]
1459            set portdir \
1460                [file join [lindex $portdir [expr $lsize - 2]] \
1461                           [lindex $portdir [expr $lsize - 1]]]
1462            if {[catch {mportsearch $portdir no exact portdir} result]} {
1463                ui_debug "$::errorInfo"
1464                break_softcontinue "Portdir $portdir not found" 1 status
1465            }
1466            if {[llength $result] < 2} {
1467                break_softcontinue "Portdir $portdir not found" 1 status
1468            }
1469            array unset portinfo
1470            array set portinfo [lindex $result 1]
1471        }
1472        set portpath [macports::getportdir $porturl]
1473        set logfile [file join [macports::getportlogpath $portpath] "main.log"]
1474        if {[file exists $logfile]} {
1475            if {[catch {set fp [open $logfile r]} result]} {
1476                break_softcontinue "Could not open file $logfile: $result" 1 status
1477            }
1478            set data [read $fp]
1479            set data [split $data "\n"]
1480
1481            if {[info exists global_options(ports_log_phase)]} {
1482                set stage $global_options(ports_log_phase);
1483            } else {
1484                set stage "\[a-z\]*"
1485            }
1486
1487            if {[info exists global_options(ports_log_verbosity)]} {
1488                set prefix $global_options(ports_log_verbosity);
1489            } else {
1490                set prefix "\[a-z\]*"
1491            }
1492            set match ""
1493            foreach line $data {
1494                set exp "^:($prefix|any):($stage|any) (.*)$"
1495                if {[regexp $exp $line -> priority phase msg] == 1} {
1496                    puts "[macports::ui_prefix_default $priority]$msg"
1497                }
1498            }
1499
1500            close $fp
1501        } else {
1502            ui_msg "Log file for port $portname not found"
1503        }
1504    }
1505    return 0
1506}
1507
1508
1509proc action_info { action portlist opts } {
1510    global global_variations
1511    set status 0
1512    if {[require_portlist portlist]} {
1513        return 1
1514    }
1515
1516    set separator ""
1517    foreachport $portlist {
1518        puts -nonewline $separator
1519        # If we have a url, use that, since it's most specific
1520        # otherwise try to map the portname to a url
1521        if {$porturl eq ""} {
1522        # Verify the portname, getting portinfo to map to a porturl
1523            if {[catch {mportlookup $portname} result]} {
1524                ui_debug "$::errorInfo"
1525                break_softcontinue "lookup of portname $portname failed: $result" 1 status
1526            }
1527            if {[llength $result] < 2} {
1528                break_softcontinue "Port $portname not found" 1 status
1529            }
1530            array unset portinfo
1531            array set portinfo [lindex $result 1]
1532            set porturl $portinfo(porturl)
1533            set portdir $portinfo(portdir)
1534        } elseif {$porturl ne "file://."} {
1535            # Extract the portdir from porturl and use it to search PortIndex.
1536            # Only the last two elements of the path (porturl) make up the
1537            # portdir.
1538            set portdir [file split [macports::getportdir $porturl]]
1539            set lsize [llength $portdir]
1540            set portdir \
1541                [file join [lindex $portdir [expr $lsize - 2]] \
1542                           [lindex $portdir [expr $lsize - 1]]]
1543            if {[catch {mportsearch $portdir no exact portdir} result]} {
1544                ui_debug "$::errorInfo"
1545                break_softcontinue "Portdir $portdir not found" 1 status
1546            }
1547            if {[llength $result] < 2} {
1548                break_softcontinue "Portdir $portdir not found" 1 status
1549            }
1550            array unset portinfo
1551            array set portinfo [lindex $result 1]
1552        }
1553
1554        if {!([info exists options(ports_info_index)] && $options(ports_info_index) eq "yes")} {
1555            # Add any global_variations to the variations
1556            # specified for the port (so we get e.g. dependencies right)
1557            array unset merged_variations
1558            array set merged_variations [array get variations]
1559            foreach { variation value } [array get global_variations] { 
1560                if { ![info exists merged_variations($variation)] } { 
1561                    set merged_variations($variation) $value 
1562                } 
1563            }
1564 
1565            if {[catch {set mport [mportopen $porturl [array get options] [array get merged_variations]]} result]} {
1566                ui_debug "$::errorInfo"
1567                break_softcontinue "Unable to open port: $result" 1 status
1568            }
1569            array unset portinfo
1570            array set portinfo [mportinfo $mport]
1571            mportclose $mport
1572            if {[info exists portdir]} {
1573                set portinfo(portdir) $portdir
1574            }
1575        } elseif {![info exists portinfo]} {
1576            ui_warn "port info --index does not work with 'current' pseudo-port"
1577            continue
1578        }
1579        array unset options ports_info_index
1580
1581        # Understand which info items are actually lists
1582        # (this could be overloaded to provide a generic formatting code to
1583        # allow us to, say, split off the prefix on libs)
1584        array set list_map "
1585            categories      1
1586            depends_fetch   1
1587            depends_extract 1
1588            depends_build   1
1589            depends_lib     1
1590            depends_run     1
1591            maintainers     1
1592            platforms       1
1593            variants        1
1594            conflicts       1
1595        "
1596
1597        # Label map for pretty printing
1598        array set pretty_label {
1599            heading     ""
1600            variants    Variants
1601            depends_fetch "Fetch Dependencies"
1602            depends_extract "Extract Dependencies"
1603            depends_build "Build Dependencies"
1604            depends_run "Runtime Dependencies"
1605            depends_lib "Library Dependencies"
1606            description "Brief Description"
1607            long_description "Description"
1608            fullname    "Full Name: "
1609            homepage    Homepage
1610            platforms   Platforms
1611            maintainers Maintainers
1612            license     License
1613            conflicts   "Conflicts with"
1614            replaced_by "Replaced by"
1615        }
1616
1617        # Wrap-length map for pretty printing
1618        array set pretty_wrap {
1619            heading 0
1620            replaced_by 22
1621            variants 22
1622            depends_fetch 22
1623            depends_extract 22
1624            depends_build 22
1625            depends_run 22
1626            depends_lib 22
1627            description 22
1628            long_description 22
1629            homepage 22
1630            platforms 22
1631            license 22
1632            conflicts 22
1633            maintainers 22
1634        }
1635
1636        # Interpret a convenient field abbreviation
1637        if {[info exists options(ports_info_depends)] && $options(ports_info_depends) == "yes"} {
1638            array unset options ports_info_depends
1639            set options(ports_info_depends_fetch) yes
1640            set options(ports_info_depends_extract) yes
1641            set options(ports_info_depends_build) yes
1642            set options(ports_info_depends_lib) yes
1643            set options(ports_info_depends_run) yes
1644        }
1645               
1646        # Set up our field separators
1647        set show_label 1
1648        set field_sep "\n"
1649        set subfield_sep ", "
1650        set pretty_print 0
1651       
1652        # For human-readable summary, which is the default with no options
1653        if {![array size options]} {
1654            set pretty_print 1
1655        } elseif {[info exists options(ports_info_pretty)]} {
1656            set pretty_print 1
1657            array unset options ports_info_pretty
1658        }
1659
1660        # Tune for sort(1)
1661        if {[info exists options(ports_info_line)]} {
1662            array unset options ports_info_line
1663            set show_label 0
1664            set field_sep "\t"
1665            set subfield_sep ","
1666        }
1667       
1668        # Figure out whether to show field name
1669        set quiet [macports::ui_isset ports_quiet]
1670        if {$quiet} {
1671            set show_label 0
1672        }
1673        # In pretty-print mode we also suppress messages, even though we show
1674        # most of the labels:
1675        if {$pretty_print} {
1676            set quiet 1
1677        }
1678
1679        # Spin through action options, emitting information for any found
1680        set fields {}
1681        set opts_todo [array names options ports_info_*]
1682        set fields_tried {}
1683        if {![llength $opts_todo]} {
1684            set opts_todo {ports_info_heading
1685                ports_info_replaced_by
1686                ports_info_variants 
1687                ports_info_skip_line
1688                ports_info_long_description ports_info_homepage
1689                ports_info_skip_line ports_info_depends_fetch
1690                ports_info_depends_extract ports_info_depends_build
1691                ports_info_depends_lib ports_info_depends_run
1692                ports_info_conflicts
1693                ports_info_platforms ports_info_license
1694                ports_info_maintainers
1695            }
1696        }
1697        foreach { option } $opts_todo {
1698            set opt [string range $option 11 end]
1699            # Artificial field name for formatting
1700            if {$pretty_print && $opt eq "skip_line"} {
1701                lappend fields ""
1702                continue
1703            }
1704            # Artificial field names to reproduce prettyprinted summary
1705            if {$opt eq "heading"} {
1706                set inf "$portinfo(name) @$portinfo(version)"
1707                set ropt "heading"
1708                if {[info exists portinfo(revision)] && $portinfo(revision) > 0} {
1709                    append inf ", Revision $portinfo(revision)"
1710                }
1711                if {[info exists portinfo(categories)]} {
1712                    append inf " ([join $portinfo(categories) ", "])"
1713                }
1714            } elseif {$opt eq "fullname"} {
1715                set inf "$portinfo(name) @"
1716                append inf [composite_version $portinfo(version) $portinfo(active_variants)]
1717                set ropt "fullname"
1718            } else {
1719                # Map from friendly name
1720                set ropt [map_friendly_field_names $opt]
1721               
1722                # If there's no such info, move on
1723                if {![info exists portinfo($ropt)]} {
1724                    set inf ""
1725                } else {
1726                    set inf [join $portinfo($ropt)]
1727                }
1728            }
1729
1730            # Calculate field label
1731            set label ""
1732            if {$pretty_print} {
1733                if {[info exists pretty_label($ropt)]} {
1734                    set label $pretty_label($ropt)
1735                } else {
1736                    set label $opt
1737                }
1738            } elseif {$show_label} {
1739                set label "$opt: "
1740            }
1741           
1742            # Format the data
1743            if { $ropt eq "maintainers" } {
1744                set inf [unobscure_maintainers $inf]
1745            }
1746            #     ... special formatting for certain fields when prettyprinting
1747            if {$pretty_print} {
1748                if {$ropt eq "variants"} {
1749                    # Use the new format for variants iff it exists in
1750                    # PortInfo. This key currently does not exist outside of
1751                    # trunk (1.8.0).
1752                    array unset vinfo
1753                    if {[info exists portinfo(vinfo)]} {
1754                        array set vinfo $portinfo(vinfo)
1755                    }
1756
1757                    set pi_vars $inf
1758                    set inf {}
1759                    foreach v [lsort $pi_vars] {
1760                        set varmodifier ""
1761                        if {[info exists variations($v)]} {
1762                            # selected by command line, prefixed with +/-
1763                            set varmodifier $variations($v)
1764                        } elseif {[info exists global_variations($v)]} {
1765                            # selected by variants.conf, prefixed with (+)/(-)
1766                            set varmodifier "($global_variations($v))"
1767                            # Retrieve additional information from the new key.
1768                        } elseif {[info exists vinfo]} {
1769                            array unset variant
1770                            array set variant $vinfo($v)
1771                            if {[info exists variant(is_default)]} {
1772                                set varmodifier "\[+]"
1773                            }
1774                        }
1775                        lappend inf "$varmodifier$v"
1776                    }
1777                } elseif {[string match "depend*" $ropt] 
1778                          && ![macports::ui_isset ports_verbose]} {
1779                    set pi_deps $inf
1780                    set inf {}
1781                    foreach d $pi_deps {
1782                        lappend inf [lindex [split $d :] end]
1783                    }
1784                }
1785            } 
1786            #End of special pretty-print formatting for certain fields
1787            if [info exists list_map($ropt)] {
1788                set field [join $inf $subfield_sep]
1789            } else {
1790                set field $inf
1791            }
1792           
1793            # Assemble the entry
1794            if {$pretty_print} {
1795                # The two special fields are considered headings and are
1796                # emitted immediately, rather than waiting. Also they are not
1797                # recorded on the list of fields tried
1798                if {$ropt eq "heading" || $ropt eq "fullname"} {
1799                    puts "$label$field"
1800                    continue
1801                }
1802            }
1803            lappend fields_tried $label
1804            if {$pretty_print} {
1805                if {![string length $field]} {
1806                    continue
1807                }
1808                if {![string length $label]} {
1809                    set wrap_len 0
1810                    if {[info exists pretty_wrap($ropt)]} {
1811                        set wrap_len $pretty_wrap($ropt)
1812                    }
1813                    lappend fields [wrap $field 0 [string repeat " " $wrap_len]]
1814                } else {
1815                    set wrap_len [string length $label]
1816                    if {[info exists pretty_wrap($ropt)]} {
1817                        set wrap_len $pretty_wrap($ropt)
1818                    }
1819                    lappend fields [wraplabel $label $field 0 [string repeat " " $wrap_len]]
1820                }
1821
1822            } else { # Not pretty print
1823                lappend fields "$label$field"
1824            }
1825        }
1826
1827        # Now output all that information:
1828        if {[llength $fields]} {
1829            puts [join $fields $field_sep]
1830        } else {
1831            if {$pretty_print && [llength $fields_tried]} {
1832                puts -nonewline "$portinfo(name) has no "
1833                puts [join $fields_tried ", "]
1834            }
1835        }
1836        set separator "--\n"
1837    }
1838   
1839    return $status
1840}
1841
1842
1843proc action_location { action portlist opts } {
1844    set status 0
1845    if {[require_portlist portlist]} {
1846        return 1
1847    }
1848    foreachport $portlist {
1849        if { [catch {set ilist [registry_installed $portname [composite_version $portversion [array get variations]]]} result] } {
1850            global errorInfo
1851            ui_debug "$errorInfo"
1852            break_softcontinue "port location failed: $result" 1 status
1853        } else {
1854            # set portname again since the one we were passed may not have had the correct case
1855            set portname [lindex $ilist 0]
1856            set version [lindex $ilist 1]
1857            set revision [lindex $ilist 2]
1858            set variants [lindex $ilist 3]
1859            set epoch [lindex $ilist 5]
1860        }
1861
1862        set ref [registry::open_entry $portname $version $revision $variants $epoch]
1863        if { [string equal [registry::property_retrieve $ref installtype] "image"] } {
1864            set imagedir [registry::property_retrieve $ref imagedir]
1865            if {![macports::ui_isset ports_quiet]} {
1866                puts "Port $portname ${version}_${revision}${variants} is installed as an image in:"
1867            }
1868            puts $imagedir
1869        } else {
1870            break_softcontinue "Port $portname is not installed as an image." 1 status
1871        }
1872    }
1873   
1874    return $status
1875}
1876
1877
1878proc action_notes { action portlist opts } {
1879    if {[require_portlist portlist]} {
1880        return 1
1881    }
1882
1883    set status 0
1884    foreachport $portlist {
1885        if {$porturl eq ""} {
1886            # Look up the port.
1887            if {[catch {mportlookup $portname} result]} {
1888                ui_debug $::errorInfo
1889                break_softcontinue "The lookup of '$portname' failed: $result" \
1890                                1 status
1891            }
1892            if {[llength $result] < 2} {
1893                break_softcontinue "The port '$portname' was not found" 1 status
1894            }
1895
1896            # Retrieve the port's URL.
1897            array unset portinfo
1898            array set portinfo [lindex $result 1]
1899            set porturl $portinfo(porturl)
1900        }
1901       
1902        # Add any global_variations to the variations
1903        # specified for the port
1904        array unset merged_variations
1905        array set merged_variations [array get variations]
1906        foreach { variation value } [array get global_variations] { 
1907            if { ![info exists merged_variations($variation)] } { 
1908                set merged_variations($variation) $value 
1909            } 
1910        }
1911
1912        # Open the Portfile associated with this port.
1913        if {[catch {set mport [mportopen $porturl [array get options] \
1914                                         [array get merged_variations]]} \
1915                   result]} {
1916            ui_debug $::errorInfo
1917            break_softcontinue [concat "The URL '$porturl' could not be" \
1918                                       "opened: $result"] 1 status
1919        }
1920        array unset portinfo
1921        array set portinfo [mportinfo $mport]
1922        mportclose $mport
1923
1924        # Return the notes associated with this Portfile.
1925        if {[info exists portinfo(notes)]} {
1926            set portnotes $portinfo(notes)
1927        } else {
1928            set portnotes {}
1929        }
1930
1931        # Retrieve the port's name once more to ensure it has the proper case.
1932        set portname $portinfo(name)
1933
1934        # Display the notes.
1935        if {![macports::ui_isset ports_quiet]} {
1936            if {$portnotes ne {}} {
1937                puts "$portname has the following notes:"
1938                puts [wrap $portnotes 0 "  " 1]
1939            } else {
1940                puts "$portname has no notes."
1941            }
1942        }
1943    }
1944    return $status
1945}
1946
1947
1948proc action_provides { action portlist opts } {
1949    # In this case, portname is going to be used for the filename... since
1950    # that is the first argument we expect... perhaps there is a better way
1951    # to do this?
1952    if { ![llength $portlist] } {
1953        ui_error "Please specify a filename to check which port provides that file."
1954        return 1
1955    }
1956    foreach filename $portlist {
1957        set file [file normalize $filename]
1958        if {[file exists $file]} {
1959            if {![file isdirectory $file] || [file type $file] == "link"} {
1960                set port [registry::file_registered $file]
1961                if { $port != 0 } {
1962                    puts "$file is provided by: $port"
1963                } else {
1964                    puts "$file is not provided by a MacPorts port."
1965                }
1966            } else {
1967                puts "$file is a directory."
1968            }
1969        } else {
1970            puts "$file does not exist."
1971        }
1972    }
1973    registry::close_file_map
1974   
1975    return 0
1976}
1977
1978
1979proc action_activate { action portlist opts } {
1980    global macports::registry.format
1981    set status 0
1982    if {[require_portlist portlist]} {
1983        return 1
1984    }
1985    foreachport $portlist {
1986        set composite_version [composite_version $portversion [array get variations]]
1987        if {${macports::registry.format} == "receipt_sqlite" && ![catch {set ilist [registry::installed $portname $composite_version]}] && [llength $ilist] == 1} {
1988            set i [lindex $ilist 0]
1989            set iversion [lindex $i 1]
1990            set irevision [lindex $i 2]
1991            set ivariants [lindex $i 3]
1992            if {![catch {set mport [mportopen_installed $portname $iversion $irevision $ivariants [array get options]]}]} {
1993                if {[catch {set result [mportexec $mport activate]} result]} {
1994                    global errorInfo
1995                    mportclose_installed $mport
1996                    ui_debug "$errorInfo"
1997                    break_softcontinue "Unable to execute port: $result" 1 status
1998                }
1999                mportclose_installed $mport
2000                continue
2001            } else {
2002                ui_warn "Could not open Portfile from registry for $portname $composite_version"
2003            }
2004        }
2005        if {![macports::global_option_isset ports_dryrun]} {
2006            if { [catch {portimage::activate $portname $composite_version [array get options]} result] } {
2007                global errorInfo
2008                ui_debug "$errorInfo"
2009                break_softcontinue "port activate failed: $result" 1 status
2010            }
2011        } else {
2012            ui_msg "Skipping activate $portname (dry run)"
2013        }
2014    }
2015   
2016    return $status
2017}
2018
2019
2020proc action_deactivate { action portlist opts } {
2021    global macports::registry.format
2022    set status 0
2023    if {[require_portlist portlist]} {
2024        return 1
2025    }
2026    foreachport $portlist {
2027        set composite_version [composite_version $portversion [array get variations]]
2028        if {${macports::registry.format} == "receipt_sqlite" && ![catch {set ilist [registry::active $portname]}]} {
2029            set i [lindex $ilist 0]
2030            set iversion [lindex $i 1]
2031            set irevision [lindex $i 2]
2032            set ivariants [lindex $i 3]
2033            if {$composite_version == "" || $composite_version == "${iversion}_${irevision}${ivariants}"} {
2034                if {![catch {set mport [mportopen_installed $portname $iversion $irevision $ivariants [array get options]]}]} {
2035                    if {[catch {set result [mportexec $mport deactivate]} result]} {
2036                        global errorInfo
2037                        mportclose_installed $mport
2038                        ui_debug "$errorInfo"
2039                        break_softcontinue "Unable to execute port: $result" 1 status
2040                    }
2041                    mportclose_installed $mport
2042                    continue
2043                } else {
2044                    global errorInfo
2045                    ui_debug "$errorInfo"
2046                    ui_warn "Could not open Portfile from registry for $portname $composite_version"
2047                }
2048            }
2049        }
2050        if {![macports::global_option_isset ports_dryrun]} {
2051            if { [catch {portimage::deactivate $portname $composite_version [array get options]} result] } {
2052                global errorInfo
2053                ui_debug "$errorInfo"
2054                break_softcontinue "port deactivate failed: $result" 1 status
2055            }
2056        } else {
2057            ui_msg "Skipping deactivate $portname (dry run)"
2058        }
2059    }
2060   
2061    return $status
2062}
2063
2064
2065proc action_select { action portlist opts } {
2066    ui_debug "action_select \[$portlist] \[$opts]..."
2067
2068    # Error out if no group is specified.
2069    if {[llength $portlist] < 1} {
2070        ui_error "port select \[--list|--set|--show] <group> \[<version>]"
2071        return 1
2072    }
2073    set group [lindex $portlist 0]
2074
2075    set commands [array names [array set {} $opts]]
2076    # If no command (--set, --show, --list) is specified *but* more than one
2077    # argument is specified, default to the set command.
2078    if {[llength $commands] < 1 && [llength $portlist] > 1} {
2079        set command set
2080        ui_debug [concat "Although no command was specified, more than " \
2081                         "one argument was specified.  Defaulting to the " \
2082                         "'set' command..."]
2083    # If no command (--set, --show, --list) is specified *and* less than two
2084    # argument are specified, default to the show command.
2085    } elseif {[llength $commands] < 1} {
2086        set command show
2087        ui_debug [concat "No command was specified. Defaulting to the " \
2088                         "'show' command..."]
2089    # Only allow one command to be specified at a time.
2090    } elseif {[llength $commands] > 1} {
2091        ui_error [concat "Multiple commands were specified. Only one " \
2092                         "command may be specified at a time."]
2093        return 1
2094    } else {
2095        set command [string map {ports_select_ ""} [lindex $commands 0]]
2096        ui_debug "The '$command' command was specified."
2097    }
2098
2099    switch -- $command {
2100        list {
2101            if {[llength $portlist] > 1} {
2102                ui_warn [concat "The 'list' command does not expect any " \
2103                                "arguments. Extra arguments will be ignored."]
2104            }
2105
2106            # On error mportselect returns with the code 'error'.
2107            if {[catch {mportselect $command $group} versions]} {
2108                ui_error "The 'list' command failed: $versions"
2109                return 1
2110            }
2111
2112            puts "Available Versions:"
2113            foreach v $versions {
2114                puts "\t$v"
2115            }
2116            return 0
2117        }
2118        set {
2119            if {[llength $portlist] < 2} {
2120                ui_error [concat "The 'set' command expects two " \
2121                                 "arguments: <group>, <version>"]
2122                return 1
2123            } elseif {[llength $portlist] > 2} {
2124                ui_warn [concat "The 'set' command only expects two " \
2125                                "arguments. Extra arguments will be " \
2126                                "ignored."]
2127            }
2128            set version [lindex $portlist 1]
2129
2130            puts -nonewline "Selecting '$version' for '$group' "
2131            if {[catch {mportselect $command $group $version} result]} {
2132                puts "failed: $result"
2133                return 1
2134            }
2135            puts "succeeded. '$version' is now active."
2136            return 0
2137        }
2138        show {
2139            if {[llength $portlist] > 1} {
2140                ui_warn [concat "The 'show' command does not expect any " \
2141                                "arguments. Extra arguments will be ignored."]
2142            }
2143
2144            if {[catch {mportselect $command $group} selected_version]} {
2145                ui_error "The 'show' command failed: $selected_version"
2146                return 1
2147            }
2148            puts [concat "The currently selected version for '$group' is " \
2149                         "'$selected_version'."]
2150            return 0
2151        }
2152        default {
2153            ui_error "An unknown command '$command' was specified."
2154            return 1
2155        }
2156    }
2157}
2158
2159
2160proc action_selfupdate { action portlist opts } {
2161    global global_options
2162    if { [catch {macports::selfupdate [array get global_options] base_updated} result ] } {
2163        global errorInfo
2164        ui_debug "$errorInfo"
2165        fatal "port selfupdate failed: $result"
2166    }
2167   
2168    if {$base_updated} {
2169        # exit immediately if in batch/interactive mode
2170        return -999
2171    } else {
2172        return 0
2173    }
2174}
2175
2176
2177proc action_upgrade { action portlist opts } {
2178    if {[require_portlist portlist]} {
2179        return 1
2180    }
2181    # shared depscache for all ports in the list
2182    array set depscache {}
2183    set status 0
2184    foreachport $portlist {
2185        if {![info exists depscache(port:$portname)]} {
2186            set status [macports::upgrade $portname "port:$portname" [array get requested_variations] [array get options] depscache]
2187            if {$status != 0 && ![macports::ui_isset ports_processall]} {
2188                break
2189            }
2190        }
2191    }
2192   
2193    if {$status != 0} {
2194        print_tickets_url
2195    }
2196
2197    return $status
2198}
2199
2200
2201proc action_version { action portlist opts } {
2202    puts "Version: [macports::version]"
2203    return 0
2204}
2205
2206
2207proc action_platform { action portlist opts } {
2208#   global os.platform os.major os.arch
2209    global tcl_platform
2210    set os_platform [string tolower $tcl_platform(os)]
2211    set os_version $tcl_platform(osVersion)
2212    set os_arch $tcl_platform(machine)
2213    if {$os_arch == "Power Macintosh"} { set os_arch "powerpc" }
2214    if {$os_arch == "i586" || $os_arch == "i686"} { set os_arch "i386" }
2215    set os_major [lindex [split $tcl_platform(osVersion) .] 0]
2216#   puts "Platform: ${os.platform} ${os.major} ${os.arch}"
2217    puts "Platform: ${os_platform} ${os_major} ${os_arch}"
2218    return 0
2219}
2220
2221
2222proc action_dependents { action portlist opts } {
2223    if {[require_portlist portlist]} {
2224        return 1
2225    }
2226    set ilist {}
2227
2228    registry::open_dep_map
2229
2230    set status 0
2231    foreachport $portlist {
2232        set composite_version [composite_version $portversion [array get variations]]
2233        if { [catch {set ilist [registry::installed $portname $composite_version]} result] } {
2234            global errorInfo
2235            ui_debug "$errorInfo"
2236            break_softcontinue "$result" 1 status
2237        } else {
2238            # choose the active version if there is one
2239            set index 0
2240            foreach i $ilist {
2241                if {[lindex $i 4]} {
2242                    set found 1
2243                    break
2244                }
2245                incr index
2246            }
2247            if {![info exists found]} {
2248                set index 0
2249            }
2250            # set portname again since the one we were passed may not have had the correct case
2251            set portname [lindex [lindex $ilist $index] 0]
2252            set iversion [lindex [lindex $ilist $index] 1]
2253            set irevision [lindex [lindex $ilist $index] 2]
2254            set ivariants [lindex [lindex $ilist $index] 3]
2255        }
2256       
2257        set deplist [registry::list_dependents $portname $iversion $irevision $ivariants]
2258        if { [llength $deplist] > 0 } {
2259            set dl [list]
2260            # Check the deps first
2261            foreach dep $deplist {
2262                set depport [lindex $dep 2]
2263                if {![macports::ui_isset ports_verbose]} {
2264                    ui_msg "$depport depends on $portname"
2265                } else {
2266                    ui_msg "$depport depends on $portname (by [lindex $dep 1]:)"
2267                }
2268            }
2269        } else {
2270            ui_msg "$portname has no dependents!"
2271        }
2272    }
2273    return $status
2274}
2275
2276
2277proc action_uninstall { action portlist opts } {
2278    global macports::registry.format
2279    set status 0
2280    if {[macports::global_option_isset port_uninstall_old]} {
2281        # if -u then uninstall all inactive ports
2282        # (union these to any other ports user has in the port list)
2283        set portlist [opUnion $portlist [get_inactive_ports]]
2284    } else {
2285        # Otherwise the user hopefully supplied a portlist, or we'll default to the existing directory
2286        if {[require_portlist portlist]} {
2287            return 1
2288        }
2289    }
2290
2291    foreachport $portlist {
2292        if {![registry::entry_exists_for_name $portname]} {
2293            ui_info "$portname is already uninstalled"
2294            continue
2295        }
2296        set composite_version [composite_version $portversion [array get variations]]
2297        if {${macports::registry.format} == "receipt_sqlite" && ![catch {set ilist [registry::installed $portname $composite_version]}] && [llength $ilist] == 1} {
2298            set i [lindex $ilist 0]
2299            set iversion [lindex $i 1]
2300            set irevision [lindex $i 2]
2301            set ivariants [lindex $i 3]
2302            if {![catch {set mport [mportopen_installed $portname $iversion $irevision $ivariants [array get options]]}]} {
2303                if {[catch {set result [mportexec $mport uninstall]} result]} {
2304                    global errorInfo
2305                    mportclose_installed $mport
2306                    ui_debug "$errorInfo"
2307                    break_softcontinue "Unable to execute port: $result" 1 status
2308                }
2309                mportclose_installed $mport
2310                continue
2311            } else {
2312                ui_warn "Could not open Portfile from registry for $portname $composite_version"
2313            }
2314        }
2315
2316        if { [catch {registry_uninstall::uninstall $portname $composite_version [array get options]} result] } {
2317            global errorInfo
2318            ui_debug "$errorInfo"
2319            break_softcontinue "port uninstall failed: $result" 1 status
2320        }
2321    }
2322
2323    return $status
2324}
2325
2326
2327proc action_installed { action portlist opts } {
2328    global private_options
2329    set status 0
2330    set restrictedList 0
2331    set ilist {}
2332   
2333    if { [llength $portlist] || (![info exists private_options(ports_no_args)] || $private_options(ports_no_args) == "no")} {
2334        set restrictedList 1
2335        foreachport $portlist {
2336            set composite_version [composite_version $portversion [array get variations]]
2337            if { [catch {set ilist [concat $ilist [registry::installed $portname $composite_version]]} result] } {
2338                if {![string match "* not registered as installed." $result]} {
2339                    global errorInfo
2340                    ui_debug "$errorInfo"
2341                    break_softcontinue "port installed failed: $result" 1 status
2342                }
2343            }
2344        }
2345    } else {
2346        if { [catch {set ilist [registry::installed]} result] } {
2347            if {$result != "Registry error: No ports registered as installed."} {
2348                global errorInfo
2349                ui_debug "$errorInfo"
2350                ui_error "port installed failed: $result"
2351                set status 1
2352            }
2353        }
2354    }
2355    if { [llength $ilist] > 0 } {
2356        if {![macports::ui_isset ports_quiet]} {
2357            puts "The following ports are currently installed:"
2358        }
2359        foreach i [portlist_sortint $ilist] {
2360            set iname [lindex $i 0]
2361            set iversion [lindex $i 1]
2362            set irevision [lindex $i 2]
2363            set ivariants [lindex $i 3]
2364            set iactive [lindex $i 4]
2365            if { $iactive == 0 } {
2366                puts "  $iname @${iversion}_${irevision}${ivariants}"
2367            } elseif { $iactive == 1 } {
2368                puts "  $iname @${iversion}_${irevision}${ivariants} (active)"
2369            }
2370        }
2371    } elseif { $restrictedList } {
2372        if {![macports::ui_isset ports_quiet]} {
2373            puts "None of the specified ports are installed."
2374        }
2375    } else {
2376        if {![macports::ui_isset ports_quiet]} {
2377            puts "No ports are installed."
2378        }
2379    }
2380
2381    return $status
2382}
2383
2384
2385proc action_outdated { action portlist opts } {
2386    global macports::registry.installtype private_options
2387    set is_image_mode [expr 0 == [string compare "image" ${macports::registry.installtype}]]
2388
2389    set status 0
2390
2391    # If port names were supplied, limit ourselves to those ports, else check all installed ports
2392    set ilist {}
2393    set restrictedList 0
2394    if { [llength $portlist] || (![info exists private_options(ports_no_args)] || $private_options(ports_no_args) == "no")} {
2395        set restrictedList 1
2396        foreach portspec $portlist {
2397            array set port $portspec
2398            set portname $port(name)
2399            set composite_version [composite_version $port(version) $port(variants)]
2400            if { [catch {set ilist [concat $ilist [registry::installed $portname $composite_version]]} result] } {
2401                if {![string match "* not registered as installed." $result]} {
2402                    global errorInfo
2403                    ui_debug "$errorInfo"
2404                    break_softcontinue "port outdated failed: $result" 1 status
2405                }
2406            }
2407        }
2408    } else {
2409        if { [catch {set ilist [registry::installed]} result] } {
2410            if {$result != "Registry error: No ports registered as installed."} {
2411                global errorInfo
2412                ui_debug "$errorInfo"
2413                ui_error "port installed failed: $result"
2414                set status 1
2415            }
2416        }
2417    }
2418
2419    set num_outdated 0
2420    if { [llength $ilist] > 0 } {   
2421        foreach i $ilist { 
2422       
2423            # Get information about the installed port
2424            set portname [lindex $i 0]
2425            set installed_version [lindex $i 1]
2426            set installed_revision [lindex $i 2]
2427            set installed_compound "${installed_version}_${installed_revision}"
2428
2429            set is_active [lindex $i 4]
2430            if { $is_active == 0 && $is_image_mode } {
2431                continue
2432            }
2433            set installed_epoch [lindex $i 5]
2434
2435            # Get info about the port from the index
2436            if {[catch {set res [mportlookup $portname]} result]} {
2437                global errorInfo
2438                ui_debug "$errorInfo"
2439                break_softcontinue "search for portname $portname failed: $result" 1 status
2440            }
2441            if {[llength $res] < 2} {
2442                if {[macports::ui_isset ports_debug]} {
2443                    puts "$portname ($installed_compound is installed; the port was not found in the port index)"
2444                }
2445                continue
2446            }
2447            array unset portinfo
2448            array set portinfo [lindex $res 1]
2449           
2450            # Get information about latest available version and revision
2451            if {![info exists portinfo(version)]} {
2452                ui_warn "$portname has no version field"
2453                continue
2454            }
2455            set latest_version $portinfo(version)
2456            set latest_revision 0
2457            if {[info exists portinfo(revision)] && $portinfo(revision) > 0} { 
2458                set latest_revision $portinfo(revision)
2459            }
2460            set latest_compound "${latest_version}_${latest_revision}"
2461            set latest_epoch 0
2462            if {[info exists portinfo(epoch)]} { 
2463                set latest_epoch $portinfo(epoch)
2464            }
2465           
2466            # Compare versions, first checking epoch, then version, then revision
2467            set comp_result [expr $installed_epoch - $latest_epoch]
2468            if { $comp_result == 0 } {
2469                set comp_result [rpm-vercomp $installed_version $latest_version]
2470                if { $comp_result == 0 } {
2471                    set comp_result [rpm-vercomp $installed_revision $latest_revision]
2472                }
2473            }
2474           
2475            # Report outdated (or, for verbose, predated) versions
2476            if { $comp_result != 0 } {
2477                           
2478                # Form a relation between the versions
2479                set flag ""
2480                if { $comp_result > 0 } {
2481                    set relation ">"
2482                    set flag "!"
2483                } else {
2484                    set relation "<"
2485                }
2486               
2487                # Emit information
2488                if {$comp_result < 0 || [macports::ui_isset ports_verbose]} {
2489               
2490                    if { $num_outdated == 0 && ![macports::ui_isset ports_quiet]} {
2491                        puts "The following installed ports are outdated:"
2492                    }
2493                    incr num_outdated
2494
2495                    puts [format "%-30s %-24s %1s" $portname "$installed_compound $relation $latest_compound" $flag]
2496                }
2497               
2498            }
2499        }
2500       
2501        if { $num_outdated == 0 && ![macports::ui_isset ports_quiet]} {
2502            puts "No installed ports are outdated."
2503        }
2504    } elseif { $restrictedList } {
2505        if {![macports::ui_isset ports_quiet]} {
2506            puts "None of the specified ports are outdated."
2507        }
2508    } else {
2509        if {![macports::ui_isset ports_quiet]} {
2510            puts "No ports are installed."
2511        }
2512    }
2513   
2514    return $status
2515}
2516
2517
2518proc action_contents { action portlist opts } {
2519    set status 0
2520    if {[require_portlist portlist]} {
2521        return 1
2522    }
2523    foreachport $portlist {
2524        if { ![catch {set ilist [registry::installed $portname]} result] } {
2525            # set portname again since the one we were passed may not have had the correct case
2526            set portname [lindex [lindex $ilist 0] 0]
2527        }
2528        set files [registry::port_registered $portname]
2529        if { $files != 0 } {
2530            if { [llength $files] > 0 } {
2531                if {![macports::ui_isset ports_quiet]} {
2532                    puts "Port $portname contains:"
2533                }
2534                foreach file $files {
2535                    puts "  $file"
2536                }
2537            } else {
2538                if {![macports::ui_isset ports_quiet]} {
2539                    puts "Port $portname does not contain any files or is not active."
2540                }
2541            }
2542        } else {
2543            if {![macports::ui_isset ports_quiet]} {
2544                puts "Port $portname is not installed."
2545            }
2546        }
2547    }
2548    registry::close_file_map
2549
2550    return $status
2551}
2552
2553proc action_variants { action portlist opts } {
2554    global global_variations
2555    set status 0
2556    if {[require_portlist portlist]} {
2557        return 1
2558    }
2559    foreachport $portlist {
2560        if {$porturl eq ""} {
2561            # look up port
2562            if {[catch {mportlookup $portname} result]} {
2563                global errorInfo
2564                ui_debug "$errorInfo"
2565                break_softcontinue "lookup of portname $portname failed: $result" 1 status
2566            }
2567            if {[llength $result] < 2} {
2568                break_softcontinue "Port $portname not found" 1 status
2569            }
2570
2571            array unset portinfo
2572            array set portinfo [lindex $result 1]
2573
2574            set porturl $portinfo(porturl)
2575            set portdir $portinfo(portdir)
2576        }
2577
2578        if {!([info exists options(ports_variants_index)] && $options(ports_variants_index) eq "yes")} {
2579            if {[catch {set mport [mportopen $porturl [array get options] [array get variations]]} result]} {
2580                ui_debug "$::errorInfo"
2581                break_softcontinue "Unable to open port: $result" 1 status
2582            }
2583            array unset portinfo
2584            array set portinfo [mportinfo $mport]
2585            mportclose $mport
2586            if {[info exists portdir]} {
2587                set portinfo(portdir) $portdir
2588            }
2589        } elseif {![info exists portinfo]} {
2590            ui_warn "port variants --index does not work with 'current' pseudo-port"
2591            continue
2592        }
2593
2594        # set portname again since the one we were passed may not have had the correct case
2595        set portname $portinfo(name)
2596
2597        # if this fails the port doesn't have any variants
2598        if {![info exists portinfo(variants)]} {
2599            if {![macports::ui_isset ports_quiet]} {
2600                puts "$portname has no variants"
2601            }
2602        } else {
2603            array unset vinfo
2604            # Use the new format if it exists.
2605            if {[info exists portinfo(vinfo)]} {
2606                array set vinfo $portinfo(vinfo)
2607            # Otherwise fall back to the old format.
2608            } elseif {[info exists portinfo(variant_desc)]} {
2609                array set vdescriptions $portinfo(variant_desc)
2610            }
2611
2612            # print out all the variants
2613            if {![macports::ui_isset ports_quiet]} {
2614                puts "$portname has the variants:"
2615            }
2616            foreach v [lsort $portinfo(variants)] {
2617                unset -nocomplain vconflicts vdescription vrequires
2618                # Retrieve variants' information from the new format.
2619                if {[info exists vinfo]} {
2620                    array unset variant
2621                    array set variant $vinfo($v)
2622
2623                    # Retrieve conflicts, description, is_default, and
2624                    # vrequires.
2625                    if {[info exists variant(conflicts)]} {
2626                        set vconflicts $variant(conflicts)
2627                    }
2628                    if {[info exists variant(description)]} {
2629                        set vdescription $variant(description)
2630                    }
2631
2632                    # XXX Keep these varmodifiers in sync with action_info, or create a wrapper for it
2633                    if {[info exists variations($v)]} {
2634                        set varmodifier "  $variations($v)"
2635                    } elseif {[info exists global_variations($v)]} {
2636                        # selected by variants.conf, prefixed with (+)/(-)
2637                        set varmodifier "($global_variations($v))"
2638                    } elseif {[info exists variant(is_default)]} {
2639                        set varmodifier "\[+]"
2640                    } else {
2641                        set varmodifier "   "
2642                    }
2643                    if {[info exists variant(requires)]} {
2644                        set vrequires $variant(requires)
2645                    }
2646                # Retrieve variants' information from the old format,
2647                # which only consists of the description.
2648                } elseif {[info exists vdescriptions($v)]} {
2649                    set vdescription $vdescriptions($v)
2650                }
2651
2652                if {[info exists vdescription]} {
2653                    puts [wraplabel "$varmodifier$v" [string trim $vdescription] 0 [string repeat " " [expr 5 + [string length $v]]]]
2654                } else {
2655                    puts "$varmodifier$v"
2656                }
2657                if {[info exists vconflicts]} {
2658                    puts "     * conflicts with [string trim $vconflicts]"
2659                }
2660                if {[info exists vrequires]} {
2661                    puts "     * requires [string trim $vrequires]"
2662                }
2663            }
2664        }
2665    }
2666
2667    return $status
2668}
2669
2670
2671proc action_search { action portlist opts } {
2672    global private_options global_options
2673    set status 0
2674    if {![llength $portlist] && [info exists private_options(ports_no_args)] && $private_options(ports_no_args) == "yes"} {
2675        ui_error "You must specify a search pattern"
2676        return 1
2677    }
2678
2679    # Copy global options as we are going to modify the array
2680    array set options [array get global_options]
2681
2682    if {[info exists options(ports_search_depends)] && $options(ports_search_depends) == "yes"} {
2683        array unset options ports_search_depends
2684        set options(ports_search_depends_fetch) yes
2685        set options(ports_search_depends_extract) yes
2686        set options(ports_search_depends_build) yes
2687        set options(ports_search_depends_lib) yes
2688        set options(ports_search_depends_run) yes
2689    }
2690
2691    # Array to hold given filters
2692    array set filters {}
2693    # Default matchstyle
2694    set filter_matchstyle "none"
2695    set filter_case no
2696    foreach { option } [array names options ports_search_*] {
2697        set opt [string range $option 13 end]
2698
2699        if { $options($option) != "yes" } {
2700            continue
2701        }
2702        switch -- $opt {
2703            exact -
2704            glob -
2705            regex {
2706                set filter_matchstyle $opt
2707                continue
2708            }
2709            case-sensitive {
2710                set filter_case yes
2711                continue
2712            }
2713            line {
2714                continue
2715            }
2716        }
2717
2718        set filters($opt) "yes"
2719    }
2720    # Set default search filter if none was given
2721    if { [array size filters] == 0 } {
2722        set filters(name) "yes"
2723        set filters(description) "yes"
2724    }
2725
2726    set separator ""
2727    foreach portname $portlist {
2728        puts -nonewline $separator
2729
2730        set searchstring $portname
2731        set matchstyle $filter_matchstyle
2732        if {$matchstyle == "none"} {
2733            # Guess if the given string was a glob expression, if not do a substring search
2734            if {[string first "*" $portname] == -1 && [string first "?" $portname] == -1} {
2735                set searchstring "*$portname*"
2736            }
2737            set matchstyle glob
2738        }
2739
2740        set res {}
2741        set portfound 0
2742        foreach { opt } [array get filters] {
2743            # Map from friendly name
2744            set opt [map_friendly_field_names $opt]
2745
2746            if {[catch {eval set matches \[mportsearch \$searchstring $filter_case $matchstyle $opt\]} result]} {
2747                global errorInfo
2748                ui_debug "$errorInfo"
2749                break_softcontinue "search for name $portname failed: $result" 1 status
2750            }
2751
2752            set tmp {}
2753            foreach {name info} $matches {
2754                add_to_portlist tmp [concat [list name $name] $info]
2755            }
2756            set res [opUnion $res $tmp]
2757        }
2758        set res [portlist_sort $res]
2759
2760        set joiner ""
2761        foreach info $res {
2762            array unset portinfo
2763            array set portinfo $info
2764
2765            # XXX is this the right place to verify an entry?
2766            if {![info exists portinfo(name)]} {
2767                puts stderr "Invalid port entry, missing portname"
2768                continue
2769            }
2770            if {![info exists portinfo(description)]} {
2771                puts stderr "Invalid port entry for $portinfo(name), missing description"
2772                continue
2773            }
2774            if {![info exists portinfo(version)]} {
2775                puts stderr "Invalid port entry for $portinfo(name), missing version"
2776                continue
2777            }
2778
2779            if {[macports::ui_isset ports_quiet]} {
2780                puts $portinfo(name)
2781            } else {
2782                if {[info exists options(ports_search_line)]
2783                        && $options(ports_search_line) == "yes"} {
2784                    puts "$portinfo(name)\t$portinfo(version)\t$portinfo(categories)\t$portinfo(description)"
2785                } else {
2786                    puts -nonewline $joiner
2787
2788                    puts -nonewline "$portinfo(name) @$portinfo(version)"
2789                    if {[info exists portinfo(categories)]} {
2790                        puts -nonewline " ([join $portinfo(categories) ", "])"
2791                    }
2792                    puts ""
2793                    puts [wrap [join $portinfo(description)] 0 [string repeat " " 4]]
2794                }
2795            }
2796
2797            set joiner "\n"
2798            set portfound 1
2799        }
2800        if { !$portfound } {
2801            if {![macports::ui_isset ports_quiet]} {
2802                ui_msg "No match for $portname found"
2803            }
2804        } elseif {[llength $res] > 1} {
2805            if {(![info exists global_options(ports_search_line)]
2806                    || $global_options(ports_search_line) != "yes")
2807                    && ![macports::ui_isset ports_quiet]} {
2808                ui_msg "\nFound [llength $res] ports."
2809            }
2810        }
2811
2812        set separator "--\n"
2813    }
2814
2815    array unset options
2816    array unset filters
2817
2818    return $status
2819}
2820
2821
2822proc action_list { action portlist opts } {
2823    global private_options
2824    set status 0
2825   
2826    # Default to list all ports if no portnames are supplied
2827    if { ![llength $portlist] && [info exists private_options(ports_no_args)] && $private_options(ports_no_args) == "yes"} {
2828        add_to_portlist portlist [list name "-all-"]
2829    }
2830   
2831    foreachport $portlist {
2832        if {$portname == "-all-"} {
2833           if {[catch {set res [mportlistall]} result]} {
2834                global errorInfo
2835                ui_debug "$errorInfo"
2836                break_softcontinue "listing all ports failed: $result" 1 status
2837            }
2838        } else {
2839            set search_string [regex_pat_sanitize $portname]
2840            if {[catch {set res [mportsearch ^$search_string\$ no]} result]} {
2841                global errorInfo
2842                ui_debug "$errorInfo"
2843                break_softcontinue "search for portname $search_string failed: $result" 1 status
2844            }
2845        }
2846
2847        foreach {name array} $res {
2848            array unset portinfo
2849            array set portinfo $array
2850            set outdir ""
2851            if {[info exists portinfo(portdir)]} {
2852                set outdir $portinfo(portdir)
2853            }
2854            puts [format "%-30s @%-14s %s" $portinfo(name) $portinfo(version) $outdir]
2855        }
2856    }
2857   
2858    return $status
2859}
2860
2861
2862proc action_echo { action portlist opts } {
2863    # Simply echo back the port specs given to this command
2864    foreachport $portlist {
2865        if {![macports::ui_isset ports_quiet]} {
2866            set opts {}
2867            foreach { key value } [array get options] {
2868                lappend opts "$key=$value"
2869            }
2870
2871            set composite_version [composite_version $portversion [array get variations] 1]
2872            if { $composite_version != "" } {
2873                set ver_field "@$composite_version"
2874            } else {
2875                set ver_field ""
2876            }
2877            puts [format "%-30s %s %s" $portname $ver_field  [join $opts " "]]
2878        } else {
2879            puts "$portname"
2880        }
2881    }
2882
2883    return 0
2884}
2885
2886
2887proc action_portcmds { action portlist opts } {
2888    # Operations on the port's directory and Portfile
2889    global env boot_env
2890    global current_portdir
2891
2892    array set local_options $opts
2893   
2894    set status 0
2895    if {[require_portlist portlist]} {
2896        return 1
2897    }
2898    foreachport $portlist {
2899        # If we have a url, use that, since it's most specific, otherwise try to map the portname to a url
2900        if {$porturl == ""} {
2901       
2902            # Verify the portname, getting portinfo to map to a porturl
2903            if {[catch {set res [mportlookup $portname]} result]} {
2904                global errorInfo
2905                ui_debug "$errorInfo"
2906                break_softcontinue "lookup of portname $portname failed: $result" 1 status
2907            }
2908            if {[llength $res] < 2} {
2909                break_softcontinue "Port $portname not found" 1 status
2910            }
2911            array set portinfo [lindex $res 1]
2912            set porturl $portinfo(porturl)
2913        }
2914       
2915       
2916        # Calculate portdir, porturl, and portfile from initial porturl
2917        set portdir [file normalize [macports::getportdir $porturl]]
2918        set porturl "file://${portdir}";    # Rebuild url so it's fully qualified
2919        set portfile "${portdir}/Portfile"
2920       
2921        # Now execute the specific action
2922        if {[file readable $portfile]} {
2923            switch -- $action {
2924                cat {
2925                    # Copy the portfile to standard output
2926                    set f [open $portfile RDONLY]
2927                    while { ![eof $f] } {
2928                        puts -nonewline [read $f 4096]
2929                    }
2930                    close $f
2931                }
2932               
2933                ed - edit {
2934                    # Edit the port's portfile with the user's editor
2935                   
2936                    # Restore our entire environment from start time.
2937                    # We need it to evaluate the editor, and the editor
2938                    # may want stuff from it as well, like TERM.
2939                    array unset env_save; array set env_save [array get env]
2940                    array unset env *; unsetenv *; array set env [array get boot_env]
2941                   
2942                    # Find an editor to edit the portfile
2943                    set editor ""
2944                    if {[info exists local_options(ports_edit_editor)]} {
2945                        set editor [join $local_options(ports_edit_editor)]
2946                    } elseif {[info exists local_options(ports_ed_editor)]} {
2947                        set editor [join $local_options(ports_ed_editor)]
2948                    } else {
2949                        foreach ed { VISUAL EDITOR } {
2950                            if {[info exists env($ed)]} {
2951                                set editor $env($ed)
2952                                break
2953                            }
2954                        }
2955                    }
2956                   
2957                    # Invoke the editor, with a reasonable canned default.
2958                    if { $editor == "" } { set editor "/usr/bin/vi" }
2959                    if {[catch {eval exec >/dev/stdout </dev/stdin $editor $portfile} result]} {
2960                        global errorInfo
2961                        ui_debug "$errorInfo"
2962                        break_softcontinue "unable to invoke editor $editor: $result" 1 status
2963                    }
2964                   
2965                    # Restore internal MacPorts environment
2966                    array unset env *; unsetenv *; array set env [array get env_save]
2967                }
2968
2969                dir {
2970                    # output the path to the port's directory
2971                    puts $portdir
2972                }
2973
2974                work {
2975                    # output the path to the port's work directory
2976                    set workpath [macports::getportworkpath_from_portdir $portdir]
2977                    if {[file exists $workpath]} {
2978                        puts $workpath
2979                    }
2980                }
2981
2982                cd {
2983                    # Change to the port's directory, making it the default
2984                    # port for any future commands
2985                    set current_portdir $portdir
2986                }
2987
2988                url {
2989                    # output the url of the port's directory, suitable to feed back in later as a port descriptor
2990                    puts $porturl
2991                }
2992
2993                file {
2994                    # output the path to the port's portfile
2995                    puts $portfile
2996                }
2997
2998                gohome {
2999                    set homepage ""
3000
3001                    # Get the homepage as read from PortIndex
3002                    if {[info exists portinfo(homepage)]} {
3003                        set homepage $portinfo(homepage)
3004                    }
3005
3006                    # If not available, get the homepage for the port by opening the Portfile
3007                    if {$homepage == "" && ![catch {set ctx [mportopen $porturl]} result]} {
3008                        array set portinfo [mportinfo $ctx]
3009                        if {[info exists portinfo(homepage)]} {
3010                            set homepage $portinfo(homepage)
3011                        }
3012                        mportclose $ctx
3013                    }
3014
3015                    # Try to open a browser to the homepage for the given port
3016                    if { $homepage != "" } {
3017                        if {[catch {system "${macports::autoconf::open_path} '$homepage'"} result]} {
3018                            global errorInfo
3019                            ui_debug "$errorInfo"
3020                            break_softcontinue "unable to invoke browser using ${macports::autoconf::open_path}: $result" 1 status
3021                        }
3022                    } else {
3023                        ui_error [format "No homepage for %s" $portname]
3024                    }
3025                }
3026            }
3027        } else {
3028            break_softcontinue "Could not read $portfile" 1 status
3029        }
3030    }
3031   
3032    return $status
3033}
3034
3035
3036proc action_sync { action portlist opts } {
3037    global global_options
3038
3039    set status 0
3040    if {[catch {mportsync [array get global_options]} result]} {
3041        global errorInfo
3042        ui_debug "$errorInfo"
3043        ui_msg "port sync failed: $result"
3044        set status 1
3045    }
3046   
3047    return $status
3048}
3049
3050
3051proc action_target { action portlist opts } {
3052    global global_variations
3053    set status 0
3054    if {[require_portlist portlist]} {
3055        return 1
3056    }
3057    foreachport $portlist {
3058        set target $action
3059
3060        # If we have a url, use that, since it's most specific
3061        # otherwise try to map the portname to a url
3062        if {$porturl == ""} {
3063            # Verify the portname, getting portinfo to map to a porturl
3064            if {[catch {set res [mportlookup $portname]} result]} {
3065                global errorInfo
3066                ui_debug "$errorInfo"
3067                break_softcontinue "lookup of portname $portname failed: $result" 1 status
3068            }
3069            if {[llength $res] < 2} {
3070                # don't error for ports that are installed but not in the tree
3071                if {[registry::entry_exists_for_name $portname]} {
3072                    ui_warn "Skipping $portname (not in the ports tree)"
3073                    continue
3074                } else {
3075                    break_softcontinue "Port $portname not found" 1 status
3076                }
3077            }
3078            array unset portinfo
3079            array set portinfo [lindex $res 1]
3080            set porturl $portinfo(porturl)
3081        }
3082       
3083        # use existing variants iff none were explicitly requested
3084        if {[array get requested_variations] == "" && [array get variations] != ""} {
3085            array unset requested_variations
3086            array set requested_variations [array get variations]
3087            set filtered_variations [mport_filtervariants [array get variations] no]
3088        } else {
3089            set filtered_variations [mport_filtervariants [array get requested_variations] yes]
3090        }
3091        # Filter out implicit variants from the explicitly set/unset variants.
3092        # Except we need to keep them for some targets to work right...
3093        switch -exact $target {
3094            distfiles -
3095            mirror {}
3096            default {
3097                array unset requested_variations
3098                array set requested_variations $filtered_variations
3099            }
3100        }
3101       
3102        # Add any global_variations to the variations
3103        # specified for the port
3104        foreach { variation value } [array get global_variations] {
3105            if { ![info exists requested_variations($variation)] } {
3106                set requested_variations($variation) $value
3107            }
3108        }
3109
3110        # If version was specified, save it as a version glob for use
3111        # in port actions (e.g. clean).
3112        if {[string length $portversion]} {
3113            set options(ports_version_glob) $portversion
3114        }
3115        if {[catch {set workername [mportopen $porturl [array get options] [array get requested_variations]]} result]} {
3116            global errorInfo
3117            ui_debug "$errorInfo"
3118            break_softcontinue "Unable to open port: $result" 1 status
3119        }
3120        if {[catch {set result [mportexec $workername $target]} result]} {
3121            global errorInfo
3122            mportclose $workername
3123            ui_debug "$errorInfo"
3124            break_softcontinue "Unable to execute port: $result" 1 status
3125        }
3126
3127        mportclose $workername
3128       
3129        # Process any error that wasn't thrown and handled already
3130        if {$result} {
3131            break_softcontinue "Status $result encountered during processing." 1 status
3132        }
3133    }
3134   
3135    if {$status != 0} {
3136        print_tickets_url
3137    }
3138   
3139    return $status
3140}
3141
3142
3143proc action_exit { action portlist opts } {
3144    # Return a semaphore telling the main loop to quit
3145    return -999
3146}
3147
3148
3149##########################################
3150# Command Parsing
3151##########################################
3152proc moreargs {} {
3153    global cmd_argn cmd_argc
3154    return [expr {$cmd_argn < $cmd_argc}]
3155}
3156
3157
3158proc lookahead {} {
3159    global cmd_argn cmd_argc cmd_argv
3160    if {$cmd_argn < $cmd_argc} {
3161        return [lindex $cmd_argv $cmd_argn]
3162    } else {
3163        return _EOF_
3164    }
3165}
3166
3167
3168proc advance {} {
3169    global cmd_argn
3170    incr cmd_argn
3171}
3172
3173
3174proc match s {
3175    if {[lookahead] == $s} {
3176        advance
3177        return 1
3178    }
3179    return 0
3180}
3181
3182# action_array specifies which action to run on the given command
3183# and if the action wants an expanded portlist.
3184# The value is a list of the form {action expand},
3185# where action is a string and expand a value:
3186#   0 none        Does not expect any text argument
3187#   1 strings     Expects some strings as text argument
3188#   2 ports       Wants an expanded list of ports as text argument
3189global action_array
3190
3191# Define global constants
3192const ACTION_ARGS_NONE 0
3193const ACTION_ARGS_STRINGS 1
3194const ACTION_ARGS_PORTS 2
3195
3196array set action_array [list \
3197    usage       [list action_usage          [ACTION_ARGS_STRINGS]] \
3198    help        [list action_help           [ACTION_ARGS_STRINGS]] \
3199    \
3200    echo        [list action_echo           [ACTION_ARGS_PORTS]] \
3201    \
3202    info        [list action_info           [ACTION_ARGS_PORTS]] \
3203    location    [list action_location       [ACTION_ARGS_PORTS]] \
3204    notes       [list action_notes          [ACTION_ARGS_PORTS]] \
3205    provides    [list action_provides       [ACTION_ARGS_STRINGS]] \
3206    log         [list action_log            [ACTION_ARGS_PORTS]] \
3207    \
3208    activate    [list action_activate       [ACTION_ARGS_PORTS]] \
3209    deactivate  [list action_deactivate     [ACTION_ARGS_PORTS]] \
3210    \
3211    select      [list action_select         [ACTION_ARGS_STRINGS]] \
3212    \
3213    sync        [list action_sync           [ACTION_ARGS_NONE]] \
3214    selfupdate  [list action_selfupdate     [ACTION_ARGS_NONE]] \
3215    \
3216    upgrade     [list action_upgrade        [ACTION_ARGS_PORTS]] \
3217    \
3218    version     [list action_version        [ACTION_ARGS_NONE]] \
3219    platform    [list action_platform       [ACTION_ARGS_NONE]] \
3220    \
3221    uninstall   [list action_uninstall      [ACTION_ARGS_PORTS]] \
3222    \
3223    installed   [list action_installed      [ACTION_ARGS_PORTS]] \
3224    outdated    [list action_outdated       [ACTION_ARGS_PORTS]] \
3225    contents    [list action_contents       [ACTION_ARGS_PORTS]] \
3226    dependents  [list action_dependents     [ACTION_ARGS_PORTS]] \
3227    deps        [list action_info           [ACTION_ARGS_PORTS]] \
3228    variants    [list action_variants       [ACTION_ARGS_PORTS]] \
3229    \
3230    search      [list action_search         [ACTION_ARGS_STRINGS]] \
3231    list        [list action_list           [ACTION_ARGS_PORTS]] \
3232    \
3233    ed          [list action_portcmds       [ACTION_ARGS_PORTS]] \
3234    edit        [list action_portcmds       [ACTION_ARGS_PORTS]] \
3235    cat         [list action_portcmds       [ACTION_ARGS_PORTS]] \
3236    dir         [list action_portcmds       [ACTION_ARGS_PORTS]] \
3237    work        [list action_portcmds       [ACTION_ARGS_PORTS]] \
3238    cd          [list action_portcmds       [ACTION_ARGS_PORTS]] \
3239    url         [list action_portcmds       [ACTION_ARGS_PORTS]] \
3240    file        [list action_portcmds       [ACTION_ARGS_PORTS]] \
3241    gohome      [list action_portcmds       [ACTION_ARGS_PORTS]] \
3242    \
3243    fetch       [list action_target         [ACTION_ARGS_PORTS]] \
3244    checksum    [list action_target         [ACTION_ARGS_PORTS]] \
3245    extract     [list action_target         [ACTION_ARGS_PORTS]] \
3246    patch       [list action_target         [ACTION_ARGS_PORTS]] \
3247    configure   [list action_target         [ACTION_ARGS_PORTS]] \
3248    build       [list action_target         [ACTION_ARGS_PORTS]] \
3249    destroot    [list action_target         [ACTION_ARGS_PORTS]] \
3250    install     [list action_target         [ACTION_ARGS_PORTS]] \
3251    clean       [list action_target         [ACTION_ARGS_PORTS]] \
3252    test        [list action_target         [ACTION_ARGS_PORTS]] \
3253    lint        [list action_target         [ACTION_ARGS_PORTS]] \
3254    submit      [list action_target         [ACTION_ARGS_PORTS]] \
3255    trace       [list action_target         [ACTION_ARGS_PORTS]] \
3256    livecheck   [list action_target         [ACTION_ARGS_PORTS]] \
3257    distcheck   [list action_target         [ACTION_ARGS_PORTS]] \
3258    mirror      [list action_target         [ACTION_ARGS_PORTS]] \
3259    load        [list action_target         [ACTION_ARGS_PORTS]] \
3260    unload      [list action_target         [ACTION_ARGS_PORTS]] \
3261    distfiles   [list action_target         [ACTION_ARGS_PORTS]] \
3262    \
3263    archive     [list action_target         [ACTION_ARGS_PORTS]] \
3264    unarchive   [list action_target         [ACTION_ARGS_PORTS]] \
3265    dmg         [list action_target         [ACTION_ARGS_PORTS]] \
3266    mdmg        [list action_target         [ACTION_ARGS_PORTS]] \
3267    dpkg        [list action_target         [ACTION_ARGS_PORTS]] \
3268    mpkg        [list action_target         [ACTION_ARGS_PORTS]] \
3269    pkg         [list action_target         [ACTION_ARGS_PORTS]] \
3270    portpkg     [list action_target         [ACTION_ARGS_PORTS]] \
3271    rpm         [list action_target         [ACTION_ARGS_PORTS]] \
3272    srpm        [list action_target         [ACTION_ARGS_PORTS]] \
3273    \
3274    quit        [list action_exit           [ACTION_ARGS_NONE]] \
3275    exit        [list action_exit           [ACTION_ARGS_NONE]] \
3276]
3277
3278proc find_action_proc { action } {
3279    global action_array
3280   
3281    set action_proc ""
3282    if { [info exists action_array($action)] } {
3283        set action_proc [lindex $action_array($action) 0]
3284    }
3285   
3286    return $action_proc
3287}
3288
3289# Returns whether an action expects text arguments at all,
3290# expects text arguments or wants an expanded list of ports
3291# Return values are constants:
3292#   [ACTION_ARGS_NONE]     Does not expect any text argument
3293#   [ACTION_ARGS_STRINGS]  Expects some strings as text argument
3294#   [ACTION_ARGS_PORTS]    Wants an expanded list of ports as text argument
3295proc action_needs_portlist { action } {
3296    global action_array
3297
3298    set ret 0
3299    if {[info exists action_array($action)]} {
3300        set ret [lindex $action_array($action) 1]
3301    }
3302
3303    return $ret
3304}
3305
3306# cmd_opts_array specifies which arguments the commands accept
3307# Commands not listed here do not accept any arguments
3308# Syntax if {option argn}
3309# Where option is the name of the option and argn specifies how many arguments
3310# this argument takes
3311global cmd_opts_array
3312array set cmd_opts_array {
3313    edit        {{editor 1}}
3314    ed          {{editor 1}}
3315    info        {category categories depends_fetch depends_extract
3316                 depends_build depends_lib depends_run
3317                 depends description epoch fullname heading homepage index license
3318                 line long_description
3319                 maintainer maintainers name platform platforms portdir pretty
3320                 replaced_by revision variant variants version}
3321    search      {case-sensitive category categories depends_fetch
3322                 depends_extract depends_build depends_lib depends_run
3323                 depends description epoch exact glob homepage line
3324                 long_description maintainer maintainers name platform
3325                 platforms portdir regex revision variant variants version}
3326    selfupdate  {nosync}
3327    uninstall   {follow-dependents}
3328    variants    {index}
3329    clean       {all archive dist work logs}
3330    mirror      {new}
3331    lint        {nitpick}
3332    select      {list set show}
3333    log         {{phase 1} {verbosity 1}}
3334    upgrade     {force enforce-variants no-replace}
3335}
3336
3337global cmd_implied_options
3338array set cmd_implied_options {
3339    deps   {ports_info_fullname yes ports_info_depends yes ports_info_pretty yes}
3340}
3341                                 
3342
3343##
3344# Checks whether the given option is valid
3345#
3346# œparam action for which action
3347# @param option the option to check
3348# @param upoptargc reference to upvar for storing the number of arguments for
3349#                  this option
3350proc cmd_option_exists { action option {upoptargc ""}} {
3351    global cmd_opts_array
3352    upvar 1 $upoptargc optargc
3353
3354    # This could be so easy with lsearch -index,
3355    # but that's only available as of Tcl 8.5
3356
3357    if {![info exists cmd_opts_array($action)]} {
3358        return 0
3359    }
3360
3361    foreach item $cmd_opts_array($action) {
3362        if {[llength $item] == 1} {
3363            set name $item
3364            set argc 0
3365        } else {
3366            set name [lindex $item 0]
3367            set argc [lindex $item 1]
3368        }
3369
3370        if {$name == $option} {
3371            set optargc $argc
3372            return 1
3373        }
3374    }
3375
3376    return 0
3377}
3378
3379# Parse global options
3380#
3381# Note that this is called several times:
3382#   (1) Initially, to parse options that will be constant across all commands
3383#       (options that come prior to any command, frozen into global_options_base)
3384#   (2) Following each command (to parse options that will be unique to that command
3385#       (the global_options array is reset to global_options_base prior to each command)
3386#
3387proc parse_options { action ui_options_name global_options_name } {
3388    upvar $ui_options_name ui_options
3389    upvar $global_options_name global_options
3390    global cmdname cmd_opts_array
3391   
3392    while {[moreargs]} {
3393        set arg [lookahead]
3394       
3395        if {[string index $arg 0] != "-"} {
3396            break
3397        } elseif {[string index $arg 1] == "-"} {
3398            # Process long arguments
3399            switch -- $arg {
3400                -- { # This is the options terminator; do no further option processing
3401                    advance; break
3402                }
3403                default {
3404                    set key [string range $arg 2 end]
3405                    set kargc 0
3406                    if {![cmd_option_exists $action $key kargc]} {
3407                        return -code error "${action} does not accept --${key}"
3408                    }
3409                    if {$kargc == 0} {
3410                        set global_options(ports_${action}_${key}) yes
3411                    } else {
3412                        set args {}
3413                        while {[moreargs] && $kargc > 0} {
3414                            advance
3415                            lappend args [lookahead]
3416                            set kargc [expr $kargc - 1]
3417                        }
3418                        if {$kargc > 0} {
3419                            return -code error "--${key} expects [expr $kargc + [llength $args]] parameters!"
3420                        }
3421                        set global_options(ports_${action}_${key}) $args
3422                    }
3423                }
3424            }
3425        } else {
3426            # Process short arg(s)
3427            set opts [string range $arg 1 end]
3428            foreach c [split $opts {}] {
3429                switch -- $c {
3430                    v {
3431                        set ui_options(ports_verbose) yes
3432                    }
3433                    d {
3434                        set ui_options(ports_debug) yes
3435                        # debug implies verbose
3436                        set ui_options(ports_verbose) yes
3437                    }
3438                    q {
3439                        set ui_options(ports_quiet) yes
3440                        set ui_options(ports_verbose) no
3441                        set ui_options(ports_debug) no
3442                    }
3443                    p {
3444                        # Ignore errors while processing within a command
3445                        set ui_options(ports_processall) yes
3446                    }
3447                    f {
3448                        set global_options(ports_force) yes
3449                    }
3450                    o {
3451                        set global_options(ports_ignore_older) yes
3452                    }
3453                    n {
3454                        set global_options(ports_nodeps) yes
3455                    }
3456                    u {
3457                        set global_options(port_uninstall_old) yes
3458                    }
3459                    R {
3460                        set global_options(ports_do_dependents) yes
3461                    }
3462                    s {
3463                        set global_options(ports_source_only) yes
3464                    }
3465                    b {
3466                        set global_options(ports_binary_only) yes
3467                    }
3468                    c {
3469                        set global_options(ports_autoclean) yes
3470                    }
3471                    k {
3472                        set global_options(ports_autoclean) no
3473                    }
3474                    t {
3475                        set global_options(ports_trace) yes
3476                    }
3477                    y {
3478                        set global_options(ports_dryrun) yes
3479                    }
3480                    F {
3481                        # Name a command file to process
3482                        advance
3483                        if {[moreargs]} {
3484                            lappend ui_options(ports_commandfiles) [lookahead]
3485                        }
3486                    }
3487                    D {
3488                        advance
3489                        if {[moreargs]} {
3490                            cd [lookahead]
3491                        }
3492                        break
3493                    }
3494                    default {
3495                        print_usage; exit 1
3496                    }
3497                }
3498            }
3499        }
3500
3501        advance
3502    }
3503}
3504
3505
3506proc process_cmd { argv } {
3507    global cmd_argc cmd_argv cmd_argn
3508    global global_options global_options_base private_options ui_options
3509    global current_portdir
3510    global cmd_implied_options
3511    set cmd_argv $argv
3512    set cmd_argc [llength $argv]
3513    set cmd_argn 0
3514
3515    set action_status 0
3516
3517    # Process an action if there is one
3518    while {($action_status == 0 || [macports::ui_isset ports_processall]) && [moreargs]} {
3519        set action [lookahead]
3520        advance
3521       
3522        # Handle command separator
3523        if { $action == ";" } {
3524            continue
3525        }
3526       
3527        # Handle a comment
3528        if { [string index $action 0] == "#" } {
3529            while { [moreargs] } { advance }
3530            break
3531        }
3532       
3533        # Always start out processing an action in current_portdir
3534        cd $current_portdir
3535       
3536        # Reset global_options from base before each action, as we munge it just below...
3537        array unset global_options
3538        array set global_options $global_options_base
3539       
3540        if {[info exists cmd_implied_options($action)]} {
3541            array set global_options $cmd_implied_options($action)
3542        }
3543
3544        # Find an action to execute
3545        set action_proc [find_action_proc $action]
3546        if { $action_proc == "" } {
3547            puts "Unrecognized action \"$action\""
3548            set action_status 1
3549            break
3550        }
3551
3552        # Parse options that will be unique to this action
3553        # (to avoid abiguity with -variants and a default port, either -- must be
3554        # used to terminate option processing, or the pseudo-port current must be specified).
3555        if {[catch {parse_options $action ui_options global_options} result]} {
3556            global errorInfo
3557            ui_debug "$errorInfo"
3558            ui_error $result
3559            set action_status 1
3560            break
3561        }
3562
3563        # What kind of arguments does the command expect?
3564        set expand [action_needs_portlist $action]
3565
3566        # Parse action arguments, setting a special flag if there were none
3567        # We otherwise can't tell the difference between arguments that evaluate
3568        # to the empty set, and the empty set itself.
3569        set portlist {}
3570        switch -- [lookahead] {
3571            ;       -
3572            _EOF_ {
3573                set private_options(ports_no_args) yes
3574            }
3575            default {
3576                if {[ACTION_ARGS_NONE] == $expand} {
3577                    ui_error "$action does not accept string arguments"
3578                    set action_status 1
3579                    break
3580                } elseif {[ACTION_ARGS_STRINGS] == $expand} {
3581                    while { [moreargs] && ![match ";"] } {
3582                        lappend portlist [lookahead]
3583                        advance
3584                    }
3585                } elseif {[ACTION_ARGS_PORTS] == $expand} {
3586                    # Parse port specifications into portlist
3587                    if {![portExpr portlist]} {
3588                        ui_error "Improper expression syntax while processing parameters"
3589                        set action_status 1
3590                        break
3591                    }
3592                }
3593            }
3594        }
3595       
3596        # execute the action
3597        set action_status [$action_proc $action $portlist [array get global_options]]
3598
3599        # semaphore to exit
3600        if {$action_status == -999} break
3601    }
3602   
3603    return $action_status
3604}
3605
3606
3607proc complete_portname { text state } { 
3608    global complete_choices complete_position
3609   
3610    if {$state == 0} {
3611        set complete_position 0
3612        set complete_choices {}
3613
3614        # Build a list of ports with text as their prefix
3615        if {[catch {set res [mportsearch "${text}*" false glob]} result]} {
3616            global errorInfo
3617            ui_debug "$errorInfo"
3618            fatal "search for portname $pattern failed: $result"
3619        }
3620        foreach {name info} $res {
3621            lappend complete_choices $name
3622        }
3623    }
3624   
3625    set word [lindex $complete_choices $complete_position]
3626    incr complete_position
3627   
3628    return $word
3629}
3630
3631
3632proc complete_action { text state } {   
3633    global action_array
3634    global complete_choices complete_position
3635
3636    if {$state == 0} {
3637        set complete_position 0
3638        set complete_choices [array names action_array "[string tolower $text]*"]
3639    }
3640
3641    set word [lindex $complete_choices $complete_position]
3642    incr complete_position
3643
3644    return $word
3645}
3646
3647
3648proc attempt_completion { text word start end } {
3649    # If the word starts with '~', or contains '.' or '/', then use the build-in
3650    # completion to complete the word
3651    if { [regexp {^~|[/.]} $word] } {
3652        return ""
3653    }
3654
3655    # Decide how to do completion based on where we are in the string
3656    set prefix [string range $text 0 [expr $start - 1]]
3657   
3658    # If only whitespace characters preceed us, or if the
3659    # previous non-whitespace character was a ;, then we're
3660    # an action (the first word of a command)
3661    if { [regexp {(^\s*$)|(;\s*$)} $prefix] } {
3662        return complete_action
3663    }
3664   
3665    # Otherwise, do completion on portname
3666    return complete_portname
3667}
3668
3669
3670proc get_next_cmdline { in out use_readline prompt linename } {
3671    upvar $linename line
3672   
3673    set line ""
3674    while { $line == "" } {
3675
3676        if {$use_readline} {
3677            set len [readline read -attempted_completion attempt_completion line $prompt]
3678        } else {
3679            puts -nonewline $out $prompt
3680            flush $out
3681            set len [gets $in line]
3682        }
3683
3684        if { $len < 0 } {
3685            return -1
3686        }
3687       
3688        set line [string trim $line]
3689
3690        if { $use_readline && $line != "" } {
3691            rl_history add $line
3692        }
3693    }
3694   
3695    return [llength $line]
3696}
3697
3698
3699proc process_command_file { in } {
3700    global current_portdir
3701
3702    # Initialize readline
3703    set isstdin [string match $in "stdin"]
3704    set name "port"
3705    set use_readline [expr $isstdin && [readline init $name]]
3706    set history_file [file normalize "${macports::macports_user_dir}/history"]
3707
3708    # Read readline history
3709    if {$use_readline && [file isdirectory $macports::macports_user_dir]} {
3710        rl_history read $history_file
3711        rl_history stifle 100
3712    }
3713
3714    # Be noisy, if appropriate
3715    set noisy [expr $isstdin && ![macports::ui_isset ports_quiet]]
3716    if { $noisy } {
3717        puts "MacPorts [macports::version]"
3718        puts "Entering interactive mode... (\"help\" for help, \"quit\" to quit)"
3719    }
3720
3721    # Main command loop
3722    set exit_status 0
3723    while { $exit_status == 0 || [macports::ui_isset ports_processall] } {
3724
3725        # Calculate our prompt
3726        if { $noisy } {
3727            set shortdir [eval file join [lrange [file split $current_portdir] end-1 end]]
3728            set prompt "\[$shortdir\] > "
3729        } else {
3730            set prompt ""
3731        }
3732
3733        # Get a command line
3734        if { [get_next_cmdline $in stdout $use_readline $prompt line] <= 0  } {
3735            puts ""
3736            break
3737        }
3738
3739        # Process the command
3740        set exit_status [process_cmd $line]
3741       
3742        # Check for semaphore to exit
3743        if {$exit_status == -999} {
3744            set exit_status 0
3745            break
3746        }
3747    }
3748
3749    # Create macports user directory if it does not exist yet
3750    if {$use_readline && ![file isdirectory $macports::macports_user_dir]} {
3751        file mkdir $macports::macports_user_dir
3752    }
3753    # Save readine history
3754    if {$use_readline && [file isdirectory $macports::macports_user_dir]} {
3755        rl_history write $history_file
3756    }
3757
3758    # Say goodbye
3759    if { $noisy } {
3760        puts "Goodbye"
3761    }
3762
3763    return $exit_status
3764}
3765
3766
3767proc process_command_files { filelist } {
3768    set exit_status 0
3769
3770    # For each file in the command list, process commands
3771    # in the file
3772    foreach file $filelist {
3773        if {$file == "-"} {
3774            set in stdin
3775        } else {
3776            if {[catch {set in [open $file]} result]} {
3777                fatal "Failed to open command file; $result"
3778            }
3779        }
3780
3781        set exit_status [process_command_file $in]
3782
3783        if {$in != "stdin"} {
3784            close $in
3785        }
3786
3787        # Exit on first failure unless -p was given
3788        if {$exit_status != 0 && ![macports::ui_isset ports_processall]} {
3789            return $exit_status
3790        }
3791    }
3792
3793    return $exit_status
3794}
3795
3796
3797##########################################
3798# Main
3799##########################################
3800
3801# Global arrays passed to the macports1.0 layer
3802array set ui_options        {}
3803array set global_options    {}
3804array set global_variations {}
3805
3806# Global options private to this script
3807array set private_options {}
3808
3809# Make sure we get the size of the terminal
3810# We do this here to save it in the boot_env, in case we determined it manually
3811term_init_size
3812
3813# Save off a copy of the environment before mportinit monkeys with it
3814global env boot_env
3815array set boot_env [array get env]
3816
3817global argv0
3818global cmdname
3819set cmdname [file tail $argv0]
3820
3821# Setp cmd_argv to match argv
3822global argc argv
3823global cmd_argc cmd_argv cmd_argn
3824set cmd_argv $argv
3825set cmd_argc $argc
3826set cmd_argn 0
3827
3828# make sure we're using a sane umask
3829umask 022
3830
3831# If we've been invoked as portf, then the first argument is assumed
3832# to be the name of a command file (i.e., there is an implicit -F
3833# before any arguments).
3834if {[moreargs] && $cmdname == "portf"} {
3835    lappend ui_options(ports_commandfiles) [lookahead]
3836    advance
3837}
3838
3839# Parse global options that will affect all subsequent commands
3840if {[catch {parse_options "global" ui_options global_options} result]} {
3841    puts "Error: $result"
3842    print_usage
3843    exit 1
3844}
3845
3846# Get arguments remaining after option processing
3847set remaining_args [lrange $cmd_argv $cmd_argn end]
3848
3849# Initialize mport
3850# This must be done following parse of global options, as some options are
3851# evaluated by mportinit.
3852if {[catch {mportinit ui_options global_options global_variations} result]} {
3853    global errorInfo
3854    puts "$errorInfo"
3855    fatal "Failed to initialize MacPorts, $result"
3856}
3857
3858# If we have no arguments remaining after option processing then force
3859# interactive mode
3860if { [llength $remaining_args] == 0 && ![info exists ui_options(ports_commandfiles)] } {
3861    lappend ui_options(ports_commandfiles) -
3862}
3863
3864# Set up some global state for our code
3865global current_portdir
3866set current_portdir [pwd]
3867
3868# Freeze global_options into global_options_base; global_options
3869# will be reset to global_options_base prior to processing each command.
3870global global_options_base
3871set global_options_base [array get global_options]
3872
3873# First process any remaining args as action(s)
3874global exit_status
3875set exit_status 0
3876if { [llength $remaining_args] > 0 } {
3877
3878    # If there are remaining arguments, process those as a command
3879    set exit_status [process_cmd $remaining_args]
3880}
3881
3882# Process any prescribed command files, including standard input
3883if { ($exit_status == 0 || [macports::ui_isset ports_processall]) && [info exists ui_options(ports_commandfiles)] } {
3884    set exit_status [process_command_files $ui_options(ports_commandfiles)]
3885}
3886
3887# Return with exit_status
3888exit $exit_status
Note: See TracBrowser for help on using the repository browser.