| 1 |
#! /usr/bin/perl
|
| 2 |
|
| 3 |
# $Id$
|
| 4 |
#*********************************************************************
|
| 5 |
#
|
| 6 |
# fcopy -- copy files using FAI classes and preserve directory structure
|
| 7 |
#
|
| 8 |
# This script is part of FAI (Fully Automatic Installation)
|
| 9 |
# Copyright (C) 2000-2007 Thomas Lange, lange@informatik.uni-koeln.de
|
| 10 |
# Universitaet zu Koeln
|
| 11 |
# Copyright (C) 2004-2005 Henning Glawe, glaweh@physik.fu-berlin.de
|
| 12 |
# Freie Univeritaet Berlin
|
| 13 |
#
|
| 14 |
#*********************************************************************
|
| 15 |
# This program is free software; you can redistribute it and/or modify
|
| 16 |
# it under the terms of the GNU General Public License as published by
|
| 17 |
# the Free Software Foundation; either version 2 of the License, or
|
| 18 |
# (at your option) any later version.
|
| 19 |
#
|
| 20 |
# This program is distributed in the hope that it will be useful, but
|
| 21 |
# WITHOUT ANY WARRANTY; without even the implied warranty of
|
| 22 |
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
| 23 |
# General Public License for more details.
|
| 24 |
#
|
| 25 |
# A copy of the GNU General Public License is available as
|
| 26 |
# '/usr/share/common-licences/GPL' in the Debian GNU/Linux distribution
|
| 27 |
# or on the World Wide Web at http://www.gnu.org/copyleft/gpl.html. You
|
| 28 |
# can also obtain it by writing to the Free Software Foundation, Inc.,
|
| 29 |
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
|
| 30 |
#*********************************************************************
|
| 31 |
|
| 32 |
my $version = "Version 2.2.13, 5-august-2007";
|
| 33 |
|
| 34 |
use strict;
|
| 35 |
use File::Copy;
|
| 36 |
use File::Compare;
|
| 37 |
use File::Find;
|
| 38 |
use File::Path;
|
| 39 |
use File::Basename;
|
| 40 |
use File::Spec;
|
| 41 |
use File::Temp qw/tempfile/;
|
| 42 |
use Getopt::Std;
|
| 43 |
|
| 44 |
use vars qw/*name/;
|
| 45 |
|
| 46 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
| 47 |
# Global variables
|
| 48 |
my $debug;
|
| 49 |
my $error = 0;
|
| 50 |
my $verbose;
|
| 51 |
my $target;
|
| 52 |
my $source;
|
| 53 |
my $logfile;
|
| 54 |
my @classes;
|
| 55 |
my $dryrun;
|
| 56 |
|
| 57 |
my @opt_modes;
|
| 58 |
my @rlist;
|
| 59 |
my %changed;
|
| 60 |
my %lastclass;
|
| 61 |
my $modeset;
|
| 62 |
my $nobackup;
|
| 63 |
my $opt_update;
|
| 64 |
my $backupdir;
|
| 65 |
my @ignoredirs = qw'CVS .svn .arch-ids {arch}';
|
| 66 |
|
| 67 |
# getopts:
|
| 68 |
our ($opt_s, $opt_t, $opt_r, $opt_m, $opt_M, $opt_v, $opt_d, $opt_D, $opt_i);
|
| 69 |
our ($opt_B, $opt_c, $opt_C, $opt_h, $opt_F, $opt_l, $opt_L, $opt_P, $opt_b);
|
| 70 |
our ($opt_I, $opt_U, $opt_n);
|
| 71 |
|
| 72 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
| 73 |
sub copy_one {
|
| 74 |
|
| 75 |
# copy file $prefix/$source/$class to $target/$source
|
| 76 |
my ($prefix,$source,$target) = @_;
|
| 77 |
my ($class,$sourcefile,$destfile);
|
| 78 |
# 'normalize' source filenames: very important for updating !
|
| 79 |
$source =~ s/^(\.\/|\/)*//;
|
| 80 |
|
| 81 |
my $ps = "$prefix/$source";
|
| 82 |
$ps =~ s#//#/#;
|
| 83 |
my $tpath = "$target/" . dirname $source;
|
| 84 |
my $preserve = 0;
|
| 85 |
my $logcomment = "";
|
| 86 |
my ($tmpfh,$tmpfile);
|
| 87 |
|
| 88 |
warn "copy_one: source: $source: ps: $ps tpath: $tpath\n" if $debug;
|
| 89 |
|
| 90 |
# $prefix/$source must be a directory
|
| 91 |
if (-f $ps) { ewarn("$ps is a file, but must be a directory containing templates.");return };
|
| 92 |
unless (-d $ps) { ewarn("Nonexisting directory $ps. No files copied.");return }
|
| 93 |
# use the last class for which a file exists
|
| 94 |
foreach (@classes) { $class = $_,last if -f "$ps/$_"; }
|
| 95 |
$destfile = "$target/$source";
|
| 96 |
|
| 97 |
my $backupfile = $backupdir ? "$backupdir/$source" : "$destfile.pre_fcopy";
|
| 98 |
my $bpath = dirname $backupfile;
|
| 99 |
|
| 100 |
unless (defined $class) {
|
| 101 |
ewarn("no matching file for any class for $source defined.");
|
| 102 |
# do not copy
|
| 103 |
if ($opt_d and -f $destfile) {
|
| 104 |
print LOGFILE "$source\tNONE\t# removed (no matching class)\n" if $logfile;
|
| 105 |
if ($nobackup) {
|
| 106 |
_unlink($destfile) || ewarn("Could not remove file $destfile");
|
| 107 |
} else {
|
| 108 |
_mkpath($bpath,$debug,0755) unless -d $bpath;
|
| 109 |
_move($destfile,$backupfile) if -d $bpath;;
|
| 110 |
}
|
| 111 |
}
|
| 112 |
return;
|
| 113 |
}
|
| 114 |
warn "using class: $class\n" if $debug;
|
| 115 |
$tmpfile = $sourcefile = "$ps/$class";
|
| 116 |
|
| 117 |
# do nothing if source and destination files are equal
|
| 118 |
if ($opt_update and not -x "$ps/preinst") {
|
| 119 |
# compare logically
|
| 120 |
if ($lastclass{$source}) {
|
| 121 |
# $source has already been copied last time
|
| 122 |
|
| 123 |
if ($lastclass{$source} ne $class) {
|
| 124 |
$logcomment = "\t# changed class" if $logfile;
|
| 125 |
} else {
|
| 126 |
if ($changed{"$source/$class"} or
|
| 127 |
$changed{"$source/postinst"} or
|
| 128 |
$changed{"$source/file-modes"}) {
|
| 129 |
$logcomment = "\t# changed file" if $logfile;
|
| 130 |
} else {
|
| 131 |
$logcomment = "\t# preserved (logical)" if $logfile;
|
| 132 |
$preserve = 1;
|
| 133 |
}
|
| 134 |
}
|
| 135 |
} else {
|
| 136 |
$logcomment = "\t# new (logical)" if $logfile;
|
| 137 |
}
|
| 138 |
} else {
|
| 139 |
# compare literally
|
| 140 |
if ( -x "$ps/preinst" ) {
|
| 141 |
warn "preinst script found, switching to literal change detection" if
|
| 142 |
($opt_P and $debug);
|
| 143 |
($tmpfh,$tmpfile)=tempfile("fcopy.XXXXXX",DIR=>File::Spec->tmpdir());
|
| 144 |
warn "preinst script found, copying $sourcefile to $tmpfile" if $debug;
|
| 145 |
ewarn("copying $sourcefile for preinst processing failed !") unless
|
| 146 |
_copy($sourcefile,$tmpfh);
|
| 147 |
runscript("preinst",$ps,$tmpfile,$class);
|
| 148 |
};
|
| 149 |
|
| 150 |
if ( compare($tmpfile,$destfile)) {
|
| 151 |
$logcomment="\t# new (literal)";
|
| 152 |
} else {
|
| 153 |
$logcomment="\t# preserved (literal)" if $logfile;
|
| 154 |
$preserve = 1;
|
| 155 |
}
|
| 156 |
}
|
| 157 |
#if a package is being purged, our information about its config files is
|
| 158 |
#wrong, so first check if they exist. if not, don't preserve, but copy
|
| 159 |
if ($preserve && ! -e $destfile) {
|
| 160 |
$logcomment="\t# magically disappeared (maybe purged)";
|
| 161 |
$preserve=0;
|
| 162 |
}
|
| 163 |
|
| 164 |
print LOGFILE "$source\t$class$logcomment\n" if $logfile;
|
| 165 |
if ($preserve) {
|
| 166 |
warn "preserving $source \n";
|
| 167 |
_unlink($tmpfile) unless ($tmpfile eq $sourcefile);
|
| 168 |
set_mode($ps,$destfile,$class); # set mode even no file was copied
|
| 169 |
return;
|
| 170 |
}
|
| 171 |
|
| 172 |
# if destination is a symlink and -l is given, complain about it
|
| 173 |
if ($opt_l && -l $destfile) {
|
| 174 |
ewarn("Destination $destfile is a symlink");
|
| 175 |
_unlink($tmpfile) unless ($tmpfile eq $sourcefile);
|
| 176 |
return;
|
| 177 |
}
|
| 178 |
|
| 179 |
# create subdirectories if they do not exist
|
| 180 |
_mkpath($tpath,$debug,0755) unless -d $tpath;
|
| 181 |
|
| 182 |
# save existing file, add suffix .pre_fcopy
|
| 183 |
# what should I do if $destfile is a symlink?
|
| 184 |
$nobackup or (-f $destfile and
|
| 185 |
(-d $bpath or _mkpath($bpath,$debug,0755)) and _move($destfile,$backupfile));
|
| 186 |
if (_copy($tmpfile,$destfile)) {
|
| 187 |
print "fcopy: copied $sourcefile to $destfile\n" ;
|
| 188 |
set_mode($ps,$destfile,$class);
|
| 189 |
runscript("postinst",$ps,$destfile,$class);
|
| 190 |
} else {
|
| 191 |
ewarn("copy $sourcefile to $destfile failed. $!") ;
|
| 192 |
}
|
| 193 |
_unlink($tmpfile) unless ($tmpfile eq $sourcefile);
|
| 194 |
}
|
| 195 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
| 196 |
sub _mkpath {
|
| 197 |
|
| 198 |
return 1 if $dryrun; # do not execute if -n or FCOPY_DRYRUN was given
|
| 199 |
mkpath(@_);
|
| 200 |
}
|
| 201 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
| 202 |
sub _unlink {
|
| 203 |
|
| 204 |
return 1 if $dryrun; # do not execute if -n or FCOPY_DRYRUN was given
|
| 205 |
unlink(@_);
|
| 206 |
}
|
| 207 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
| 208 |
sub _move {
|
| 209 |
|
| 210 |
return 1 if $dryrun; # do not execute if -n or FCOPY_DRYRUN was given
|
| 211 |
move(@_);
|
| 212 |
}
|
| 213 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
| 214 |
sub _copy {
|
| 215 |
|
| 216 |
return 1 if $dryrun; # do not execute if -n or FCOPY_DRYRUN was given
|
| 217 |
copy(@_);
|
| 218 |
}
|
| 219 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
| 220 |
sub runscript {
|
| 221 |
|
| 222 |
my ($scriptname,$sourcefile,$destfile,$class) = @_;
|
| 223 |
return unless -x "$sourcefile/$scriptname";
|
| 224 |
warn "executing $sourcefile/$scriptname $class $destfile\n" if $debug;
|
| 225 |
return if $dryrun; # do not execute if -n or FCOPY_DRYRUN was given
|
| 226 |
system "$sourcefile/$scriptname $class $destfile";
|
| 227 |
my $rc = $?>>8;
|
| 228 |
warn "ERROR: $scriptname returned code $rc\n" if $rc;
|
| 229 |
$error=1 if $rc;
|
| 230 |
}
|
| 231 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
| 232 |
sub name2num {
|
| 233 |
|
| 234 |
# convert names to numeric uid, gid
|
| 235 |
my ($user, $group) = @_;
|
| 236 |
my ($uid, $gid);
|
| 237 |
|
| 238 |
if( !defined( $ENV{ROOTCMD} ) || $ENV{ROOTCMD} =~ /^\s*$/ )
|
| 239 |
{
|
| 240 |
$uid = ($user =~ /^\d+$/) ? $user : getpwnam $user;
|
| 241 |
$gid = ($group =~ /^\d+$/) ? $group : getgrnam $group;
|
| 242 |
}
|
| 243 |
else
|
| 244 |
{
|
| 245 |
$uid = ($user =~ /^\d+$/) ? $user : `$ENV{ROOTCMD} perl -e '\$uid = getpwnam "$user"; print \$uid'`;
|
| 246 |
$gid = ($group =~ /^\d+$/) ? $group : `$ENV{ROOTCMD} perl -e '\$gid = getgrnam "$group"; print \$gid'`;
|
| 247 |
}
|
| 248 |
warn "name2num $user = $uid ; $group = $gid\n" if $debug;
|
| 249 |
return ($uid,$gid);
|
| 250 |
}
|
| 251 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
| 252 |
sub set_mode {
|
| 253 |
|
| 254 |
# set target file's owner, group, mode and time
|
| 255 |
# use owner,group,mode from -m or from the file file-modes or
|
| 256 |
# use the values from the source file
|
| 257 |
my ($sourcefile,$destfile,$class) = @_;
|
| 258 |
my ($uid,$gid,$owner,$group,$mode);
|
| 259 |
# get mtime,uid,gid,mode from source file
|
| 260 |
my ($stime,@defmodes) = (stat("$sourcefile/$class"))[9,4,5,2];
|
| 261 |
|
| 262 |
if ($modeset) { # use -m values
|
| 263 |
($owner,$group,$mode) = @opt_modes;
|
| 264 |
} elsif (-f "$sourcefile/file-modes"){
|
| 265 |
($owner,$group,$mode) = read_file_mode("$sourcefile/file-modes",$class);
|
| 266 |
} else { # use values from source file
|
| 267 |
($owner,$group,$mode) = @defmodes;
|
| 268 |
}
|
| 269 |
|
| 270 |
($uid,$gid) = name2num($owner,$group);
|
| 271 |
warn "chown/chmod u:$uid g:$gid m:$mode $destfile\n" if $debug;
|
| 272 |
return if $dryrun; # do not execute if -n or FCOPY_DRYRUN was given
|
| 273 |
chown ($uid,$gid, $destfile) || ewarn("chown $owner $group $destfile failed. $!");
|
| 274 |
chmod ($mode, $destfile) || ewarn("chmod $mode $destfile failed. $!");
|
| 275 |
utime ($stime,$stime, $destfile) || ewarn("utime for $destfile failed. $!");
|
| 276 |
}
|
| 277 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
| 278 |
sub check_mopt {
|
| 279 |
|
| 280 |
# save and check -m options
|
| 281 |
$modeset = 1;
|
| 282 |
my $n = @opt_modes = split(/,/,$opt_m);
|
| 283 |
($n != 3) &&
|
| 284 |
die "fcopy: wrong number of options for -m. Exact 3 comma separated items needed.\n";
|
| 285 |
unless ($opt_modes[2] =~/^[0-7]+$/) {
|
| 286 |
die "fcopy: file mode should be an octal number. Value is: $opt_modes[2]\n";
|
| 287 |
}
|
| 288 |
$opt_modes[2] = oct($opt_modes[2]);
|
| 289 |
}
|
| 290 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
| 291 |
sub read_file_mode {
|
| 292 |
|
| 293 |
my ($modefile,$class) = @_;
|
| 294 |
my ($owner,$group,$mode,$fclass,@defaults);
|
| 295 |
|
| 296 |
warn "reading $modefile\n" if $verbose;
|
| 297 |
open (MODEFILE,"<$modefile") || die "fcopy: can't open $modefile\n";
|
| 298 |
while (<MODEFILE>) {
|
| 299 |
# skip empty lines
|
| 300 |
next if /^\s*$/;
|
| 301 |
# skip comment lines
|
| 302 |
next if /^#/;
|
| 303 |
($owner,$group,$mode,$fclass) = split;
|
| 304 |
$mode = oct($mode);
|
| 305 |
# class found
|
| 306 |
return ($owner,$group,$mode) if ($fclass eq $class);
|
| 307 |
# when no class is specified use data for all classes
|
| 308 |
$fclass or @defaults = ($owner,$group,$mode);
|
| 309 |
}
|
| 310 |
close MODEFILE;
|
| 311 |
return @defaults if @defaults;
|
| 312 |
ewarn("no modes found for $class in $modefile");
|
| 313 |
}
|
| 314 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
| 315 |
sub read_classes {
|
| 316 |
|
| 317 |
# read class names from a file
|
| 318 |
my $file = shift;
|
| 319 |
my @classes;
|
| 320 |
|
| 321 |
open(CLASS,$file) || die "fcopy: can't open class file $file. $!\n";
|
| 322 |
while (<CLASS>) {
|
| 323 |
next if /^#/;
|
| 324 |
push @classes, split;
|
| 325 |
}
|
| 326 |
close CLASS;
|
| 327 |
return @classes;
|
| 328 |
}
|
| 329 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
| 330 |
sub ewarn {
|
| 331 |
|
| 332 |
# print warnings and set error to 1
|
| 333 |
$error = 1;
|
| 334 |
warn "fcopy: @_\n";
|
| 335 |
}
|
| 336 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
| 337 |
sub read_status {
|
| 338 |
my $n = my @status_files=split(/,/,$opt_update);
|
| 339 |
($n != 2) && die "fcopy: need both log and changes file\n";
|
| 340 |
|
| 341 |
open(LASTLOG,$status_files[0]);
|
| 342 |
while (<LASTLOG>) {
|
| 343 |
s/\#.*//g;
|
| 344 |
chomp;
|
| 345 |
my ($source,$class) = split(/\s/,$_,2);
|
| 346 |
$class=~s/\s*//g;
|
| 347 |
$lastclass{$source} = $class;
|
| 348 |
}
|
| 349 |
close(LASTLOG);
|
| 350 |
|
| 351 |
$_=$source; /([^\/]+)$/;
|
| 352 |
my $source_base = $1;
|
| 353 |
open(CHANGES,$status_files[1]);
|
| 354 |
while (<CHANGES>) {
|
| 355 |
s/\#.*//g;
|
| 356 |
chomp;
|
| 357 |
m#$source_base/(\S+)$# and $changed{$1} = 1;
|
| 358 |
}
|
| 359 |
close(CHANGES);
|
| 360 |
}
|
| 361 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
| 362 |
sub read_files {
|
| 363 |
|
| 364 |
# read list of files
|
| 365 |
# lines starting with # are comments
|
| 366 |
my $file = shift;
|
| 367 |
my @list;
|
| 368 |
|
| 369 |
open(LIST,"<$file") || die "fcopy: Can't open file $file\n";
|
| 370 |
while (<LIST>) {
|
| 371 |
next if /^#/;
|
| 372 |
chomp;
|
| 373 |
push @list, $_;
|
| 374 |
}
|
| 375 |
return @list;
|
| 376 |
}
|
| 377 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
| 378 |
sub usage {
|
| 379 |
|
| 380 |
print << "EOF";
|
| 381 |
fcopy, copy files using classes. $version
|
| 382 |
|
| 383 |
Copyright (C) 2001-2006 by Thomas Lange
|
| 384 |
|
| 385 |
Usage: fcopy [OPTION] ... SOURCE ...
|
| 386 |
|
| 387 |
-B Remove backup file.
|
| 388 |
-c class[,class] Define classes.
|
| 389 |
-C file Read classes from file.
|
| 390 |
-d Remove target file if no class applies.
|
| 391 |
-D Create debug output.
|
| 392 |
-F file Read list of sources from file.
|
| 393 |
-h Show summary of options.
|
| 394 |
-i Exit with 0 when no class applies.
|
| 395 |
-I dir[,dir] Override default list of ignored subdirectories
|
| 396 |
-l Do not copy if destination is a symbolic link.
|
| 397 |
-L file Log destination and used class to file
|
| 398 |
-m user,group,mode Set user, group and mode for copied files.
|
| 399 |
-M Same as -m root,root,0644
|
| 400 |
-n Print the commands, but do not execute them.
|
| 401 |
-P log,changes Copy if class or source for class has changed since
|
| 402 |
previous run
|
| 403 |
-r Copy recursivly but skip ignored directories.
|
| 404 |
-s source_dir Look for source files relative to source_dir.
|
| 405 |
-t target_dir Copy files relativ to target_dir.
|
| 406 |
-b backup_dir Where to save backups of overwritten files
|
| 407 |
-v Create verbose output.
|
| 408 |
|
| 409 |
Report bugs to <lange\@informatik.uni-koeln.de>.
|
| 410 |
EOF
|
| 411 |
exit 0;
|
| 412 |
}
|
| 413 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
| 414 |
# main program
|
| 415 |
|
| 416 |
$|=1;
|
| 417 |
getopts('Ms:t:rm:vidDc:C:hF:lL:P:Bb:I:Un') || usage;
|
| 418 |
$opt_h && usage;
|
| 419 |
$dryrun = $ENV{FCOPY_DRYRUN} || $opt_n || 0; # is true if in dry-run mode
|
| 420 |
$dryrun and warn "Dry-run only! Nothing is really executed.\n";
|
| 421 |
$opt_M and $opt_m = "root,root,0644"; # set default modes
|
| 422 |
$opt_m && check_mopt();
|
| 423 |
$nobackup = $opt_B || $ENV{FCOPY_NOBACKUP} || 0;
|
| 424 |
$verbose = $opt_v || $ENV{verbose} || 0;
|
| 425 |
$debug = $opt_D || $ENV{debug} || 0;
|
| 426 |
$source = $opt_s || $ENV{FAI} && "$ENV{FAI}/files" || `pwd`;
|
| 427 |
chomp $source; # since pwd contains a newline
|
| 428 |
$target = $opt_t || $ENV{FAI_ROOT} || $ENV{target};
|
| 429 |
$target eq "/" or $ENV{'ROOTCMD'}="chroot $target";
|
| 430 |
$logfile = $opt_L || $ENV{LOGDIR} && "$ENV{LOGDIR}/fcopy.log" || 0;
|
| 431 |
$logfile and (open(LOGFILE,">> $logfile") || die("can't open logfile: $!"));
|
| 432 |
$backupdir = $opt_b || $ENV{FAI_BACKUPDIR};
|
| 433 |
|
| 434 |
if ($opt_U && -f "/var/run/fai/fai_softupdate_is_running" ) {
|
| 435 |
print "Skipping this fcopy command during softupdate." if $verbose;
|
| 436 |
exit 0;
|
| 437 |
}
|
| 438 |
|
| 439 |
if ($ENV{FCOPY_LASTLOG} and $ENV{FCOPY_UPDATELOG}) {
|
| 440 |
$opt_update = "$ENV{FCOPY_LASTLOG},$ENV{FCOPY_UPDATELOG}";
|
| 441 |
}
|
| 442 |
$opt_P and $opt_update=$opt_P;
|
| 443 |
$opt_update and read_status();
|
| 444 |
|
| 445 |
#for postinst scripts
|
| 446 |
$ENV{'FAI_ROOT'} = $ENV{'target'} = $target;
|
| 447 |
|
| 448 |
# last class has highest priority
|
| 449 |
$ENV{classes} and @classes = reverse split /\s+/,$ENV{classes};
|
| 450 |
$opt_c and @classes = split /,/,$opt_c;
|
| 451 |
$opt_C and @classes = read_classes($opt_C);
|
| 452 |
warn join ' ','Classes:',@classes,"\n" if $debug;
|
| 453 |
$opt_F and @ARGV = read_files($opt_F);
|
| 454 |
$ENV{'FCOPY_IGNOREDIRS'} and @ignoredirs = split /\s+/,$ENV{'FCOPY_IGNOREDIRS'};
|
| 455 |
$opt_I and @ignoredirs = split /,/,$opt_I;
|
| 456 |
|
| 457 |
die "fcopy: source undefined\n" unless $source;
|
| 458 |
die "fcopy: target undefined\n" unless $target;
|
| 459 |
|
| 460 |
if ($opt_r) {
|
| 461 |
foreach (@ARGV) { $_="$source/$_"; } # add prefix to list of directories
|
| 462 |
my %has_subdirs;
|
| 463 |
my %ignoredirs;
|
| 464 |
map $ignoredirs{$_}=1,@ignoredirs;
|
| 465 |
File::Find::find({
|
| 466 |
wanted=>sub{ $has_subdirs{$File::Find::dir} |= -d},
|
| 467 |
preprocess=>sub{grep ! (-d and exists($ignoredirs{$_})),@_}},
|
| 468 |
@ARGV);
|
| 469 |
foreach (keys %has_subdirs) {
|
| 470 |
unless ($has_subdirs{$_}) {
|
| 471 |
# remove prefix from all files found
|
| 472 |
s#^\Q$source/##;
|
| 473 |
push @rlist,$_;
|
| 474 |
}
|
| 475 |
}
|
| 476 |
warn "List of all files found by File::Find::find: @rlist" if $debug;
|
| 477 |
@ARGV = @rlist;
|
| 478 |
}
|
| 479 |
|
| 480 |
foreach (@ARGV) { copy_one($source,$_,$target); }
|
| 481 |
$opt_i && exit 0; # ignore any warning
|
| 482 |
exit $error;
|
Parent Directory
| 
Revision Log