[Bio] / SubsystemEditor / WebPage / ShowVariants.pm Repository:
ViewVC logotype

View of /SubsystemEditor/WebPage/ShowVariants.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (download) (as text) (annotate)
Fri Aug 31 20:39:34 2007 UTC (12 years, 5 months ago) by bartels
Branch: MAIN
first version

package SubsystemEditor::WebPage::ShowVariants;

use strict;
use warnings;
use URI::Escape;
use HTML;
use Data::Dumper;

use FIG;

use base qw( WebPage );

1;

##################################################
# Method for registering components etc. for the #
# application                                    #
##################################################
sub init {
  my ( $self ) = @_;

  $self->application->register_component(  'Table', 'ShowVariantsTable'  );
  $self->application->register_component(  'Table', 'FRTable'  );
}

sub require_javascript {

  return [ './Html/showfunctionalroles.js' ];

}

##############################################
# Website content is returned by this method #
##############################################
sub output {
  my ( $self ) = @_;

  my $can_alter = 1;
  
  my $fig = new FIG;
  my $cgi = $self->application->cgi;
  
  my $name = $cgi->param( 'subsystem' );
  my $ssname = $name;
  $ssname =~ s/\_/ /g;

  ######################
  # Construct the menu #
  ######################

  my $menu = $self->application->menu();

  # Build nice tab menu here
  $menu->add_category( 'Subsystem Info', "SubsysEditor.cgi?page=ShowSubsystem&subsystem=$name" );
  $menu->add_category( 'Functional Roles', "SubsysEditor.cgi?page=ShowFunctionalRoles&subsystem=$name" );
  $menu->add_category( 'Subsystem Diagram', "SubsysEditor.cgi?page=ShowDiagram&subsystem=$name" );
  $menu->add_category( 'Subsystem Spreadsheet', "SubsysEditor.cgi?page=ShowSpreadsheet&subsystem=$name" );
  $menu->add_category( 'Subsystem Tree', "SubsysEditor.cgi?page=ShowTree&subsystem=$name" );
 
  
  ##############################
  # Construct the page content #
  ##############################
  my $comment;
  my $error;

  my $content = "<H1>Variants for Subsystem:  $ssname</H1>";

  if ( !defined( $name ) ) {
    $content .= "<B>No subsystem given</B>";
    return $content;
  }

  my ( $datahash, $subsystem ) = get_data( $fig, $name );

  my $application = $self->application;

  if ( $cgi->param( 'set_variants' ) ) {
    $comment .= '<BR>';
    $comment .= set_variants( $cgi, $fig, $name, $subsystem, $application, $datahash );
    ( $datahash, $subsystem ) = get_data( $fig, $name );
  }

  $content .= show_variants( $self, $cgi, $fig, $name, $subsystem, $datahash );

  ###############################
  # Display errors and comments #
  ###############################
 
  if ( defined( $error ) && $error ne '' ) {
    $self->application->add_message( 'warning', $error );
  }
  if ( defined( $comment ) && $comment ne '' ) {
    $self->application->add_message( 'info', $comment );
  }

  return $content;
}

sub get_data {
  my ( $fig, $name ) = @_;

  my $datahash = {};

  my $subsystem = $fig->get_subsystem( $name );
  my @genomes        = $subsystem->get_genomes;
  my %variant_codes = map { $_ => $subsystem->get_variant_code( $subsystem->get_genome_index( $_ ) ) } @genomes;
  my @roles          = $subsystem->get_roles;

  $datahash->{ 'genomes' } = \@genomes;
  $datahash->{ 'varcodes' } = \%variant_codes;
  $datahash->{ 'roles' } = \@roles;  
  
  return ( $datahash, $subsystem );
}

