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

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

Landon says sometimes portdir doesn't exist. If this is the case, use portname
as before instead.

  • Property svn:eol-style set to native
  • Property svn:executable set to *
File size: 8.6 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# UI Instantiations
37# ui_options(ports_debug) - If set, output debugging messages.
38# ui_options(ports_verbose) - If set, output info messages (ui_info)
39# ui_options(ports_quiet) - If set, don't output "standard messages"
40
41# ui_options accessor
42proc ui_isset {val} {
43    global ui_options
44    if {[info exists ui_options($val)]} {
45        if {$ui_options($val) == "yes"} {
46            return 1
47        }
48    }
49    return 0
50}
51
52# Output string "str"
53# If you don't want newlines to be output, you must pass "-nonewline"
54# as the second argument.
55
56proc ui_puts {priority str nonl} {
57    set channel stdout
58    switch $priority {
59        debug {
60            if [ui_isset ports_debug] {
61                set channel stderr
62                set str "DEBUG: $str"
63            } else {
64                return
65            }
66        }
67        info {
68            if ![ui_isset ports_verbose] {
69                return
70            }
71        }
72        msg {
73            if [ui_isset ports_quiet] {
74                return
75            }
76        }
77        error {
78            set str "Error: $str"
79            set channel stderr
80        }
81        warn {
82            set str "Warning: $str"
83        }
84    }
85    if {$nonl == "-nonewline"} {
86        puts -nonewline $channel "$str"
87        flush $channel 
88    } else {
89        puts "$str"
90    }
91}
92
93# Get a line of input from the user and store in str, returning the
94# number of bytes input.
95proc ui_gets {str} {
96    upvar $str in_string
97    gets stdin in_string
98}
99
100# Ask a boolean "yes/no" question of the user, using "promptstr" as
101# the prompt.  It should contain a trailing space and/or anything else
102# you want to precede the user's input string.  Returns 1 for "yes" or
103# 0 for "no".  This implementation also assumes an english yes/no or
104# y/n response, but that is not mandated by the spec.  If "defvalue"
105# is passed, it will be used as the default value if none is supplied
106# by the user.
107proc ui_yesno {promptstr {defvalue ""}} {
108    set satisfaction no
109    while {$satisfaction == "no"} {
110        ui_puts msg $promptstr -nonewline
111        if {[ui_gets mystr] == 0} {
112            if {[string length $defvalue] > 0} {
113                set mystr $defvalue
114            } else {
115                continue
116            }
117        }
118        if {[string compare -nocase -length 1 $mystr y] == 0} {
119            set rval 1
120            set satisfaction yes
121        } elseif {[string compare -nocase -length 1 $mystr n] == 0} {
122            set rval 0
123            set satisfaction yes
124        }
125    }
126    return $rval
127}
128
129# Put up a simple confirmation dialog, requesting nothing more than
130# the user's acknowledgement of the prompt string passed in
131# "promptstr".  There is no return value.
132proc ui_confirm {promptstr} {
133    ui_puts msg "$promptstr" -nonewline
134    ui_gets garbagestr
135}
136
137# Display the contents of a file, ideally in a manner which allows the
138# user to scroll through and read it comfortably (e.g. a license
139# text).  For the "simple UI" version of this, we simply punt this to
140# less(1) since rewriting a complete pager for the simple case would
141# be a waste of time.  It's expected in a more complex UI case, a
142# scrolling display widget of some type will be used.
143proc ui_display {filename} {
144    if [file exists $filename] {
145        system "/usr/bin/less $filename"
146    }
147}
148
149# Standard procedures
150proc print_usage args {
151    global argv0
152    puts "Usage: $argv0 \[-vdqof\] \[action\] \[-D portdir\] \[options\]"
153}
154
155proc fatal args {
156    global argv0
157    puts stderr "$argv0: $args"
158    exit
159}
160
161# Main
162set separator 0
163array set options [list]
164array set variations [list]
165for {set i 0} {$i < $argc} {incr i} {
166    set arg [lindex $argv $i]
167   
168    # if -xyz before the separator
169    if {$separator == 0 && [regexp {^-([-A-Za-z0-9]+)$} $arg match opt] == 1} {
170        if {$opt == "-"} {
171            set separator 1
172        } else {
173            foreach c [split $opt {}] {
174                if {$c == "v"} {
175                    set ui_options(ports_verbose) yes
176                } elseif {$c == "f"} {
177                    set options(ports_force) yes
178                } elseif {$c == "d"} {
179                    set ui_options(ports_debug) yes
180                    # debug infers verbose
181                    set ui_options(ports_verbose) yes
182                } elseif {$c == "q"} {
183                    set ui_options(ports_quiet) yes
184                    set ui_options(ports_verbose) no
185                    set ui_options(ports_debug) no
186                } elseif {$c == "o"} {
187                    set options(ports_ignore_older) yes
188                } elseif {$opt == "D"} {
189                    incr i
190                    set porturl "file://[lindex $argv $i]"
191                } elseif {$opt == "u"} {
192                    incr i
193                    set porturl [lindex $argv $i]
194                } else {
195                    print_usage; exit
196                }
197            }
198        }
199       
200        # if +xyz -xyz or after the separator
201    } elseif {[regexp {^([-+])([-A-Za-z0-9_+\.]+)$} $arg match sign opt] == 1} {
202        set variations($opt) $sign
203       
204        # option=value
205    } elseif {[regexp {([A-Za-z0-9_\.]+)=(.*)} $arg match key val] == 1} {
206        set options($key) \"$val\"
207       
208        # action
209    } elseif {[regexp {^([A-Za-z0-9/._\-^$\[\[?\(\)\\|\+\*]+)$} $arg match opt] == 1} {
210        if [info exists action] {
211            set portname $opt
212        } else {
213            set action $opt
214        }
215    } else {
216        print_usage; exit
217    }
218}
219
220if ![info exists action] {
221    set action build
222}
223
224if {[catch {dportinit} result]} {
225    puts "Failed to initialize ports system, $result"
226    exit 1
227}
228
229switch -- $action {
230    search {
231        if ![info exists portname] {
232            puts "You must specify a search pattern"
233            exit 1
234        }
235        if {[catch {set res [dportsearch $portname]} result]} {
236            puts "port search failed: $result"
237            exit 1
238        }
239        foreach {name array} $res {
240            array set portinfo $array
241
242            # XXX is this the right place to verify an entry?
243            if ![info exists portinfo(name)] {
244                puts "Invalid port entry, missing portname"
245                continue
246            }
247            if ![info exists portinfo(description)] {
248                puts "Invalid port entry for $portinfo(name), missing description"
249                continue
250            }
251            if ![info exists portinfo(version)] {
252                puts "Invalid port entry for $portinfo(name), missing version"
253                continue
254            }
255            if ![info exists portinfo(portdir)] {
256                set displayname $portinfo(name)
257            } else {
258                set displayname $portinfo(portdir)
259            }
260            set portfound 1
261            puts [format "%-20s\t%-8s\t%s" $displayname $portinfo(version) $portinfo(description)]
262            unset portinfo
263        }
264        if {![info exists portfound] || $portfound == 0} {
265            puts "No match for $portname found"
266            exit 1
267        }
268    }
269    sync {
270        if {[catch {dportsync} result]} {
271            puts "port sync failed: $result"
272            exit 1
273        }
274    }
275    default {
276        set target $action
277        if {[info exists portname]} {
278                # Escape regex special characters
279                regsub -all "(\\(){1}|(\\)){1}|(\\{1}){1}|(\\+){1}|(\\{1}){1}|(\\{){1}|(\\}){1}|(\\^){1}|(\\$){1}|(\\.){1}|(\\\\){1}" $portname "\\\\&" search_string
280            if {[catch {set res [dportsearch ^$search_string\$]} result]} {
281                puts "port search failed: $result"
282                exit 1
283            }
284            if {[llength $res] < 2} {
285                puts "Port $portname not found"
286                exit 1
287            }
288            array set portinfo [lindex $res 1]
289            set porturl $portinfo(porturl)
290        }
291        if ![info exists porturl] {
292            set porturl file://./
293        }
294        if {[catch {set workername [dportopen $porturl [array get options] [array get variations]]} result]} {
295            puts "Unable to open port: $result"
296            exit 1
297        }
298        if {[catch {set result [dportexec $workername $target]} result]} {
299            puts "Unable to execute port: $result"
300            exit 1
301        }
302
303        dportclose $workername
304        exit $result
305    }
306}
Note: See TracBrowser for help on using the repository browser.