source: trunk/base/src/port1.0/portregistry.tcl @ 1560

Last change on this file since 1560 was 1560, checked in by landonf (Landon Fuller), 18 years ago

Add support for homepage key
Submitted by: jpm@…

  • Property svn:eol-style set to native
  • Property svn:executable set to *
File size: 7.5 KB
Line 
1# et:ts=4
2# portregistry.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#
31
32package provide portregistry 1.0
33package require portutil 1.0
34
35set com.apple.registry [target_new com.apple.registry registry_main]
36${com.apple.registry} provides registry
37${com.apple.registry} requires main fetch extract checksum patch configure build install
38${com.apple.registry} deplist depends_run depends_lib
39${com.apple.registry} set prerun registry_start
40
41# define options
42options contents long_description description homepage registry.nochecksum registry.path registry.nobzip registry.contents_recurse
43
44# Export options via PortInfo
45options_export description long_description homepage
46
47default registry.path {[file join ${portdbpath} receipts]}
48
49set UI_PREFIX "---> "
50
51proc registry_start {args} {
52    global UI_PREFIX portname
53
54    ui_msg "$UI_PREFIX Adding $portname to registry, this may take a moment..."
55}
56
57# For now, just write stuff to a file for debugging.
58
59proc registry_new {portname {portversion 1.0}} {
60    global _registry_name registry.path
61
62    file mkdir ${registry.path}
63    set _registry_name [file join ${registry.path} $portname-$portversion]
64    system "rm -f ${_registry_name}.tmp"
65    set rhandle [open ${_registry_name}.tmp w 0644]
66    puts $rhandle "\# Format: var value ... {contents {filename uid gid mode size {md5}} ... }"
67    return $rhandle
68}
69
70proc registry_exists {portname {portversion 0}} {
71    global registry.path
72
73    # regex match case
74    if {$portversion == 0} {
75        set x [glob -nocomplain [file join ${registry.path} ${portname}-*]]
76        if [string length $x] {
77            set matchfile [lindex $x 0]
78        } else {
79            set matchfile ""
80        }
81    } else {
82        set matchfile [file join ${registry.path} ${portname}-${portversion}]
83    }
84
85    # Might as well bail out early if no file to match
86    if ![string length $matchfile] {
87        return ""
88    }
89
90    if [file exists $matchfile] {
91        return $matchfile
92    }
93    if [file exists ${matchfile}.bz2] {
94        return ${matchfile}.bz2
95    }
96    return ""
97}
98
99proc registry_store {rhandle data} {
100    puts $rhandle $data
101}
102
103proc registry_fetch {rhandle} {
104    return -1
105}
106
107proc registry_traverse {func} {
108    return -1
109}
110
111proc registry_close {rhandle} {
112    global _registry_name
113    global registry.nobzip
114
115    close $rhandle
116    system "mv ${_registry_name}.tmp ${_registry_name}"
117    if {[file exists ${_registry_name}] && [file exists /usr/bin/bzip2] && ![info exists registry.nobzip]} {
118        system "/usr/bin/bzip2 -f ${_registry_name}"
119    }
120}
121
122proc registry_delete {portname {portversion 1.0}} {
123    global registry.path
124
125    # Try both versions, just to be sure.
126    exec rm -f [file join ${registry.path} ${portname}-${portversion}]
127    exec rm -f [file join ${registry.path} ${portname}-${portversion}].bz2
128}
129
130proc fileinfo_for_file {fname} {
131    global registry.nochecksum
132
133    if ![catch {file stat $fname statvar}] {
134        if {![tbool registry.nochecksum] && [file isfile $fname]} {
135            set md5regex "^(MD5)\[ \]\\((.+)\\)\[ \]=\[ \](\[A-Za-z0-9\]+)\n$"
136            set pipe [open "|md5 \"$fname\"" r]
137            set line [read $pipe]
138            if {[regexp $md5regex $line match type filename sum] == 1} {
139                close $pipe
140                set line [string trimright $line "\n"]
141                return [list $fname $statvar(uid) $statvar(gid) $statvar(mode) $statvar(size) $line]
142            }
143            close $pipe
144        } else {
145            return  [list $fname $statvar(uid) $statvar(gid) $statvar(mode) $statvar(size) "MD5 ($fname) NONE"]
146        }
147    }
148    return {}
149}
150
151proc fileinfo_for_entry {rval dir entry} {
152    global registry.contents_recurse UI_PREFIX
153
154    upvar $rval myrval
155    set path [file join $dir $entry]
156    if {[file isdirectory $path] && [tbool registry.contents_recurse]} {
157        foreach name [readdir $path] {
158            if {[string match $name .] || [string match $name ..]} {
159                continue
160            }
161            set subpath [file join $path $name]
162            if [file isdirectory $subpath] {
163                fileinfo_for_entry myrval $subpath ""
164            } elseif [file readable $subpath] {
165                lappend myrval [fileinfo_for_file $subpath]
166            }
167        }
168    }
169    lappend myrval [fileinfo_for_file $path]
170    return $myrval
171}
172
173proc fileinfo_for_index {flist} {
174    global prefix registry.contents_recurse UI_PREFIX
175
176    set rval {}
177    foreach file $flist {
178        if [string match /* $file] {
179            set fname $file
180            set dir /
181        } else {
182            set fname [file join $prefix $file]
183            set dir $prefix
184        }
185        if {[file isdirectory $fname] && [tbool registry.contents_recurse]} {
186            ui_msg "$UI_PREFIX Warning: Registry adding contents of directory $fname"
187        }
188        fileinfo_for_entry rval $dir $file
189    }
190    return $rval
191}
192
193proc proc_disasm {pname} {
194    set p "proc "
195    append p $pname " {"
196    set space ""
197    foreach arg [info args $pname] {
198        if [info default $pname $arg value] {
199            append p "$space{" [list $arg $value] "}"
200        } else {
201            append p $space $arg
202        }
203        set space " "
204    }
205    append p "} {" [info body $pname] "}"
206    return $p
207}
208
209proc registry_main {args} {
210    global portname portversion portpath categories description long_description homepage depends_run contents package-install uninstall workdir worksrcdir prefix UI_PREFIX
211
212    # Package installed successfully, so now we must register it
213    set rhandle [registry_new $portname $portversion]
214
215    registry_store $rhandle [list prefix $prefix]
216    registry_store $rhandle [list categories $categories]
217    if [info exists description] {
218        registry_store $rhandle [concat description $description]
219    }
220    if [info exists long_description] {
221        registry_store $rhandle [concat long_description ${long_description}]
222    }
223    if [info exists homepage] {
224        registry_store $rhandle [concat homepage ${homepage}]
225    }
226    if [info exists depends_run] {
227        registry_store $rhandle [list run_depends $depends_run]
228    }
229    if [info exists package-install] {
230        registry_store $rhandle [concat package-install ${package-install}]
231    }
232    if [info exists contents] {
233        registry_store $rhandle [list contents [fileinfo_for_index $contents]]
234    }
235    if {[info proc pkg_uninstall] == "pkg_uninstall"} {
236        registry_store $rhandle [list uninstall [proc_disasm pkg_uninstall]]
237    }
238    registry_close $rhandle
239    return 0
240}
Note: See TracBrowser for help on using the repository browser.