1 #!/usr/bin/perl
3 # Syntax
4 # ccperl cpytools.pl srcbase dstbase [enable_write]
5 #
6 # Copy tree specified from srcbase to dstbase. If the enable_write parameter
7 # is provided, then files are copied to and deleted from dstbase, to maintain
8 # an exact mirror of srcbase. If the enable_write parameter is not provided,
9 # an exit status of 0 is returned if all of the files in srcbase are present
10 # in dstbase with same sizes and dates; If any of the files are missing or do
11 # not match, then a nonzero exit value is returned.
12 #
14 # For DOS, change this to "command /c copy"
16 $copy="cmd /c copy";
17 $write_enabled = 0;
18 $error = 1;
19 $files_to_copy = 0;
20 $files_to_delete = 0;
22 $error = 0 if ($#ARGV == 1);
23 if ($#ARGV == 2) {
24 if ($ARGV[2] eq "enable_write") {
25 $write_enabled = 1;
26 $error = 0;
27 }
28 }
30 errexit ("Syntax: ccperl $0 srcbase dstbase [enable_write]\n") if ($error);
32 # Now verify that srcbase exists
33 $srcbase = $ARGV[0];
34 errexit ("Source base directory invalid ($srcbase)\n") if ( !-d $srcbase);
36 # Set dstbase, error will "fall out" while trying to copy files
37 $dstbase = $ARGV[1];
39 # Get a list of files in $dstbase
40 @subdirs = ("$dstbase");
42 while (@subdirs) {
43 $dir = pop (@subdirs);
44 opendir (DIR, $dir) || next;
45 @files = readdir(DIR);
46 closedir DIR;
48 foreach $file (@files) {
49 next if (($file eq ".") || ($file eq ".."));
50 if (-f "$dir/$file") {
51 # Add files to checklist hash
52 $dstfiles{normalize("$dir/$file")} = 1;
53 } elsif (-d "$dir/$file") {
54 # Add directories to @subdirs
55 push @subdirs, "$dir/$file";
56 }
57 }
58 }
60 # Get a list of files in $srcbase
61 @subdirs = ("");
62 @cpylist = ();
64 while (@subdirs) {
65 $reldir = pop (@subdirs);
66 opendir DIR, "$srcbase$reldir" || errexit ("Can\'t read $srcbase$reldir\n");
67 @files = readdir(DIR);
68 closedir DIR;
70 foreach $file (@files) {
71 next if (($file eq ".") || ($file eq ".."));
72 if (-f "$srcbase$reldir/$file") {
73 # Process the file.
74 $dstpath = normalize("$dstbase$reldir/$file");
76 # Mark file as present
77 $dstfiles{"$dstpath"} = 0;
79 push @cpylist, "$reldir/$file";
80 } elsif (-d "$srcbase$reldir/$file") {
81 # Add directories to @subdirs
82 push @subdirs, "$reldir/$file";
83 }
84 }
85 }
87 # Find any files that were in srcbase, but were not in dstfiles, and delete them
88 foreach $file (keys %dstfiles) {
89 if ($dstfiles{"$file"}) {
90 if ($write_enabled) {
91 print "rm -f $file\n";
92 chmod 0777, $file;
93 unlink $file;
94 } else {
95 $files_to_delete ++;
96 }
97 }
98 }
100 # Now copy source files to dest files; this is done after deletions so that
101 # files with incorrect case on case preserving but case insensitive filesystems
102 # are recopied with correct case.
103 for ($i=0; $i<=$#cpylist; $i++) {
104 $srcpath = normalize("$srcbase$cpylist[$i]");
105 $dstpath = normalize("$dstbase$cpylist[$i]");
107 if ((-e $srcpath) && (-e $dstpath)) {
108 @stats = stat($srcpath);
109 $srcmtime = $stats[9];
110 $srcsize = $stats[7];
111 @stats = stat($dstpath);
112 $dstmtime = $stats[9];
113 $dstsize = $stats[7];
114 next if (($srcmtime == $dstmtime) && ($srcsize == $dstsize));
115 }
117 if ($write_enabled) {
118 makepath ($dstpath);
120 if ((-e $dstpath) && (! -w $dstpath)) {
121 print "rm -f $dstpath\n";
122 chmod 0777, $dstpath;
123 unlink $dstpath;
124 }
125 $cmd = dosnormalize("\"$srcpath\" \"$dstpath\"");
126 print "copy $cmd\n";
127 $ret = system "$copy $cmd >nul";
128 errexit ("Command ($cmd) failed\nCheck for cmd vs command\n") if ($ret != 0);
129 } else {
130 $files_to_copy ++;
131 }
132 }
134 # Check and return error status
135 if (! $write_enabled) {
136 if ($files_to_delete || $files_to_copy) {
137 print "********************** UNSYNCHRONIZED TOOLS ***************************\n";
138 print "In order to synchronize $dstbase,\n";
139 print "need to delete $files_to_delete files, and copy $files_to_copy files.\n";
140 print "Rerun command with 'enable_write' parameter to perform synchronization\n";
141 print "********************** UNSYNCHRONIZED TOOLS ***************************\n";
142 exit (1);
143 }
144 }
145 exit (0);
147 # Convert \ to /, and then // to /
148 sub normalize {
149 my ($str) = @_;
151 $str =~ s|\\|/|g;
153 $str =~ s|/+|/|g;
155 return "$str";
156 }
158 # Convert / to \, and then \\ to \
159 sub dosnormalize {
160 my ($str) = @_;
162 $str =~ s|/|\\|g;
164 $str =~ s|\\+|\\|g;
166 return "$str";
167 }
169 sub makepath {
170 my ($path) = @_;
172 @components = split /\//, $path;
173 # Dispose of file name part
174 pop(@components);
176 $first = 1;
177 $path = "";
178 foreach $component (@components) {
179 $path = $path . "$component";
181 if ($first) {
182 # Skip through the drive letter
183 $first = 0;
184 if ($component =~ /^[A-Za-z]:$/) {
185 $path = $path . "/";
186 next;
187 }
188 }
189 if (! -e $path) {
190 print "mkdir $path\n";
191 mkdir "$path",0777;
192 }
193 errexit ("Destination must be directory: ($path)") if (! -d $path);
195 $path = $path . "/";
196 }
197 }
199 sub errexit {
200 my ($msg) = @_;
202 print $msg;
203 exit(5);
204 }