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

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

Fix bugs #11683, #10766.

Present a cleaner message for port installed and port outdated when the list of ports has been restricted. In these cases we now say 'none of the specified ports are outdated/installed' instead of 'no ports are installed/outdated.'

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