source: trunk/base/src/port1.0/portclean.tcl @ 50562

Last change on this file since 50562 was 50562, checked in by blb@…, 11 years ago

base/src - detab and remove space-at-end-of-line

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 9.0 KB
Line 
1# et:ts=4
2# portclean.tcl
3# $Id: portclean.tcl 50562 2009-05-04 04:15:01Z blb@macports.org $
4#
5# Copyright (c) 2004 Robert Shaw <rshaw@opendarwin.org>
6# Copyright (c) 2002 - 2003 Apple Computer, Inc.
7# All rights reserved.
8#
9# Redistribution and use in source and binary forms, with or without
10# modification, are permitted provided that the following conditions
11# are met:
12# 1. Redistributions of source code must retain the above copyright
13#    notice, this list of conditions and the following disclaimer.
14# 2. Redistributions in binary form must reproduce the above copyright
15#    notice, this list of conditions and the following disclaimer in the
16#    documentation and/or other materials provided with the distribution.
17# 3. Neither the name of Apple Computer, Inc. nor the names of its contributors
18#    may be used to endorse or promote products derived from this software
19#    without specific prior written permission.
20#
21# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
22# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
23# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
24# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
25# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
26# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
27# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
28# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
29# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
30# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
31# POSSIBILITY OF SUCH DAMAGE.
32#
33
34# the 'clean' target is provided by this package
35
36package provide portclean 1.0
37package require portutil 1.0
38package require Pextlib 1.0
39
40set org.macports.clean [target_new org.macports.clean portclean::clean_main]
41target_runtype ${org.macports.clean} always
42target_state ${org.macports.clean} no
43target_provides ${org.macports.clean} clean
44target_requires ${org.macports.clean} main
45target_prerun ${org.macports.clean} portclean::clean_start
46
47namespace eval portclean {
48}
49
50set_ui_prefix
51
52proc portclean::clean_start {args} {
53    global UI_PREFIX
54
55    ui_msg "$UI_PREFIX [format [msgcat::mc "Cleaning %s"] [option portname]]"
56}
57
58proc portclean::clean_main {args} {
59    global UI_PREFIX
60    global ports_clean_dist ports_clean_work ports_clean_archive
61    global ports_clean_all usealtworkpath
62
63    if {[info exists ports_clean_all] && $ports_clean_all == "yes" || \
64        [info exists ports_clean_dist] && $ports_clean_dist == "yes"} {
65        ui_info "$UI_PREFIX [format [msgcat::mc "Removing distfiles for %s"] [option portname]]"
66        clean_dist
67    }
68    if {[info exists ports_clean_all] && $ports_clean_all == "yes" || \
69        [info exists ports_clean_archive] && $ports_clean_archive == "yes"} {
70        ui_info "$UI_PREFIX [format [msgcat::mc "Removing archives for %s"] [option portname]]"
71        clean_archive
72    }
73    if {[info exists ports_clean_all] && $ports_clean_all == "yes" || \
74        [info exists ports_clean_work] && $ports_clean_work == "yes" || \
75        (!([info exists ports_clean_dist] && $ports_clean_dist == "yes") && \
76         !([info exists ports_clean_archive] && $ports_clean_archive == "yes"))} {
77         ui_info "$UI_PREFIX [format [msgcat::mc "Removing build directory for %s"] [option portname]]"
78         clean_work
79    }
80
81    # start gsoc-08 privileges
82    if {[info exists usealtworkpath] && $usealtworkpath == "yes"} {
83        ui_info "$UI_PREFIX [format [msgcat::mc "Removing alt source directory for %s"] [option portname]]"
84        clean_altsource
85    }
86    # end gsoc-08 privileges
87
88    return 0
89}
90
91proc portclean::clean_altsource {args} {
92    global usealtworkpath worksymlink
93
94    set sourcepath [string map {"work" ""} $worksymlink]
95
96    if {[file isdirectory $sourcepath]} {
97        ui_debug "Removing directory: ${sourcepath}"
98        if {[catch {delete $sourcepath} result]} {
99            ui_debug "$::errorInfo"
100            ui_error "$result"
101        }
102    } else {
103        ui_debug "No alt source directory found to remove."
104    }
105
106    return 0
107}
108
109#
110# Remove the directory where the distfiles reside.
111# This is crude, but works.
112#
113proc portclean::clean_dist {args} {
114    global ports_force portname distpath dist_subdir distfiles
115
116    # remove known distfiles for sure (if they exist)
117    set count 0
118    foreach file $distfiles {
119        if {[info exist distpath] && [info exists dist_subdir]} {
120            set distfile [file join $distpath $dist_subdir $file]
121        } else {
122            set distfile [file join $distpath $file]
123        }
124        if {[file isfile $distfile]} {
125            ui_debug "Removing file: $distfile"
126            if {[catch {delete $distfile} result]} {
127                ui_debug "$::errorInfo"
128                ui_error "$result"
129            }
130            set count [expr $count + 1]
131        }
132    }
133    if {$count > 0} {
134        ui_debug "$count distfile(s) removed."
135    } else {
136        ui_debug "No distfiles found to remove at $distpath"
137    }
138
139    # next remove dist_subdir if only needed for this port,
140    # or if user forces us to
141    set dirlist [list]
142    if {($dist_subdir != $portname)} {
143        if {[info exists dist_subdir]} {
144            set distfullpath [file join $distpath $dist_subdir]
145            if {!([info exists ports_force] && $ports_force == "yes")
146                && [file isdirectory $distfullpath]
147                && [llength [readdir $distfullpath]] > 0} {
148                ui_warn [format [msgcat::mc "Distfiles directory '%s' may contain distfiles needed for other ports, use the -f flag to force removal" ] [file join $distpath $dist_subdir]]
149            } else {
150                lappend dirlist $dist_subdir
151                lappend dirlist $portname
152            }
153        } else {
154            lappend dirlist $portname
155        }
156    } else {
157        lappend dirlist $portname
158    }
159    # loop through directories
160    set count 0
161    foreach dir $dirlist {
162        set distdir [file join $distpath $dir]
163        if {[file isdirectory $distdir]} {
164            ui_debug "Removing directory: ${distdir}"
165            if {[catch {delete $distdir} result]} {
166                ui_debug "$::errorInfo"
167                ui_error "$result"
168            }
169            set count [expr $count + 1]
170        }
171    }
172    if {$count > 0} {
173        ui_debug "$count distfile directory(s) removed."
174    } else {
175        ui_debug "No distfile directory found to remove."
176    }
177    return 0
178}
179
180proc portclean::clean_work {args} {
181    global portbuildpath worksymlink
182
183    if {[file isdirectory $portbuildpath]} {
184        ui_debug "Removing directory: ${portbuildpath}"
185        if {[catch {delete $portbuildpath} result]} {
186            ui_debug "$::errorInfo"
187            ui_error "$result"
188        }
189    } else {
190        ui_debug "No work directory found to remove at ${portbuildpath}"
191    }
192
193    # Clean symlink, if necessary
194    if {![catch {file type $worksymlink} result] && $result eq "link"} {
195        ui_debug "Removing symlink: $worksymlink"
196        delete $worksymlink
197    }
198
199    return 0
200}
201
202proc portclean::clean_archive {args} {
203    global workpath portarchivepath portname portversion ports_version_glob
204
205    # Define archive destination directory and target filename
206    if {$portarchivepath ne $workpath && $portarchivepath ne ""} {
207        set archivepath [file join $portarchivepath [option os.platform] [option os.arch]]
208    }
209
210    if {[info exists ports_version_glob]} {
211        # Match all possible archive variatns that match the version
212        # glob specified by the user for this OS.
213        set fileglob "$portname-[option ports_version_glob]*.[option os.arch].*"
214    } else {
215        # Match all possible archive variants for the current version on
216        # this OS. If you want to delete previous versions, use the
217        # version glob argument to clean.
218        #
219        # We do this because if we don't, then ports that match the
220        # first part of the name (e.g. trying to remove foo-*, it will
221        # pick up anything foo-bar-* as well, which is undesirable).
222        set fileglob "$portname-$portversion*.[option os.arch].*"
223    }
224
225    # Remove the archive files
226    set count 0
227    if {![catch {set archivelist [glob [file join $archivepath $fileglob]]} result]} {
228        foreach path $archivelist {
229            set file [file tail $path]
230            # Make sure file is truly a port archive file, and not
231            # and accidental match with some other file that might exist.
232            if {[regexp "^$portname-\[-_a-zA-Z0-9\.\]+_\[0-9\]*\[+-_a-zA-Z0-9\]*\[\.\][option os.arch]\[\.\]\[a-z\]+\$" $file]} {
233                if {[file isfile $path]} {
234                    ui_debug "Removing archive: $path"
235                    if {[catch {delete $path} result]} {
236                        ui_debug "$::errorInfo"
237                        ui_error "$result"
238                    }
239                    set count [expr $count + 1]
240                }
241            }
242        }
243    }
244    if {$count > 0} {
245        ui_debug "$count archive(s) removed."
246    } else {
247        ui_debug "No archives found to remove at $archivepath"
248    }
249
250    return 0
251}
252
Note: See TracBrowser for help on using the repository browser.