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

Last change on this file since 2126 was 2126, checked in by kevin, 17 years ago

Added -o option to ignore modification times on state file and Portfile

  • Property svn:eol-style set to native
  • Property svn:executable set to *
File size: 8.5 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 $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 "$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            # XXX is this the right place to verify an entry?
242            if ![info exists portinfo(name)] {
243                puts "Invalid port entry, missing portname"
244                continue
245            }
246            if ![info exists portinfo(description)] {
247                puts "Invalid port entry for $portinfo(name), missing description"
248                continue
249            }
250            if ![info exists portinfo(version)] {
251                puts "Invalid port entry for $portinfo(name), missing version"
252                continue
253            }
254            set portfound 1
255            puts [format "%-15s\t%-8s\t%s" $portinfo(name) $portinfo(version) $portinfo(description)]
256            unset portinfo
257        }
258        if {![info exists portfound] || $portfound == 0} {
259            puts "No match for $portname found"
260            exit 1
261        }
262    }
263    sync {
264        if {[catch {dportsync} result]} {
265            puts "port sync failed: $result"
266            exit 1
267        }
268    }
269    default {
270        set target $action
271        if {[info exists portname]} {
272                # Escape regex special characters
273                regsub -all "(\\(){1}|(\\)){1}|(\\{1}){1}|(\\+){1}|(\\{1}){1}|(\\{){1}|(\\}){1}|(\\^){1}|(\\$){1}|(\\.){1}|(\\\\){1}" $portname "\\\\&" search_string
274            if {[catch {set res [dportsearch ^$search_string\$]} result]} {
275                puts "port search failed: $result"
276                exit 1
277            }
278            if {[llength $res] < 2} {
279                puts "Port $portname not found"
280                exit 1
281            }
282            array set portinfo [lindex $res 1]
283            set porturl $portinfo(porturl)
284        }
285        if ![info exists porturl] {
286            set porturl file://./
287        }
288        if {[catch {set workername [dportopen $porturl [array get options] [array get variations]]} result]} {
289            puts "Unable to open port: $result"
290            exit 1
291        }
292        if {[catch {set result [dportexec $workername $target]} result]} {
293            puts "Unable to execute port: $result"
294            exit 1
295        }
296
297        dportclose $workername
298        exit $result
299    }
300}
Note: See TracBrowser for help on using the repository browser.