79 lines
1.7 KiB
Perl
Executable File
79 lines
1.7 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
#*************************************************************************
|
|
# Copyright (c) 2002 The University of Chicago, as Operator of Argonne
|
|
# National Laboratory.
|
|
# Copyright (c) 2002 The Regents of the University of California, as
|
|
# Operator of Los Alamos National Laboratory.
|
|
# EPICS BASE Versions 3.13.7
|
|
# and higher are distributed subject to a Software License Agreement found
|
|
# in file LICENSE that is included with this distribution.
|
|
#*************************************************************************
|
|
#
|
|
# UNIX-mv in Perl
|
|
|
|
use File::Copy;
|
|
|
|
sub Usage
|
|
{
|
|
my ($txt) = @_;
|
|
|
|
print "Usage:\n";
|
|
print "\tmv oldname newname\n";
|
|
print "\tmv file [ file2 file3 ...] directory\n";
|
|
print "\nError: $txt\n" if $txt;
|
|
|
|
exit 2;
|
|
}
|
|
|
|
sub Move
|
|
{
|
|
my ($src, $dest) = @_;
|
|
|
|
print "Move($src, $dest)\n";
|
|
|
|
copy ($src, $dest) or die "Cannot copy $src to $dest";
|
|
unlink ($src) or die "Cannot remove $src";
|
|
}
|
|
|
|
# return filename.ext from Drive:/path/a/b/c/filename.ext
|
|
sub Filename
|
|
{
|
|
my ($file) = @_;
|
|
|
|
$file =~ s'.*[/\\]'';
|
|
|
|
return $file;
|
|
}
|
|
|
|
# need at least two args: ARGV[0] and ARGV[1]
|
|
Usage("need more args") if $#ARGV < 1;
|
|
|
|
$target=$ARGV[$#ARGV];
|
|
@sources=@ARGV[0..$#ARGV-1];
|
|
|
|
print "move @sources into $target\n";
|
|
|
|
# If target is (already existent) directory,
|
|
# move files into it:
|
|
if (-d $target)
|
|
{
|
|
foreach $file ( @sources )
|
|
{
|
|
Move ($file, "$target/" . Filename($file));
|
|
}
|
|
exit 0;
|
|
}
|
|
|
|
# Otherwise the target is a filename.
|
|
# Now 'mv' may be either a 'move' or a 'rename',
|
|
# in any case it requires exactly two args: old and new name.
|
|
|
|
Usage("Need exactly one source") if $#sources != 0;
|
|
$source = @sources[0];
|
|
|
|
# Move only if a simple rename
|
|
# fails (e.g. across file systems):
|
|
Move ($source, $target) unless (rename $source, $target);
|
|
|
|
# EOF mv.pl
|