diff 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 diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/writter.pm	Wed Apr 19 11:31:58 2017 -0400
@@ -0,0 +1,300 @@
+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
\ No newline at end of file