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

Annotation of /SubsystemEditor/WebPage/MetaSpreadsheet.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3