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

View of /FigKernelPackages/MetaSubsystem.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (download) (as text) (annotate)
Tue Jul 1 14:40:46 2008 UTC (11 years, 5 months ago) by bartels
Branch: MAIN
CVS Tags: rast_rel_2008_07_21, mgrast_rel_2008_0806, rast_rel_2008_08_07
*** empty log message ***

#
# Copyright (c) 2003-2006 University of Chicago and Fellowship
# for Interpretations of Genomes. All Rights Reserved.
#
# This file is part of the SEED Toolkit.
#
# The SEED Toolkit is free software. You can redistribute
# it and/or modify it under the terms of the SEED Toolkit
# Public License.
#
# You should have received a copy of the SEED Toolkit Public License
# along with this program; if not write to the University of Chicago
# at info@ci.uchicago.edu or the Fellowship for Interpretation of
# Genomes at veronika@thefig.info or download a copy from
# http://www.theseed.org/LICENSE.TXT.
#

package MetaSubsystem;

#use Carp;

#use POSIX;
use DirHandle;
#use Data::Dumper;
#use File::Copy;
#use File::Spec;
#use IPC::Open2;
#use FileHandle;
#use Tracer;
use Subsystem;
use strict;

1;

sub new {
    
    my ( $class, $name, $fig, $create, $subsystems, $genomes, $subsets, $view ) = @_;

    my $msadir = get_dir_from_name( $name );
    

    # RAE: Please do this:
    $name =~ s/^\s+//; $name =~ s/\s+$//;
    $name =~ s/ /_/g;

    my $self = {
		dir => $msadir,
		name => $name,
		fig => $fig,
	       };

    bless($self, $class);

    #
    # Check to see if the database we're running against has a variant column.
    #
#    $self->detect_db_version();

    if ($create)
    {
        $self->create_metasubsystem( $subsystems, $genomes, $subsets, $view );
    }
    else
    {
        $self->load();
    }

    return $self;
}


=head3 create_metasubsystem

Create a new subsystem. This creates the subsystem directory in the
correct place ($FIG_Config::data/Subsystems), and populates it with
the correct initial data.

=cut

sub create_metasubsystem {
  my( $self, $subsystems, $genomes, $subsets, $view ) = @_;

  my $dir = $self->{dir};
  my $fig = $self->{fig};

  $self->{ genomes } = $genomes;
  $self->{ subsystems } = $subsystems;
  $self->{ subsets } = $subsets;
  $self->{ view } = $view;
  
  if (-d $dir)  {
    warn "Not creating: MetaSubsystem directory $dir already exists";
    return;
  }

  $fig->verify_dir($dir);
  
  $self->write_metasubsystem();
}

sub write_metasubsystem {
  my( $self, $force_backup ) = @_;

  my $dir = $self->{dir};
  my $fig = $self->{fig};
  
  #
  # We first move the existing spreadsheet and notes files (if present)
  # to spreadsheet~ and notes~, and current state.
  #
  
  my $genomes_file = "$dir/genomes";
  my $genomes_bak = "$dir/genomes~";
  my $subsystems_file = "$dir/subsystems";
  my $subsystems_bak = "$dir/subsystems~";
  my $subsets_file = "$dir/subsets";
  my $subsets_bak = "$dir/subsets~";
  my $view_file = "$dir/view";
  my $view_bak = "$dir/view~";

  if ( -f $genomes_file ) {
    rename( $genomes_file, $genomes_bak);
  }
  if ( -f $subsystems_file ) {
    rename( $subsystems_file, $subsystems_bak);
  }
  if ( -f $subsets_file ) {
    rename( $subsets_file, $subsets_bak);
  }
  if ( -f $view_file ) {
    rename( $view_file, $view_bak);
  }

  eval {
    my $fh;
    
    open( $fh, ">$genomes_file" ) or die "Cannot open $genomes_file for writing: $!\n";
    my $genomes = $self->{ genomes };
    foreach $_ ( keys %$genomes )  {
      print $fh "$_\n";
    }
    close( $fh );
    chmod( 0777,$genomes_file );
    
    open( $fh, ">$subsets_file" ) or die "Cannot open $subsets_file for writing: $!\n";
    my $subsets = $self->{ subsets };
    foreach my $ss ( keys %$subsets )  {
      foreach my $sub ( keys %{ $subsets->{ $ss } } ) {
	chomp $sub;
	print $fh "$ss\t$sub\t";
	my $subsystem_subset = $subsets->{ $ss }->{ $sub };
	print $fh $subsystem_subset."\n";
      }
    }
    close( $fh );
    chmod( 0777,$subsystems_file );
    
    open( $fh, ">$subsystems_file" ) or die "Cannot open $subsystems_file for writing: $!\n";
    my $subsystems = $self->{ subsystems };
    foreach my $sst ( keys %$subsystems )  {
      chomp $sst;
      print $fh "$sst\n";
    }
    close( $fh );
    chmod( 0777,$subsystems_file );
    
    open( $fh, ">$view_file" ) or die "Cannot open $view_file for writing: $!\n";
    my $view = $self->{ view };
    my %subsets_view = %{ $view->{ 'Subsets' } };
    foreach my $ssname ( keys %subsets_view )  {
      my $visible = $subsets_view{ $ssname }->{ 'visible' };
      $visible = 0 if ( !defined( $visible ) );
      my $collapsed = $subsets_view{ $ssname }->{ 'collapsed' };
      $collapsed = 0 if ( !defined( $collapsed ) );
      print $fh "Subset\t$ssname\t$visible\t$collapsed\n";
    }
    if ( defined( $view->{ 'Roles' } ) ) {
      %subsets_view = %{ $view->{ 'Roles' } };
      foreach my $ssname ( keys %subsets_view )  {
	my $visible = $subsets_view{ $ssname }->{ 'visible' };
	$visible = 0 if ( !defined( $visible ) );

	if ( $ssname =~ /(.*)##-##(.*)/ ) {
	  my $role = $1;
	  my $subsystem = $2;
	  $subsystem = 0 if ( !defined( $subsystem ) );
	  print $fh "Role\t$ssname\t$subsystem\t$visible\n";
	}
      }
    }
    close( $fh );
    chmod( 0777,$subsystems_file );

    $self->make_backup();
  };

  if ( $@ ne "" ) {
    warn "Spreadsheet write failed, reverting to backup. Error was\n$@\n";
  }
}


