Mercurial > repos > fgiacomoni > massbank_ws_searchspectrum
diff lib/mapper.pm @ 0:023c380900ef draft default tip
Init repository with last massbank_ws_searchspectrum master version
author | fgiacomoni |
---|---|
date | Wed, 19 Apr 2017 11:31:58 -0400 |
parents | |
children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lib/mapper.pm Wed Apr 19 11:31:58 2017 -0400 @@ -0,0 +1,899 @@ +package lib::mapper ; + +use strict; +use warnings ; +use Exporter ; +use Carp ; + +use Data::Dumper ; + +use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS); + +our $VERSION = "1.0"; +our @ISA = qw(Exporter); +our @EXPORT = qw( add_min_max_for_pcgroup_res get_massbank_records_by_chunk compute_ids_from_pcgroups_res filter_pcgroup_res get_pcgroup_list get_pcgroups set_massbank_matrix_object add_massbank_matrix_to_input_matrix map_pc_to_generic_json set_html_tbody_object add_mz_to_tbody_object add_entries_to_tbody_object); +our %EXPORT_TAGS = ( ALL => [qw( add_min_max_for_pcgroup_res get_massbank_records_by_chunk compute_ids_from_pcgroups_res filter_pcgroup_res get_pcgroup_list get_pcgroups set_massbank_matrix_object add_massbank_matrix_to_input_matrix map_pc_to_generic_json set_html_tbody_object add_mz_to_tbody_object add_entries_to_tbody_object)] ); + +=head1 NAME + +My::Module - An example module + +=head1 SYNOPSIS + + use My::Module; + my $object = My::Module->new(); + print $object->as_string; + +=head1 DESCRIPTION + +This module does not really exist, it +was made for the sole purpose of +demonstrating how POD works. + +=head1 METHODS + +Methods are : + +=head2 METHOD new + + ## Description : new + ## Input : $self + ## Ouput : bless $self ; + ## Usage : new() ; + +=cut + +sub new { + ## Variables + my $self={}; + bless($self) ; + return $self ; +} +### END of SUB + +=head2 METHOD get_pcgroups + + ## Description : get and prepare pcgroup features (mzs, into, names) from input cvs parser + ## Input : $pcs, $mzs, $ints, $names + ## Output : $pcgroups + ## Usage : my ( $pcgroups ) = get_pcgroups( $pcs, $mzs, $ints, $names ) ; + +=cut +## START of SUB +sub get_pcgroups { + my $self = shift; + my ( $pcs, $mzs, $ints ) = @_; + + my %pcgroups = () ; + my $i = 0 ; + + ## Warn diff matrix dimension : + my $num_pcs = scalar(@{$pcs}) ; + my $num_mzs = scalar(@{$mzs}) ; + my $num_ints = scalar(@{$ints}) ; + + if ( ($num_pcs == $num_mzs ) and ( $num_mzs == $num_ints ) ) { + my @pcs = @{$pcs} ; + + foreach my $pc (@{$pcs}) { + + if ( ! $pcgroups{$pc} ) { $pcgroups{$pc}->{'id'} = $pc ; $pcgroups{$pc}->{'annotation'} = {} ; $pcgroups{$pc}->{'massbank_ids'} = [] ; } + + push (@{$pcgroups{$pc}->{'mzmed'}}, $mzs->[$i]) if ($mzs->[$i]) ; ## map mzs by pcgroup + + if ($ints->[$i] > 0 ) { push (@{$pcgroups{$pc}->{'into'}}, $ints->[$i]) ; ## map into by pcgroup + } + elsif ($ints->[$i] == 0) { + push (@{$pcgroups{$pc}->{'into'}}, $ints->[$i]) ; ## map into by pcgroup even value is 0 + } + else { + warn "Undefined value found in pcgroups array\n" ; + } + $i++ ; + } + } + else { + warn "The different ARRAYS (pcs, mzs, ints) doesn't have the same size : mapping is not possible \n!!" + } + return (\%pcgroups) ; +} +### END of SUB + +=head2 METHOD get_pcgroup_list + + ## Description : get and prepare unik pcgroup list from input cvs parsed list + ## Input : $pcs + ## Output : $list + ## Usage : my ( $list ) = get_pcgroup_list( $pcs ) ; + +=cut +## START of SUB +sub get_pcgroup_list { + my $self = shift; + my ( $pcs ) = @_; + + my @pcgroup_list = () ; + my $i = 0 ; + + my %hash = map { $_, 1 } @{$pcs} ; + @pcgroup_list = keys %hash; + @pcgroup_list = sort { $a <=> $b } @pcgroup_list ; + + return (\@pcgroup_list) ; +} + +### END of SUB + + +=head2 METHOD filter_pcgroup_res + + ## Description : This method filter the results returned by massbank with a user defined score threshold + ## Input : $pcgroups, $threshold + ## Output : $pcgroups + ## Usage : my ( $pcgroups ) = filter_pcgroup_res ( $pcgroups, $threshold ) ; + +=cut +## START of SUB +sub filter_pcgroup_res { + ## Retrieve Values + my $self = shift ; + my ( $pcgroups, $threshold ) = @_ ; + + my %temp = () ; + + if (!defined $threshold) { + $threshold = 0.5 ; ## default value + } + + if ( (defined $pcgroups) and (defined $threshold) ) { + %temp = %{$pcgroups} ; + + foreach my $pc (keys %temp) { + + if ( $temp{$pc}{'annotation'}{'num_res'} > 0 ) { + my @filtered_annot = reverse(grep { $_->{'score'} >= $threshold if ($_->{'score'}) } @{$temp{$pc}{'annotation'}{'res'}}) ; + my $new_num_res = scalar (@filtered_annot) ; + my @ids = () ; + foreach (@filtered_annot) { push (@ids, $_->{'id'} ) } + $temp{$pc}{'annotation'}{'res'} =\@filtered_annot ; + $temp{$pc}{'annotation'}{'num_res'} = $new_num_res ; + $temp{$pc}{'massbank_ids'} = \@ids ; + } + else { + warn "No result found for this pcgroup $pc\n" ; + } + } + } ## End IF + else { + warn "No pcgroup and threshold defined\n" ; + } + return (\%temp) ; +} +### END of SUB + +=head2 METHOD add_min_max_for_pcgroup_res + + ## Description : This method add min / max value for each mzmed contained in pcgroup + ## Input : $pcgroups + ## Output : $pcgroups + ## Usage : my ( $pcgroups ) = add_min_max_for_pcgroup_res ( $pcgroups ) ; + +=cut +## START of SUB +sub add_min_max_for_pcgroup_res { + ## Retrieve Values + my $self = shift ; + my ( $pcgroups, $delta ) = @_ ; + + my %temp = () ; + + if (!defined $delta) { + $delta = 0.01 ; ## default value + } + + if ( defined $pcgroups) { + %temp = %{$pcgroups} ; + + foreach my $pc (keys %temp) { + my %mz_intervales = () ; + if ( $temp{$pc}{'mzmed'} ) { + my @temp = @{$temp{$pc}{'mzmed'}} ; + foreach my $mz (@temp) { + my ($min, $max) = lib::mapper::new->min_and_max_from_double_with_delta($mz, 'Da', $delta); + $mz_intervales{$mz} = {'min' => $min, 'max' => $max } ; + } + } + else { + warn "No mzmed found for this pcgroup\n" ; + } + $temp{$pc}{'intervales'} = \%mz_intervales ; + + } + } ## End IF + else { + warn "No pcgroup and threshold defined\n" ; + } + return (\%temp) ; +} +### END of SUB + + + +=head2 METHOD min_and_max_from_double_with_delta + + ## Description : returns the minimum and maximum double according to the delta + ## Input : \$double, \$delta_type, \$delta + ## Output : \$min, \$max + ## Usage : ($min, $max)= min_and_max_from_double_with_delta($double, $delta_type, $mz_delta) ; + +=cut +## START of SUB +sub min_and_max_from_double_with_delta { + ## Retrieve Values + my $self = shift ; + my ( $double, $delta_type, $delta ) = @_ ; + my ( $min, $max ) = ( undef, undef ) ; + + if ($delta_type eq 'ppm'){ + $min = $double - ($delta * 10**-6 * $double); + $max = $double + ($delta * 10**-6 * $double) + 0.0000000001; ## it's to included the maximum value in the search + } + elsif ($delta_type eq 'Da'){ + $min = $double - $delta; + $max = $double + $delta + 0.0000000001; ## it's to included the maximum value in the search + } + else { croak "The double delta type '$delta_type' isn't a valid type !\n" ; } + + return($min, $max) ; +} +## END of SUB + + +=head2 METHOD compute_ids_from_pcgroups_res + + ## Description : get all ids returned by massbank with sent queries and keep only unique ones. + ## Input : $pcgroups + ## Output : $unique_ids + ## Usage : my ( $unique_ids ) = compute_ids_from_pcgroups_res ( $pcgroups ) ; + +=cut +## START of SUB +sub compute_ids_from_pcgroups_res { + ## Retrieve Values + my $self = shift ; + my ( $pcgroups ) = @_; + my ( @ids, @unique ) = ( (), () ) ; + + if ( defined $pcgroups ) { + + foreach my $pc ( keys %{$pcgroups} ) { + if ( $pcgroups->{$pc}{'massbank_ids'} ) { + push (@ids , @{ $pcgroups->{$pc}{'massbank_ids'} } ) ; + } + } + + if ( ( scalar (@ids) ) > 0 ) { +# print Dumper @ids ; + @unique = do { my %seen; grep { !$seen{$_}++ if (defined $_) } @ids }; + @unique = sort { $a cmp $b } @unique; + } + else { + @unique = () ; + } + + + } + return (\@unique) ; +} +### END of SUB + + +=head2 METHOD get_massbank_records_by_chunk + + ## Description : get massbank records from a complete list but send queries chunk by chunk. + ## Input : $ids, $chunk_size + ## Output : $records + ## Usage : my ( $records ) = get_massbank_records_by_chunk ( $ids, $chunk_size ) ; + +=cut +## START of SUB +sub get_massbank_records_by_chunk { + ## Retrieve Values + my $self = shift ; + my ( $server, $ids, $chunk_size ) = @_; + my ( @records, @sent_ids ) = ( (), () ) ; + + my $current = 0 ; + my $pos = 1 ; + my @temp_ids = () ; + + my $num_ids = scalar(@{$ids}) ; +# print "The number of given massbank ids is: $num_ids\n" ; + + foreach my $id (@{$ids}) { + $current++ ; +# print "$id - - $current/$num_ids) - - $pos \n" ; + + if ( ($current == $num_ids) or ($pos == $chunk_size) ) { +# print "Querying Massbank with...\n" ; + push (@temp_ids, $id) ; + ## send query + my $omassbank = lib::massbank_api->new() ; + my ($osoap) = $omassbank->selectMassBank($server) ; + my ($records) = $omassbank->getRecordInfo($osoap, \@temp_ids) ; + push (@records, @{$records}) ; + + @temp_ids = () ; + $pos = 0 ; + } + elsif ($pos < $chunk_size) { +# print "store...\n"; + push (@temp_ids, $id) ; + $pos ++ ; + } + else { + warn "Something goes wrong : out of range\n" + } + + + } + my $num_records = scalar(@records) ; +# print "The number of received massbank records is: $num_records\n" ; + return (\@records) ; +} +### END of SUB + +=head2 METHOD set_massbank_matrix_object + + ## Description : build the massbank_row under its ref form + ## Input : $header, $init_pcs, $init_mzs, $pcgroups, $records + ## Output : $massbank_matrix + ## Usage : my ( $massbank_matrix ) = set_lm_matrix_object( $header, $init_pcs, $init_mzs, $pcgroups, $records ) ; + +=cut +## START of SUB +sub set_massbank_matrix_object { + ## Retrieve Values + my $self = shift ; + my ( $header, $init_pcs, $init_mzs, $pcgroups, $records ) = @_ ; + my @massbank_matrix = () ; + + my $current_pos = 0 ; + + ## format massbank(score::name::mz::formula::adduct::id) + if ( defined $header ) { + $header .= '(score::name::mz::formula::adduct::id)' ; + my @headers = () ; + push @headers, $header ; + push @massbank_matrix, \@headers ; + } + + ## foreach mz of the input file + foreach my $mz (@{$init_mzs}) { + + my $nb_ids = 0 ; + my @ids = () ; + + my $pc = $init_pcs->[$current_pos] ; ## get the rigth pcgroup with maz postion in list +# print "---> Current PCGROUP is $pc\n" ; + if ( $pcgroups->{$pc}{'enrich_annotation'}{$mz} ) { + ## get record_ids + my @massbank_ids = @{ $pcgroups->{$pc}{'enrich_annotation'}{$mz} } ; ## get validated ids relative to one mz + $nb_ids = scalar (@massbank_ids) ; +# print "- - - NB RECORDS FOR MZ $mz = $nb_ids - - STATUS => \t" ; + my $massbank_ids_string = undef ; + ## manage empty array + if (!defined $nb_ids) { carp "The number of massbank ids is not defined\n" ; } + elsif ( $nb_ids > 0 ) { + ## get data from records and init_annotation + my $index_entries = 0 ; + foreach my $record_id (@massbank_ids) { + my $massbank_name = $records->{$record_id}{names}[0] ; + my $massbank_id = $record_id ; + my $massbank_formula = $records->{$record_id}{formula} ; + my $massbank_cpd_mz = $records->{$record_id}{exact_mz} ; + my $massbank_adduct = $records->{$record_id}{precursor_type} ; + my $massbank_score = 0 ; + + ## getting the score + my @filtered_records= @{ $pcgroups->{$pc}{'annotation'}{res} } ; + foreach my $record (@filtered_records) { + if ($record->{id} eq $massbank_id ) { + $massbank_score = $record->{score} ; + last ; + } + else { + next ; + } + } + + ## METLIN data display model + ## entry1= ENTRY_DELTA::ENTRY_ENTRY_NAME::ENTRY_CPD_MZ::ENTRY_FORMULA::ENTRY_ADDUCT::ENTRY_ENTRY_ID | entry2=VAR1::VAR2::VAR3::VAR4|... + my $massbank_id_string = $massbank_score.'::['."$massbank_name".']::'.$massbank_cpd_mz.'::'.$massbank_formula.'::['.$massbank_adduct.']::'.$massbank_id ; + + # manage final pipe + if ($index_entries < $nb_ids-1 ) { $massbank_ids_string .= $massbank_id_string.' | ' ; } + else { $massbank_ids_string .= $massbank_id_string ; } + $index_entries++; + } + } + elsif ( $nb_ids == 0 ) { $massbank_ids_string = 'NONE' ; } + else { + $massbank_ids_string = 'NONE' ; + } +# print "$massbank_ids_string\n" ; + push (@ids, $massbank_ids_string) ; + } ## End if + else { + next; + } + $current_pos++ ; + + push (@massbank_matrix, \@ids) ; + } ## End foreach mz +# print "* * * * Start of the MATRIX: * * * *\n" ; +# print Dumper @massbank_matrix ; +# print "* * * * END of the MATRIX * * * *\n" ; + return(\@massbank_matrix) ; +} +## END of SUB + +=head2 METHOD add_massbank_matrix_to_input_matrix + + ## Description : build a full matrix (input + lm column) + ## Input : $input_matrix_object, $massbank_matrix_object + ## Output : $output_matrix_object + ## Usage : my ( $output_matrix_object ) = add_massbank_matrix_to_input_matrix( $input_matrix_object, $massbank_matrix_object ) ; + +=cut +## START of SUB +sub add_massbank_matrix_to_input_matrix { + ## Retrieve Values + my $self = shift ; + my ( $input_matrix_object, $massbank_matrix_object ) = @_ ; + + my @output_matrix_object = () ; + my $index_row = 0 ; + + foreach my $row ( @{$input_matrix_object} ) { + my @init_row = @{$row} ; + + if ( $massbank_matrix_object->[$index_row] ) { + my $dim = scalar(@{$massbank_matrix_object->[$index_row]}) ; + + if ($dim > 1) { warn "the add method can't manage more than one column\n" ;} + my $lm_col = $massbank_matrix_object->[$index_row][$dim-1] ; + + push (@init_row, $lm_col) ; + $index_row++ ; + } + push (@output_matrix_object, \@init_row) ; + } + return(\@output_matrix_object) ; +} +## END of SUB + +=head2 METHOD map_res_to_generic_json + + ## Description : build json structure with all massbank results + ## Input : $mzs, $pcs, $pcgroups_results + ## Output : $json_scalar + ## Usage : my ( $json_scalar ) = add_massbank_matrix_to_input_matrix( $mzs, $pcs, $pcgroups_results ) ; + +=cut +## START of SUB +sub map_pc_to_generic_json { + my $self = shift; + my ( $pcs, $pcgroups, $records ) = @_ ; + +# print Dumper $pcgroups ; +# print Dumper $records ; + + ## JSON DESIGN + my %JSON = ( + QUERY => {}, + PARAM => {}, + TYPE => {} + ) ; + + my %oEntry = ( + mzmed => undef, + into => undef, + mzmin => undef, + mzmax => undef, + pcgroup => undef, + num_res => undef, + RECORDS => undef, + ) ; + + + my %oRecord = ( + id => undef, + exact_mz => undef, + score => undef, + formula => undef, + inchi => undef, + ms_type => undef, + precursor_type => undef, + instrument_type => undef, + name => undef, + peaks => undef, + ) ; + + + + foreach my $pc (@{$pcs}) { + + my $pc_res = {} ; + my $num_res = undef ; + + if ($pcgroups->{$pc}) { + my $pos = 0 ; + ## foreach mz of the pcgroup + foreach my $mz (@{ $pcgroups->{$pc}{mzmed} } ) { + + my %entry = %oEntry ; + ## + if ( defined $mz ) { $entry{mzmed} = $mz ; } + if ( $pcgroups->{$pc}{intervales}{$mz} ) { $entry{mzmin} = $pcgroups->{$pc}{intervales}{$mz}{min} ; } + if ( $pcgroups->{$pc}{intervales}{$mz} ) { $entry{mzmax} = $pcgroups->{$pc}{intervales}{$mz}{max} ; } + if ( $pcgroups->{$pc}{into}[$pos] ) { $entry{into} = $pcgroups->{$pc}{into}[$pos] ; } + if ( defined $pc ) { $entry{pcgroup} = $pc ; } + ## get RECORDS + if ( $pcgroups->{$pc}{enrich_annotation}{$mz} ) { + + my @recs = @{ $pcgroups->{$pc}{enrich_annotation}{$mz} } ; + $entry{num_res} = scalar(@recs) ; + + foreach my $recId (@recs) { + + my %record = %oRecord ; + if ( $records->{$recId} ) { $record{id} = $recId ; } + if ( $records->{$recId}{exact_mz} ) { $record{exact_mz} = $records->{$recId}{exact_mz} ; } + if ( $records->{$recId}{formula} ) { $record{formula} = $records->{$recId}{formula} ; } + if ( $records->{$recId}{ms_type} ) { $record{ms_type} = $records->{$recId}{ms_type} ; } + if ( $records->{$recId}{precursor_type} ) { $record{precursor_type} = $records->{$recId}{precursor_type} ; } + if ( $records->{$recId}{instrument_type} ) { $record{instrument_type} = $records->{$recId}{instrument_type} ; } + if ( $records->{$recId}{names} ) { $record{name} = $records->{$recId}{names}[0] ; } + if ( $records->{$recId}{inchi} ) { $record{inchi} = $records->{$recId}{inchi} ; } + ## peaks TODO... + + ## Score / BIG SHIT / + foreach my $record (@{ $pcgroups->{$pc}{'annotation'}{res} }) { + if ($record->{id} eq $recId ) { + $record{score} = $record->{score} ; + last ; + } + else { + next ; + } + } ## foreach record - - - for score + $entry{RECORDS}{$recId} = \%record ; + } ## foreach recId + } ## end IF + + $JSON{QUERY}{$mz} = \%entry ; + $pos ++ ; + } ## End FOREACH MZ + } + else { + warn "The pc group $pc doesn't exist in results !" ; + } + } +# print Dumper %JSON ; + return(\%JSON) ; +} +## END of SUB + + +=head2 METHOD mapGroupsWithRecords + + ## Description : map records with pcgroups mz to adjust massbank id annotations + ## Input : $pcgroups, $records + ## Output : $pcgroups + ## Usage : my ( $var4 ) = mapGroupsWithRecords ( $$pcgroups, $records ) ; + +=cut +## START of SUB +sub mapGroupsWithRecords { + ## Retrieve Values + my $self = shift ; + my ( $pcgroups, $records ) = @_; + + my %temp = () ; + my (%intervales, @annotation_ids) = ( (), () ) ; + + if ( ( defined $pcgroups ) and ( defined $records ) ) { + + %temp = %{$pcgroups} ; + my %unik_real_ids = () ; + my @real_ids = () ; + + foreach my $pc (keys %temp) { + + if ( $temp{$pc}{'intervales'} ) { %intervales = %{$temp{$pc}{'intervales'}} ; } + else { warn "Cant't find any intervale values\n" ; } + if ( $temp{$pc}{'massbank_ids'} ) { @annotation_ids = @{$temp{$pc}{'massbank_ids'}} ; } + else { warn "Cant't find any massbank id values\n" ; } + +# print Dumper %intervales; +# print Dumper @annotation_ids ; + + ## map with intervales + foreach my $mz (keys %intervales) { + my @filteredIds = () ; + my ( $min, $max ) = ( $intervales{$mz}{'min'}, $intervales{$mz}{'max'} ) ; + + foreach my $id (@annotation_ids) { +# print "Analyse mzs of id: $id...\n" ; + if ( (defined $id) and ( $records->{$id}) ) { + + my %currentRecord = %{$records->{$id}} ; + + if (scalar @{$currentRecord{'peaks'} } > 0 ) { + ## + foreach my $peak_mz (@{ $currentRecord{'peaks'} } ) { + if ($peak_mz) { + my $record_mz = $peak_mz->{'mz'} ; + if ( ($record_mz > $min ) and ($record_mz < $max) ){ + + if (!exists $unik_real_ids{$id}) { + $unik_real_ids{$id} = 1 ; + push (@filteredIds, $id) ; + # print "$mz - - $id\n" ; + } + + + } + else { + next ; + } + } + else { + warn "The mz field is not defined\n" ; + } + } ## foreach + } + else { + warn "The record ($id) has no peak\n" ; + } + } + else { + if (defined $id) { + warn "The id $id seems to be not present in getting records\n" ; + } + else { + warn "This catched id seems to be undef in getting records\n" ; + } + + next ; + } + } ## end foreach + ## to avoid multiple ids +# foreach my $id (keys %unik_real_ids) { +# push(@real_ids, $id) ; +# } + %unik_real_ids = () ; +# my @temp = @real_ids ; + my @temp = @filteredIds ; + $temp{$pc}{'enrich_annotation'}{$mz} = \@temp ; + @real_ids = () ; + @filteredIds = () ; + } ## End foreach mz + @annotation_ids = () ; + } ## End foreach pc + } + else { + warn"Can't find record or pcgroup data\n" ; + } + + return (\%temp) ; +} +### END of SUB + +=head2 METHOD set_html_tbody_object + + ## Description : initializes and build the tbody object (perl array) needed to html template + ## Input : $nb_pages, $nb_items_per_page + ## Output : $tbody_object + ## Usage : my ( $tbody_object ) = set_html_tbody_object($nb_pages, $nb_items_per_page) ; + +=cut +## START of SUB +sub set_html_tbody_object { + my $self = shift ; + my ( $nb_pages, $nb_items_per_page ) = @_ ; + + my ( @tbody_object ) = ( ) ; + + for ( my $i = 1 ; $i <= $nb_pages ; $i++ ) { + + my %pages = ( + # tbody feature + PAGE_NB => $i, + MASSES => [], ## end MASSES + ) ; ## end TBODY N + push (@tbody_object, \%pages) ; + } + return(\@tbody_object) ; +} +## END of SUB + +=head2 METHOD add_mz_to_tbody_object + + ## Description : initializes and build the mz object (perl array) needed to html template + ## Input : $tbody_object, $nb_items_per_page, $mz_list + ## Output : $tbody_object + ## Usage : my ( $tbody_object ) = add_mz_to_tbody_object( $tbody_object, $nb_items_per_page, $mz_list ) ; + +=cut +## START of SUB +sub add_mz_to_tbody_object { + my $self = shift ; + my ( $tbody_object, $nb_items_per_page, $mz_list, $json ) = @_ ; + + my ( $current_page, $mz_index ) = ( 0, 0 ) ; + + foreach my $page ( @{$tbody_object} ) { + + my @colors = ('white', 'green') ; + my ( $current_index, , $icolor ) = ( 0, 0 ) ; + + for ( my $i = 1 ; $i <= $nb_items_per_page ; $i++ ) { + # + if ( $current_index > $nb_items_per_page ) { ## manage exact mz per html page + $current_index = 0 ; + last ; ## + } + else { + $current_index++ ; + if ( $icolor > 1 ) { $icolor = 0 ; } + + if ( exists $mz_list->[$mz_index] ) { + + my %mz = ( + # mass feature + MASSES_ID_QUERY => "mz_0".sprintf("%04s", $mz_index+1 ) , + MASSES_MZ_QUERY => $mz_list->[$mz_index], + MASSES_PCGROUP_QUERY => $json->{QUERY}{ $mz_list->[$mz_index] }{pcgroup} , + MZ_COLOR => $colors[$icolor], + MASSES_NB => $mz_index+1, + ENTRIES => [] , + ) ; + push ( @{ $tbody_object->[$current_page]{MASSES} }, \%mz ) ; + # Html attr for mass + $icolor++ ; + } + } + $mz_index++ ; + } ## foreach mz + + $current_page++ ; + } + return($tbody_object) ; +} +## END of SUB + +=head2 METHOD add_entries_to_tbody_object + + ## Description : initializes and build the entries object (perl array) needed to html template + ## Input : $tbody_object, $nb_items_per_page, $mz_list, $entries + ## Output : $tbody_object + ## Usage : my ( $tbody_object ) = add_entries_to_tbody_object( $tbody_object, $nb_items_per_page, $mz_list, $entries ) ; + +=cut +## START of SUB +sub add_entries_to_tbody_object { + ## Retrieve Values + my $self = shift ; + my ( $tbody_object, $nb_items_per_page, $mz_list, $JSON ) = @_ ; + + my $index_page = 0 ; + my $index_mz_continous = 0 ; + + foreach my $page (@{$tbody_object}) { + + my $index_mz = 0 ; + + foreach my $mz (@{ $tbody_object->[$index_page]{MASSES} }) { + my $index_entry = 0 ; + my $check_noentry = 0 ; + my @toSort = () ; + + foreach my $record (keys %{ $JSON->{QUERY}{$mz->{MASSES_MZ_QUERY}}{RECORDS} }) { + $check_noentry ++ ; + + my %entry = ( + ENTRY_COLOR => $tbody_object->[$index_page]{MASSES}[$index_mz]{MZ_COLOR}, + ENTRY_ENTRY_NAME => $JSON->{QUERY}{$mz->{MASSES_MZ_QUERY}}{RECORDS}{$record}{name}, + ENTRY_ENTRY_ID => $JSON->{QUERY}{$mz->{MASSES_MZ_QUERY}}{RECORDS}{$record}{id}, + ENTRY_ENTRY_ID2 => $JSON->{QUERY}{$mz->{MASSES_MZ_QUERY}}{RECORDS}{$record}{id}, + ENTRY_FORMULA => $JSON->{QUERY}{$mz->{MASSES_MZ_QUERY}}{RECORDS}{$record}{formula}, + ENTRY_CPD_MZ => $JSON->{QUERY}{$mz->{MASSES_MZ_QUERY}}{RECORDS}{$record}{exact_mz}, + ENTRY_MS_TYPE => $JSON->{QUERY}{$mz->{MASSES_MZ_QUERY}}{RECORDS}{$record}{ms_type}, + ENTRY_PRECURSOR_TYPE => $JSON->{QUERY}{$mz->{MASSES_MZ_QUERY}}{RECORDS}{$record}{precursor_type}, + ENTRY_INSTRUMENT_TYPE => $JSON->{QUERY}{$mz->{MASSES_MZ_QUERY}}{RECORDS}{$record}{instrument_type}, + ENTRY_SCORE => $JSON->{QUERY}{$mz->{MASSES_MZ_QUERY}}{RECORDS}{$record}{score}, + ENTRY_ENTRY_INCHI => $JSON->{QUERY}{$mz->{MASSES_MZ_QUERY}}{RECORDS}{$record}{inchi}, + ) ; + push ( @{ $tbody_object->[$index_page]{MASSES}[$index_mz]{ENTRIES} }, \%entry) ; + + $index_entry++ ; + } ## end foreach record + if ($check_noentry == 0 ) { + my %entry = ( + ENTRY_COLOR => $tbody_object->[$index_page]{MASSES}[$index_mz]{MZ_COLOR}, + ENTRY_ENTRY_NAME => 'UNKNOWN', + ENTRY_ENTRY_ID => 'NONE', + ENTRY_ENTRY_ID2 => '', + ENTRY_FORMULA => 'n/a', + ENTRY_CPD_MZ => 'n/a', + ENTRY_MS_TYPE => 'n/a', + ENTRY_PRECURSOR_TYPE => 'n/a', + ENTRY_INSTRUMENT_TYPE => 'n/a', + ENTRY_SCORE => 0, + ENTRY_ENTRY_INCHI => 'n/a', + ) ; + push ( @{ $tbody_object->[$index_page]{MASSES}[$index_mz]{ENTRIES} }, \%entry) ; + } + + ## sorted by score + my @sorted = () ; + my @temp = @{ $tbody_object->[$index_page]{MASSES}[$index_mz]{ENTRIES} } ; + if (scalar (@temp) > 1 ) { ## for mz without record (only one entry with NA or 0 values) + @sorted = sort { $b->{ENTRY_SCORE} <=> $a->{ENTRY_SCORE} } @temp; + } + else { + @sorted = @temp; + } + + $tbody_object->[$index_page]{MASSES}[$index_mz]{ENTRIES} = \@sorted ; + + $index_mz ++ ; + $index_mz_continous ++ ; + + } ## End foreach mz + $index_page++ ; + + } ## End foreach page +# print Dumper $tbody_object ; + return($tbody_object) ; +} +## END of SUB + + + +1 ; + + +__END__ + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc XXX.pm + +=head1 Exports + +=over 4 + +=item :ALL is ... + +=back + +=head1 AUTHOR + +Franck Giacomoni E<lt>franck.giacomoni@clermont.inra.frE<gt> + +=head1 LICENSE + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=head1 VERSION + +version 1 : xx / xx / 201x + +version 2 : ?? + +=cut \ No newline at end of file