Mercurial > repos > pitagora > imp_exp
diff export.pl @ 2:4c225e57d44b draft default tip
Uploaded
author | pitagora |
---|---|
date | Wed, 09 Jul 2014 05:23:25 -0400 |
parents | |
children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/export.pl Wed Jul 09 05:23:25 2014 -0400 @@ -0,0 +1,32 @@ +#!/usr/bin/perl + +use strict; +use File::Copy; +use File::Basename; + +# ARGS +my ($symlink, $dest, $logfile, @files)=@ARGV; +die("Absolute path required\n") unless $dest =~ /^\//; +die("Paths containing '..' are disallowed\n") if $dest =~ /\/\.\.\//; +die("Only /home/*, /house/*, and /ifs/* paths are allowed\n") unless $dest =~ /^\/home/ or $dest =~ /^\/house/ or $dest =~ /^\/ifs/; +die("Destination folder does not exist: $dest\n") unless -e $dest; +die("Destination path is not a folder: $dest\n") unless -d $dest; + +# CP +open(OUT, ">$logfile") or die($!); +while (@files) { + my $file=shift @files or die("Source filename required\n"); + my $name=shift @files or die("Destination filename required\n"); + print OUT "$file -> $dest/$name\n"; + if ($symlink) { + symlink($file, "$dest/$name"); + } else { + copy($file, "$dest/$name"); + } +} +close OUT; +print "Exported ", scalar(@files), " to $dest\n"; +exit; +__END__ +Copyright (c) 2011 US DOE Joint Genome Institute. +Use freely under the same license as Galaxy itself.