source: branches/variant-descs-14482/base/src/port/port.tcl @ 34854

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

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

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