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

Last change on this file since 15691 was 15691, checked in by olegb, 15 years ago

Bug:
Submitted by:
Reviewed by:
Approved by:
Obtained from:

Add

  • New target: "dependents"
  • New switch: "-R" for upgrading dependents
  • Make upgrade look up force for forcefully upgrading (or re-installing)
  • Documenting the above in port.1
  • Property svn:eol-style set to native
  • Property svn:executable set to *
File size: 49.5 KB
Line 
1#!/bin/sh
2#\
3exec @TCLSH@ "$0" "$@"
4# port.tcl
5# $Id: port.tcl,v 1.146 2006/01/05 06:40:56 olegb Exp $
6#
7# Copyright (c) 2004 Robert Shaw <rshaw@opendarwin.org>
8# Copyright (c) 2002 Apple Computer, Inc.
9# All rights reserved.
10#
11# Redistribution and use in source and binary forms, with or without
12# modification, are permitted provided that the following conditions
13# are met:
14# 1. Redistributions of source code must retain the above copyright
15#    notice, this list of conditions and the following disclaimer.
16# 2. Redistributions in binary form must reproduce the above copyright
17#    notice, this list of conditions and the following disclaimer in the
18#    documentation and/or other materials provided with the distribution.
19# 3. Neither the name of Apple Computer, Inc. nor the names of its contributors
20#    may be used to endorse or promote products derived from this software
21#    without specific prior written permission.
22#
23# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
24# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
25# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
26# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
27# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
28# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
29# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
30# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
31# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
32# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
33# POSSIBILITY OF SUCH DAMAGE.
34
35#
36#       TODO:
37#
38
39catch {source \
40        [file join "@TCL_PACKAGE_DIR@" darwinports1.0 darwinports_fastload.tcl]}
41package require darwinports
42
43# globals
44set portdir .
45set argn 0
46set action ""
47set portlist {}
48array set ui_options            {}
49array set global_options        {}
50array set global_variations     {}
51
52# Save off a copy of the environment before dportinit monkeys with it
53global env
54array set boot_env [array get env]
55
56global argv0
57set cmdname [file tail $argv0]
58
59# UI Instantiations
60# ui_options(ports_debug) - If set, output debugging messages.
61# ui_options(ports_verbose) - If set, output info messages (ui_info)
62# ui_options(ports_quiet) - If set, don't output "standard messages"
63
64# ui_options accessor
65proc ui_isset {val} {
66        global ui_options
67        if {[info exists ui_options($val)]} {
68                if {$ui_options($val) == "yes"} {
69                        return 1
70                }
71        }
72        return 0
73}
74
75# global_options accessor
76proc global_option_isset {val} {
77        global global_options
78        if {[info exists global_options($val)]} {
79                if {$global_options($val) == "yes"} {
80                        return 1
81                }
82        }
83        return 0
84}
85
86# UI Callback
87proc ui_prefix {priority} {
88    switch $priority {
89        debug {
90                return "DEBUG: "
91        }
92        error {
93                return "Error: "
94        }
95        warn {
96                return "Warning: "
97        }
98        default {
99                return ""
100        }
101    }
102}
103
104proc ui_channels {priority} {
105    global logfd
106    switch $priority {
107        debug {
108            if {[ui_isset ports_debug]} {
109                return {stderr}
110            } else {
111                return {}
112            }
113        }
114        info {
115            if {[ui_isset ports_verbose]} {
116                return {stdout}
117            } else {
118                return {}
119                        }
120                }
121        msg {
122            if {[ui_isset ports_quiet]} {
123                return {}
124                        } else {
125                                return {stdout}
126                        }
127                }
128        error {
129                return {stderr}
130        }
131        default {
132                return {stdout}
133        }
134    }
135}
136
137
138# Standard procedures
139proc print_usage args {
140        global cmdname
141        set usage { [-vdqfonRsbcktu] [-D portdir] action [actionflags]
142[[portname|pseudo-portname|port-url] [@version] [+-variant]... [option=value]...]...
143}
144               
145        puts "Usage: $cmdname$usage"
146        puts "\"$cmdname help\" or \"man 1 port\" for more information."
147}
148
149
150proc print_help args {
151        global cmdname
152       
153        set help { [-vdqfonRsbcktu] [-D portdir] action [actionflags]
154[[portname|pseudo-portname|port-url] [@version] [+-variant]... [option=value]...]...
155       
156Valid actions are:
157        help, info, location, provides, activate, deactivate, selfupdate, upgrade,
158        version, compact, uncompact, uninstall, installed, outdated, contents, deps,
159        dependents, variants, search, list, echo, sync, dir, url, file, cat, edit,
160        fetch, patch, extract, build, destroot, install, test.
161       
162Pseudo-portnames:
163        Pseudo-portnames are words which may be used in place of a portname, and
164        which expand to some set of ports. The common pseudo-ports are:
165        all, current, active, inactive, installed, uninstalled, and outdated.
166        These pseudo-portnames expand to the set of ports named.
167       
168        Additional pseudo-portnames are:
169        variants:, variant:, description:, portdir:, homepage:, epoch:,
170        platforms:, platform:, name:, long_description:, maintainers:,
171        maintainer:, categories:, category:, version:, and revision:.
172        These each select a set of ports based on a regex search of metadata
173        about the ports. In all such cases, a standard regex pattern following
174        the colon will be used to select the set of ports to which the
175        pseudo-portname expands.
176       
177        portnames that contain standard glob characters will be expanded to the
178        set of ports matching the glob pattern.
179       
180Port expressions:
181        Portnames, port glob patterns, and pseudo-portnames may be logically combined
182        using expressions consisting of and, or, not, !, (, and ).
183       
184For more information:
185        See man pages: port(1), ports.conf(5), portfile(7), portgroup(7),
186        porthier(7), portstyle(7).
187       
188        }
189       
190        puts "$cmdname$help"
191}
192
193
194
195# Produce error message and exit
196proc fatal s {
197        global argv0
198        ui_error "$argv0: $s"
199        exit 1
200}
201
202
203# Produce an error message, and exit, unless
204# we're handling errors in a soft fashion, in which
205# case we continue
206proc fatal_softcontinue s {
207        if {[global_option_isset ports_force]} {
208                ui_error $s
209                return -code continue
210        } else {
211                fatal $s
212        }
213}
214
215
216# Form a composite version as is sometimes used for registry functions
217proc composite_version {version variations {emptyVersionOkay 0}} {
218        # Form a composite version out of the version and variations
219       
220        # Select the variations into positive and negative
221        set pos {}
222        set neg {}
223        foreach { key val } $variations {
224                if {$val == "+"} {
225                        lappend pos $key
226                } elseif {$val == "-"} {
227                        lappend neg $key
228                }
229        }
230       
231        # If there is no version, we have nothing to do
232        set composite_version ""
233        if {$version != "" || $emptyVersionOkay} {
234                set pos_str ""
235                set neg_str ""
236               
237                if {[llength $pos]} {
238                        set pos_str "+[join [lsort -ascii $pos] "+"]"
239                }
240                if {[llength $neg]} {
241                        set neg_str "-[join [lsort -ascii $neg] "-"]"
242                }
243               
244                set composite_version "$version$pos_str$neg_str"
245        }
246       
247        return $composite_version
248}
249
250
251proc split_variants {variants} {
252        set result {}
253        set l [regexp -all -inline -- {([-+])([[:alpha:]_]+[\w\.]*)} $variants]
254        foreach { match sign variant } $l {
255                lappend result $variant $sign
256        }
257        return $result
258}
259
260
261proc registry_installed {portname {portversion ""}} {
262        set ilist [registry::installed $portname $portversion]
263        if { [llength $ilist] > 1 } {
264                puts "The following versions of $portname are currently installed:"
265                foreach i $ilist { 
266                        set iname [lindex $i 0]
267                        set iversion [lindex $i 1]
268                        set irevision [lindex $i 2]
269                        set ivariants [lindex $i 3]
270                        set iactive [lindex $i 4]
271                        if { $iactive == 0 } {
272                                puts "  $iname ${iversion}_${irevision}${ivariants}"
273                        } elseif { $iactive == 1 } {
274                                puts "  $iname ${iversion}_${irevision}${ivariants} (active)"
275                        }
276                }
277                return -code error "Registry error: Please specify the full version as recorded in the port registry."
278        } else {
279                return [lindex $ilist 0]
280        }
281}
282
283
284proc add_to_portlist {listname portentry} {
285        upvar $listname portlist
286        global global_options global_variations
287       
288        # The portlist currently has the following elements in it:
289        #       url                             if any
290        #       name
291        #       version                 (version_revision)
292        #       variants array  (variant=>+-)
293        #       options array   (key=>value)
294        #       fullname                (name/version_revision+-variants)
295       
296        array set port $portentry
297        if {![info exists port(url)]}           { set port(url) "" }
298        if {![info exists port(name)]}          { set port(name) "" }
299        if {![info exists port(version)]}       { set port(version) "" }
300        if {![info exists port(variants)]}      { set port(variants) "" }
301        if {![info exists port(options)]}       { set port(options) [array get global_options] }
302       
303        # If neither portname nor url is specified, then default to the current port
304        if { $port(url) == "" && $port(name) == "" } {
305                set url file://.
306                set portname [url_to_portname $url]
307                set port(url) $url
308                set port(name) $portname
309                if {$portname == ""} {
310                        fatal "A default port name could not be supplied."
311                }
312        }
313       
314               
315        # Form the fully descriminated portname: portname/version_revison+-variants
316        set port(fullname) "$port(name)/[composite_version $port(version) $port(variants)]"
317       
318        # Add it to our portlist
319        lappend portlist [array get port]
320}
321
322
323proc add_ports_to_portlist {listname ports {overridelist ""}} {
324        upvar $listname portlist
325       
326        array set overrides $overridelist
327       
328        # Add each entry to the named portlist, overriding any values
329        # specified as overrides
330        foreach portentry $ports {
331                array set port $portentry
332                if ([info exists overrides(version)])   { set port(version) $overrides(version) }
333                if ([info exists overrides(variants)])  { set port(variants) $overrides(variants)       }
334                if ([info exists overrides(options)])   { set port(options) $overrides(options) }
335                add_to_portlist portlist [array get port]
336        }
337}
338
339
340proc url_to_portname { url } {
341        # Save directory and restore the directory, since dportopen changes it
342        set savedir [pwd]
343        set portname ""
344        if {[catch {set ctx [dportopen $url]} result]} {
345                puts stderr "Can't map the URL '$url' to a port description file (${result}). Please verify that the directory and portfile syntax are correct."
346        } else {
347                array set portinfo [dportinfo $ctx]
348                set portname $portinfo(name)
349                dportclose $ctx
350        }
351        cd $savedir
352        return $portname
353}
354
355
356# Supply a default porturl/portname if the portlist is empty
357proc require_portlist {} {
358        upvar portlist portlist
359       
360        if {[llength $portlist] == 0} {
361                set portlist [get_current_port]
362        }
363}
364
365
366# Execute the enclosed block once for every element in the portlist
367# When the block is entered, the variables portname, portversion, options, and variations
368# will have been set
369proc foreachport {portlist block} {
370        # Restore cwd after each port, since dportopen changes it, and relative
371        # urls will break on subsequent passes
372        set savedir [pwd]
373        foreach portspec $portlist {
374                uplevel 1 "array set portspec { $portspec }"
375                uplevel 1 {
376                        set porturl $portspec(url)
377                        set portname $portspec(name)
378                        set portversion $portspec(version)
379                        array unset variations
380                        array set variations $portspec(variants)
381                        array unset options
382                        array set options $portspec(options)
383                }
384                uplevel 1 $block
385                cd $savedir
386        }
387}
388
389
390proc portlist_compare { a b } {
391        array set a_ $a
392        array set b_ $b
393        return [string compare $a_(name) $b_(name)]
394}
395
396
397proc portlist_sort list {
398        return [lsort -command portlist_compare $list]
399}
400
401
402proc regex_pat_sanitize s {
403        set sanitized [regsub -all {[\\(){}+$.^]} $s {\\&}]
404        return $sanitized
405}
406
407
408##########################################
409# Port selection
410##########################################
411proc get_matching_ports {pattern {casesensitive no} {matchstyle glob} {field name}} {
412        if {[catch {set res [dportsearch $pattern $casesensitive $matchstyle $field]} result]} {
413                global errorInfo
414                ui_debug "$errorInfo"
415                fatal "search for portname $pattern failed: $result"
416        }
417
418        set results {}
419        foreach {name info} $res {
420                array set portinfo $info
421               
422                #set variants {}
423                #if {[info exists portinfo(variants)]} {
424                #       foreach variant $portinfo(variants) {
425                #               lappend variants $variant "+"
426                #       }
427                #}
428                # For now, don't include version or variants with all ports list
429                #"$portinfo(version)_$portinfo(revision)"
430                #$variants
431                add_to_portlist results [list url $portinfo(porturl) name $name]
432        }
433       
434        # Return the list of all ports, sorted
435        return [portlist_sort $results]
436}
437
438
439proc get_all_ports {} {
440        global all_ports_cache
441       
442        if {![info exists all_ports_cache]} {
443                set all_ports_cache [get_matching_ports "*"]
444        }
445        return $all_ports_cache
446}
447
448
449proc get_current_ports {} {
450        # This is just a synonym for get_current_port that
451        # works with the regex in element
452        return [get_current_port]
453}
454
455
456proc get_current_port {} {
457        set url file://.
458        set portname [url_to_portname $url]
459        if {$portname == ""} {
460                fatal "To use the current port, you must be in a port's directory"
461        }
462       
463        set results {}
464        add_to_portlist results [list url $url name $portname]
465        return $results
466}
467
468
469proc get_installed_ports { {ignore_active yes} {active yes} } {
470        if { [catch {set ilist [registry::installed]} result] } {
471                if {$result == "Registry error: No ports registered as installed."} {
472                        fatal "No ports installed!"
473                } else {
474                        global errorInfo
475                        ui_debug "$errorInfo"
476                        fatal "port installed failed: $result"
477                }
478        }
479       
480        set results {}
481        foreach i $ilist {
482                set iname [lindex $i 0]
483                set iversion [lindex $i 1]
484                set irevision [lindex $i 2]
485                set ivariants [split_variants [lindex $i 3]]
486                set iactive [lindex $i 4]
487               
488                if { ${ignore_active} == "yes" || (${active} == "yes") == (${iactive} != 0) } {
489                        add_to_portlist results [list name $iname version "${iversion}_${irevision}" variants $ivariants]
490                }
491        }
492       
493        # Return the list of ports, sorted
494        return [portlist_sort $results]
495}
496
497
498proc get_uninstalled_ports {} {
499        # Return all - installed
500        set all [get_all_ports]
501        set installed [get_installed_ports]
502        return [opComplement $all $installed]
503}
504
505
506proc get_active_ports {} {
507        return [get_installed_ports no yes]
508}
509
510
511proc get_inactive_ports {} {
512        return [get_installed_ports no no]
513}
514
515
516proc get_outdated_ports {} {
517        # Get the list of install ports
518        if { [catch {set ilist [registry::installed]} result] } {
519                global errorInfo
520                ui_debug "$errorInfo"
521                fatal "can't get installed ports: $result"
522        }
523
524        # Now process the list, keeping only those ports that are outdated
525        set results {}
526        if { [llength $ilist] > 0 } {
527                foreach i $ilist {
528               
529                        # Get information about the installed port
530                        set portname                    [lindex $i 0]
531                        set installed_version   [lindex $i 1]
532                        set installed_revision  [lindex $i 2]
533                        set installed_compound  "${installed_version}_${installed_revision}"
534                        set installed_variants  [lindex $i 3]
535
536                        set is_active                   [lindex $i 4]
537                        if { $is_active == 0 } continue
538                        set installed_epoch             [lindex $i 5]
539
540                        # Get info about the port from the index
541                        if {[catch {set res [dportsearch $portname no exact]} result]} {
542                                global errorInfo
543                                ui_debug "$errorInfo"
544                                fatal "search for portname $portname failed: $result"
545                        }
546                        if {[llength $res] < 2} {
547                                if {[ui_isset ports_debug]} {
548                                        puts "$portname ($installed_compound is installed; the port was not found in the port index)"
549                                }
550                                continue
551                        }
552                        array set portinfo [lindex $res 1]
553                       
554                        # Get information about latest available version and revision
555                        set latest_version $portinfo(version)
556                        set latest_revision             0
557                        if {[info exists portinfo(revision)] && $portinfo(revision) > 0} { 
558                                set latest_revision     $portinfo(revision)
559                        }
560                        set latest_compound             "${latest_version}_${latest_revision}"
561                        set latest_epoch                0
562                        if {[info exists portinfo(epoch)]} { 
563                                set latest_epoch        $portinfo(epoch)
564                        }
565                       
566                        # Compare versions, first checking epoch, then the compound version string
567                        set comp_result [expr $installed_epoch - $latest_epoch]
568                        if { $comp_result == 0 } {
569                                set comp_result [rpm-vercomp $installed_compound $latest_compound]
570                        }
571                       
572                        # Add outdated ports to our results list
573                        if { $comp_result < 0 } {
574                                add_to_portlist results [list name $portname version $installed_compound variants [split_variants $installed_variants]]
575                        }
576                }
577        }
578
579        return $results
580}
581
582
583
584##########################################
585# Port expressions
586##########################################
587proc moreargs {} {
588        global argn argc
589        return [expr {$argn < $argc}]
590}
591
592proc lookahead {} {
593        global argn argc argv
594        if {$argn < $argc} {
595                return [lindex $argv $argn]
596        } else {
597                return _EOF_
598        }
599}
600
601
602proc advance {} {
603        global argn
604        incr argn
605}
606
607
608proc match s {
609        if {[lookahead] == $s} {
610                advance
611                return 1
612        }
613        return 0
614}
615
616
617proc portExpr resname {
618        upvar $resname reslist
619        set result [seqExpr reslist]
620        return $result
621}
622
623
624proc seqExpr resname {
625        upvar $resname reslist
626       
627        # Evaluate a sequence of expressions a b c...
628        # These act the same as a or b or c
629
630        set result 1
631        while {$result} {
632                switch -- [lookahead] {
633                        )               -
634                        _EOF_   { break }
635                }
636               
637                set blist {}
638                set result [orExpr blist]
639                if {$result} {
640                        # Calculate the union of result and b
641                        set reslist [opUnion $reslist $blist]
642                }
643        }
644       
645        return $result
646}
647
648
649proc orExpr resname {
650        upvar $resname reslist
651       
652        set a [andExpr reslist]
653        while ($a) {
654                switch -- [lookahead] {
655                        or {
656                                        advance
657                                        set blist {}
658                                        if {![andExpr blist]} {
659                                                return 0
660                                        }
661                                               
662                                        # Calculate a union b
663                                        set reslist [opUnion $reslist $blist]
664                                }
665                        default {
666                                        return $a
667                                }
668                }
669        }
670       
671        return $a
672}
673
674
675proc andExpr resname {
676        upvar $resname reslist
677       
678        set a [unaryExpr reslist]
679        while {$a} {
680                switch -- [lookahead] {
681                        and {
682                                        advance
683                                       
684                                        set blist {}
685                                        set b [unaryExpr blist]
686                                        if {!$b} {
687                                                return 0
688                                        }
689                                       
690                                        # Calculate a intersect b
691                                        set reslist [opIntersection $reslist $blist]
692                                }
693                        default {
694                                        return $a
695                                }
696                }
697        }
698       
699        return $a
700}
701
702
703proc unaryExpr resname {
704        upvar $resname reslist
705        set result 0
706
707        switch -- [lookahead] {
708                !       -
709                not     {
710                                advance
711                                set blist {}
712                                set result [unaryExpr blist]
713                                if {$result} {
714                                        set all [get_all_ports]
715                                        set reslist [opComplement $all $blist]
716                                }
717                        }
718                default {
719                                set result [element reslist]
720                        }
721        }
722       
723        return $result
724}
725
726
727proc element resname {
728        upvar $resname reslist
729        set el 0
730       
731        set name ""
732        set version ""
733        array unset variants
734        array unset options
735       
736        set token [lookahead]
737        switch -regex -- $token {
738                ^\\)$                   -
739                ^_EOF_$                 {       # End of file/expression
740                                                }
741               
742                ^\\($                   {       # Parenthesized Expression
743                                                        advance
744                                                        set el [portExpr reslist]
745                                                        if {!$el || ![match ")"]} {
746                                                                set el 0
747                                                        }
748                                                }
749                       
750                ^all(@.*)?$                     -
751                ^installed(@.*)?$               -
752                ^uninstalled(@.*)?$             -
753                ^active(@.*)?$                  -
754                ^inactive(@.*)?$                -
755                ^outdated(@.*)?$                -
756                ^current(@.*)?$ {
757                                                        # A simple pseudo-port name
758                                                        advance
759                                                       
760                                                        # Break off the version component, if there is one
761                                                        regexp {^(\w+)(@.*)?} $token matchvar name remainder
762                                                       
763                                                        add_multiple_ports reslist [get_${name}_ports] $remainder
764                                                       
765                                                        set el 1
766                                                }
767               
768                ^variants:              -
769                ^variant:               -
770                ^description:   -
771                ^portdir:               -
772                ^homepage:              -
773                ^epoch:                 -
774                ^platforms:             -
775                ^platform:              -
776                ^name:                  -
777                ^long_description:      -
778                ^maintainers:   -
779                ^maintainer:    -
780                ^categories:    -
781                ^category:              -
782                ^version:               -
783                ^revision:              {       # Handle special port selectors
784                                                        advance
785                                                       
786                                                        # Break up the token, because older Tcl switch doesn't support -matchvar
787                                                        regexp {^(\w+):(.*)} $token matchvar field pat
788                                                       
789                                                        # Remap friendly names to actual names
790                                                        switch -- $field {
791                                                                variant         -
792                                                                platform        -
793                                                                maintainer      { set field "${field}s" }
794                                                                category        { set field "categories" }
795                                                        }                                                       
796                                                        add_multiple_ports reslist [get_matching_ports $pat no regexp $field]
797                                                        set el 1
798                                                }
799                                               
800                [][?*]                  {       # Handle portname glob patterns
801                                                        advance; add_multiple_ports reslist [get_matching_ports $token no glob]
802                                                        set el 1
803                                                }
804                                               
805                ^\\w+:.+                {       # Handle a url by trying to open it as a port and mapping the name
806                                                        advance
807                                                        set name [url_to_portname $token]
808                                                        if {$name != ""} {
809                                                                parsePortSpec version variants options
810                                                                add_to_portlist reslist [list url $token \
811                                                                                                                        name $name\
812                                                                                                                        version $version \
813                                                                                                                        variants [array get variants] \
814                                                                                                                        options [array get options]]
815                                                        } else {
816                                                                fatal "Can't open URL '$token' as a port"
817                                                        }
818                                                        set el 1
819                                                }
820               
821                default                 {       # Treat anything else as a portspec (portname, version, variants, options
822                                                        # or some combination thereof).
823                                                        parseFullPortSpec name version variants options
824                                                        add_to_portlist reslist [list name $name \
825                                                                                                                version $version \
826                                                                                                                variants [array get variants] \
827                                                                                                                options [array get options]]
828                                                        set el 1
829                                                }
830        }
831       
832        return $el
833}
834
835
836proc add_multiple_ports { resname ports {remainder ""} } {
837        upvar $resname reslist
838       
839        set version ""
840        array unset variants
841        array unset options
842        parsePortSpec version variants options $remainder
843       
844        array unset overrides
845        if {$version != ""}                     { set overrides(version) $version }
846        if {[array size variants]}      { set overrides(variants) [array get variants] }
847        if {[array size options]}       { set overrides(options) [array get options] }
848
849        add_ports_to_portlist reslist $ports [array get overrides]
850}
851
852
853proc opUnion { a b } {
854        set result {}
855       
856        array unset onetime
857       
858        # Walk through each array, adding to result only those items that haven't
859        # been added before
860        foreach item $a {
861                array set port $item
862                if {[info exists onetime($port(fullname))]} continue
863                lappend result $item
864        }
865
866        foreach item $b {
867                array set port $item
868                if {[info exists onetime($port(fullname))]} continue
869                lappend result $item
870        }
871       
872        return $result
873}
874
875
876proc opIntersection { a b } {
877        set result {}
878       
879        # Rules we follow in performing the intersection of two port lists:
880        #
881        #       a/, a/                  ==> a/
882        #       a/, b/                  ==>
883        #       a/, a/1.0               ==> a/1.0
884        #       a/1.0, a/               ==> a/1.0
885        #       a/1.0, a/2.0    ==>
886        #
887        #       If there's an exact match, we take it.
888        #       If there's a match between simple and descriminated, we take the later.
889       
890        # First create a list of the fully descriminated names in b
891        array unset bfull
892        set i 0
893        foreach bitem $b {
894                array set port $bitem
895                set bfull($port(fullname)) $i
896                incr i
897        }
898       
899        # Walk through each item in a, matching against b
900        #
901        # Note: -regexp may not be present in all versions of Tcl we need to work
902        #               against, in which case we may have to fall back to a slower alternative
903        #               for those cases. I'm not worrying about that for now, however. -jdb
904        foreach aitem $a {
905                array set port $aitem
906               
907                # Quote the fullname and portname to avoid special characters messing up the regexp
908                set safefullname [regex_pat_sanitize $port(fullname)]
909               
910                set simpleform [expr { "$port(name)/" == $port(fullname) }]
911                if {$simpleform} {
912                        set pat "^${safefullname}"
913                } else {
914                        set safename [regex_pat_sanitize $port(name)]
915                        set pat "^${safefullname}$|^${safename}/$"
916                }
917               
918                set matches [array names bfull -regexp $pat]
919                foreach match $matches {
920                        if {$simpleform} {
921                                set i $bfull($match)
922                                lappend result [lindex $b $i]
923                        } else {
924                                lappend result $aitem
925                        }
926                }
927        }
928       
929        return $result
930}
931
932
933proc opComplement { a b } {
934        set result {}
935       
936        # Return all elements of a not matching elements in b
937       
938        # First create a list of the fully descriminated names in b
939        array unset bfull
940        set i 0
941        foreach bitem $b {
942                array set port $bitem
943                set bfull($port(fullname)) $i
944                incr i
945        }
946       
947        # Walk through each item in a, taking all those items that don't match b
948        #
949        # Note: -regexp may not be present in all versions of Tcl we need to work
950        #               against, in which case we may have to fall back to a slower alternative
951        #               for those cases. I'm not worrying about that for now, however. -jdb
952        foreach aitem $a {
953                array set port $aitem
954               
955                # Quote the fullname and portname to avoid special characters messing up the regexp
956                set safefullname [regex_pat_sanitize $port(fullname)]
957               
958                set simpleform [expr { "$port(name)/" == $port(fullname) }]
959                if {$simpleform} {
960                        set pat "^${safefullname}"
961                } else {
962                        set safename [regex_pat_sanitize $port(name)]
963                        set pat "^${safefullname}$|^${safename}/$"
964                }
965               
966                set matches [array names bfull -regexp $pat]
967
968                # We copy this element to result only if it didn't match against b
969                if {![llength $matches]} {
970                        lappend result $aitem
971                }
972        }
973       
974        return $result
975}
976
977
978proc parseFullPortSpec { namename vername varname optname } {
979        upvar $namename portname
980        upvar $vername portversion
981        upvar $varname portvariants
982        upvar $optname portoptions
983       
984        set portname ""
985        set portversion ""
986        array unset portvariants
987        array unset portoptions
988       
989        if { [moreargs] } {
990                # Look first for a potential portname
991                #
992                # We need to allow a wide variaty of tokens here, because of actions like "provides"
993                # so we take a rather lenient view of what a "portname" is. We allow
994                # anything that doesn't look like either a version, a variant, or an option
995                set token [lookahead]
996
997                set remainder ""
998                if {![regexp {^(@|[-+]|[[:alpha:]_]+[\w\.]*=)} $token match]} {
999                        advance                 
1000                        regexp {^([^@]+)(@.*)?} $token match portname remainder
1001                }
1002               
1003                # Now parse the rest of the spec
1004                parsePortSpec portversion portvariants portoptions $remainder
1005        }
1006}
1007
1008       
1009proc parsePortSpec { vername varname optname {remainder ""} } {
1010        upvar $vername portversion
1011        upvar $varname portvariants
1012        upvar $optname portoptions
1013       
1014        global global_options
1015       
1016        set portversion ""
1017        array unset portoptions
1018        array set portoptions [array get global_options]
1019        array unset portvariants
1020       
1021        # Parse port version/variants/options
1022        set opt $remainder
1023        set adv 0
1024        set consumed 0
1025        for {set firstTime 1} {$opt != "" || [moreargs]} {set firstTime 0} {
1026       
1027                # Refresh opt as needed
1028                if {$opt == ""} {
1029                        if {$adv} advance
1030                        set opt [lookahead]
1031                        set adv 1
1032                        set consumed 0
1033                }
1034               
1035                # Version must be first, if it's there at all
1036                if {$firstTime && [string match {@*} $opt]} {
1037                        # Parse the version
1038                       
1039                        # Strip the @
1040                        set opt [string range $opt 1 end]
1041                       
1042                        # Handle the version
1043                        set sepPos [string first "/" $opt]
1044                        if {$sepPos >= 0} {
1045                                # Version terminated by "/" to disambiguate -variant from part of version
1046                                set portversion [string range $opt 0 [expr $sepPos-1]]
1047                                set opt [string range $opt [expr $sepPos+1] end]
1048                        } else {
1049                                # Version terminated by "+", or else is complete
1050                                set sepPos [string first "+" $opt]
1051                                if {$sepPos >= 0} {
1052                                        # Version terminated by "+"
1053                                        set portversion [string range $opt 0 [expr $sepPos-1]]
1054                                        set opt [string range $opt $sepPos end]
1055                                } else {
1056                                        # Unterminated version
1057                                        set portversion $opt
1058                                        set opt ""
1059                                }
1060                        }
1061                        set consumed 1
1062                } else {
1063                        # Parse all other options
1064                       
1065                        # Look first for a variable setting: VARNAME=VALUE
1066                        if {[regexp {^([[:alpha:]_]+[\w\.]*)=(.*)} $opt match key val] == 1} {
1067                                # It's a variable setting
1068                                set portoptions($key) \"$val\"
1069                                set opt ""
1070                                set consumed 1
1071                        } elseif {[regexp {^([-+])([[:alpha:]_]+[\w\.]*)} $opt match sign variant] == 1} {
1072                                # It's a variant
1073                                set portvariants($variant) $sign
1074                                set opt [string range $opt [expr [string length $variant]+1] end]
1075                                set consumed 1
1076                        } else {
1077                                # Not an option we recognize, so break from port option processing
1078                                if { $consumed && $adv } advance
1079                                break
1080                        }
1081                }
1082        }
1083}
1084
1085
1086
1087##########################################
1088# Main
1089##########################################
1090
1091# Parse global options
1092while {[moreargs]} {
1093        set arg [lookahead]
1094       
1095        if {[string index $arg 0] != "-"} {
1096                break
1097        } elseif {[string index $arg 1] == "-"} {
1098                # Process long arguments
1099                switch -- $arg {
1100                        --version       { ui_warn "(please use \"$cmdname version\" to get version information)"; set action "version" }
1101                        default         { print_usage; exit 1 }
1102                }
1103        } else {
1104                # Process short arg(s)
1105                set opts [string range $arg 1 end]
1106                foreach c [split $opts {}] {
1107                        switch -- $c {
1108                                v {     set ui_options(ports_verbose) yes               }
1109                                d { set ui_options(ports_debug) yes
1110                                        # debug implies verbose
1111                                        set ui_options(ports_verbose) yes
1112                                  }
1113                                q { set ui_options(ports_quiet) yes
1114                                        set ui_options(ports_verbose) no
1115                                        set ui_options(ports_debug) no
1116                                  }
1117                                f { set global_options(ports_force) yes                 }
1118                                o { set global_options(ports_ignore_older) yes  }
1119                                n { set global_options(ports_nodeps) yes                }
1120                                R { set global_options(ports_do_dependents) yes }
1121                                u { set global_options(port_uninstall_old) yes  }
1122                                s { set global_options(ports_source_only) yes   }
1123                                b { set global_options(ports_binary_only) yes   }
1124                                c { set global_options(ports_autoclean) yes             }
1125                                k { set global_options(ports_autoclean) no              }
1126                                t { set global_options(ports_trace) yes                 }
1127                                D { advance
1128                                        cd [lookahead]
1129                                        break
1130                                  }
1131                                default {
1132                                        print_usage; exit 1
1133                                  }
1134                        }
1135                }
1136        }
1137       
1138        advance
1139}
1140
1141# Initialize dport
1142# This must be done following parse of global options, as these are
1143# evaluated by dportinit.
1144if {[catch {dportinit ui_options global_options global_variations} result]} {
1145        global errorInfo
1146        puts "$errorInfo"
1147        fatal "Failed to initialize ports system, $result"
1148}
1149
1150# Process an action if there is one
1151if {[moreargs]} {
1152        set action [lookahead]
1153        advance
1154       
1155        # Parse action options
1156        while {[moreargs]} {
1157                set arg [lookahead]
1158               
1159                if {[string index $arg 0] != "-"} {
1160                        break
1161                } elseif {[string index $arg 1] == "-"} {
1162                        # Process long options
1163                        set key [string range $arg 2 end]
1164                        set global_options(ports_${action}_${key}) yes
1165                } else {
1166                        # Process short options
1167                        # There are none for now
1168                        print_usage; exit 1
1169                }
1170               
1171                advance
1172        }
1173       
1174        # Parse port specifications into portlist
1175        if {![portExpr portlist]} {
1176                fatal "Improper expression syntax while processing parameters"
1177        }
1178}
1179
1180# If there's no action, just print the usage and be done
1181if {$action == ""} {
1182        print_usage
1183        exit 1
1184}
1185
1186# Perform the action
1187switch -- $action {
1188
1189        help {
1190                print_help
1191        }
1192
1193        info {
1194                require_portlist
1195                foreachport $portlist { 
1196                        # Get information about the named port
1197                        if {[catch {dportsearch $portname no exact} result]} {
1198                                global errorInfo
1199                                ui_debug "$errorInfo"
1200                                fatal_softcontinue "search for portname $portname failed: $result"
1201                        }
1202               
1203                        if {$result == ""} {
1204                                puts "No port $portname found."
1205                        } else {
1206                                set found [expr [llength $result] / 2]
1207                                if {$found > 1} {
1208                                        ui_warn "Found $found port $portname definitions, displaying first one."
1209                                }
1210                                array set portinfo [lindex $result 1]
1211       
1212                                puts -nonewline "$portinfo(name) $portinfo(version)"
1213                                if {[info exists portinfo(revision)] && $portinfo(revision) > 0} { 
1214                                        puts -nonewline ", Revision $portinfo(revision)" 
1215                                }
1216                                puts -nonewline ", $portinfo(portdir)" 
1217                                if {[info exists portinfo(variants)]} {
1218                                        puts -nonewline " (Variants: "
1219                                        for {set i 0} {$i < [llength $portinfo(variants)]} {incr i} {
1220                                                if {$i > 0} { puts -nonewline ", " }
1221                                                puts -nonewline "[lindex $portinfo(variants) $i]"
1222                                        }
1223                                        puts -nonewline ")"
1224                                }
1225                                puts ""
1226                                if {[info exists portinfo(homepage)]} { 
1227                                        puts "$portinfo(homepage)"
1228                                }
1229               
1230                                if {[info exists portinfo(long_description)]} {
1231                                        puts "\n$portinfo(long_description)\n"
1232                                }
1233       
1234                                # find build dependencies
1235                                if {[info exists portinfo(depends_build)]} {
1236                                        puts -nonewline "Build Dependencies: "
1237                                        for {set i 0} {$i < [llength $portinfo(depends_build)]} {incr i} {
1238                                                if {$i > 0} { puts -nonewline ", " }
1239                                                puts -nonewline "[lindex [split [lindex $portinfo(depends_build) $i] :] end]"
1240                                        }
1241                                        set nodeps false
1242                                        puts ""
1243                                }
1244               
1245                                # find library dependencies
1246                                if {[info exists portinfo(depends_lib)]} {
1247                                        puts -nonewline "Library Dependencies: "
1248                                        for {set i 0} {$i < [llength $portinfo(depends_lib)]} {incr i} {
1249                                                if {$i > 0} { puts -nonewline ", " }
1250                                                puts -nonewline "[lindex [split [lindex $portinfo(depends_lib) $i] :] end]"
1251                                        }
1252                                        set nodeps false
1253                                        puts ""
1254                                }
1255               
1256                                # find runtime dependencies
1257                                if {[info exists portinfo(depends_run)]} {
1258                                        puts -nonewline "Runtime Dependencies: "
1259                                        for {set i 0} {$i < [llength $portinfo(depends_run)]} {incr i} {
1260                                                if {$i > 0} { puts -nonewline ", " }
1261                                                puts -nonewline "[lindex [split [lindex $portinfo(depends_run) $i] :] end]"
1262                                        }
1263                                        set nodeps false
1264                                        puts ""
1265                                }
1266                                if {[info exists portinfo(platforms)]} { puts "Platforms: $portinfo(platforms)"}
1267                                if {[info exists portinfo(maintainers)]} { puts "Maintainers: $portinfo(maintainers)"}
1268                        }
1269                }
1270        }
1271       
1272        location {
1273                require_portlist
1274                foreachport $portlist {
1275                        if { [catch {set ilist [registry_installed $portname [composite_version $portversion [array get variations]]]} result] } {
1276                                global errorInfo
1277                                ui_debug "$errorInfo"
1278                                fatal_softcontinue "port location failed: $result"
1279                        } else {
1280                                set version [lindex $ilist 1]
1281                                set revision [lindex $ilist 2]
1282                                set     variants [lindex $ilist 3]
1283                        }
1284       
1285                        set ref [registry::open_entry $portname $version $revision $variants]
1286                        if { [string equal [registry::property_retrieve $ref installtype] "image"] } {
1287                                set imagedir [registry::property_retrieve $ref imagedir]
1288                                puts "Port $portname ${version}_${revision}${variants} is installed as an image in:"
1289                                puts $imagedir
1290                        } else {
1291                                fatal_softcontinue "Port $portname is not installed as an image."
1292                        }
1293                }
1294        }
1295       
1296        provides {
1297                # In this case, portname is going to be used for the filename... since
1298                # that is the first argument we expect... perhaps there is a better way
1299                # to do this?
1300                if { ![llength $portlist] } {
1301                        fatal "Please specify a filename to check which port provides that file."
1302                }
1303                foreachport $portlist {
1304                        set file [compat filenormalize $portname]
1305                        if {[file exists $file]} {
1306                                if {![file isdirectory $file]} {
1307                                        set port [registry::file_registered $file] 
1308                                        if { $port != 0 } {
1309                                                puts "$file is provided by: $port"
1310                                        } else {
1311                                                puts "$file is not provided by a DarwinPorts port."
1312                                        }
1313                                } else {
1314                                        puts "$file is a directory."
1315                                }
1316                        } else {
1317                                puts "$file does not exist."
1318                        }
1319                }
1320        }
1321       
1322        activate {
1323                require_portlist
1324                foreachport $portlist {
1325                        if { [catch {portimage::activate $portname [composite_version $portversion [array get variations]] [array get options]} result] } {
1326                                global errorInfo
1327                                ui_debug "$errorInfo"
1328                                fatal_softcontinue "port activate failed: $result"
1329                        }
1330                }
1331        }
1332       
1333        deactivate {
1334                require_portlist
1335                foreachport $portlist {
1336                        if { [catch {portimage::deactivate $portname [composite_version $portversion [array get variations]] [array get options]} result] } {
1337                                global errorInfo
1338                                ui_debug "$errorInfo"
1339                                fatal_softcontinue "port deactivate failed: $result"
1340                        }
1341                }
1342        }
1343       
1344        selfupdate {
1345                if { [catch {darwinports::selfupdate [array get global_options]} result ] } {
1346                        global errorInfo
1347                        ui_debug "$errorInfo"
1348                        fatal "selfupdate failed: $result"
1349                }
1350        }
1351
1352        dependents {
1353                require_portlist
1354
1355                foreachport $portlist {
1356                        registry::open_dep_map
1357                set deplist [registry::list_dependents $portname]
1358
1359                if { [llength $deplist] > 0 } {
1360                        set dl [list]
1361                        # Check the deps first
1362                        foreach dep $deplist {
1363                                set depport [lindex $dep 2]
1364                                ui_msg "$depport depends on $portname"
1365                                # xxx: Should look at making registry::installed return 0 or
1366                                # something instead  of erroring.
1367                                if { ![catch {set installed [registry::installed $depport]} res] } {
1368                                        if { [llength [registry::installed $depport]] > 0 } {
1369                                                lappend dl $depport
1370                                        }
1371                                        }
1372                                }
1373                } else {
1374                                ui_msg "$portname has no dependents!"
1375                        }
1376                }
1377        }
1378
1379        upgrade {
1380        # Otherwise if the user has supplied no ports we'll use the current port
1381                require_portlist
1382               
1383                foreachport $portlist {
1384                        # Merge global variations into the variations specified for this port
1385                        foreach { variation value } [array get global_variations] {
1386                                if { ![info exists variations($variation)] } {
1387                                        set variations($variation) $value
1388                                }
1389                        }
1390                       
1391                        darwinports::upgrade $portname "port:$portname" [array get variations] [array get options]
1392                }
1393    }
1394
1395        version {
1396                puts "Version: [darwinports::version]"
1397        }
1398
1399        compact {
1400                require_portlist
1401                foreachport $portlist {
1402                        if { [catch {portimage::compact $portname [composite_version $portversion [array get variations]]} result] } {
1403                                global errorInfo
1404                                ui_debug "$errorInfo"
1405                                fatal_softcontinue "port compact failed: $result"
1406                        }
1407                }
1408        }
1409       
1410        uncompact {
1411                require_portlist
1412                foreachport $portlist {
1413                        if { [catch {portimage::uncompact $portname [composite_version $portversion [array get variations]]} result] } {
1414                                global errorInfo
1415                                ui_debug "$errorInfo"
1416                                fatal_softcontinue "port uncompact failed: $result"
1417                        }
1418                }
1419        }
1420       
1421        uninstall {
1422                if {[info exists global_options(port_uninstall_old)]} {
1423                        # if -u then uninstall all inactive ports
1424                        # (union these to any other ports user has in the port list)
1425                        set portlist [opUnion $portlist [get_inactive_ports]]
1426                } else {
1427                        # Otherwise the user had better have supplied a portlist, or we'll default to the existing directory
1428                        require_portlist
1429                }
1430
1431                foreachport $portlist {
1432                        if { [catch {portuninstall::uninstall $portname [composite_version $portversion [array get variations]] [array get options]} result] } {
1433                                global errorInfo
1434                                ui_debug "$errorInfo"
1435                                fatal_softcontinue "port uninstall failed: $result"
1436                        }
1437                }
1438        }
1439       
1440        installed {
1441        if { [llength $portlist] } {
1442                        set ilist {}
1443                        foreachport $portlist {
1444                        set composite_version [composite_version $portversion [array get variations]]
1445                                if { [catch {set ilist [concat $ilist [registry::installed $portname $composite_version]]} result] } {
1446                                        if {[string match "* not registered as installed." $result]} {
1447                                                puts "Port $portname is not installed."
1448                                        } else {
1449                                                global errorInfo
1450                                                ui_debug "$errorInfo"
1451                                                fatal_softcontinue "port installed failed: $result"
1452                                        }
1453                                }
1454                        }
1455        } else {
1456            if { [catch {set ilist [registry::installed]} result] } {
1457                if {$result == "Registry error: No ports registered as installed."} {
1458                    puts "No ports are installed!"
1459                                        set ilist {}
1460                } else {
1461                                        global errorInfo
1462                                        ui_debug "$errorInfo"
1463                    fatal "port installed failed: $result"
1464                }
1465            }
1466        }
1467        if { [llength $ilist] > 0 } {
1468            puts "The following ports are currently installed:"
1469            foreach i $ilist {
1470                set iname [lindex $i 0]
1471                set iversion [lindex $i 1]
1472                set irevision [lindex $i 2]
1473                set ivariants [lindex $i 3]
1474                set iactive [lindex $i 4]
1475                if { $iactive == 0 } {
1476                    puts "  $iname @${iversion}_${irevision}${ivariants}"
1477                } elseif { $iactive == 1 } {
1478                    puts "  $iname @${iversion}_${irevision}${ivariants} (active)"
1479                }
1480            }
1481        } else {
1482            exit 1
1483        }
1484    }
1485
1486        outdated {
1487                # If port names were supplied, limit ourselves to those port, else check all installed ports
1488       if { [llength $portlist] } {
1489                        set ilist {}
1490                foreach portspec $portlist {
1491                        array set port $portspec
1492                        set portname $port(name)
1493                        set composite_version [composite_version $port(version) $port(variants)]
1494                                if { [catch {set ilist [concat $ilist [registry::installed $portname $composite_version]]} result] } {
1495                                        if {![string match "* not registered as installed." $result]} {
1496                                                global errorInfo
1497                                                ui_debug "$errorInfo"
1498                                                fatal_softcontinue "port outdated failed: $result"
1499                                        }
1500                                }
1501                        }
1502                } else {
1503                        if { [catch {set ilist [registry::installed]} result] } {
1504                                global errorInfo
1505                                ui_debug "$errorInfo"
1506                                fatal "port outdated failed: $result"
1507                        }
1508                }
1509       
1510                if { [llength $ilist] > 0 } {
1511                        puts "The following installed ports are outdated:"
1512               
1513                        foreach i $ilist { 
1514
1515                                # Get information about the installed port
1516                                set portname                    [lindex $i 0]
1517                                set installed_version   [lindex $i 1]
1518                                set installed_revision  [lindex $i 2]
1519                                set installed_compound  "${installed_version}_${installed_revision}"
1520
1521                                set is_active                   [lindex $i 4]
1522                                if { $is_active == 0 } {
1523                                        continue
1524                                }
1525                                set installed_epoch             [lindex $i 5]
1526
1527                                # Get info about the port from the index
1528                                if {[catch {set res [dportsearch $portname no exact]} result]} {
1529                                        global errorInfo
1530                                        ui_debug "$errorInfo"
1531                                        fatal_softcontinue "search for portname $portname failed: $result"
1532                                }
1533                                if {[llength $res] < 2} {
1534                                        if {[ui_isset ports_debug]} {
1535                                                puts "$portname ($installed_compound is installed; the port was not found in the port index)"
1536                                        }
1537                                        continue
1538                                }
1539                                array set portinfo [lindex $res 1]
1540                               
1541                                # Get information about latest available version and revision
1542                                set latest_version $portinfo(version)
1543                                set latest_revision             0
1544                                if {[info exists portinfo(revision)] && $portinfo(revision) > 0} { 
1545                                        set latest_revision     $portinfo(revision)
1546                                }
1547                                set latest_compound             "${latest_version}_${latest_revision}"
1548                                set latest_epoch                0
1549                                if {[info exists portinfo(epoch)]} { 
1550                                        set latest_epoch        $portinfo(epoch)
1551                                }
1552                               
1553                                # Compare versions, first checking epoch, then the compound version string
1554                                set comp_result [expr $installed_epoch - $latest_epoch]
1555                                if { $comp_result == 0 } {
1556                                        set comp_result [rpm-vercomp $installed_compound $latest_compound]
1557                                }
1558                               
1559                                # Report outdated (or, for verbose, predated) versions
1560                                if { $comp_result != 0 } {
1561                                                               
1562                                        # Form a relation between the versions
1563                                        set flag ""
1564                                        if { $comp_result > 0 } {
1565                                                set relation ">"
1566                                                set flag "!"
1567                                        } else {
1568                                                set relation "<"
1569                                        }
1570                                       
1571                                        # Emit information
1572                                        if {$comp_result < 0 || [ui_isset ports_verbose]} {
1573                                                puts [format "%-30s %-24s %1s" $portname "$installed_compound $relation $latest_compound" $flag]
1574                                        }
1575                                       
1576                                }
1577                        }
1578                } else {
1579                        exit 1
1580                }
1581        }
1582
1583        contents {
1584                require_portlist
1585                foreachport $portlist {
1586                        set files [registry::port_registered $portname]
1587                        if { $files != 0 } {
1588                                if { [llength $files] > 0 } {
1589                                        puts "Port $portname contains:"
1590                                        foreach file $files {
1591                                                puts "  $file"
1592                                        }
1593                                } else {
1594                                        puts "Port $portname does not contain any file or is not active."
1595                                }
1596                        } else {
1597                                puts "Port $portname is not installed."
1598                        }
1599                }
1600        }
1601       
1602        deps {
1603                require_portlist
1604                foreachport $portlist {
1605                        # Get info about the port
1606                        if {[catch {dportsearch $portname no exact} result]} {
1607                                global errorInfo
1608                                ui_debug "$errorInfo"
1609                                fatal_softcontinue "search for portname $portname failed: $result"
1610                        }
1611       
1612                        if {$result == ""} {
1613                                fatal "No port $portname found."
1614                        }
1615       
1616                        array set portinfo [lindex $result 1]
1617       
1618                        set depstypes {depends_build depends_lib depends_run}
1619                        set depstypes_descr {"build" "library" "runtime"}
1620       
1621                        set nodeps true
1622                        foreach depstype $depstypes depsdecr $depstypes_descr {
1623                                if {[info exists portinfo($depstype)] &&
1624                                        $portinfo($depstype) != ""} {
1625                                        puts "$portname has $depsdecr dependencies on:"
1626                                        foreach i $portinfo($depstype) {
1627                                                puts "\t[lindex [split [lindex $i 0] :] end]"
1628                                        }
1629                                        set nodeps false
1630                                }
1631                        }
1632                       
1633                        # no dependencies found
1634                        if {$nodeps == "true"} {
1635                                puts "$portname has no dependencies"
1636                        }
1637                }
1638        }
1639       
1640        variants {
1641                require_portlist
1642                foreachport $portlist {
1643                        # search for port
1644                        if {[catch {dportsearch $portname no exact} result]} {
1645                                global errorInfo
1646                                ui_debug "$errorInfo"
1647                                fatal_softcontinue "search for portname $portname failed: $result"
1648                        }
1649               
1650                        if {$result == ""} {
1651                                puts "No port $portname found."
1652                        }
1653               
1654                        array set portinfo [lindex $result 1]
1655               
1656                        # if this fails the port doesn't have any variants
1657                        if {![info exists portinfo(variants)]} {
1658                                puts "$portname has no variants"
1659                        } else {
1660                                # print out all the variants
1661                                puts "$portname has the variants:"
1662                                for {set i 0} {$i < [llength $portinfo(variants)]} {incr i} {
1663                                        puts "\t[lindex $portinfo(variants) $i]"
1664                                }
1665                        }
1666                }
1667        }
1668       
1669        search {
1670                if {![llength portlist]} {
1671                        fatal "You must specify a search pattern"
1672                }
1673               
1674                foreachport $portlist {
1675                        if {[catch {set res [dportsearch $portname no]} result]} {
1676                                global errorInfo
1677                                ui_debug "$errorInfo"
1678                                fatal_softcontinue "search for portname $portname failed: $result"
1679                        }
1680                        foreach {name array} $res {
1681                                array set portinfo $array
1682       
1683                                # XXX is this the right place to verify an entry?
1684                                if {![info exists portinfo(name)]} {
1685                                        puts "Invalid port entry, missing portname"
1686                                        continue
1687                                }
1688                                if {![info exists portinfo(description)]} {
1689                                        puts "Invalid port entry for $portinfo(name), missing description"
1690                                        continue
1691                                }
1692                                if {![info exists portinfo(version)]} {
1693                                        puts "Invalid port entry for $portinfo(name), missing version"
1694                                        continue
1695                                }
1696                                if {![info exists portinfo(portdir)]} {
1697                                        set output [format "%-30s @%-12s %s" $portinfo(name) $portinfo(version) $portinfo(description)]
1698                                } else {
1699                                        set output [format "%-30s %-14s @%-12s %s" $portinfo(name) $portinfo(portdir) $portinfo(version) $portinfo(description)]
1700                                }
1701                                set portfound 1
1702                                puts $output
1703                                unset portinfo
1704                        }
1705                        if {![info exists portfound] || $portfound == 0} {
1706                                fatal "No match for $portname found"
1707                        }
1708                }
1709        }
1710       
1711        list {
1712                # Default to list all ports if no portnames are supplied
1713                if {![llength $portlist]} {
1714                        add_to_portlist portlist [list name "-all-"]
1715                }
1716               
1717                foreachport $portlist {
1718                        if {$portname == "-all-"} {
1719                                set search_string ".+"
1720                        } else {
1721                                set search_string [regex_pat_sanitize $portname]
1722                        }
1723                       
1724                        if {[catch {set res [dportsearch ^$search_string\$ no]} result]} {
1725                                global errorInfo
1726                                ui_debug "$errorInfo"
1727                                fatal_softcontinue "search for portname $search_string failed: $result"
1728                        }
1729
1730                        foreach {name array} $res {
1731                                array set portinfo $array
1732                                set outdir ""
1733                                if {[info exists portinfo(portdir)]} {
1734                                        set outdir $portinfo(portdir)
1735                                }
1736                                puts [format "%-30s @%-14s %s" $portinfo(name) $portinfo(version) $outdir]
1737                        }
1738                }
1739        }
1740       
1741        echo {
1742                # Simply echo back the port specs given to this command
1743                foreachport $portlist {
1744                        set opts {}
1745                        foreach { key value } [array get options] {
1746                                lappend opts "$key=$value"
1747                        }
1748                       
1749                        set composite_version [composite_version $portversion [array get variations] 1]
1750                        if { $composite_version != "" } {
1751                                set ver_field "@$composite_version"
1752                        } else {
1753                                set ver_field ""
1754                        }
1755                        puts [format "%-30s %s %s" $portname $ver_field  [join $opts " "]]
1756                }
1757        }
1758       
1759        ed - edit -
1760        cat -
1761        dir -
1762        url -
1763        file {
1764                # Operations on the port's directory and Portfile
1765                require_portlist
1766                foreachport $portlist {
1767                        # If we have a url, use that, since it's most specific
1768                        # otherwise try to map the portname to a url
1769                        if {$porturl == ""} {
1770                                # Verify the portname, getting portinfo to map to a porturl
1771                                if {[catch {set res [dportsearch $portname no exact]} result]} {
1772                                        global errorInfo
1773                                        ui_debug "$errorInfo"
1774                                        fatal_softcontinue "search for portname $portname failed: $result"
1775                                }
1776                                if {[llength $res] < 2} {
1777                                        fatal_softcontinue "Port $portname not found"
1778                                }
1779                                array set portinfo [lindex $res 1]
1780                                set porturl $portinfo(porturl)
1781                        }
1782                       
1783                        set portdir [file normalize [darwinports::getportdir $porturl]]
1784                        set porturl "file://${portdir}";        # Rebuild url so it's fully qualified
1785                        set portfile "${portdir}/Portfile"
1786                       
1787                        if {[file readable $portfile]} {
1788                                switch -- $action {
1789                                        cat     {
1790                                                # Copy the portfile to standard output
1791                                                set f [open $portfile RDONLY]
1792                                                while { ![eof $f] } {
1793                                                        puts [read $f 4096]
1794                                                }
1795                                                close $f
1796                                        }
1797                                       
1798                                        ed - edit {
1799                                                # Edit the port's portfile with the user's editor
1800                                               
1801                                                # Restore our entire environment from start time.
1802                                                # We need it to evaluate the editor, and the editor
1803                                                # may want stuff from it as well, like TERM.
1804                                                array unset env_save; array set env_save [array get env]
1805                                                array unset env *; array set env [array get boot_env]
1806                                               
1807                                                # Find an editor to edit the portfile
1808                                                set editor ""
1809                                                foreach ed { VISUAL EDITOR } {
1810                                                        if {[info exists env($ed)]} {
1811                                                                set editor $env($ed)
1812                                                                break
1813                                                        }
1814                                                }
1815                                               
1816                                                # Invoke the editor
1817                                                if { $editor == "" } {
1818                                                        fatal "No EDITOR is specified in your environment"
1819                                                } else {
1820                                                        if {[catch {eval exec >/dev/stdout </dev/stdin $editor $portfile} result]} {
1821                                                                global errorInfo
1822                                                                ui_debug "$errorInfo"
1823                                                                fatal "unable to invoke editor $editor: $result"
1824                                                        }
1825                                                }
1826                                               
1827                                                # Restore internal dp environment
1828                                                array unset env *; array set env [array get env_save]
1829                                        }
1830                                       
1831                                        dir {
1832                                                # output the path to the port's directory
1833                                                puts $portdir
1834                                        }
1835
1836                                        url {
1837                                                # output the url of the port's directory, suitable to feed back in later as a port descriptor
1838                                                puts $porturl
1839                                        }
1840
1841                                        file {
1842                                                # output the path to the port's portfile
1843                                                puts $portfile
1844                                        }
1845                                }
1846                        } else {
1847                                fatal_softcontinue "Could not read $portfile"
1848                        }
1849                }
1850        }
1851       
1852        sync {
1853                if {[catch {dportsync} result]} {
1854                        global errorInfo
1855                        ui_debug "$errorInfo"
1856                        fatal "port sync failed: $result"
1857                }
1858        }
1859       
1860        default {
1861                require_portlist
1862                foreachport $portlist {
1863                        set target $action
1864
1865                        # If we have a url, use that, since it's most specific
1866                        # otherwise try to map the portname to a url
1867                        if {$porturl == ""} {
1868                                # Verify the portname, getting portinfo to map to a porturl
1869                                if {[catch {set res [dportsearch $portname no exact]} result]} {
1870                                        global errorInfo
1871                                        ui_debug "$errorInfo"
1872                                        fatal_softcontinue "search for portname $portname failed: $result"
1873                                }
1874                                if {[llength $res] < 2} {
1875                                        fatal_softcontinue "Port $portname not found"
1876                                }
1877                                array set portinfo [lindex $res 1]
1878                                set porturl $portinfo(porturl)
1879                        }
1880                       
1881                        # If this is the install target, add any global_variations to the variations
1882                        # specified for the port
1883                        if { $target == "install" } {
1884                                foreach { variation value } [array get global_variations] {
1885                                        if { ![info exists variations($variation)] } {
1886                                                set variations($variation) $value
1887                                        }
1888                                }
1889                        }
1890
1891                        # If version was specified, save it as a version glob for use
1892                        # in port actions (e.g. clean).
1893                        if {[string length $portversion]} {
1894                                set options(ports_version_glob) $portversion
1895                        }
1896                        if {[catch {set workername [dportopen $porturl [array get options] [array get variations]]} result]} {
1897                                global errorInfo
1898                                ui_debug "$errorInfo"
1899                                fatal_softcontinue "Unable to open port: $result"
1900                        }
1901                        if {[catch {set result [dportexec $workername $target]} result]} {
1902                                global errorInfo
1903                                dportclose $workername
1904                                ui_debug "$errorInfo"
1905                                fatal_softcontinue "Unable to execute port: $result"
1906                        }
1907
1908                        dportclose $workername
1909                       
1910                        # Process any error that wasn't thrown and handled already
1911                        if {$result} {
1912                                fatal_softcontinue "Status $result encountered during processing."
1913                        }
1914                }
1915        }
1916}
1917
1918
Note: See TracBrowser for help on using the repository browser.