Mercurial > repos > pitagora > imp_exp
diff link_path.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/link_path.pl Wed Jul 09 05:23:25 2014 -0400 @@ -0,0 +1,38 @@ +#!/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;