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

Annotation of /SubsystemEditor/WebPage/MetaSpreadsheet.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : bartels 1.1 package SubsystemEditor::WebPage::MetaSpreadsheet;
2 :    
3 :     use strict;
4 :     use warnings;
5 :     use URI::Escape;
6 :     use HTML;
7 :     use Data::Dumper;
8 :     use DBMaster;
9 :    
10 :     use FIG;
11 :    
12 :     use MIME::Base64;
13 :     use Data::Dumper;
14 :     use File::Spec;
15 :     use GenomeLists;
16 :     use MetaSubsystem;
17 :     use base qw( WebPage );
18 :    
19 :     1;
20 :    
21 :    
22 :     ##############################################################
23 :     # Method for registering components etc. for the application #
24 :     ##############################################################
25 :     sub init {
26 :     my ( $self ) = @_;
27 :    
28 :     $self->application->register_component( 'Table', 'SubsystemSpreadsheet' );
29 :     $self->application->register_component( 'TabView', 'functionTabView' );
30 : bartels 1.8 $self->application->register_component( 'Info', 'CommentInfo');
31 :     $self->application->register_component( 'OrganismSelect', 'OSelect');
32 : bartels 1.1 $self->application->register_component( 'Table', 'LD_SUBSETS' );
33 :     $self->application->register_component( 'Table', 'LD_ROLES' );
34 :     $self->application->register_component( 'Table', 'FunctionalRolesTable' );
35 :    
36 :     return 1;
37 :     }
38 :    
39 :     sub require_javascript {
40 :    
41 :     return [ './Html/showfunctionalroles.js' ];
42 :    
43 :     }
44 :    
45 :     ##############################################
46 :     # Website content is returned by this method #
47 :     ##############################################
48 :     sub output {
49 :     my ( $self ) = @_;
50 :    
51 :     # needed objects #
52 :     my $application = $self->application();
53 :     $self->{ 'fig' } = $application->data_handle( 'FIG' );
54 :     $self->{ 'cgi' } = $self->application->cgi;
55 :    
56 :     # subsystem name and 'nice name' #
57 :     my $name = $self->{ 'cgi' }->param( 'metasubsystem' );
58 :     my $ssname = $name;
59 :    
60 :     my $esc_name = uri_escape( $name );
61 :    
62 :     $ssname =~ s/\_/ /g;
63 :    
64 :     # look if someone is logged in and can write the subsystem #
65 :     $self->{ 'can_alter' } = 0;
66 :     my $user = $self->application->session->user;
67 :    
68 : paczian 1.12 my $dbmaster = $self->application->dbmaster;
69 :     my $ppoapplication = $self->application->backend;
70 : bartels 1.1
71 :     ############################################
72 :     ### GET PREFERENCES FOR AN EXISTING USER ###
73 :     my $preferences = {};
74 :    
75 :     if ( defined( $user ) && ref( $user ) ) {
76 :     my $pre = $self->application->dbmaster->Preferences->get_objects( { user => $user,
77 :     application => $ppoapplication } );
78 :     %{ $preferences } = map { $_->name => $_ } @$pre;
79 :     }
80 :     ############################################
81 :    
82 :     # get a seeduser #
83 :     my $seeduser = '';
84 :    
85 : bartels 1.4
86 :     $self->{ 'metasubsystem' } = new MetaSubsystem( $name, $self->{ 'fig' }, 0 );
87 :    
88 : bartels 1.1 if ( defined( $preferences->{ 'SeedUser' } ) ) {
89 :     $seeduser = $preferences->{ 'SeedUser' }->value;
90 :     }
91 : bartels 1.4 if ( $user ) {
92 :     if ( $user->has_right( $self->application, 'edit', 'metasubsystem', $esc_name ) ) {
93 :     $self->{ 'can_alter' } = 1;
94 :     $self->{ 'fig' }->set_user( $seeduser );
95 :     $self->{ 'seeduser' } = $seeduser;
96 :     }
97 :     else {
98 :     # we might have the problem that the user has not yet got the right for editing the
99 :     # subsystem due to that it was created in the old seed or what do I know where.
100 :     my $curatorOfSS = $self->{ 'metasubsystem' }->get_curator();
101 :    
102 :     my $su = lc( $seeduser );
103 :     my $cu = lc( $curatorOfSS );
104 :     if ( $su eq $cu ) {
105 :     # now set the rights...
106 :     my $right = $dbmaster->Rights->create( { name => 'edit',
107 :     scope => $user->get_user_scope,
108 :     data_type => 'metasubsystem',
109 :     data_id => $name,
110 :     granted => 1,
111 :     delegated => 0 } );
112 :     if ( $right ) {
113 :     $self->{ 'can_alter' } = 1;
114 :     $self->{ 'fig' }->set_user( $seeduser );
115 :     $self->{ 'seeduser' } = $seeduser;
116 :     }
117 :     }
118 :     }
119 : bartels 1.1 }
120 :    
121 : bartels 1.2 my ( $phylo, $row_ss_members ) = $self->get_phylo_groups();
122 :     $self->{ 'row_subset_members' } = $row_ss_members;
123 : bartels 1.1
124 :     #########
125 :     # TASKS #
126 :     #########
127 :    
128 : bartels 1.8 my ( $error, $comment ) = ( "", "" );
129 : bartels 1.1 if ( defined( $self->{ 'cgi' }->param( 'buttonpressed' ) ) && $self->{ 'cgi' }->param( 'buttonpressed' ) eq 'LimitSubsets' ) {
130 : bartels 1.8
131 : bartels 1.1 my @showsets = $self->{ 'cgi' }->param( 'show_set' );
132 :     my @collapsesets = $self->{ 'cgi' }->param( 'collapse_set' );
133 :     my @showrole = $self->{ 'cgi' }->param( 'show_role' );
134 :    
135 :     my $view;
136 : bartels 1.8
137 : bartels 1.1 foreach my $set ( @showsets ) {
138 :     $set =~ /show_set_(.*)/;
139 :     $view->{ 'Subsets' }->{ $1 }->{ 'visible' } = 1;
140 :     }
141 :     foreach my $set ( @collapsesets ) {
142 :     $set =~ /collapse_set_(.*)/;
143 :     $view->{ 'Subsets' }->{ $1 }->{ 'collapsed' } = 1;
144 :     }
145 :     foreach my $role ( @showrole ) {
146 :     $role =~ /show_role_(.*)\##-##(.*)/;
147 :     my $tmprole = $1.'##-##'.$2;
148 :     $view->{ 'Roles' }->{ $tmprole }->{ 'visible' } = 1;
149 :     $view->{ 'Roles' }->{ $tmprole }->{ 'subsystem' } = $2;
150 :     }
151 :     $self->{ 'metasubsystem' }->{ 'view' } = $view;
152 :     $self->{ 'metasubsystem' }->write_metasubsystem();
153 :     }
154 : bartels 1.4 elsif ( defined( $self->{ 'cgi' }->param( 'buttonpressed' ) ) && $self->{ 'cgi' }->param( 'buttonpressed' ) eq 'PLUSMINUS' ) {
155 :     $self->{ 'plusminus' } = 1;
156 :     }
157 :     elsif ( defined( $self->{ 'cgi' }->param( 'buttonpressed' ) ) && $self->{ 'cgi' }->param( 'buttonpressed' ) eq 'NOTPLUSMINUS' ) {
158 :     $self->{ 'plusminus' } = 0;
159 :     }
160 : bartels 1.8 elsif ( defined( $self->{ 'cgi' }->param( 'buttonpressed' ) ) && $self->{ 'cgi' }->param( 'buttonpressed' ) eq 'DeleteGenomes' ) {
161 :     my @genomesIds = $self->{ 'cgi' }->param( 'genome_checkbox' );
162 :     my ( $putcomment ) = $self->remove_genomes( \@genomesIds );
163 :     $comment .= $putcomment;
164 :     }
165 :     elsif ( defined( $self->{ 'cgi' }->param( 'buttonpressed' ) ) && $self->{ 'cgi' }->param( 'buttonpressed' ) eq 'Add selected genome(s) to spreadsheet' ) {
166 :     my @newGenomes = $self->{ 'cgi' }->param( 'new_genome' );
167 :     my $specialsetlist = $self->{ 'cgi' }->param( 'add_special_set' );
168 :     my $usersetlist = $self->{ 'cgi' }->param( 'add_user_set' );
169 :     my $ghash = {};
170 :     unless( $specialsetlist eq 'None' ) {
171 :     my @subsetspecial = $self->moregenomes( $specialsetlist );
172 :     my %tmpspecialhash = map { $_ => 1 } @subsetspecial;
173 :     $ghash = \%tmpspecialhash;
174 :     }
175 :     unless( $usersetlist eq 'None' ) {
176 :     $ghash = get_userlist_hash( $usersetlist, $ghash );
177 :     }
178 :    
179 :     # take only the fig-tax id from the genome label #
180 :     foreach my $g ( @newGenomes ) {
181 :     $ghash->{ $g } = 1;
182 :     }
183 :    
184 : bartels 1.9 my ( $puterror, $putcomment ) = $self->add_refill_genomes( $ghash );
185 : bartels 1.8 $error .= $puterror;
186 :     $comment .= $putcomment;
187 :     }
188 : bartels 1.2 if ( !defined( $self->{ 'activeSubsetHash' } ) ) {
189 :     $self->{ 'activeSubsetHash' } = $self->getActiveSubsetHash();
190 :     }
191 : bartels 1.8
192 : bartels 1.1 $self->get_metass_data();
193 : bartels 1.8
194 : bartels 1.1 ########
195 :     # Data #
196 :     ########
197 : bartels 1.8
198 : bartels 1.2 my ( $hiddenvalues ) = $self->load_subsystem_spreadsheet( $application, $preferences );
199 : bartels 1.8
200 : bartels 1.1 my $table = $self->application->component( 'SubsystemSpreadsheet' );
201 :     my $frtable = $self->application->component( 'FunctionalRolesTable' );
202 : bartels 1.8
203 : bartels 1.1 ######################
204 :     # Construct the menu #
205 :     ######################
206 : bartels 1.8
207 : bartels 1.1 my $menu = $self->application->menu();
208 : bartels 1.8
209 : bartels 1.1 # Build nice tab menu here
210 :     $menu->add_category( 'Meta Overview', "SubsysEditor.cgi?page=MetaOverview" );
211 : bartels 1.3 $menu->add_category( 'Info', "SubsysEditor.cgi?page=MetaInfo&metasubsystem=$esc_name" );
212 : bartels 1.2 $menu->add_category( 'Edit Subsets', "SubsysEditor.cgi?page=MetaSubsets&metasubsystem=$esc_name" );
213 : bartels 1.5 $menu->add_category( 'Add/Remove Subsystems', "SubsysEditor.cgi?page=MetaEditSubsystems&metasubsystem=$esc_name" );
214 : bartels 1.2 $menu->add_category( 'Spreadsheet', "SubsysEditor.cgi?page=MetaSpreadsheet&metasubsystem=$esc_name" );
215 : bartels 1.8
216 : bartels 1.1 ##############################
217 :     # Construct the page content #
218 :     ##############################
219 :    
220 :     # colorpanel #
221 :     my $colorpanel = $self->color_spreadsheet_panel( $preferences, $name );
222 :     # limitdisplaypanel #
223 :     my $limitdisplaypanel = $self->limit_display_panel();
224 :     my $limitsubsetspanel = $self->limit_subsets_panel();
225 : bartels 1.8 # addgenomespanel #
226 :     my $addgenomepanel = $self->add_genomes_panel( $application );
227 : bartels 1.1
228 : bartels 1.4 # spreadsheetbuttons #
229 :     my $spreadsheetbuttons = $self->get_spreadsheet_buttons();
230 :    
231 : bartels 1.1 my $tab_view_component = $self->application->component( 'functionTabView' );
232 :     $tab_view_component->width( 900 );
233 : bartels 1.3 if ( $self->{ 'can_alter' } ) {
234 : bartels 1.8 $tab_view_component->add_tab( '<H2>&nbsp; Add Genomes to Spreadsheet &nbsp;</H2>', "$addgenomepanel" );
235 : bartels 1.3 }
236 : bartels 1.1 $tab_view_component->add_tab( '<H2>&nbsp; Color Spreadsheet &nbsp;</H2>', "$colorpanel" );
237 :     $tab_view_component->add_tab( '<H2>&nbsp; Limit Genomes &nbsp;</H2>', "$limitdisplaypanel" );
238 :     $tab_view_component->add_tab( '<H2>&nbsp; Limit Subsets &nbsp;</H2>', "$limitsubsetspanel" );
239 :     $tab_view_component->add_tab( '<H2>&nbsp; Functional Roles &nbsp;</H2>', $frtable->output() );
240 : bartels 1.8 # $tab_view_component->add_tab( '<H2>&nbsp; Show Variants &nbsp;</H2>', "$variantpanel" );
241 :    
242 : bartels 1.1 if ( defined( $self->{ 'cgi' }->param( 'defaulttabhidden' ) ) ) {
243 :     $tab_view_component->default( $self->{ 'cgi' }->param( 'defaulttabhidden' ) );
244 :     }
245 :     else {
246 :     $tab_view_component->default( 0 );
247 :     }
248 :    
249 :     # add hidden parameter for the tab that is actually open #
250 :     my $dth = 0;
251 :     if ( defined( $self->{ 'cgi' }->param( 'defaulttabhidden' ) ) ) {
252 :     $dth = $self->{ 'cgi' }->param( 'defaulttabhidden' );
253 :     }
254 :    
255 :     $hiddenvalues->{ 'metasubsystem' } = $name;
256 :     $hiddenvalues->{ 'buttonpressed' } = 'none';
257 :     $hiddenvalues->{ 'defaulttabhidden' } = $dth;
258 : bartels 1.4 $hiddenvalues->{ 'PLUSMINUS' } = $self->{ 'plusminus' };
259 : bartels 1.1
260 :     ###########
261 :     # Content #
262 :     ###########
263 :    
264 :     my $content = "<H1>Subsystem Metaview for $ssname</H1>";
265 :    
266 : bartels 1.8 if ( defined( $comment ) && $comment ne '' ) {
267 :     my $info_component = $application->component( 'CommentInfo' );
268 :    
269 :     $info_component->content( $comment );
270 :     $info_component->default( 0 );
271 :     $content .= $info_component->output();
272 :     }
273 :    
274 : bartels 1.1 # start form #
275 :     $content .= $self->start_form( 'subsys_spreadsheet', $hiddenvalues );
276 :     $content .= "<TABLE><TR><TD>";
277 :    
278 :     $content .= $tab_view_component->output();
279 :     $content .= "</TD></TR><TR><TD>";
280 :     # put in color legends #
281 :     if ( defined( $self->{ 'legend' } ) ) {
282 :     $content .= $self->{ 'legend' };
283 :     $content .= "</TD></TR><TR><TD>";
284 :     }
285 :     if ( defined( $self->{ 'legendg' } ) ) {
286 :     $content .= $self->{ 'legendg' };
287 :     $content .= "</TD></TR><TR><TD>";
288 :     }
289 :    
290 : bartels 1.4 $content .= $spreadsheetbuttons;
291 :     $content .= "</TD></TR><TR><TD>";
292 : bartels 1.1 $content .= $table->output();
293 : bartels 1.4 $content .= "</TD></TR><TR><TD>";
294 :     $content .= $spreadsheetbuttons;
295 : bartels 1.1
296 :     $content .= "</TD></TR>";
297 :     $content .= "</TABLE>";
298 :    
299 :     # end form
300 :     $content .= $self->end_form();
301 :    
302 :     return $content;
303 :     }
304 :    
305 :     ##############################
306 :     # draw subsystem spreadsheet #
307 :     ##############################
308 :     sub load_subsystem_spreadsheet {
309 :     my ( $self, $application, $preferences ) = @_;
310 :    
311 :     # initialize roles, subsets and spreadsheet
312 :     my $roles = $self->{ 'data_roles' };
313 :     my $subsets = $self->{ 'data_subsets' };
314 :     my $spreadsheet_hash = $self->{ 'data_spreadsheethash' };
315 :     my $pegsarr = $self->{ 'data_allpegs' };
316 :    
317 :     my $user = $application->session->user();
318 :     my $seeduser = $self->{ 'seeduser' };
319 :     my $metass = $self->{ 'metasubsystem' };
320 :    
321 :    
322 :     # get a list of sane colors
323 :     my $colors = $self->get_colors();
324 :    
325 :     #####################################
326 :     # Displaying and Collapsing Subsets #
327 :     #####################################
328 :    
329 :     # Now - what roles or what subsets do I take?
330 :     my $role_to_group;
331 :     my $columns;
332 : bartels 1.2 my $visible;
333 : bartels 1.1 my $role_to_function;
334 :     my $function_to_role;
335 :     my $subsetssupercolumns = 0;
336 : bartels 1.2 my $roletosubsethidden;
337 :    
338 :     my $th = $metass->{ 'view' }->{ 'Roles' };
339 : bartels 1.1
340 : bartels 1.7 foreach my $subset ( sort keys %$subsets ) {
341 : bartels 1.2 foreach my $abb ( keys %{ $subsets->{ $subset } } ) {
342 :     push @{ $role_to_group->{ $abb } }, $subset;
343 :     $roletosubsethidden .= "$abb\t$subset\n";
344 :     }
345 :     $subsetssupercolumns++;
346 :     $columns->{ $subset } = scalar( keys %$columns );
347 : bartels 1.1 if ( $metass->{ 'view' }->{ 'Subsets' }->{ $subset }->{ 'visible' } ) {
348 :     if ( $metass->{ 'view' }->{ 'Subsets' }->{ $subset }->{ 'collapsed' } ) {
349 : bartels 1.2 $visible->{ $subset } = 1;
350 : bartels 1.1 }
351 :     else {
352 : bartels 1.2 my $ssvals = $subsets->{ $subset };
353 : bartels 1.1 }
354 :     }
355 :     }
356 :    
357 :     foreach my $role ( @$roles ) {
358 : bartels 1.2 my $rolesubsystem = $role->[0].'##-##'.$role->[3];
359 :     if ( defined( $th->{ $rolesubsystem } && $th->{ $rolesubsystem }->{ 'visible' } ) ) {
360 :     $visible->{ $rolesubsystem } = 1;
361 :     }
362 :     if ( defined( $role_to_group->{ $rolesubsystem } ) ) {
363 :     $visible->{ $rolesubsystem } = 1;
364 : bartels 1.1
365 : bartels 1.2 my @sss = @{ $role_to_group->{ $rolesubsystem } };
366 :     foreach my $ss ( @sss ) {
367 :     if ( $metass->{ 'view' }->{ 'Subsets' }->{ $ss }->{ 'visible' } ) {
368 :     if ( $metass->{ 'view' }->{ 'Subsets' }->{ $ss }->{ 'collapsed' } ) {
369 :     $visible->{ $rolesubsystem } = 0;
370 :     }
371 :     }
372 :     }
373 :     }
374 : bartels 1.1
375 :     $role_to_function->{ $rolesubsystem } = $role->[1];
376 :     $function_to_role->{ $role->[1] } = $role->[2];
377 :    
378 : bartels 1.2 $columns->{ $rolesubsystem } = scalar( keys %$columns );
379 : bartels 1.1 }
380 :    
381 :     ##########################################
382 :     # COLORING SETTINGS OF GENES AND GENOMES #
383 :     ##########################################
384 :     my $peg_to_color_alround;
385 :     my $cluster_colors_alround = {};
386 :     my $genome_colors;
387 :     my $genomes_to_color = {};
388 :     my $columnNameHash;
389 :     my $ind_to_subset;
390 :     my $name = $self->{ 'cgi' }->param( 'metasubsystem' );
391 :    
392 :     ### COLOR GENES ###
393 :     my $color_by = 'do not color'; #default
394 :     if ( $preferences->{ $name."_color_stuff" } ) {
395 :     $color_by = $preferences->{ $name."_color_stuff" }->value;
396 :     }
397 :     if ( defined( $self->{ 'cgi' }->param( 'color_stuff' ) ) ) {
398 :     $color_by = $self->{ 'cgi' }->param( 'color_stuff' );
399 :     unless ( $preferences->{ $name."_color_stuff" } ) {
400 :     if ( defined( $user ) && ref( $user ) ) {
401 :     $preferences->{ $name."_color_stuff" } = $self->application->dbmaster->Preferences->create( { user => $user,
402 :     application => $self->application->backend,
403 :     name => $name."_color_stuff",
404 :     value => $color_by } );
405 :     }
406 :     }
407 :     else {
408 :     $preferences->{ $name."_color_stuff" }->value( $color_by );
409 :     }
410 :     }
411 :     elsif ( $preferences->{ $name."_color_stuff" } ) {
412 :     $self->{ 'cgi' }->param( 'color_stuff', $preferences->{ $name."_color_stuff" }->value );
413 :     }
414 :    
415 :     if ( $color_by eq 'by attribute: ' ) {
416 :     my $attr = 'Essential_Gene_Sets_Bacterial';
417 :    
418 :     if ( $preferences->{ $name."_color_by_peg_tag" } ) {
419 :     $attr = $preferences->{ $name."_color_by_peg_tag" }->value;
420 :     }
421 :     if ( defined( $self->{ 'cgi' }->param( 'color_by_peg_tag' ) ) ) {
422 :     $attr = $self->{ 'cgi' }->param( 'color_by_peg_tag' );
423 :     unless ( $preferences->{ $name."_color_by_peg_tag" } ) {
424 :     if ( $user ) {
425 :     $preferences->{ $name."_color_by_peg_tag" } = $self->application->dbmaster->Preferences->create( { user => $user,
426 :     application => $self->application->backend,
427 :     name => $name."_color_by_peg_tag",
428 :     value => $attr } );
429 :     }
430 :     }
431 :     else {
432 :     $preferences->{ $name."_color_by_peg_tag" }->value( $attr );
433 :     }
434 :     }
435 :    
436 :     ( $peg_to_color_alround, $cluster_colors_alround ) = $self->get_color_by_attribute_infos( $attr, $pegsarr, $colors );
437 :     }
438 :    
439 :     ### COLOR GENOMES ###
440 :     my $colorg_by = 'do not color';
441 :     if ( $preferences->{ $name."_colorg_stuff" } ) {
442 :     $colorg_by = $preferences->{ $name."_colorg_stuff" }->value;
443 :     }
444 :     if ( defined( $self->{ 'cgi' }->param( 'colorg_stuff' ) ) ) {
445 :     $colorg_by = $self->{ 'cgi' }->param( 'colorg_stuff' );
446 :     unless ( $preferences->{ $name."_colorg_stuff" } ) {
447 :     if ( $user ) {
448 :     $preferences->{ $name."_colorg_stuff" } = $self->application->dbmaster->Preferences->create( { user => $user,
449 :     application => $self->application->backend,
450 :     name => $name."_colorg_stuff",
451 :     value => $color_by } );
452 :     }
453 :     }
454 :     else {
455 :     $preferences->{ $name."_colorg_stuff" }->value( $colorg_by );
456 :     }
457 :     }
458 :     elsif ( $preferences->{ $name."_colorg_stuff" } ) {
459 :     $self->{ 'cgi' }->param( 'colorg_stuff', $preferences->{ $name."_colorg_stuff" }->value );
460 :     }
461 :    
462 :     if ( $colorg_by eq 'by attribute: ' ) {
463 :    
464 :     my $attr;
465 :     if ( $preferences->{ $name."_color_by_ga" } ) {
466 :     $attr = $preferences->{ $name."_color_by_ga" }->value;
467 :     }
468 :    
469 :     if ( defined( $self->{ 'cgi' }->param( 'color_by_ga' ) ) && $self->{ 'cgi' }->param( 'color_by_ga' ) ne '' ) {
470 :     $attr = $self->{ 'cgi' }->param( 'color_by_ga' );
471 :    
472 :     unless ( $preferences->{ $name."_color_by_ga" } ) {
473 :     if ( $user ) {
474 :     $preferences->{ $name."_color_by_ga" } = $self->application->dbmaster->Preferences->create( { user => $user,
475 :     application => $self->application->backend,
476 :     name => $name."_color_by_ga",
477 :     value => $attr } );
478 :     }
479 :     }
480 :     elsif ( defined( $attr ) ) {
481 :     $preferences->{ $name."_color_by_ga" }->value( $attr );
482 :     $self->{ 'cgi' }->param( 'color_by_ga', $attr );
483 :     }
484 :     ( $genomes_to_color, $genome_colors ) = $self->get_color_by_attribute_infos_for_genomes( $spreadsheet_hash, $colors );
485 :     }
486 :     }
487 :    
488 :     ## END OF COLORING SETTINGS ##
489 :    
490 :     ################################
491 :     # Creating the table from here #
492 :     ################################
493 :    
494 : bartels 1.2 my $javascriptstring = '';
495 :    
496 : bartels 1.1 # create table headers
497 :     my $table_columns = [ '',
498 :     { name => 'Organism', filter => 1, sortable => 1, width => '150', operand => $self->{ 'cgi' }->param( 'filterOrganism' ) || '' },
499 :     { name => 'Domain', filter => 1, operator => 'combobox', operand => $self->{ 'cgi' }->param( 'filterDomain' ) || '' },
500 :     { name => 'Taxonomy', sortable => 1, visible => 0, show_control => 1 },
501 :     { name => 'Variant', sortable => 1 }
502 :     ];
503 :    
504 : bartels 1.5 my $supercolumns = [ [ '', 1 ], [ '', 1 ], [ '', 1 ], [ '', 1 ], [ '', 1 ] ];
505 : bartels 1.6
506 :     # if user can write he gets a writable variant column that if first invisible
507 :     if ( $self->{ 'can_alter' } ) {
508 :     push @$table_columns, { name => 'Variant', visible => 0 };
509 :     push @$supercolumns, [ '', 1 ];
510 :     }
511 : bartels 1.1
512 :     if ( $subsetssupercolumns > 0 ) {
513 :     push @$supercolumns, [ 'Subsets', $subsetssupercolumns ];
514 :     }
515 :     my $supercolstobe;
516 :    
517 :     my $ii = 4; # this is for keeping in mind in what column we start the Functional Roles
518 :     if ( $self->{ 'can_alter' } ) {
519 :     $ii++;
520 :     }
521 :    
522 :     my $i = $ii;
523 :    
524 :     ### Now add the column headers for all functional roles or subsets of the table ###
525 :     foreach my $column ( sort { $columns->{ $a } <=> $columns->{ $b } } keys( %$columns) ) {
526 :     $i++;
527 :    
528 :     if ( exists( $role_to_function->{ $column } ) ) {
529 :     $column =~ /(.*)\#\#\-\#\#(.*)/;
530 :     my $colrole = $1;
531 :     my $ss_of_role = $2;
532 :     my $tooltip = "<TABLE><TR><TH>Role</TH><TH>Subsystem</TH></TR>\n";
533 : bartels 1.4 $tooltip .= "<TR><TD>".$role_to_function->{ $column }."</TD><TD>$ss_of_role</TD></TR></TABLE>";
534 : bartels 1.2 # if ( $visible->{ $column } ) {
535 :     push @$supercolstobe, [ $ss_of_role, 1 ];
536 :     # }
537 : bartels 1.4 push( @$table_columns, { name => $colrole, tooltip => $tooltip, visible => $visible->{ $column } || 0 } );
538 : bartels 1.1 $columnNameHash->{ $i } = $colrole.'<BR>'.$tooltip;
539 : bartels 1.2 $javascriptstring .= "\n$column\t$i";
540 : bartels 1.1 $ind_to_subset->{ $i } = 1;
541 :     }
542 :     else {
543 :     my $tooltip = "<table>";
544 : bartels 1.2 $tooltip .= "<tr><th colspan=2>Subset $column</th></tr>";
545 : bartels 1.1 foreach my $role ( keys %{ $subsets->{ $column } } ) {
546 : bartels 1.2 $role =~ /(.*)##-##(.*)/;
547 :     $tooltip .= "<tr><td>$1</td><td><b>$2</b></td></tr>";
548 : bartels 1.1 }
549 :     $tooltip .= "</table>";
550 : bartels 1.4 push( @$table_columns, { name => $column, tooltip => $tooltip, visible => $visible->{ $column } || 0 } );
551 : bartels 1.1 $columnNameHash->{ $i } = $column.'<BR>'.$tooltip;
552 : bartels 1.2 $javascriptstring .= "\n$column\t$i";
553 : bartels 1.1 }
554 :     }
555 :     push( @$table_columns, { name => 'Pattern', sortable => 1, visible => 0, show_control => 1 });
556 :    
557 :    
558 :     # Variants - default is not to show the -1 variants, so we have to ask if that is still true.
559 :     my $show_mo_variants = 0;
560 :     if ( defined( $self->{ 'cgi' }->param( 'buttonpressed' ) ) && $self->{ 'cgi' }->param( 'buttonpressed' ) eq 'MoVariants' || $self->{ 'cgi' }->param( 'showMoVariants' ) ) {
561 :     $show_mo_variants = 1;
562 :     }
563 : bartels 1.10 if ( defined( $self->{ 'cgi' }->param( 'buttonpressed' ) ) && $self->{ 'cgi' }->param( 'buttonpressed' ) eq 'HideOneMOVariants' ) {
564 :     $show_mo_variants = -1;
565 :     }
566 :     if ( defined( $self->{ 'cgi' }->param( 'buttonpressed' ) ) && $self->{ 'cgi' }->param( 'buttonpressed' ) eq 'HideAllMOVariants' ) {
567 : bartels 1.1 $show_mo_variants = 0;
568 :     }
569 :    
570 :     # For the lines of the table, walk through spreadsheet hash #
571 :     my $pretty_spreadsheet;
572 :    
573 :     my @sortedrows;
574 :    
575 :     if ( $preferences->{ 'sort_spreadsheet_by' } && $preferences->{ 'sort_spreadsheet_by' }->value() eq 'alphabetically' ) {
576 :     @sortedrows = sort { $spreadsheet_hash->{ $a }->{ 'name' } cmp $spreadsheet_hash->{ $b }->{ 'name' } } keys %$spreadsheet_hash;
577 :     }
578 :     else {
579 :     @sortedrows = sort { $spreadsheet_hash->{ $a }->{ 'taxonomy' } cmp $spreadsheet_hash->{ $b }->{ 'taxonomy' } } keys %$spreadsheet_hash;
580 :     }
581 :    
582 :     foreach my $g ( @sortedrows ) {
583 :    
584 : bartels 1.2 if ( defined( $self->{ 'activeSubsetHash' } ) ) {
585 :     next unless ( $self->{ 'activeSubsetHash' }->{ $g } );
586 :     }
587 :    
588 : bartels 1.1 my $new_row;
589 :    
590 :     # organism name, domain, taxonomy, variantcode #
591 :     my $gname = $spreadsheet_hash->{ $g }->{ 'name' };
592 :     my $domain = $spreadsheet_hash->{ $g }->{ 'domain' };
593 :     my $tax = $spreadsheet_hash->{ $g }->{ 'taxonomy' };
594 :     my $variant = $spreadsheet_hash->{ $g }->{ 'variant' };
595 :    
596 : bartels 1.10 if ( $show_mo_variants ne '1' ) {
597 :     # need a new way to handle variants here.
598 :     my @var_subs = split( "\_", $variant );
599 :     my $countvars = 0;
600 :     foreach my $vs ( @var_subs ) {
601 :     if ( $vs eq '-1' ) {
602 :     $countvars++;
603 :     }
604 :     }
605 :     if ( $show_mo_variants == -1 && $countvars > 0 ) {
606 :     next;
607 :     }
608 :     if ( $show_mo_variants == 0 && $countvars == scalar( @var_subs ) ) {
609 :     next;
610 :     }
611 : bartels 1.1 }
612 : bartels 1.10
613 :    
614 : bartels 1.1
615 :     # add link to Organism page here #
616 :     $gname = "<A HREF='seedviewer.cgi?page=Organism&organism=" . $g."' target=_blank>$gname</A>";
617 :    
618 :     my $gentry = $gname;
619 :     if ( defined( $genomes_to_color->{ $g } ) ) {
620 :     $gentry = "<span style='background-color: " . $genome_colors->{ $genomes_to_color->{ $g } } . ";'>$gname</span>";
621 :     }
622 :    
623 :     my $genome_checkbox = $self->{ 'cgi' }->checkbox( -name => 'genome_checkbox',
624 :     -id => "genome_checkbox_$g",
625 :     -value => "genome_checkbox_$g",
626 :     -label => '',
627 :     -checked => 0,
628 :     -override => 1,
629 :     );
630 :    
631 :     push( @$new_row, $genome_checkbox );
632 :     push( @$new_row, $gentry );
633 :     push( @$new_row, $domain );
634 :     push( @$new_row, $tax );
635 :     push( @$new_row, $variant );
636 :     if ( $self->{ 'can_alter' } ) {
637 :     push( @$new_row, "<INPUT TYPE=TEXT NAME=\"variant$g\" SIZE=5 VALUE=\"$variant\">" );
638 :     }
639 :    
640 :     # now the genes #
641 :     my $thisrow = $spreadsheet_hash->{ $g }->{ 'row' };
642 :     my @row = @$thisrow;
643 :    
644 :     # memorize all pegs of this row
645 :     my $pegs;
646 :     my $rawpegs;
647 :    
648 :     # go through data cells and do grouping
649 :     my $data_cells;
650 :    
651 :     for ( my $i=0; $i<scalar( @row ); $i++ ) {
652 :     push( @$pegs, split( /, /, $row[$i] ) );
653 :    
654 :     my $roleident = $roles->[$i]->[0].'##-##'.$roles->[$i]->[3];
655 :    
656 :     if ( exists( $role_to_group->{ $roleident } ) ) {
657 :     my $subsetsofthisrole = $role_to_group->{ $roleident };
658 :    
659 :     my $thiscell = '';
660 :     foreach my $ss ( @$subsetsofthisrole ) {
661 :     my $index = $columns->{ $ss };
662 :     unless ( $row[$i] =~ /INPUT/ ) {
663 :     push( @{ $data_cells->[ $index ] }, split( /, /, $row[$i] ) );
664 :     }
665 :     }
666 :     }
667 : bartels 1.2 # else {
668 : bartels 1.1 my $index = $columns->{ $roleident };
669 :     push( @{ $data_cells->[ $index ] }, split( /, /, $row[$i] ) );
670 :     }
671 : bartels 1.2 # }
672 : bartels 1.1
673 :     foreach my $p ( @$pegs ) {
674 :     if ( $p =~ /(fig\|\d+\.\d+\.peg\.\d+)/ ) {
675 :     push @$rawpegs, $p;
676 :     }
677 :     }
678 :    
679 :     my $peg_to_color;
680 :     my $cluster_colors;
681 :    
682 :     # if we wanna color by cluster put it in here
683 :     if ( $color_by eq 'by cluster' ) {
684 :    
685 :     # compute clusters
686 :     my @clusters = $self->{ 'fig' }->compute_clusters( $rawpegs, undef, 5000 );
687 :    
688 :     for ( my $i = 0; $i < scalar( @clusters ); $i++ ) {
689 :    
690 :     my %countfunctions = map{ (scalar $self->{ 'fig' }->function_of( $_ ) => 1 ) } @{ $clusters[ $i ] };
691 :     next unless ( scalar( keys %countfunctions ) > 1);
692 :    
693 :     foreach my $peg ( @{ $clusters[ $i ] } ) {
694 :     $peg_to_color->{ $peg } = $i;
695 :     }
696 :     }
697 :     }
698 :     elsif ( $color_by eq 'by attribute: ' ) {
699 :     $peg_to_color = $peg_to_color_alround;
700 :     $cluster_colors = $cluster_colors_alround;
701 :     }
702 :    
703 : olson 1.13
704 : bartels 1.1 # print actual cells
705 :     my $pattern = "a";
706 :     my $ind = $ii;
707 :     foreach my $data_cell ( @$data_cells ) {
708 :     $ind++;
709 :     my $num_clustered = 0;
710 :     my $num_unclustered = 0;
711 :     my $cluster_num = 0;
712 :     if ( defined( $data_cell ) ) {
713 :     $data_cell = [ sort( @$data_cell ) ];
714 : bartels 1.2 my $cell = {};
715 : bartels 1.1
716 : olson 1.13 #
717 :     # If we have a zero variant, force the subset column for that
718 :     # subsystem to -.
719 :     #
720 :    
721 :     if ($self->{plusminus})
722 :     {
723 :     my $si = $ind - $ii - 1;
724 :     my $there;
725 :     my @var_subs = split( "\_", $variant );
726 :    
727 :     if ($si < @var_subs && $var_subs[$si] eq '0')
728 :     {
729 :     $there = '-';
730 :     }
731 :     else
732 :     {
733 :     $there = ((@$data_cell) > 0) ? '+' : '-';
734 :     }
735 :     my $tt = $columnNameHash->{ $ind };
736 :     push( @$new_row, { data => $there, tooltip => $tt } );
737 : bartels 1.4 }
738 :     else {
739 :     foreach my $peg ( @$data_cell ) {
740 : bartels 1.1
741 : bartels 1.4 if ( $peg =~ /(fig\|\d+\.\d+\.peg\.\d+)/ ) {
742 :     my $thispeg = $1;
743 :     my $pegf = $self->{ 'fig' }->function_of( $thispeg );
744 :     my $pegfnum = '';
745 :    
746 :     if ( !defined( $thispeg ) ) {
747 :     next;
748 :     }
749 :    
750 :     $thispeg =~ /fig\|\d+\.\d+\.peg\.(\d+)/;
751 :     my $n = $1;
752 :    
753 :     my $peg_link = $self->fid_link( $thispeg );
754 :     $peg_link = "<A HREF='$peg_link' target=_blank>$n</A>";
755 :     unless ( $ind_to_subset->{ $ind } ) {
756 :     my $add_to_peg = $self->get_peg_addition( $pegf );
757 :     $peg_link .= $add_to_peg;
758 :     }
759 :    
760 :     if ( exists( $peg_to_color->{ $peg } ) ) {
761 :     unless ( defined( $cluster_colors->{ $peg_to_color->{ $peg } } ) ) {
762 :     $cluster_colors->{ $peg_to_color->{ $peg } } = $colors->[ scalar( keys( %$cluster_colors ) ) ];
763 :     }
764 :     $cluster_num = scalar( keys( %$cluster_colors ) );
765 :     $num_clustered++;
766 :     $cell->{ "<span style='background-color: " . $cluster_colors->{ $peg_to_color->{ $peg } } . ";'>$peg_link</span>" } = 1;
767 :     }
768 :     else {
769 :     $num_unclustered++;
770 :     $cell->{ "<span>$peg_link</span>" } = 1;
771 : bartels 1.1 }
772 :     }
773 :     else {
774 : bartels 1.4 $cell->{ $peg } = 1;
775 : bartels 1.1 }
776 :     }
777 : bartels 1.4 my $tt = $columnNameHash->{ $ind };
778 :     push( @$new_row, { data => join( '<br>', keys %$cell ), tooltip => $tt } );
779 : bartels 1.1 }
780 :     }
781 :     else {
782 :     my $tt = $columnNameHash->{ $ind };
783 :     push( @$new_row, { data => '', tooltip => $tt } );
784 :     }
785 :     $pattern .= $num_clustered.$num_unclustered.$cluster_num;
786 :     }
787 :     # pattern
788 :     push(@$new_row, $pattern);
789 :    
790 :     # push row to table
791 :     push(@$pretty_spreadsheet, $new_row);
792 :     }
793 :    
794 :     ### create table from parsed data ###
795 :    
796 :     my $table = $application->component( 'SubsystemSpreadsheet' );
797 :     $table->columns( $table_columns );
798 :     $table->data( $pretty_spreadsheet );
799 :     $table->show_top_browse( 1 );
800 :     $table->show_export_button( { strip_html => 1,
801 :     hide_invisible_columns => 1,
802 :     title => 'Export plain data to Excel' } );
803 :    
804 :     my $ss;
805 :     my $ssval = 0;
806 :     foreach my $thisarr ( @$supercolstobe ) {
807 :     if ( !defined( $ss ) ) {
808 :     $ss = $thisarr->[0];
809 :     $ssval++;
810 :     }
811 :     elsif ( $ss eq $thisarr->[0] ) {
812 :     $ssval++;
813 :     }
814 :     else {
815 :     my $nicess = $ss;
816 :     $nicess =~ s/\_/ /g;
817 :     push @$supercolumns, [ $nicess, $ssval ];
818 :     $ss = $thisarr->[0];
819 :     $ssval = 1;
820 :     }
821 :     }
822 :     if ( defined( $ss ) ) {
823 :     my $nicess = $ss;
824 :     $nicess =~ s/\_/ /g;
825 :     push @$supercolumns, [ $nicess, $ssval ];
826 :     }
827 :    
828 :     $table->supercolumns( $supercolumns );
829 :    
830 :     $table->show_select_items_per_page( 1 );
831 :    
832 :     ### remember some hidden values ###
833 :    
834 :     my $hiddenvalues = { 'filterOrganism' => '',
835 :     'sortOrganism' => '',
836 :     'filterDomain' => '',
837 :     'tableid' => $table->id,
838 : bartels 1.2 'showMoVariants' => $show_mo_variants,
839 :     'javascripthidden' => $javascriptstring,
840 :     'roletosubsethidden' => $roletosubsethidden };
841 : bartels 1.1
842 :     # finished
843 : bartels 1.2 return ( $hiddenvalues );
844 : bartels 1.1 }
845 :    
846 :    
847 :     ######################################
848 :     # Panel for coloring the spreadsheet #
849 :     ######################################
850 :     sub color_spreadsheet_panel {
851 :    
852 :     my ( $self, $preferences, $name ) = @_;
853 :    
854 :     my $content = "<H2>Color genes in spreadsheet</H2>";
855 :    
856 :     my $default_coloring = $self->{ 'cgi' }->param( 'color_stuff' ) || 'do not color';
857 :    
858 :     if ( !defined( $self->{ 'cgi' }->param( 'color_by_peg_tag' ) ) && defined( $preferences->{ $name."_color_by_peg_tag" } ) ) {
859 :     $self->{ 'cgi' }->param( 'color_by_peg_tag', $preferences->{ $name."_color_by_peg_tag" }->value );
860 :     }
861 :    
862 :     my $defaultg_coloring = 'do not color';
863 :     if ( defined( $self->{ 'cgi' }->param( 'colorg_stuff' ) ) ) {
864 :     $defaultg_coloring = $self->{ 'cgi' }->param( 'colorg_stuff' );
865 :     }
866 :    
867 :     my @color_opt = $self->{ 'cgi' }->radio_group( -name => 'color_stuff',
868 :     -values => [ 'do not color', 'by cluster', 'by attribute: ' ],
869 :     -default => $default_coloring,
870 :     -override => 1
871 :     );
872 :    
873 :     my @pegkeys = $self->{ 'fig' }->get_peg_keys();
874 :     push @pegkeys, 'Expert_Annotations';
875 :    
876 :     # Compile and order the attribute keys found on pegs:
877 :     my $high_priority = qr/(essential|fitness)/i;
878 :     my @options = sort { $b =~ /$high_priority/o <=> $a =~ /$high_priority/o
879 :     || uc( $a ) cmp uc( $b )
880 :     }
881 :     @pegkeys;
882 :     my $blacklist = attribute_blacklist();
883 :    
884 :     @options = grep { !$blacklist->{ $_ } } @options;
885 :     unshift @options, undef; # Start list with empty
886 :    
887 :     my $att_popup = $self->{ 'cgi' }->popup_menu(-name => 'color_by_peg_tag', -values => \@options);
888 :    
889 :     $content .= join( "<BR>\n", @color_opt );
890 :     $content .= $att_popup;
891 :    
892 :     $content .= "<H2>Color genomes in spreadsheet</H2>";
893 :    
894 :     my @goptions = sort { uc( $a ) cmp uc( $b ) } $self->{ 'fig' }->get_genome_keys(); # get all the genome keys
895 :     unshift @goptions, undef; # a blank field at the start
896 :    
897 :     my @colorg_opt = $self->{ 'cgi' }->radio_group( -name => 'colorg_stuff',
898 :     -values => [ 'do not color', 'by attribute: ' ],
899 :     -default => $defaultg_coloring,
900 :     -override => 1
901 :     );
902 :    
903 :     my $genome_popup = $self->{ 'cgi' }->popup_menu( -name => 'color_by_ga', -values => \@goptions );
904 :     $content .= join( "<BR>\n", @colorg_opt );
905 :     $content .= $genome_popup;
906 :     if ( $self->{ 'can_alter' } ) {
907 :     $content .= "<BR><BR><INPUT TYPE=BUTTON VALUE='Color Spreadsheet' ONCLICK='SubmitSpreadsheet( \"Color Spreadsheet\", 1 );'>";
908 :     }
909 :     else {
910 :     $content .= "<BR><BR><INPUT TYPE=BUTTON VALUE='Color Spreadsheet' ONCLICK='SubmitSpreadsheet( \"Color Spreadsheet\", 0 );'>";
911 :     }
912 :    
913 :     return $content;
914 :     }
915 :    
916 :     ###############
917 :     # data method #
918 :     ###############
919 :     sub get_metass_data {
920 :    
921 :     my ( $self ) = @_;
922 :    
923 :     my $meta = $self->{ 'metasubsystem' };
924 :    
925 :     my $subsystems = $meta->{ 'subsystems' };
926 :    
927 :     my ( $subsets, $spreadsheet, $allpegs );
928 :     my $counter = 0;
929 :     my @roles;
930 :     my %spreadsheethash;
931 :     my @supercolumns;
932 :    
933 :     my $frtable = $self->application->component( 'FunctionalRolesTable' );
934 :     $frtable->columns( [ '#', 'Subsystem', 'Abbr.', 'Role Name' ] );
935 :     my $frtablerows;
936 :    
937 :     my @genomes = keys %{ $meta->{ 'genomes' } };
938 :     my $role_counter = 0;
939 :    
940 :     foreach my $ssname ( keys %$subsystems ) {
941 :     my $subsystem = $subsystems->{ $ssname };
942 : bartels 1.9 my $esc_ssname = uri_escape( $ssname );
943 :     my $sslink = qq~<A HREF=\"SubsysEditor.cgi?page=ShowSpreadsheet&subsystem=$ssname\" target=_blank>$ssname</A>~;
944 : bartels 1.1
945 :     $counter ++;
946 :    
947 :     ## get da roles ##
948 :     my @rs = $subsystem->get_roles();
949 :     foreach my $r ( @rs ) {
950 :     $role_counter++;
951 :     my $abb = $subsystem->get_abbr_for_role( $r );
952 :     my $in = $subsystem->get_role_index( $r );
953 :     push @{ $self->{ 'roles_to_num' }->{ $r } }, [ $role_counter, $abb.'##-##'.$ssname ];
954 :     # $self->{ 'abb_ss_to_num' }->{ $abb.'##-##'.$ssname } = $role_counter;
955 :    
956 :    
957 :     push @roles, [ $abb, $r, $in, $ssname ];
958 : bartels 1.9 push @$frtablerows, [ $role_counter, $sslink, $abb, $r ];
959 : bartels 1.1 }
960 :    
961 :     foreach my $genome ( @genomes ) {
962 :     my $gidx = $subsystem->get_genome_index( $genome );
963 :    
964 :     $spreadsheethash{ $genome }->{ 'name' } = $self->{ 'fig' }->genus_species( $genome );
965 :     $spreadsheethash{ $genome }->{ 'domain' } = $self->{ 'fig' }->genome_domain( $genome );
966 :     $spreadsheethash{ $genome }->{ 'taxonomy' } = $self->{ 'fig' }->taxonomy_of( $genome );
967 :    
968 :     my $var = $subsystem->get_variant_code( $gidx );
969 :     if ( !defined( $gidx ) ) {
970 :     $var = '-';
971 :     }
972 :     if ( defined( $spreadsheethash{ $genome }->{ 'variant' } ) ) {
973 :     $spreadsheethash{ $genome }->{ 'variant' } .= "_$var";
974 :     }
975 :     else {
976 :     $spreadsheethash{ $genome }->{ 'variant' } = $var;
977 :     }
978 :    
979 :     my $rowss = $subsystem->get_row( $gidx );
980 :     my @row;
981 :    
982 :     foreach my $tr ( @$rowss ) {
983 :     if ( !defined( $gidx ) ) {
984 :     push @row, '';
985 :     }
986 :     else {
987 :     if ( defined( $tr->[0] ) ) {
988 :     push @$allpegs, @$tr;
989 :     push @row, join( ', ', @$tr );
990 :     }
991 :     else {
992 :     push @row, '';
993 :     }
994 :     }
995 :     }
996 :    
997 :     push @{ $spreadsheethash{ $genome }->{ 'row' } }, @row;
998 :     }
999 :    
1000 :     $frtable->data( $frtablerows );
1001 :    
1002 :     }
1003 :    
1004 :     ## now get da subsets ##
1005 :     my @subsetArr = keys %{ $meta->{ 'subsets' } };
1006 :    
1007 :     foreach my $subsetname ( @subsetArr ) {
1008 :     next if ( $subsetname eq 'All' );
1009 :     my @abb_subsets = keys %{ $meta->{ 'subsets' } };
1010 :    
1011 :     $subsets->{ $subsetname } = $meta->{ 'subsets' }->{ $subsetname };
1012 :     }
1013 :    
1014 :     $self->{ 'data_roles' } = \@roles;
1015 :     $self->{ 'data_subsets' } = $subsets;
1016 :     $self->{ 'data_spreadsheethash' } = \%spreadsheethash;
1017 :     $self->{ 'data_allpegs' } = $allpegs;
1018 :    
1019 :     }
1020 :    
1021 :     ######################################
1022 :     # Panel for coloring the spreadsheet #
1023 :     ######################################
1024 :     sub limit_display_panel {
1025 :    
1026 :     my ( $self ) = @_;
1027 :    
1028 :     # create a new subsystem object #
1029 :     my $subsets = $self->{ 'metasubsystem' }->{ 'subsets' };
1030 :    
1031 :     # my @tmp = grep { $_ ne "All" } sort $subsystem->get_subset_namesR;
1032 :     my $genomes = $self->{ 'metasubsystem' }->{ 'genomes' };
1033 :    
1034 :     my %options = ( "higher_plants" => "Higher Plants",
1035 :     "eukaryotic_ps" => "Photosynthetic Eukaryotes",
1036 :     "nonoxygenic_ps" => "Anoxygenic Phototrophs",
1037 :     "hundred_hundred" => "Hundred by a hundred",
1038 :     "functional_coupling_paper" => "Functional Coupling Paper",
1039 :     "cyano_or_plant" => "Cyanos OR Plants",
1040 :     "ecoli_essentiality_paper" => "E. coli Essentiality Paper",
1041 :     "has_essentiality_data" => "Genomes with essentiality data",
1042 :     "" => "All"
1043 :     );
1044 :    
1045 :     my @options = ( 'All',
1046 :     'NMPDR',
1047 :     'BRC',
1048 :     'Hundred by a hundred' );
1049 :    
1050 :     my @genomeListsUser = GenomeLists::getListsForUser();
1051 :     unshift @genomeListsUser, 'All';
1052 :    
1053 :     my @allsets = keys %$subsets;
1054 :     my @starsets = @allsets;
1055 :    
1056 :     my $content .= "<P>Limit display of the the genomes in the table based on phylogeny or one of the preselected groups in the left box. Limit display of roles via their subsets and decide which subsets you want to uncollapse in the right box:<P>\n";
1057 :    
1058 :     # put in table #
1059 :     $content .= "<TABLE><TR><TD>";
1060 :    
1061 :     # build a little table for the genomes limiting
1062 :     $content .= "<H2>&nbsp; Limit displayed Genomes</H2><TABLE><TR><TD>";
1063 :    
1064 :     $content .= "<B>Phylogeny</B></TD><TD><B>Specific Sets</B></TD><TD><B>User Sets</B></TD></TR><TR><TD>";
1065 :    
1066 :     # phylogeny here #
1067 : bartels 1.2 my ( $phylo, $row_ss_members ) = $self->get_phylo_groups();
1068 :     # $self->{ 'row_subset_members' } = $row_ss_members;
1069 : bartels 1.1 $content .= $self->{ 'cgi' }->scrolling_list( -id => 'phylogeny_set',
1070 :     -name => 'phylogeny_set',
1071 : bartels 1.2 -values => [ "All", sort @$phylo ],
1072 : bartels 1.1 -default => 'All',
1073 :     -size => 5
1074 :     );
1075 :     $content .= "</TD><TD>\n";
1076 :    
1077 :     # now special sets #
1078 :     $content .= $self->{ 'cgi' }->scrolling_list( -id => 'special_set',
1079 :     -name => 'special_set',
1080 :     -values => \@options,
1081 :     -default => 'All',
1082 :     -size => 5
1083 :     );
1084 :     $content .= "</TD><TD>\n";
1085 :    
1086 :     # now special sets #
1087 :     $content .= $self->{ 'cgi' }->scrolling_list( -id => 'user_set',
1088 :     -name => 'user_set',
1089 :     -values => \@genomeListsUser,
1090 :     -default => 'All',
1091 :     -size => 5
1092 :     );
1093 :     $content .= "</TD></TR></TABLE>\n";
1094 :     $content .= "</TD></TR>\n</TABLE>";
1095 :    
1096 :     if ( $self->{ 'can_alter' } ) {
1097 : bartels 1.2 $content .= "<BR><BR><INPUT TYPE=BUTTON VALUE='Limit Display' ONCLICK='SubmitSpreadsheet( \"LimitDisplay\", 1 );'>";
1098 : bartels 1.1 }
1099 :     else {
1100 : bartels 1.2 $content .= "<BR><BR><INPUT TYPE=BUTTON VALUE='Limit Display' ONCLICK='SubmitSpreadsheet( \"LimitDisplay\", 1 );'>";
1101 : bartels 1.1 }
1102 :    
1103 :     return $content;
1104 :     }
1105 :    
1106 :    
1107 :     ######################################
1108 :     # Panel for coloring the spreadsheet #
1109 :     ######################################
1110 :     sub limit_subsets_panel {
1111 :    
1112 :     my ( $self ) = @_;
1113 :    
1114 :     # create a new subsystem object #
1115 :     my $subsets = $self->{ 'metasubsystem' }->{ 'subsets' };
1116 :    
1117 :     my @allsets = keys %$subsets;
1118 :     my @starsets = @allsets;
1119 :    
1120 :     my @roles = @{ $self->{ 'data_roles' } };
1121 :     my %roles;
1122 : bartels 1.2 my %abbtofr;
1123 : bartels 1.1 foreach my $r ( @roles ) {
1124 :     $roles{ $r->[0].'##-##'.$r->[3] } = $r;
1125 :     }
1126 :    
1127 :     my $subsets_table = $self->application->component( 'LD_SUBSETS' );
1128 :     my $roles_table = $self->application->component( 'LD_ROLES' );
1129 :    
1130 :     my $sstdata = [];
1131 :     foreach my $set ( @allsets ) {
1132 :     my $show_checked = $self->{ 'metasubsystem' }->{ 'view' }->{ 'Subsets' }->{ $set }->{ 'visible' } || 0;
1133 :     my $collapse_checked = $self->{ 'metasubsystem' }->{ 'view' }->{ 'Subsets' }->{ $set }->{ 'collapsed' } || 0;
1134 :    
1135 :     my $show_set = $self->{ 'cgi' }->checkbox( -name => 'show_set',
1136 :     -id => "show_set_$set",
1137 :     -value => "show_set_$set",
1138 :     -label => '',
1139 :     -checked => $show_checked,
1140 :     );
1141 :     my $collapse_set = $self->{ 'cgi' }->checkbox( -name => 'collapse_set',
1142 :     -id => "collapse_set_$set",
1143 :     -value => "collapse_set_$set",
1144 :     -label => '',
1145 :     -checked => $collapse_checked,
1146 :     );
1147 :    
1148 :     my @mems = keys %{ $subsets->{ $set } };
1149 : bartels 1.2 my @nicemems;
1150 :     my @nicesubsystems;
1151 : bartels 1.1 foreach ( @mems ) {
1152 : bartels 1.2 $self->{ 'in_subset_role' }->{ $_ } = 1;
1153 :     if ( $_ =~ /([^#^-]+)##-##(.*)/ ) {
1154 :     push @nicemems, $1;
1155 :     push @nicesubsystems, $2;
1156 :     }
1157 : bartels 1.1 }
1158 :    
1159 : bartels 1.2 my $row = [ $set, { data => join( ', ', @nicemems ), tooltip => join( ', ', @nicesubsystems ) },
1160 : bartels 1.1 $show_set, $collapse_set ];
1161 :    
1162 :     push @$sstdata, $row;
1163 :     }
1164 :    
1165 :     my $rowdata = [];
1166 :     my %rowdatahash;
1167 :     foreach my $r ( sort keys %roles ) {
1168 : bartels 1.2 next if ( defined( $self->{ 'in_subset_role' }->{ $r } ) );
1169 : bartels 1.1 my $checkid = "show_role_$r";
1170 :    
1171 :     my $show_checked = 0;
1172 :     if ( $self->{ 'metasubsystem' }->{ 'view' }->{ 'Roles' }->{ $r }->{ 'visible' } ) {
1173 :     $show_checked = 1;
1174 :     }
1175 :    
1176 :     my $show_set = $self->{ 'cgi' }->checkbox( -name => 'show_role',
1177 :     -id => "$checkid",
1178 :     -value => "$checkid",
1179 :     -label => '',
1180 :     -checked => $show_checked,
1181 :     );
1182 :     $r =~ /(.*)##-##.*/;
1183 :    
1184 :     $rowdatahash{ $roles{ $r }->[3] }->{ $1 }->{ 'funcrole' } = $roles{ $r }->[1];
1185 :     $rowdatahash{ $roles{ $r }->[3] }->{ $1 }->{ 'checkbox' } = $show_set;
1186 :     }
1187 :    
1188 :     my $isrow = 0;
1189 :     foreach my $subsys ( keys %rowdatahash ) {
1190 :     my $count = 0;
1191 :     my @row = ( $subsys );
1192 :     foreach my $abb ( keys %{ $rowdatahash{ $subsys } } ) {
1193 :     $count++;
1194 :     $isrow = 1;
1195 : bartels 1.2 push @row, { data => $abb."<BR>".$rowdatahash{ $subsys }->{ $abb }->{ 'checkbox' }, tooltip => $rowdatahash{ $subsys }->{ $abb }->{ 'funcrole' } };
1196 : bartels 1.1 if ( $count > 8 ) {
1197 :     $count = 0;
1198 :     push @$rowdata, [ @row ];
1199 :     @row = ( $subsys );
1200 :     }
1201 :     }
1202 :     if ( $count > 0 ) {
1203 :     for( my $i = $count; $i <= 8; $i++ ) {
1204 :     push @row, '';
1205 :     }
1206 :     push @$rowdata, [ @row ];
1207 :     }
1208 :     }
1209 :    
1210 : bartels 1.2 if ( scalar( @$sstdata ) > 0 ) {
1211 :     $subsets_table->columns( [ 'Name', 'Members', 'Show', 'Collapse' ] );
1212 :     $subsets_table->data( $sstdata );
1213 :     }
1214 :     if ( scalar( @$rowdata ) > 0 ) {
1215 :     $roles_table->columns( [ 'Subsystem', '', '', '', '', '', '', '', '', '' ] );
1216 :     $roles_table->data( $rowdata );
1217 :     }
1218 : bartels 1.1
1219 :     my $content = '<TABLE><TR>';
1220 :     $content .= "<TD><B>Subsets</B></TD></TR><TR>";
1221 :     $content .= "<TD>Choose which subsets should be visible, and for these if they should be displayed collapsed or show each role in a separate column.";
1222 :     $content .= "</TD></TR><TR><TD>";
1223 :     $content .= $subsets_table->output();
1224 :     if ( $isrow ) {
1225 :     $content .= '</TD></TR><TR>';
1226 :     $content .= "<TD><B>Functional Roles</B></TD></TR><TR>";
1227 :     $content .= "<TD>The following roles are not part of any defined subsystem. Check the roles you want to see in your display.</TD>";
1228 :     $content .= '</TR><TR><TD>';
1229 :     $content .= $roles_table->output();
1230 :     }
1231 :     $content .= '</TD></TR></TABLE>';
1232 :    
1233 : bartels 1.2 my $spreadsheettable = $self->application->component( 'SubsystemSpreadsheet' );
1234 :     my $spreadsheettableid = $spreadsheettable->id();
1235 :    
1236 : bartels 1.3 $content .= "<BR><BR><INPUT TYPE=BUTTON VALUE='Limit Subsets and Functional Roles' ONCLICK='ChangeVisibility( \"$spreadsheettableid\" );'>";
1237 :     if ( $self->{ 'can_alter' } ) {
1238 :     $content .= "<INPUT TYPE=BUTTON VALUE='Make current setting Default' ONCLICK='SubmitSpreadsheet( \"LimitSubsets\", 2 );'>";
1239 :     }
1240 : bartels 1.1
1241 :     return $content;
1242 :     }
1243 :    
1244 :    
1245 :     sub fid_link {
1246 :     my ( $self, $fid ) = @_;
1247 :     my $n;
1248 :     my $seeduser = $self->{ 'seeduser' };
1249 :     $seeduser = '' if ( !defined( $seeduser ) );
1250 :    
1251 :     if ($fid =~ /^fig\|\d+\.\d+\.([a-zA-Z]+)\.(\d+)/) {
1252 :     if ( $1 eq "peg" ) {
1253 :     $n = $2;
1254 :     }
1255 :     else {
1256 :     $n = "$1.$2";
1257 :     }
1258 :     }
1259 :    
1260 : bartels 1.4 # return "./protein.cgi?prot=$fid&user=$seeduser\&new_framework=0";
1261 :     return qq~./seedviewer.cgi?page=Annotation&feature=$fid&user=$seeduser~;
1262 : bartels 1.1 }
1263 :    
1264 :    
1265 :    
1266 :     sub get_color_by_attribute_infos {
1267 :    
1268 : bartels 1.2 my ( $self, $attr, $pegsarr, $colors ) = @_;
1269 : bartels 1.1
1270 :     my $scalacolor = is_scala_attribute( $attr );
1271 :     my $peg_to_color_alround;
1272 :     my $cluster_colors_alround;
1273 :    
1274 :     if ( defined( $attr ) ) {
1275 : bartels 1.2 my $groups_for_pegs = get_groups_for_pegs( $self->{ 'fig' }, $attr, $pegsarr );
1276 : bartels 1.1 my $i = 0;
1277 :     my $biggestitem = 0;
1278 :     my $smallestitem = 100000000000;
1279 :    
1280 :     if ( $scalacolor ) {
1281 :     foreach my $item ( keys %$groups_for_pegs ) {
1282 :    
1283 :     if ( $biggestitem < $item ) {
1284 :     $biggestitem = $item;
1285 :     }
1286 :     if ( $smallestitem > $item ) {
1287 :     $smallestitem = $item;
1288 :     }
1289 :     }
1290 :     $self->{ 'legend' } = get_scala_legend( $biggestitem, $smallestitem, 'Color legend for CDSs' );
1291 :     }
1292 :    
1293 :     my $leghash;
1294 :     foreach my $item ( keys %$groups_for_pegs ) {
1295 :     foreach my $peg ( @{ $groups_for_pegs->{ $item } } ) {
1296 :     $peg_to_color_alround->{ $peg } = $i;
1297 :     }
1298 :    
1299 :     if ( $scalacolor ) {
1300 :     my $col = get_scalar_color( $item, $biggestitem, $smallestitem );
1301 :     $cluster_colors_alround->{ $i } = $col;
1302 :     }
1303 :     else {
1304 :     $cluster_colors_alround->{ $i } = $colors->[ scalar( keys( %$cluster_colors_alround ) ) ];
1305 :     $leghash->{ $item } = $cluster_colors_alround->{ $i };
1306 :     }
1307 :     $i++;
1308 :     }
1309 :     if ( !$scalacolor ) {
1310 :     $self->{ 'legend' } = get_value_legend( $leghash, 'Color Legend for CDSs' );
1311 :     }
1312 :     }
1313 :     return ( $peg_to_color_alround, $cluster_colors_alround );
1314 :     }
1315 :    
1316 :     sub get_peg_addition {
1317 :    
1318 :     my ( $self, $pegf ) = @_;
1319 :    
1320 : bartels 1.7 # my @frs = split( ' / ', $pegf );
1321 :     my @frs = ( split( /\s*;\s+|\s+[\@\/]\s+/, $pegf ) );
1322 : bartels 1.1 my $pegfnum = '';
1323 :    
1324 :     foreach ( @frs ) {
1325 :     my $m = $self->{ 'roles_to_num' }->{ $_ };
1326 :     next if ( !defined( $m ) );
1327 :    
1328 :     foreach my $pm ( @$m ) {
1329 :     my $pegfnumtmp = $pm->[0];
1330 :     $pegfnum .= '_'.$pegfnumtmp;
1331 :     }
1332 :     }
1333 :     return $pegfnum;
1334 :     }
1335 :    
1336 :     sub get_color_by_attribute_infos_for_genomes {
1337 :    
1338 : bartels 1.2 my ( $self, $spreadsheethash, $colors ) = @_;
1339 : bartels 1.1
1340 :     my $genomes_to_color;
1341 :     my $genome_colors;
1342 :     my $leghash;
1343 :     my $i = 0;
1344 :     my $biggestitem = 0;
1345 :     my $smallestitem = 100000000000;
1346 :    
1347 : bartels 1.2 my $attr = $self->{ 'cgi' }->param( 'color_by_ga' );
1348 : bartels 1.1 my $scalacolor = is_scala_attribute( $attr );
1349 :    
1350 :     my @genomes = keys %$spreadsheethash;
1351 : bartels 1.2 my $groups_for_genomes = get_groups_for_pegs( $self->{ 'fig' }, $attr, \@genomes );
1352 : bartels 1.1
1353 :     if ( $scalacolor ) {
1354 :    
1355 :     foreach my $item ( keys %$groups_for_genomes ) {
1356 :    
1357 :     if ( $biggestitem < $item ) {
1358 :     $biggestitem = $item;
1359 :     }
1360 :     if ( $smallestitem > $item ) {
1361 :     $smallestitem = $item;
1362 :     }
1363 :     }
1364 :     $self->{ 'legendg' } = get_scala_legend( $biggestitem, $smallestitem, 'Color Legend for Genomes' );
1365 :     }
1366 :    
1367 :     foreach my $item ( keys %$groups_for_genomes ) {
1368 :     foreach my $g ( @{ $groups_for_genomes->{ $item } } ) {
1369 :     $genomes_to_color->{ $g } = $i;
1370 :     }
1371 :    
1372 :     if ( $scalacolor ) {
1373 :     my $col = get_scalar_color( $item, $biggestitem, $smallestitem );
1374 :     $genome_colors->{ $i } = $col;
1375 :     }
1376 :     else {
1377 :     $genome_colors->{ $i } = $colors->[ scalar( keys( %$genome_colors ) ) ];
1378 :     $leghash->{ $item } = $genome_colors->{ $i };
1379 :     }
1380 :     $i++;
1381 :     }
1382 :     if ( !$scalacolor ) {
1383 :     $self->{ 'legendg' } = get_value_legend( $leghash, 'Color Legend for Genomes' );
1384 :     }
1385 :    
1386 :     return ( $genomes_to_color, $genome_colors );
1387 :     }
1388 :    
1389 :    
1390 :     sub get_colors {
1391 :     my ( $self ) = @_;
1392 :    
1393 :     return [ '#d94242', '#eaec19', '#715ae5', '#25d729', '#f9ae1d', '#19b5b3', '#b519b3', '#ffa6ef',
1394 :     '#744747', '#701414', '#70a444', '#C0C0C0', '#FF40C0', '#FF8040', '#FF0080', '#FFC040',
1395 :     '#40C0FF', '#40FFC0', '#C08080', '#C0FF00', '#00FF80', '#00C040',
1396 :     "#6B8E23", "#483D8B", "#2E8B57", "#008000", "#006400", "#800000", "#00FF00", "#7FFFD4",
1397 :     "#87CEEB", "#A9A9A9", "#90EE90", "#D2B48C", "#8DBC8F", "#D2691E", "#87CEFA", "#E9967A",
1398 :     "#FFE4C4", "#FFB6C1", "#E0FFFF", "#FFA07A", "#DB7093", "#9370DB", "#008B8B", "#FFDEAD",
1399 :     "#DA70D6", "#DCDCDC", "#FF00FF", "#6A5ACD", "#00FA9A", "#228B22", "#1E90FF", "#FA8072",
1400 :     "#CD853F", "#DC143C", "#FF6347", "#98FB98", "#4682B4", "#D3D3D3", "#7B68EE", "#2F4F4F",
1401 :     "#FF7F50", "#FF69B4", "#BC8F8F", "#A0522D", "#DEB887", "#00DED1", "#6495ED", "#800080",
1402 :     "#FFD700", "#F5DEB3", "#66CDAA", "#FF4500", "#4B0082", "#CD5C5C", "#EE82EE", "#7CFC00",
1403 :     "#FFFF00", "#191970", "#FFFFE0", "#DDA0DD", "#00BFFF", "#DAA520", "#008080", "#00FF7F",
1404 :     "#9400D3", "#BA55D3", "#D8BFD8", "#8B4513", "#3CB371", "#00008B", "#5F9EA0", "#4169E1",
1405 :     "#20B2AA", "#8A2BE2", "#ADFF2F", "#556B2F", "#F0FFFF", "#B0E0E6", "#FF1493", "#B8860B",
1406 :     "#FF0000", "#F08080", "#7FFF00", "#8B0000", "#40E0D0", "#0000CD", "#48D1CC", "#8B008B",
1407 :     "#696969", "#AFEEEE", "#FF8C00", "#EEE8AA", "#A52A2A", "#FFE4B5", "#B0C4DE", "#FAF0E6",
1408 :     "#9ACD32", "#B22222", "#FAFAD2", "#808080", "#0000FF", "#000080", "#32CD32", "#FFFACD",
1409 :     "#9932CC", "#FFA500", "#F0E68C", "#E6E6FA", "#F4A460", "#C71585", "#BDB76B", "#00FFFF",
1410 :     "#FFDAB9", "#ADD8E6", "#778899" ];
1411 :     }
1412 :    
1413 :    
1414 :     #####################################################
1415 :     # List of attributes that are not used for coloring #
1416 :     #####################################################
1417 :     sub attribute_blacklist {
1418 :    
1419 :     my $list = { 'pfam-domain' => 1,
1420 :     'PFAM' => 1,
1421 :     'CDD' => 1 };
1422 :     return $list;
1423 :    
1424 :     }
1425 : bartels 1.2
1426 :     sub get_phylo_groups {
1427 :     my ( $self ) = @_;
1428 :    
1429 :     my @row_subsets;
1430 :     my $row_subset_members;
1431 :    
1432 :     my $taxonomic_groups = $self->{ 'fig' }->taxonomic_groups_of_complete(10);
1433 :     foreach my $pair ( @$taxonomic_groups ) {
1434 :     my ( $id, $members ) = @$pair;
1435 :     if ( $id ne "All" ) {
1436 :     push( @row_subsets, $id );
1437 :     }
1438 :     $row_subset_members->{ $id } = $members;
1439 :     }
1440 :     return ( \@row_subsets, $row_subset_members );
1441 :     }
1442 :    
1443 :    
1444 :     sub getActiveSubsetHash {
1445 :    
1446 :     my ( $self ) = @_;
1447 :    
1448 :     my $activeR;
1449 :     my $evaluate = 0;
1450 :     my $andor;
1451 :    
1452 :     my $phylo = $self->{ 'cgi' }->param( 'phylogeny_set' );
1453 :     my $special = $self->{ 'cgi' }->param( 'special_set' );
1454 :     my $userset = $self->{ 'cgi' }->param( 'user_set' );
1455 :    
1456 :     if ( defined( $special ) && $special ne '' && $special ne 'All' ) {
1457 :     my @subsetspecial = moregenomes( $self, $special );
1458 :     my %activeRH = map { $_ => 1 } @subsetspecial;
1459 :     $activeR = \%activeRH;
1460 :     $evaluate = 1;
1461 :     }
1462 :     if ( defined( $phylo ) && $phylo ne '' && $phylo ne 'All' ) {
1463 :     my %genomes = %{ $self->{ 'metasubsystem' }->{ 'genomes' } };
1464 :     my @subsetR = grep { $genomes{ $_ } } @{ $self->{ 'row_subset_members' }->{ $phylo } };
1465 :    
1466 :     my %activeRH = map { $_ => 1 } @subsetR;
1467 :     if ( $evaluate ) {
1468 :     $activeR = andor( $activeR, \%activeRH, $andor );
1469 :     }
1470 :     else {
1471 :     $activeR = \%activeRH;
1472 :     }
1473 :     $evaluate = 1;
1474 :     }
1475 :     if ( defined( $userset ) && $userset ne '' && $userset ne 'All' ) {
1476 :     my %activeRH;
1477 :     my $gl = GenomeLists::load( $userset );
1478 :     my $gs = $gl->{ 'genomes' };
1479 :     foreach my $ssu ( @$gs ) {
1480 :     $activeRH{ $ssu } = 1;
1481 :     }
1482 :     if ( $evaluate ) {
1483 :     $activeR = andor( $activeR, \%activeRH, $andor );
1484 :     }
1485 :     else {
1486 :     $activeR = \%activeRH;
1487 :     }
1488 :     }
1489 :    
1490 :     return $activeR;
1491 :     }
1492 :    
1493 :    
1494 :    
1495 :     sub selectgenomeattr {
1496 : bartels 1.8 my ( $self, $tag, $value )=@_;
1497 : bartels 1.2 my @orgs;
1498 :    
1499 :     if ( $tag eq "phylogeny" ) {
1500 : bartels 1.8 my $taxonomic_groups = $self->{ 'fig' }->taxonomic_groups_of_complete(10);
1501 : bartels 1.2 foreach my $pair (@$taxonomic_groups)
1502 :     {
1503 :     push @orgs, @{$pair->[1]} if ($pair->[0] eq "$value");
1504 :     }
1505 :     }
1506 :     elsif ( $tag eq "filepresent" ) {
1507 : bartels 1.8 foreach my $genome ( $self->{ 'fig' }->genomes ) {
1508 : bartels 1.2 push(@orgs, $genome) if (-e $FIG_Config::organisms."/$genome/$value");
1509 :     }
1510 :     }
1511 :     else {
1512 :     if ( $value ) {
1513 : bartels 1.8 @orgs = map { $_->[0]} grep {$_->[0] =~ /^\d+\.\d+$/ } $self->{ 'fig' }->get_attributes( undef, $tag, $value );
1514 : bartels 1.2 }
1515 :     else {
1516 : bartels 1.8 @orgs = map { $_->[0]} grep {$_->[0] =~ /^\d+\.\d+$/ } $self->{ 'fig' }->get_attributes( undef, 'collection', $tag );
1517 : bartels 1.2 }
1518 :     }
1519 :     return @orgs;
1520 :     }
1521 : bartels 1.4
1522 :     #################################
1523 :     # Buttons under the spreadsheet #
1524 :     #################################
1525 :     sub get_spreadsheet_buttons {
1526 :     my ( $self ) = @_;
1527 :    
1528 :     my $plusminus = "<INPUT TYPE=BUTTON VALUE='PlusMinus View' ID='PLUSMINUS' NAME='PLUSMINUS' ONCLICK='SubmitSpreadsheet( \"PLUSMINUS\", 0 );'>";
1529 :     my $notplusminus = "<INPUT TYPE=BUTTON VALUE='Normal View' ID='NOTPLUSMINUS' NAME='NOTPLUSMINUS' ONCLICK='SubmitSpreadsheet( \"NOTPLUSMINUS\", 0 );'>";
1530 :    
1531 : bartels 1.8 my $delete_button = "<INPUT TYPE=HIDDEN VALUE=0 NAME='DeleteGenomesHidden' ID='DeleteGenomesHidden'>";
1532 :     $delete_button .= "<INPUT TYPE=BUTTON VALUE='Delete selected genomes' NAME='DeleteGenomes' ID='DeleteGenomes' ONCLICK='if ( confirm( \"Do you really want to delete the selected genomes from the spreadsheet?\" ) ) {
1533 :     document.getElementById( \"DeleteGenomesHidden\" ).value = 1;
1534 :     SubmitSpreadsheet( \"DeleteGenomes\", 0 ); }'>";
1535 : bartels 1.10 my $minus1_variant_button = "<INPUT TYPE=BUTTON VALUE='Show all variants' NAME='MoVariants' ID='MoVariants' ONCLICK='SubmitSpreadsheet( \"MOVariants\", 0 );'>";
1536 :     my $minus1_variant_hideall_button = "<INPUT TYPE=BUTTON VALUE='Hide variants all subsystems -1' NAME='HideAllMOVariants' ID='HideAllMOVariants' ONCLICK='SubmitSpreadsheet( \"HideAllMOVariants\", 0 );'>";
1537 :     my $minus1_variant_hideone_button = "<INPUT TYPE=BUTTON VALUE='Hide variants one subsystem -1' NAME='HideOneMOVariants' ID='HideOneMOVariants' ONCLICK='SubmitSpreadsheet( \"HideOneMOVariants\", 0 );'>";
1538 : bartels 1.8
1539 : bartels 1.4 my $spreadsheetbuttons = "<DIV id='controlpanel'><H2>Actions</H2>\n";
1540 :    
1541 : bartels 1.10 $spreadsheetbuttons .= "<TABLE><TR><TD><B>Variants:</B></TD><TD>$minus1_variant_button</TD><TD>$minus1_variant_hideone_button</TD><TD>$minus1_variant_hideall_button</TD></TR></TABLE><BR>";
1542 : bartels 1.4 $spreadsheetbuttons .= "<TABLE><TR><TD><B>View:</B></TD><TD>$plusminus</TD></TR></TABLE><BR>";
1543 : bartels 1.8 $spreadsheetbuttons .= "<TABLE><TR><TD><B>Selection:</B></TD><TD>$delete_button</TD></TR></TABLE><BR>";
1544 : bartels 1.4
1545 :     return $spreadsheetbuttons;
1546 :     }
1547 : bartels 1.8
1548 :    
1549 :     ##################################
1550 :     # Add genomes to the spreadsheet #
1551 :     ##################################
1552 :     sub add_refill_genomes {
1553 :     my ( $self, $genomes ) = @_;
1554 :    
1555 :     my $comment = "";
1556 :    
1557 : bartels 1.9 $self->{ 'metasubsystem' }->add_genomes( $genomes );
1558 : bartels 1.8 $self->{ 'metasubsystem' }->write_metasubsystem();
1559 :    
1560 : bartels 1.9 $comment .= "Added ". scalar( keys( %$genomes ) ). " genomes to the spreadsheet:<BR>";
1561 : bartels 1.8
1562 : bartels 1.11 foreach my $g ( keys %$genomes ) {
1563 : bartels 1.8 $comment .= " - $g <BR>";
1564 :     }
1565 :    
1566 :     return ( '', $comment );
1567 :     }
1568 :    
1569 :     #######################################
1570 :     # Remove genomes from the spreadsheet #
1571 :     #######################################
1572 :     sub remove_genomes {
1573 :     my( $self, $genomes ) = @_;
1574 :    
1575 :     my $comment = '';
1576 :    
1577 :     if ( scalar( @$genomes ) == 0 ) {
1578 :     return "No genomes selected to delete<BR>\n";
1579 :     }
1580 :    
1581 :     my %delgenomes;
1582 :     foreach my $genm ( @$genomes ) {
1583 :     $genm =~ /^genome_checkbox_(\d+\.\d+.*)/;
1584 :     my $genome = $1;
1585 :     my $rawgenome = $genome;
1586 :     $delgenomes{ $genome } = 1;
1587 :    
1588 :     if ( $genome =~ /(\d+\.\d+)\:(.*)/ ) {
1589 :     $rawgenome = $1;
1590 :     my $loc = $2;
1591 :     my $genomename = $self->{ 'fig' }->genus_species( $rawgenome );
1592 :     $comment .= "Deleted region $genomename".": $loc ( $genome ) from the spreadsheet<BR>\n";
1593 :     }
1594 :     else {
1595 :     my $genomename = $self->{ 'fig' }->genus_species( $rawgenome );
1596 :     $comment .= "Deleted genome $genomename ( $genome ) from the spreadsheet<BR>\n";
1597 :     }
1598 :     }
1599 :    
1600 :    
1601 :     $self->{ 'metasubsystem' }->remove_genomes( \%delgenomes );
1602 :     $self->{ 'metasubsystem' }->write_metasubsystem();
1603 :    
1604 :     return $comment;
1605 :     }
1606 :    
1607 :     ##################################
1608 :     # Upper panel for adding genomes #
1609 :     ##################################
1610 :     sub add_genomes_panel {
1611 :    
1612 :     my ( $self, $application ) = @_;
1613 :    
1614 :     ####################################
1615 :     # collect some data into variables #
1616 :     ####################################
1617 :     # get a hash of all genomes of that subsystem #
1618 :     my %genomes = %{ $self->{ 'metasubsystem' }->{ 'genomes' } };
1619 :    
1620 :     #################################
1621 :     # Put The New OrganismSelect in #
1622 :     #################################
1623 :     my $oselect = $application->component( 'OSelect' );
1624 :     $oselect->multiple( 1 );
1625 :     $oselect->width( 500 );
1626 :     $oselect->name( 'new_genome' );
1627 :     $oselect->blacklist( \%genomes );
1628 :    
1629 :     my @options = ( 'None',
1630 :     'NMPDR',
1631 :     'BRC',
1632 :     'Hundred by a hundred' );
1633 :    
1634 :     my @genomeListsUser = GenomeLists::getListsForUser();
1635 :     unshift @genomeListsUser, 'None';
1636 :    
1637 :     ###################
1638 :     # Build HTML here #
1639 :     ###################
1640 :    
1641 :     my $addgenomespanel .= "<TABLE><TR><TD><TABLE><TR><TD COLSPAN=4>";
1642 :    
1643 :     $addgenomespanel .= $oselect->output();
1644 :    
1645 :     $addgenomespanel .= "</TD></TR><TR><TD>";
1646 :    
1647 :     $addgenomespanel .= "<B>Specific Sets</B></TD><TD><B>User Sets</B></TD></TR><TR><TD>";
1648 :    
1649 :     # now special sets #
1650 :     $addgenomespanel .= $self->{ 'cgi' }->scrolling_list( -id => 'add_special_set',
1651 :     -name => 'add_special_set',
1652 :     -values => \@options,
1653 :     -default => 'None',
1654 :     -size => 4
1655 :     );
1656 :     $addgenomespanel .= "</TD><TD><TABLE><TR><TD>\n";
1657 :    
1658 :     $addgenomespanel .= $self->{ 'cgi' }->scrolling_list( -id => 'add_user_set',
1659 :     -name => 'add_user_set',
1660 :     -values => \@genomeListsUser,
1661 :     -default => 'None',
1662 :     -size => 4
1663 :     );
1664 :     $addgenomespanel .= "</TD><TD>\n";
1665 :     $addgenomespanel .= "<INPUT TYPE=BUTTON VALUE=\"Show selected\ngenome list\" ID='ShowSelectionButton' ONCLICK='OpenGenomeList( \"".$application->url()."\" );'>";
1666 :     $addgenomespanel .= "</TD></TR></TABLE></TD></TR></TABLE>\n";
1667 :    
1668 :     $addgenomespanel .= "</TD></TR><TR><TD>";
1669 :    
1670 :     $addgenomespanel .= "<INPUT TYPE=BUTTON VALUE='Add selected genome(s) to spreadsheet' ONCLICK='SubmitSpreadsheet( \"Add selected genome(s) to spreadsheet\", 0 );'>";
1671 :    
1672 :     $addgenomespanel .= "</TD></TR></TABLE><BR>";
1673 :    
1674 :    
1675 :     return $addgenomespanel;
1676 :     }
1677 :    
1678 :     sub moregenomes {
1679 :     my ( $self, $more ) = @_;
1680 :    
1681 :     if ($more eq "Cyanobacteria") { return $self->selectgenomeattr( $self->{ 'fig' }, "phylogeny", "Cyanobacteria")}
1682 :     if ($more eq "NMPDR") { return $self->selectgenomeattr( $self->{ 'fig' }, "filepresent", "NMPDR")}
1683 :     if ($more eq "BRC") { return $self->selectgenomeattr( $self->{ 'fig' }, "filepresent", "BRC")}
1684 :     if ($more eq "higher_plants") { return $self->selectgenomeattr( $self->{ 'fig' }, "higher_plants")}
1685 :     if ($more eq "eukaryotic_ps") { return $self->selectgenomeattr( $self->{ 'fig' }, "eukaryotic_ps")}
1686 :     if ($more eq "nonoxygenic_ps") { return $self->selectgenomeattr( $self->{ 'fig' }, "nonoxygenic_ps")}
1687 :     if ($more eq "Hundred by a hundred") { return $self->selectgenomeattr( $self->{ 'fig' }, "hundred_hundred")}
1688 :     if ($more eq "functional_coupling_paper") { return $self->selectgenomeattr( $self->{ 'fig' }, "functional_coupling_paper")}
1689 :     }
1690 :    
1691 :     sub get_userlist_hash {
1692 :     my ( $usersetlist, $ghash ) = @_;
1693 :    
1694 :     my $gl = GenomeLists::load( $usersetlist );
1695 :     my $gs = $gl->{ 'genomes' };
1696 :     foreach my $ssu ( @$gs ) {
1697 :     $ghash->{ $ssu } = 1;
1698 :     }
1699 :     return $ghash;
1700 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3