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

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

install macports1.0 next to the other Tcl packages and just put a link in the Tcl package dir if possible (#12943)

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