Fossil

Check-in [cbbf9a75]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Got rid of the explicit revision tree and rephrased the trunk processing to use a loop which is more self-explanatory. Started to add in code needed when we process the branches as well, currently they will have now effect.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:cbbf9a7575ae82dec05c2e5dda09d79e7c48f9b0
User & Date: aku 2007-09-20 07:14:44
Context
2007-09-20
07:33
Trim the commit messages to remove irrelevant leading and trailing line-endings. check-in: a9dcf091 user: aku tags: trunk
07:14
Got rid of the explicit revision tree and rephrased the trunk processing to use a loop which is more self-explanatory. Started to add in code needed when we process the branches as well, currently they will have now effect. check-in: cbbf9a75 user: aku tags: trunk
07:08
Moved the counting of imported changesets to the beginning for a more accurate percent calculation and proper ending at 100%. check-in: 330f2da7 user: aku tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to tools/lib/cvs.tcl.

9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
..
27
28
29
30
31
32
33
34

35
36
37
38
39
40

41
42
43
44
45
46
47
..
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99

100
101
102

103
104
105
106
107
108
109
110
111

112


113
114





115
116
117
118
119
120
121
122


123
124
125
126



127
128
129
130
131
132
133
...
262
263
264
265
266
267
268
269
270
271
272
273

274

275
276
277
278
279
280
281
282
283
284
285
286
287
288
289




290
291
292
293
294
295
296
297
298
299


300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317

318
319
320
321
322
323
324
325
326
327




328








329
330
331
332
333
334
335
336
337
338

339
340
341
342
343
344
345
346
...
399
400
401
402
403
404
405
406
407
408

409
410

411
412
413
414
415
416
417
package require vc::rcs::parser       ; # Handling the RCS archive files.
package require vc::tools::log        ; # User feedback
package require vc::tools::trouble    ; # Error handling
package require vc::cvs::cmd          ; # Access to cvs application.
package require vc::cvs::ws::files    ; # Scan CVS repository for relevant files.
package require vc::cvs::ws::timeline ; # Manage timeline of all changes.
package require vc::cvs::ws::csets    ; # Manage the changesets found in the timeline
package require struct::tree

