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

Diff of /FigKernelPackages/MetaSubsystem.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1, Tue Jul 1 14:40:46 2008 UTC revision 1.2, Sat Aug 30 10:04:38 2008 UTC
# Line 34  Line 34 
34    
35  sub new {  sub new {
36    
37      my ( $class, $name, $fig, $create, $subsystems, $genomes, $subsets, $view ) = @_;      my ( $class, $name, $fig, $create, $subsystems, $genomes, $subsets, $view, $description ) = @_;
38    
39      my $msadir = get_dir_from_name( $name );      my $msadir = get_dir_from_name( $name );
40    
41    
42        if ( ! -d $msadir and not $create )    {
43          return undef;
44        }
45    
46      # RAE: Please do this:      # RAE: Please do this:
47      $name =~ s/^\s+//; $name =~ s/\s+$//;      $name =~ s/^\s+//; $name =~ s/\s+$//;
48      $name =~ s/ /_/g;      $name =~ s/ /_/g;
# Line 58  Line 62 
62    
63      if ($create)      if ($create)
64      {      {
65          $self->create_metasubsystem( $subsystems, $genomes, $subsets, $view );          my $succ = $self->create_metasubsystem( $subsystems, $genomes, $subsets, $view, $description );
66            if ( $succ eq -1 ) {
67              return -1;
68            }
69      }      }
70      else      else
71      {      {
# Line 78  Line 85 
85  =cut  =cut
86    
87  sub create_metasubsystem {  sub create_metasubsystem {
88    my( $self, $subsystems, $genomes, $subsets, $view ) = @_;    my( $self, $subsystems, $genomes, $subsets, $view, $description ) = @_;
89    
90    my $dir = $self->{dir};    my $dir = $self->{dir};
91    my $fig = $self->{fig};    my $fig = $self->{fig};
# Line 87  Line 94 
94    $self->{ subsystems } = $subsystems;    $self->{ subsystems } = $subsystems;
95    $self->{ subsets } = $subsets;    $self->{ subsets } = $subsets;
96    $self->{ view } = $view;    $self->{ view } = $view;
97      $self->{ description } = $description;
98    
99    if (-d $dir)  {    if (-d $dir)  {
100      warn "Not creating: MetaSubsystem directory $dir already exists";      warn "Not creating: MetaSubsystem directory $dir already exists";
101      return;      return -1;
102    }    }
103    
104    $fig->verify_dir($dir);    $fig->verify_dir($dir);
# Line 117  Line 125 
125    my $subsets_bak = "$dir/subsets~";    my $subsets_bak = "$dir/subsets~";
126    my $view_file = "$dir/view";    my $view_file = "$dir/view";
127    my $view_bak = "$dir/view~";    my $view_bak = "$dir/view~";
128      my $description_file = "$dir/description";
129      my $description_bak = "$dir/description~";
130    
131    if ( -f $genomes_file ) {    if ( -f $genomes_file ) {
132      rename( $genomes_file, $genomes_bak);      rename( $genomes_file, $genomes_bak);
# Line 130  Line 140 
140    if ( -f $view_file ) {    if ( -f $view_file ) {
141      rename( $view_file, $view_bak);      rename( $view_file, $view_bak);
142    }    }
143      if ( -f $description_file ) {
144        rename( $description_file, $description_bak);
145      }
146    
147    eval {    eval {
148      my $fh;      my $fh;
# Line 144  Line 157 
157    
158      open( $fh, ">$subsets_file" ) or die "Cannot open $subsets_file for writing: $!\n";      open( $fh, ">$subsets_file" ) or die "Cannot open $subsets_file for writing: $!\n";
159      my $subsets = $self->{ subsets };      my $subsets = $self->{ subsets };
160        if ( defined( $subsets ) ) {
161      foreach my $ss ( keys %$subsets )  {      foreach my $ss ( keys %$subsets )  {
162        foreach my $sub ( keys %{ $subsets->{ $ss } } ) {        foreach my $sub ( keys %{ $subsets->{ $ss } } ) {
163          chomp $sub;          chomp $sub;
164          print $fh "$ss\t$sub\t";            print $fh "$ss\t$sub\n";
165          my $subsystem_subset = $subsets->{ $ss }->{ $sub };          }
         print $fh $subsystem_subset."\n";  
166        }        }
167      }      }
168      close( $fh );      close( $fh );
# Line 166  Line 179 
179    
180      open( $fh, ">$view_file" ) or die "Cannot open $view_file for writing: $!\n";      open( $fh, ">$view_file" ) or die "Cannot open $view_file for writing: $!\n";
181      my $view = $self->{ view };      my $view = $self->{ view };
182        if ( defined( $view ) ) {
183      my %subsets_view = %{ $view->{ 'Subsets' } };      my %subsets_view = %{ $view->{ 'Subsets' } };
184      foreach my $ssname ( keys %subsets_view )  {      foreach my $ssname ( keys %subsets_view )  {
185        my $visible = $subsets_view{ $ssname }->{ 'visible' };        my $visible = $subsets_view{ $ssname }->{ 'visible' };
# Line 188  Line 202 
202          }          }
203        }        }
204      }      }
205        }
206      close( $fh );      close( $fh );
207      chmod( 0777,$subsystems_file );      chmod( 0777,$subsystems_file );
208    
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      $self->make_backup();      $self->make_backup();
234    
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    };    };
241    
242    if ( $@ ne "" ) {    if ( $@ ne "" ) {
# Line 250  Line 295 
295      $self->load_genomes( $genomes );      $self->load_genomes( $genomes );
296      $self->load_subsets( $subsets );      $self->load_subsets( $subsets );
297      $self->load_view( $view );      $self->load_view( $view );
298        $self->load_description();
299        $self->load_version();
300        $self->load_curation();
301    
302      close $ssa;      close $ssa;
303      close $genomes;      close $genomes;
# Line 295  Line 343 
343    my $subsethash;    my $subsethash;
344    while ( my $thissubset = <$subsets> ) {    while ( my $thissubset = <$subsets> ) {
345      chomp $thissubset;      chomp $thissubset;
346      my ( $ssname, $ssabb, $ssss ) = split( "\t", $thissubset );      my ( $ssname, $ssabb ) = split( "\t", $thissubset );
347      $subsethash->{ $ssname }->{ $ssabb } = $ssss;      $subsethash->{ $ssname }->{ $ssabb } = 1;
348    }    }
349    
350    $self->{ subsets } = $subsethash;    $self->{ subsets } = $subsethash;
# Line 350  Line 398 
398    my $dir = File::Spec->catfile($FIG_Config::data, 'MetaSubsystems', $b);    my $dir = File::Spec->catfile($FIG_Config::data, 'MetaSubsystems', $b);
399    return $dir;    return $dir;
400  }  }
401    
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    }

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3