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

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

Whitespaces changes only.

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