Mercurial > repos > fgiacomoni > hmdb_ms_search

comparison lib/csv.pm @ 1:6d0a0f8f672a draft

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
planemo upload commit f67323ae4fa7fdbd9f4518ede105a7d7cd44b471
author fgiacomoni
date Wed, 23 Nov 2016 09:31:50 -0500
parents
children 625fa968d99a
comparison
equal deleted inserted replaced
0:9583f9772198 1:6d0a0f8f672a
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_multi_header );
17 our %EXPORT_TAGS = ( ALL => [qw( get_csv_object 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_multi_header
79
80 ## Description : extract a targeted column in a csv file
81 ## Input : $csv, $file, $column, $is_header, $nb_header
82 ## Output : $value
83 ## Usage : my ( $value ) = get_value_from_csv_multi_header( $csv, $file, $column, $is_header, $nb_header ) ;
84
85 =cut
86 ## START of SUB
87 sub get_value_from_csv_multi_header {
88 ## Retrieve Values
89 my $self = shift ;
90 my ( $csv, $file, $column, $is_header, $nb_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 and $is_header eq 'yes') { if ($line <= $nb_header) { 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 parse_csv_object
122
123 ## Description : parse_all csv object and return a array of rows
124 ## Input : $csv, $file
125 ## Output : $csv_matrix
126 ## Usage : my ( $csv_matrix ) = parse_csv_object( $csv, $file ) ;
127
128 =cut
129 ## START of SUB
130 sub parse_csv_object {
131 ## Retrieve Values
132 my $self = shift ;
133 my ( $csv, $file ) = @_ ;
134
135 my @csv_matrix = () ;
136
137 open my $fh, "<:encoding(utf8)", $$file or die "Can't open csv file $$file: $!";
138
139 while ( my $row = $csv->getline( $fh ) ) {
140 push @csv_matrix, $row;
141 }
142 $csv->eof or $csv->error_diag();
143 close $fh;
144
145 return(\@csv_matrix) ;
146 }
147 ## END of SUB
148
149 =head2 METHOD parse_allcsv_object
150
151 ## Description : parse_all csv object and return a array of rows with or without header
152 ## Input : $csv, $file, $keep_header
153 ## Output : $csv_matrix
154 ## Usage : my ( $csv_matrix ) = parse_csv_object( $csv, $file, $keep_header ) ;
155
156 =cut
157 ## START of SUB
158 sub parse_allcsv_object {
159 ## Retrieve Values
160 my $self = shift ;
161 my ( $csv, $file, $keep_header ) = @_ ;
162
163 my @csv_matrix = () ;
164 my $line = 1 ;
165
166 open my $fh, "<:encoding(utf8)", $$file or die "Can't open csv file $$file: $!";
167
168 while ( my $row = $csv->getline( $fh ) ) {
169 if ( ( $keep_header eq 'n' ) and ($line == 1) ) { }
170 else { push @csv_matrix, $row; }
171 $line ++ ;
172 }
173 my $status = $csv->eof or $csv->error_diag();
174 close $fh;
175
176 return(\@csv_matrix, $status) ;
177 }
178 ## END of SUB
179
180
181 =head2 METHOD write_csv_from_arrays
182
183 ## Description : write a csv file from list of rows
184 ## Input : $csv, $file_name, $rows
185 ## Output : $csv_file
186 ## Usage : my ( $csv_file ) = write_csv_from_arrays( $csv, $file_name, $rows ) ;
187
188 =cut
189 ## START of SUB
190 sub write_csv_from_arrays {
191 ## Retrieve Values
192 my $self = shift ;
193 my ( $csv, $file_name, $rows ) = @_ ;
194
195 my $fh = undef ;
196 $csv->eol ("\n"); ## end-of-line string to add to rows
197 $csv->quote_char(undef) ;
198 open $fh, ">:encoding(utf8)", "$file_name" or die "$file_name: $!";
199
200 my $status = $csv->print ($fh, $_) for @{$rows};
201 close $fh or die "$file_name: $!";
202
203 return(\$file_name) ;
204 }
205 ## END of SUB
206
207 1 ;
208
209
210 __END__
211
212 =head1 SUPPORT
213
214 You can find documentation for this module with the perldoc command.
215
216 perldoc csv.pm
217
218 =head1 Exports
219
220 =over 4
221
222 =item :ALL is get_csv_object, get_value_from_csv_multi_header
223
224 =back
225
226 =head1 AUTHOR
227
228 Franck Giacomoni E<lt>franck.giacomoni@clermont.inra.frE<gt>
229
230 =head1 LICENSE
231
232 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
233
234 =head1 VERSION
235
236 version 1 : 23 / 10 / 2013
237
238 version 2 : ??
239
240 =cut