diff options
| author | Kevin B Kenny <kennykb@acm.org> | 2004-08-18 19:58:56 (GMT) |
|---|---|---|
| committer | Kevin B Kenny <kennykb@acm.org> | 2004-08-18 19:58:56 (GMT) |
| commit | c81923307b132f8ba713354710cdae44427a1451 (patch) | |
| tree | 0bfbd9e68acb81b08b317b956ce8ac4cca0824cd /tools/installData.tcl | |
| parent | 1a395009d72b54f9d2ea9b4f70de9eafd192c2b3 (diff) | |
| download | tcl-c81923307b132f8ba713354710cdae44427a1451.zip tcl-c81923307b132f8ba713354710cdae44427a1451.tar.gz tcl-c81923307b132f8ba713354710cdae44427a1451.tar.bz2 | |
TIP #173 and #209 implementation - see ChangeLog for details
Diffstat (limited to 'tools/installData.tcl')
| -rw-r--r-- | tools/installData.tcl | 53 |
1 files changed, 53 insertions, 0 deletions
diff --git a/tools/installData.tcl b/tools/installData.tcl new file mode 100644 index 0000000..cf067a3 --- /dev/null +++ b/tools/installData.tcl @@ -0,0 +1,53 @@ +#!/bin/sh +#\ + exec tclsh "$0" ${1+"$@"} + +#---------------------------------------------------------------------- +# +# installData.tcl -- +# +# This file installs a hierarchy of data found in the directory +# specified by its first argument into the directory specified +# by its second. +# +#---------------------------------------------------------------------- +# +# Copyright (c) 2004 by Kevin B. Kenny. All rights reserved. +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: installData.tcl,v 1.1 2004/08/18 19:59:09 kennykb Exp $ +# +#---------------------------------------------------------------------- + +proc copyDir { d1 d2 } { + + puts [format {%*sCreating %s} [expr { 4 * [info level] }] {} \ + [file tail $d2]] + + file delete -force -- $d2 + file mkdir $d2 + + foreach ftail [glob -directory $d1 -nocomplain -tails *] { + set f [file join $d1 $ftail] + if { [file isdirectory $f] && [string compare CVS $ftail] } { + copyDir $f [file join $d2 $ftail] + } elseif { [file isfile $f] } { + file copy -force $f [file join $d2 $ftail] + if { $::tcl_platform(platform) eq {unix} } { + file attributes [file join $d2 $ftail] -permissions 0644 + } else { + file attributes [file join $d2 $ftail] -readonly 1 + } + } + } + + if { $::tcl_platform(platform) eq {unix} } { + file attributes $d2 -permissions 0755 + } else { + file attributes $d2 -readonly 1 + } + +} + +copyDir [lindex $argv 0] [lindex $argv 1] |
