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

Last change on this file since 14889 was 14889, checked in by jberry, 15 years ago

Adjust some documentation to reflect change to version syntax.

  • Property svn:eol-style set to native
  • Property svn:executable set to *
File size: 49.0 KB
Line 
1#!/bin/sh
2#\
3exec @TCLSH@ "$0" "$@"
4# port.tcl
5# $Id: port.tcl,v 1.143 2005/10/30 16:21:02 jberry 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 { [-vdqfonasbcktu] [-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 { [-vdqfonasbcktu] [-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                                a { set global_options(port_upgrade_all) 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        upgrade {
1353        if {[info exists global_options(port_upgrade_all)] } {
1354                        # if -a then upgrade all installed ports
1355                        # (union these to any other ports user has in the port list)
1356                        set portlist [opUnion $portlist [get_installed_ports]]
1357        } else {
1358                # Otherwise if the user has supplied no ports we'll use the current port
1359                        require_portlist
1360        }
1361               
1362                foreachport $portlist {
1363                        # Merge global variations into the variations specified for this port
1364                        foreach { variation value } [array get global_variations] {
1365                                if { ![info exists variations($variation)] } {
1366                                        set variations($variation) $value
1367                                }
1368                        }
1369                       
1370                        darwinports::upgrade $portname "port:$portname" [array get variations] [array get options]
1371                }
1372    }
1373
1374        version {
1375                puts "Version: [darwinports::version]"
1376        }
1377
1378        compact {
1379                require_portlist
1380                foreachport $portlist {
1381                        if { [catch {portimage::compact $portname [composite_version $portversion [array get variations]]} result] } {
1382                                global errorInfo
1383                                ui_debug "$errorInfo"
1384                                fatal_softcontinue "port compact failed: $result"
1385                        }
1386                }
1387        }
1388       
1389        uncompact {
1390                require_portlist
1391                foreachport $portlist {
1392                        if { [catch {portimage::uncompact $portname [composite_version $portversion [array get variations]]} result] } {
1393                                global errorInfo
1394                                ui_debug "$errorInfo"
1395                                fatal_softcontinue "port uncompact failed: $result"
1396                        }
1397                }
1398        }
1399       
1400        uninstall {
1401                if {[info exists global_options(port_uninstall_old)]} {
1402                        # if -u then uninstall all inactive ports
1403                        # (union these to any other ports user has in the port list)
1404                        set portlist [opUnion $portlist [get_inactive_ports]]
1405                } else {
1406                        # Otherwise the user had better have supplied a portlist, or we'll default to the existing directory
1407                        require_portlist
1408                }
1409
1410                foreachport $portlist {
1411                        if { [catch {portuninstall::uninstall $portname [composite_version $portversion [array get variations]] [array get options]} result] } {
1412                                global errorInfo
1413                                ui_debug "$errorInfo"
1414                                fatal_softcontinue "port uninstall failed: $result"
1415                        }
1416                }
1417        }
1418       
1419        installed {
1420        if { [llength $portlist] } {
1421                        set ilist {}
1422                        foreachport $portlist {
1423                        set composite_version [composite_version $portversion [array get variations]]
1424                                if { [catch {set ilist [concat $ilist [registry::installed $portname $composite_version]]} result] } {
1425                                        if {[string match "* not registered as installed." $result]} {
1426                                                puts "Port $portname is not installed."
1427                                        } else {
1428                                                global errorInfo
1429                                                ui_debug "$errorInfo"
1430                                                fatal_softcontinue "port installed failed: $result"
1431                                        }
1432                                }
1433                        }
1434        } else {
1435            if { [catch {set ilist [registry::installed]} result] } {
1436                if {$result == "Registry error: No ports registered as installed."} {
1437                    puts "No ports are installed!"
1438                } else {
1439                                        global errorInfo
1440                                        ui_debug "$errorInfo"
1441                    fatal "port installed failed: $result"
1442                }
1443            }
1444        }
1445        if { [llength $ilist] > 0 } {
1446            puts "The following ports are currently installed:"
1447            foreach i $ilist {
1448                set iname [lindex $i 0]
1449                set iversion [lindex $i 1]
1450                set irevision [lindex $i 2]
1451                set ivariants [lindex $i 3]
1452                set iactive [lindex $i 4]
1453                if { $iactive == 0 } {
1454                    puts "  $iname @${iversion}_${irevision}${ivariants}"
1455                } elseif { $iactive == 1 } {
1456                    puts "  $iname @${iversion}_${irevision}${ivariants} (active)"
1457                }
1458            }
1459        } else {
1460            exit 1
1461        }
1462    }
1463
1464        outdated {
1465                # If port names were supplied, limit ourselves to those port, else check all installed ports
1466       if { [llength $portlist] } {
1467                        set ilist {}
1468                foreach portspec $portlist {
1469                        array set port $portspec
1470                        set portname $port(name)
1471                        set composite_version [composite_version $port(version) $port(variants)]
1472                                if { [catch {set ilist [concat $ilist [registry::installed $portname $composite_version]]} result] } {
1473                                        if {![string match "* not registered as installed." $result]} {
1474                                                global errorInfo
1475                                                ui_debug "$errorInfo"
1476                                                fatal_softcontinue "port outdated failed: $result"
1477                                        }
1478                                }
1479                        }
1480                } else {
1481                        if { [catch {set ilist [registry::installed]} result] } {
1482                                global errorInfo
1483                                ui_debug "$errorInfo"
1484                                fatal "port outdated failed: $result"
1485                        }
1486                }
1487       
1488                if { [llength $ilist] > 0 } {
1489                        puts "The following installed ports are outdated:"
1490               
1491                        foreach i $ilist { 
1492
1493                                # Get information about the installed port
1494                                set portname                    [lindex $i 0]
1495                                set installed_version   [lindex $i 1]
1496                                set installed_revision  [lindex $i 2]
1497                                set installed_compound  "${installed_version}_${installed_revision}"
1498
1499                                set is_active                   [lindex $i 4]
1500                                if { $is_active == 0 } {
1501                                        continue
1502                                }
1503                                set installed_epoch             [lindex $i 5]
1504
1505                                # Get info about the port from the index
1506                                if {[catch {set res [dportsearch $portname no exact]} result]} {
1507                                        global errorInfo
1508                                        ui_debug "$errorInfo"
1509                                        fatal_softcontinue "search for portname $portname failed: $result"
1510                                }
1511                                if {[llength $res] < 2} {
1512                                        if {[ui_isset ports_debug]} {
1513                                                puts "$portname ($installed_compound is installed; the port was not found in the port index)"
1514                                        }
1515                                        continue
1516                                }
1517                                array set portinfo [lindex $res 1]
1518                               
1519                                # Get information about latest available version and revision
1520                                set latest_version $portinfo(version)
1521                                set latest_revision             0
1522                                if {[info exists portinfo(revision)] && $portinfo(revision) > 0} { 
1523                                        set latest_revision     $portinfo(revision)
1524                                }
1525                                set latest_compound             "${latest_version}_${latest_revision}"
1526                                set latest_epoch                0
1527                                if {[info exists portinfo(epoch)]} { 
1528                                        set latest_epoch        $portinfo(epoch)
1529                                }
1530                               
1531                                # Compare versions, first checking epoch, then the compound version string
1532                                set comp_result [expr $installed_epoch - $latest_epoch]
1533                                if { $comp_result == 0 } {
1534                                        set comp_result [rpm-vercomp $installed_compound $latest_compound]
1535                                }
1536                               
1537                                # Report outdated (or, for verbose, predated) versions
1538                                if { $comp_result != 0 } {
1539                                                               
1540                                        # Form a relation between the versions
1541                                        set flag ""
1542                                        if { $comp_result > 0 } {
1543                                                set relation ">"
1544                                                set flag "!"
1545                                        } else {
1546                                                set relation "<"
1547                                        }
1548                                       
1549                                        # Emit information
1550                                        if {$comp_result < 0 || [ui_isset ports_verbose]} {
1551                                                puts [format "%-30s %-24s %1s" $portname "$installed_compound $relation $latest_compound" $flag]
1552                                        }
1553                                       
1554                                }
1555                        }
1556                } else {
1557                        exit 1
1558                }
1559        }
1560
1561        contents {
1562                require_portlist
1563                foreachport $portlist {
1564                        set files [registry::port_registered $portname]
1565                        if { $files != 0 } {
1566                                if { [llength $files] > 0 } {
1567                                        puts "Port $portname contains:"
1568                                        foreach file $files {
1569                                                puts "  $file"
1570                                        }
1571                                } else {
1572                                        puts "Port $portname does not contain any file or is not active."
1573                                }
1574                        } else {
1575                                puts "Port $portname is not installed."
1576                        }
1577                }
1578        }
1579       
1580        deps {
1581                require_portlist
1582                foreachport $portlist {
1583                        # Get info about the port
1584                        if {[catch {dportsearch $portname no exact} result]} {
1585                                global errorInfo
1586                                ui_debug "$errorInfo"
1587                                fatal_softcontinue "search for portname $portname failed: $result"
1588                        }
1589       
1590                        if {$result == ""} {
1591                                fatal "No port $portname found."
1592                        }
1593       
1594                        array set portinfo [lindex $result 1]
1595       
1596                        set depstypes {depends_build depends_lib depends_run}
1597                        set depstypes_descr {"build" "library" "runtime"}
1598       
1599                        set nodeps true
1600                        foreach depstype $depstypes depsdecr $depstypes_descr {
1601                                if {[info exists portinfo($depstype)] &&
1602                                        $portinfo($depstype) != ""} {
1603                                        puts "$portname has $depsdecr dependencies on:"
1604                                        foreach i $portinfo($depstype) {
1605                                                puts "\t[lindex [split [lindex $i 0] :] end]"
1606                                        }
1607                                        set nodeps false
1608                                }
1609                        }
1610                       
1611                        # no dependencies found
1612                        if {$nodeps == "true"} {
1613                                puts "$portname has no dependencies"
1614                        }
1615                }
1616        }
1617       
1618        variants {
1619                require_portlist
1620                foreachport $portlist {
1621                        # search for port
1622                        if {[catch {dportsearch $portname no exact} result]} {
1623                                global errorInfo
1624                                ui_debug "$errorInfo"
1625                                fatal_softcontinue "search for portname $portname failed: $result"
1626                        }
1627               
1628                        if {$result == ""} {
1629                                puts "No port $portname found."
1630                        }
1631               
1632                        array set portinfo [lindex $result 1]
1633               
1634                        # if this fails the port doesn't have any variants
1635                        if {![info exists portinfo(variants)]} {
1636                                puts "$portname has no variants"
1637                        } else {
1638                                # print out all the variants
1639                                puts "$portname has the variants:"
1640                                for {set i 0} {$i < [llength $portinfo(variants)]} {incr i} {
1641                                        puts "\t[lindex $portinfo(variants) $i]"
1642                                }
1643                        }
1644                }
1645        }
1646       
1647        search {
1648                if {![llength portlist]} {
1649                        fatal "You must specify a search pattern"
1650                }
1651               
1652                foreachport $portlist {
1653                        if {[catch {set res [dportsearch $portname no]} result]} {
1654                                global errorInfo
1655                                ui_debug "$errorInfo"
1656                                fatal_softcontinue "search for portname $portname failed: $result"
1657                        }
1658                        foreach {name array} $res {
1659                                array set portinfo $array
1660       
1661                                # XXX is this the right place to verify an entry?
1662                                if {![info exists portinfo(name)]} {
1663                                        puts "Invalid port entry, missing portname"
1664                                        continue
1665                                }
1666                                if {![info exists portinfo(description)]} {
1667                                        puts "Invalid port entry for $portinfo(name), missing description"
1668                                        continue
1669                                }
1670                                if {![info exists portinfo(version)]} {
1671                                        puts "Invalid port entry for $portinfo(name), missing version"
1672                                        continue
1673                                }
1674                                if {![info exists portinfo(portdir)]} {
1675                                        set output [format "%-30s @%-12s %s" $portinfo(name) $portinfo(version) $portinfo(description)]
1676                                } else {
1677                                        set output [format "%-30s %-14s @%-12s %s" $portinfo(name) $portinfo(portdir) $portinfo(version) $portinfo(description)]
1678                                }
1679                                set portfound 1
1680                                puts $output
1681                                unset portinfo
1682                        }
1683                        if {![info exists portfound] || $portfound == 0} {
1684                                fatal "No match for $portname found"
1685                        }
1686                }
1687        }
1688       
1689        list {
1690                # Default to list all ports if no portnames are supplied
1691                if {![llength $portlist]} {
1692                        add_to_portlist portlist [list name "-all-"]
1693                }
1694               
1695                foreachport $portlist {
1696                        if {$portname == "-all-"} {
1697                                set search_string ".+"
1698                        } else {
1699                                set search_string [regex_pat_sanitize $portname]
1700                        }
1701                       
1702                        if {[catch {set res [dportsearch ^$search_string\$ no]} result]} {
1703                                global errorInfo
1704                                ui_debug "$errorInfo"
1705                                fatal_softcontinue "search for portname $search_string failed: $result"
1706                        }
1707
1708                        foreach {name array} $res {
1709                                array set portinfo $array
1710                                set outdir ""
1711                                if {[info exists portinfo(portdir)]} {
1712                                        set outdir $portinfo(portdir)
1713                                }
1714                                puts [format "%-30s @%-14s %s" $portinfo(name) $portinfo(version) $outdir]
1715                        }
1716                }
1717        }
1718       
1719        echo {
1720                # Simply echo back the port specs given to this command
1721                foreachport $portlist {
1722                        set opts {}
1723                        foreach { key value } [array get options] {
1724                                lappend opts "$key=$value"
1725                        }
1726                       
1727                        set composite_version [composite_version $portversion [array get variations] 1]
1728                        if { $composite_version != "" } {
1729                                set ver_field "@$composite_version"
1730                        } else {
1731                                set ver_field ""
1732                        }
1733                        puts [format "%-30s %s %s" $portname $ver_field  [join $opts " "]]
1734                }
1735        }
1736       
1737        ed - edit -
1738        cat -
1739        dir -
1740        url -
1741        file {
1742                # Operations on the port's directory and Portfile
1743                require_portlist
1744                foreachport $portlist {
1745                        # If we have a url, use that, since it's most specific
1746                        # otherwise try to map the portname to a url
1747                        if {$porturl == ""} {
1748                                # Verify the portname, getting portinfo to map to a porturl
1749                                if {[catch {set res [dportsearch $portname no exact]} result]} {
1750                                        global errorInfo
1751                                        ui_debug "$errorInfo"
1752                                        fatal_softcontinue "search for portname $portname failed: $result"
1753                                }
1754                                if {[llength $res] < 2} {
1755                                        fatal_softcontinue "Port $portname not found"
1756                                }
1757                                array set portinfo [lindex $res 1]
1758                                set porturl $portinfo(porturl)
1759                        }
1760                       
1761                        set portdir [file normalize [darwinports::getportdir $porturl]]
1762                        set porturl "file://${portdir}";        # Rebuild url so it's fully qualified
1763                        set portfile "${portdir}/Portfile"
1764                       
1765                        if {[file readable $portfile]} {
1766                                switch -- $action {
1767                                        cat     {
1768                                                # Copy the portfile to standard output
1769                                                set f [open $portfile RDONLY]
1770                                                while { ![eof $f] } {
1771                                                        puts [read $f 4096]
1772                                                }
1773                                                close $f
1774                                        }
1775                                       
1776                                        ed - edit {
1777                                                # Edit the port's portfile with the user's editor
1778                                               
1779                                                # Restore our entire environment from start time.
1780                                                # We need it to evaluate the editor, and the editor
1781                                                # may want stuff from it as well, like TERM.
1782                                                array unset env_save; array set env_save [array get env]
1783                                                array unset env *; array set env [array get boot_env]
1784                                               
1785                                                # Find an editor to edit the portfile
1786                                                set editor ""
1787                                                foreach ed { VISUAL EDITOR } {
1788                                                        if {[info exists env($ed)]} {
1789                                                                set editor $env($ed)
1790                                                                break
1791                                                        }
1792                                                }
1793                                               
1794                                                # Invoke the editor
1795                                                if { $editor == "" } {
1796                                                        fatal "No EDITOR is specified in your environment"
1797                                                } else {
1798                                                        if {[catch {eval exec >/dev/stdout </dev/stdin $editor $portfile} result]} {
1799                                                                global errorInfo
1800                                                                ui_debug "$errorInfo"
1801                                                                fatal "unable to invoke editor $editor: $result"
1802                                                        }
1803                                                }
1804                                               
1805                                                # Restore internal dp environment
1806                                                array unset env *; array set env [array get env_save]
1807                                        }
1808                                       
1809                                        dir {
1810                                                # output the path to the port's directory
1811                                                puts $portdir
1812                                        }
1813
1814                                        url {
1815                                                # output the url of the port's directory, suitable to feed back in later as a port descriptor
1816                                                puts $porturl
1817                                        }
1818
1819                                        file {
1820                                                # output the path to the port's portfile
1821                                                puts $portfile
1822                                        }
1823                                }
1824                        } else {
1825                                fatal_softcontinue "Could not read $portfile"
1826                        }
1827                }
1828        }
1829       
1830        sync {
1831                if {[catch {dportsync} result]} {
1832                        global errorInfo
1833                        ui_debug "$errorInfo"
1834                        fatal "port sync failed: $result"
1835                }
1836        }
1837       
1838        default {
1839                require_portlist
1840                foreachport $portlist {
1841                        set target $action
1842
1843                        # If we have a url, use that, since it's most specific
1844                        # otherwise try to map the portname to a url
1845                        if {$porturl == ""} {
1846                                # Verify the portname, getting portinfo to map to a porturl
1847                                if {[catch {set res [dportsearch $portname no exact]} result]} {
1848                                        global errorInfo
1849                                        ui_debug "$errorInfo"
1850                                        fatal_softcontinue "search for portname $portname failed: $result"
1851                                }
1852                                if {[llength $res] < 2} {
1853                                        fatal_softcontinue "Port $portname not found"
1854                                }
1855                                array set portinfo [lindex $res 1]
1856                                set porturl $portinfo(porturl)
1857                        }
1858                       
1859                        # If this is the install target, add any global_variations to the variations
1860                        # specified for the port
1861                        if { $target == "install" } {
1862                                foreach { variation value } [array get global_variations] {
1863                                        if { ![info exists variations($variation)] } {
1864                                                set variations($variation) $value
1865                                        }
1866                                }
1867                        }
1868
1869                        # If version was specified, save it as a version glob for use
1870                        # in port actions (e.g. clean).
1871                        if {[string length $portversion]} {
1872                                set options(ports_version_glob) $portversion
1873                        }
1874                        if {[catch {set workername [dportopen $porturl [array get options] [array get variations]]} result]} {
1875                                global errorInfo
1876                                ui_debug "$errorInfo"
1877                                fatal_softcontinue "Unable to open port: $result"
1878                        }
1879                        if {[catch {set result [dportexec $workername $target]} result]} {
1880                                global errorInfo
1881                                dportclose $workername
1882                                ui_debug "$errorInfo"
1883                                fatal_softcontinue "Unable to execute port: $result"
1884                        }
1885
1886                        dportclose $workername
1887                       
1888                        # Process any error that wasn't thrown and handled already
1889                        if {$result} {
1890                                fatal_softcontinue "Status $result encountered during processing."
1891                        }
1892                }
1893        }
1894}
1895
1896
Note: See TracBrowser for help on using the repository browser.