Fossil SCM
Moved the new case-sensitive file checking code into the misc package with descriptive command names, to recapture clarity of code at the calling places.
Commit
edc46651c7f9ad0ad3cbd1273ae519e65359536d
Parent
e2a42f7a6800408…
2 files changed
+6
-6
+45
-1
| --- tools/cvs2fossil/lib/c2f_pcollar.tcl | ||
| +++ tools/cvs2fossil/lib/c2f_pcollar.tcl | ||
| @@ -22,10 +22,11 @@ | ||
| 22 | 22 | package require snit ; # OO system. |
| 23 | 23 | package require fileutil::traverse ; # Directory traversal. |
| 24 | 24 | package require fileutil ; # File & path utilities. |
| 25 | 25 | package require vc::tools::trouble ; # Error reporting. |
| 26 | 26 | package require vc::tools::log ; # User feedback. |
| 27 | +package require vc::tools::misc ; # Local file utilities. | |
| 27 | 28 | package require vc::fossil::import::cvs::pass ; # Pass management. |
| 28 | 29 | package require vc::fossil::import::cvs::repository ; # Repository management. |
| 29 | 30 | package require vc::fossil::import::cvs::state ; # State storage |
| 30 | 31 | |
| 31 | 32 | # # ## ### ##### ######## ############# ##################### |
| @@ -114,12 +115,12 @@ | ||
| 114 | 115 | set usr [UserPath $rcs isattic] |
| 115 | 116 | if {[IsSuperceded $base $rcs $usr $isattic]} continue |
| 116 | 117 | |
| 117 | 118 | # XXX Checkme: not sure if this will still fail in the case where a directory does conflict with a file XXX |
| 118 | 119 | if { |
| 119 | - [lsearch [glob -nocomplain -tail -types f -directory $base *] $usr] != -1 && | |
| 120 | - [lsearch [glob -nocomplain -tail -types d -directory $base *] $usr] != -1 | |
| 120 | + [fileexists_ci $base/$usr] && | |
| 121 | + [fileisdir_ci $base/$usr] | |
| 121 | 122 | } { |
| 122 | 123 | trouble fatal "Directory name conflicts with filename." |
| 123 | 124 | trouble fatal "Please remove or rename one of the following:" |
| 124 | 125 | trouble fatal " $base/$usr" |
| 125 | 126 | trouble fatal " $base/$rcs" |
| @@ -218,14 +219,12 @@ | ||
| 218 | 219 | } |
| 219 | 220 | |
| 220 | 221 | proc IsSuperceded {base rcs usr isattic} { |
| 221 | 222 | ::variable myignore |
| 222 | 223 | |
| 223 | - if {!$isattic} {return 0} | |
| 224 | - | |
| 225 | - # use glob to account for case insensitive file systems | |
| 226 | - if {[lsearch [glob -nocomplain -tail -directory $base *] $usr,v] == -1} {return 0} | |
| 224 | + if {!$isattic} {return 0} | |
| 225 | + if {![fileexists_ci $base/$usr,v]} {return 0} | |
| 227 | 226 | |
| 228 | 227 | # We have a regular archive and an Attic archive refering to |
| 229 | 228 | # the same user visible file. Ignore the file in the Attic. |
| 230 | 229 | # |
| 231 | 230 | # By default this is a problem causing an abort after the pass |
| @@ -256,14 +255,15 @@ | ||
| 256 | 255 | namespace eval collar { |
| 257 | 256 | namespace import ::vc::fossil::import::cvs::repository |
| 258 | 257 | namespace import ::vc::fossil::import::cvs::state |
| 259 | 258 | namespace import ::vc::tools::trouble |
| 260 | 259 | namespace import ::vc::tools::log |
| 260 | + namespace import ::vc::tools::misc::file* | |
| 261 | 261 | log register collar |
| 262 | 262 | } |
| 263 | 263 | } |
| 264 | 264 | |
| 265 | 265 | # # ## ### ##### ######## ############# ##################### |
| 266 | 266 | ## Ready |
| 267 | 267 | |
| 268 | 268 | package provide vc::fossil::import::cvs::pass::collar 1.0 |
| 269 | 269 | return |
| 270 | 270 |
| --- tools/cvs2fossil/lib/c2f_pcollar.tcl | |
| +++ tools/cvs2fossil/lib/c2f_pcollar.tcl | |
| @@ -22,10 +22,11 @@ | |
| 22 | package require snit ; # OO system. |
| 23 | package require fileutil::traverse ; # Directory traversal. |
| 24 | package require fileutil ; # File & path utilities. |
| 25 | package require vc::tools::trouble ; # Error reporting. |
| 26 | package require vc::tools::log ; # User feedback. |
| 27 | package require vc::fossil::import::cvs::pass ; # Pass management. |
| 28 | package require vc::fossil::import::cvs::repository ; # Repository management. |
| 29 | package require vc::fossil::import::cvs::state ; # State storage |
| 30 | |
| 31 | # # ## ### ##### ######## ############# ##################### |
| @@ -114,12 +115,12 @@ | |
| 114 | set usr [UserPath $rcs isattic] |
| 115 | if {[IsSuperceded $base $rcs $usr $isattic]} continue |
| 116 | |
| 117 | # XXX Checkme: not sure if this will still fail in the case where a directory does conflict with a file XXX |
| 118 | if { |
| 119 | [lsearch [glob -nocomplain -tail -types f -directory $base *] $usr] != -1 && |
| 120 | [lsearch [glob -nocomplain -tail -types d -directory $base *] $usr] != -1 |
| 121 | } { |
| 122 | trouble fatal "Directory name conflicts with filename." |
| 123 | trouble fatal "Please remove or rename one of the following:" |
| 124 | trouble fatal " $base/$usr" |
| 125 | trouble fatal " $base/$rcs" |
| @@ -218,14 +219,12 @@ | |
| 218 | } |
| 219 | |
| 220 | proc IsSuperceded {base rcs usr isattic} { |
| 221 | ::variable myignore |
| 222 | |
| 223 | if {!$isattic} {return 0} |
| 224 | |
| 225 | # use glob to account for case insensitive file systems |
| 226 | if {[lsearch [glob -nocomplain -tail -directory $base *] $usr,v] == -1} {return 0} |
| 227 | |
| 228 | # We have a regular archive and an Attic archive refering to |
| 229 | # the same user visible file. Ignore the file in the Attic. |
| 230 | # |
| 231 | # By default this is a problem causing an abort after the pass |
| @@ -256,14 +255,15 @@ | |
| 256 | namespace eval collar { |
| 257 | namespace import ::vc::fossil::import::cvs::repository |
| 258 | namespace import ::vc::fossil::import::cvs::state |
| 259 | namespace import ::vc::tools::trouble |
| 260 | namespace import ::vc::tools::log |
| 261 | log register collar |
| 262 | } |
| 263 | } |
| 264 | |
| 265 | # # ## ### ##### ######## ############# ##################### |
| 266 | ## Ready |
| 267 | |
| 268 | package provide vc::fossil::import::cvs::pass::collar 1.0 |
| 269 | return |
| 270 |
| --- tools/cvs2fossil/lib/c2f_pcollar.tcl | |
| +++ tools/cvs2fossil/lib/c2f_pcollar.tcl | |
| @@ -22,10 +22,11 @@ | |
| 22 | package require snit ; # OO system. |
| 23 | package require fileutil::traverse ; # Directory traversal. |
| 24 | package require fileutil ; # File & path utilities. |
| 25 | package require vc::tools::trouble ; # Error reporting. |
| 26 | package require vc::tools::log ; # User feedback. |
| 27 | package require vc::tools::misc ; # Local file utilities. |
| 28 | package require vc::fossil::import::cvs::pass ; # Pass management. |
| 29 | package require vc::fossil::import::cvs::repository ; # Repository management. |
| 30 | package require vc::fossil::import::cvs::state ; # State storage |
| 31 | |
| 32 | # # ## ### ##### ######## ############# ##################### |
| @@ -114,12 +115,12 @@ | |
| 115 | set usr [UserPath $rcs isattic] |
| 116 | if {[IsSuperceded $base $rcs $usr $isattic]} continue |
| 117 | |
| 118 | # XXX Checkme: not sure if this will still fail in the case where a directory does conflict with a file XXX |
| 119 | if { |
| 120 | [fileexists_ci $base/$usr] && |
| 121 | [fileisdir_ci $base/$usr] |
| 122 | } { |
| 123 | trouble fatal "Directory name conflicts with filename." |
| 124 | trouble fatal "Please remove or rename one of the following:" |
| 125 | trouble fatal " $base/$usr" |
| 126 | trouble fatal " $base/$rcs" |
| @@ -218,14 +219,12 @@ | |
| 219 | } |
| 220 | |
| 221 | proc IsSuperceded {base rcs usr isattic} { |
| 222 | ::variable myignore |
| 223 | |
| 224 | if {!$isattic} {return 0} |
| 225 | if {![fileexists_ci $base/$usr,v]} {return 0} |
| 226 | |
| 227 | # We have a regular archive and an Attic archive refering to |
| 228 | # the same user visible file. Ignore the file in the Attic. |
| 229 | # |
| 230 | # By default this is a problem causing an abort after the pass |
| @@ -256,14 +255,15 @@ | |
| 255 | namespace eval collar { |
| 256 | namespace import ::vc::fossil::import::cvs::repository |
| 257 | namespace import ::vc::fossil::import::cvs::state |
| 258 | namespace import ::vc::tools::trouble |
| 259 | namespace import ::vc::tools::log |
| 260 | namespace import ::vc::tools::misc::file* |
| 261 | log register collar |
| 262 | } |
| 263 | } |
| 264 | |
| 265 | # # ## ### ##### ######## ############# ##################### |
| 266 | ## Ready |
| 267 | |
| 268 | package provide vc::fossil::import::cvs::pass::collar 1.0 |
| 269 | return |
| 270 |
+45
-1
| --- tools/cvs2fossil/lib/misc.tcl | ||
| +++ tools/cvs2fossil/lib/misc.tcl | ||
| @@ -83,16 +83,60 @@ | ||
| 83 | 83 | |
| 84 | 84 | proc striptrailingslash {path} { |
| 85 | 85 | # split and rejoin gets rid of a traling / character. |
| 86 | 86 | return [eval [linsert [file split $path] 0 ::file join]] |
| 87 | 87 | } |
| 88 | + | |
| 89 | + # The windows filesystem is storing file-names case-sensitive, but | |
| 90 | + # matching is case-insensitive. That is a problem as without | |
| 91 | + # precaution the two files Attic/X,v and x,v may be mistakenly | |
| 92 | + # identified as the same file. A similar thing can happen for | |
| 93 | + # files and directories. To prevent such mistakes we need commands | |
| 94 | + # which do case-sensitive file matching even on systems which do | |
| 95 | + # not perform this natively. These are below. | |
| 96 | + | |
| 97 | + if {$tcl_platform(platform) eq "windows"} { | |
| 98 | + # We use glob to get the list of files (with proper case in | |
| 99 | + # the names) to perform our own, case-sensitive matching. WE | |
| 100 | + # use 8.5 features where possible, for clarity. | |
| 101 | + | |
| 102 | + if {[package vsatisfies [package present Tcl] 8.5]} { | |
| 103 | + proc fileexists_ci {path} { | |
| 104 | + set dir [::file dirname $path] | |
| 105 | + set file [::file tail $path] | |
| 106 | + return [expr {$file in [glob -nocomplain -tail -directory $dir *]}] | |
| 107 | + } | |
| 108 | + | |
| 109 | + proc fileisdir_ci {path} { | |
| 110 | + set dir [::file dirname $path] | |
| 111 | + set file [::file tail $path] | |
| 112 | + return [expr {$file in [glob -nocomplain -types d -tail -directory $dir *]}] | |
| 113 | + } | |
| 114 | + } else { | |
| 115 | + proc fileexists_ci {path} { | |
| 116 | + set dir [::file dirname $path] | |
| 117 | + set file [::file tail $path] | |
| 118 | + return [expr {[lsearch [glob -nocomplain -tail -directory $dir *] $file] >= 0}] | |
| 119 | + } | |
| 120 | + | |
| 121 | + proc fileisdir_ci {path} { | |
| 122 | + set dir [::file dirname $path] | |
| 123 | + set file [::file tail $path] | |
| 124 | + return [expr {[lsearch [glob -nocomplain -types d -tail -directory $dir *] $file] >= 0}] | |
| 125 | + } | |
| 126 | + } | |
| 127 | + } else { | |
| 128 | + proc fileexists_ci {path} { return [file exists $path] } | |
| 129 | + proc fileisdir_ci {path} { return [file isdirectory $path] } | |
| 130 | + } | |
| 88 | 131 | |
| 89 | 132 | # # ## ### ##### ######## ############# |
| 90 | 133 | } |
| 91 | 134 | |
| 92 | 135 | namespace eval ::vc::tools::misc { |
| 93 | - namespace export sp nsp max min max2 min2 ldelete striptrailingslash | |
| 136 | + namespace export sp nsp max min max2 min2 ldelete | |
| 137 | + namespace export striptrailingslash fileexists_ci fileisdir_ci | |
| 94 | 138 | } |
| 95 | 139 | |
| 96 | 140 | # ----------------------------------------------------------------------------- |
| 97 | 141 | # Ready |
| 98 | 142 | |
| 99 | 143 |
| --- tools/cvs2fossil/lib/misc.tcl | |
| +++ tools/cvs2fossil/lib/misc.tcl | |
| @@ -83,16 +83,60 @@ | |
| 83 | |
| 84 | proc striptrailingslash {path} { |
| 85 | # split and rejoin gets rid of a traling / character. |
| 86 | return [eval [linsert [file split $path] 0 ::file join]] |
| 87 | } |
| 88 | |
| 89 | # # ## ### ##### ######## ############# |
| 90 | } |
| 91 | |
| 92 | namespace eval ::vc::tools::misc { |
| 93 | namespace export sp nsp max min max2 min2 ldelete striptrailingslash |
| 94 | } |
| 95 | |
| 96 | # ----------------------------------------------------------------------------- |
| 97 | # Ready |
| 98 | |
| 99 |
| --- tools/cvs2fossil/lib/misc.tcl | |
| +++ tools/cvs2fossil/lib/misc.tcl | |
| @@ -83,16 +83,60 @@ | |
| 83 | |
| 84 | proc striptrailingslash {path} { |
| 85 | # split and rejoin gets rid of a traling / character. |
| 86 | return [eval [linsert [file split $path] 0 ::file join]] |
| 87 | } |
| 88 | |
| 89 | # The windows filesystem is storing file-names case-sensitive, but |
| 90 | # matching is case-insensitive. That is a problem as without |
| 91 | # precaution the two files Attic/X,v and x,v may be mistakenly |
| 92 | # identified as the same file. A similar thing can happen for |
| 93 | # files and directories. To prevent such mistakes we need commands |
| 94 | # which do case-sensitive file matching even on systems which do |
| 95 | # not perform this natively. These are below. |
| 96 | |
| 97 | if {$tcl_platform(platform) eq "windows"} { |
| 98 | # We use glob to get the list of files (with proper case in |
| 99 | # the names) to perform our own, case-sensitive matching. WE |
| 100 | # use 8.5 features where possible, for clarity. |
| 101 | |
| 102 | if {[package vsatisfies [package present Tcl] 8.5]} { |
| 103 | proc fileexists_ci {path} { |
| 104 | set dir [::file dirname $path] |
| 105 | set file [::file tail $path] |
| 106 | return [expr {$file in [glob -nocomplain -tail -directory $dir *]}] |
| 107 | } |
| 108 | |
| 109 | proc fileisdir_ci {path} { |
| 110 | set dir [::file dirname $path] |
| 111 | set file [::file tail $path] |
| 112 | return [expr {$file in [glob -nocomplain -types d -tail -directory $dir *]}] |
| 113 | } |
| 114 | } else { |
| 115 | proc fileexists_ci {path} { |
| 116 | set dir [::file dirname $path] |
| 117 | set file [::file tail $path] |
| 118 | return [expr {[lsearch [glob -nocomplain -tail -directory $dir *] $file] >= 0}] |
| 119 | } |
| 120 | |
| 121 | proc fileisdir_ci {path} { |
| 122 | set dir [::file dirname $path] |
| 123 | set file [::file tail $path] |
| 124 | return [expr {[lsearch [glob -nocomplain -types d -tail -directory $dir *] $file] >= 0}] |
| 125 | } |
| 126 | } |
| 127 | } else { |
| 128 | proc fileexists_ci {path} { return [file exists $path] } |
| 129 | proc fileisdir_ci {path} { return [file isdirectory $path] } |
| 130 | } |
| 131 | |
| 132 | # # ## ### ##### ######## ############# |
| 133 | } |
| 134 | |
| 135 | namespace eval ::vc::tools::misc { |
| 136 | namespace export sp nsp max min max2 min2 ldelete |
| 137 | namespace export striptrailingslash fileexists_ci fileisdir_ci |
| 138 | } |
| 139 | |
| 140 | # ----------------------------------------------------------------------------- |
| 141 | # Ready |
| 142 | |
| 143 |