sub make_backup {
    my($self) = @_;

    my $dir = $self->{dir};
    my $bak = "$dir/Backup";

    $self->{fig}->verify_dir($bak);

    my $ts = time;

    rename("$dir/genomes~", "$bak/genomes.$ts");
    rename("$dir/subsystems~", "$bak/subsystems.$ts");
    rename("$dir/subsets~", "$bak/subsets.$ts");
    rename("$dir/view~", "$bak/view.$ts");
    $self->{version}++;
}



sub load {

    my($self) = @_;

    #
    # Load the subsystem.
    #

    my $ssa;
    my $genomes;
    my $subsets;
    my $view; 
    if  ( !open( $ssa,"<$self->{dir}/subsystems" ) ) {
      $self->{ empty_ss }++;
      return;
    }
    if  ( !open( $genomes,"<$self->{dir}/genomes" ) ) {
      $self->{ empty_ss }++;
      return;
    }
    if  ( !open( $subsets,"<$self->{dir}/subsets" ) ) {
      return;
    }
    if  ( !open( $view,"<$self->{dir}/view" ) ) {
      return;
    }

    $self->load_subsystems( $ssa );
    $self->load_genomes( $genomes );
    $self->load_subsets( $subsets );
    $self->load_view( $view );

    close $ssa;
    close $genomes;
    close $subsets;
    close $view;

    return 1;
}

sub load_subsystems {

  my ( $self, $ssa ) = @_;
  my $fig = $self->{ fig };

  my $sshandles;
  
  while( my $ssname = <$ssa> ) {
    chomp $ssname;
    my $sshandle = new Subsystem( $ssname, $fig, 0 );

    $self->{ subsystems }->{ $ssname } = $sshandle;
  }
  return 1;
}

sub load_genomes {
  my ( $self, $genomes ) = @_;
  
  my @genomesarr;
  while ( my $thisgenome = <$genomes> ) {
    chomp $thisgenome;
    push @genomesarr, $thisgenome;
  }
  
  my %genomeshash = map { $_ => 1 } @genomesarr;

  $self->{ genomes } = \%genomeshash;
}

sub load_subsets {
  my ( $self, $subsets ) = @_;
  
  my $subsethash;
  while ( my $thissubset = <$subsets> ) {
    chomp $thissubset;
    my ( $ssname, $ssabb, $ssss ) = split( "\t", $thissubset );
    $subsethash->{ $ssname }->{ $ssabb } = $ssss;
  }

  $self->{ subsets } = $subsethash;
}


sub load_view {
  my ( $self, $view ) = @_;
  
  my $viewhash;
  while ( my $line = <$view> ) {
    chomp $line;
    my ( $what, $name, $third, $fourth ) = split( "\t", $line );
    if ( $what eq 'Subset' ) {
      $viewhash->{ 'Subsets' }->{ $name }->{ 'visible' } = $third;
      $viewhash->{ 'Subsets' }->{ $name }->{ 'collapsed' } = $fourth;
    }
    elsif ( $what eq 'Role' ) {
      $viewhash->{ 'Roles' }->{ $name }->{ 'visible' } = $fourth;
    }
  }
  $self->{ view } = $viewhash;
}

=head3 get_dir_from_name

    my $dirName = Subsystem::get_dir_from_name($name);

Return the name of the directory containing the SEED data for the specified
subsystem.

=over 4

=item name

Name of the subsystem whose directory is desired.

=item RETURN

Returns the fully-qualified directory name for the subsystem.

=back

=cut

sub get_dir_from_name {
  my ( $name ) = @_;
  
  my $b = $name;
  $b =~ s/ /_/g;
  my $dir = File::Spec->catfile($FIG_Config::data, 'MetaSubsystems', $b);
  return $dir;
}

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3