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

Annotation of /FigKernelPackages/GenomeMeta.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : gdpusch 1.11 # -*- perl -*-
2 :     ########################################################################
3 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
4 :     # for Interpretations of Genomes. All Rights Reserved.
5 :     #
6 :     # This file is part of the SEED Toolkit.
7 :     #
8 :     # The SEED Toolkit is free software. You can redistribute
9 :     # it and/or modify it under the terms of the SEED Toolkit
10 :     # Public License.
11 :     #
12 :     # You should have received a copy of the SEED Toolkit Public License
13 :     # along with this program; if not write to the University of Chicago
14 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
15 :     # Genomes at veronika@thefig.info or download a copy from
16 :     # http://www.theseed.org/LICENSE.TXT.
17 :     ########################################################################
18 :    
19 : olson 1.1 #
20 :     # Package to maintain metadata records about a genome.
21 :     #
22 :     # Intended to be used to maintain state of a genome during its passage through
23 :     # the 48-hour annotation server.
24 :     #
25 :     # Metadata keys are simple strings.
26 :     # Metadata values may be any of the basic perl data structures: scalar,
27 :     # list, hash.
28 :     # Metadata values may contain nested data structures.
29 :     #
30 :     # We also maintain a log of changes made to the genome. Each log entry
31 :     # has a log-date, comment, and data field.
32 :     #
33 :     # Changes to metadata result in log entries that contain the old and new
34 :     # values for the metadata entry.
35 :     #
36 :    
37 :     package GenomeMeta;
38 :    
39 : olson 1.2 use Carp;
40 :     use Data::Dumper;
41 : olson 1.16 use Errno;
42 : olson 1.2
43 : olson 1.10 use FileLocking qw(lock_file unlock_file lock_file_shared);
44 : olson 1.2 use FileHandle;
45 :     use Fcntl ':seek';
46 : olson 1.15 use GenomeMetaDB;
47 : olson 1.1 use XML::LibXML;
48 :     use strict;
49 : olson 1.13 my $have_fsync;
50 :     eval {
51 :     require File::Sync;
52 :     $have_fsync++;
53 :     };
54 :     #print STDERR "have_fsync=$have_fsync\n";
55 : olson 1.16 #my $host = `hostname`;
56 :     #chomp $host;
57 : olson 1.1
58 :     sub new
59 :     {
60 : olson 1.10 my($class, $genome, $file, %opts) = @_;
61 : olson 1.1
62 : olson 1.15 #
63 :     # First see if this is a database-based file.
64 :     #
65 :     if (open(my $fh, "<$file"))
66 :     {
67 :     my $n = 0;
68 :     while (my $l = <$fh>)
69 :     {
70 :     last if $n++ > 4;
71 :     if ($l =~ /serviceHandle/)
72 :     {
73 :     close($fh);
74 :     return new GenomeMetaDB($genome, $file);
75 :     }
76 :     }
77 :     close($fh);
78 :     }
79 :    
80 : olson 1.1 my $self = bless {
81 :     genome => $genome,
82 :     file => $file,
83 : olson 1.10 options => \%opts,
84 :     readonly => $opts{readonly},
85 : olson 1.1 }, $class;
86 :    
87 :     if (-f $file)
88 :     {
89 :     $self->load();
90 :     }
91 :     else
92 :     {
93 :     $self->create_new();
94 :     }
95 :     return $self;
96 :     }
97 :    
98 : olson 1.3 sub get_file
99 :     {
100 :     my($self) = @_;
101 :     return $self->{file};
102 :     }
103 :    
104 : olson 1.10 sub readonly
105 :     {
106 :     my $self = @_;
107 :     return $self->{readonly};
108 :     }
109 : olson 1.3
110 : olson 1.1 sub load
111 :     {
112 :     my($self) = @_;
113 :    
114 : olson 1.2 my $fh = new FileHandle("<$self->{file}");
115 :     if (!$fh)
116 :     {
117 :     die "Cannot open meta file $self->{file}: $!\n";
118 :     }
119 : olson 1.10 lock_file_shared($fh);
120 : olson 1.2 seek($fh, 0, SEEK_SET);
121 :     my @stat = stat($fh);
122 :     $self->{last_mod} = $stat[9];
123 :    
124 : paarmann 1.7 eval { $self->load_from_fh($fh) };
125 :     if($@) { die "Error reading ".$self->{file}.":\n $@"; }
126 :    
127 : olson 1.2 unlock_file($fh);
128 :     close($fh);
129 :     }
130 :    
131 :     sub load_from_fh
132 :     {
133 :     my($self, $fh) = @_;
134 :    
135 : olson 1.1 my $parser = XML::LibXML->new();
136 : olson 1.2
137 : olson 1.1 $parser->keep_blanks(0);
138 : olson 1.2 my $dom = $parser->parse_fh($fh);
139 : olson 1.1
140 :     my $root = $dom->documentElement();
141 :     if ($root->nodeName ne "genomeMeta")
142 :     {
143 :     die "invalid root nodename ". $root->nodeName() ." in metadata";
144 :     }
145 :    
146 :     my $g = $root->getAttribute('genomeId');
147 : olson 1.2
148 :     if (defined($self->{genome}))
149 : olson 1.1 {
150 : olson 1.2 if ($g ne $self->{genome})
151 :     {
152 : olson 1.5 warn "metadata genome $g does not match our genome $self->{genome}\n";
153 : olson 1.2 }
154 :     }
155 :     else
156 :     {
157 :     $self->{genome} = $g;
158 : olson 1.1 }
159 :     $self->set_dom($dom);
160 :     }
161 : olson 1.2
162 : olson 1.1
163 :     =head3
164 :    
165 :     Create a new metadata file.
166 :    
167 :     =cut
168 :    
169 :     sub create_new
170 :     {
171 :     my($self) = @_;
172 :    
173 :     my $dom = XML::LibXML->createDocument;
174 :     my $root = $dom->createElement('genomeMeta');
175 :     $root->setAttribute(genomeId => $self->{genome});
176 :     $root->setAttribute(creationDate => time);
177 :     $dom->setDocumentElement($root);
178 :    
179 :     my $md = $dom->createElement('metadata');
180 :     $root->appendChild($md);
181 :    
182 :     my $log = $dom->createElement('log');
183 :     $root->appendChild($log);
184 :    
185 :     $self->set_dom($dom);
186 :    
187 : olson 1.2 $self->{fh} = new FileHandle(">$self->{file}");
188 :    
189 : olson 1.1 $self->write();
190 :     }
191 :    
192 : olson 1.2 =head3 lock_for_writing
193 :    
194 :     Open and lock the metadata file. If the last_mod time on the file
195 :     is later than the state we have internally, reread the file before
196 :     continuing. Leave the file locked.
197 :    
198 :     =cut
199 :    
200 :     sub lock_for_writing
201 :     {
202 :     my($self) = @_;
203 :    
204 : olson 1.16 my $tries = 10;
205 :    
206 :     my $fh;
207 :     while ($tries--)
208 :     {
209 :    
210 :     $SIG{INT} = sub { $self->{exit} = 1;};
211 :     $SIG{TERM} = sub { $self->{exit} = 1;};
212 :     $SIG{HUP} = sub { $self->{exit} = 1;};
213 :     $fh = new FileHandle("+<$self->{file}");
214 :     $fh or die "Cannot open $self->{file}: $!\n";
215 :     if (!defined(lock_file($fh)))
216 :     {
217 :     my $err = $!;
218 :     if ($err == Errno::EOVERFLOW)
219 :     {
220 :     warn "Hit EOVERFLOW, sleeping and retrying\n";
221 :     sleep 1;
222 :     next;
223 :     }
224 :     die "lock_file failed: $err";
225 :     }
226 :     $fh->autoflush(1);
227 :    
228 :     seek($fh, 0, SEEK_SET);
229 :    
230 :     eval {
231 :     $self->load_from_fh($fh);
232 :     };
233 : olson 1.2
234 : olson 1.16 if ($@)
235 :     {
236 :     warn "Error in lock_for_writing at tries=$tries: $@";
237 :     close($fh);
238 :     undef $fh;
239 :     }
240 :     else
241 :     {
242 :     last;
243 :     }
244 :     }
245 :    
246 : olson 1.12 seek($fh, 0, SEEK_SET);
247 :     $fh->truncate(0);
248 : olson 1.16
249 :     $self->{fh} = $fh;
250 : olson 1.12
251 : olson 1.2 }
252 :    
253 :     sub check_for_reading
254 :     {
255 :     my($self) = @_;
256 :    
257 :     my $fh = new FileHandle("<$self->{file}");
258 :     $fh or die "Cannot open $self->{file}: $!\n";
259 : olson 1.16 if (!defined(lock_file_shared($fh)))
260 :     {
261 :     die "lock failed: $!";
262 :     }
263 : olson 1.2 my @stat = stat($fh);
264 :     my $last_mod = $stat[9];
265 :    
266 :     if ($last_mod > $self->{last_mod})
267 :     {
268 :     seek($fh, 0, SEEK_SET);
269 :     warn "check_for_reading: rereading after obtaining lock\n";
270 :     $self->load_from_fh($fh);
271 :     }
272 :     unlock_file($fh);
273 :     close($fh);
274 :     }
275 :    
276 : olson 1.1 sub write
277 :     {
278 :     my($self) = @_;
279 : olson 1.2
280 :     my $fh = $self->{fh};
281 :     if (!$fh)
282 :     {
283 :     confess "GenomeMeta::write: fh not set";
284 :     }
285 :    
286 :     $self->{dom}->toFH($fh, 2);
287 :    
288 :     my @stat = stat($fh);
289 :     $self->{last_mod} = $stat[9];
290 :    
291 : olson 1.13 eval { File::Sync::fsync($fh) if $have_fsync; };
292 :    
293 : olson 1.2 unlock_file($fh);
294 :     close($fh);
295 :     delete $self->{fh};
296 :     $SIG{INT} = 'DEFAULT';
297 :     $SIG{TERM} = 'DEFAULT';
298 :     $SIG{HUP} = 'DEFAULT';
299 :     if ($self->{exit})
300 :     {
301 :     die "Exiting on deferred signal\n";
302 :     }
303 : olson 1.1 }
304 :    
305 :    
306 :     =head3 set_dom
307 :    
308 :     Set the DOM document for our metadata file.
309 :    
310 :     This also sets root - root of documents, md - metadata container noe, and log - log container node.
311 :    
312 :     =cut
313 :    
314 :     sub set_dom
315 :     {
316 :     my($self, $dom) = @_;
317 :    
318 :     my $root = $dom->documentElement();
319 :    
320 :     my @md = $root->findnodes("/genomeMeta/metadata");
321 :     if (@md != 1)
322 :     {
323 :     die "Invalid metadata list in document";
324 :     }
325 :     $self->{md} = $md[0];
326 :    
327 :     my @log = $root->findnodes("/genomeMeta/log");
328 :     if (@log != 1)
329 :     {
330 :     die "Invalid log element in document";
331 :     }
332 :     $self->{log} = $log[0];
333 :    
334 :     $self->{dom} = $dom;
335 :     $self->{root} = $root;
336 :     }
337 :    
338 :     sub add_log_entry
339 :     {
340 :     my($self, $type, $data) = @_;
341 :    
342 : olson 1.2 $self->lock_for_writing();
343 :    
344 : olson 1.1 if (ref($type))
345 :     {
346 :     die "log type cannot be a reference";
347 :     }
348 :    
349 :     my $lnode = $self->{dom}->createElement("log_entry");
350 :     $lnode->setAttribute(type => $type);
351 :     $lnode->setAttribute(updateTime => time);
352 :     $lnode->appendChild($self->serialize_value($data));
353 :    
354 :     $self->{log}->appendChild($lnode);
355 :     $self->write();
356 :     }
357 :    
358 :     sub set_metadata
359 :     {
360 :     my($self, $name, $val) = @_;
361 :    
362 :     if (ref($name))
363 :     {
364 :     die "metadata key cannot be a reference";
365 :     }
366 :    
367 : olson 1.2 $self->lock_for_writing();
368 :    
369 : olson 1.1 my $did_create;
370 :     my $md_node = $self->find_metadata_node($name, \$did_create);
371 :    
372 :     my $sval = $self->serialize_value($val);
373 :    
374 :     my $md_new = $self->{dom}->createElement("entry");
375 :     $md_new->setAttribute(name => $name);
376 :     $md_new->appendChild($sval);
377 :    
378 :     my $lnode;
379 :     if (not $did_create)
380 :     {
381 :     my $md_old = $md_node->replaceNode($md_new);
382 :    
383 :     $lnode = $self->{dom}->createElement("meta_updated");
384 :     $lnode->setAttribute(updateTime => time);
385 :     $lnode->appendChild($md_old);
386 :     }
387 :     else
388 :     {
389 :     my $md_old = $md_node->replaceNode($md_new);
390 :    
391 :     $lnode = $self->{dom}->createElement("meta_created");
392 :     $lnode->setAttribute(updateTime => time);
393 :     $lnode->setAttribute(name => $name);
394 :     }
395 :    
396 :     $self->{log}->appendChild($lnode);
397 :    
398 :     $self->write();
399 :     }
400 :    
401 :     sub get_metadata
402 :     {
403 :     my($self, $name) = @_;
404 :    
405 : olson 1.2 $self->check_for_reading();
406 :    
407 : olson 1.1 if (ref($name))
408 :     {
409 :     die "metadata key cannot be a reference";
410 :     }
411 :    
412 :     my $md_node = $self->find_metadata_node($name);
413 :    
414 :     my $val;
415 :     if (defined($md_node))
416 :     {
417 :     $val = $self->deserialize_value($md_node->firstChild());
418 :     }
419 :    
420 :     return $val;
421 :     }
422 :    
423 : olson 1.2 sub get_metadata_keys
424 :     {
425 :     my($self) = @_;
426 :     $self->check_for_reading();
427 :    
428 :     my $expr = '//metadata/entry/@name';
429 :    
430 :     my @m = $self->{md}->findnodes($expr);
431 :    
432 :     return map { $_->value() } @m;
433 :     }
434 :    
435 :     sub get_log
436 :     {
437 :     my($self) = @_;
438 :     $self->check_for_reading();
439 :    
440 :     my $out = [];
441 :     for (my $node = $self->{log}->firstChild; $node; $node = $node->nextSibling)
442 :     {
443 :     my $type = $node->nodeName();
444 :    
445 :     if ($type eq 'meta_created')
446 :     {
447 :     push(@$out, [$type, $node->getAttribute("name"), $node->getAttribute("updateTime")]);
448 :     }
449 :     elsif ($type eq 'meta_updated')
450 :     {
451 :     my $ent = $node->firstChild();
452 :     my $val = $self->deserialize_value($ent->firstChild());
453 :     push(@$out, [$type, $ent->getAttribute("name"), $node->getAttribute("updateTime"), $val]);
454 :     }
455 :     elsif ($type eq "log_entry")
456 :     {
457 :     my $val = $self->deserialize_value($node->firstChild());
458 :     push(@$out, [$type, $node->getAttribute('type'), $node->getAttribute('updateTime'), $val]);
459 :     }
460 :     }
461 :     return $out;
462 :     }
463 :    
464 : olson 1.1 sub deserialize_value
465 :     {
466 :     my($self, $node) = @_;
467 : olson 1.3
468 :     return unless defined($node);
469 : olson 1.1 my $type = $node->nodeName();
470 :    
471 :     if ($type eq 'scalar')
472 :     {
473 :     my $cd = $node->firstChild();
474 : olson 1.9 return ref($cd) ? $cd->nodeValue() : undef;
475 : olson 1.1 }
476 :     elsif ($type eq 'hash')
477 :     {
478 :     my $h = {};
479 :     my $e = $node->firstChild();
480 :     while ($e)
481 :     {
482 :     my $e2 = $e->nextSibling();
483 :     if ($e->nodeName() ne 'k' or $e2->nodeName() ne 'v')
484 :     {
485 :     die "invalid hash values";
486 :     }
487 :     my $k = $self->deserialize_value($e->firstChild());
488 :     my $v = $self->deserialize_value($e2->firstChild());
489 :     $h->{$k} = $v;
490 :     $e = $e2->nextSibling();
491 :     }
492 :     return $h;
493 :     }
494 :     elsif ($type eq 'array')
495 :     {
496 :     my $l = [];
497 :     my $e = $node->firstChild();
498 :     while ($e)
499 :     {
500 :     my $v = $self->deserialize_value($e);
501 :     push(@$l, $v);
502 :     $e = $e->nextSibling();
503 :     }
504 :     return $l;
505 :     }
506 :     elsif ($type eq 'undef')
507 :     {
508 :     return undef;
509 :     }
510 :     }
511 :    
512 :     sub serialize_value
513 :     {
514 :     my($self, $val) = @_;
515 :    
516 :     if (ref($val) eq 'ARRAY')
517 :     {
518 :     my $n = $self->{dom}->createElement("array");
519 :     for my $elt (@$val)
520 :     {
521 :     my $selt = $self->serialize_value($elt);
522 :     $n->appendChild($selt);
523 :     }
524 :     return $n;
525 :     }
526 :     elsif (ref($val) eq 'HASH')
527 :     {
528 :     my $n = $self->{dom}->createElement("hash");
529 :    
530 :     for my $k (keys(%$val))
531 :     {
532 :     my $sk = $self->serialize_value($k);
533 :     my $sv = $self->serialize_value($val->{$k});
534 :    
535 :     my $sn = $self->{dom}->createElement("k");
536 :     $sn->appendChild($sk);
537 :     $n->appendChild($sn);
538 : olson 1.4 $sn = $self->{dom}->createElement("v");
539 : olson 1.1 $sn->appendChild($sv);
540 :     $n->appendChild($sn);
541 :     }
542 :     return $n;
543 :     }
544 :     elsif (ref($val))
545 :     {
546 :     die "Cannot serialize other refs ($val)";
547 :     }
548 :     elsif (defined($val))
549 :     {
550 :     my $n = $self->{dom}->createElement("scalar");
551 :     $n->appendChild($self->{dom}->createCDATASection($val));
552 :     # $n->setAttribute(value => $val);
553 :     return $n;
554 :     }
555 :     else
556 :     {
557 :     my $n = $self->{dom}->createElement("undef");
558 :     return $n;
559 :     }
560 :     }
561 :    
562 :     sub find_metadata_node
563 :     {
564 :     my($self, $name, $created) = @_;
565 :    
566 :     my $expr = qq(./entry[\@name="$name"]);
567 :     my @m = $self->{md}->findnodes($expr);
568 :     my $m;
569 :     if (@m == 0)
570 :     {
571 :     $m = $self->{dom}->createElement("entry");
572 :     $m->setAttribute(name => $name);
573 :     $self->{md}->appendChild($m);
574 :     $created and $$created = 1;
575 :     }
576 :     else
577 :     {
578 :     $m = shift @m;
579 :     }
580 :     return $m;
581 :     }
582 :    
583 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3