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

Annotation of /FigKernelPackages/GenomeMetaDB.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : olson 1.1 # -*- 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 :     #
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 :     # The metadata file in the DB verison contains the address of the
37 :     # service that handles the actual metadata storage:
38 :     #
39 :     # <genomeMeta genomeId="..." creationDate="...">
40 :     # <serviceHandle url="..."/>
41 :     # </genomeMeta>
42 :     #
43 :    
44 :     package GenomeMetaDB;
45 :    
46 :     use strict;
47 :     use Carp;
48 :     use Data::Dumper;
49 :     use LWP::UserAgent;
50 :     use HTTP::Request::Common;
51 :     use IO::Socket::INET;
52 :     use Cwd 'abs_path';
53 :     use HTTP::Request;
54 :     use Storable qw(fd_retrieve);
55 :     use IO::Scalar;
56 :     use XML::LibXML;
57 :    
58 :     use base 'Class::Accessor';
59 :    
60 :     __PACKAGE__->mk_accessors(qw(ua file id url dom parser));
61 :    
62 :     my $service_url = 'http://mg-rast.mcs.anl.gov:8080/meta/genome_meta_server.cgi';
63 :    
64 :     sub new
65 :     {
66 :     my($class, $genome, $file) = @_;
67 :    
68 :     my $self = bless {
69 :     genome => $genome,
70 :     file => $file,
71 :     dom => XML::LibXML->createDocument(),
72 :     parser => XML::LibXML->new(),
73 :     }, $class;
74 :    
75 :     if (! -f $file)
76 :     {
77 :     $self->create_new();
78 :     }
79 :    
80 :     $self->open();
81 :    
82 :     return $self;
83 :     }
84 :    
85 :     sub get_file
86 :     {
87 :     my($self) = @_;
88 :     return $self->{file};
89 :     }
90 :    
91 : olson 1.2 sub touch_file
92 :     {
93 :     my($self) = @_;
94 :     utime(undef, undef, $self->{file});
95 :     }
96 :    
97 : olson 1.1 sub open
98 :     {
99 :     my($self) = @_;
100 :    
101 :     open(F, "<", $self->{file}) or die "cannot open $self->{file}: $!";
102 :    
103 :     my $url;
104 :     while (<F>)
105 :     {
106 :     if (/serviceHandle=['"]([^'"]+)['"]/)
107 :     {
108 :     $url = $1;
109 :     last;
110 :     }
111 :     }
112 :     close(F);
113 :    
114 :     $url or die "Cannot find service url in $self->{file}";
115 :    
116 :     $self->url($url);
117 :     $self->ua(LWP::UserAgent->new);
118 :    
119 :     my $abs = abs_path($self->file);
120 :    
121 :     my @res = $self->invoke('id_for_path', path => $abs);
122 :     $self->id($res[0]);
123 :     }
124 :    
125 :     sub invoke
126 :     {
127 :     my($self, $op, @opts) = @_;
128 :    
129 :     push(@opts, op => $op, id => $self->id);
130 :    
131 :     # print "Invoke: " . Dumper(\@opts);
132 :    
133 :     my $req = HTTP::Request::Common::POST($self->url, \@opts);
134 :    
135 :     # print "Connect to " . $req->uri->host . " " . $req->uri->port . "\n";
136 :     my $sock = IO::Socket::INET->new(PeerHost => $req->uri->host,
137 :     PeerPort => $req->uri->port,
138 :     Proto => 'tcp');
139 :     $sock or die "cannot connect to " . $req->uri->as_string;
140 :    
141 :     my $path = $req->uri->path;
142 :     $path = '/' if $path eq '';
143 :     print $sock "POST $path HTTP/1.0\n";
144 :     print $sock $req->headers->as_string();
145 :     print $sock "\n";
146 :     print $sock $req->content();
147 :    
148 :     $sock->shutdown(1);
149 :    
150 :     my $l = <$sock>;
151 :     my($proto, $code, $rest) = split(/\s+/, $l, 3);
152 :     # print "proto=$proto code==$code rest=$rest\n";
153 :     if ($code !~ /^2/)
154 :     {
155 :     die "failed with res: $_";
156 :     }
157 :    
158 :     while (my $l = <$sock>)
159 :     {
160 :     # print "Got '$l'\n";
161 :     $l =~ s/[\r\n]//g;
162 :    
163 :     last if $l eq '';
164 :     }
165 :    
166 :     local $/;
167 :     undef $/;
168 :     my $dat = <$sock>;
169 :     #print "Got dat '$dat'\n";
170 :     my $ret = $self->deserialize_value($dat);
171 :     #print Dumper($ret);
172 :     return $ret;
173 :     }
174 :    
175 :     =head3
176 :    
177 :     Create a new metadata file.
178 :    
179 :     =cut
180 :    
181 :     sub create_new
182 :     {
183 :     my($self) = @_;
184 :     my $file = $self->file;
185 :     open(F, ">", $file) or die "Cannot create $file: $!";
186 :     print F "<genomeMeta serviceHandle='$service_url' genome='$self->{genome}'/>\n";
187 :     close(F);
188 :     }
189 :    
190 :     sub readonly
191 :     {
192 :     my $self = @_;
193 :     return $self->{readonly};
194 :     }
195 :    
196 :     sub set_metadata
197 :     {
198 :     my($self, $name, $val) = @_;
199 :    
200 :     $self->invoke('set', key => $name, data => $self->serialize_value($val)->toString);
201 : olson 1.2 $self->touch_file();
202 : olson 1.1 }
203 :    
204 :     sub get_metadata
205 :     {
206 :     my($self, $name) = @_;
207 :    
208 :     return $self->invoke('get', key => $name);
209 :     }
210 :    
211 :     sub get_metadata_keys
212 :     {
213 :     my($self) = @_;
214 :     my $l = $self->invoke('get_keys');
215 :     return @$l;
216 :     }
217 :    
218 :     sub add_log_entry
219 :     {
220 :     my($self, $type, $data) = @_;
221 :    
222 :     $self->invoke("log", type => $type, data => $self->serialize_value($data)->toString);
223 : olson 1.2 $self->touch_file();
224 : olson 1.1 }
225 :    
226 :     sub get_log
227 :     {
228 :     my($self) = @_;
229 :    
230 :     my $out = [];
231 :     my $l = $self->invoke('get_log');
232 :     return $l;
233 :     }
234 :    
235 :     sub serialize_value
236 :     {
237 :     my($self, $val) = @_;
238 :    
239 :     if (ref($val) eq 'ARRAY')
240 :     {
241 :     my $n = $self->{dom}->createElement("array");
242 :     for my $elt (@$val)
243 :     {
244 :     my $selt = $self->serialize_value($elt);
245 :     $n->appendChild($selt);
246 :     }
247 :     return $n;
248 :     }
249 :     elsif (ref($val) eq 'HASH')
250 :     {
251 :     my $n = $self->{dom}->createElement("hash");
252 :    
253 :     for my $k (keys(%$val))
254 :     {
255 :     my $sk = $self->serialize_value($k);
256 :     my $sv = $self->serialize_value($val->{$k});
257 :    
258 :     my $sn = $self->{dom}->createElement("k");
259 :     $sn->appendChild($sk);
260 :     $n->appendChild($sn);
261 :     $sn = $self->{dom}->createElement("v");
262 :     $sn->appendChild($sv);
263 :     $n->appendChild($sn);
264 :     }
265 :     return $n;
266 :     }
267 :     elsif (ref($val))
268 :     {
269 :     die "Cannot serialize other refs ($val)";
270 :     }
271 :     elsif (defined($val))
272 :     {
273 :     my $n = $self->{dom}->createElement("scalar");
274 :     $n->appendChild($self->{dom}->createCDATASection($val));
275 :     # $n->setAttribute(value => $val);
276 :     return $n;
277 :     }
278 :     else
279 :     {
280 :     my $n = $self->{dom}->createElement("undef");
281 :     return $n;
282 :     }
283 :     }
284 :    
285 :     sub deserialize_value
286 :     {
287 :     my($self, $node) = @_;
288 :    
289 :     return unless defined($node);
290 :    
291 :     if (!ref($node))
292 :     {
293 :     $node = $self->parser->parse_string($node)->documentElement();
294 :     }
295 :    
296 :     my $type = $node->nodeName();
297 :    
298 :     if ($type eq 'scalar')
299 :     {
300 :     my $cd = $node->firstChild();
301 :     return ref($cd) ? $cd->nodeValue() : undef;
302 :     }
303 :     elsif ($type eq 'hash')
304 :     {
305 :     my $h = {};
306 :     my $e = $node->firstChild();
307 :     while ($e)
308 :     {
309 :     my $e2 = $e->nextSibling();
310 :     if ($e->nodeName() ne 'k' or $e2->nodeName() ne 'v')
311 :     {
312 :     die "invalid hash values";
313 :     }
314 :     my $k = $self->deserialize_value($e->firstChild());
315 :     my $v = $self->deserialize_value($e2->firstChild());
316 :     $h->{$k} = $v;
317 :     $e = $e2->nextSibling();
318 :     }
319 :     return $h;
320 :     }
321 :     elsif ($type eq 'array')
322 :     {
323 :     my $l = [];
324 :     my $e = $node->firstChild();
325 :     while ($e)
326 :     {
327 :     my $v = $self->deserialize_value($e);
328 :     push(@$l, $v);
329 :     $e = $e->nextSibling();
330 :     }
331 :     return $l;
332 :     }
333 :     elsif ($type eq 'undef')
334 :     {
335 :     return undef;
336 :     }
337 :     }
338 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3