diff export.pl @ 2:4c225e57d44b draft default tip

Uploaded

--- /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.