#!/usr/bin/tclsh
###
# Microversion (uvn)
# Kevin Van Vechten <kvv@apple.com>
# 9/28/2006
###
proc DEBUG {args} {
global DEBUGGING
global env
if {![info exists DEBUGGING]} {
set DEBUGGING [info exists env(UVNDEBUG)]
}
if {$DEBUGGING} {
puts stderr "DEBUG: $args"
}
}
proc PRINT {args} {
puts stdout "$args"
}
proc ldelete {l v} {
upvar $l ul
while {[set i [lsearch -exact $ul $v]] != -1} {
set ul [lreplace $ul $i $i]
}
}
namespace eval uvn {
variable srcroot
variable objroot
variable var
variable state
variable patchlevel 1
proc init {} {
global env
variable srcroot
variable objroot
variable var
variable patchlevel
if {[info exists env(UVNPATCHLEVEL)]} {
set patchlevel $env(UVNPATCHLEVEL)
}
if {[info exists env(RC_XBS)] &&
$env(RC_XBS) == "YES" &&
[info exists env(SRCROOT)] &&
[file isdirectory $env(SRCROOT)] &&
[info exists env(OBJROOT)] &&
[file isdirectory $env(OBJROOT)]} {
DEBUG XBS mode (using SRCROOT and OBJROOT)
set srcroot $env(SRCROOT)
set objroot $env(OBJROOT)
} else {
set dir [pwd]
set origdir $dir
while {![file isdirectory .uvn] && $dir != "/"} {
set dir [file dirname $dir]
cd $dir
}
### check for archive/patches/something
if {$dir == "/"} {
set dir $origdir
cd $dir
}
set srcroot $dir
set objroot $dir
}
set var $objroot/.uvn
}
}
namespace eval uvn::util {
proc cat {path} {
set fd [open $path r]
puts -nonewline [read $fd]
close $fd
}
}
namespace eval uvn::state {
proc save {data} {
if {[file isfile $uvn::var/state] || [llength $data] > 0} {
file mkdir $uvn::var
set fd [open $uvn::var/.tmp.state w]
puts $fd $data
close $fd
file rename -force $uvn::var/.tmp.state $uvn::var/state
}
}
proc load {} {
if {[file exists $uvn::var/state]} {
set fd [open $uvn::var/state r]
set data [read -nonewline $fd]
close $fd
} else {
set data [list]
}
return $data
}
}
proc find_distfile {} {
set sources {}
foreach suffix {.tar .tar.Z .tar.gz .tar.bz2 .tgz .tbz2} {
set files [glob -nocomplain -type f *$suffix]
if {[llength $files] > 0} {
lappend sources $files
}
}
set c [llength $sources]
if {$c == 0} {
return -code error "no source archive"
} elseif {$c > 1} {
return -code error "too many source archives; please specify one"
} else {
return [file join [pwd] [lindex $sources 0]]
}
}
proc extract_sources {path {suffix ""}} {
set cmd {tar -xf -}
switch -glob -- $path {
*.tar { set cmd {tar -xf -} }
*.tar.Z { set cmd {tar -xZf -} }
*.tar.gz { set cmd {tar -xzf -} }
*.tgz { set cmd {tar -xzf -} }
*.tar.bz2 { set cmd {tar -xjf -} }
*.tbz2 { set cmd {tar -xjf -} }
default { return -code error "unsupported archive format: $path" }
}
### Validate temp ###
file mkdir $uvn::var/extract
eval DEBUG $cmd -C $uvn::var/extract < $path
eval exec -- $cmd -C $uvn::var/extract < $path
set files [glob $uvn::var/extract/*]
if {[llength $files] == 0} {
return -code error "archive is empty: $path"
} elseif {[llength $files] > 1} {
return -code error "archive does not have root directory: $path"
}
set dir [lindex $files 0]
if {![file isdirectory $dir]} {
return -code error "archive does not contain a directory: $path"
}
### Make temp visible (with optional suffix appended) ###
set dst [file join $uvn::objroot [file tail $dir]$suffix]
if {![file exists $dst]} {
file rename $dir $dst
}
return $dst
}
##### main #####
proc extract {} {
if {![info exists uvn::state(distfile)]} {
set uvn::state(distfile) [find_distfile]
}
if {![info exists uvn::state(workdir)] ||
![file exists $uvn::state(workdir)]} {
PRINT Extracting: [file tail $uvn::state(distfile)]
set uvn::state(workdir) [extract_sources $uvn::state(distfile)]
}
}
proc clean {} {
PRINT Cleaning
foreach dir {workdir origdir} {
DEBUG cleaning $dir
if {[info exists uvn::state($dir)] &&
[file isdirectory $uvn::state($dir)]} {
DEBUG deleting $uvn::state($dir)
file delete -force $uvn::state($dir)
}
}
if {[file isfile $uvn::var/state]} {
DEBUG deleting $uvn::var/state
file delete -force $uvn::var/state
}
array unset uvn::state
}
proc diff {{outfile -}} {
if {![info exists uvn::state(origdir)]} {
PRINT Extracting orig: [file tail $uvn::state(distfile)]
set uvn::state(origdir) [extract_sources $uvn::state(distfile) .orig]
}
if {[info exists uvn::state(workdir)]} {
file mkdir $uvn::var
cd $uvn::objroot
### diff exits 1 if files differ ###
DEBUG diff -r -u -N --exclude=*.orig [file tail $uvn::state(origdir)] [file tail $uvn::state(workdir)]
catch {exec diff -r -u -N --exclude=*.orig [file tail $uvn::state(origdir)] [file tail $uvn::state(workdir)] > $uvn::var/diff}
if {$outfile == "-" } {
uvn::util::cat $uvn::var/diff
} else {
file rename -force $uvn::var/diff $outfile
}
}
}
namespace eval uvn::patch {
proc create {patch {outfile patches/$patch}} {
if {![info exists uvn::state(origdir)]} {
set uvn::state(origdir) [extract_sources $uvn::state(distfile) .orig]
}
file mkdir patches
set patches {}
### unapply orthogonal patches ###
if {[info exists uvn::state(patches_applied)]} {
set patches $uvn::state(patches_applied)
foreach p $patches {
if {$p != $patch} {
uvn::patch::unapply $p
}
}
}
### store diff in patchfile ###
diff $outfile
if {![info exists uvn::state(patches_applied)] ||
[lsearch -exact $uvn::state(patches_applied) $patch] == -1} {
lappend uvn::state(patches_applied) $patch
}
### reapply previously applied patches ###
foreach p $patches {
uvn::patch::apply $p
}
}
proc apply {patch} {
if {![info exists uvn::state(patches_applied)] ||
[lsearch -exact $uvn::state(patches_applied) $patch] == -1} {
PRINT Applying patch: $patch
cd $uvn::objroot
cd $uvn::state(workdir)
exec patch -N -u -p$uvn::patchlevel -r $uvn::var/rejects < $uvn::srcroot/patches/$patch
lappend uvn::state(patches_applied) $patch
} else {
DEBUG patch already applied: $patch
}
}
proc unapply {patch} {
if {[info exists uvn::state(patches_applied)] &&
[lsearch -exact $uvn::state(patches_applied) $patch] != -1} {
DEBUG unapplying patch: $patch
cd $uvn::objroot
cd $uvn::state(workdir)
exec patch -R -u -p$uvn::patchlevel -r $uvn::var/rejects < $uvn::srcroot/patches/$patch
ldelete uvn::state(patches_applied) $patch
} else {
DEBUG patch not applied: $patch
}
}
proc all {} {
set patches {}
foreach p [glob -nocomplain patches/*.diff patches/*.patch] {
lappend patches [file tail $p]
}
return $patches
}
proc list {} {
set applied {}
if {[info exists uvn::state(patches_applied)]} {
set applied $uvn::state(patches_applied)
}
foreach p [uvn::patch::all] {
if {[lsearch -exact $applied $p] != -1} {
puts -nonewline "* "
} else {
puts -nonewline " "
}
puts $p
}
}
proc show {patch} {
cd $uvn::srcroot
DEBUG exec diffstat patches/$patch
exec diffstat -o $uvn::var/diffstat patches/$patch
PRINT
PRINT $patch:
uvn::util::cat $uvn::var/diffstat
}
proc isvalid {patch} {
if {![regexp -- {[[:alnum:]_-]+(.diff|.patch)} $patch]} {
return -code error "invalid patch name: $patch"
}
return $patch
}
proc defuzz {} {
foreach p [uvn::patch::all] {
uvn::patch::apply $p
uvn::patch::create $p $uvn::srcroot/patches/.tmp.$p
uvn::patch::unapply $p
file rename -force $uvn::srcroot/patches/.tmp.$p $uvn::srcroot/patches/$p
}
}
}
proc patch {argv} {
if {![info exists uvn::state(workdir)]} {
extract
}
switch -exact -- [lindex $argv 1] {
--apply {
uvn::patch::apply [uvn::patch::isvalid [lindex $argv 2]]
}
--create {
uvn::patch::create [uvn::patch::isvalid [lindex $argv 2]]
}
--defuzz {
uvn::patch::defuzz
}
--list {
uvn::patch::list
}
--show {
if {[lindex $argv 2] != ""} {
uvn::patch::show [uvn::patch::isvalid [lindex $argv 2]]
} else {
foreach patch [uvn::patch::all] {
uvn::patch::show $patch
}
}
}
--unapply {
uvn::patch::unapply [uvn::patch::isvalid [lindex $argv 2]]
}
{} {
foreach p [uvn::patch::all] {
uvn::patch::apply $p
}
}
default {
puts stderr "usage: uvn patch"
puts stderr " uvn patch --apply name"
puts stderr " uvn patch --create name"
puts stderr { uvn patch --defuzz [name]}
puts stderr " uvn patch --list"
puts stderr { uvn patch --show [name]}
puts stderr " uvn patch --unapply name"
exit 1
}
}
}
proc main {argv} {
switch -exact -- [lindex $argv 0] {
clean { clean }
extract { extract }
diff { diff }
patch { patch $argv }
default {
puts stderr {usage: uvn <subcommand> [options] [args]}
puts stderr ""
puts stderr "Available subcommands:"
puts stderr " clean"
puts stderr " extract"
puts stderr " diff"
puts stderr " patch"
exit 1
}
}
}
##### start #####
uvn::init
array set uvn::state [uvn::state::load]
DEBUG state = [array get uvn::state]
if {[catch {main $argv} res]} {
puts stderr $res
}
uvn::state::save [array get uvn::state]