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

Last change on this file since 42662 was 42662, checked in by raimue@…, 12 years ago

Merged revisions 34469,34852,34854-34855,34900,36952-36956,37507-37508,37511-37512,41040,41042-41046,41138-41139,41142-41143,41145,41151,41403,41458,41462-41463,42575,42626,42640-42641,42659 via svnmerge from
https://svn.macosforge.org/repository/macports/branches/variant-descs-14482/base

........

r34469 | raimue@… | 2008-02-26 07:08:09 +0100 (Tue, 26 Feb 2008) | 3 lines


port/port.tcl:
Reading from .config/variant_descriptions actually works

........

r34852 | raimue@… | 2008-03-09 02:45:22 +0100 (Sun, 09 Mar 2008) | 4 lines


macports1.0/macports.tcl:
New API: macports::getsourceconfigdir
Returns the path to .config for a porturl.

........

r34854 | raimue@… | 2008-03-09 03:11:27 +0100 (Sun, 09 Mar 2008) | 3 lines


port/port.tcl:
Use new API macports::getsourceconfigdir

........

r34855 | raimue@… | 2008-03-09 03:12:54 +0100 (Sun, 09 Mar 2008) | 3 lines


port/port.tcl:
Treat variant descriptions as strings to avoid problems with braces

........

r34900 | raimue@… | 2008-03-10 16:54:25 +0100 (Mon, 10 Mar 2008) | 3 lines


port/port.tcl:
Rename variable

........

r36952 | raimue@… | 2008-05-21 04:20:27 +0200 (Wed, 21 May 2008) | 3 lines


port/port.tcl:
Remove get_variant_desc, this will now be done in port1.0/portutil.tcl instead

........

r36953 | raimue@… | 2008-05-21 04:22:04 +0200 (Wed, 21 May 2008) | 3 lines


macports1.0/macports.tcl:
Give the worker access to variable porturl and proc getsourceconfigdir

........

r36954 | raimue@… | 2008-05-21 04:23:37 +0200 (Wed, 21 May 2008) | 3 lines


port1.0/tests:
Fix the portutil test after r36953

........

r36955 | raimue@… | 2008-05-21 05:01:11 +0200 (Wed, 21 May 2008) | 3 lines


macports1.0/macports.tcl:
Give worker access to getprotocol and getportdir as they are needed for getsourceconfigdir

........

r36956 | raimue@… | 2008-05-21 05:02:23 +0200 (Wed, 21 May 2008) | 3 lines


port1.0/portutil.tcl:
New proc variant_desc, reads global variant description file

........

r37507 | raimue@… | 2008-06-10 16:04:54 +0200 (Tue, 10 Jun 2008) | 4 lines


port1.0/portutil.tcl:
Don't warn about a missing description if it is set global,
but warn if the variant overrides the global description

........

r37508 | raimue@… | 2008-06-10 16:14:03 +0200 (Tue, 10 Jun 2008) | 3 lines


macports1.0/macports.tcl:
Use .resources instead of .config as it is a bit clearer, see #14553

........

r37511 | raimue@… | 2008-06-10 17:22:12 +0200 (Tue, 10 Jun 2008) | 5 lines


port1.0/portutil.tcl:
Switch back to this format:
name {description}
So this could be easily extended if ever needed.

........

r37512 | raimue@… | 2008-06-10 17:27:48 +0200 (Tue, 10 Jun 2008) | 3 lines


port1.0/portutil.tcl:
Add a warning if global variant description file could not be opened

........

r41040 | raimue@… | 2008-10-21 13:06:39 +0200 (Tue, 21 Oct 2008) | 4 lines


macports/macport.tcl:

  • New flag "default" for sources to indicate fallback for resources (group)
  • Add parameter to getsourceconfigdir to get path for a requested file

........

r41042 | raimue@… | 2008-10-21 13:11:44 +0200 (Tue, 21 Oct 2008) | 3 lines


macports1.0/macports.tcl:
Rename getsourceconfigdir to getportresourcepath

........

r41043 | raimue@… | 2008-10-21 13:15:16 +0200 (Tue, 21 Oct 2008) | 3 lines


