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 |
