Mercurial > repos > fgiacomoni > hr2
annotate lib/hr.pm @ 1:e2cbcf6fa22e draft
master branch Updating with tag :CI_COMMIT_TAG - - Fxx
author | fgiacomoni |
---|---|
date | Sun, 11 Dec 2022 17:16:43 +0000 |
parents | 86296c048e46 |
children | 23970530a518 |
rev | line source |
---|---|
0 | 1 package lib::hr ; |
2 | |
3 use strict; | |
4 no strict "refs" ; | |
5 use warnings ; | |
6 use Exporter ; | |
7 use threads ; | |
8 use HTML::Template ; | |
9 use Carp ; | |
10 | |
11 use Data::Dumper ; | |
12 | |
13 use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS); | |
14 | |
15 our $VERSION = "1.0"; | |
16 our @ISA = qw(Exporter); | |
17 our @EXPORT = qw( manage_atoms_and_ranges manage_atoms check_hr_exe manage_atom_and_range manage_tolerance manage_mode config_hr_exe ); | |
18 our %EXPORT_TAGS = ( ALL => [qw(manage_atoms_and_ranges manage_atoms check_hr_exe manage_atom_and_range manage_tolerance manage_mode config_hr_exe )] ); | |
19 | |
20 =head1 NAME | |
21 | |
22 lib::hr - A module for managing / launching hr binary (structure elucidation c++ progr) | |
23 | |
24 =head1 SYNOPSIS | |
25 | |
26 use lib::hr; | |
27 my $object = lib::hr->new(); | |
28 print $object->as_string; | |
29 | |
30 =head1 DESCRIPTION | |
31 | |
32 This module does not really exist, it | |
33 was made for the sole purpose of | |
34 demonstrating how POD works. | |
35 | |
36 =head1 METHODS | |
37 | |
38 Methods are : | |
39 | |
40 =head2 METHOD new | |
41 | |
42 ## Description : new | |
43 ## Input : $self | |
44 ## Ouput : bless $self ; | |
45 ## Usage : new() ; | |
46 | |
47 =cut | |
48 | |
49 sub new { | |
50 ## Variables | |
51 my $self={}; | |
52 bless($self) ; | |
53 return $self ; | |
54 } | |
55 ### END of SUB | |
56 | |
57 =head2 METHOD manage_atoms_and_ranges | |
58 | |
59 ## Description : allow from an initial config to add or delete atoms and their range | |
60 ## Input : $atomsconfig, $atombasic, $atomsupp | |
61 ## Output : $atomcleanconfig | |
62 ## Usage : my ( $atomcleanconfig ) = manage_atoms_and_ranges ( $atomsconfig, $atombasic, $atomsupp ) ; | |
63 | |
64 =cut | |
65 ## START of SUB | |
66 sub manage_atoms_and_ranges { | |
67 ## Retrieve Values | |
68 my $self = shift ; | |
69 my ( $atomsconfig, $CONF, $atombasic, $atomsupp ) = @_; | |
70 my ( $atomcleanconfig ) = ( undef ) ; | |
71 | |
72 # basic atoms case: | |
73 foreach my $atom ( (split(",", $atombasic )) ) { | |
74 if ( exists $CONF->{$atom} ) { $atomsconfig->{$atom}{'max'} = $CONF->{$atom} ; } | |
1
e2cbcf6fa22e
master branch Updating with tag :CI_COMMIT_TAG - - Fxx
fgiacomoni
parents:
0
diff
changeset
|
75 else { print "*** $atom not recognized***\n" ; } |
0 | 76 } |
77 | |
78 # suppl. atoms case | |
79 foreach my $atom ( (split(",", $atomsupp )) ) { | |
80 print "*** $atom***\n" ; | |
1
e2cbcf6fa22e
master branch Updating with tag :CI_COMMIT_TAG - - Fxx
fgiacomoni
parents:
0
diff
changeset
|
81 if ( exists $atomsconfig->{$atom} ) { $atomsconfig->{$atom}{'max'} = $CONF->{'DEFAULT_MAX'} ; } |
e2cbcf6fa22e
master branch Updating with tag :CI_COMMIT_TAG - - Fxx
fgiacomoni
parents:
0
diff
changeset
|
82 else { print "*** $atom not recognized***\n" ; } |
e2cbcf6fa22e
master branch Updating with tag :CI_COMMIT_TAG - - Fxx
fgiacomoni
parents:
0
diff
changeset
|
83 |
0 | 84 } |
85 | |
86 # Create atoms and range parameters: | |
87 foreach my $selectedAtom ( keys %{$atomsconfig} ) { | |
88 $atomcleanconfig .= ' -'.$selectedAtom.' '.$atomsconfig->{$selectedAtom}{'min'}.'-'.$atomsconfig->{$selectedAtom}{'max'} ; | |
89 } | |
90 | |
91 return ($atomcleanconfig) ; | |
92 } | |
93 ### END of SUB | |
94 | |
95 | |
96 | |
97 =head2 METHOD manage_atoms ### DEPRECATED | |
98 | |
99 ## Description : controles atoms input list and prepare it like hr binary parameter | |
100 ## Input : $input_atoms, $conf_atoms | |
101 ## Output : $hr_atoms_param | |
102 ## Usage : my ( $hr_atoms_param ) = manage_atoms( $input_atoms, $conf_atoms ) ; | |
103 ### DEPRECATED | |
104 | |
105 =cut | |
106 ## START of SUB | |
107 sub manage_atoms { ### DEPRECATED | |
108 ## Retrieve Values | |
109 my $self = shift ; | |
110 my ( $input_atoms, $conf_atoms ) = @_ ; | |
111 my $hr_atoms_param = undef ; | |
112 | |
113 if ( ( defined $$input_atoms ) and ( defined $$conf_atoms ) ) { | |
114 if ( ( $$input_atoms eq 'None' ) or ( $$input_atoms eq '' ) or ( $$input_atoms eq ' ' ) ) { $hr_atoms_param = $$conf_atoms ; } | |
115 elsif ( $$input_atoms =~ /[P|S|F|L|K|B|A|1|,]+/ ) { $hr_atoms_param = $$conf_atoms.','.$$input_atoms ; } | |
116 else { $hr_atoms_param = $$conf_atoms ; } | |
117 } ## END IF | |
118 elsif ( !defined $$input_atoms ) { $hr_atoms_param = $$conf_atoms ; } | |
119 elsif ( !defined $$conf_atoms ) { warn "hr module can't manage any atom list (undef values in conf)\n" ; } | |
120 else { warn "hr module musn't manage any atom list\n" ; } | |
121 | |
122 return(\$hr_atoms_param) ; | |
123 } | |
124 ## END of SUB | |
125 | |
126 =head2 METHOD manage_atom_and_range ### DEPRECATED | |
127 | |
128 ## Description : build atom range with defined value in conf file | |
129 ## Input : $atom, $min, $max | |
130 ## Output : $hr_range | |
131 ## Usage : my ( ) = manage_atom_and_range( $atom, $min, $max ) ; | |
132 ### DEPRECATED | |
133 | |
134 =cut | |
135 ## START of SUB | |
136 sub manage_atom_and_range { ### DEPRECATED | |
137 ## Retrieve Values | |
138 my $self = shift ; | |
139 my ( $atom, $min, $max ) = @_ ; | |
140 my $hr_range = undef ; | |
141 | |
142 if ( ( defined $$atom ) and ( defined $$min ) and ( defined $$max ) ) { | |
143 ## manage ragne like "-C 0-200" | |
144 $hr_range = ' -'.$$atom.' '.$$min.'-'.$$max ; | |
145 } ## END IF | |
146 else { | |
147 warn "Some argvts are missing to build the current atom range line\n" ; | |
148 } | |
149 return(\$hr_range) ; | |
150 } | |
151 ## END of SUB | |
152 | |
153 =head2 METHOD manage_tolerance | |
154 | |
155 ## Description : check range and format of tolerance | |
156 ## Input : $tolerance, $default_value | |
157 ## Output : $set_tol | |
158 ## Usage : my ( $set_tol ) = manage_tolerance( $tolerance, $default_value ) ; | |
159 | |
160 =cut | |
161 ## START of SUB | |
162 sub manage_tolerance { | |
163 ## Retrieve Values | |
164 my $self = shift ; | |
165 my ( $tolerance, $default_value ) = @_ ; | |
166 my ($set_tol, $tmp_tol ) = (undef, undef) ; | |
167 | |
168 if ( ( defined $$tolerance ) and ( defined $$default_value )) { | |
169 $tmp_tol = $$tolerance ; | |
170 $tmp_tol =~ tr/,/./; | |
171 ## tolerance doit etre >0 et <10 | |
172 if ( $tmp_tol <= 0 || $tmp_tol >= 10 ){ | |
173 $set_tol = $$default_value ; | |
174 warn "The used tolerance is set to $$default_value (out of authorized range)\n" ; | |
175 } | |
176 else{ $set_tol = $tmp_tol ; } | |
177 } | |
178 else { warn "Your tolerance or the default tol are not defined\n" ; } | |
179 | |
180 return(\$set_tol) ; | |
181 } | |
182 ## END of SUB | |
183 | |
184 =head2 METHOD manage_mode | |
185 | |
186 ## Description : manage mode and apply mass correction (positive/negative/neutral) | |
187 ## Input : $mode, $charge, $electron, $proton, $mass | |
188 ## Output : $exact_mass | |
189 ## Usage : my ( $exact_mass ) = manage_mode( $mode, $charge, $electron, $proton, $mass ) ; | |
190 | |
191 =cut | |
192 ## START of SUB | |
193 sub manage_mode { | |
194 ## Retrieve Values | |
195 my $self = shift ; | |
196 my ( $mode, $charge, $electron, $proton, $mass ) = @_ ; | |
197 my ($exact_mass, $tmp_mass) = ( undef, undef ) ; | |
198 | |
199 ## some explanations : | |
200 # MS in + mode = adds H+ (proton) and molecule is positive : el+ => $charge = "positive" | |
201 # For HR, need to subtrack proton mz and to add electron mz (1 electron per charge) to the input mass which comes neutral! | |
202 | |
203 if ( ( defined $$electron ) and ( defined $$proton ) ) { | |
204 # check mass | |
205 if ( defined $$mass ) { $tmp_mass = $$mass ; $tmp_mass =~ tr/,/./ ; } # manage . and , in case of... | |
206 else { warn "No mass is defined\n" } | |
207 | |
208 # manage charge | |
209 if ( ( !defined $$charge ) || ($$charge < 0) ){ warn "Charge is not defined or value is less than zero\n" ; } | |
210 | |
211 # set neutral mass in function of ms mode | |
212 if($$mode eq 'positive') { $exact_mass = ( $tmp_mass - $$proton + $$electron) * $$charge ; } | |
213 elsif($$mode eq 'negative') { $exact_mass = ( $tmp_mass + $$proton - $$electron) * $$charge ; } | |
214 elsif($$mode eq "neutral") { $exact_mass = $tmp_mass ; } | |
215 else { warn "This mode doesn't exist : please select positive/negative or neutral mode\n" ; } | |
216 } | |
217 else { | |
218 warn "Missing some parameter values (electron, neutron masses), please check your conf file\n" ; | |
219 } | |
220 return(\$exact_mass) ; | |
221 } | |
222 ## END of SUB | |
223 | |
224 =head2 METHOD check_hr_exe | |
225 | |
226 ## Description : permit to check the path of hr.exe and its full availability | |
227 ## Input : $hr_path, $hr_version | |
228 ## Output : true/false | |
229 ## Usage : my ( $res ) = check_hr_exe( $hr_path, $hr_version ) ; | |
230 | |
231 =cut | |
232 ## START of SUB | |
233 sub check_hr_exe { | |
234 ## Retrieve Values | |
235 my $self = shift ; | |
236 my ( $hr_path, $hr_version ) = @_ ; | |
237 my $success = undef ; | |
238 my $check_res = undef ; | |
239 | |
240 ## test path : | |
241 if ( ( defined $$hr_path ) and ( defined $$hr_version ) ) { | |
242 if ( defined $$hr_path ) { | |
243 $success = `$$hr_path -version`; | |
244 print "$success\n" ; | |
245 if ($success !~/^$$hr_version/) { warn "You do not use the expected version of hr2 ($$hr_version)\n" ; } | |
246 else { $check_res = 1 ; } | |
247 } | |
248 else { warn "Can't use HR because the binary file doesn't exist at the specified path ($$hr_path)\n" ; } | |
249 | |
250 } ## END IF | |
251 else { warn "No HR path or Hr version defined\n" ; } | |
252 | |
253 return($check_res) ; | |
254 } | |
255 ## END of SUB | |
256 | |
257 =head2 METHOD config_hr_exe | |
258 | |
259 ## Description : builds hr execute line with needed params | |
260 ## Input : $hr_path, $hr_delta, $mass, $has_goldenrules, $atoms_and_ranks | |
261 ## Output : var2 | |
262 ## Usage : my ( var2 ) = config_hr_exe( $hr_path, $hr_delta, $mass, $has_goldenrules, $atoms_and_ranks ) ; | |
263 | |
264 =cut | |
265 ## START of SUB | |
266 sub config_hr_exe { | |
267 ## Retrieve Values | |
268 my $self = shift ; | |
269 my ( $hr_path, $hr_delta, $mass, $has_goldenrules, $atoms_and_ranks ) = @_ ; | |
270 my $hr_cmd = undef ; | |
271 | |
272 if ( ( defined $$hr_path ) and ( defined $$hr_delta ) and ( defined $$mass ) and ( defined $$atoms_and_ranks ) ) { | |
273 $hr_cmd = $$hr_path.' -t '.$$hr_delta.' -m '.$$mass.' '.$$atoms_and_ranks ; | |
274 if ( defined $$has_goldenrules ) { $$hr_cmd .= ' -g ' ; } | |
275 } ## END IF | |
276 else { warn "Some argvts are missing to build the current hr exec line\n" ; } | |
277 | |
278 return(\$hr_cmd) ; | |
279 } | |
280 ## END of SUB | |
281 | |
282 =head2 METHOD threading_hr_exe | |
283 | |
284 ## Description : prepare 5 threads for hr executing | |
285 ## Input : $method, $list | |
286 ## Output : $results | |
287 ## Usage : my ( $results ) = threading_hr_exe( $method, $list ) ; | |
288 | |
289 =cut | |
290 ## START of SUB | |
291 sub threading_hr_exe { | |
292 ## Retrieve Values | |
293 my $self = shift ; | |
294 my ( $method, $list ) = @_ ; | |
295 | |
296 my @results = () ; | |
297 | |
298 if ( ( defined $list ) and ( defined $method )) { | |
299 | |
300 for (my $i = 0; $i < (scalar @{$list}); $i+=6 ) { | |
301 my $thr1 = threads->create($method, $self, $list->[$i]) if $list->[$i] ; | |
302 my $thr2 = threads->create($method, $self, $list->[$i+1]) if $list->[$i+1] ; | |
303 my $thr3 = threads->create($method, $self, $list->[$i+2]) if $list->[$i+2] ; | |
304 my $thr4 = threads->create($method, $self, $list->[$i+3]) if $list->[$i+3] ; | |
305 my $thr5 = threads->create($method, $self, $list->[$i+4]) if $list->[$i+4] ; | |
306 my $thr6 = threads->create($method, $self, $list->[$i+5]) if $list->[$i+5] ; | |
307 push ( @results, $thr1->join ) if $list->[$i] ; | |
308 push ( @results, $thr2->join ) if $list->[$i+1] ; | |
309 push ( @results, $thr3->join ) if $list->[$i+2] ; | |
310 push ( @results, $thr4->join ) if $list->[$i+3] ; | |
311 push ( @results, $thr5->join ) if $list->[$i+4] ; | |
312 push ( @results, $thr6->join ) if $list->[$i+5] ; | |
313 } | |
314 } | |
315 else { | |
316 warn "Your input list or your method is undefined\n" ; | |
317 } | |
318 | |
319 return(\@results) ; | |
320 } | |
321 ## END of SUB | |
322 | |
323 =head2 METHOD hr_exe | |
324 | |
325 ## Description : hr_exe launches hr and catches result | |
326 ## Input : $cmd | |
327 ## Output : $res | |
328 ## Usage : my ( $res ) = hr_exe( $cmd ) ; | |
329 | |
330 =cut | |
331 ## START of SUB | |
332 sub hr_exe { | |
333 ## Retrieve Values | |
334 my $self = shift ; | |
335 my ( $cmd ) = @_ ; | |
336 my $res = undef ; | |
337 | |
338 if (defined $cmd){ | |
339 #print "\n--CMD used : $cmd\n" ; | |
340 $res = `$cmd` ; | |
341 sleep(0.5) ; | |
342 #print "Results : $res\n" ; | |
343 } | |
344 | |
345 return (\$res) ; | |
346 } | |
347 ## END of SUB | |
348 | |
349 | |
350 =head2 METHOD hr_out_parser | |
351 | |
352 ## Description : parse output of hr and return a hash of features | |
353 ## Input : $res | |
354 ## Output : $parsed_res | |
355 ## Usage : my ( $parsed_res ) = hr_out_parser( $res ) ; | |
356 | |
357 =cut | |
358 ## START of SUB | |
359 sub hr_out_parser { | |
360 ## Retrieve Values | |
361 my $self = shift ; | |
362 my ( $res ) = @_ ; | |
363 | |
364 my %parsed_res = () ; | |
365 my ( @formula, @rings_and_double_bond_equivalents, @formula_mz, @mmus ) = ( (), (), (), () ) ; | |
366 my ( $formula_nb, $formula_total, $time ) = ( undef, undef, undef ) ; | |
367 | |
368 if ( defined $$res ) { | |
369 # foreach line | |
370 foreach my $line (split(/\n/,$$res)){ | |
371 ## v1.02 - parse result line "C7.H17.N5. 2.0 171.1484 +17.2 mmu" | |
372 ## v1.03 - parse result line "C10.H25.N5.O5.P2.S2. C10H25N5O5P2S2 8.00 421.0772333 0 0 +0.40" | |
373 ## $1 = "C10.H25.N5.O5.P2.S2. " $2 = "C10H25N5O5P2S2" $3 = "8.00" $4="421.0772333" $5="0" $6="0" $7="+0.40" | |
374 ## if ( $line =~ /([\w|\.]+)\s+(\d+.?\d*)\s+(\d+.?\d*)\s+([+|-]\d+.?\d*)\s+(.*)/ ) { ## for hr2 1.02 | |
375 | |
376 if ( $line =~ /([\w|\.]+)\s+(\w+)\s+(\d+.?\d*)\s+(\d+.?\d*)\s+(\d+.?\d*)\s+(\d+.?\d*)\s+([+|-]\d+.?\d*)/ ) { # for hr2 1.03 | |
377 my ( $formula, $cleanformula, $rings_and_double_bond_equivalent, $formula_mz, $abscharge, $nadd, $mmu_value ) = ( $1, $2, $3, $4, $5, $6, $7 ) ; | |
378 | |
379 if (defined $formula ) { $formula =~ s/\.//g ; push (@formula, $formula) ; } # clean \. | |
380 if (defined $rings_and_double_bond_equivalent ) { push (@rings_and_double_bond_equivalents, $rings_and_double_bond_equivalent) ; } # | |
381 if (defined $formula_mz ) { push (@formula_mz, $formula_mz) ; } | |
382 if (defined $mmu_value ) { $mmu_value =~ s/\+// ; push (@mmus, $mmu_value) ; } # clean (+) | |
383 } | |
384 elsif ( $line =~ /(\d+)\s+formulas.+\s+(\d+)\s+seconds.+\s+(\d+)\s+formulae/ ) { | |
385 ( $formula_nb, $time, $formula_total ) = ( $1, $2, $3 ) ; | |
386 } | |
387 else { next; } | |
388 } | |
389 # build parser | |
390 if ( scalar(@formula) > 0 ){ | |
391 $parsed_res{'ENTRY_FORMULA'} = \@formula ; | |
392 $parsed_res{'rings_and_double_bond_equivalents'} = \@rings_and_double_bond_equivalents ; | |
393 $parsed_res{'ENTRY_CPD_MZ'} = \@formula_mz ; | |
394 $parsed_res{'ENTRY_DELTA'} = \@mmus ; | |
395 $parsed_res{'MASSES_TOTAL'} = \$formula_nb ; | |
396 $parsed_res{'time'} = \$time ; | |
397 } | |
398 } | |
399 return(\%parsed_res) ; | |
400 } | |
401 ## END of SUB | |
402 | |
403 | |
404 =head2 METHOD set_html_tbody_object | |
405 | |
406 ## Description : initializes and build the tbody object (perl array) need to html template | |
407 ## Input : $nb_pages, $nb_items_per_page | |
408 ## Output : $tbody_object | |
409 ## Usage : my ( $tbody_object ) = set_html_tbody_object($nb_pages, $nb_items_per_page) ; | |
410 | |
411 =cut | |
412 ## START of SUB | |
413 sub set_html_tbody_object { | |
414 my $self = shift ; | |
415 my ( $nb_pages, $nb_items_per_page ) = @_ ; | |
416 | |
417 my ( @tbody_object ) = ( ) ; | |
418 | |
419 for ( my $i = 1 ; $i <= $nb_pages ; $i++ ) { | |
420 | |
421 my %pages = ( | |
422 # tbody feature | |
423 PAGE_NB => $i, | |
424 MASSES => [], ## end MASSES | |
425 ) ; ## end TBODY N | |
426 push (@tbody_object, \%pages) ; | |
427 } | |
428 return(\@tbody_object) ; | |
429 } | |
430 ## END of SUB | |
431 | |
432 =head2 METHOD add_mz_to_tbody_object | |
433 | |
434 ## Description : initializes and build the mz object (perl array) need to html template | |
435 ## Input : $tbody_object, $nb_items_per_page, $mz_list | |
436 ## Output : $tbody_object | |
437 ## Usage : my ( $tbody_object ) = add_mz_to_tbody_object( $tbody_object, $nb_items_per_page, $mz_list ) ; | |
438 | |
439 =cut | |
440 ## START of SUB | |
441 sub add_mz_to_tbody_object { | |
442 my $self = shift ; | |
443 my ( $tbody_object, $nb_items_per_page, $mz_list, $ids_list, $totals ) = @_ ; | |
444 | |
445 my ( $current_page, $mz_index ) = ( 0, 0 ) ; | |
446 | |
447 foreach my $page ( @{$tbody_object} ) { | |
448 | |
449 my @colors = ('white', 'green') ; | |
450 my ( $current_index, , $icolor ) = ( 0, 0 ) ; | |
451 | |
452 for ( my $i = 1 ; $i <= $nb_items_per_page ; $i++ ) { | |
453 # | |
454 if ( $current_index > $nb_items_per_page ) { ## manage exact mz per html page | |
455 $current_index = 0 ; | |
456 last ; ## | |
457 } | |
458 else { | |
459 $current_index++ ; | |
460 if ( $icolor > 1 ) { $icolor = 0 ; } | |
461 | |
462 if ( exists $mz_list->[$mz_index] ) { | |
463 my $total = \0 ; | |
464 if ( $totals->[$mz_index]{'MASSES_TOTAL'} ) { $total = $totals->[$mz_index]{'MASSES_TOTAL'} } | |
465 | |
466 my %mz = ( | |
467 # mass feature | |
468 MASSES_ID_QUERY => $ids_list->[$mz_index], | |
469 MASSES_MZ_QUERY => $mz_list->[$mz_index], | |
470 MZ_COLOR => $colors[$icolor], | |
471 MASSES_NB => $mz_index+1, | |
472 MASSES_TOTAL => $$total , | |
473 ENTRIES => [] , | |
474 ) ; | |
475 push ( @{ $tbody_object->[$current_page]{MASSES} }, \%mz ) ; | |
476 # Html attr for mass | |
477 $icolor++ ; | |
478 } | |
479 } | |
480 $mz_index++ ; | |
481 } ## foreach mz | |
482 | |
483 $current_page++ ; | |
484 } | |
485 return($tbody_object) ; | |
486 } | |
487 ## END of SUB | |
488 | |
489 =head2 METHOD add_entries_to_tbody_object | |
490 | |
491 ## Description : initializes and build the mz object (perl array) need to html template | |
492 ## Input : $tbody_object, $nb_items_per_page, $mz_list, $entries | |
493 ## Output : $tbody_object | |
494 ## Usage : my ( $tbody_object ) = add_entries_to_tbody_object( $tbody_object, $nb_items_per_page, $mz_list, $entries ) ; | |
495 | |
496 =cut | |
497 ## START of SUB | |
498 sub add_entries_to_tbody_object { | |
499 ## Retrieve Values | |
500 my $self = shift ; | |
501 my ( $tbody_object, $results ) = @_ ; | |
502 | |
503 my $index_page = 0 ; | |
504 my $index_mz_continous = 0 ; | |
505 | |
506 foreach my $page (@{$tbody_object}) { | |
507 | |
508 my $index_mz = 0 ; | |
509 | |
510 foreach my $mz (@{ $tbody_object->[$index_page]{MASSES} }) { | |
511 | |
512 my $index_res = 0 ; | |
513 if ( $results->[$index_mz_continous]{ENTRY_FORMULA} ){ | |
514 | |
515 my $entry_nb = scalar( @{ $results->[$index_mz_continous]{ENTRY_FORMULA} } ) ; | |
516 for( my $i = 0 ; $i<$entry_nb; $i++ ) { | |
517 my %entry = ( | |
518 ENTRY_COLOR => $tbody_object->[$index_page]{MASSES}[$index_mz]{MZ_COLOR}, | |
519 ENTRY_FORMULA => $results->[$index_mz_continous]->{ENTRY_FORMULA}[$i], | |
520 ENTRY_CPD_MZ => $results->[$index_mz_continous]->{ENTRY_CPD_MZ}[$i], | |
521 ENTRY_DELTA => $results->[$index_mz_continous]->{ENTRY_DELTA}[$i] | |
522 ) ; | |
523 push ( @{ $tbody_object->[$index_page]{MASSES}[$index_mz]{ENTRIES} }, \%entry) ; | |
524 } | |
525 $index_res++ ; | |
526 } | |
527 $index_mz ++ ; | |
528 $index_mz_continous ++ ; | |
529 } | |
530 $index_page++ ; | |
531 } | |
532 return($tbody_object) ; | |
533 } | |
534 ## END of SUB | |
535 | |
536 =head2 METHOD write_html_skel | |
537 | |
538 ## Description : prepare and write the html output file | |
539 ## Input : $html_file_name, $html_object, $html_template | |
540 ## Output : $html_file_name | |
541 ## Usage : my ( $html_file_name ) = write_html_skel( $html_file_name, $html_object ) ; | |
542 | |
543 =cut | |
544 ## START of SUB | |
545 sub write_html_skel { | |
546 ## Retrieve Values | |
547 my $self = shift ; | |
548 my ( $html_file_name, $html_object, $pages , $search_condition, $html_template, $js_path, $css_path ) = @_ ; | |
549 | |
550 my $html_file = $$html_file_name ; | |
551 | |
552 if ( defined $html_file ) { | |
553 open ( HTML, ">$html_file" ) or die "Can't create the output file $html_file " ; | |
554 | |
555 if (-e $html_template) { | |
556 my $ohtml = HTML::Template->new(filename => $html_template); | |
557 $ohtml->param( JS_GALAXY_PATH => $js_path, CSS_GALAXY_PATH => $css_path ) ; | |
558 $ohtml->param( CONDITIONS => $search_condition ) ; | |
559 $ohtml->param( PAGES_NB => $pages ) ; | |
560 $ohtml->param( PAGES => $html_object ) ; | |
561 print HTML $ohtml->output ; | |
562 } | |
563 else { | |
564 croak "Can't fill any html output : No template available ($html_template)\n" ; | |
565 } | |
566 | |
567 close (HTML) ; | |
568 } | |
569 else { | |
570 croak "No output file name available to write HTML file\n" ; | |
571 } | |
572 return(\$html_file) ; | |
573 } | |
574 ## END of SUB | |
575 | |
576 =head2 METHOD write_csv_one_mass | |
577 | |
578 ## Description : print a csv file | |
579 ## Input : $masses, $ids, $results, $file | |
580 ## Output : N/A | |
581 ## Usage : write_csv_one_mass( $ids, $results, $file ) ; | |
582 | |
583 =cut | |
584 ## START of SUB | |
585 sub write_csv_one_mass { | |
586 ## Retrieve Values | |
587 my $self = shift ; | |
588 my ( $masses, $ids, $results, $file, ) = @_ ; | |
589 | |
590 open(CSV, '>:utf8', "$file") or die "Cant' create the file $file\n" ; | |
591 print CSV "ID\tMASS_SUBMIT\tCPD_FORMULA\tCPD_MW\tDELTA\n" ; | |
592 | |
593 my $i = 0 ; | |
594 | |
595 foreach my $id (@{$ids}) { | |
596 my $mass = $masses->[$i] ; | |
597 | |
598 if ( $results->[$i] ) { ## an requested id has a result in the list of hashes $results. | |
599 | |
600 my $entry_nb = 0 ; | |
601 | |
602 ## in case of no results -- Hr_parsed Results : $VAR1 = [ { 'ENTRY_FORMULA' => [] } ]; | |
603 if ( !$results->[$i]{'ENTRY_FORMULA'} ) { print CSV "$id\t$mass\tN/A\t0.0\t0.0\n" ; } | |
604 | |
605 foreach (@{$results->[$i]{'ENTRY_FORMULA'}}) { | |
606 | |
607 print CSV "$id\t$mass\t" ; | |
608 ## print cpd formula | |
609 if ( $results->[$i]{'ENTRY_FORMULA'}[$entry_nb] ) { print CSV "$results->[$i]{'ENTRY_FORMULA'}[$entry_nb]\t" ; } | |
610 else { print CSV "N/A\t" ; } | |
611 ## print cpd name | |
612 if ( $results->[$i]{'ENTRY_CPD_MZ'}[$entry_nb] ) { print CSV "$results->[$i]{'ENTRY_CPD_MZ'}[$entry_nb]\t" ; } | |
613 else { print CSV "0.0\t" ; } | |
614 ## print delta | |
615 if ( $results->[$i]{'ENTRY_DELTA'}[$entry_nb] ) { print CSV "$results->[$i]{'ENTRY_DELTA'}[$entry_nb]\n" ; } | |
616 else { print CSV "0.0\n" ; } | |
617 $entry_nb++ ; | |
618 } | |
619 } | |
620 else { | |
621 print CSV "$id\t$mass\tN/A\t0.0\t0.0\n" ; | |
622 } | |
623 $i++ ; | |
624 } | |
625 close(CSV) ; | |
626 return() ; | |
627 } | |
628 ## END of SUB | |
629 | |
630 =head2 METHOD add_hr_matrix_to_input_matrix | |
631 | |
632 ## Description : build a full matrix (input + lm column) | |
633 ## Input : $input_matrix_object, $lm_matrix_object | |
634 ## Output : $output_matrix_object | |
635 ## Usage : my ( $output_matrix_object ) = add_hr_matrix_to_input_matrix( $input_matrix_object, $hr_matrix_object ) ; | |
636 | |
637 =cut | |
638 ## START of SUB | |
639 sub add_hr_matrix_to_input_matrix { | |
640 ## Retrieve Values | |
641 my $self = shift ; | |
642 my ( $input_matrix_object, $hr_matrix_object ) = @_ ; | |
643 | |
644 my @output_matrix_object = () ; | |
645 my $index_row = 0 ; | |
646 | |
647 foreach my $row ( @{$input_matrix_object} ) { | |
648 my @init_row = @{$row} ; | |
649 | |
650 if ( $hr_matrix_object->[$index_row] ) { | |
651 my $dim = scalar(@{$hr_matrix_object->[$index_row]}) ; | |
652 | |
653 if ($dim > 1) { warn "the add method can't manage more than one column\n" ;} | |
654 my $lm_col = $hr_matrix_object->[$index_row][$dim-1] ; | |
655 | |
656 push (@init_row, $lm_col) ; | |
657 $index_row++ ; | |
658 } | |
659 push (@output_matrix_object, \@init_row) ; | |
660 } | |
661 return(\@output_matrix_object) ; | |
662 } | |
663 ## END of SUB | |
664 | |
665 =head2 METHOD write_csv_skel | |
666 | |
667 ## Description : prepare and write csv output file | |
668 ## Input : $csv_file, $rows | |
669 ## Output : $csv_file | |
670 ## Usage : my ( $csv_file ) = write_csv_skel( $csv_file, $rows ) ; | |
671 | |
672 =cut | |
673 ## START of SUB | |
674 sub write_csv_skel { | |
675 ## Retrieve Values | |
676 my $self = shift ; | |
677 my ( $csv_file, $rows ) = @_ ; | |
678 | |
679 my $ocsv = lib::csv::new() ; | |
680 my $csv = $ocsv->get_csv_object("\t") ; | |
681 $ocsv->write_csv_from_arrays($csv, $$csv_file, $rows) ; | |
682 | |
683 return($csv_file) ; | |
684 } | |
685 ## END of SUB | |
686 | |
687 =head2 METHOD set_hr_matrix_object | |
688 | |
689 ## Description : build the hr_row under its ref form | |
690 ## Input : $header, $init_mzs, $entries | |
691 ## Output : $hr_matrix | |
692 ## Usage : my ( $hmdb_matrix ) = set_hr_matrix_object( $header, $init_mzs, $entries ) ; | |
693 | |
694 =cut | |
695 ## START of SUB | |
696 sub set_hr_matrix_object { | |
697 ## Retrieve Values | |
698 my $self = shift ; | |
699 my ( $header, $init_mzs, $entries ) = @_ ; | |
700 | |
701 my @hr_matrix = () ; | |
702 | |
703 if ( defined $header ) { | |
704 my @headers = () ; | |
705 push @headers, $header ; | |
706 push @hr_matrix, \@headers ; | |
707 } | |
708 | |
709 my $index_mz = 0 ; | |
710 | |
711 foreach my $mz ( @{$init_mzs} ) { | |
712 | |
713 my $index_entries = 0 ; | |
714 my @clusters = () ; | |
715 my $cluster_col = undef ; | |
716 | |
717 my $nb_entries = $entries->[$index_mz]{MASSES_TOTAL} ; | |
718 | |
719 foreach (@{$entries->[$index_mz]{'ENTRY_FORMULA'}}) { | |
720 | |
721 my $delta = $entries->[$index_mz]{'ENTRY_DELTA'}[$index_entries] ; | |
722 my $hr_formula = $entries->[$index_mz]{'ENTRY_FORMULA'}[$index_entries] ; | |
723 my $hr_mz = $entries->[$index_mz]{'ENTRY_CPD_MZ'}[$index_entries] ; | |
724 | |
725 | |
726 ## METLIN data display model | |
727 ## entry1=VAR1::VAR2::VAR3::VAR4|entry2=VAR1::VAR2::VAR3::VAR4|... | |
728 # manage final pipe | |
729 if ($index_entries < $$nb_entries-1 ) { $cluster_col .= $delta.'::('.$hr_formula.')::'.$hr_mz.'|' ; } | |
730 else { $cluster_col .= $delta.'::('.$hr_formula.')::'.$hr_mz ; } | |
731 | |
732 $index_entries++ ; | |
733 } ## end foreach | |
734 if ( !defined $cluster_col ) { $cluster_col = 'No_result_found_with HR' ; } | |
735 push (@clusters, $cluster_col) ; | |
736 push (@hr_matrix, \@clusters) ; | |
737 $index_mz++ ; | |
738 } | |
739 return(\@hr_matrix) ; | |
740 } | |
741 ## END of SUB | |
742 | |
743 | |
744 | |
745 1 ; | |
746 | |
747 | |
748 __END__ | |
749 | |
750 =head1 SUPPORT | |
751 | |
752 You can find documentation for this module with the perldoc command. | |
753 | |
754 perldoc hr.pm | |
755 | |
756 =head1 Exports | |
757 | |
758 =over 4 | |
759 | |
760 =item :ALL is manage_atoms, check_hr_exe, manage_tolerance | |
761 | |
762 =back | |
763 | |
764 =head1 AUTHOR | |
765 | |
766 Franck Giacomoni E<lt>franck.giacomoni@clermont.inra.frE<gt> | |
767 | |
768 =head1 LICENSE | |
769 | |
770 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. | |
771 | |
772 =head1 VERSION | |
773 | |
774 version 1 : 02 / 20 / 2014 | |
775 | |
776 version 2 : ?? | |
777 | |
778 =cut |