namespace eval ::vc::cvs::ws {
    vc::tools::log::system cvs
    namespace import ::vc::tools::log::write
    namespace import ::vc::rcs::parser::process
    namespace import ::vc::cvs::cmd::dova

................................................................................
# -----------------------------------------------------------------------------
# API

# vc::cvs::ws::configure key value    - Configure the subsystem.
# vc::cvs::ws::check     src mv       - Check if src is a CVS repository directory.
# vc::cvs::ws::begin     src          - Start new workspace and return the top-
#                                       most directory co'd files are put into.
# vc::cvs::ws::ncsets    ?-import?    - Retrieve number of csets (all/to import)

# vc::cvs::ws::foreach   csvar script - Run the script for each changeset, the
#                                       id of the current changeset stored in
#                                       the variable named by csvar.
# vc::cvs::ws::done                   - Close workspace and delete it.
# vc::cvs::ws::isadmin path           - Check if path is an admin file of CVS
# vc::cvs::ws::checkout id            - Have workspace contain the changeset id.

#
# Configuration keys:
#
# -project path - Sub directory under 'src' to limit the import to.

# -----------------------------------------------------------------------------
# API Implementation
................................................................................

proc ::vc::cvs::ws::begin {src} {
    if {![check $src msg]} { return -code error $msg }

    DefBase $src
    MakeTimeline [ScanArchives [files::find [RootPath]]]
    MakeChangesets

    # OLD api calls ... TODO rework for more structure ...
    rtree    ; # Build revision tree (trunk only right now).

    return [MakeWorkspace]
}

proc ::vc::cvs::ws::done {} {
    variable            workspace
    file delete -force $workspace
    return
}

proc ::vc::cvs::ws::foreach {cv script} {
    # OLD api ... TODO inline
    uplevel 1 [list ::vc::cvs::ws::foreach_cset $cv 0 $script]
}


proc ::vc::cvs::ws::ncsets {args} {
    variable ntrunk


    if {[llength $args] > 1} {
	return -code error "wrong#args: Expected ?-import?"
    } elseif {[llength $args] == 1} {
	if {[set k [lindex $args 0]] ne "-import"} {
	    return -code "Unknown switch $k, expected -import"
	} else {
	    return $ntrunk
	}
    }




    return [csets::num]
}






proc ::vc::cvs::ws::isadmin {path} {
    # Check if path is a CVS admin file.
    if {[string match CVS/*   $path]} {return 1}
    if {[string match */CVS/* $path]} {return 1}
    return 0
}



proc ::vc::cvs::ws::checkout {id} {
    variable workspace
    cd      $workspace




    array set cs [csets::get $id]

    write 1 cvs "@  $cs(date)"
    ::foreach l [split [string trim $cs(cmsg)] \n] {
	write 1 cvs "|  $l"
    }

................................................................................
    return $w
}

# Building the revision tree from the changesets.
# Limitation: Currently only trunk csets is handled.
# Limitation: Dead files are not removed, i.e. no 'R' actions right now.

proc ::vc::cvs::ws::rtree {} {
    variable rtree {}
    variable ntrunk 0

    write 0 cvs "Extracting the trunk"



    set rtree [struct::tree ::vc::cvs::ws::RT]
    $rtree rename root 0 ; # Root is first changeset, always.
    set trunk 0
    set ntrunk 1 ; # Root is on the trunk.
    set b      0 ; # No branch csets found yet.

    # Extracting the trunk is easy, simply by looking at the involved
    # version numbers. 

    for {set c 1} {$c < [csets::num]} {incr c} {
	array set cs [csets::get $c]
	# Ignore branch changes, just count them for the statistics.
	if {$cs(lastd) != 2} {
	    incr b
	    continue




	}

	# Trunk revision, connect to, and update the head.
	$rtree insert $trunk end $c
	set trunk $c
	incr ntrunk
    }

    write 0 cvs "Processed $ntrunk trunk  [expr {($ntrunk == 1) ? "changeset" : "changesets"}]"
    write 0 cvs "Ignored   $b branch [expr {($b == 1) ? "changeset" : "changesets"}]"


    return
}

namespace eval ::vc::cvs::ws {
    # Tree holding trunk and branch information (struct::tree).
    # Node names are cset id's.

    variable rtree {}
    variable ntrunk 0
}

proc ::vc::cvs::ws::foreach_cset {cv node script} {
    upvar 1 $cv c
    variable rtree

    set c $node
    while {1} {
	set code [catch {uplevel 1 $script} res]


	# 0 - ok, 1 - error, 2 - return, 3 - break, 4 - continue
	switch -- $code {
	    0 {}
	    1 { return -errorcode $::errorCode -errorinfo $::errorInfo -code error $res }
	    2 {}
	    3 { return }
	    4 {}
	    default {
		return -code $code $result




	    }








	}

	# Stop on reaching the head.
	if {![llength [$rtree children $c]]} break

	#puts <[$rtree children $c]>

	# Go to next child in trunk (leftmost).
	set c [lindex [$rtree children $c] 0]
    }

    return
}

proc ::vc::cvs::ws::Checkout {f r} {
    variable base
    variable project

    # Added or modified, put the requested version of the file into
................................................................................
    if {$plural eq ""} {set plural ${singular}s}
    return $plural
}

# -----------------------------------------------------------------------------

namespace eval ::vc::cvs::ws {
    variable base      {} ; # Toplevel repository directory
    variable project   {} ; # Sub directory to limit the import to.
    variable workspace {} ; # Directory to checkout changesets to.


    namespace export configure begin done foreach ncsets checkout

}

# -----------------------------------------------------------------------------
# Ready

package provide vc::cvs::ws 1.0
return







<







 







|
>






>







 







|
<
<











|
|
|
<
>
|
<

>
|
|
|
|
|
|
|


>
|
>
>


>
>
>
>
>








>
>




>
>
>







 







|
|
<

<
>

>
|
<
<
<
<

<
<

<
<
<
<
<
<
>
>
>
>
|
<
<
<
<
<
<
<
<
<
>
>



<
<
<
<
<
<
<
<
|
<
|

<
<
<
>

<
<
<
<
<
<
<
<
<
>
>
>
>
|
>
>
>
>
>
>
>
>

|
<
<

<
<
<
<
<
>
|







 







|
|
|
>

|
>







9
10
11
12
13
14
15

16
17
18
19
20
21
22
..
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
..
76
77
78
79
80
81
82
83


84
85
86
87
88
89
90
91
92
93
94
95
96
97

98
99

100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
...
274
275
276
277
278
279
280
281
282

283

284
285
286
287




288


289






290
291
292
293
294









295
296
297
298
299








300

301
302



303
304









305
306
307
308
309
310
311
312
313
314
315
316
317
318
319


320





321
322
323
324
325
326
327
328
329
...
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
package require vc::rcs::parser       ; # Handling the RCS archive files.
package require vc::tools::log        ; # User feedback
package require vc::tools::trouble    ; # Error handling
package require vc::cvs::cmd          ; # Access to cvs application.
package require vc::cvs::ws::files    ; # Scan CVS repository for relevant files.
package require vc::cvs::ws::timeline ; # Manage timeline of all changes.
package require vc::cvs::ws::csets    ; # Manage the changesets found in the timeline


namespace eval ::vc::cvs::ws {
    vc::tools::log::system cvs
    namespace import ::vc::tools::log::write
    namespace import ::vc::rcs::parser::process
    namespace import ::vc::cvs::cmd::dova

................................................................................
# -----------------------------------------------------------------------------
# API

# vc::cvs::ws::configure key value    - Configure the subsystem.
# vc::cvs::ws::check     src mv       - Check if src is a CVS repository directory.
# vc::cvs::ws::begin     src          - Start new workspace and return the top-
#                                       most directory co'd files are put into.
# vc::cvs::ws::ncsets                 - Retrieve total number of csets
# vc::cvs::ws::nimportable            - Retrieve number of importable csets
# vc::cvs::ws::foreach   csvar script - Run the script for each changeset, the
#                                       id of the current changeset stored in
#                                       the variable named by csvar.
# vc::cvs::ws::done                   - Close workspace and delete it.
# vc::cvs::ws::isadmin path           - Check if path is an admin file of CVS
# vc::cvs::ws::checkout id            - Have workspace contain the changeset id.
# vc::cvs::ws::get      id            - Retrieve data of a changeset.
#
# Configuration keys:
#
# -project path - Sub directory under 'src' to limit the import to.

# -----------------------------------------------------------------------------
# API Implementation
................................................................................

proc ::vc::cvs::ws::begin {src} {
    if {![check $src msg]} { return -code error $msg }

    DefBase $src
    MakeTimeline [ScanArchives [files::find [RootPath]]]
    MakeChangesets
    ProcessBranches



    return [MakeWorkspace]
}

proc ::vc::cvs::ws::done {} {
    variable            workspace
    file delete -force $workspace
    return
}

proc ::vc::cvs::ws::foreach {cv script} {
    variable importable
    upvar 1 $cv c


    ::foreach c [lsort -integer -increasing $importable] {
	set code [catch {uplevel 1 $script} res]


	# 0 - ok, 1 - error, 2 - return, 3 - break, 4 - continue
	switch -- $code {
	    0 {}
	    1 { return -errorcode $::errorCode -errorinfo $::errorInfo -code error $res }
	    2 {}
	    3 { return }
	    4 {}
	    default { return -code $code $result }
	}
    }
    return
}

proc ::vc::cvs::ws::ncsets {args} {
    return [csets::num]
}

proc ::vc::cvs::ws::nimportable {args} {
    variable importable
    return [llength $importable]
}

proc ::vc::cvs::ws::isadmin {path} {
    # Check if path is a CVS admin file.
    if {[string match CVS/*   $path]} {return 1}
    if {[string match */CVS/* $path]} {return 1}
    return 0
}

proc ::vc::cvs::ws::parentOf {id} { csets::parentOf $id }

proc ::vc::cvs::ws::checkout {id} {
    variable workspace
    cd      $workspace

    # TODO: Hide the direct access to the data structures behind
    # TODO: accessors for date, cmsg, removed, added, changed, and
    # TODO: author
    array set cs [csets::get $id]

    write 1 cvs "@  $cs(date)"
    ::foreach l [split [string trim $cs(cmsg)] \n] {
	write 1 cvs "|  $l"
    }

................................................................................
    return $w
}

# Building the revision tree from the changesets.
# Limitation: Currently only trunk csets is handled.
# Limitation: Dead files are not removed, i.e. no 'R' actions right now.

proc ::vc::cvs::ws::ProcessBranches {} {
    variable importable



    write 0 cvs "Organizing the changesets into branches"

    set remainder [ProcessTrunk]
    # TODO: Processing non-trunk branches














    # Status information ...
    set nr  [llength $remainder]
    set ni  [llength $importable]
    set fmt %[string length [csets::num]]s










    write 0 cvs "Unprocessed: [format $fmt $nr] [SIPL $nr changeset] (Will be ignored)"
    write 0 cvs "To import:   [format $fmt $ni] [SIPL $ni changeset]"
    return
}









proc ::vc::cvs::ws::ProcessTrunk {} {

    variable importable




    write 0 cvs "Processing the trunk changesets"










    set remainder {}
    set t         0
    set n         [csets::num]
    set parent    {}

    for {set c 0} {$c < $n} {incr c} {
	if {[csets::isTrunk $c]} {
	    csets::setParentOf $c $parent
	    set parent $c
	    incr t
	    lappend importable $c
	} else {
	    lappend remainder $c
	}
    }








    write 0 cvs "Found [NSIPL $t {trunk changeset}], [NSIPL [llength $remainder] {branch changeset}]"
    return $remainder
}

proc ::vc::cvs::ws::Checkout {f r} {
    variable base
    variable project

    # Added or modified, put the requested version of the file into
................................................................................
    if {$plural eq ""} {set plural ${singular}s}
    return $plural
}

# -----------------------------------------------------------------------------

namespace eval ::vc::cvs::ws {
    variable base       {} ; # Toplevel repository directory
    variable project    {} ; # Sub directory to limit the import to.
    variable workspace  {} ; # Directory to checkout changesets to.
    variable importable {} ; # List of the csets which can be imported.

    namespace export configure begin done foreach ncsets nimportable checkout
    namespace export parentOf
}

# -----------------------------------------------------------------------------
# Ready

package provide vc::cvs::ws 1.0
return

Changes to tools/lib/cvs_csets.tcl.

18
19
20
21
22
23
24

25
26
27
28
29
30
31
..
46
47
48
49
50
51
52


















53
54
55
56
57
58
59
...
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
# vc::cvs::ws::csets::get id - Get data of a cset.
# vc::cvs::ws::csets::num    - Get number of csets.

# -----------------------------------------------------------------------------
# API Implementation

proc ::vc::cvs::ws::csets::init {} {

    Current::Clear
    return
}

proc ::vc::cvs::ws::csets::add {date file revision operation author cmsg} {
    if {![Current::Empty] && [Current::New $file $revision $author $cmsg]} {
	Save [Current::Complete]
................................................................................
    return  $csets($id)
}

proc ::vc::cvs::ws::csets::num {} {
    variable csets
    return [array size csets]
}



















# -----------------------------------------------------------------------------
# Internal helper commands: Changeset inspection and construction.

proc ::vc::cvs::ws::csets::Save {data} {
    variable csets
    variable ncs
................................................................................
	variable  removed {} ; # file -> revision of removed files.
	variable  added   {} ; # file -> revision of added files.
	variable  changed {} ; # file -> revision of modified files.
	variable  files
	array set files {}   ; # file -> revision
    }

    namespace export init add done get num
}

# -----------------------------------------------------------------------------
# Ready

package provide vc::cvs::ws::csets 1.0
return







>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|







18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
..
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
...
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
# vc::cvs::ws::csets::get id - Get data of a cset.
# vc::cvs::ws::csets::num    - Get number of csets.

# -----------------------------------------------------------------------------
# API Implementation

proc ::vc::cvs::ws::csets::init {} {
    variable ncs 0
    Current::Clear
    return
}

proc ::vc::cvs::ws::csets::add {date file revision operation author cmsg} {
    if {![Current::Empty] && [Current::New $file $revision $author $cmsg]} {
	Save [Current::Complete]
................................................................................
    return  $csets($id)
}

proc ::vc::cvs::ws::csets::num {} {
    variable csets
    return [array size csets]
}

proc ::vc::cvs::ws::csets::isTrunk {id} {
    variable csets
    array set cs $csets($id)
    return [expr {$cs(lastd) == 2}]
}

proc ::vc::cvs::ws::csets::setParentOf {id parent} {
    variable csets
    lappend  csets($id) parent $parent
    return
}

proc ::vc::cvs::ws::csets::parentOf {id} {
    variable      csets
    array set cs $csets($id)
    return   $cs(parent)
}

# -----------------------------------------------------------------------------
# Internal helper commands: Changeset inspection and construction.

proc ::vc::cvs::ws::csets::Save {data} {
    variable csets
    variable ncs
................................................................................
	variable  removed {} ; # file -> revision of removed files.
	variable  added   {} ; # file -> revision of added files.
	variable  changed {} ; # file -> revision of modified files.
	variable  files
	array set files {}   ; # file -> revision
    }

    namespace export init add done get num isTrunk setParentOf parentOf
}

# -----------------------------------------------------------------------------
# Ready

package provide vc::cvs::ws::csets 1.0
return

Changes to tools/lib/fossil.tcl.

17
18
19
20
21
22
23

24
25
26
27
28
29
30
..
78
79
80
81
82
83
84









85
86
87
88
89
90
91
...
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221

# -----------------------------------------------------------------------------
# API

# vc::fossil::ws::configure key value         - Configure the subsystem.
# vc::fossil::ws::begin     src               - Start new workspace for directory
# vc::fossil::ws::done      dst               - Close workspace and copy to destination.

# vc::fossil::ws::commit    cset usr time msg - Look for changes and commit as new revision.

# Configuration keys:
#
# -nosign  bool		default 0 (= sign imported changesets)
# -breakat num		default empty, no breakpoint.
#			Otherwise stop before committing the identified changeset.
................................................................................

proc ::vc::fossil::ws::done {destination} {
    variable rp
    file rename -force $rp $destination
    set rp {}
    return
}










proc ::vc::fossil::ws::commit {cset user timestamp message} {
    variable lastuuid
    variable base

    cd $base

................................................................................
    variable appname {} ; # Name of importer application using the package.
    variable ignore  {} ; # No files to ignore.

    variable base     {} ; # Workspace directory
    variable rp       {} ; # Repository the package works on.
    variable lastuuid {} ; # Uuid of last imported changeset.

    namespace export configure begin done commit
}

# -----------------------------------------------------------------------------
# Ready

package provide vc::fossil::ws 1.0
return







>







 







>
>
>
>
>
>
>
>
>







 







|







17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
..
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
...
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231

# -----------------------------------------------------------------------------
# API

# vc::fossil::ws::configure key value         - Configure the subsystem.
# vc::fossil::ws::begin     src               - Start new workspace for directory
# vc::fossil::ws::done      dst               - Close workspace and copy to destination.
# vc::fossil::ws::setup     uuid              - Move workspace to an older revision.
# vc::fossil::ws::commit    cset usr time msg - Look for changes and commit as new revision.

# Configuration keys:
#
# -nosign  bool		default 0 (= sign imported changesets)
# -breakat num		default empty, no breakpoint.
#			Otherwise stop before committing the identified changeset.
................................................................................

proc ::vc::fossil::ws::done {destination} {
    variable rp
    file rename -force $rp $destination
    set rp {}
    return
}

proc ::vc::fossil::ws::setup {uuid} {
    variable lastuuid
    if {$uuid eq $lastuuid} return
    write 1 fossil "=> goto $uuid"
    dova update $uuid
    set lastuuid $uuid
    return
}

proc ::vc::fossil::ws::commit {cset user timestamp message} {
    variable lastuuid
    variable base

    cd $base

................................................................................
    variable appname {} ; # Name of importer application using the package.
    variable ignore  {} ; # No files to ignore.

    variable base     {} ; # Workspace directory
    variable rp       {} ; # Repository the package works on.
    variable lastuuid {} ; # Uuid of last imported changeset.

    namespace export configure begin done setup commit
}

# -----------------------------------------------------------------------------
# Ready

package provide vc::fossil::ws 1.0
return

Changes to tools/lib/importcvs.tcl.

58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
..
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
    return
}

# Import the CVS repository found at directory 'src' into the new
# fossil repository at 'dst'.

proc ::vc::fossil::import::cvs::run {src dst} {
    #B map::set {} {}

    set src [file normalize $src]
    set dst [file normalize $dst]

    set ws [cvs::begin $src]
    fossil::begin $ws
    stats::setup [cvs::ncsets -import] [cvs::ncsets]

    cvs::foreach cset {
	Import1 $cset
    }

    stats::done
    fossil::done $dst
................................................................................
    set seconds      [expr {$microseconds/1e6}]

    stats::csend $seconds
    return
}

proc ::vc::fossil::import::cvs::ImportCS {cset} {
    #B fossil::setup [map::get [cvs::parentOf $cset]]
    lassign [cvs::checkout  $cset] user  timestamp  message
    lassign [fossil::commit $cset $user $timestamp $message] uuid ad rm ch
    write 2 import "== +${ad}-${rm}*${ch}"
    map::set $cset $uuid
    return
}








|






|







 







|







58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
..
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
    return
}

# Import the CVS repository found at directory 'src' into the new
# fossil repository at 'dst'.

proc ::vc::fossil::import::cvs::run {src dst} {
    map::set {} {}

    set src [file normalize $src]
    set dst [file normalize $dst]

    set ws [cvs::begin $src]
    fossil::begin $ws
    stats::setup [cvs::nimportable] [cvs::ncsets]

    cvs::foreach cset {
	Import1 $cset
    }

    stats::done
    fossil::done $dst
................................................................................
    set seconds      [expr {$microseconds/1e6}]

    stats::csend $seconds
    return
}

proc ::vc::fossil::import::cvs::ImportCS {cset} {
    fossil::setup [map::get [cvs::parentOf $cset]]
    lassign [cvs::checkout  $cset] user  timestamp  message
    lassign [fossil::commit $cset $user $timestamp $message] uuid ad rm ch
    write 2 import "== +${ad}-${rm}*${ch}"
    map::set $cset $uuid
    return
}