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

Annotation of /FigKernelPackages/MetaSubsystem.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : bartels 1.1 #
2 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
3 :     # for Interpretations of Genomes. All Rights Reserved.
4 :     #
5 :     # This file is part of the SEED Toolkit.
6 :     #
7 :     # The SEED Toolkit is free software. You can redistribute
8 :     # it and/or modify it under the terms of the SEED Toolkit
9 :     # Public License.
10 :     #
11 :     # You should have received a copy of the SEED Toolkit Public License
12 :     # along with this program; if not write to the University of Chicago
13 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
14 :     # Genomes at veronika@thefig.info or download a copy from
15 :     # http://www.theseed.org/LICENSE.TXT.
16 :     #
17 :    
18 :     package MetaSubsystem;
19 :    
20 :     #use Carp;
21 :    
22 :     #use POSIX;
23 :     use DirHandle;
24 :     #use Data::Dumper;
25 :     #use File::Copy;
26 :     #use File::Spec;
27 :     #use IPC::Open2;
28 :     #use FileHandle;
29 :     #use Tracer;
30 :     use Subsystem;
31 :     use strict;
32 :    
33 :     1;
34 :    
35 :     sub new {
36 :    
37 : bartels 1.2 my ( $class, $name, $fig, $create, $subsystems, $genomes, $subsets, $view, $description ) = @_;
38 : bartels 1.1
39 :     my $msadir = get_dir_from_name( $name );
40 :    
41 :    
42 : bartels 1.2 if ( ! -d $msadir and not $create ) {
43 :     return undef;
44 :     }
45 :    
46 : bartels 1.1 # RAE: Please do this:
47 :     $name =~ s/^\s+//; $name =~ s/\s+$//;
48 :     $name =~ s/ /_/g;
49 :    
50 :     my $self = {
51 :     dir => $msadir,
52 :     name => $name,
53 :     fig => $fig,
54 :     };
55 :    
56 :     bless($self, $class);
57 :    
58 :     #
59 :     # Check to see if the database we're running against has a variant column.
60 :     #
61 :     # $self->detect_db_version();
62 :    
63 :     if ($create)
64 :     {
65 : bartels 1.2 my $succ = $self->create_metasubsystem( $subsystems, $genomes, $subsets, $view, $description );
66 :     if ( $succ eq -1 ) {
67 :     return -1;
68 :     }
69 : bartels 1.1 }
70 :     else
71 :     {
72 :     $self->load();
73 :     }
74 :    
75 :     return $self;
76 :     }
77 :    
78 :    
79 :     =head3 create_metasubsystem
80 :    
81 :     Create a new subsystem. This creates the subsystem directory in the
82 :     correct place ($FIG_Config::data/Subsystems), and populates it with
83 :     the correct initial data.
84 :    
85 :     =cut
86 :    
87 :     sub create_metasubsystem {
88 : bartels 1.2 my( $self, $subsystems, $genomes, $subsets, $view, $description ) = @_;
89 : bartels 1.1
90 :     my $dir = $self->{dir};
91 :     my $fig = $self->{fig};
92 :    
93 :     $self->{ genomes } = $genomes;
94 :     $self->{ subsystems } = $subsystems;
95 :     $self->{ subsets } = $subsets;
96 :     $self->{ view } = $view;
97 : bartels 1.2 $self->{ description } = $description;
98 : bartels 1.1
99 :     if (-d $dir) {
100 :     warn "Not creating: MetaSubsystem directory $dir already exists";
101 : bartels 1.2 return -1;
102 : bartels 1.1 }
103 :    
104 :     $fig->verify_dir($dir);
105 :    
106 :     $self->write_metasubsystem();
107 :     }
108 :    
109 :     sub write_metasubsystem {
110 :     my( $self, $force_backup ) = @_;
111 :    
112 :     my $dir = $self->{dir};
113 :     my $fig = $self->{fig};
114 :    
115 :     #
116 :     # We first move the existing spreadsheet and notes files (if present)
117 :     # to spreadsheet~ and notes~, and current state.
118 :     #
119 :    
120 :     my $genomes_file = "$dir/genomes";
121 :     my $genomes_bak = "$dir/genomes~";
122 :     my $subsystems_file = "$dir/subsystems";
123 :     my $subsystems_bak = "$dir/subsystems~";
124 :     my $subsets_file = "$dir/subsets";
125 :     my $subsets_bak = "$dir/subsets~";
126 :     my $view_file = "$dir/view";
127 :     my $view_bak = "$dir/view~";
128 : bartels 1.2 my $description_file = "$dir/description";
129 :     my $description_bak = "$dir/description~";
130 : bartels 1.1
131 :     if ( -f $genomes_file ) {
132 :     rename( $genomes_file, $genomes_bak);
133 :     }
134 :     if ( -f $subsystems_file ) {
135 :     rename( $subsystems_file, $subsystems_bak);
136 :     }
137 :     if ( -f $subsets_file ) {
138 :     rename( $subsets_file, $subsets_bak);
139 :     }
140 :     if ( -f $view_file ) {
141 :     rename( $view_file, $view_bak);
142 :     }
143 : bartels 1.2 if ( -f $description_file ) {
144 :     rename( $description_file, $description_bak);
145 :     }
146 : bartels 1.1
147 :     eval {
148 :     my $fh;
149 :    
150 :     open( $fh, ">$genomes_file" ) or die "Cannot open $genomes_file for writing: $!\n";
151 :     my $genomes = $self->{ genomes };
152 :     foreach $_ ( keys %$genomes ) {
153 :     print $fh "$_\n";
154 :     }
155 :     close( $fh );
156 :     chmod( 0777,$genomes_file );
157 :    
158 :     open( $fh, ">$subsets_file" ) or die "Cannot open $subsets_file for writing: $!\n";
159 :     my $subsets = $self->{ subsets };
160 : bartels 1.2 if ( defined( $subsets ) ) {
161 :     foreach my $ss ( keys %$subsets ) {
162 :     foreach my $sub ( keys %{ $subsets->{ $ss } } ) {
163 :     chomp $sub;
164 :     print $fh "$ss\t$sub\n";
165 :     }
166 : bartels 1.1 }
167 :     }
168 :     close( $fh );
169 :     chmod( 0777,$subsystems_file );
170 :    
171 :     open( $fh, ">$subsystems_file" ) or die "Cannot open $subsystems_file for writing: $!\n";
172 :     my $subsystems = $self->{ subsystems };
173 :     foreach my $sst ( keys %$subsystems ) {
174 :     chomp $sst;
175 :     print $fh "$sst\n";
176 :     }
177 :     close( $fh );
178 :     chmod( 0777,$subsystems_file );
179 :    
180 :     open( $fh, ">$view_file" ) or die "Cannot open $view_file for writing: $!\n";
181 :     my $view = $self->{ view };
182 : bartels 1.2 if ( defined( $view ) ) {
183 :     my %subsets_view = %{ $view->{ 'Subsets' } };
184 : bartels 1.1 foreach my $ssname ( keys %subsets_view ) {
185 :     my $visible = $subsets_view{ $ssname }->{ 'visible' };
186 :     $visible = 0 if ( !defined( $visible ) );
187 : bartels 1.2 my $collapsed = $subsets_view{ $ssname }->{ 'collapsed' };
188 :     $collapsed = 0 if ( !defined( $collapsed ) );
189 :     print $fh "Subset\t$ssname\t$visible\t$collapsed\n";
190 :     }
191 :     if ( defined( $view->{ 'Roles' } ) ) {
192 :     %subsets_view = %{ $view->{ 'Roles' } };
193 :     foreach my $ssname ( keys %subsets_view ) {
194 :     my $visible = $subsets_view{ $ssname }->{ 'visible' };
195 :     $visible = 0 if ( !defined( $visible ) );
196 :    
197 :     if ( $ssname =~ /(.*)##-##(.*)/ ) {
198 :     my $role = $1;
199 :     my $subsystem = $2;
200 :     $subsystem = 0 if ( !defined( $subsystem ) );
201 :     print $fh "Role\t$ssname\t$subsystem\t$visible\n";
202 :     }
203 : bartels 1.1 }
204 :     }
205 :     }
206 :     close( $fh );
207 :     chmod( 0777,$subsystems_file );
208 : bartels 1.2
209 :     open( $fh, ">$description_file" ) or die "Cannot open $description_file for writing: $!\n";
210 :     my $description = $self->{ description };
211 :     chomp $description;
212 :     print $fh "$description\n";
213 :     close( $fh );
214 :     chmod( 0777,$description_file );
215 :    
216 :     $self->update_curation_log();
217 :    
218 :     #
219 :     # Write out the piddly stuff.
220 :     #
221 :    
222 :     open($fh, ">$dir/EXCHANGABLE") or die "Cannot write $dir/EXCHANGABLE: $!\n";
223 :     print $fh "$self->{exchangable}\n";
224 :     close($fh);
225 :     chmod(0777,"EXCHANGABLE");
226 :    
227 :     #
228 :     # Process backup files. This is the smae process that determines when the
229 :     # version number should be bumped, so write the version file afterward.
230 :     #
231 :    
232 :     # $self->update_backups($force_backup);
233 : bartels 1.1 $self->make_backup();
234 : bartels 1.2
235 :     if ($self->{version} < 100) { $self->{version} += 100 }
236 :     open($fh, ">$dir/VERSION") or die "Cannot write $dir/VERSION: $!\n";
237 :     print $fh "$self->{version}\n";
238 :     close($fh);
239 :     chmod(0777,"VERSION");
240 : bartels 1.1 };
241 : bartels 1.2
242 : bartels 1.1 if ( $@ ne "" ) {
243 :     warn "Spreadsheet write failed, reverting to backup. Error was\n$@\n";
244 :     }
245 :     }
246 :    
247 :    
248 :     sub make_backup {
249 :     my($self) = @_;
250 :    
251 :     my $dir = $self->{dir};
252 :     my $bak = "$dir/Backup";
253 :    
254 :     $self->{fig}->verify_dir($bak);
255 :    
256 :     my $ts = time;
257 :    
258 :     rename("$dir/genomes~", "$bak/genomes.$ts");
259 :     rename("$dir/subsystems~", "$bak/subsystems.$ts");
260 :     rename("$dir/subsets~", "$bak/subsets.$ts");
261 :     rename("$dir/view~", "$bak/view.$ts");
262 :     $self->{version}++;
263 :     }
264 :    
265 :    
266 :    
267 :     sub load {
268 :    
269 :     my($self) = @_;
270 :    
271 :     #
272 :     # Load the subsystem.
273 :     #
274 :    
275 :     my $ssa;
276 :     my $genomes;
277 :     my $subsets;
278 :     my $view;
279 :     if ( !open( $ssa,"<$self->{dir}/subsystems" ) ) {
280 :     $self->{ empty_ss }++;
281 :     return;
282 :     }
283 :     if ( !open( $genomes,"<$self->{dir}/genomes" ) ) {
284 :     $self->{ empty_ss }++;
285 :     return;
286 :     }
287 :     if ( !open( $subsets,"<$self->{dir}/subsets" ) ) {
288 :     return;
289 :     }
290 :     if ( !open( $view,"<$self->{dir}/view" ) ) {
291 :     return;
292 :     }
293 :    
294 :     $self->load_subsystems( $ssa );
295 :     $self->load_genomes( $genomes );
296 :     $self->load_subsets( $subsets );
297 :     $self->load_view( $view );
298 : bartels 1.2 $self->load_description();
299 :     $self->load_version();
300 :     $self->load_curation();
301 : bartels 1.1
302 :     close $ssa;
303 :     close $genomes;
304 :     close $subsets;
305 :     close $view;
306 :    
307 :     return 1;
308 :     }
309 :    
310 :     sub load_subsystems {
311 :    
312 :     my ( $self, $ssa ) = @_;
313 :     my $fig = $self->{ fig };
314 :    
315 :     my $sshandles;
316 :    
317 :     while( my $ssname = <$ssa> ) {
318 :     chomp $ssname;
319 :     my $sshandle = new Subsystem( $ssname, $fig, 0 );
320 :    
321 :     $self->{ subsystems }->{ $ssname } = $sshandle;
322 :     }
323 :     return 1;
324 :     }
325 :    
326 :     sub load_genomes {
327 :     my ( $self, $genomes ) = @_;
328 :    
329 :     my @genomesarr;
330 :     while ( my $thisgenome = <$genomes> ) {
331 :     chomp $thisgenome;
332 :     push @genomesarr, $thisgenome;
333 :     }
334 :    
335 :     my %genomeshash = map { $_ => 1 } @genomesarr;
336 :    
337 :     $self->{ genomes } = \%genomeshash;
338 :     }
339 :    
340 :     sub load_subsets {
341 :     my ( $self, $subsets ) = @_;
342 :    
343 :     my $subsethash;
344 :     while ( my $thissubset = <$subsets> ) {
345 :     chomp $thissubset;
346 : bartels 1.2 my ( $ssname, $ssabb ) = split( "\t", $thissubset );
347 :     $subsethash->{ $ssname }->{ $ssabb } = 1;
348 : bartels 1.1 }
349 :    
350 :     $self->{ subsets } = $subsethash;
351 :     }
352 :    
353 :    
354 :     sub load_view {
355 :     my ( $self, $view ) = @_;
356 :    
357 :     my $viewhash;
358 :     while ( my $line = <$view> ) {
359 :     chomp $line;
360 :     my ( $what, $name, $third, $fourth ) = split( "\t", $line );
361 :     if ( $what eq 'Subset' ) {
362 :     $viewhash->{ 'Subsets' }->{ $name }->{ 'visible' } = $third;
363 :     $viewhash->{ 'Subsets' }->{ $name }->{ 'collapsed' } = $fourth;
364 :     }
365 :     elsif ( $what eq 'Role' ) {
366 :     $viewhash->{ 'Roles' }->{ $name }->{ 'visible' } = $fourth;
367 :     }
368 :     }
369 :     $self->{ view } = $viewhash;
370 :     }
371 :    
372 :     =head3 get_dir_from_name
373 :    
374 :     my $dirName = Subsystem::get_dir_from_name($name);
375 :    
376 :     Return the name of the directory containing the SEED data for the specified
377 :     subsystem.
378 :    
379 :     =over 4
380 :    
381 :     =item name
382 :    
383 :     Name of the subsystem whose directory is desired.
384 :    
385 :     =item RETURN
386 :    
387 :     Returns the fully-qualified directory name for the subsystem.
388 :    
389 :     =back
390 :    
391 :     =cut
392 :    
393 :     sub get_dir_from_name {
394 :     my ( $name ) = @_;
395 :    
396 :     my $b = $name;
397 :     $b =~ s/ /_/g;
398 :     my $dir = File::Spec->catfile($FIG_Config::data, 'MetaSubsystems', $b);
399 :     return $dir;
400 :     }
401 : bartels 1.2
402 :    
403 :     =head3 get_curator
404 :    
405 :     my $userName = $sub->get_curator();
406 :    
407 :     Return the name of this subsystem's official curator.
408 :    
409 :     =cut
410 :    
411 :     sub get_curator {
412 :     my ( $self ) = @_;
413 :     return $self->{ 'curator' };
414 :     }
415 :    
416 :    
417 :     sub get_created {
418 :     my( $self ) = @_;
419 :     return $self->{ 'created' };
420 :     }
421 :    
422 :     sub get_last_updated {
423 :     my ( $self ) = @_;
424 :     return $self->{ 'last_updated' };
425 :     }
426 :    
427 :     sub load_curation {
428 :     my ( $self ) = @_;
429 :    
430 :     if ( open( LOG, "<$self->{dir}/curation.log" ) ) {
431 :     my $last = 0;
432 :     while ( defined( $_ = <LOG> ) ) {
433 :     if ( /^(\d+)\t(\S+)\s+started/ ) {
434 :     my $tmpcurator = $2;
435 :     $self->{ 'created' } = $1;
436 :     if ( $tmpcurator =~ /master\:(.*)/ ) {
437 :     $self->{ 'curator' } = $1;
438 :     }
439 :     else {
440 :     $self->{ 'curator' } = $tmpcurator;
441 :     }
442 :     }
443 :     if ( ( /^(\d+)/ ) && ( $1 > $last ) ) {
444 :     $last = $1;
445 :     }
446 :     }
447 :     close( LOG );
448 :     if ($last) { $self->{last_updated} = $last; }
449 :     }
450 :     }
451 :    
452 :     sub load_version {
453 :     my ( $self ) = @_;
454 :    
455 :     my @l = &FIG::file_head(File::Spec->catfile($self->{dir}, "VERSION"), 1);
456 :     my $l = $l[0];
457 :     chomp $l;
458 :     $self->{version} = $l;
459 :     }
460 :    
461 :     sub load_description {
462 :     my ( $self ) = @_;
463 :    
464 :     if ( open( DESC, "<$self->{dir}/description" ) ) {
465 :     my $description;
466 :     while ( defined( $_ = <DESC> ) ) {
467 :     $description .= $_;
468 :     }
469 :     $self->{description} = $description;
470 :     }
471 :     }
472 :    
473 :     sub update_curation_log {
474 :     my( $self ) = @_;
475 :    
476 :     my $fh;
477 :     my $file = "$self->{dir}/curation.log";
478 :    
479 :     my $now = time;
480 :     my $user = $self->{fig}->get_user();
481 :    
482 :     if ( -f $file ) {
483 :     open( $fh, ">>$file" ) or die "Cannot open $file for writing: $!\n";
484 :     }
485 :     else {
486 :     open($fh, ">$file") or die "Cannot open $file for writing: $!\n";
487 :     print $fh "$now\t$user\tstarted\n";
488 :     }
489 :     print $fh "$now\t$user\tupdated\n";
490 :     close( $fh );
491 :     }
492 :    
493 :    
494 :     =head3 get_description
495 :    
496 :     my $text = $sub->get_description();
497 :    
498 :     Return the description for this subsystem.
499 :    
500 :     =cut
501 :    
502 :     sub get_description {
503 :     my( $self ) = @_;
504 :    
505 :     return $self->{description};
506 :     }
507 :    
508 :     sub set_description {
509 :     my ( $self, $desc ) = @_;
510 :    
511 :     $self->{description} = $desc;
512 :     }
513 :    
514 :     #
515 :     # Increment the subsystem's version number.
516 :     #
517 :     sub incr_version {
518 :     my ( $self ) = @_;
519 :    
520 :     my $dir = $self->{dir};
521 :     my $vfile = "$dir/VERSION";
522 :     my($ver);
523 :    
524 :     if ( open( my $fh,"<$vfile" ) ) {
525 :     if ( defined( $ver = <$fh> ) && ( $ver =~ /^(\S+)/ ) ) {
526 :     $ver = $1;
527 :     }
528 :     else {
529 :     $ver = 0;
530 :     }
531 :     close($fh);
532 :     }
533 :     else {
534 :     $ver = 0;
535 :     }
536 :    
537 :     $ver++;
538 :    
539 :     open( my $fh, ">$vfile" ) || die "could not open $vfile";
540 :     print $fh "$ver\n";
541 :     close($fh);
542 :    
543 :     chmod( 0777, $vfile );
544 :    
545 :     $self->load_version();
546 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3