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

Annotation of /FigKernelPackages/MetaSubsystem.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (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 :     my ( $class, $name, $fig, $create, $subsystems, $genomes, $subsets, $view ) = @_;
38 :    
39 :     my $msadir = get_dir_from_name( $name );
40 :    
41 :    
42 :     # RAE: Please do this:
43 :     $name =~ s/^\s+//; $name =~ s/\s+$//;
44 :     $name =~ s/ /_/g;
45 :    
46 :     my $self = {
47 :     dir => $msadir,
48 :     name => $name,
49 :     fig => $fig,
50 :     };
51 :    
52 :     bless($self, $class);
53 :    
54 :     #
55 :     # Check to see if the database we're running against has a variant column.
56 :     #
57 :     # $self->detect_db_version();
58 :    
59 :     if ($create)
60 :     {
61 :     $self->create_metasubsystem( $subsystems, $genomes, $subsets, $view );
62 :     }
63 :     else
64 :     {
65 :     $self->load();
66 :     }
67 :    
68 :     return $self;
69 :     }
70 :    
71 :    
72 :     =head3 create_metasubsystem
73 :    
74 :     Create a new subsystem. This creates the subsystem directory in the
75 :     correct place ($FIG_Config::data/Subsystems), and populates it with
76 :     the correct initial data.
77 :    
78 :     =cut
79 :    
80 :     sub create_metasubsystem {
81 :     my( $self, $subsystems, $genomes, $subsets, $view ) = @_;
82 :    
83 :     my $dir = $self->{dir};
84 :     my $fig = $self->{fig};
85 :    
86 :     $self->{ genomes } = $genomes;
87 :     $self->{ subsystems } = $subsystems;
88 :     $self->{ subsets } = $subsets;
89 :     $self->{ view } = $view;
90 :    
91 :     if (-d $dir) {
92 :     warn "Not creating: MetaSubsystem directory $dir already exists";
93 :     return;
94 :     }
95 :    
96 :     $fig->verify_dir($dir);
97 :    
98 :     $self->write_metasubsystem();
99 :     }
100 :    
101 :     sub write_metasubsystem {
102 :     my( $self, $force_backup ) = @_;
103 :    
104 :     my $dir = $self->{dir};
105 :     my $fig = $self->{fig};
106 :    
107 :     #
108 :     # We first move the existing spreadsheet and notes files (if present)
109 :     # to spreadsheet~ and notes~, and current state.
110 :     #
111 :    
112 :     my $genomes_file = "$dir/genomes";
113 :     my $genomes_bak = "$dir/genomes~";
114 :     my $subsystems_file = "$dir/subsystems";
115 :     my $subsystems_bak = "$dir/subsystems~";
116 :     my $subsets_file = "$dir/subsets";
117 :     my $subsets_bak = "$dir/subsets~";
118 :     my $view_file = "$dir/view";
119 :     my $view_bak = "$dir/view~";
120 :    
121 :     if ( -f $genomes_file ) {
122 :     rename( $genomes_file, $genomes_bak);
123 :     }
124 :     if ( -f $subsystems_file ) {
125 :     rename( $subsystems_file, $subsystems_bak);
126 :     }
127 :     if ( -f $subsets_file ) {
128 :     rename( $subsets_file, $subsets_bak);
129 :     }
130 :     if ( -f $view_file ) {
131 :     rename( $view_file, $view_bak);
132 :     }
133 :    
134 :     eval {
135 :     my $fh;
136 :    
137 :     open( $fh, ">$genomes_file" ) or die "Cannot open $genomes_file for writing: $!\n";
138 :     my $genomes = $self->{ genomes };
139 :     foreach $_ ( keys %$genomes ) {
140 :     print $fh "$_\n";
141 :     }
142 :     close( $fh );
143 :     chmod( 0777,$genomes_file );
144 :    
145 :     open( $fh, ">$subsets_file" ) or die "Cannot open $subsets_file for writing: $!\n";
146 :     my $subsets = $self->{ subsets };
147 :     foreach my $ss ( keys %$subsets ) {
148 :     foreach my $sub ( keys %{ $subsets->{ $ss } } ) {
149 :     chomp $sub;
150 :     print $fh "$ss\t$sub\t";
151 :     my $subsystem_subset = $subsets->{ $ss }->{ $sub };
152 :     print $fh $subsystem_subset."\n";
153 :     }
154 :     }
155 :     close( $fh );
156 :     chmod( 0777,$subsystems_file );
157 :    
158 :     open( $fh, ">$subsystems_file" ) or die "Cannot open $subsystems_file for writing: $!\n";
159 :     my $subsystems = $self->{ subsystems };
160 :     foreach my $sst ( keys %$subsystems ) {
161 :     chomp $sst;
162 :     print $fh "$sst\n";
163 :     }
164 :     close( $fh );
165 :     chmod( 0777,$subsystems_file );
166 :    
167 :     open( $fh, ">$view_file" ) or die "Cannot open $view_file for writing: $!\n";
168 :     my $view = $self->{ view };
169 :     my %subsets_view = %{ $view->{ 'Subsets' } };
170 :     foreach my $ssname ( keys %subsets_view ) {
171 :     my $visible = $subsets_view{ $ssname }->{ 'visible' };
172 :     $visible = 0 if ( !defined( $visible ) );
173 :     my $collapsed = $subsets_view{ $ssname }->{ 'collapsed' };
174 :     $collapsed = 0 if ( !defined( $collapsed ) );
175 :     print $fh "Subset\t$ssname\t$visible\t$collapsed\n";
176 :     }
177 :     if ( defined( $view->{ 'Roles' } ) ) {
178 :     %subsets_view = %{ $view->{ 'Roles' } };
179 :     foreach my $ssname ( keys %subsets_view ) {
180 :     my $visible = $subsets_view{ $ssname }->{ 'visible' };
181 :     $visible = 0 if ( !defined( $visible ) );
182 :    
183 :     if ( $ssname =~ /(.*)##-##(.*)/ ) {
184 :     my $role = $1;
185 :     my $subsystem = $2;
186 :     $subsystem = 0 if ( !defined( $subsystem ) );
187 :     print $fh "Role\t$ssname\t$subsystem\t$visible\n";
188 :     }
189 :     }
190 :     }
191 :     close( $fh );
192 :     chmod( 0777,$subsystems_file );
193 :    
194 :     $self->make_backup();
195 :     };
196 :    
197 :     if ( $@ ne "" ) {
198 :     warn "Spreadsheet write failed, reverting to backup. Error was\n$@\n";
199 :     }
200 :     }
201 :    
202 :    
203 :     sub make_backup {
204 :     my($self) = @_;
205 :    
206 :     my $dir = $self->{dir};
207 :     my $bak = "$dir/Backup";
208 :    
209 :     $self->{fig}->verify_dir($bak);
210 :    
211 :     my $ts = time;
212 :    
213 :     rename("$dir/genomes~", "$bak/genomes.$ts");
214 :     rename("$dir/subsystems~", "$bak/subsystems.$ts");
215 :     rename("$dir/subsets~", "$bak/subsets.$ts");
216 :     rename("$dir/view~", "$bak/view.$ts");
217 :     $self->{version}++;
218 :     }
219 :    
220 :    
221 :    
222 :     sub load {
223 :    
224 :     my($self) = @_;
225 :    
226 :     #
227 :     # Load the subsystem.
228 :     #
229 :    
230 :     my $ssa;
231 :     my $genomes;
232 :     my $subsets;
233 :     my $view;
234 :     if ( !open( $ssa,"<$self->{dir}/subsystems" ) ) {
235 :     $self->{ empty_ss }++;
236 :     return;
237 :     }
238 :     if ( !open( $genomes,"<$self->{dir}/genomes" ) ) {
239 :     $self->{ empty_ss }++;
240 :     return;
241 :     }
242 :     if ( !open( $subsets,"<$self->{dir}/subsets" ) ) {
243 :     return;
244 :     }
245 :     if ( !open( $view,"<$self->{dir}/view" ) ) {
246 :     return;
247 :     }
248 :    
249 :     $self->load_subsystems( $ssa );
250 :     $self->load_genomes( $genomes );
251 :     $self->load_subsets( $subsets );
252 :     $self->load_view( $view );
253 :    
254 :     close $ssa;
255 :     close $genomes;
256 :     close $subsets;
257 :     close $view;
258 :    
259 :     return 1;
260 :     }
261 :    
262 :     sub load_subsystems {
263 :    
264 :     my ( $self, $ssa ) = @_;
265 :     my $fig = $self->{ fig };
266 :    
267 :     my $sshandles;
268 :    
269 :     while( my $ssname = <$ssa> ) {
270 :     chomp $ssname;
271 :     my $sshandle = new Subsystem( $ssname, $fig, 0 );
272 :    
273 :     $self->{ subsystems }->{ $ssname } = $sshandle;
274 :     }
275 :     return 1;
276 :     }
277 :    
278 :     sub load_genomes {
279 :     my ( $self, $genomes ) = @_;
280 :    
281 :     my @genomesarr;
282 :     while ( my $thisgenome = <$genomes> ) {
283 :     chomp $thisgenome;
284 :     push @genomesarr, $thisgenome;
285 :     }
286 :    
287 :     my %genomeshash = map { $_ => 1 } @genomesarr;
288 :    
289 :     $self->{ genomes } = \%genomeshash;
290 :     }
291 :    
292 :     sub load_subsets {
293 :     my ( $self, $subsets ) = @_;
294 :    
295 :     my $subsethash;
296 :     while ( my $thissubset = <$subsets> ) {
297 :     chomp $thissubset;
298 :     my ( $ssname, $ssabb, $ssss ) = split( "\t", $thissubset );
299 :     $subsethash->{ $ssname }->{ $ssabb } = $ssss;
300 :     }
301 :    
302 :     $self->{ subsets } = $subsethash;
303 :     }
304 :    
305 :    
306 :     sub load_view {
307 :     my ( $self, $view ) = @_;
308 :    
309 :     my $viewhash;
310 :     while ( my $line = <$view> ) {
311 :     chomp $line;
312 :     my ( $what, $name, $third, $fourth ) = split( "\t", $line );
313 :     if ( $what eq 'Subset' ) {
314 :     $viewhash->{ 'Subsets' }->{ $name }->{ 'visible' } = $third;
315 :     $viewhash->{ 'Subsets' }->{ $name }->{ 'collapsed' } = $fourth;
316 :     }
317 :     elsif ( $what eq 'Role' ) {
318 :     $viewhash->{ 'Roles' }->{ $name }->{ 'visible' } = $fourth;
319 :     }
320 :     }
321 :     $self->{ view } = $viewhash;
322 :     }
323 :    
324 :     =head3 get_dir_from_name
325 :    
326 :     my $dirName = Subsystem::get_dir_from_name($name);
327 :    
328 :     Return the name of the directory containing the SEED data for the specified
329 :     subsystem.
330 :    
331 :     =over 4
332 :    
333 :     =item name
334 :    
335 :     Name of the subsystem whose directory is desired.
336 :    
337 :     =item RETURN
338 :    
339 :     Returns the fully-qualified directory name for the subsystem.
340 :    
341 :     =back
342 :    
343 :     =cut
344 :    
345 :     sub get_dir_from_name {
346 :     my ( $name ) = @_;
347 :    
348 :     my $b = $name;
349 :     $b =~ s/ /_/g;
350 :     my $dir = File::Spec->catfile($FIG_Config::data, 'MetaSubsystems', $b);
351 :     return $dir;
352 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3