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

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

Bug:
Submitted by:
Reviewed by:
Approved by: jmpp@
Obtained from:
Removal of -a

  • removed from port.tcl
  • removed from port(1)
  • Property svn:eol-style set to native
  • Property svn:executable set to *
File size: 48.7 KB
Line 
1#!/bin/sh
2#\
3exec @TCLSH@ "$0" "$@"
4# port.tcl
5# $Id: port.tcl,v 1.145 2006/01/01 15:24:48 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 { [-vdqfonsbcktu] [-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 { [-vdqfonsbcktu] [-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        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                                u { set global_options(port_uninstall_old) yes  }
1121                                s { set global_options(ports_source_only) yes   }
1122                                b { set global_options(ports_binary_only) yes   }
1123                                c { set global_options(ports_autoclean) yes             }
1124                                k { set global_options(ports_autoclean) no              }
1125                                t { set global_options(ports_trace) yes                 }
1126                                D { advance
1127                                        cd [lookahead]
1128                                        break
1129                                  }
1130                                default {
1131                                        print_usage; exit 1
1132                                  }
1133                        }
1134                }
1135        }
1136       
1137        advance
1138}
1139
1140# Initialize dport
1141# This must be done following parse of global options, as these are
1142# evaluated by dportinit.
1143if {[catch {dportinit ui_options global_options global_variations} result]} {
1144        global errorInfo
1145        puts "$errorInfo"
1146        fatal "Failed to initialize ports system, $result"
1147}
1148
1149# Process an action if there is one
1150if {[moreargs]} {
1151        set action [lookahead]
1152        advance
1153       
1154        # Parse action options
1155        while {[moreargs]} {
1156                set arg [lookahead]
1157               
1158                if {[string index $arg 0] != "-"} {
1159                        break
1160                } elseif {[string index $arg 1] == "-"} {
1161                        # Process long options
1162                        set key [string range $arg 2 end]
1163                        set global_options(ports_${action}_${key}) yes
1164                } else {
1165                        # Process short options
1166                        # There are none for now
1167                        print_usage; exit 1
1168                }
1169               
1170                advance
1171        }
1172       
1173        # Parse port specifications into portlist
1174        if {![portExpr portlist]} {
1175                fatal "Improper expression syntax while processing parameters"
1176        }
1177}
1178
1179# If there's no action, just print the usage and be done
1180if {$action == ""} {
1181        print_usage
1182        exit 1
1183}
1184
1185# Perform the action
1186switch -- $action {
1187
1188        help {
1189                print_help
1190        }
1191
1192        info {
1193                require_portlist
1194                foreachport $portlist { 
1195                        # Get information about the named port
1196                        if {[catch {dportsearch $portname no exact} result]} {
1197                                global errorInfo
1198                                ui_debug "$errorInfo"
1199                                fatal_softcontinue "search for portname $portname failed: $result"
1200                        }
1201               
1202                        if {$result == ""} {
1203                                puts "No port $portname found."
1204                        } else {
1205                                set found [expr [llength $result] / 2]
1206                                if {$found > 1} {
1207                                        ui_warn "Found $found port $portname definitions, displaying first one."
1208                                }
1209                                array set portinfo [lindex $result 1]
1210       
1211                                puts -nonewline "$portinfo(name) $portinfo(version)"
1212                                if {[info exists portinfo(revision)] && $portinfo(revision) > 0} { 
1213                                        puts -nonewline ", Revision $portinfo(revision)" 
1214                                }
1215                                puts -nonewline ", $portinfo(portdir)" 
1216                                if {[info exists portinfo(variants)]} {
1217                                        puts -nonewline " (Variants: "
1218                                        for {set i 0} {$i < [llength $portinfo(variants)]} {incr i} {
1219                                                if {$i > 0} { puts -nonewline ", " }
1220                                                puts -nonewline "[lindex $portinfo(variants) $i]"
1221                                        }
1222                                        puts -nonewline ")"
1223                                }
1224                                puts ""
1225                                if {[info exists portinfo(homepage)]} { 
1226                                        puts "$portinfo(homepage)"
1227                                }
1228               
1229                                if {[info exists portinfo(long_description)]} {
1230                                        puts "\n$portinfo(long_description)\n"
1231                                }
1232       
1233                                # find build dependencies
1234                                if {[info exists portinfo(depends_build)]} {
1235                                        puts -nonewline "Build Dependencies: "
1236                                        for {set i 0} {$i < [llength $portinfo(depends_build)]} {incr i} {
1237                                                if {$i > 0} { puts -nonewline ", " }
1238                                                puts -nonewline "[lindex [split [lindex $portinfo(depends_build) $i] :] end]"
1239                                        }
1240                                        set nodeps false
1241                                        puts ""
1242                                }
1243               
1244                                # find library dependencies
1245                                if {[info exists portinfo(depends_lib)]} {
1246                                        puts -nonewline "Library Dependencies: "
1247                                        for {set i 0} {$i < [llength $portinfo(depends_lib)]} {incr i} {
1248                                                if {$i > 0} { puts -nonewline ", " }
1249                                                puts -nonewline "[lindex [split [lindex $portinfo(depends_lib) $i] :] end]"
1250                                        }
1251                                        set nodeps false
1252                                        puts ""
1253                                }
1254               
1255                                # find runtime dependencies
1256                                if {[info exists portinfo(depends_run)]} {
1257                                        puts -nonewline "Runtime Dependencies: "
1258                                        for {set i 0} {$i < [llength $portinfo(depends_run)]} {incr i} {
1259                                                if {$i > 0} { puts -nonewline ", " }
1260                                                puts -nonewline "[lindex [split [lindex $portinfo(depends_run) $i] :] end]"
1261                                        }
1262                                        set nodeps false
1263                                        puts ""
1264                                }
1265                                if {[info exists portinfo(platforms)]} { puts "Platforms: $portinfo(platforms)"}
1266                                if {[info exists portinfo(maintainers)]} { puts "Maintainers: $portinfo(maintainers)"}
1267                        }
1268                }
1269        }
1270       
1271        location {
1272                require_portlist
1273                foreachport $portlist {
1274                        if { [catch {set ilist [registry_installed $portname [composite_version $portversion [array get variations]]]} result] } {
1275                                global errorInfo
1276                                ui_debug "$errorInfo"
1277                                fatal_softcontinue "port location failed: $result"
1278                        } else {
1279                                set version [lindex $ilist 1]
1280                                set revision [lindex $ilist 2]
1281                                set     variants [lindex $ilist 3]
1282                        }
1283       
1284                        set ref [registry::open_entry $portname $version $revision $variants]
1285                        if { [string equal [registry::property_retrieve $ref installtype] "image"] } {
1286                                set imagedir [registry::property_retrieve $ref imagedir]
1287                                puts "Port $portname ${version}_${revision}${variants} is installed as an image in:"
1288                                puts $imagedir
1289                        } else {
1290                                fatal_softcontinue "Port $portname is not installed as an image."
1291                        }
1292                }
1293        }
1294       
1295        provides {
1296                # In this case, portname is going to be used for the filename... since
1297                # that is the first argument we expect... perhaps there is a better way
1298                # to do this?
1299                if { ![llength $portlist] } {
1300                        fatal "Please specify a filename to check which port provides that file."
1301                }
1302                foreachport $portlist {
1303                        set file [compat filenormalize $portname]
1304                        if {[file exists $file]} {
1305                                if {![file isdirectory $file]} {
1306                                        set port [registry::file_registered $file] 
1307                                        if { $port != 0 } {
1308                                                puts "$file is provided by: $port"
1309                                        } else {
1310                                                puts "$file is not provided by a DarwinPorts port."
1311                                        }
1312                                } else {
1313                                        puts "$file is a directory."
1314                                }
1315                        } else {
1316                                puts "$file does not exist."
1317                        }
1318                }
1319        }
1320       
1321        activate {
1322                require_portlist
1323                foreachport $portlist {
1324                        if { [catch {portimage::activate $portname [composite_version $portversion [array get variations]] [array get options]} result] } {
1325                                global errorInfo
1326                                ui_debug "$errorInfo"
1327                                fatal_softcontinue "port activate failed: $result"
1328                        }
1329                }
1330        }
1331       
1332        deactivate {
1333                require_portlist
1334                foreachport $portlist {
1335                        if { [catch {portimage::deactivate $portname [composite_version $portversion [array get variations]] [array get options]} result] } {
1336                                global errorInfo
1337                                ui_debug "$errorInfo"
1338                                fatal_softcontinue "port deactivate failed: $result"
1339                        }
1340                }
1341        }
1342       
1343        selfupdate {
1344                if { [catch {darwinports::selfupdate [array get global_options]} result ] } {
1345                        global errorInfo
1346                        ui_debug "$errorInfo"
1347                        fatal "selfupdate failed: $result"
1348                }
1349        }
1350       
1351        upgrade {
1352        # Otherwise if the user has supplied no ports we'll use the current port
1353                require_portlist
1354               
1355                foreachport $portlist {
1356                        # Merge global variations into the variations specified for this port
1357                        foreach { variation value } [array get global_variations] {
1358                                if { ![info exists variations($variation)] } {
1359                                        set variations($variation) $value
1360                                }
1361                        }
1362                       
1363                        darwinports::upgrade $portname "port:$portname" [array get variations] [array get options]
1364                }
1365    }
1366
1367        version {
1368                puts "Version: [darwinports::version]"
1369        }
1370
1371        compact {
1372                require_portlist
1373                foreachport $portlist {
1374                        if { [catch {portimage::compact $portname [composite_version $portversion [array get variations]]} result] } {
1375                                global errorInfo
1376                                ui_debug "$errorInfo"
1377                                fatal_softcontinue "port compact failed: $result"
1378                        }
1379                }
1380        }
1381       
1382        uncompact {
1383                require_portlist
1384                foreachport $portlist {
1385                        if { [catch {portimage::uncompact $portname [composite_version $portversion [array get variations]]} result] } {
1386                                global errorInfo
1387                                ui_debug "$errorInfo"
1388                                fatal_softcontinue "port uncompact failed: $result"
1389                        }
1390                }
1391        }
1392       
1393        uninstall {
1394                if {[info exists global_options(port_uninstall_old)]} {
1395                        # if -u then uninstall all inactive ports
1396                        # (union these to any other ports user has in the port list)
1397                        set portlist [opUnion $portlist [get_inactive_ports]]
1398                } else {
1399                        # Otherwise the user had better have supplied a portlist, or we'll default to the existing directory
1400                        require_portlist
1401                }
1402
1403                foreachport $portlist {
1404                        if { [catch {portuninstall::uninstall $portname [composite_version $portversion [array get variations]] [array get options]} result] } {
1405                                global errorInfo
1406                                ui_debug "$errorInfo"
1407                                fatal_softcontinue "port uninstall failed: $result"
1408                        }
1409                }
1410        }
1411       
1412        installed {
1413        if { [llength $portlist] } {
1414                        set ilist {}
1415                        foreachport $portlist {
1416                        set composite_version [composite_version $portversion [array get variations]]
1417                                if { [catch {set ilist [concat $ilist [registry::installed $portname $composite_version]]} result] } {
1418                                        if {[string match "* not registered as installed." $result]} {
1419                                                puts "Port $portname is not installed."
1420                                        } else {
1421                                                global errorInfo
1422                                                ui_debug "$errorInfo"
1423                                                fatal_softcontinue "port installed failed: $result"
1424                                        }
1425                                }
1426                        }
1427        } else {
1428            if { [catch {set ilist [registry::installed]} result] } {
1429                if {$result == "Registry error: No ports registered as installed."} {
1430                    puts "No ports are installed!"
1431                                        set ilist {}
1432                } else {
1433                                        global errorInfo
1434                                        ui_debug "$errorInfo"
1435                    fatal "port installed failed: $result"
1436                }
1437            }
1438        }
1439        if { [llength $ilist] > 0 } {
1440            puts "The following ports are currently installed:"
1441            foreach i $ilist {
1442                set iname [lindex $i 0]
1443                set iversion [lindex $i 1]
1444                set irevision [lindex $i 2]
1445                set ivariants [lindex $i 3]
1446                set iactive [lindex $i 4]
1447                if { $iactive == 0 } {
1448                    puts "  $iname @${iversion}_${irevision}${ivariants}"
1449                } elseif { $iactive == 1 } {
1450                    puts "  $iname @${iversion}_${irevision}${ivariants} (active)"
1451                }
1452            }
1453        } else {
1454            exit 1
1455        }
1456    }
1457
1458        outdated {
1459                # If port names were supplied, limit ourselves to those port, else check all installed ports
1460       if { [llength $portlist] } {
1461                        set ilist {}
1462                foreach portspec $portlist {
1463                        array set port $portspec
1464                        set portname $port(name)
1465                        set composite_version [composite_version $port(version) $port(variants)]
1466                                if { [catch {set ilist [concat $ilist [registry::installed $portname $composite_version]]} result] } {
1467                                        if {![string match "* not registered as installed." $result]} {
1468                                                global errorInfo
1469                                                ui_debug "$errorInfo"
1470                                                fatal_softcontinue "port outdated failed: $result"
1471                                        }
1472                                }
1473                        }
1474                } else {
1475                        if { [catch {set ilist [registry::installed]} result] } {
1476                                global errorInfo
1477                                ui_debug "$errorInfo"
1478                                fatal "port outdated failed: $result"
1479                        }
1480                }
1481       
1482                if { [llength $ilist] > 0 } {
1483                        puts "The following installed ports are outdated:"
1484               
1485                        foreach i $ilist { 
1486
1487                                # Get information about the installed port
1488                                set portname                    [lindex $i 0]
1489                                set installed_version   [lindex $i 1]
1490                                set installed_revision  [lindex $i 2]
1491                                set installed_compound  "${installed_version}_${installed_revision}"
1492
1493                                set is_active                   [lindex $i 4]
1494                                if { $is_active == 0 } {
1495                                        continue
1496                                }
1497                                set installed_epoch             [lindex $i 5]
1498
1499                                # Get info about the port from the index
1500                                if {[catch {set res [dportsearch $portname no exact]} result]} {
1501                                        global errorInfo
1502                                        ui_debug "$errorInfo"
1503                                        fatal_softcontinue "search for portname $portname failed: $result"
1504                                }
1505                                if {[llength $res] < 2} {
1506                                        if {[ui_isset ports_debug]} {
1507                                                puts "$portname ($installed_compound is installed; the port was not found in the port index)"
1508                                        }
1509                                        continue
1510                                }
1511                                array set portinfo [lindex $res 1]
1512                               
1513                                # Get information about latest available version and revision
1514                                set latest_version $portinfo(version)
1515                                set latest_revision             0
1516                                if {[info exists portinfo(revision)] && $portinfo(revision) > 0} { 
1517                                        set latest_revision     $portinfo(revision)
1518                                }
1519                                set latest_compound             "${latest_version}_${latest_revision}"
1520                                set latest_epoch                0
1521                                if {[info exists portinfo(epoch)]} { 
1522                                        set latest_epoch        $portinfo(epoch)
1523                                }
1524                               
1525                                # Compare versions, first checking epoch, then the compound version string
1526                                set comp_result [expr $installed_epoch - $latest_epoch]
1527                                if { $comp_result == 0 } {
1528                                        set comp_result [rpm-vercomp $installed_compound $latest_compound]
1529                                }
1530                               
1531                                # Report outdated (or, for verbose, predated) versions
1532                                if { $comp_result != 0 } {
1533                                                               
1534                                        # Form a relation between the versions
1535                                        set flag ""
1536                                        if { $comp_result > 0 } {
1537                                                set relation ">"
1538                                                set flag "!"
1539                                        } else {
1540                                                set relation "<"
1541                                        }
1542                                       
1543                                        # Emit information
1544                                        if {$comp_result < 0 || [ui_isset ports_verbose]} {
1545                                                puts [format "%-30s %-24s %1s" $portname "$installed_compound $relation $latest_compound" $flag]
1546                                        }
1547                                       
1548                                }
1549                        }
1550                } else {
1551                        exit 1
1552                }
1553        }
1554
1555        contents {
1556                require_portlist
1557                foreachport $portlist {
1558                        set files [registry::port_registered $portname]
1559                        if { $files != 0 } {
1560                                if { [llength $files] > 0 } {
1561                                        puts "Port $portname contains:"
1562                                        foreach file $files {
1563                                                puts "  $file"
1564                                        }
1565                                } else {
1566                                        puts "Port $portname does not contain any file or is not active."
1567                                }
1568                        } else {
1569                                puts "Port $portname is not installed."
1570                        }
1571                }
1572        }
1573       
1574        deps {
1575                require_portlist
1576                foreachport $portlist {
1577                        # Get info about the port
1578                        if {[catch {dportsearch $portname no exact} result]} {
1579                                global errorInfo
1580                                ui_debug "$errorInfo"
1581                                fatal_softcontinue "search for portname $portname failed: $result"
1582                        }
1583       
1584                        if {$result == ""} {
1585                                fatal "No port $portname found."
1586                        }
1587       
1588                        array set portinfo [lindex $result 1]
1589       
1590                        set depstypes {depends_build depends_lib depends_run}
1591                        set depstypes_descr {"build" "library" "runtime"}
1592       
1593                        set nodeps true
1594                        foreach depstype $depstypes depsdecr $depstypes_descr {
1595                                if {[info exists portinfo($depstype)] &&
1596                                        $portinfo($depstype) != ""} {
1597                                        puts "$portname has $depsdecr dependencies on:"
1598                                        foreach i $portinfo($depstype) {
1599                                                puts "\t[lindex [split [lindex $i 0] :] end]"
1600                                        }
1601                                        set nodeps false
1602                                }
1603                        }
1604                       
1605                        # no dependencies found
1606                        if {$nodeps == "true"} {
1607                                puts "$portname has no dependencies"
1608                        }
1609                }
1610        }
1611       
1612        variants {
1613                require_portlist
1614                foreachport $portlist {
1615                        # search for port
1616                        if {[catch {dportsearch $portname no exact} result]} {
1617                                global errorInfo
1618                                ui_debug "$errorInfo"
1619                                fatal_softcontinue "search for portname $portname failed: $result"
1620                        }
1621               
1622                        if {$result == ""} {
1623                                puts "No port $portname found."
1624                        }
1625               
1626                        array set portinfo [lindex $result 1]
1627               
1628                        # if this fails the port doesn't have any variants
1629                        if {![info exists portinfo(variants)]} {
1630                                puts "$portname has no variants"
1631                        } else {
1632                                # print out all the variants
1633                                puts "$portname has the variants:"
1634                                for {set i 0} {$i < [llength $portinfo(variants)]} {incr i} {
1635                                        puts "\t[lindex $portinfo(variants) $i]"
1636                                }
1637                        }
1638                }
1639        }
1640       
1641        search {
1642                if {![llength portlist]} {
1643                        fatal "You must specify a search pattern"
1644                }
1645               
1646                foreachport $portlist {
1647                        if {[catch {set res [dportsearch $portname no]} result]} {
1648                                global errorInfo
1649                                ui_debug "$errorInfo"
1650                                fatal_softcontinue "search for portname $portname failed: $result"
1651                        }
1652                        foreach {name array} $res {
1653                                array set portinfo $array
1654       
1655                                # XXX is this the right place to verify an entry?
1656                                if {![info exists portinfo(name)]} {
1657                                        puts "Invalid port entry, missing portname"
1658                                        continue
1659                                }
1660                                if {![info exists portinfo(description)]} {
1661                                        puts "Invalid port entry for $portinfo(name), missing description"
1662                                        continue
1663                                }
1664                                if {![info exists portinfo(version)]} {
1665                                        puts "Invalid port entry for $portinfo(name), missing version"
1666                                        continue
1667                                }
1668                                if {![info exists portinfo(portdir)]} {
1669                                        set output [format "%-30s @%-12s %s" $portinfo(name) $portinfo(version) $portinfo(description)]
1670                                } else {
1671                                        set output [format "%-30s %-14s @%-12s %s" $portinfo(name) $portinfo(portdir) $portinfo(version) $portinfo(description)]
1672                                }
1673                                set portfound 1
1674                                puts $output
1675                                unset portinfo
1676                        }
1677                        if {![info exists portfound] || $portfound == 0} {
1678                                fatal "No match for $portname found"
1679                        }
1680                }
1681        }
1682       
1683        list {
1684                # Default to list all ports if no portnames are supplied
1685                if {![llength $portlist]} {
1686                        add_to_portlist portlist [list name "-all-"]
1687                }
1688               
1689                foreachport $portlist {
1690                        if {$portname == "-all-"} {
1691                                set search_string ".+"
1692                        } else {
1693                                set search_string [regex_pat_sanitize $portname]
1694                        }
1695                       
1696                        if {[catch {set res [dportsearch ^$search_string\$ no]} result]} {
1697                                global errorInfo
1698                                ui_debug "$errorInfo"
1699                                fatal_softcontinue "search for portname $search_string failed: $result"
1700                        }
1701
1702                        foreach {name array} $res {
1703                                array set portinfo $array
1704                                set outdir ""
1705                                if {[info exists portinfo(portdir)]} {
1706                                        set outdir $portinfo(portdir)
1707                                }
1708                                puts [format "%-30s @%-14s %s" $portinfo(name) $portinfo(version) $outdir]
1709                        }
1710                }
1711        }
1712       
1713        echo {
1714                # Simply echo back the port specs given to this command
1715                foreachport $portlist {
1716                        set opts {}
1717                        foreach { key value } [array get options] {
1718                                lappend opts "$key=$value"
1719                        }
1720                       
1721                        set composite_version [composite_version $portversion [array get variations] 1]
1722                        if { $composite_version != "" } {
1723                                set ver_field "@$composite_version"
1724                        } else {
1725                                set ver_field ""
1726                        }
1727                        puts [format "%-30s %s %s" $portname $ver_field  [join $opts " "]]
1728                }
1729        }
1730       
1731        ed - edit -
1732        cat -
1733        dir -
1734        url -
1735        file {
1736                # Operations on the port's directory and Portfile
1737                require_portlist
1738                foreachport $portlist {
1739                        # If we have a url, use that, since it's most specific
1740                        # otherwise try to map the portname to a url
1741                        if {$porturl == ""} {
1742                                # Verify the portname, getting portinfo to map to a porturl
1743                                if {[catch {set res [dportsearch $portname no exact]} result]} {
1744                                        global errorInfo
1745                                        ui_debug "$errorInfo"
1746                                        fatal_softcontinue "search for portname $portname failed: $result"
1747                                }
1748                                if {[llength $res] < 2} {
1749                                        fatal_softcontinue "Port $portname not found"
1750                                }
1751                                array set portinfo [lindex $res 1]
1752                                set porturl $portinfo(porturl)
1753                        }
1754                       
1755                        set portdir [file normalize [darwinports::getportdir $porturl]]
1756                        set porturl "file://${portdir}";        # Rebuild url so it's fully qualified
1757                        set portfile "${portdir}/Portfile"
1758                       
1759                        if {[file readable $portfile]} {
1760                                switch -- $action {
1761                                        cat     {
1762                                                # Copy the portfile to standard output
1763                                                set f [open $portfile RDONLY]
1764                                                while { ![eof $f] } {
1765                                                        puts [read $f 4096]
1766                                                }
1767                                                close $f
1768                                        }
1769                                       
1770                                        ed - edit {
1771                                                # Edit the port's portfile with the user's editor
1772                                               
1773                                                # Restore our entire environment from start time.
1774                                                # We need it to evaluate the editor, and the editor
1775                                                # may want stuff from it as well, like TERM.
1776                                                array unset env_save; array set env_save [array get env]
1777                                                array unset env *; array set env [array get boot_env]
1778                                               
1779                                                # Find an editor to edit the portfile
1780                                                set editor ""
1781                                                foreach ed { VISUAL EDITOR } {
1782                                                        if {[info exists env($ed)]} {
1783                                                                set editor $env($ed)
1784                                                                break
1785                                                        }
1786                                                }
1787                                               
1788                                                # Invoke the editor
1789                                                if { $editor == "" } {
1790                                                        fatal "No EDITOR is specified in your environment"
1791                                                } else {
1792                                                        if {[catch {eval exec >/dev/stdout </dev/stdin $editor $portfile} result]} {
1793                                                                global errorInfo
1794                                                                ui_debug "$errorInfo"
1795                                                                fatal "unable to invoke editor $editor: $result"
1796                                                        }
1797                                                }
1798                                               
1799                                                # Restore internal dp environment
1800                                                array unset env *; array set env [array get env_save]
1801                                        }
1802                                       
1803                                        dir {
1804                                                # output the path to the port's directory
1805                                                puts $portdir
1806                                        }
1807
1808                                        url {
1809                                                # output the url of the port's directory, suitable to feed back in later as a port descriptor
1810                                                puts $porturl
1811                                        }
1812
1813                                        file {
1814                                                # output the path to the port's portfile
1815                                                puts $portfile
1816                                        }
1817                                }
1818                        } else {
1819                                fatal_softcontinue "Could not read $portfile"
1820                        }
1821                }
1822        }
1823       
1824        sync {
1825                if {[catch {dportsync} result]} {
1826                        global errorInfo
1827                        ui_debug "$errorInfo"
1828                        fatal "port sync failed: $result"
1829                }
1830        }
1831       
1832        default {
1833                require_portlist
1834                foreachport $portlist {
1835                        set target $action
1836
1837                        # If we have a url, use that, since it's most specific
1838                        # otherwise try to map the portname to a url
1839                        if {$porturl == ""} {
1840                                # Verify the portname, getting portinfo to map to a porturl
1841                                if {[catch {set res [dportsearch $portname no exact]} result]} {
1842                                        global errorInfo
1843                                        ui_debug "$errorInfo"
1844                                        fatal_softcontinue "search for portname $portname failed: $result"
1845                                }
1846                                if {[llength $res] < 2} {
1847                                        fatal_softcontinue "Port $portname not found"
1848                                }
1849                                array set portinfo [lindex $res 1]
1850                                set porturl $portinfo(porturl)
1851                        }
1852                       
1853                        # If this is the install target, add any global_variations to the variations
1854                        # specified for the port
1855                        if { $target == "install" } {
1856                                foreach { variation value } [array get global_variations] {
1857                                        if { ![info exists variations($variation)] } {
1858                                                set variations($variation) $value
1859                                        }
1860                                }
1861                        }
1862
1863                        # If version was specified, save it as a version glob for use
1864                        # in port actions (e.g. clean).
1865                        if {[string length $portversion]} {
1866                                set options(ports_version_glob) $portversion
1867                        }
1868                        if {[catch {set workername [dportopen $porturl [array get options] [array get variations]]} result]} {
1869                                global errorInfo
1870                                ui_debug "$errorInfo"
1871                                fatal_softcontinue "Unable to open port: $result"
1872                        }
1873                        if {[catch {set result [dportexec $workername $target]} result]} {
1874                                global errorInfo
1875                                dportclose $workername
1876                                ui_debug "$errorInfo"
1877                                fatal_softcontinue "Unable to execute port: $result"
1878                        }
1879
1880                        dportclose $workername
1881                       
1882                        # Process any error that wasn't thrown and handled already
1883                        if {$result} {
1884                                fatal_softcontinue "Status $result encountered during processing."
1885                        }
1886                }
1887        }
1888}
1889
1890
Note: See TracBrowser for help on using the repository browser.