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

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

API change:

  • move ui_isset and global_option_isset procs that are found in every single macports1.0 client into macports1.0 itself, sparing the clients from implementing them repeatedly;
  • change their prototypes to require the arrays as arguments, so that the library clients can still set and fill them up as desired;
  • update every macports1.0 client in our tree to use this new API (this expands to the port, portindex and portmirror scripts in the base/src/port, do let me know of I'm missing any).

PS: The purpose of this commit is to further simplify macports1.0 scripting, so that a client is not forced to do all the UI initialization plumbing.

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