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

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

Changes to support long_description (long-description unfortunately turned
out to be a bad name choice) and an attempt to sprinkle it through enough
ports to at least give people the idea in hopes they'll start adding it to
their ports. Also add to the registry entry and clean up some package
installation hook stuff while I'm in there.

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