|
2
|
1 #!/usr/bin/perl
|
|
|
2
|
|
|
3 use strict;
|
|
|
4 use File::Copy;
|
|
|
5 use File::Basename;
|
|
|
6
|
|
|
7 # ARGS
|
|
|
8 my ($symlink, $dest, $logfile, @files)=@ARGV;
|
|
|
9 die("Absolute path required\n") unless $dest =~ /^\//;
|
|
|
10 die("Paths containing '..' are disallowed\n") if $dest =~ /\/\.\.\//;
|
|
|
11 die("Only /home/*, /house/*, and /ifs/* paths are allowed\n") unless $dest =~ /^\/home/ or $dest =~ /^\/house/ or $dest =~ /^\/ifs/;
|
|
|
12 die("Destination folder does not exist: $dest\n") unless -e $dest;
|
|
|
13 die("Destination path is not a folder: $dest\n") unless -d $dest;
|
|
|
14
|
|
|
15 # CP
|
|
|
16 open(OUT, ">$logfile") or die($!);
|
|
|
17 while (@files) {
|
|
|
18 my $file=shift @files or die("Source filename required\n");
|
|
|
19 my $name=shift @files or die("Destination filename required\n");
|
|
|
20 print OUT "$file -> $dest/$name\n";
|
|
|
21 if ($symlink) {
|
|
|
22 symlink($file, "$dest/$name");
|
|
|
23 } else {
|
|
|
24 copy($file, "$dest/$name");
|
|
|
25 }
|
|
|
26 }
|
|
|
27 close OUT;
|
|
|
28 print "Exported ", scalar(@files), " to $dest\n";
|
|
|
29 exit;
|
|
|
30 __END__
|
|
|
31 Copyright (c) 2011 US DOE Joint Genome Institute.
|
|
|
32 Use freely under the same license as Galaxy itself.
|
