summaryrefslogtreecommitdiffstats
path: root/tcllib/config/installFile.tcl
blob: b77afdd0d9fa084473feb8b65f468a594b15f0b2 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
#!/bin/sh
#
# installFile.tcl - a Tcl version of install-sh
#	that copies a file and preserves its permission bits.
#	This also optimizes out installation of existing files
#	that have the same size and time stamp as the source.
#
# \
exec tclsh8.3 "$0" ${1+"$@"}

set doCopy 0	;# Rename files instead of copy
set doStrip 0	;# Strip the symbols from installed copy
set verbose 0
set src ""
set dst ""

# Process command line arguments, compatible with install-sh

for {set i 0} {$i < $argc} {incr i} {
    set arg [lindex $argv $i]
    switch -- $arg {
	-c {
	    set doCopy 1
	}
	-m  {
	    incr i
	    # Assume UNIX standard "644", etc, so force Tcl to think octal
	    set permissions 0[lindex $argv $i]
	}
	-o  {
	    incr i
	    set owner [lindex $argv $i]
	}
	-g  {
	    incr i
	    set group [lindex $argv $i]
	}
	-s {
	    set doStrip 1
	}
	-v {
	    set verbose 1
	}
	default {
	    set src $arg
	    incr i
	    set dst [lindex $argv $i]
	    break
	}
    }
}
if {[string length $src] == 0} {
    puts stderr "$argv0: no input file specified"
    exit 1
}
if {[string length $dst] == 0} {
    puts stderr "$argv0: no destination file specified"
    exit 1
}

# Compatibility with CYGNUS-style pathnames
regsub {^/(cygdrive)?/(.)/(.*)} $src {\2:/\3} src
regsub {^/(cygdrive)?/(.)/(.*)} $dst {\2:/\3} dst

if {$verbose && $doStrip} {
    puts stderr "Ignoring -s (strip) option for $dst"
}
if {[file isdirectory $dst]} {
    set dst [file join $dst [file tail $src]]
}

# Temporary file name

set dsttmp [file join [file dirname $dst] #inst.[pid]#]

# Optimize out install if the file already exists

set actions ""
if {[file exists $dst] &&
	([file mtime $src] == [file mtime $dst]) &&
	([file size $src] == [file size $dst])} {

    # Looks like the same file, so don't bother to copy.
    # Set dsttmp in case we still need to tweak mode, group, etc.

    set dsttmp $dst
    lappend actions "already installed"
} else {
    if {"[file type $src]" == "link"} {
	# Perfom a true copy.
	set in  [open $src r]
	set out [open $dsttmp w]
	fcopy $in $out
	close $in
	close $out
    } else {
	file copy -force $src $dsttmp
    }
    lappend actions copied
}

# update the modification time of the target file
file mtime $dsttmp [clock seconds]

# At this point "$dsttmp" is installed, but might not have the
# right permissions and may need to be renamed.


foreach attrName {owner group permissions} {
    upvar 0 $attrName attr

    if {[info exists attr]} {
	if {![catch {file attributes $dsttmp -$attrName} dstattr]} {

	    # This system supports "$attrName" kind of attributes

	    if {($attr != $dstattr)} {
		file attributes $dsttmp -$attrName $attr
		lappend actions "set $attrName to $attr"
	    }
	}
    }
}

if {[string compare $dst $dsttmp] != 0} {
    file rename -force $dsttmp $dst
}
if {$verbose} {
    puts stderr "$dst: [join $actions ", "]"
}
exit 0