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

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3