Mercurial > repos > fgiacomoni > massbank_ws_searchspectrum

comparison lib/csv.pm @ 0:023c380900ef draft default tip

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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::csv ;
2
3 use strict;
4 use warnings ;
5 use Exporter ;
6 use Carp ;
7
8 use Text::CSV ;
9
10 use Data::Dumper ;
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( get_csv_object get_value_from_csv get_value_from_csv_multi_header );
17 our %EXPORT_TAGS = ( ALL => [qw( get_csv_object get_value_from_csv get_value_from_csv_multi_header )] );
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 get_csv_object
57
58 ## Description : builds a csv object and etablishes format
59 ## Input : $separator
60 ## Output : $csv
61 ## Usage : my ( $csv ) = get_csv_object( $separator ) ;
62
63 =cut
64 ## START of SUB
65 sub get_csv_object {
66 ## Retrieve Values
67 my $self = shift ;
68 my ( $separator ) = @_ ;
69
70 # my $csv = Text::CSV->new({'sep_char' => "$separator"});
71 my $csv = Text::CSV->new ( {'sep_char' => "$separator", binary => 1, } ) # should set binary attribute.
72 or die "Cannot use CSV: ".Text::CSV->error_diag ();
73
74 return($csv) ;
75 }
76 ## END of SUB
77
78 =head2 METHOD get_value_from_csv
79
80 ## Description : extract a targeted column in a csv file
81 ## Input : $csv, $file, $column, $is_header
82 ## Output : $value
83 ## Usage : my ( $value ) = get_value_from_csv( $csv, $file, $column, $is_header ) ;
84
85 =cut
86 ## START of SUB
87 sub get_value_from_csv {
88 ## Retrieve Values
89 my $self = shift ;
90 my ( $csv, $file, $column, $is_header ) = @_ ;
91
92 my @value = () ;
93
94 ## Adapte the number of the colunm : (nb of column to position in array)
95 $column = $column - 1 ;
96
97 open (CSV, "<", $file) or die $! ;
98
99 my $line = 0 ;
100
101 while (<CSV>) {
102 $line++ ;
103 chomp $_ ;
104 # file has a header
105 if ( defined $is_header ) { if ($line == 1) { next ; } }
106 # parsing the targeted column
107 if ( $csv->parse($_) ) {
108 my @columns = $csv->fields();
109 push ( @value, $columns[$column] ) ;
110 }
111 else {
112 my $err = $csv->error_input;
113 die "Failed to parse line: $err";
114 }
115 }
116 close CSV;
117 return(\@value) ;
118 }
119 ## END of SUB
120
121 =head2 METHOD get_value_from_csv_multi_header
122
123 ## Description : extract a targeted column in a csv file
124 ## Input : $csv, $file, $column, $is_header, $nb_header
125 ## Output : $value
126 ## Usage : my ( $value ) = get_value_from_csv_multi_header( $csv, $file, $column, $is_header, $nb_header ) ;
127
128 =cut
129 ## START of SUB
130 sub get_value_from_csv_multi_header {
131 ## Retrieve Values
132 my $self = shift ;
133 my ( $csv, $file, $column, $is_header, $nb_header ) = @_ ;
134
135 my @value = () ;
136
137 ## Adapte the number of the colunm : (nb of column to position in array)
138 $column = $column - 1 ;
139
140 open (CSV, "<", $file) or die $! ;
141
142 my $line = 0 ;
143
144 while (<CSV>) {
145 $line++ ;
146 chomp $_ ;
147 # file has a header
148 if ( defined $is_header and $is_header eq 'yes') { if ($line <= $nb_header) { next ; } }
149 # parsing the targeted column
150 if ( $csv->parse($_) ) {
151 my @columns = $csv->fields();
152 my $value = $columns[$column] ;
153 $value =~s/\r|\n// ;
154 push ( @value, $value ) ;
155 }
156 else {
157 my $err = $csv->error_input;
158 die "Failed to parse line: $err";
159 }
160 }
161 close CSV;
162 return(\@value) ;
163 }
164 ## END of SUB
165
166 =head2 METHOD parse_csv_object
167
168 ## Description : parse_all csv object and return a array of rows
169 ## Input : $csv, $file
170 ## Output : $csv_matrix
171 ## Usage : my ( $csv_matrix ) = parse_csv_object( $csv, $file ) ;
172
173 =cut
174 ## START of SUB
175 sub parse_csv_object {
176 ## Retrieve Values
177 my $self = shift ;
178 my ( $csv, $file ) = @_ ;
179
180 my @csv_matrix = () ;
181
182 open my $fh, "<:encoding(utf8)", $$file or die "Can't open csv file $$file: $!";
183
184 while ( my $row = $csv->getline( $fh ) ) {
185 push @csv_matrix, $row;
186 }
187 $csv->eof or $csv->error_diag();
188 close $fh;
189
190 return(\@csv_matrix) ;
191 }
192 ## END of SUB
193
194 =head2 METHOD parse_allcsv_object
195
196 ## Description : parse_all csv object and return a array of rows with or without header
197 ## Input : $csv, $file, $keep_header
198 ## Output : $csv_matrix
199 ## Usage : my ( $csv_matrix ) = parse_csv_object( $csv, $file, $keep_header ) ;
200
201 =cut
202 ## START of SUB
203 sub parse_allcsv_object {
204 ## Retrieve Values
205 my $self = shift ;
206 my ( $csv, $file, $keep_header ) = @_ ;
207
208 my @csv_matrix = () ;
209 my $line = 1 ;
210
211 open my $fh, "<:encoding(utf8)", $$file or die "Can't open csv file $$file: $!";
212
213 while ( my $row = $csv->getline( $fh ) ) {
214 if ( ( $keep_header eq 'n' ) and ($line == 1) ) { }
215 else { push @csv_matrix, $row; }
216 $line ++ ;
217 }
218 my $status = $csv->eof or $csv->error_diag();
219 close $fh;
220
221 return(\@csv_matrix, $status) ;
222 }
223 ## END of SUB
224
225
226 =head2 METHOD write_csv_from_arrays
227
228 ## Description : write a csv file from list of rows
229 ## Input : $csv, $file_name, $rows
230 ## Output : $csv_file
231 ## Usage : my ( $csv_file ) = write_csv_from_arrays( $csv, $file_name, $rows ) ;
232
233 =cut
234 ## START of SUB
235 sub write_csv_from_arrays {
236 ## Retrieve Values
237 my $self = shift ;
238 my ( $csv, $file_name, $rows ) = @_ ;
239
240 my $fh = undef ;
241 $csv->eol ("\n"); ## end-of-line string to add to rows
242 $csv->quote_char(undef) ;
243 open $fh, ">:encoding(utf8)", "$file_name" or die "$file_name: $!";
244
245 my $status = $csv->print ($fh, $_) for @{$rows};
246 close $fh or die "$file_name: $!";
247
248 return(\$file_name) ;
249 }
250 ## END of SUB
251
252 1 ;
253
254
255 __END__
256
257 =head1 SUPPORT
258
259 You can find documentation for this module with the perldoc command.
260
261 perldoc csv.pm
262
263 =head1 Exports
264
265 =over 4
266
267 =item :ALL is get_csv_object, get_value_from_csv
268
269 =back
270
271 =head1 AUTHOR
272
273 Franck Giacomoni E<lt>franck.giacomoni@clermont.inra.frE<gt>
274
275 =head1 LICENSE
276
277 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
278
279 =head1 VERSION
280
281 version 1 : 23 / 10 / 2013
282
283 version 2 : ??
284
285 =cut