[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.8, Wed May 7 19:19:18 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      $self->application->register_component( 'Info', 'CommentInfo');
26  }  }
27    
28  sub require_javascript {  sub require_javascript {
# Line 35  Line 37 
37  sub output {  sub output {
38    my ( $self ) = @_;    my ( $self ) = @_;
39    
40    my $can_alter = 1;    my $can_alter = 0;
41      my $user = $self->application->session->user;
42    
43    my $fig = new FIG;    my $fig = new FIG;
44    my $cgi = $self->application->cgi;    my $cgi = $self->application->cgi;
45    
46    my $name = $cgi->param( 'subsystem' );    my $name = $cgi->param( 'subsystem' );
47    my $ssname = $name;    my $ssname = $name;
48      $name = uri_unescape( $name );
49    $ssname =~ s/\_/ /g;    $ssname =~ s/\_/ /g;
50    
51      my $esc_name = uri_escape($name);
52    
53      my $dbmaster = DBMaster->new( -database => 'WebAppBackend' );
54      my $ppoapplication = $dbmaster->Backend->init( { name => 'SubsystemEditor' } );
55    
56      # get a seeduser #
57      my $seeduser = '';
58      if ( defined( $user ) && ref( $user ) ) {
59        my $preferences = $dbmaster->Preferences->get_objects( { user => $user,
60                                                                 name => 'SeedUser',
61                                                                 application => $ppoapplication } );
62        if ( defined( $preferences->[0] ) ) {
63          $seeduser = $preferences->[0]->value();
64        }
65      }
66    
67      if ( $user && $user->has_right( $self->application, 'edit', 'subsystem', $name ) ) {
68        $can_alter = 1;
69        $fig->set_user( $seeduser );
70      }
71    
72    ######################    ######################
73    # Construct the menu #    # Construct the menu #
74    ######################    ######################
# Line 51  Line 76 
76    my $menu = $self->application->menu();    my $menu = $self->application->menu();
77    
78    # Build nice tab menu here    # Build nice tab menu here
79    $menu->add_category( 'Subsystem Info', "SubsysEditor.cgi?page=ShowSubsystem&subsystem=$name" );    $menu->add_category( 'Subsystem Info', "SubsysEditor.cgi?page=ShowSubsystem&subsystem=$esc_name" );
80    $menu->add_category( 'Functional Roles', "SubsysEditor.cgi?page=ShowFunctionalRoles&subsystem=$name" );    $menu->add_category( 'Functional Roles', "SubsysEditor.cgi?page=ShowFunctionalRoles&subsystem=$esc_name" );
81    $menu->add_category( 'Subsystem Diagram', "SubsysEditor.cgi?page=ShowDiagram&subsystem=$name" );    $menu->add_category( 'Diagram', "SubsysEditor.cgi?page=ShowDiagram&subsystem=$esc_name" );
82    $menu->add_category( 'Subsystem Spreadsheet', "SubsysEditor.cgi?page=ShowSpreadsheet&subsystem=$name" );    $menu->add_category( 'Illustrations', "SubsysEditor.cgi?page=ShowIllustrations&subsystem=$esc_name" );
83    $menu->add_category( 'Subsystem Check', "SubsysEditor.cgi?page=ShowCheck&subsystem=$name" );    $menu->add_category( 'Spreadsheet', "SubsysEditor.cgi?page=ShowSpreadsheet&subsystem=$esc_name" );
84    $menu->add_category( 'Subsystem Tree', "SubsysEditor.cgi?page=ShowTree&subsystem=$name" );    $menu->add_category( 'Show Check', "SubsysEditor.cgi?page=ShowCheck&subsystem=$esc_name" );
85      $menu->add_category( 'Show Connections', "SubsysEditor.cgi?page=ShowTree&subsystem=$esc_name" );
86    
87    
88    ##############################    ##############################
# Line 72  Line 98 
98      return $content;      return $content;
99    }    }
100    
101    my ( $datahash, $subsystem ) = get_data( $fig, $name );    my $subsystem = $fig->get_subsystem( $name );
102    
103      my $datahash = get_data( $fig, $subsystem );
104    
105    my $application = $self->application;    my $application = $self->application;
106    
107    if ( $cgi->param( 'set_variants' ) ) {    if ( $cgi->param( 'set_variants' ) ) {
108      $comment .= '<BR>';      $comment .= '<BR>';
109      $comment .= set_variants( $cgi, $fig, $name, $subsystem, $application, $datahash );      $comment .= set_variants( $cgi, $fig, $name, $subsystem, $application, $datahash );
110      ( $datahash, $subsystem ) = get_data( $fig, $name );      $datahash = get_data( $fig, $subsystem );
111      }
112      elsif ( $cgi->param( 'addsave_variants' ) ) {
113        my @varcodes = $cgi->param( 'VARIANT' );
114        my @vardescs = $cgi->param( 'VARIANTDESC' );
115        my %varhash;
116    
117        for ( my $i = 0; $i < scalar( @varcodes ); $i++ ) {
118    
119          if ( $varcodes[$i] eq '' ) {
120            if ( $vardescs[$i] ne '' ) {
121              $comment .= "No Variant Code given for description ".$vardescs[$i].", so this variant could not be saved.<BR>\n";
122            }
123            next;
124          }
125          if ( defined( $varhash{ $varcodes[$i] } ) ) {
126            $comment .= "Variant ".$varcodes[$i]." already has the description ".$varhash{ $varcodes[$i] }.", so description ".$vardescs[$i]." was ignored.<BR>\n";
127            next;
128          }
129    
130          $varhash{ $varcodes[$i] } = $vardescs[$i];
131        }
132        my $newvarcode = $cgi->param( 'NEWVARIANT' );
133        my $newvardesc = $cgi->param( 'NEWVARIANTDESC' );
134        if ( defined( $newvarcode ) && $newvarcode ne '' && defined( $newvardesc ) && $newvardesc ne '' ) {
135          if ( $newvarcode eq '' ) {
136            if ( $newvarcode ne '' ) {
137              $comment .= "No Variant Code given for description $newvardesc, so this variant could not be saved.<BR>\n";
138            }
139          }
140          elsif ( defined( $varhash{ $newvarcode } ) ) {
141            $comment .= "Variant $newvarcode already has the description $newvardesc, so description $newvardesc was ignored.<BR>\n";
142          }
143          else {
144            $varhash{ $newvarcode } = $newvardesc;
145    }    }
146        }
147    
148        $subsystem->set_variants( \%varhash );
149        $subsystem->incr_version();
150        $subsystem->db_sync();
151        $subsystem->write_subsystem();
152      }
153    
154      if ( defined( $comment ) && $comment ne '' ) {
155        my $info_component = $application->component( 'CommentInfo' );
156    
157    $content .= show_variants( $self, $cgi, $fig, $name, $subsystem, $datahash );      $info_component->content( $comment );
158        $info_component->default( 0 );
159        $content .= $info_component->output();
160      }
161    
162      $content .= show_variants( $self, $cgi, $fig, $name, $subsystem, $can_alter, $datahash );
163    
164    ###############################    ###############################
165    # Display errors and comments #    # Display errors and comments #
# Line 91  Line 168 
168    if ( defined( $error ) && $error ne '' ) {    if ( defined( $error ) && $error ne '' ) {
169      $self->application->add_message( 'warning', $error );      $self->application->add_message( 'warning', $error );
170    }    }
   if ( defined( $comment ) && $comment ne '' ) {  
     $self->application->add_message( 'info', $comment );  
   }  
   
171    return $content;    return $content;
172  }  }
173    
# Line 102  Line 175 
175  # data method #  # data method #
176  ###############  ###############
177  sub get_data {  sub get_data {
178    my ( $fig, $name ) = @_;    my ( $fig, $subsystem ) = @_;
179    
180    my $datahash = {};    my $datahash = {};
181    
   my $subsystem = $fig->get_subsystem( $name );  
182    my @genomes        = $subsystem->get_genomes;    my @genomes        = $subsystem->get_genomes;
183    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;
184    my @roles          = $subsystem->get_roles;    my @roles          = $subsystem->get_roles;
# Line 115  Line 187 
187    $datahash->{ 'varcodes' } = \%variant_codes;    $datahash->{ 'varcodes' } = \%variant_codes;
188    $datahash->{ 'roles' } = \@roles;    $datahash->{ 'roles' } = \@roles;
189    
190    return ( $datahash, $subsystem );    return $datahash;
191  }  }
192    
193  #########################################################  #########################################################
194  # show table with variants and button for changing them #  # show table with variants and button for changing them #
195  #########################################################  #########################################################
196  sub show_variants {  sub show_variants {
197    my ( $self, $cgi, $fig, $name, $sub, $datahash ) = @_;    my ( $self, $cgi, $fig, $name, $sub, $can_alter, $datahash ) = @_;
198    
199    my $application = $self->application();    my $application = $self->application();
200    
# Line 145  Line 217 
217      $has_filled{join(",",@has)}->{$variant_codes{$genome}}++;      $has_filled{join(",",@has)}->{$variant_codes{$genome}}++;
218    }    }
219    
220    my ( $col_hdrs, $tab, $pattern );    my ( $col_hdrs, $pattern_uq );
221      if ( $can_alter ) {
222    $col_hdrs = [ { name => "Pattern" }, { name => "# Genomes with Pattern" },    $col_hdrs = [ { name => "Pattern" }, { name => "# Genomes with Pattern" },
223                  { name => "Existing Variant Code" }, { name => "Set To" } ];                  { name => "Existing Variant Code" }, { name => "Set To" } ];
224    $tab = [];    }
225    foreach $pattern ( sort keys( %has_filled ) ) {    else {
226        $col_hdrs = [ { name => "Pattern" }, { name => "# Genomes with Pattern" },
227                      { name => "Existing Variant Code" } ];
228      }
229    
230      my $tab = [];
231      foreach $pattern_uq ( sort keys( %has_filled ) ) {
232    
233        my $pattern = quotemeta( $pattern_uq );
234    
235      my @codes = keys( %{ $has_filled{ $pattern } } );      my @codes = keys( %{ $has_filled{ $pattern_uq } } );
236      my $code;      my $code;
237      my $nrow = @codes;      my $nrow = @codes;
238      if ( @codes > 0 ) {      if ( @codes > 0 ) {
239        $code = shift @codes;        $code = shift @codes;
240        push( @$tab, [ $pattern,        if ( $can_alter ) {
241                       $has_filled{$pattern}->{$code},          push( @$tab, [ $pattern_uq,
242                           $has_filled{ $pattern_uq }->{ $code },
243                       $code,                       $code,
244                       $cgi->textfield(-name => "p:$pattern:$code", -size => 5, -value => $code, -override => 1)                         $cgi->textfield(-name => "p##:##$pattern##:##$code", -size => 5, -value => $code, -override => 1)
245                     ]);                     ]);
246      }      }
247          else {
248            push( @$tab, [ $pattern_uq,
249                           $has_filled{ $pattern_uq }->{ $code },
250                           $code
251                         ]);
252          }
253        }
254    
255      foreach $code ( @codes ) {      foreach $code ( @codes ) {
256          if ( $can_alter ) {
257        push( @$tab,[ $has_filled{ $pattern }->{ $code },          push( @$tab, [ $pattern_uq,
258                           $has_filled{ $pattern_uq }->{ $code },
259                      $code,                      $code,
260                      $cgi->textfield(-name => "p:$pattern:$code", -size => 5, -value => $code, -override => 1)                         $cgi->textfield(-name => "p##:##$pattern##:##$code", -size => 5, -value => $code, -override => 1)
261                         ]);
262          }
263          else {
264            push( @$tab, [ $pattern_uq,
265                           $has_filled{ $pattern_uq }->{ $code },
266                           $code
267                    ]);                    ]);
268      }      }
269    }    }
270      }
271    
272    $cont .= $frtable;    $cont .= $frtable;
273    $cont .= $self->start_form();    $cont .= $self->start_form();
274    
275    # create table from parsed data    my $thistable = create_table( $self, $fig, \%has_filled, $col_hdrs, $tab );
276    my $table = $application->component( 'ShowVariantsTable' );  
277    $table->columns( $col_hdrs );  #  # create table from parsed data
278    $table->data( $tab );  #  my $table = $application->component( 'ShowVariantsTable' );
279    #  $table->columns( $col_hdrs );
280    #  $table->data( $tab );
281    
282      ############################################
283      # Variant Descriptions from the Notes file #
284      ############################################
285      $cont .= "<H2>Variant descriptions</H2>\n";
286      my $variants = $sub->get_variants();
287    
288      my $infotable = '';
289      if ( $can_alter ) {
290        $infotable .= "<TABLE class='table_table'><TR><TD class='table_first_row'>Variant</TD><TD class='table_first_row'>Description</TD></TR>";
291        foreach my $kv ( sort keys %$variants ) {
292          $infotable .= "<TR><TD class='table_odd_row'><INPUT TYPE=TEXT NAME='VARIANT' ID='VARIANT".$kv."' VALUE='$kv'></TD><TD class='table_odd_row'><INPUT TYPE=TEXT NAME='VARIANTDESC' ID='VARIANTDESC".$kv."' VALUE='".$variants->{ $kv }."' STYLE='width: 500px;'></TD></TR>";
293        }
294        $infotable .= "<TR><TD class='table_odd_row'><INPUT TYPE=TEXT NAME='NEWVARIANT' ID='NEWVARIANT'></TD><TD class='table_odd_row'><INPUT TYPE=TEXT NAME='NEWVARIANTDESC' ID='NEWVARIANTDESC' STYLE='width: 500px;'></TD></TR>";
295        $infotable .= "<TR><TD>";
296        $infotable .= $cgi->submit( -name => "addsave_variants", -value => "Add/Save Variants" );
297        $infotable .= "</TD></TR></TABLE>";
298    
299        $cont .= $infotable;
300      }
301      else {
302        my $infotable = $application->component( 'VarDescTable' );
303        $infotable->columns( [ { name => "Variant" }, { name => "Description" } ] );
304    
305        my $vardata;
306        foreach my $kv ( sort keys %$variants ) {
307          push @$vardata, [ $kv, $variants->{ $kv } ];
308        }
309        $infotable->data( $vardata );
310        $cont .= $infotable->output();
311      }
312    
313      my $esc_name = uri_escape($name);
314    
315    $cont .= "<H2>Variant groups</H2>\n";    $cont .= "<H2>Variant groups</H2>\n";
316    $cont .= $application->component( 'ShowVariantsTable' )->output();  #  $cont .= $application->component( 'ShowVariantsTable' )->output();
317      $cont .= $thistable;
318    
319    $cont .= $cgi->hidden(-name => 'request', -value => 'set_variants', -override => 1);    $cont .= $cgi->hidden(-name => 'request', -value => 'set_variants', -override => 1);
320    $cont .= $cgi->hidden(-name => 'subsystem', -value => $name, -override => 1);    $cont .= $cgi->hidden(-name => 'subsystem', -value => $name, -override => 1);
321      if ( $can_alter ) {
322    $cont .= $cgi->br;    $cont .= $cgi->br;
323      }
324    $cont .= $cgi->submit( -name => "set_variants", -value => "Set Variants" );    $cont .= $cgi->submit( -name => "set_variants", -value => "Set Variants" );
325    $cont .= $self->end_form();    $cont .= $self->end_form();
326    
# Line 255  Line 391 
391        foreach my $role ( @roles ) {        foreach my $role ( @roles ) {
392          push( @has, ( $sub->get_pegs_from_cell( $genome, $role ) > 0 ) ? $abbrev->{ $role } : () );          push( @has, ( $sub->get_pegs_from_cell( $genome, $role ) > 0 ) ? $abbrev->{ $role } : () );
393        }        }
394        my $pattern = join( ",", @has );        my $pattern = quotemeta( join( ",", @has ) );
395        push( @{ $genomes_with{ "$pattern, $vc" } }, $genome );        push( @{ $genomes_with{ "$pattern, $vc" } }, $genome );
396      }      }
397    
398      my $comment = '';      my $comment = '';
399        my @params = grep { $_ =~ /^p##:##/ } $cgi->param;
400    
     my @params = grep { $_ =~ /^p:/ } $cgi->param;  
401      foreach my $param (@params) {      foreach my $param (@params) {
402        if ( $param =~ /^p:(.*):(.*)$/ ) {  
403          if ( $param =~ /^p##:##(.*)##:##(.*)$/ ) {
404          my ( $pattern, $vc ) = ( $1, $2 );          my ( $pattern, $vc ) = ( $1, $2 );
405    
406          $pattern =~ s/ //g;          $pattern =~ s/ //g;
407          $vc      =~ s/ //g;          $vc      =~ s/ //g;
408          my $to = $cgi->param( $param );          my $to = $cgi->param( $param );
409    
410          if ( my $x = $genomes_with{ "$pattern, $vc" } ) {          if ( my $x = $genomes_with{ "$pattern, $vc" } ) {
   
411            foreach my $genome ( @$x ) {            foreach my $genome ( @$x ) {
412    
413              if ( $to ne $variant_codes{ $genome } ) {              if ( $to ne $variant_codes{ $genome } ) {
414    
415                my $old = $variant_codes{$genome};                my $old = $variant_codes{$genome};
416                my $gs = $fig->genus_species($genome);                my $gs = $fig->genus_species($genome);
417                $comment .= "resetting $genome $gs from $old to $to<BR>\n";                $comment .= "resetting $genome $gs from $old to $to<BR>\n";
# Line 283  Line 422 
422          }          }
423        }        }
424      }      }
425    
426        $sub->incr_version();
427        $sub->db_sync();
428      $sub->write_subsystem();      $sub->write_subsystem();
429    
430      return $comment;      return $comment;
431  }  }
432    
433    sub create_table {
434      my ($self, $fig, $has_filled, $col_hdrs, $tab ) = @_;
435    
436      my $in;
437      my $tabl = "<TABLE class='table_table'><TR>";
438    
439      foreach my $ch ( @$col_hdrs ) {
440        $tabl .= "<TD class='table_first_row'>";
441        $tabl .= $ch->{ name };
442        $tabl .= "</TD>";
443      }
444    
445      foreach my $r ( @$tab ) {
446        $tabl .= "<TR>";
447    
448        my $num = scalar( keys %{ $has_filled->{ $r->[0] } } );
449        my $pat = $r->[0];
450        if ( $num > 1 ) {
451          if ( !$in->{ $pat } ) {
452            $tabl .= "<TD rowspan=$num class='table_odd_row' STYLE='vertical-align: middle;'>".$r->[0]."</TD>";
453            $in->{ $pat } = 1;
454          }
455        }
456        else {
457          $tabl .= "<TD class='table_odd_row'>".$r->[0]."</TD>";
458        }
459        my $next = 0;
460        foreach my $cell ( @$r ) {
461          if ( $next == 0 ) {
462            $next = 1;
463            next;
464          }
465          else {
466            $tabl .= "<TD class='table_odd_row'>".$cell."</TD>";
467          }
468        }
469        $tabl .= "</TR>";
470      }
471    
472      $tabl .= "</TABLE>";
473    
474      return $tabl;
475    }

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3