Mercurial > repos > fgiacomoni > massbank_ws_searchspectrum
view lib/writter.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 source
package lib::writter ; use strict; use warnings ; use Exporter ; use Carp ; use Data::Dumper ; use JSON ; use HTML::Template ; use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS); our $VERSION = "1.0"; our @ISA = qw(Exporter); our @EXPORT = qw( write_csv_skel write_xls_skel write_json_skel write_html_skel ); our %EXPORT_TAGS = ( ALL => [qw( write_csv_skel write_xls_skel write_json_skel write_html_skel )] ); =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 write_csv_skel ## Description : prepare and write csv output file ## Input : $csv_file, $rows ## Output : $csv_file ## Usage : my ( $csv_file ) = write_csv_skel( $csv_file, $rows ) ; =cut ## START of SUB sub write_csv_skel { ## Retrieve Values my $self = shift ; my ( $csv_file, $rows ) = @_ ; my $ocsv = lib::csv::new( {is_binary => 1 , quote_binary => 0, quote_char => undef }) ; my $csv = $ocsv->get_csv_object("\t") ; $ocsv->write_csv_from_arrays($csv, $$csv_file, $rows) ; return($csv_file) ; } ## END of SUB =head2 METHOD write_xls_skel ## Description : prepare and write xls output file ## Input : $xls_file, $rows ## Output : $xls_file ## Usage : my ( $xls_file ) = write_xls_skel( $xls_file, $rows ) ; =cut ## START of SUB sub write_xls_skel { ## Retrieve Values my $self = shift ; my ( $out_xls, $mzs, $pcs, $pcgroups, $records ) = @_ ; my $results = undef ; my $i = 0 ; open(XLS, '>:utf8', "$$out_xls") or die "Cant' create the file $$out_xls\n" ; print XLS "ID\tPCGROUP\tQuery(Da)\tScore\tMetabolite_name\tCpd_Mw(Da)\tFormula\tAdduct\tMASSBANK_ID\tInstrument\tMS_level\n" ; $results = ['ID','PCGROUP','Query(Da)','Score','Metabolite_name','Cpd_Mw(Da)','Formula','Adduct','MASSBANK_ID','Instrument','MS_level'] ; foreach my $pc (@{$pcs}) { if ($pcgroups->{$pc}) { # print "------>$pc - $pcgroups->{$pc}{annotation}{num_res}\n" ; if ( $pcgroups->{$pc}{'annotation'} ) { my $result = undef ; my $well_id = "mz_0".sprintf("%04s", $i+1 ) ; if ($pcgroups->{$pc}{'annotation'}{'num_res'} > 0) { my @entries = @{$pcgroups->{$pc}{'annotation'}{'res'} } ; my $status = undef ; foreach my $entry (@entries) { my $match = undef ; ## manage if the queried mz is really in the mzs spectrum list... if ( $pcgroups->{$pc}{'enrich_annotation'}{$mzs->[$i]} ) { my @matching_ids = @{$pcgroups->{$pc}{'enrich_annotation'}{$mzs->[$i]}} ; ## if ( scalar @matching_ids == 0 ) { $result .= $well_id."\t".$pc."\t".$mzs->[$i]."\t".'0'."\t".'UNKNOWN'."\t".'NA'."\t".'NA'."\t".'NA'."\t".'NA'."\t".'NA'."\t".'NA'."\n" ; print XLS "$well_id\t$pc\t$mzs->[$i]\t0\tNA\tNA\tNA\tNA\tNA\tNA\tNA\n" ; last ; } else { # search the massbank matched id foreach (@matching_ids) { if ($_ eq $entry->{'id'} ) { $match = 'TRUE' ; last ; } } if ( ( defined $match ) and ($match eq 'TRUE') ) { ## sort by ['ID','PCGROUP','Query(Da)','Score','Metabolite_name','Cpd_Mw(Da)','Formula','Adduct','MASSBANK_ID','Instrument','MS_level'] ## print mz_id if ($mzs->[$i]) { print XLS "$well_id\t" ; $result .= $well_id."\t" ; } else { print XLS "NA\t" ; } ## print submitted pcgroup if ($pc ) { print XLS "$pc\t" ; $result .= $pc."\t" ; } ## pb de clean de la derniere ligne !!!!!! else { print XLS "NA\t" ; } ## print Query(Da) if ($mzs->[$i]) { print XLS "$mzs->[$i]\t" ; $result .= $mzs->[$i]."\t" ; } else { print XLS "NA\t" ; } ## print Score if ($entry->{'score'}) { print XLS "$entry->{'score'}\t" ; $result .= $entry->{'score'}."\t" ; } else { print XLS "NA\n" ; } ## print Met_name if ($entry->{'id'}) { print XLS "$records->{$entry->{'id'}}{names}[0]\t" ; $result .= $records->{$entry->{'id'}}{names}[0]."\t" ; } else { print XLS "NA\t" ; } ## print Cpd_mw if ($entry->{'exactMass'}) { print XLS "$entry->{'exactMass'}\t" ; $result .= $entry->{'exactMass'}."\t" ; } else { print XLS "NA\t" ; } ## print Formula if ($entry->{'formula'}) { print XLS "$entry->{'formula'}\t" ; $result .= $entry->{'formula'}."\t" ; } else { print XLS "NA\t" ; } ## print Adduct (precursor type) if ($entry->{'id'}) { print XLS "$records->{$entry->{'id'}}{precursor_type}\t" ; $result .= $records->{$entry->{'id'}}{precursor_type}."\t" ; } else { print XLS "NA\t" ; } ## print Massbank ID if ($entry->{'id'}) { print XLS "$entry->{'id'}\t" ; $result .= $entry->{'id'}."\t" ; } else { print XLS "NA\t" ; } ## print Instrument if ($entry->{'id'}) { print XLS "$records->{$entry->{'id'}}{instrument_type}\t" ; $result .= $records->{$entry->{'id'}}{instrument_type}."\t" ; } else { print XLS "NA\t" ; } ## print MS_Level if ($entry->{'id'}) { print XLS "$records->{$entry->{'id'}}{ms_type}\n" ; $result .= $records->{$entry->{'id'}}{ms_type}."\n" ; } else { print XLS "NA\n" ; } } ## else match is not TRUE else { next ; } } } } ## End foreach entries } else { $result .= $well_id."\t".$pc."\t".$mzs->[$i]."\t".'0'."\t".'UNKNOWN'."\t".'NA'."\t".'NA'."\t".'NA'."\t".'NA'."\t".'NA'."\t".'NA'."\n" ; print XLS "$well_id\t$pc\t$mzs->[$i]\t0\tNA\tNA\tNA\tNA\tNA\tNA\tNA\n" ; } } else{ warn "Not possible to get number of found ids on MassBank\n" ; } } else { croak "No such pc group exists in your pcgroups object - No xls written\n" ; } $i++ ; } ## End foreach pcs close(XLS) ; return($results) ; } ## END of SUB =head2 METHOD write_json_skel ## Description : prepare and write json output file ## Input : $json_file, $scalar ## Output : $json_file ## Usage : my ( $json_file ) = write_json_skel( $csv_file, $scalar ) ; =cut ## START of SUB sub write_json_skel { ## Retrieve Values my $self = shift ; my ( $json_file, $scalar ) = @_ ; my $utf8_encoded_json_text = encode_json $scalar ; open(JSON, '>:utf8', "$$json_file") or die "Cant' create the file $$json_file\n" ; print JSON $utf8_encoded_json_text ; close(JSON) ; return($json_file) ; } ## END of SUB =head2 METHOD write_html_skel ## Description : prepare and write the html output file ## Input : $html_file_name, $html_object, $html_template ## Output : $html_file_name ## Usage : my ( $html_file_name ) = write_html_skel( $html_file_name, $html_object ) ; =cut ## START of SUB sub write_html_skel { ## Retrieve Values my $self = shift ; my ( $html_file_name, $html_object, $pages , $search_condition, $html_template, $js_path, $css_path ) = @_ ; my $html_file = $$html_file_name ; if ( defined $html_file ) { open ( HTML, ">$html_file" ) or die "Can't create the output file $html_file " ; if (-e $html_template) { my $ohtml = HTML::Template->new(filename => $html_template); $ohtml->param( JS_GALAXY_PATH => $js_path, CSS_GALAXY_PATH => $css_path ) ; $ohtml->param( CONDITIONS => $search_condition ) ; $ohtml->param( PAGES_NB => $pages ) ; $ohtml->param( PAGES => $html_object ) ; print HTML $ohtml->output ; } else { croak "Can't fill any html output : No template available ($html_template)\n" ; } close (HTML) ; } else { croak "No output file name available to write HTML file\n" ; } return(\$html_file) ; } ## END of SUB 1 ; __END__ =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc writter.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 : 14 / 08 / 2015 version 2 : ?? =cut