view imp_exp/link_path.pl @ 0:07d3e0871bb4 draft

Uploaded

#!/usr/bin/perl

# INTERNAL USE ONLY!
# THIS TOOLS IS WRITTEN BASED ON link_path.pl FROM US DOE Joint Genome Institute.
# 2012-02-10 Yamanaka

# THIS TOOL HAS BEEN DEPRECATED IN FAVOR OF THE galaxy_import.pl AND gcpd.pl METHOD
# WHICH DON'T REQUIRE SETTING METADATA MANUALLY FOR EACH FILE.

use strict;
use File::Copy;

# CONFIG
my @allowed_paths = ('/');

# ARGS
my ($src, $dest, $symlink)=@ARGV;
die("Absolute path required\n") unless $src =~ /^\//;
die("Paths containing '..' are disallowed\n") if $src =~ /\/\.\.\//;
my $ok=0;
foreach my $dir (@allowed_paths) {
    my $re="^$dir";
    $re =~ s/\//\\\//g;
    if ($src =~ /$re/) {
        $ok=1;
        last;
    }
}
die("Not an allowed source path\n") unless $ok;

# CP
unlink($dest);
if ($symlink) {
    symlink($src, $dest);
} else {
    copy($src,$dest);
}
exit;