[Bio] / FigKernelPackages / Cluster.pm Repository:
ViewVC logotype

Annotation of /FigKernelPackages/Cluster.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (view) (download) (as text)

1 : olson 1.1 #
2 :     # Routines for managing SEED jobs on a cluster.
3 :     #
4 :    
5 :     package Cluster::DBJobMgr;
6 :     use strict;
7 :    
8 :     use base qw(Class::Accessor);
9 :    
10 :     __PACKAGE__->mk_accessors(qw(table_name fig db dbh dbms lock_mode));
11 :    
12 :     use constant {
13 :     AVAIL => 0,
14 :     TAKEN => 1,
15 :     DONE => 2,
16 :     };
17 :    
18 :     #
19 :     # A database-based job manager.
20 :     #
21 :     # We use a table in the database to maintain the work to be done and the work
22 :     # as completed.
23 :     #
24 :    
25 :     sub new
26 :     {
27 :     my($class, $fig, $table_name) = @_;
28 :    
29 :     #
30 :     # Ensure table_name is valid.
31 :     #
32 :    
33 :     if ($table_name !~ /^\w+$/)
34 :     {
35 :     die "Cluster::DBJobMgr::new: Table name may only consist of alphanumeric characters, no spaces allowed.";
36 :     }
37 :    
38 :     my $db = $fig->db_handle;
39 :     my $dbh = $db->{_dbh};
40 :     my $dbms = $db->{_dbms};
41 :    
42 :     my $self = {
43 :     table_name => "pjs_$table_name",
44 :     fig => $fig,
45 :     db => $db,
46 :     dbh => $dbh,
47 :     dbms => $dbms,
48 :     lock_mode => "",
49 :     };
50 :    
51 :     bless $self, $class;
52 :    
53 :     if ($dbms eq "mysql")
54 :     {
55 :     $self->lock_mode("for update");
56 :     }
57 :    
58 :     return bless $self, $class;
59 :     }
60 :    
61 :     sub get_work
62 :     {
63 :     my($self, $worker) = @_;
64 :     my $work;
65 :    
66 :     my $dbh = $self->dbh;
67 :     my $table = $self->table_name;
68 :    
69 :     local $dbh->{AutoCommit} = 0;
70 :     local $dbh->{RaiseError} = 1;
71 :    
72 :     eval {
73 :     my $res = $dbh->selectall_arrayref("SELECT * FROM $table
74 :     WHERE status = ? LIMIT 1 " . $self->lock_mode,
75 :     undef,
76 :     AVAIL);
77 :     if (not $res or @$res == 0)
78 :     {
79 :     die "No work found\n";
80 :     }
81 :    
82 :     my ($peg, $status, $job_taken, $job_finished, $output) = @{$res->[0]};
83 :     # warn "Found peg=$peg status=$status job info $job_taken $job_finished\n";
84 :     $dbh->do("update $table set status = ?, worker = ?, job_taken = now() where peg = ?", undef,
85 :     TAKEN, $worker, $peg);
86 :    
87 :     $dbh->commit();
88 :     $work = $peg;
89 :     };
90 :    
91 :     if ($@)
92 :     {
93 :     warn "Error in get_work eval: $@\n";
94 :     $dbh->rollback();
95 :     return;
96 :     }
97 :     else
98 :     {
99 :     return $work;
100 :     }
101 :     }
102 :    
103 :     sub work_done
104 :     {
105 :     my($self, $work, $output) = @_;
106 :    
107 :     my $dbh = $self->dbh;
108 :     my $table = $self->table_name;
109 :    
110 :     local $dbh->{AutoCommit} = 0;
111 :     local $dbh->{RaiseError} = 1;
112 :    
113 :     eval {
114 :     $dbh->do("update $table set status = ?, job_finished = now(), output = ? where peg = ?", undef,
115 :     DONE, $output, $work);
116 :    
117 :     $dbh->commit();
118 :     };
119 :    
120 :     if ($@)
121 :     {
122 :     warn "Error in work_done eval: $@\n";
123 :     $dbh->rollback();
124 :     die "Invalid work request: $@";
125 :     }
126 :     else
127 :     {
128 :     return 1;
129 :     }
130 :    
131 :     }
132 :    
133 :     sub work_done
134 :     {
135 :     my($self, $work, $output) = @_;
136 :    
137 :     my $dbh = $self->dbh;
138 :     my $table = $self->table_name;
139 :    
140 :     local $dbh->{AutoCommit} = 0;
141 :     local $dbh->{RaiseError} = 1;
142 :    
143 :     eval {
144 :     $dbh->do("update $table set status = ?, job_finished = now(), output = ? where peg = ?", undef,
145 :     DONE, $output, $work);
146 :    
147 :     $dbh->commit();
148 :     };
149 :    
150 :     if ($@)
151 :     {
152 :     warn "Error in work_done eval: $@\n";
153 :     $dbh->rollback();
154 :     die "Invalid work_done request: $@";
155 :     }
156 :     else
157 :     {
158 :     return 1;
159 :     }
160 :    
161 :     }
162 :    
163 :     sub work_aborted
164 :     {
165 :     my($self, $work) = @_;
166 :    
167 :     my $dbh = $self->dbh;
168 :     my $table = $self->table_name;
169 :    
170 :     local $dbh->{AutoCommit} = 0;
171 :     local $dbh->{RaiseError} = 1;
172 :    
173 :     eval {
174 :     $dbh->do("update $table set status = ?, job_finished = now(), output = NULL where peg = ?", undef,
175 :     AVAIL, $work);
176 :    
177 :     $dbh->commit();
178 :     };
179 :    
180 :     if ($@)
181 :     {
182 :     warn "Error in work_aborted eval: $@\n";
183 :     $dbh->rollback();
184 :     die "Invalid work_aborted request:$@";
185 :     }
186 :     else
187 :     {
188 :     return 1;
189 :     }
190 :    
191 :     }
192 :    
193 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3