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

Uploaded

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