Mercurial > repos > pitagora > imp_exp
comparison export.pl @ 2:4c225e57d44b draft default tip
Uploaded
author | pitagora |
---|---|
date | Wed, 09 Jul 2014 05:23:25 -0400 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
1:75dc30937969 | 2:4c225e57d44b |
---|---|
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. |