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

Diff of /SubsystemEditor/WebPage/ShowVariants.pm

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

revision 1.2, Fri Aug 31 20:43:46 2007 UTC revision 1.7, Mon May 5 20:06:46 2008 UTC
# Line 21  Line 21 
21    
22    $self->application->register_component(  'Table', 'ShowVariantsTable'  );    $self->application->register_component(  'Table', 'ShowVariantsTable'  );
23    $self->application->register_component(  'Table', 'FRTable'  );    $self->application->register_component(  'Table', 'FRTable'  );
24      $self->application->register_component(  'Table', 'VarDescTable'  );
25  }  }
26    
27  sub require_javascript {  sub require_javascript {
# Line 35  Line 36 
36  sub output {  sub output {
37    my ( $self ) = @_;    my ( $self ) = @_;
38    
39    my $can_alter = 1;    my $can_alter = 0;
40      my $user = $self->application->session->user;
41    
42    my $fig = new FIG;    my $fig = new FIG;
43    my $cgi = $self->application->cgi;    my $cgi = $self->application->cgi;
# Line 44  Line 46 
46    my $ssname = $name;    my $ssname = $name;
47    $ssname =~ s/\_/ /g;    $ssname =~ s/\_/ /g;
48    
49      my $esc_name = uri_escape($name);
50    
51      my $dbmaster = DBMaster->new( -database => 'WebAppBackend' );
52      my $ppoapplication = $dbmaster->Backend->init( { name => 'SubsystemEditor' } );
53    
54      # get a seeduser #
55      my $seeduser = '';
56      if ( defined( $user ) && ref( $user ) ) {
57        my $preferences = $dbmaster->Preferences->get_objects( { user => $user,
58                                                                 name => 'SeedUser',
59                                                                 application => $ppoapplication } );
60        if ( defined( $preferences->[0] ) ) {
61          $seeduser = $preferences->[0]->value();
62        }
63      }
64    
65      if ( $user && $user->has_right( $self->application, 'edit', 'subsystem', $name ) ) {
66        $can_alter = 1;
67        $fig->set_user( $seeduser );
68      }
69    
70    ######################    ######################
71    # Construct the menu #    # Construct the menu #
72    ######################    ######################
# Line 51  Line 74 
74    my $menu = $self->application->menu();    my $menu = $self->application->menu();
75    
76    # Build nice tab menu here    # Build nice tab menu here
77    $menu->add_category( 'Subsystem Info', "SubsysEditor.cgi?page=ShowSubsystem&subsystem=$name" );    $menu->add_category( 'Subsystem Info', "SubsysEditor.cgi?page=ShowSubsystem&subsystem=$esc_name" );
78    $menu->add_category( 'Functional Roles', "SubsysEditor.cgi?page=ShowFunctionalRoles&subsystem=$name" );    $menu->add_category( 'Functional Roles', "SubsysEditor.cgi?page=ShowFunctionalRoles&subsystem=$esc_name" );
79    $menu->add_category( 'Subsystem Diagram', "SubsysEditor.cgi?page=ShowDiagram&subsystem=$name" );    $menu->add_category( 'Diagram', "SubsysEditor.cgi?page=ShowDiagram&subsystem=$esc_name" );
80    $menu->add_category( 'Subsystem Spreadsheet', "SubsysEditor.cgi?page=ShowSpreadsheet&subsystem=$name" );    $menu->add_category( 'Illustrations', "SubsysEditor.cgi?page=ShowIllustrations&subsystem=$esc_name" );
81    $menu->add_category( 'Subsystem Check', "SubsysEditor.cgi?page=ShowCheck&subsystem=$name" );    $menu->add_category( 'Spreadsheet', "SubsysEditor.cgi?page=ShowSpreadsheet&subsystem=$esc_name" );
82    $menu->add_category( 'Subsystem Tree', "SubsysEditor.cgi?page=ShowTree&subsystem=$name" );    $menu->add_category( 'Show Check', "SubsysEditor.cgi?page=ShowCheck&subsystem=$esc_name" );
83      $menu->add_category( 'Show Connections', "SubsysEditor.cgi?page=ShowTree&subsystem=$esc_name" );
84    
85    
86    ##############################    ##############################
# Line 72  Line 96 
96      return $content;      return $content;
97    }    }
98    
99    my ( $datahash, $subsystem ) = get_data( $fig, $name );    my $subsystem = $fig->get_subsystem( $name );
100    
101      my $datahash = get_data( $fig, $subsystem );
102    
103    my $application = $self->application;    my $application = $self->application;
104    
105    if ( $cgi->param( 'set_variants' ) ) {    if ( $cgi->param( 'set_variants' ) ) {
106      $comment .= '<BR>';      $comment .= '<BR>';
107      $comment .= set_variants( $cgi, $fig, $name, $subsystem, $application, $datahash );      $comment .= set_variants( $cgi, $fig, $name, $subsystem, $application, $datahash );
108      ( $datahash, $subsystem ) = get_data( $fig, $name );      $datahash = get_data( $fig, $subsystem );
109    }    }
110      elsif ( $cgi->param( 'addsave_variants' ) ) {
111        my @varcodes = $cgi->param( 'VARIANT' );
112        my @vardescs = $cgi->param( 'VARIANTDESC' );
113        my %varhash;
114    
115        for ( my $i = 0; $i < scalar( @varcodes ); $i++ ) {
116    
117    $content .= show_variants( $self, $cgi, $fig, $name, $subsystem, $datahash );        if ( $varcodes[$i] eq '' ) {
118            if ( $vardescs[$i] ne '' ) {
119              $comment .= "No Variant Code given for description ".$vardescs[$i].", so this variant could not be saved.<BR>\n";
120            }
121            next;
122          }
123          if ( defined( $varhash{ $varcodes[$i] } ) ) {
124            $comment .= "Variant ".$varcodes[$i]." already has the description ".$varhash{ $varcodes[$i] }.", so description ".$vardescs[$i]." was ignored.<BR>\n";
125            next;
126          }
127    
128          $varhash{ $varcodes[$i] } = $vardescs[$i];
129        }
130        my $newvarcode = $cgi->param( 'NEWVARIANT' );
131        my $newvardesc = $cgi->param( 'NEWVARIANTDESC' );
132        if ( defined( $newvarcode ) && $newvarcode ne '' && defined( $newvardesc ) && $newvardesc ne '' ) {
133          if ( $newvarcode eq '' ) {
134            if ( $newvarcode ne '' ) {
135              $comment .= "No Variant Code given for description $newvardesc, so this variant could not be saved.<BR>\n";
136            }
137          }
138          elsif ( defined( $varhash{ $newvarcode } ) ) {
139            $comment .= "Variant $newvarcode already has the description $newvardesc, so description $newvardesc was ignored.<BR>\n";
140          }
141          else {
142            $varhash{ $newvarcode } = $newvardesc;
143          }
144        }
145    
146        $subsystem->set_variants( \%varhash );
147        $subsystem->incr_version();
148        $subsystem->db_sync();
149        $subsystem->write_subsystem();
150      }
151    
152      $content .= show_variants( $self, $cgi, $fig, $name, $subsystem, $can_alter, $datahash );
153    
154    ###############################    ###############################
155    # Display errors and comments #    # Display errors and comments #
# Line 94  Line 161 
161    if ( defined( $comment ) && $comment ne '' ) {    if ( defined( $comment ) && $comment ne '' ) {
162      $self->application->add_message( 'info', $comment );      $self->application->add_message( 'info', $comment );
163    }    }
   
164    return $content;    return $content;
165  }  }
166    
# Line 102  Line 168 
168  # data method #  # data method #
169  ###############  ###############
170  sub get_data {  sub get_data {
171    my ( $fig, $name ) = @_;    my ( $fig, $subsystem ) = @_;
172    
173    my $datahash = {};    my $datahash = {};
174    
   my $subsystem = $fig->get_subsystem( $name );  
175    my @genomes        = $subsystem->get_genomes;    my @genomes        = $subsystem->get_genomes;
176    my %variant_codes = map { $_ => $subsystem->get_variant_code( $subsystem->get_genome_index( $_ ) ) } @genomes;    my %variant_codes = map { $_ => $subsystem->get_variant_code( $subsystem->get_genome_index( $_ ) ) } @genomes;
177    my @roles          = $subsystem->get_roles;    my @roles          = $subsystem->get_roles;
# Line 115  Line 180 
180    $datahash->{ 'varcodes' } = \%variant_codes;    $datahash->{ 'varcodes' } = \%variant_codes;
181    $datahash->{ 'roles' } = \@roles;    $datahash->{ 'roles' } = \@roles;
182    
183    return ( $datahash, $subsystem );    return $datahash;
184  }  }
185    
186  #########################################################  #########################################################
187  # show table with variants and button for changing them #  # show table with variants and button for changing them #
188  #########################################################  #########################################################
189  sub show_variants {  sub show_variants {
190    my ( $self, $cgi, $fig, $name, $sub, $datahash ) = @_;    my ( $self, $cgi, $fig, $name, $sub, $can_alter, $datahash ) = @_;
191    
192    my $application = $self->application();    my $application = $self->application();
193    
# Line 145  Line 210 
210      $has_filled{join(",",@has)}->{$variant_codes{$genome}}++;      $has_filled{join(",",@has)}->{$variant_codes{$genome}}++;
211    }    }
212    
213    my ( $col_hdrs, $tab, $pattern );    my ( $col_hdrs, $pattern_uq );
214      if ( $can_alter ) {
215    $col_hdrs = [ { name => "Pattern" }, { name => "# Genomes with Pattern" },    $col_hdrs = [ { name => "Pattern" }, { name => "# Genomes with Pattern" },
216                  { name => "Existing Variant Code" }, { name => "Set To" } ];                  { name => "Existing Variant Code" }, { name => "Set To" } ];
217    $tab = [];    }
218    foreach $pattern ( sort keys( %has_filled ) ) {    else {
219        $col_hdrs = [ { name => "Pattern" }, { name => "# Genomes with Pattern" },
220                      { name => "Existing Variant Code" } ];
221      }
222    
223      my @codes = keys( %{ $has_filled{ $pattern } } );    my $tab = [];
224      foreach $pattern_uq ( sort keys( %has_filled ) ) {
225    
226        my $pattern = quotemeta( $pattern_uq );
227    
228        my @codes = keys( %{ $has_filled{ $pattern_uq } } );
229      my $code;      my $code;
230      my $nrow = @codes;      my $nrow = @codes;
231      if ( @codes > 0 ) {      if ( @codes > 0 ) {
232        $code = shift @codes;        $code = shift @codes;
233        push( @$tab, [ $pattern,        if ( $can_alter ) {
234                       $has_filled{$pattern}->{$code},          push( @$tab, [ $pattern_uq,
235                           $has_filled{ $pattern_uq }->{ $code },
236                       $code,                       $code,
237                       $cgi->textfield(-name => "p:$pattern:$code", -size => 5, -value => $code, -override => 1)                         $cgi->textfield(-name => "p##:##$pattern##:##$code", -size => 5, -value => $code, -override => 1)
238                     ]);                     ]);
239      }      }
240          else {
241            push( @$tab, [ $pattern_uq,
242                           $has_filled{ $pattern_uq }->{ $code },
243                           $code
244                         ]);
245          }
246        }
247    
248      foreach $code ( @codes ) {      foreach $code ( @codes ) {
249          if ( $can_alter ) {
250        push( @$tab,[ $has_filled{ $pattern }->{ $code },          push( @$tab, [ $pattern_uq,
251                           $has_filled{ $pattern_uq }->{ $code },
252                      $code,                      $code,
253                      $cgi->textfield(-name => "p:$pattern:$code", -size => 5, -value => $code, -override => 1)                         $cgi->textfield(-name => "p##:##$pattern##:##$code", -size => 5, -value => $code, -override => 1)
254                    ]);                    ]);
255      }      }
256          else {
257            push( @$tab, [ $pattern_uq,
258                           $has_filled{ $pattern_uq }->{ $code },
259                           $code
260                         ]);
261          }
262        }
263    }    }
264    
265    $cont .= $frtable;    $cont .= $frtable;
# Line 179  Line 269 
269    my $table = $application->component( 'ShowVariantsTable' );    my $table = $application->component( 'ShowVariantsTable' );
270    $table->columns( $col_hdrs );    $table->columns( $col_hdrs );
271    $table->data( $tab );    $table->data( $tab );
272    
273      ############################################
274      # Variant Descriptions from the Notes file #
275      ############################################
276      $cont .= "<H2>Variant descriptions</H2>\n";
277      my $variants = $sub->get_variants();
278    
279      my $infotable = '';
280      if ( $can_alter ) {
281        $infotable .= "<TABLE><TR><TH>Variant</TH><TH>Description</TH></TR>";
282        foreach my $kv ( sort keys %$variants ) {
283          $infotable .= "<TR><TD><INPUT TYPE=TEXT NAME='VARIANT' ID='VARIANT".$kv."' VALUE='$kv'></TD><TD><INPUT TYPE=TEXT NAME='VARIANTDESC' ID='VARIANTDESC".$kv."' VALUE='".$variants->{ $kv }."' STYLE='width: 500px;'></TD></TR>";
284        }
285        $infotable .= "<TR><TD><INPUT TYPE=TEXT NAME='NEWVARIANT' ID='NEWVARIANT'></TD><TD><INPUT TYPE=TEXT NAME='NEWVARIANTDESC' ID='NEWVARIANTDESC' STYLE='width: 500px;'></TD></TR>";
286        $infotable .= "<TR><TD>";
287        $infotable .= $cgi->submit( -name => "addsave_variants", -value => "Add/Save Variants" );
288        $infotable .= "</TD></TR></TABLE>";
289    
290        $cont .= $infotable;
291      }
292      else {
293        my $infotable = $application->component( 'VarDescTable' );
294        $infotable->columns( [ { name => "Variant" }, { name => "Description" } ] );
295    
296        my $vardata;
297        foreach my $kv ( sort keys %$variants ) {
298          push @$vardata, [ $kv, $variants->{ $kv } ];
299        }
300        $infotable->data( $vardata );
301        $cont .= $infotable->output();
302      }
303    
304      my $esc_name = uri_escape($name);
305    
306    $cont .= "<H2>Variant groups</H2>\n";    $cont .= "<H2>Variant groups</H2>\n";
307    $cont .= $application->component( 'ShowVariantsTable' )->output();    $cont .= $application->component( 'ShowVariantsTable' )->output();
308    
309    $cont .= $cgi->hidden(-name => 'request', -value => 'set_variants', -override => 1);    $cont .= $cgi->hidden(-name => 'request', -value => 'set_variants', -override => 1);
310    $cont .= $cgi->hidden(-name => 'subsystem', -value => $name, -override => 1);    $cont .= $cgi->hidden(-name => 'subsystem', -value => $esc_name, -override => 1);
311      if ( $can_alter ) {
312    $cont .= $cgi->br;    $cont .= $cgi->br;
313      }
314    $cont .= $cgi->submit( -name => "set_variants", -value => "Set Variants" );    $cont .= $cgi->submit( -name => "set_variants", -value => "Set Variants" );
315    $cont .= $self->end_form();    $cont .= $self->end_form();
316    
# Line 255  Line 381 
381        foreach my $role ( @roles ) {        foreach my $role ( @roles ) {
382          push( @has, ( $sub->get_pegs_from_cell( $genome, $role ) > 0 ) ? $abbrev->{ $role } : () );          push( @has, ( $sub->get_pegs_from_cell( $genome, $role ) > 0 ) ? $abbrev->{ $role } : () );
383        }        }
384        my $pattern = join( ",", @has );        my $pattern = quotemeta( join( ",", @has ) );
385        push( @{ $genomes_with{ "$pattern, $vc" } }, $genome );        push( @{ $genomes_with{ "$pattern, $vc" } }, $genome );
386      }      }
387    
388      my $comment = '';      my $comment = '';
389        my @params = grep { $_ =~ /^p##:##/ } $cgi->param;
390    
     my @params = grep { $_ =~ /^p:/ } $cgi->param;  
391      foreach my $param (@params) {      foreach my $param (@params) {
392        if ( $param =~ /^p:(.*):(.*)$/ ) {  
393          if ( $param =~ /^p##:##(.*)##:##(.*)$/ ) {
394          my ( $pattern, $vc ) = ( $1, $2 );          my ( $pattern, $vc ) = ( $1, $2 );
395    
396          $pattern =~ s/ //g;          $pattern =~ s/ //g;
397          $vc      =~ s/ //g;          $vc      =~ s/ //g;
398          my $to = $cgi->param( $param );          my $to = $cgi->param( $param );
399    
400          if ( my $x = $genomes_with{ "$pattern, $vc" } ) {          if ( my $x = $genomes_with{ "$pattern, $vc" } ) {
   
401            foreach my $genome ( @$x ) {            foreach my $genome ( @$x ) {
402    
403              if ( $to ne $variant_codes{ $genome } ) {              if ( $to ne $variant_codes{ $genome } ) {
404    
405                my $old = $variant_codes{$genome};                my $old = $variant_codes{$genome};
406                my $gs = $fig->genus_species($genome);                my $gs = $fig->genus_species($genome);
407                $comment .= "resetting $genome $gs from $old to $to<BR>\n";                $comment .= "resetting $genome $gs from $old to $to<BR>\n";
# Line 283  Line 412 
412          }          }
413        }        }
414      }      }
415    
416        $sub->incr_version();
417        $sub->db_sync();
418      $sub->write_subsystem();      $sub->write_subsystem();
419    
420      return $comment;      return $comment;

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3