|
2
|
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;
|
