Mercurial > repos > fgiacomoni > massbank_ws_searchspectrum
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 |