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