Mercurial > repos > edward-kirton > data_nfs
view data_nfs/export.pl @ 0:9974ff5df008 default tip
Uploaded
author | edward-kirton |
---|---|
date | Thu, 01 Dec 2011 20:41:36 -0500 |
parents | |
children |
line wrap: on
line source
#!/usr/bin/perl use strict; use File::Copy; use File::Basename; # SETTINGS my $password='jgi'; # changeme # ARGS my ($trypass, $symlink, $dest, $logfile, @files)=@ARGV; die("Invalid password\n") unless $trypass and $password and $trypass eq $password; 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.