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

Last change on this file since 1066 was 1066, checked in by jkh, 18 years ago

Add a -f[orce] flag for making certain things happen unconditionally when
the port system is trying to be more clever than you are and not succeeding.

  • Property svn:eol-style set to native
  • Property svn:executable set to *
File size: 5.0 KB
Line 
1#!/usr/bin/env tclsh8.3
2# port.tcl
3#
4# Copyright (c) 2002 Apple Computer, Inc.
5# All rights reserved.
6#
7# Redistribution and use in source and binary forms, with or without
8# modification, are permitted provided that the following conditions
9# are met:
10# 1. Redistributions of source code must retain the above copyright
11#    notice, this list of conditions and the following disclaimer.
12# 2. Redistributions in binary form must reproduce the above copyright
13#    notice, this list of conditions and the following disclaimer in the
14#    documentation and/or other materials provided with the distribution.
15# 3. Neither the name of Apple Computer, Inc. nor the names of its contributors
16#    may be used to endorse or promote products derived from this software
17#    without specific prior written permission.
18#
19# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
20# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
21# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
22# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
23# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
24# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
25# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
26# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
27# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
28# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
29# POSSIBILITY OF SUCH DAMAGE.
30
31package require darwinports
32
33# globals
34set portdir .
35
36# Standard procedures
37proc print_usage args {
38    global argv0
39    puts "Usage: $argv0 \[-vDq\] \[action\] \[-d portdir\] \[options\]"
40}
41
42proc fatal args {
43    global argv0
44    puts stderr "$argv0: $args"
45    exit
46}
47
48# Main
49set separator 0
50array set options [list]
51array set variations [list]
52for {set i 0} {$i < $argc} {incr i} {
53    set arg [lindex $argv $i]
54   
55    # if -xyz before the separator
56    if {$separator == 0 && [regexp {^-([-A-Za-z0-9]+)$} $arg match opt] == 1} {
57        if {$opt == "-"} {
58            set separator 1
59        } else {
60            foreach c [split $opt {}] {
61                if {$c == "v"} {
62                    set options(ports_verbose) yes
63                } elseif {$c == "f"} {
64                    set options(ports_force) yes
65                } elseif {$c == "D"} {
66                    set options(ports_debug) yes
67                } elseif {$c == "q"} {
68                    set options(ports_quiet) yes
69                    set options(ports_verbose) no
70                    set options(ports_debug) no
71                } elseif {$opt == "d"} {
72                    incr i
73                    set porturl "file://[lindex $argv $i]"
74                } elseif {$opt == "u"} {
75                    incr i
76                    set porturl [lindex $argv $i]
77                } else {
78                    print_usage; exit
79                }
80            }
81        }
82       
83        # if +xyz -xyz or after the separator
84    } elseif {[regexp {^([-+])([-A-Za-z0-9_+\.]+)$} $arg match sign opt] == 1} {
85        set variations($opt) $sign
86       
87        # option=value
88    } elseif {[regexp {([A-Za-z0-9_\.]+)=(.*)} $arg match key val] == 1} {
89        set options($key) \"$val\"
90       
91        # action
92    } elseif {[regexp {^([A-Za-z0-9/._\-^$\[\[?\(\)\\|\+\*]+)$} $arg match opt] == 1} {
93        if [info exists action] {
94            set portname $opt
95        } else {
96            set action $opt
97        }
98    } else {
99        print_usage; exit
100    }
101}
102
103if ![info exists action] {
104    set action build
105}
106
107if {[catch {dportinit} result]} {
108    puts "Failed to initialize ports system, $result"
109    exit 1
110}
111
112switch -- $action {
113    search {
114        if ![info exists portname] {
115            puts "You must specify a search pattern"
116            exit 1
117        }
118        if {[catch {set res [dportsearch $portname]} result]} {
119            puts "port search failed: $result"
120            exit 1
121        }
122        foreach {name array} $res {
123            array set portinfo $array
124            # XXX is this the right place to verify an entry?
125            if ![info exists portinfo(name)] {
126                puts "Invalid port entry, missing portname"
127                continue
128            }
129            if ![info exists portinfo(description)] {
130                puts "Invalid port entry for $portinfo(name), missing description"
131                continue
132            }
133            if ![info exists portinfo(version)] {
134                puts "Invalid port entry for $portinfo(name), missing version"
135                continue
136            }
137            set portfound 1
138            puts [format "%-15s\t%-8s\t%s" $portinfo(name) $portinfo(version) $portinfo(description)]
139            unset portinfo
140        }
141        if {![info exists portfound] || $portfound == 0} {
142            puts "No match for $portname found"
143            exit 1
144        }
145    }
146    sync {
147        if {[catch {dportsync} result]} {
148            puts "port sync failed: $result"
149            exit 1
150        }
151    }
152    default {
153        set target $action
154        if {[info exists portname]} {
155            if {[catch {array set portinfo [dportmatch ^$portname\$]} result]} {
156                puts $result
157                exit 1
158            }
159            if {[array size portinfo] == 0} {
160                puts "Port $portname not found"
161                exit 1
162            }
163            set porturl $portinfo(porturl)
164        }
165        if ![info exists porturl] {
166            set porturl file://./
167        }
168        if {[catch {set workername [dportopen $porturl options variations]} result]} {
169            puts "Unable to open port: $result"
170            exit 1
171        }
172        if {[catch {set result [dportexec $workername $target]} result]} {
173            puts "Unable to execute port: $result"
174            exit 1
175        }
176
177        dportclose $workername
178        exit $result
179    }
180}
Note: See TracBrowser for help on using the repository browser.