Fossil SCM
Added more checks to pass I looking for possible file/directory conflicts in the repository, and modified traverser to report on and ignore sub directories of Attic's.
Commit
a10f654ac719780b97e647130c79c9654043978f
Parent
338854a61ad1f3b…
1 file changed
+27
-1
+27
-1
| --- tools/cvs2fossil/lib/c2f_pcollar.tcl | ||
| +++ tools/cvs2fossil/lib/c2f_pcollar.tcl | ||
| @@ -83,11 +83,12 @@ | ||
| 83 | 83 | set rbase [repository base?] |
| 84 | 84 | foreach project [repository projects] { |
| 85 | 85 | set base [file join $rbase [$project base]] |
| 86 | 86 | log write 1 collar "Scan $base" |
| 87 | 87 | |
| 88 | - set traverse [fileutil::traverse %AUTO% $base] | |
| 88 | + set traverse [fileutil::traverse %AUTO% $base \ | |
| 89 | + -prefilter [myproc FilterAtticSubdir $base]] | |
| 89 | 90 | set n 0 |
| 90 | 91 | set r {} |
| 91 | 92 | |
| 92 | 93 | $traverse foreach path { |
| 93 | 94 | set rcs [fileutil::stripPath $base $path] |
| @@ -94,10 +95,21 @@ | ||
| 94 | 95 | if {[IsCVSAdmin $rcs]} continue |
| 95 | 96 | if {![IsRCSArchive $path]} continue |
| 96 | 97 | |
| 97 | 98 | set usr [UserPath $rcs isattic] |
| 98 | 99 | if {[IsSuperceded $base $rcs $usr $isattic]} continue |
| 100 | + | |
| 101 | + if { | |
| 102 | + [file exists $base/$usr] && | |
| 103 | + [file isdirectory $base/$usr] | |
| 104 | + } { | |
| 105 | + trouble fatal "Directory name conflicts with filename." | |
| 106 | + trouble fatal "Please remove or rename one of the following:" | |
| 107 | + trouble fatal " $base/$usr" | |
| 108 | + trouble fatal " $base/$rcs" | |
| 109 | + continue | |
| 110 | + } | |
| 99 | 111 | |
| 100 | 112 | log write 4 collar "Found $rcs" |
| 101 | 113 | $project add $rcs $usr |
| 102 | 114 | |
| 103 | 115 | incr n |
| @@ -123,10 +135,24 @@ | ||
| 123 | 135 | |
| 124 | 136 | # # ## ### ##### ######## ############# |
| 125 | 137 | ## Internal methods |
| 126 | 138 | |
| 127 | 139 | typevariable myignore 0 |
| 140 | + | |
| 141 | + proc FilterAtticSubdir {base path} { | |
| 142 | + # This command is used by the traverser to prevent it from | |
| 143 | + # scanning into subdirectories of an Attic. We get away with | |
| 144 | + # checking the immediate parent directory of the current path | |
| 145 | + # as our rejection means that deeper path do not occur. | |
| 146 | + | |
| 147 | + if {[file tail [file dirname $path]] eq "Attic"} { | |
| 148 | + set ad [fileutil::stripPath $base $path] | |
| 149 | + log write 1 collar "Directory $ad found in Attic, ignoring." | |
| 150 | + return 0 | |
| 151 | + } | |
| 152 | + return 1 | |
| 153 | + } | |
| 128 | 154 | |
| 129 | 155 | proc IsRCSArchive {path} { |
| 130 | 156 | if {![string match *,v $path]} {return 0} |
| 131 | 157 | if {[fileutil::test $path fr msg]} {return 1} |
| 132 | 158 | trouble warn $msg |
| 133 | 159 |
| --- tools/cvs2fossil/lib/c2f_pcollar.tcl | |
| +++ tools/cvs2fossil/lib/c2f_pcollar.tcl | |
| @@ -83,11 +83,12 @@ | |
| 83 | set rbase [repository base?] |
| 84 | foreach project [repository projects] { |
| 85 | set base [file join $rbase [$project base]] |
| 86 | log write 1 collar "Scan $base" |
| 87 | |
| 88 | set traverse [fileutil::traverse %AUTO% $base] |
| 89 | set n 0 |
| 90 | set r {} |
| 91 | |
| 92 | $traverse foreach path { |
| 93 | set rcs [fileutil::stripPath $base $path] |
| @@ -94,10 +95,21 @@ | |
| 94 | if {[IsCVSAdmin $rcs]} continue |
| 95 | if {![IsRCSArchive $path]} continue |
| 96 | |
| 97 | set usr [UserPath $rcs isattic] |
| 98 | if {[IsSuperceded $base $rcs $usr $isattic]} continue |
| 99 | |
| 100 | log write 4 collar "Found $rcs" |
| 101 | $project add $rcs $usr |
| 102 | |
| 103 | incr n |
| @@ -123,10 +135,24 @@ | |
| 123 | |
| 124 | # # ## ### ##### ######## ############# |
| 125 | ## Internal methods |
| 126 | |
| 127 | typevariable myignore 0 |
| 128 | |
| 129 | proc IsRCSArchive {path} { |
| 130 | if {![string match *,v $path]} {return 0} |
| 131 | if {[fileutil::test $path fr msg]} {return 1} |
| 132 | trouble warn $msg |
| 133 |
| --- tools/cvs2fossil/lib/c2f_pcollar.tcl | |
| +++ tools/cvs2fossil/lib/c2f_pcollar.tcl | |
| @@ -83,11 +83,12 @@ | |
| 83 | set rbase [repository base?] |
| 84 | foreach project [repository projects] { |
| 85 | set base [file join $rbase [$project base]] |
| 86 | log write 1 collar "Scan $base" |
| 87 | |
| 88 | set traverse [fileutil::traverse %AUTO% $base \ |
| 89 | -prefilter [myproc FilterAtticSubdir $base]] |
| 90 | set n 0 |
| 91 | set r {} |
| 92 | |
| 93 | $traverse foreach path { |
| 94 | set rcs [fileutil::stripPath $base $path] |
| @@ -94,10 +95,21 @@ | |
| 95 | if {[IsCVSAdmin $rcs]} continue |
| 96 | if {![IsRCSArchive $path]} continue |
| 97 | |
| 98 | set usr [UserPath $rcs isattic] |
| 99 | if {[IsSuperceded $base $rcs $usr $isattic]} continue |
| 100 | |
| 101 | if { |
| 102 | [file exists $base/$usr] && |
| 103 | [file isdirectory $base/$usr] |
| 104 | } { |
| 105 | trouble fatal "Directory name conflicts with filename." |
| 106 | trouble fatal "Please remove or rename one of the following:" |
| 107 | trouble fatal " $base/$usr" |
| 108 | trouble fatal " $base/$rcs" |
| 109 | continue |
| 110 | } |
| 111 | |
| 112 | log write 4 collar "Found $rcs" |
| 113 | $project add $rcs $usr |
| 114 | |
| 115 | incr n |
| @@ -123,10 +135,24 @@ | |
| 135 | |
| 136 | # # ## ### ##### ######## ############# |
| 137 | ## Internal methods |
| 138 | |
| 139 | typevariable myignore 0 |
| 140 | |
| 141 | proc FilterAtticSubdir {base path} { |
| 142 | # This command is used by the traverser to prevent it from |
| 143 | # scanning into subdirectories of an Attic. We get away with |
| 144 | # checking the immediate parent directory of the current path |
| 145 | # as our rejection means that deeper path do not occur. |
| 146 | |
| 147 | if {[file tail [file dirname $path]] eq "Attic"} { |
| 148 | set ad [fileutil::stripPath $base $path] |
| 149 | log write 1 collar "Directory $ad found in Attic, ignoring." |
| 150 | return 0 |
| 151 | } |
| 152 | return 1 |
| 153 | } |
| 154 | |
| 155 | proc IsRCSArchive {path} { |
| 156 | if {![string match *,v $path]} {return 0} |
| 157 | if {[fileutil::test $path fr msg]} {return 1} |
| 158 | trouble warn $msg |
| 159 |