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 |