port1.0/portutil.tcl:
Use getportresourcepath for the group files

........

r41044 | raimue@… | 2008-10-21 13:19:47 +0200 (Tue, 21 Oct 2008) | 3 lines


port1.0/portlint.tcl:
Use getresourcepath for group files

........

r41045 | raimue@… | 2008-10-21 13:20:36 +0200 (Tue, 21 Oct 2008) | 3 lines


port1.0/portmain.tcl:
Add a note that we should get rid of $portresourcepath in favor of [getportresourcepath]

........

r41046 | raimue@… | 2008-10-21 13:40:29 +0200 (Tue, 21 Oct 2008) | 3 lines


port1.0/portutil.tcl:
Missed one instance of getsourceconfigdir

........

r41138 | raimue@… | 2008-10-25 20:52:50 +0200 (Sat, 25 Oct 2008) | 3 lines


port1.0/portutil.tcl:
Use getportresourcepath for global variant descriptions

........

r41139 | raimue@… | 2008-10-25 21:23:15 +0200 (Sat, 25 Oct 2008) | 3 lines


port1.0/portmain.tcl:
Correct XXX tag

........

r41142 | raimue@… | 2008-10-25 23:11:30 +0200 (Sat, 25 Oct 2008) | 3 lines


port1.0/portfetch.tcl:
Use getportresourcepath

........

r41143 | raimue@… | 2008-10-25 23:12:04 +0200 (Sat, 25 Oct 2008) | 3 lines


port1.0/portdestroot.tcl:
Use getportresourcepath

........

r41145 | raimue@… | 2008-10-26 00:04:15 +0200 (Sun, 26 Oct 2008) | 3 lines


macports1.0/macports.tcl:
Fix a problem with URLs not using the file protocol

........

r41151 | raimue@… | 2008-10-26 03:09:54 +0100 (Sun, 26 Oct 2008) | 3 lines


macports1.0/macports.tcl:
Fix issues introduced in r41145, the file exists check was wrong

........

r41403 | raimue@… | 2008-11-01 22:59:21 +0100 (Sat, 01 Nov 2008) | 3 lines


port1.0/portutil.tcl:
Add a debug output which group files are used

........

r41458 | blb@… | 2008-11-03 22:58:28 +0100 (Mon, 03 Nov 2008) | 2 lines


Add [default] tag and description to sources.conf

........

r41462 | blb@… | 2008-11-04 02:12:28 +0100 (Tue, 04 Nov 2008) | 2 lines


No longer need to install resources with base

........

r41463 | blb@… | 2008-11-04 02:14:49 +0100 (Tue, 04 Nov 2008) | 4 lines


Move the install/ subdir (containing the mtree files) into .../share/macports
from the resources dir (the mtree contains a bit of install-time info, so it
shouldn't be with the resources stuff in the port tree)

........

r42575 | blb@… | 2008-11-25 01:53:05 +0100 (Tue, 25 Nov 2008) | 3 lines


Add script to handle upgrades through configure/make/make install and
the package, so [default] is added as appropriate to sources.conf

........

r42626 | raimue@… | 2008-11-27 02:21:15 +0100 (Thu, 27 Nov 2008) | 3 lines


package1.0/portpkg.tcl, package1.0/portmpkg.tcl:
Remove portresourcepath and use [getportresourcepath] instead

........

r42640 | raimue@… | 2008-11-27 11:49:32 +0100 (Thu, 27 Nov 2008) | 3 lines


package1.0/portrpm.tcl, package1.0/portsrpm.tcl:
Remove reference to portresurcepath which is not used at all

........

r42641 | raimue@… | 2008-11-27 11:52:12 +0100 (Thu, 27 Nov 2008) | 3 lines


port1.0/portmain.tcl:
Remove definition of portresourcepath as it is not used any more

........

r42659 | raimue@… | 2008-11-28 16:44:30 +0100 (Fri, 28 Nov 2008) | 3 lines


macports1.0/macports.tcl:
Rename portresourcepath from .resources to _resources

........

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