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

Annotation of /SubsystemEditor/WebPage/ShowVariants.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (view) (download) (as text)

1 : bartels 1.1 package SubsystemEditor::WebPage::ShowVariants;
2 :    
3 :     use strict;
4 :     use warnings;
5 :     use URI::Escape;
6 :     use HTML;
7 :     use Data::Dumper;
8 :    
9 :     use FIG;
10 :    
11 :     use base qw( WebPage );
12 :    
13 :     1;
14 :    
15 :     ##################################################
16 :     # Method for registering components etc. for the #
17 :     # application #
18 :     ##################################################
19 :     sub init {
20 :     my ( $self ) = @_;
21 :    
22 :     $self->application->register_component( 'Table', 'ShowVariantsTable' );
23 :     $self->application->register_component( 'Table', 'FRTable' );
24 :     }
25 :    
26 :     sub require_javascript {
27 :    
28 :     return [ './Html/showfunctionalroles.js' ];
29 :    
30 :     }
31 :    
32 :     ##############################################
33 :     # Website content is returned by this method #
34 :     ##############################################
35 :     sub output {
36 :     my ( $self ) = @_;
37 :    
38 :     my $can_alter = 1;
39 :    
40 :     my $fig = new FIG;
41 :     my $cgi = $self->application->cgi;
42 :    
43 :     my $name = $cgi->param( 'subsystem' );
44 :     my $ssname = $name;
45 :     $ssname =~ s/\_/ /g;
46 :    
47 :     ######################
48 :     # Construct the menu #
49 :     ######################
50 :    
51 :     my $menu = $self->application->menu();
52 :    
53 :     # Build nice tab menu here
54 :     $menu->add_category( 'Subsystem Info', "SubsysEditor.cgi?page=ShowSubsystem&subsystem=$name" );
55 :     $menu->add_category( 'Functional Roles', "SubsysEditor.cgi?page=ShowFunctionalRoles&subsystem=$name" );
56 :     $menu->add_category( 'Subsystem Diagram', "SubsysEditor.cgi?page=ShowDiagram&subsystem=$name" );
57 :     $menu->add_category( 'Subsystem Spreadsheet', "SubsysEditor.cgi?page=ShowSpreadsheet&subsystem=$name" );
58 : bartels 1.2 $menu->add_category( 'Subsystem Check', "SubsysEditor.cgi?page=ShowCheck&subsystem=$name" );
59 : bartels 1.1 $menu->add_category( 'Subsystem Tree', "SubsysEditor.cgi?page=ShowTree&subsystem=$name" );
60 :    
61 :    
62 :     ##############################
63 :     # Construct the page content #
64 :     ##############################
65 :     my $comment;
66 :     my $error;
67 :    
68 :     my $content = "<H1>Variants for Subsystem: $ssname</H1>";
69 :    
70 :     if ( !defined( $name ) ) {
71 :     $content .= "<B>No subsystem given</B>";
72 :     return $content;
73 :     }
74 :    
75 :     my ( $datahash, $subsystem ) = get_data( $fig, $name );
76 :    
77 :     my $application = $self->application;
78 :    
79 :     if ( $cgi->param( 'set_variants' ) ) {
80 :     $comment .= '<BR>';
81 :     $comment .= set_variants( $cgi, $fig, $name, $subsystem, $application, $datahash );
82 :     ( $datahash, $subsystem ) = get_data( $fig, $name );
83 :     }
84 :    
85 :     $content .= show_variants( $self, $cgi, $fig, $name, $subsystem, $datahash );
86 :    
87 :     ###############################
88 :     # Display errors and comments #
89 :     ###############################
90 :    
91 :     if ( defined( $error ) && $error ne '' ) {
92 :     $self->application->add_message( 'warning', $error );
93 :     }
94 :     if ( defined( $comment ) && $comment ne '' ) {
95 :     $self->application->add_message( 'info', $comment );
96 :     }
97 :    
98 :     return $content;
99 :     }
100 :    
101 : bartels 1.2 ###############
102 :     # data method #
103 :     ###############
104 : bartels 1.1 sub get_data {
105 :     my ( $fig, $name ) = @_;
106 :    
107 :     my $datahash = {};
108 :    
109 :     my $subsystem = $fig->get_subsystem( $name );
110 :     my @genomes = $subsystem->get_genomes;
111 :     my %variant_codes = map { $_ => $subsystem->get_variant_code( $subsystem->get_genome_index( $_ ) ) } @genomes;
112 :     my @roles = $subsystem->get_roles;
113 :    
114 :     $datahash->{ 'genomes' } = \@genomes;
115 :     $datahash->{ 'varcodes' } = \%variant_codes;
116 :     $datahash->{ 'roles' } = \@roles;
117 :    
118 :     return ( $datahash, $subsystem );
119 :     }
120 :    
121 : bartels 1.2 #########################################################
122 :     # show table with variants and button for changing them #
123 :     #########################################################
124 : bartels 1.1 sub show_variants {
125 :     my ( $self, $cgi, $fig, $name, $sub, $datahash ) = @_;
126 :    
127 :     my $application = $self->application();
128 :    
129 :     my $cont = '';
130 :    
131 :     # get some datapoints #
132 :     my @genomes = @{ $datahash->{ 'genomes' } };
133 :     my %variant_codes = %{ $datahash->{ 'varcodes' } };
134 :     my @roles = @{ $datahash->{ 'roles' } };
135 :    
136 :     my ( $abbrev, $frtable ) = format_roles( $application, $fig, $cgi, $sub );
137 :    
138 :     my( @has, $role, %has_filled );
139 :     foreach my $genome ( @genomes ) {
140 :     @has = ();
141 :     foreach $role (@roles)
142 :     {
143 :     push(@has,($sub->get_pegs_from_cell($genome,$role) > 0) ? $abbrev->{$role} : ());
144 :     }
145 :     $has_filled{join(",",@has)}->{$variant_codes{$genome}}++;
146 :     }
147 :    
148 :     my ( $col_hdrs, $tab, $pattern );
149 :     $col_hdrs = [ { name => "Pattern" }, { name => "# Genomes with Pattern" },
150 :     { name => "Existing Variant Code" }, { name => "Set To" } ];
151 :     $tab = [];
152 :     foreach $pattern ( sort keys( %has_filled ) ) {
153 :    
154 :     my @codes = keys( %{ $has_filled{ $pattern } } );
155 :     my $code;
156 :     my $nrow = @codes;
157 :     if ( @codes > 0 ) {
158 :     $code = shift @codes;
159 :     push( @$tab, [ $pattern,
160 : bartels 1.3 $has_filled{ $pattern }->{ $code },
161 : bartels 1.1 $code,
162 :     $cgi->textfield(-name => "p:$pattern:$code", -size => 5, -value => $code, -override => 1)
163 :     ]);
164 :     }
165 :    
166 :     foreach $code ( @codes ) {
167 :    
168 : bartels 1.3 push( @$tab, [ $pattern,
169 :     $has_filled{ $pattern }->{ $code },
170 :     $code,
171 :     $cgi->textfield(-name => "p:$pattern:$code", -size => 5, -value => $code, -override => 1)
172 : bartels 1.1 ]);
173 :     }
174 :     }
175 :    
176 :     $cont .= $frtable;
177 :     $cont .= $self->start_form();
178 :    
179 :     # create table from parsed data
180 :     my $table = $application->component( 'ShowVariantsTable' );
181 :     $table->columns( $col_hdrs );
182 :     $table->data( $tab );
183 :     $cont .= "<H2>Variant groups</H2>\n";
184 :     $cont .= $application->component( 'ShowVariantsTable' )->output();
185 :    
186 :     $cont .= $cgi->hidden(-name => 'request', -value => 'set_variants', -override => 1);
187 :     $cont .= $cgi->hidden(-name => 'subsystem', -value => $name, -override => 1);
188 :     $cont .= $cgi->br;
189 :     $cont .= $cgi->submit( -name => "set_variants", -value => "Set Variants" );
190 :     $cont .= $self->end_form();
191 :    
192 :     return $cont;
193 :     }
194 :    
195 :    
196 : bartels 1.2 ###############################
197 :     # get a functional role table #
198 :     ###############################
199 : bartels 1.1 sub format_roles {
200 :     my( $application, $fig, $cgi, $subsystem ) = @_;
201 :     my( $i );
202 :    
203 :     my $col_hdrs = [ "Column", "Abbrev", "Functional Role" ];
204 :    
205 :     my $n = 1;
206 :     my ( $tab, $abbrevP ) = format_existing_roles( $fig, $subsystem, \$n );
207 :    
208 :     # create table from parsed data
209 :     my $table = $application->component( 'FRTable' );
210 :     $table->columns( $col_hdrs );
211 :     $table->data( $tab );
212 :    
213 :     my $formatted = '<H2>Functional Roles</H2>';
214 :     $formatted .= $application->component( 'FRTable' )->output();
215 :    
216 :     $formatted .= "<BR><BR>";
217 :     return ( $abbrevP, $formatted );
218 :     }
219 :    
220 : bartels 1.2 #########################################
221 :     # get rows of the functional role table #
222 :     #########################################
223 : bartels 1.1 sub format_existing_roles {
224 :     my ( $fig, $subsystem, $nP ) = @_;
225 :     my $tab = [];
226 :     my $abbrevP = {};
227 :    
228 :     foreach my $role ( $subsystem->get_roles ) {
229 :     my $i = $subsystem->get_role_index( $role );
230 :     my $abbrev = $role ? $subsystem->get_role_abbr( $i ) : "";
231 :     $abbrevP->{ $role } = $abbrev;
232 :     push( @$tab, [ $$nP, $abbrev, $role ] );
233 :     }
234 :    
235 :     return ( $tab, $abbrevP );
236 :     }
237 :    
238 : bartels 1.2
239 :     ##############################################
240 :     # change the variants in the subsystems file #
241 :     ##############################################
242 : bartels 1.1 sub set_variants {
243 :     my ( $cgi, $fig, $subsys, $sub, $application, $datahash ) = @_;
244 :    
245 :     my @genomes = @{ $datahash->{ 'genomes' } };
246 :     my %variant_codes = %{ $datahash->{ 'varcodes' } };
247 :     my @roles = @{ $datahash->{ 'roles' } };
248 :    
249 :     my ( $abbrev, $frtable ) = format_roles( $application, $fig, $cgi, $sub );
250 :    
251 :     my ( %genomes_with );
252 :     foreach my $genome ( @genomes ) {
253 :     my $vc = $variant_codes{ $genome };
254 :    
255 :     my @has = ();
256 :     foreach my $role ( @roles ) {
257 :     push( @has, ( $sub->get_pegs_from_cell( $genome, $role ) > 0 ) ? $abbrev->{ $role } : () );
258 :     }
259 :     my $pattern = join( ",", @has );
260 :     push( @{ $genomes_with{ "$pattern, $vc" } }, $genome );
261 :     }
262 :    
263 :     my $comment = '';
264 :    
265 :     my @params = grep { $_ =~ /^p:/ } $cgi->param;
266 :     foreach my $param (@params) {
267 :     if ( $param =~ /^p:(.*):(.*)$/ ) {
268 :     my ( $pattern, $vc ) = ( $1, $2 );
269 :     $pattern =~ s/ //g;
270 :     $vc =~ s/ //g;
271 :     my $to = $cgi->param( $param );
272 :    
273 :     if ( my $x = $genomes_with{ "$pattern, $vc" } ) {
274 :    
275 :     foreach my $genome ( @$x ) {
276 :     if ( $to ne $variant_codes{ $genome } ) {
277 :     my $old = $variant_codes{$genome};
278 :     my $gs = $fig->genus_species($genome);
279 :     $comment .= "resetting $genome $gs from $old to $to<BR>\n";
280 :     $sub->set_variant_code( $sub->get_genome_index( $genome ), $to );
281 :     }
282 :     }
283 :    
284 :     }
285 :     }
286 :     }
287 :     $sub->write_subsystem();
288 :    
289 :     return $comment;
290 :     }
291 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3