Mercurial > repos > pitagora > imp_exp
comparison link_path.pl @ 2:4c225e57d44b draft default tip
Uploaded
author | pitagora |
---|---|
date | Wed, 09 Jul 2014 05:23:25 -0400 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
1:75dc30937969 | 2:4c225e57d44b |
---|---|
1 #!/usr/bin/perl | |
2 | |
3 # INTERNAL USE ONLY! | |
4 # THIS TOOLS IS WRITTEN BASED ON link_path.pl FROM US DOE Joint Genome Institute. | |
5 # 2012-02-10 Yamanaka | |
6 | |
7 # THIS TOOL HAS BEEN DEPRECATED IN FAVOR OF THE galaxy_import.pl AND gcpd.pl METHOD | |
8 # WHICH DON'T REQUIRE SETTING METADATA MANUALLY FOR EACH FILE. | |
9 | |
10 use strict; | |
11 use File::Copy; | |
12 | |
13 # CONFIG | |
14 my @allowed_paths = ('/'); | |
15 | |
16 # ARGS | |
17 my ($src, $dest, $symlink)=@ARGV; | |
18 die("Absolute path required\n") unless $src =~ /^\//; | |
19 die("Paths containing '..' are disallowed\n") if $src =~ /\/\.\.\//; | |
20 my $ok=0; | |
21 foreach my $dir (@allowed_paths) { | |
22 my $re="^$dir"; | |
23 $re =~ s/\//\\\//g; | |
24 if ($src =~ /$re/) { | |
25 $ok=1; | |
26 last; | |
27 } | |
28 } | |
29 die("Not an allowed source path\n") unless $ok; | |
30 | |
31 # CP | |
32 unlink($dest); | |
33 if ($symlink) { | |
34 symlink($src, $dest); | |
35 } else { | |
36 copy($src,$dest); | |
37 } | |
38 exit; |