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

Uploaded
author pitagora
date Wed, 09 Jul 2014 04:48:09 -0400
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/imp_exp/link_path.pl	Wed Jul 09 04:48:09 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;