1# 2# instcopy.tcl -- 3# 4# Tcl program to copy files during the installation of Tcl. This is used 5# because "copy -r" is not ubiquitous. It also adds some minor additional 6# functionality. 7# 8#------------------------------------------------------------------------------ 9# Copyright 1992-1999 Karl Lehenbauer and Mark Diekhans. 10# 11# Permission to use, copy, modify, and distribute this software and its 12# documentation for any purpose and without fee is hereby granted, provided 13# that the above copyright notice appear in all copies. Karl Lehenbauer and 14# Mark Diekhans make no representations about the suitability of this 15# software for any purpose. It is provided "as is" without express or 16# implied warranty. 17#------------------------------------------------------------------------------ 18# $Id: instcopy.tcl,v 8.7 2002/11/12 21:35:31 karll Exp $ 19#------------------------------------------------------------------------------ 20# 21# It is run in the following manner: 22# 23# instcopy file1 file2 ... targetdir 24# instcopy -filename file1 targetfile 25# 26# o -filename - If specified, then the last file is the name of a file rather 27# than a directory. 28# o -bin - Force file to be copied without translation. (not implemented). 29# o files - List of files to copy. If one of directories are specified, they 30# are copied. 31# o targetdir - Target directory to copy the files to. If the directory does 32# not exist, it is created (including parent directories). 33#:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: 34 35package require Tclx 36source [file join [file dirname [info script]] buildutil.tcl] 37 38#------------------------------------------------------------------------------ 39# Usage -- 40# 41# Issue a usage message and exit. 42#------------------------------------------------------------------------------ 43proc Usage {{msg {}}} { 44 if {"$msg" != ""} { 45 puts stderr "Error: $msg" 46 } 47 puts stderr {usage: instcopy ?-filename? file1 file2 ... targetdir} 48 exit 1 49} 50 51#------------------------------------------------------------------------------ 52# DoACopy -- 53#------------------------------------------------------------------------------ 54 55proc DoACopy {file target mode} { 56 57 if [cequal [file tail $file] "CVS"] { 58 return 59 } 60 if {$mode == "FILENAME"} { 61 set targetDir [file dirname $target] 62 if [file exists $target] { 63 file delete -force $target 64 } 65 } else { 66 set targetDir $target 67 } 68 file mkdir $targetDir 69 70 if [file isdirectory $file] { 71 CopyDir $file $target 72 } else { 73 CopyFile $file $target 74 } 75} 76 77 78#------------------------------------------------------------------------------ 79# Main program code. 80#------------------------------------------------------------------------------ 81 82# 83# Parse the arguments 84# 85if {$argc < 2} { 86 Usage "Not enough arguments" 87} 88 89set mode {} 90set binary 0 91while {[string match -* [lindex $argv 0]]} { 92 set flag [lvarpop argv] 93 incr argc -1 94 switch -exact -- $flag { 95 -filename { 96 set mode FILENAME 97 } 98 -bin { 99 set binary 1 100 } 101 default { 102 puts stderr "unknown flag" 103 } 104 } 105} 106 107set files {} 108foreach file [lrange $argv 0 [expr $argc-2]] { 109 lappend files [eval file join [file split $file]] 110} 111set targetDir [eval file join [file split [lindex $argv [expr $argc-1]]]] 112 113if {[file exists $targetDir] && ![file isdirectory $targetDir] && 114 ($mode != "FILENAME")} { 115 Usage "Target is not a directory: $targetDir" 116} 117 118umask 022 119 120if [catch { 121 foreach file $files { 122 DoACopy $file $targetDir $mode 123 } 124} msg] { 125 puts stderr "Error: $msg" 126 exit 1 127} 128 129 130