comparison 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
comparison
equal deleted inserted replaced
-1:000000000000 0:023c380900ef
1 package lib::writter ;
2
3 use strict;
4 use warnings ;
5 use Exporter ;
6 use Carp ;
7
8 use Data::Dumper ;
9 use JSON ;
10 use HTML::Template ;
11
12 use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS);
13
14 our $VERSION = "1.0";
15 our @ISA = qw(Exporter);
16 our @EXPORT = qw( write_csv_skel write_xls_skel write_json_skel write_html_skel );
17 our %EXPORT_TAGS = ( ALL => [qw( write_csv_skel write_xls_skel write_json_skel write_html_skel )] );
18
19 =head1 NAME
20
21 My::Module - An example module
22
23 =head1 SYNOPSIS
24
25 use My::Module;
26 my $object = My::Module->new();
27 print $object->as_string;
28
29 =head1 DESCRIPTION
30
31 This module does not really exist, it
32 was made for the sole purpose of
33 demonstrating how POD works.
34
35 =head1 METHODS
36
37 Methods are :
38
39 =head2 METHOD new
40
41 ## Description : new
42 ## Input : $self
43 ## Ouput : bless $self ;
44 ## Usage : new() ;
45
46 =cut
47
48 sub new {
49 ## Variables
50 my $self={};
51 bless($self) ;
52 return $self ;
53 }
54 ### END of SUB
55
56 =head2 METHOD write_csv_skel
57
58 ## Description : prepare and write csv output file
59 ## Input : $csv_file, $rows
60 ## Output : $csv_file
61 ## Usage : my ( $csv_file ) = write_csv_skel( $csv_file, $rows ) ;
62
63 =cut
64 ## START of SUB
65 sub write_csv_skel {
66 ## Retrieve Values
67 my $self = shift ;
68 my ( $csv_file, $rows ) = @_ ;
69
70 my $ocsv = lib::csv::new( {is_binary => 1 , quote_binary => 0, quote_char => undef }) ;
71 my $csv = $ocsv->get_csv_object("\t") ;
72 $ocsv->write_csv_from_arrays($csv, $$csv_file, $rows) ;
73
74 return($csv_file) ;
75 }
76 ## END of SUB
77
78 =head2 METHOD write_xls_skel
79
80 ## Description : prepare and write xls output file
81 ## Input : $xls_file, $rows
82 ## Output : $xls_file
83 ## Usage : my ( $xls_file ) = write_xls_skel( $xls_file, $rows ) ;
84
85 =cut
86 ## START of SUB
87 sub write_xls_skel {
88 ## Retrieve Values
89 my $self = shift ;
90 my ( $out_xls, $mzs, $pcs, $pcgroups, $records ) = @_ ;
91
92 my $results = undef ;
93 my $i = 0 ;
94
95 open(XLS, '>:utf8', "$$out_xls") or die "Cant' create the file $$out_xls\n" ;
96 print XLS "ID\tPCGROUP\tQuery(Da)\tScore\tMetabolite_name\tCpd_Mw(Da)\tFormula\tAdduct\tMASSBANK_ID\tInstrument\tMS_level\n" ;
97
98 $results = ['ID','PCGROUP','Query(Da)','Score','Metabolite_name','Cpd_Mw(Da)','Formula','Adduct','MASSBANK_ID','Instrument','MS_level'] ;
99
100 foreach my $pc (@{$pcs}) {
101
102 if ($pcgroups->{$pc}) {
103 # print "------>$pc - $pcgroups->{$pc}{annotation}{num_res}\n" ;
104
105 if ( $pcgroups->{$pc}{'annotation'} ) {
106 my $result = undef ;
107 my $well_id = "mz_0".sprintf("%04s", $i+1 ) ;
108
109 if ($pcgroups->{$pc}{'annotation'}{'num_res'} > 0) {
110
111 my @entries = @{$pcgroups->{$pc}{'annotation'}{'res'} } ;
112 my $status = undef ;
113 foreach my $entry (@entries) {
114 my $match = undef ;
115 ## manage if the queried mz is really in the mzs spectrum list...
116
117 if ( $pcgroups->{$pc}{'enrich_annotation'}{$mzs->[$i]} ) {
118
119 my @matching_ids = @{$pcgroups->{$pc}{'enrich_annotation'}{$mzs->[$i]}} ;
120
121 ##
122 if ( scalar @matching_ids == 0 ) {
123 $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" ;
124 print XLS "$well_id\t$pc\t$mzs->[$i]\t0\tNA\tNA\tNA\tNA\tNA\tNA\tNA\n" ;
125 last ;
126 }
127 else {
128 # search the massbank matched id
129 foreach (@matching_ids) {
130 if ($_ eq $entry->{'id'} ) {
131 $match = 'TRUE' ;
132 last ;
133 }
134 }
135
136 if ( ( defined $match ) and ($match eq 'TRUE') ) {
137 ## sort by ['ID','PCGROUP','Query(Da)','Score','Metabolite_name','Cpd_Mw(Da)','Formula','Adduct','MASSBANK_ID','Instrument','MS_level']
138
139 ## print mz_id
140 if ($mzs->[$i]) { print XLS "$well_id\t" ; $result .= $well_id."\t" ; }
141 else { print XLS "NA\t" ; }
142 ## print submitted pcgroup
143 if ($pc ) { print XLS "$pc\t" ; $result .= $pc."\t" ; } ## pb de clean de la derniere ligne !!!!!!
144 else { print XLS "NA\t" ; }
145 ## print Query(Da)
146 if ($mzs->[$i]) { print XLS "$mzs->[$i]\t" ; $result .= $mzs->[$i]."\t" ; }
147 else { print XLS "NA\t" ; }
148
149 ## print Score
150 if ($entry->{'score'}) { print XLS "$entry->{'score'}\t" ; $result .= $entry->{'score'}."\t" ; }
151 else { print XLS "NA\n" ; }
152 ## print Met_name
153 if ($entry->{'id'}) { print XLS "$records->{$entry->{'id'}}{names}[0]\t" ; $result .= $records->{$entry->{'id'}}{names}[0]."\t" ; }
154 else { print XLS "NA\t" ; }
155 ## print Cpd_mw
156 if ($entry->{'exactMass'}) { print XLS "$entry->{'exactMass'}\t" ; $result .= $entry->{'exactMass'}."\t" ; }
157 else { print XLS "NA\t" ; }
158 ## print Formula
159 if ($entry->{'formula'}) { print XLS "$entry->{'formula'}\t" ; $result .= $entry->{'formula'}."\t" ; }
160 else { print XLS "NA\t" ; }
161 ## print Adduct (precursor type)
162 if ($entry->{'id'}) { print XLS "$records->{$entry->{'id'}}{precursor_type}\t" ; $result .= $records->{$entry->{'id'}}{precursor_type}."\t" ; }
163 else { print XLS "NA\t" ; }
164 ## print Massbank ID
165 if ($entry->{'id'}) { print XLS "$entry->{'id'}\t" ; $result .= $entry->{'id'}."\t" ; }
166 else { print XLS "NA\t" ; }
167 ## print Instrument
168 if ($entry->{'id'}) { print XLS "$records->{$entry->{'id'}}{instrument_type}\t" ; $result .= $records->{$entry->{'id'}}{instrument_type}."\t" ; }
169 else { print XLS "NA\t" ; }
170 ## print MS_Level
171 if ($entry->{'id'}) { print XLS "$records->{$entry->{'id'}}{ms_type}\n" ; $result .= $records->{$entry->{'id'}}{ms_type}."\n" ; }
172 else { print XLS "NA\n" ; }
173
174 }
175 ## else match is not TRUE
176 else {
177 next ;
178 }
179 }
180 }
181 } ## End foreach entries
182 }
183 else {
184 $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" ;
185 print XLS "$well_id\t$pc\t$mzs->[$i]\t0\tNA\tNA\tNA\tNA\tNA\tNA\tNA\n" ;
186 }
187 }
188 else{
189 warn "Not possible to get number of found ids on MassBank\n" ;
190 }
191 }
192 else {
193 croak "No such pc group exists in your pcgroups object - No xls written\n" ;
194 }
195 $i++ ;
196
197 } ## End foreach pcs
198
199 close(XLS) ;
200 return($results) ;
201 }
202 ## END of SUB
203
204 =head2 METHOD write_json_skel
205
206 ## Description : prepare and write json output file
207 ## Input : $json_file, $scalar
208 ## Output : $json_file
209 ## Usage : my ( $json_file ) = write_json_skel( $csv_file, $scalar ) ;
210
211 =cut
212 ## START of SUB
213 sub write_json_skel {
214 ## Retrieve Values
215 my $self = shift ;
216 my ( $json_file, $scalar ) = @_ ;
217
218 my $utf8_encoded_json_text = encode_json $scalar ;
219 open(JSON, '>:utf8', "$$json_file") or die "Cant' create the file $$json_file\n" ;
220 print JSON $utf8_encoded_json_text ;
221 close(JSON) ;
222
223 return($json_file) ;
224 }
225 ## END of SUB
226
227 =head2 METHOD write_html_skel
228
229 ## Description : prepare and write the html output file
230 ## Input : $html_file_name, $html_object, $html_template
231 ## Output : $html_file_name
232 ## Usage : my ( $html_file_name ) = write_html_skel( $html_file_name, $html_object ) ;
233
234 =cut
235 ## START of SUB
236 sub write_html_skel {
237 ## Retrieve Values
238 my $self = shift ;
239 my ( $html_file_name, $html_object, $pages , $search_condition, $html_template, $js_path, $css_path ) = @_ ;
240
241 my $html_file = $$html_file_name ;
242
243 if ( defined $html_file ) {
244 open ( HTML, ">$html_file" ) or die "Can't create the output file $html_file " ;
245
246 if (-e $html_template) {
247 my $ohtml = HTML::Template->new(filename => $html_template);
248 $ohtml->param( JS_GALAXY_PATH => $js_path, CSS_GALAXY_PATH => $css_path ) ;
249 $ohtml->param( CONDITIONS => $search_condition ) ;
250 $ohtml->param( PAGES_NB => $pages ) ;
251 $ohtml->param( PAGES => $html_object ) ;
252 print HTML $ohtml->output ;
253 }
254 else {
255 croak "Can't fill any html output : No template available ($html_template)\n" ;
256 }
257
258 close (HTML) ;
259 }
260 else {
261 croak "No output file name available to write HTML file\n" ;
262 }
263 return(\$html_file) ;
264 }
265 ## END of SUB
266
267 1 ;
268
269
270 __END__
271
272 =head1 SUPPORT
273
274 You can find documentation for this module with the perldoc command.
275
276 perldoc writter.pm
277
278 =head1 Exports
279
280 =over 4
281
282 =item :ALL is ...
283
284 =back
285
286 =head1 AUTHOR
287
288 Franck Giacomoni E<lt>franck.giacomoni@clermont.inra.frE<gt>
289
290 =head1 LICENSE
291
292 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
293
294 =head1 VERSION
295
296 version 1 : 14 / 08 / 2015
297
298 version 2 : ??
299
300 =cut