sub show_variants {
  my ( $self, $cgi, $fig, $name, $sub, $datahash ) = @_;

  my $application = $self->application();

  my $cont = '';

  # get some datapoints #
  my @genomes        = @{ $datahash->{ 'genomes' } };
  my %variant_codes = %{ $datahash->{ 'varcodes' } };
  my @roles          = @{ $datahash->{ 'roles' } };
  
  my ( $abbrev, $frtable ) = format_roles( $application, $fig, $cgi, $sub );
  
  my( @has, $role, %has_filled );
  foreach my $genome ( @genomes ) {
    @has = ();
    foreach $role (@roles)
      {
	push(@has,($sub->get_pegs_from_cell($genome,$role) > 0) ? $abbrev->{$role} : ());
      }
    $has_filled{join(",",@has)}->{$variant_codes{$genome}}++;
  }
  
  my ( $col_hdrs, $tab, $pattern );
  $col_hdrs = [ { name => "Pattern" }, { name => "# Genomes with Pattern" },
		{ name => "Existing Variant Code" }, { name => "Set To" } ];
  $tab = [];
  foreach $pattern ( sort keys( %has_filled ) ) {

    my @codes = keys( %{ $has_filled{ $pattern } } );
    my $code;
    my $nrow = @codes;
    if ( @codes > 0 ) {
      $code = shift @codes;
      push( @$tab, [ $pattern,
		     $has_filled{$pattern}->{$code},
		     $code,
		     $cgi->textfield(-name => "p:$pattern:$code", -size => 5, -value => $code, -override => 1)
		   ]);
    }
    
    foreach $code ( @codes ) {
      
      push( @$tab,[ $has_filled{ $pattern }->{ $code },
		    $code,
		    $cgi->textfield(-name => "p:$pattern:$code", -size => 5, -value => $code, -override => 1)
		  ]);
    }
  }
  
  $cont .= $frtable;
  $cont .= $self->start_form();
  
  # create table from parsed data
  my $table = $application->component( 'ShowVariantsTable' );
  $table->columns( $col_hdrs );
  $table->data( $tab );
  $cont .= "<H2>Variant groups</H2>\n";
  $cont .= $application->component( 'ShowVariantsTable' )->output();
   
  $cont .= $cgi->hidden(-name => 'request', -value => 'set_variants', -override => 1);
  $cont .= $cgi->hidden(-name => 'subsystem', -value => $name, -override => 1);
  $cont .= $cgi->br;
  $cont .= $cgi->submit( -name => "set_variants", -value => "Set Variants" );
  $cont .= $self->end_form();
  
  return $cont;
}
	    

sub format_roles {
    my( $application, $fig, $cgi, $subsystem ) = @_;
    my( $i );

    my $col_hdrs = [ "Column", "Abbrev", "Functional Role" ];

    my $n = 1;
    my ( $tab, $abbrevP ) = format_existing_roles( $fig, $subsystem, \$n );

    # create table from parsed data
    my $table = $application->component( 'FRTable' );
    $table->columns( $col_hdrs );
    $table->data( $tab );

    my $formatted = '<H2>Functional Roles</H2>';
    $formatted .= $application->component( 'FRTable' )->output();

    $formatted .= "<BR><BR>";
    return ( $abbrevP, $formatted );
}

sub format_existing_roles {
    my ( $fig, $subsystem, $nP ) = @_;
    my $tab = [];
    my $abbrevP = {};

    foreach my $role ( $subsystem->get_roles ) {
      my $i = $subsystem->get_role_index( $role );
      my $abbrev = $role ? $subsystem->get_role_abbr( $i ) : "";
      $abbrevP->{ $role } = $abbrev;
      push( @$tab, [ $$nP, $abbrev, $role ] );
    }

    return ( $tab, $abbrevP );
}

sub set_variants {
    my ( $cgi, $fig, $subsys, $sub, $application, $datahash ) = @_;

    my @genomes        = @{ $datahash->{ 'genomes' } };
    my %variant_codes = %{ $datahash->{ 'varcodes' } };
    my @roles          = @{ $datahash->{ 'roles' } };

    my ( $abbrev, $frtable ) = format_roles( $application, $fig, $cgi, $sub );

    my ( %genomes_with );
    foreach my $genome ( @genomes ) {
      my $vc = $variant_codes{ $genome };
      
      my @has = ();
      foreach my $role ( @roles ) {
	push( @has, ( $sub->get_pegs_from_cell( $genome, $role ) > 0 ) ? $abbrev->{ $role } : () );
      }
      my $pattern = join( ",", @has );
      push( @{ $genomes_with{ "$pattern, $vc" } }, $genome );
    }

    my $comment = '';
    
    my @params = grep { $_ =~ /^p:/ } $cgi->param;
    foreach my $param (@params) {
      if ( $param =~ /^p:(.*):(.*)$/ ) {
	my ( $pattern, $vc ) = ( $1, $2 );
	$pattern =~ s/ //g;
	$vc      =~ s/ //g;
	my $to = $cgi->param( $param );

	if ( my $x = $genomes_with{ "$pattern, $vc" } ) {

	  foreach my $genome ( @$x ) {
	    if ( $to ne $variant_codes{ $genome } ) {
	      my $old = $variant_codes{$genome};
	      my $gs = $fig->genus_species($genome);
	      $comment .= "resetting $genome $gs from $old to $to<BR>\n";
	      $sub->set_variant_code( $sub->get_genome_index( $genome ), $to );
	    }
	  }

	}
      }
    }
    $sub->write_subsystem();

    return $comment;
}


MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3