Mercurial > repos > fgiacomoni > lipidmaps_textsearch
diff lib/parser.pm @ 0:e8bd49794291 draft
Init repository with last lipidmaps_textsearch master version
author | fgiacomoni |
---|---|
date | Tue, 11 Apr 2017 03:47:06 -0400 |
parents | |
children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lib/parser.pm Tue Apr 11 03:47:06 2017 -0400 @@ -0,0 +1,250 @@ +package lib::parser ; + +use strict; +use warnings; + +use Data::Dumper; +use Carp ; + +use Exporter; +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); + +$VERSION = "1.0"; +@ISA = qw(Exporter); +@EXPORT = (); +@EXPORT_OK = qw( get_oxidation_ref get_neutral_loss_ref set_category set_class set_subclass ); +%EXPORT_TAGS = ( ALL => [qw( get_oxidation_ref get_neutral_loss_ref set_category set_class set_subclass )] ) ; + +=head1 NAME + +My::operations - An example module + +=head1 SYNOPSIS + + use My::operations; + my $object = My::Module->new(); + print $object->as_string; + +=head1 DESCRIPTION + +This module clusters several more used maths functions like factorial... + +=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_oxidation_ref + + ## Description : get oxidation type and oxidation modification from conf file + ## Input : $CONF + ## Output : $list_oxidations, $list_ox_values + ## Usage : my ( $list_oxidations, $list_ox_values ) = get_oxidation_ref( $CONF, $selected_ox ) ; + +=cut +## START of SUB +sub get_oxidation_ref { + ## Retrieve Values + my $self = shift ; + my ( $CONF, $selected_ox ) = @_ ; + + my @list_oxidations = () ; + my @clean_list_oxidations = () ; + my @list_ox_values = () ; + + if ( defined $selected_ox ) { + + @list_oxidations = split( /,/, $selected_ox ) ; + my $pos = 0 ; ## manage the splice + + foreach my $ox ( @list_oxidations ) { + if ($ox !~/NA$/ ) { ## case of ox + push(@clean_list_oxidations, $ox) ; + if ( $ox =~/^loss_(.*)/ ) { push ( @list_ox_values, ($CONF->{$1}) ) ; } + elsif ( $ox =~/^add_(.*)/ ) { push ( @list_ox_values, -($CONF->{$1}) ) ; } ### carefull of the number sign + else { warn "This oxidation ($ox) is unknown in conf and menu\n" ; } + } + else { # if atoms eq NA, splice it + next ; + } + $pos++ ; + } + } + return(\@clean_list_oxidations, \@list_ox_values) ; +} +## END of SUB + +=head2 METHOD get_neutral_loss_ref + + ## Description : get neutral loss type and neutral loss modifications from conf file + ## Input : $CONF + ## Output : $list_neutral_losses, $list_nloss_values + ## Usage : my ( $list_neutral_losses, $list_nloss_values ) = get_neutral_loss_ref( $CONF, $selected_nloss ) ; + +=cut +## START of SUB +sub get_neutral_loss_ref { + ## Retrieve Values + my $self = shift ; + my ( $CONF, $selected_nloss ) = @_ ; + + my @list_neutral_losses = () ; ## complete list + my @clean_list_neutral_losses = () ; # list without NA + my @list_nloss_values = () ; # values + + if ( defined $selected_nloss ) { + @list_neutral_losses = split( /,/, $selected_nloss ) ; + + foreach my $nloss ( @list_neutral_losses ) { + + if ($nloss !~/NA$/ ) { ## case of neutral loss + push(@clean_list_neutral_losses, $nloss) ; + if ( $nloss =~/^loss_(.*)/ ) { push ( @list_nloss_values, ($CONF->{$1}) ) ; } + elsif ( $nloss =~/^add_(.*)/ ) { push ( @list_nloss_values, -($CONF->{$1}) ) ; } ### carefull of the number sign + else { warn "This neutral loss ($nloss) is unknown in conf and menu\n" ; } + } + else { # if atoms eq NA, splice it + next ; + } + } + } + return(\@clean_list_neutral_losses, \@list_nloss_values) ; +} +## END of SUB + +=head2 METHOD set_category + + ## Description : set the category id from any types of ids + ## Input : $unknown_id + ## Output : $cat_id + ## Usage : my ( $cat_id ) = set_category( $unknown_id ) ; + +=cut +## START of SUB +sub set_category { + ## Retrieve Values + my $self = shift ; + my ( $unknown_id ) = @_ ; + my $cat_id = undef ; + + if ( defined $unknown_id ) { + if ( $unknown_id > 0 ) { + if ( (length $unknown_id) == 1 ) { $cat_id = $unknown_id } + elsif ( (length $unknown_id) == 3 ) { $cat_id = substr($unknown_id, 0, 1) } + elsif ( (length $unknown_id) == 5 ) { $cat_id = substr($unknown_id, 0, 1) } + } + } + else { + warn "Can't find any id to substr\n" ; + } + return( \$cat_id ) ; +} +## END of SUB + +=head2 METHOD set_class + + ## Description : set the class id from any types of ids + ## Input : $unknown_id + ## Output : $class_id + ## Usage : my ( $class_id ) = set_category( $unknown_id ) ; + +=cut +## START of SUB +sub set_class { + ## Retrieve Values + my $self = shift ; + my ( $unknown_id ) = @_ ; + my $class_id = undef ; + + if ( defined $unknown_id ) { + if ( $unknown_id > 0 ) { + if ( (length $unknown_id) == 3 ) { $class_id = $unknown_id } + elsif ( (length $unknown_id) == 5 ) { $class_id = substr($unknown_id, 0, 3) } + } + } + else { + warn "Can't find any id to substr\n" ; + } + return( \$class_id ) ; +} +## END of SUB + +=head2 METHOD set_subclass + + ## Description : set the subclass id from any types of ids + ## Input : $unknown_id + ## Output : $subclass_id + ## Usage : my ( $subclass_id ) = set_subclass( $unknown_id ) ; + +=cut +## START of SUB +sub set_subclass { + ## Retrieve Values + my $self = shift ; + my ( $unknown_id ) = @_ ; + my $subclass_id = undef ; + + if ( defined $unknown_id ) { + if ( $unknown_id > 0 ) { + if ( (length $unknown_id) == 5 ) { $subclass_id = $unknown_id } + } + } + else { + warn "Can't find any id to substr\n" ; + } + return( \$subclass_id ) ; +} +## 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