Mercurial > repos > edward-kirton > data_nfs
comparison data_nfs/gcpd.pl @ 0:9974ff5df008 default tip
Uploaded
author | edward-kirton |
---|---|
date | Thu, 01 Dec 2011 20:41:36 -0500 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
-1:000000000000 | 0:9974ff5df008 |
---|---|
1 #!/usr/bin/perl | |
2 | |
3 # SET UP A CRON JOB THAT RUNS FREQUENTLY (EG. EVERY 2 MIN) | |
4 | |
5 use warnings; | |
6 use strict; | |
7 use File::Copy; | |
8 use File::Which; | |
9 use File::Basename; | |
10 | |
11 ## SETTINGS | |
12 my $queue_file = '/some/world/accessible/nfs/import_queue.txt'; | |
13 my $ftp_dir = '/your/galaxy/ftp'; | |
14 my $admin_email = 'admin@yoursite.gov'; | |
15 | |
16 # INPUT | |
17 die("No args expected\n") if @ARGV; | |
18 die("Queue file does not exist: $queue_file\n") unless -f $queue_file; | |
19 die("FTP folder does not exist: $ftp_dir\n") unless -d $ftp_dir; | |
20 | |
21 # EXIT IF EMPTY | |
22 exit unless -s $queue_file; | |
23 | |
24 # CHECK IF SENDMAIL AVAILABLE | |
25 our $sendmail=which('sendmail'); # undef if not found | |
26 | |
27 # MOVE QUEUE, CREATE NEW EMPTY FILE | |
28 my $current_queue_file="$queue_file.$$"; | |
29 move($queue_file,$current_queue_file); | |
30 open(Q, ">$queue_file") or die($!); | |
31 close(Q) or die($!); | |
32 chmod 0666, $queue_file or die("Unable to chmod queue file: $!\n"); | |
33 | |
34 # LOAD QUEUE | |
35 my @queue=(); | |
36 open(Q, "<$current_queue_file") or die($!); | |
37 while (<Q>) { | |
38 chomp; | |
39 my @row=split(/\t/); | |
40 push @queue, \@row; | |
41 } | |
42 close Q; | |
43 unlink($current_queue_file); | |
44 | |
45 # COPY FILES | |
46 my %notify=(); | |
47 while (@queue) { | |
48 my $row=shift @queue; | |
49 my ($email,$path)=@$row; | |
50 copypath($path,"$ftp_dir/$email"); | |
51 if ($sendmail) { | |
52 $notify{$email}=[] unless exists($notify{$email}); | |
53 push @{$notify{$email}}, $path; | |
54 } | |
55 } | |
56 | |
57 # SEND NOTIFICATION EMAILS | |
58 foreach my $email (keys %notify) { | |
59 my $msg="The following files are available in your FTP folder; use the Upload tool to import them.\n\n" | |
60 . join("\n", @{$notify{$email}})."\n"; | |
61 email($sendmail,$admin_email,'Galaxy import complete',$email,$msg); | |
62 } | |
63 | |
64 ## SUBROUTINES | |
65 | |
66 # COPY FILE/FOLDER TO DEST FOLDER | |
67 sub copypath { | |
68 my ($src,$destdir)=@_; | |
69 return unless $src and $destdir; | |
70 $src = $1 if $src =~ /^(.+)\/$/; | |
71 $destdir = $1 if $destdir =~ /^(.+)\/$/; | |
72 # make dest if not exist | |
73 unless (-d $destdir) { | |
74 mkdir($destdir) or warn("Unable to mkdir $destdir: $!\n"); | |
75 chmod 0775, $destdir or warn("Unable to chmod dir, $destdir: $!\n"); | |
76 } | |
77 if (-d $src) { | |
78 #print "Recursively copy folder $src to $destdir\n"; | |
79 my ($subdir,$parentdir)=fileparse($src); | |
80 $destdir .= "/$subdir"; | |
81 # make dest if not exist | |
82 unless (-d $destdir) { | |
83 mkdir($destdir) or warn("Unable to mkdir $destdir: $!\n"); | |
84 chmod 0775, $destdir or warn("Unable to chmod dir, $destdir: $!\n"); | |
85 } | |
86 # process src folder | |
87 unless (opendir(DIR, $src)) { | |
88 warn("Unable to open dir, $src\n"); | |
89 return; | |
90 } | |
91 my @files= grep { $_ !~ /^\./ } readdir DIR or warn("Unable to readdir, $src: $!\n"); | |
92 closedir(DIR); | |
93 #print "Folder, $src, contains ", scalar(@files), " files\n"; | |
94 foreach my $file (@files) { | |
95 copypath("$src/$file",$destdir); | |
96 } | |
97 } elsif (-f $src) { | |
98 my ($file,$dir)=fileparse($src); | |
99 my $destfile="$destdir/$file"; | |
100 #print "Copy file, $src to $destfile\n"; | |
101 copy($src,$destdir) or warn("Unable to copy $src: $!\n"); | |
102 chmod 0664, $destfile or warn("Unable to chmod file, $destfile: $!\n"); | |
103 } else { | |
104 warn("Invalid path, $src\n"); | |
105 } | |
106 } | |
107 | |
108 sub email { | |
109 my ($sendmail, $from, $subj, $to, $msg)=@_; | |
110 return unless defined($sendmail); | |
111 die("From email not defined\n") unless $from; | |
112 die("Subj not defined\n") unless $subj; | |
113 die("Receipient email not defined\n") unless $to; | |
114 die("Message not defined\n") unless $msg; | |
115 my $email= | |
116 "Reply-to: $from\n". | |
117 "Subject: $subj\n". | |
118 "To: $to\n". | |
119 "Content-type: text/plain\n\n". | |
120 $msg; | |
121 open(SENDMAIL, "|$sendmail -t") or die "Cannot open $sendmail: $!"; | |
122 print SENDMAIL $email; | |
123 close(SENDMAIL); | |
124 } | |
125 | |
126 __END__ | |
127 Copyright(c) 2011 US DOE Joint Genome Institute. | |
128 Use freely under the same license as Galaxy itself. |