|
0
|
1 package 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 write_csv_from_hash);
|
|
|
17 our %EXPORT_TAGS = ( ALL => [qw( get_csv_object get_value_from_csv_multi_header write_csv_from_hash )] );
|
|
|
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 |
