1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
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
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
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
|
# patch.tcl --
#
# Application of a diff -ruN patch to a directory tree.
#
# Copyright (c) 2019 Christian Gollwitzer <auriocus@gmx.de>
# with tweaks by Andreas Kupries
# - Factored patch parsing into a helper
# - Replaced `puts` with report callback.
package require Tcl 8.5
package provide textutil::patch 0.1
# # ## ### ##### ######## ############# #####################
namespace eval ::textutil::patch {
namespace export apply
namespace ensemble create
}
# # ## ### ##### ######## ############# #####################
proc ::textutil::patch::apply {dir striplevel patch reportcmd} {
set patchdict [Parse $dir $striplevel $patch]
# Apply, now that we have parsed the patch.
dict for {fn hunks} $patchdict {
Report apply $fn
if {[catch {open $fn} fd]} {
set orig {}
} else {
set orig [split [read $fd] \n]
}
close $fd
set patched $orig
set fail false
set already_applied false
set hunknr 1
foreach hunk $hunks {
dict with hunk {
set oldend [expr {$oldstart+[llength $oldcode]-1}]
set newend [expr {$newstart+[llength $newcode]-1}]
# check if the hunk matches
set origcode [lrange $orig $oldstart $oldend]
if {$origcode ne $oldcode} {
set fail true
# check if the patch is already applied
set origcode_applied [lrange $orig $newstart $newend]
if {$origcode_applied eq $newcode} {
set already_applied true
Report fail-already $fn $hunknr
} else {
Report fail $fn $hunknr $oldcode $origcode
}
break
}
# apply patch
set patched [list \
{*}[lrange $patched 0 $newstart-1] \
{*}$newcode \
{*}[lrange $orig $oldend+1 end]]
}
incr hunknr
}
if {!$fail} {
# success - write the result back
set fd [open $fn w]
puts -nonewline $fd [join $patched \n]
close $fd
}
}
return
}
# # ## ### ##### ######## ############# #####################
proc ::textutil::patch::Report {args} {
upvar 1 reportcmd reportcmd
uplevel #0 [list {*}$reportcmd {*}$args]
##
# apply $fname
# fail-already $fname $hunkno
# fail $fname $hunkno $expected $seen
##
}
proc ::textutil::patch::Parse {dir striplevel patch} {
set patchlines [split $patch \n]
set inhunk false
set oldcode {}
set newcode {}
set n [llength $patchlines]
set patchdict {}
for {set lineidx 0} {$lineidx < $n} {incr lineidx} {
set line [lindex $patchlines $lineidx]
if {[string match ---* $line]} {
# a diff block starts. Current line should be
# --- oldfile date time TZ
# Next line should be
# +++ newfile date time TZ
set in $line
incr lineidx
set out [lindex $patchlines $lineidx]
if {![string match ---* $in] || ![string match +++* $out]} {
#puts $in
#puts $out
return -code error "Patch not in unified diff format, line $lineidx $in $out"
}
# the quoting is compatible with list
lassign $in -> oldfile
lassign $out -> newfile
set fntopatch [file join $dir {*}[lrange [file split $oldfile] $striplevel end]]
set inhunk false
#puts "Found diffline for $fntopatch"
continue
}
# state machine for parsing the hunks
set typechar [string index $line 0]
set codeline [string range $line 1 end]
switch $typechar {
@ {
if {![regexp {@@\s+\-(\d+),(\d+)\s+\+(\d+),(\d+)\s+@@} $line \
-> oldstart oldlen newstart newlen]} {
return code -error "Erroneous hunk in line $lindeidx, $line"
}
# adjust line numbers for 0-based indexing
incr oldstart -1
incr newstart -1
#puts "New hunk"
set newcode {}
set oldcode {}
set inhunk true
}
- { # line only in old code
if {$inhunk} {
lappend oldcode $codeline
}
}
+ { # line only in new code
if {$inhunk} {
lappend newcode $codeline
}
}
" " { # common line
if {$inhunk} {
lappend oldcode $codeline
lappend newcode $codeline
}
}
default {
# puts "Junk: $codeline";
continue
}
}
# test if the hunk is complete
if {[llength $oldcode]==$oldlen && [llength $newcode]==$newlen} {
set hunk [dict create \
oldcode $oldcode \
newcode $newcode \
oldstart $oldstart \
newstart $newstart]
#puts "hunk complete: $hunk"
set inhunk false
dict lappend patchdict $fntopatch $hunk
}
}
return $patchdict
}
# # ## ### ##### ######## ############# #####################
return
|
