<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head><meta http-equiv="content-type" content="text/html; charset=utf-8" />
<title>[128122] trunk/base/src/macports1.0/reclaim.tcl</title>
</head>
<body>
<style type="text/css"><!--
#msg dl.meta { border: 1px #006 solid; background: #369; padding: 6px; color: #fff; }
#msg dl.meta dt { float: left; width: 6em; font-weight: bold; }
#msg dt:after { content:':';}
#msg dl, #msg dt, #msg ul, #msg li, #header, #footer, #logmsg { font-family: verdana,arial,helvetica,sans-serif; font-size: 10pt; }
#msg dl a { font-weight: bold}
#msg dl a:link { color:#fc3; }
#msg dl a:active { color:#ff0; }
#msg dl a:visited { color:#cc6; }
h3 { font-family: verdana,arial,helvetica,sans-serif; font-size: 10pt; font-weight: bold; }
#msg pre { overflow: auto; background: #ffc; border: 1px #fa0 solid; padding: 6px; }
#logmsg { background: #ffc; border: 1px #fa0 solid; padding: 1em 1em 0 1em; }
#logmsg p, #logmsg pre, #logmsg blockquote { margin: 0 0 1em 0; }
#logmsg p, #logmsg li, #logmsg dt, #logmsg dd { line-height: 14pt; }
#logmsg h1, #logmsg h2, #logmsg h3, #logmsg h4, #logmsg h5, #logmsg h6 { margin: .5em 0; }
#logmsg h1:first-child, #logmsg h2:first-child, #logmsg h3:first-child, #logmsg h4:first-child, #logmsg h5:first-child, #logmsg h6:first-child { margin-top: 0; }
#logmsg ul, #logmsg ol { padding: 0; list-style-position: inside; margin: 0 0 0 1em; }
#logmsg ul { text-indent: -1em; padding-left: 1em; }#logmsg ol { text-indent: -1.5em; padding-left: 1.5em; }
#logmsg > ul, #logmsg > ol { margin: 0 0 1em 0; }
#logmsg pre { background: #eee; padding: 1em; }
#logmsg blockquote { border: 1px solid #fa0; border-left-width: 10px; padding: 1em 1em 0 1em; background: white;}
#logmsg dl { margin: 0; }
#logmsg dt { font-weight: bold; }
#logmsg dd { margin: 0; padding: 0 0 0.5em 0; }
#logmsg dd:before { content:'\00bb';}
#logmsg table { border-spacing: 0px; border-collapse: collapse; border-top: 4px solid #fa0; border-bottom: 1px solid #fa0; background: #fff; }
#logmsg table th { text-align: left; font-weight: normal; padding: 0.2em 0.5em; border-top: 1px dotted #fa0; }
#logmsg table td { text-align: right; border-top: 1px dotted #fa0; padding: 0.2em 0.5em; }
#logmsg table thead th { text-align: center; border-bottom: 1px solid #fa0; }
#logmsg table th.Corner { text-align: left; }
#logmsg hr { border: none 0; border-top: 2px dashed #fa0; height: 1px; }
#header, #footer { color: #fff; background: #636; border: 1px #300 solid; padding: 6px; }
#patch { width: 100%; }
#patch h4 {font-family: verdana,arial,helvetica,sans-serif;font-size:10pt;padding:8px;background:#369;color:#fff;margin:0;}
#patch .propset h4, #patch .binary h4 {margin:0;}
#patch pre {padding:0;line-height:1.2em;margin:0;}
#patch .diff {width:100%;background:#eee;padding: 0 0 10px 0;overflow:auto;}
#patch .propset .diff, #patch .binary .diff {padding:10px 0;}
#patch span {display:block;padding:0 10px;}
#patch .modfile, #patch .addfile, #patch .delfile, #patch .propset, #patch .binary, #patch .copfile {border:1px solid #ccc;margin:10px 0;}
#patch ins {background:#dfd;text-decoration:none;display:block;padding:0 10px;}
#patch del {background:#fdd;text-decoration:none;display:block;padding:0 10px;}
#patch .lines, .info {color:#888;background:#fff;}
--></style>
<div id="msg">
<dl class="meta">
<dt>Revision</dt> <dd><a href="https://trac.macports.org/changeset/128122">128122</a></dd>
<dt>Author</dt> <dd>cal@macports.org</dd>
<dt>Date</dt> <dd>2014-11-13 15:29:12 -0800 (Thu, 13 Nov 2014)</dd>
</dl>
<h3>Log Message</h3>
<pre>base: reclaim: refactor distfile cleanup
- Keep patchfiles of installed ports
- Gather a list of files to be deleted before actually deleting
- Use the list to interactively show the list to the user and report the size of files to be removed
- Don't follow symlinks to avoid escaping the distfiles directory
- Don't abort when a port can't be executed, but just skip it
- Improve Tcl quoting in $workername eval to avoid ending up on http://wiki.tcl.tk/1726 again
- Use a sorted list to check for presence so O(log n) binary search can be used
- Suboptimal: Uses bytesize from port.tcl. This should be changed since it's
an API violation. Base shouldn't depend on this code.</pre>
<h3>Modified Paths</h3>
<ul>
<li><a href="#trunkbasesrcmacports10reclaimtcl">trunk/base/src/macports1.0/reclaim.tcl</a></li>
</ul>
</div>
<div id="patch">
<h3>Diff</h3>
<a id="trunkbasesrcmacports10reclaimtcl"></a>
<div class="modfile"><h4>Modified: trunk/base/src/macports1.0/reclaim.tcl (128121 => 128122)</h4>
<pre class="diff"><span>
<span class="info">--- trunk/base/src/macports1.0/reclaim.tcl 2014-11-13 23:28:33 UTC (rev 128121)
+++ trunk/base/src/macports1.0/reclaim.tcl 2014-11-13 23:29:12 UTC (rev 128122)
</span><span class="lines">@@ -56,7 +56,6 @@
</span><span class="cx"> namespace eval reclaim {
</span><span class="cx">
</span><span class="cx"> proc main {args} {
</span><del>-
</del><span class="cx"> # The main function. Calls each individual function that needs to be run.
</span><span class="cx"> # Args:
</span><span class="cx"> # None
</span><span class="lines">@@ -68,74 +67,34 @@
</span><span class="cx"> update_last_run
</span><span class="cx"> }
</span><span class="cx">
</span><del>- proc is_empty_dir {dir} {
-
- # Test if the given directory is empty.
</del><ins>+ proc walk_files {dir files_in_use unused_name} {
+ # Recursively walk the given directory $dir and build a list of all files that are present on-disk but not listed in $files_in_use.
+ # The list of unused files will be stored in the variable given by $unused_name
+ #
</ins><span class="cx"> # Args:
</span><del>- # dir - A string path of the given directory to test
- # Returns:
- # 0 if the directory is not empty, 1 if it is.
-
- # Get _all_ files
- set filenames [glob -nocomplain -tails -directory $dir * .*]
-
- # Yay complex statements! Use RE, lsearch, and llength to determine if the directory is empty.
- expr {![llength [lsearch -all -not -regexp $filenames {^\.\.?$}]]}
- }
-
- proc walk_files {dir delete dist_paths} {
-
- # Recursively walk through each directory that isn't an installed port and if delete each file that isn't a directory if requested.
- # Args:
</del><span class="cx"> # dir - A string path of the given directory to walk through
</span><del>- # delete - Whether to delete each file found that isn't a directory or not. Set to 'yes' or 'no'.
- # dist_paths - A list of the full paths for all distfiles from installed ports
- # Returns:
- # 'no' if no distfiles were found, and 'yes' if distfiles were found.
</del><ins>+ # files_in_use - A sorted list of the full paths for all distfiles from installed ports
+ # unused_name - The name of a list in the caller to which unused files will be appended
</ins><span class="cx">
</span><del>- set found_distfile no
- set root_dist [file join ${macports::portdbpath} distfiles]
- set home_dist ${macports::user_home}/.macports/$root_dist
</del><ins>+ upvar $unused_name unused
</ins><span class="cx">
</span><span class="cx"> foreach item [readdir $dir] {
</span><span class="cx"> set currentPath [file join $dir $item]
</span><del>-
- if {[file isdirectory $currentPath]} {
- walk_files $currentPath $delete $dist_paths
- } else {
- # If the current file isn't in the known-installed-distfiles
- if {[lsearch $dist_paths $currentPath] == -1} {
- set found_distfile yes
-
- ui_msg "Found unused distfile: $item"
-
- if {$delete eq "yes"} {
- ui_debug "Deleting file: $item"
- ui_msg "Removing distfile: $item"
-
- if {[catch {file delete $currentPath} error]} {
- ui_error "something went wrong when trying to delete $currentPath: $error"
- }
</del><ins>+ switch -exact -- [file type $currentPath] {
+ directory {
+ walk_files $currentPath $files_in_use unused
+ }
+ file {
+ if {[lsearch -exact -sorted $files_in_use $currentPath] == -1} {
+ ui_info "Found unused distfile $currentPath"
+ lappend unused $currentPath
</ins><span class="cx"> }
</span><span class="cx"> }
</span><span class="cx"> }
</span><span class="cx"> }
</span><del>-
- if {$dir ne $root_dist && $dir ne $home_dist && [llength [readdir $dir]] == 0} {
- # If the directory is empty, and this isn't the root folder, delete
- # it.
- ui_msg "Found empty directory: $dir. Attempting to delete."
-
- if {[catch {file delete -force $dir} error] } {
- ui_error "something went wrong when trying to delete $dir: $error"
- }
- }
-
- return $found_distfile
</del><span class="cx"> }
</span><span class="cx">
</span><span class="cx"> proc remove_distfiles {} {
</span><del>-
</del><span class="cx"> # Check for distfiles in both the root, and home directories. If found, delete them.
</span><span class="cx"> # Args:
</span><span class="cx"> # None
</span><span class="lines">@@ -150,61 +109,127 @@
</span><span class="cx"> set home_dist ${macports::user_home}/.macports$root_dist
</span><span class="cx">
</span><span class="cx"> set port_info [get_info]
</span><del>- set dist_path [list]
</del><ins>+ set files_in_use [list]
</ins><span class="cx">
</span><span class="cx"> foreach port $port_info {
</span><ins>+ set name [lindex $port 0]
+ set version [lindex $port 1]
+ set revision [lindex $port 2]
+ set variants [lindex $port 3]
</ins><span class="cx">
</span><del>- set name [lindex $port 0]
- set version [lindex $port 1]
- set revision [lindex $port 2]
- set variants [lindex $port 3]
-
</del><span class="cx"> # Get mport reference
</span><span class="cx"> if {[catch {set mport [mportopen_installed $name $version $revision $variants {}]} error]} {
</span><del>- ui_error "something went wrong when trying to get an mport reference."
</del><ins>+ ui_warn [msgcat::mc "Failed to open port %s from registry: %s" $name $error]
+ continue
</ins><span class="cx"> }
</span><span class="cx">
</span><span class="cx"> # Setup sub-Tcl-interpreter that executed the installed port
</span><span class="cx"> set workername [ditem_key $mport workername]
</span><span class="cx">
</span><span class="cx"> # Append that port's distfiles to the list
</span><del>- set subdir [$workername eval return \$dist_subdir]
- set name [$workername eval return \$distfiles]
</del><ins>+ set dist_subdir [$workername eval return {$dist_subdir}]
+ set distfiles [$workername eval return {$distfiles}]
+ set patchfiles [$workername eval [list if {[exists patchfiles]} { return $patchfiles } else { return [list] }]]
</ins><span class="cx">
</span><del>- set root_path [file join $root_dist $subdir $name]
- set home_path [file join $home_dist $subdir $name]
</del><ins>+ foreach distfile [concat $distfiles $patchfiles] {
+ set root_path [file join $root_dist $dist_subdir $distfile]
+ set home_path [file join $home_dist $dist_subdir $distfile]
</ins><span class="cx">
</span><del>- # Add the full file path to the list, depending where it's located.
- if {[file isfile $root_path]} {
- ui_debug "Appending $root_path."
- lappend dist_path $root_path
-
- } else {
</del><ins>+ # Add the full file path to the list, depending where it's located.
+ if {[file isfile $root_path]} {
+ ui_info "Keeping $root_path"
+ lappend files_in_use $root_path
+ }
</ins><span class="cx"> if {[file isfile $home_path]} {
</span><del>- ui_debug "Appending $home_path"
- lappend dist_path $home_path
</del><ins>+ ui_info "Keeping $home_path"
+ lappend files_in_use $home_path
</ins><span class="cx"> }
</span><span class="cx"> }
</span><span class="cx"> }
</span><span class="cx">
</span><ins>+ # sort so we can use binary search in walk_files
+ set files_in_use [lsort -unique $files_in_use]
+
</ins><span class="cx"> ui_debug "Calling walk_files on root directory."
</span><span class="cx">
</span><del>- # Walk through each directory, and delete any files found. Alert the user if no files were found.
- if {[walk_files $root_dist yes $dist_path] eq "no"} {
- ui_msg "No distfiles found in root directory."
- }
</del><ins>+ set superfluous_files [list]
+ walk_files $root_dist $files_in_use superfluous_files
</ins><span class="cx">
</span><span class="cx"> if {[file exists $home_dist]} {
</span><del>-
</del><span class="cx"> ui_debug "Calling walk_files on home directory."
</span><ins>+ walk_files $home_dist $files_in_use superfluous_files
+ }
</ins><span class="cx">
</span><del>- if {[walk_files $home_dist yes $dist_path] eq "no"} {
- ui_msg "No distfiles found in home directory."
</del><ins>+ set num_superfluous_files [llength $superfluous_files]
+ set size_superfluous_files 0
+ foreach f $superfluous_files {
+ incr size_superfluous_files [file size $f]
+ }
+ if {[llength $superfluous_files] > 0} {
+ ui_msg [msgcat::mc \
+ "Found %d files (total %s) that are no longer needed and can be deleted." \
+ $num_superfluous_files \
+ [bytesize $size_superfluous_files]]
+ while {1} {
+ ui_msg "\[D]elete / \[k]eep / \[l]ist: "
+ switch [gets stdin] {
+ d -
+ D {
+ ui_msg "Deleting..."
+ foreach f $superfluous_files {
+ set root_length [string length "${root_dist}/"]
+ set home_length [string length "${home_dist}/"]
+
+ try {
+ ui_info [msgcat::mc "Deleting unused file %s" $f]
+ file delete -- $f
+
+ set directory [file dirname $f]
+ while {1} {
+ set is_below_root [string equal -length $root_length $directory "${root_dist}/"]
+ set is_below_home [string equal -length $home_length $directory "${home_dist}/"]
+
+ if {!$is_below_root && !$is_below_home} {
+ break
+ }
+
+ if {[llength [readdir $directory]] > 0} {
+ break
+ }
+
+ ui_info [msgcat::mc "Deleting empty directory %s" $directory]
+ try {
+ file delete -- $directory
+ } catch {{*} eCode eMessage} {
+ ui_warn [msgcat::mc "Could not delete empty directory %s: %s" $directory $eMesage]
+ }
+ set directory [file dirname $directory]
+ }
+ } catch {{*} eCode eMessage} {
+ ui_warn [msgcat::mc "Could not delete %s: %s" $f $eMessage]
+ }
+ }
+ break
+ }
+ k -
+ K {
+ ui_msg "OK, keeping the files."
+ break
+ }
+ l -
+ L {
+ foreach f $superfluous_files {
+ ui_msg " $f"
+ }
+ }
+ }
</ins><span class="cx"> }
</span><ins>+ } else {
+ ui_msg "No unused distfiles found."
</ins><span class="cx"> }
</span><span class="cx">
</span><span class="cx"> return 0
</span><del>- }
</del><ins>+ }
</ins><span class="cx">
</span><span class="cx"> proc close_file {file} {
</span><span class="cx">
</span></span></pre>
</div>
</div>
</body>
</html>