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

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

Start the separation between port.tcl's private options and those that are passed to the macports1.0 API.
For the time being, simply store "ports_no_args" into the "private_options" array and poll the latter
whereever the former is needed, thus fixing the regressions introduced by the recent API tweaks. More
separation (taking away from ui_options and global_options) will come later on in follow-up commits.

Also remove some unnecessary calls to the global arrays in varios procs, as they are no longer needed
to be in scope due to the API tweaks.

This commit fixes #12837.

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