source: branches/gsoc09-logging/base/src/port1.0/portclean.tcl @ 52218

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

Merge from trunk

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 8.9 KB
Line 
1# et:ts=4
2# portclean.tcl
3# $Id: portclean.tcl 52218 2009-06-12 08:57:53Z enl@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 name]]"
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 name]]"
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 name]]"
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_archive] && $ports_clean_archive == "yes"))} {
76         ui_info "$UI_PREFIX [format [msgcat::mc "Removing build directory for %s"] [option name]]"
77         clean_work
78    }
79
80    # start gsoc-08 privileges
81    if {[info exists usealtworkpath] && $usealtworkpath == "yes"} {
82        ui_info "$UI_PREFIX [format [msgcat::mc "Removing alt source directory for %s"] [option name]]"
83        clean_altsource
84    }
85    # end gsoc-08 privileges
86
87    return 0
88}
89
90proc portclean::clean_altsource {args} {
91    global usealtworkpath worksymlink
92
93    set sourcepath [string map {"work" ""} $worksymlink]
94
95    if {[file isdirectory $sourcepath]} {
96        ui_debug "Removing directory: ${sourcepath}"
97        if {[catch {delete $sourcepath} result]} {
98            ui_debug "$::errorInfo"
99            ui_error "$result"
100        }
101    } else {
102        ui_debug "No alt source directory found to remove."
103    }
104
105    return 0
106}
107
108#
109# Remove the directory where the distfiles reside.
110# This is crude, but works.
111#
112proc portclean::clean_dist {args} {
113    global ports_force name distpath dist_subdir distfiles
114
115    # remove known distfiles for sure (if they exist)
116    set count 0
117    foreach file $distfiles {
118        if {[info exist distpath] && [info exists dist_subdir]} {
119            set distfile [file join $distpath $dist_subdir $file]
120        } else {
121            set distfile [file join $distpath $file]
122        }
123        if {[file isfile $distfile]} {
124            ui_debug "Removing file: $distfile"
125            if {[catch {delete $distfile} result]} {
126                ui_debug "$::errorInfo"
127                ui_error "$result"
128            }
129            set count [expr $count + 1]
130        }
131    }
132    if {$count > 0} {
133        ui_debug "$count distfile(s) removed."
134    } else {
135        ui_debug "No distfiles found to remove at $distpath"
136    }
137
138    # next remove dist_subdir if only needed for this port,
139    # or if user forces us to
140    set dirlist [list]
141    if {($dist_subdir != $name)} {
142        if {[info exists dist_subdir]} {
143            set distfullpath [file join $distpath $dist_subdir]
144            if {!([info exists ports_force] && $ports_force == "yes")
145                && [file isdirectory $distfullpath]
146                && [llength [readdir $distfullpath]] > 0} {
147                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]]
148            } else {
149                lappend dirlist $dist_subdir
150                lappend dirlist $name
151            }
152        } else {
153            lappend dirlist $name
154        }
155    } else {
156        lappend dirlist $name
157    }
158    # loop through directories
159    set count 0
160    foreach dir $dirlist {
161        set distdir [file join $distpath $dir]
162        if {[file isdirectory $distdir]} {
163            ui_debug "Removing directory: ${distdir}"
164            if {[catch {delete $distdir} result]} {
165                ui_debug "$::errorInfo"
166                ui_error "$result"
167            }
168            set count [expr $count + 1]
169        }
170    }
171    if {$count > 0} {
172        ui_debug "$count distfile directory(s) removed."
173    } else {
174        ui_debug "No distfile directory found to remove."
175    }
176    return 0
177}
178
179proc portclean::clean_work {args} {
180    global portbuildpath worksymlink
181
182    if {[file isdirectory $portbuildpath]} {
183        ui_debug "Removing directory: ${portbuildpath}"
184        if {[catch {delete $portbuildpath} result]} {
185            ui_debug "$::errorInfo"
186            ui_error "$result"
187        }
188    } else {
189        ui_debug "No work directory found to remove at ${portbuildpath}"
190    }
191
192    # Clean symlink, if necessary
193    if {![catch {file type $worksymlink} result] && $result eq "link"} {
194        ui_debug "Removing symlink: $worksymlink"
195        delete $worksymlink
196    }
197
198    return 0
199}
200
201proc portclean::clean_archive {args} {
202    global workpath portarchivepath name version ports_version_glob
203
204    # Define archive destination directory and target filename
205    if {$portarchivepath ne $workpath && $portarchivepath ne ""} {
206        set archivepath [file join $portarchivepath [option os.platform] [option os.arch]]
207    }
208
209    if {[info exists ports_version_glob]} {
210        # Match all possible archive variatns that match the version
211        # glob specified by the user for this OS.
212        set fileglob "$name-[option ports_version_glob]*.[option os.arch].*"
213    } else {
214        # Match all possible archive variants for the current version on
215        # this OS. If you want to delete previous versions, use the
216        # version glob argument to clean.
217        #
218        # We do this because if we don't, then ports that match the
219        # first part of the name (e.g. trying to remove foo-*, it will
220        # pick up anything foo-bar-* as well, which is undesirable).
221        set fileglob "$name-$version*.[option os.arch].*"
222    }
223
224    # Remove the archive files
225    set count 0
226    if {![catch {set archivelist [glob [file join $archivepath $fileglob]]} result]} {
227        foreach path $archivelist {
228            set file [file tail $path]
229            # Make sure file is truly a port archive file, and not
230            # and accidental match with some other file that might exist.
231            if {[regexp "^$name-\[-_a-zA-Z0-9\.\]+_\[0-9\]*\[+-_a-zA-Z0-9\]*\[\.\][option os.arch]\[\.\]\[a-z\]+\$" $file]} {
232                if {[file isfile $path]} {
233                    ui_debug "Removing archive: $path"
234                    if {[catch {delete $path} result]} {
235                        ui_debug "$::errorInfo"
236                        ui_error "$result"
237                    }
238                    set count [expr $count + 1]
239                }
240            }
241        }
242    }
243    if {$count > 0} {
244        ui_debug "$count archive(s) removed."
245    } else {
246        ui_debug "No archives found to remove at $archivepath"
247    }
248
249    return 0
250}
251
Note: See TracBrowser for help on using the repository browser.