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.