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 | fab56e2415bbbc5e2355f500b28d26c5e907ef29 (patch) | |
tree | 0bfbd9e68acb81b08b317b956ce8ac4cca0824cd /tools/installData.tcl | |
parent | dcdb6368302f0bb38e0d11e8c2d346b684507b07 (diff) | |
download | tcl-fab56e2415bbbc5e2355f500b28d26c5e907ef29.zip tcl-fab56e2415bbbc5e2355f500b28d26c5e907ef29.tar.gz tcl-fab56e2415bbbc5e2355f500b28d26c5e907ef29.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] |