source: trunk/base/src/port1.0/portinstall.tcl @ 3220

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

Fix all conditionals that are missing braces
Submitted by: Jason Corley <jcorley1@…>

  • Property svn:eol-style set to native
  • Property svn:executable set to *
File size: 5.6 KB
Line 
1# et:ts=4
2# portinstall.tcl
3#
4# Copyright (c) 2002 - 2003 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 portinstall 1.0
33package require portutil 1.0
34
35set com.apple.install [target_new com.apple.install install_main]
36target_runtype ${com.apple.install} always
37target_provides ${com.apple.install} install
38target_requires ${com.apple.install} main fetch extract checksum patch configure build destroot
39target_prerun ${com.apple.install} install_start
40
41set UI_PREFIX "---> "
42
43proc install_start {args} {
44    global UI_PREFIX portname
45
46    ui_msg "$UI_PREFIX [format [msgcat::mc "Installing %s"] ${portname}]"
47}
48
49proc install_element {src_element dst_element} {
50# don't recursively copy directories
51    if {[file isdirectory $src_element] && [file type $src_element] != "link"} {
52        file mkdir $dst_element
53    } else {
54        file copy -force $src_element $dst_element
55    }
56
57    # if the file is a symlink, do not try to set file attributes
58    # if the destination file is an existing directory,
59    # do not overwrite its file attributes
60    if {[file type $src_element] != "link" || [file isdirectory $dst_element]} {
61        set attributes [file attributes $src_element]   
62        for {set i 0} {$i < [llength $attributes]} {incr i} {
63            set opt [lindex $attributes $i]
64            incr i
65            set arg [lindex $attributes $i]
66            file attributes $dst_element $opt $arg
67            # set mtime on installed element
68            exec touch -r $src_element $dst_element
69        }
70    }
71}
72
73proc directory_dig {rootdir workdir {cwd ""}} {
74    global installPlist
75    set pwd [pwd]
76    if {[catch {cd $workdir} err]} {
77        puts $err
78        return
79    }
80
81    foreach name [readdir .] {
82        if {[string match $name "."] || [string match $name ".."]} {
83            continue
84        }
85        set element [file join $cwd $name]
86
87        # XXX jpm's cross-platform code to find file separator
88        # replace with [file seperator] with tcl 8.4
89        if {![info exists root]} {
90            if {[string match [file tail "/monkey"] "monkey"]} {
91                set root "/"
92            } elseif {[string match [file tail ":monkey"] "monkey"]} {
93                set root ":" 
94            } else {
95                set root "\\"           
96            }
97        }
98
99        set dst_element [file join $root $element]
100        set src_element [file join $rootdir $element]
101        # overwrites files but not directories
102        if {![file exists $dst_element] || ![file isdirectory $dst_element]} {
103            ui_debug "installing file: $dst_element"
104            install_element $src_element $dst_element
105            lappend installPlist $dst_element
106        }
107        if {[file isdirectory $name] && [file type $name] != "link"} {
108            directory_dig $rootdir $name [file join $cwd $name]
109        }
110    }
111    cd $pwd
112}
113
114proc install_main {args} {
115    global portname portversion portpath categories description long_description homepage depends_run installPlist package-install uninstall workdir worksrcdir prefix UI_PREFIX destroot
116
117    # Install ${destroot} contents into /
118    directory_dig ${destroot} ${destroot}
119
120    # Package installed successfully, so now we must register it
121    set rhandle [registry_new $portname $portversion]
122
123    registry_store $rhandle [list prefix $prefix]
124    registry_store $rhandle [list categories $categories]
125    if {[info exists description]} {
126        registry_store $rhandle [concat description $description]
127    }
128    if {[info exists long_description]} {
129        registry_store $rhandle [concat long_description ${long_description}]
130    }
131    if {[info exists homepage]} {
132        registry_store $rhandle [concat homepage ${homepage}]
133    }
134    if {[info exists depends_run]} {
135        registry_store $rhandle [list run_depends $depends_run]
136    }
137    if {[info exists package-install]} {
138        registry_store $rhandle [concat package-install ${package-install}]
139    }
140    if {[info exists installPlist]} {
141        registry_store $rhandle [list contents [fileinfo_for_index $installPlist]]
142    }
143    if {[info proc pkg_uninstall] == "pkg_uninstall"} {
144        registry_store $rhandle [list uninstall [proc_disasm pkg_uninstall]]
145    }
146    registry_close $rhandle
147    return 0
148}
149
150proc proc_disasm {pname} {
151    set p "proc "
152    append p $pname " {"
153    set space ""
154    foreach arg [info args $pname] {
155        if {[info default $pname $arg value]} {
156            append p "$space{" [list $arg $value] "}"
157        } else {
158            append p $space $arg
159        }
160        set space " "
161    }
162    append p "} {" [info body $pname] "}"
163    return $p
164}
Note: See TracBrowser for help on using the repository browser.