Mercurial > repos > fgiacomoni > hmdb_ms_search
view lib/csv.pm @ 22:453fbe98925a draft
" master branch Updating with tag :CI_COMMIT_TAG - - Fxx"
author | fgiacomoni |
---|---|
date | Fri, 20 Nov 2020 17:29:18 +0000 |
parents | 625fa968d99a |
children |
line wrap: on
line source
package lib::csv ; use strict; use warnings ; use Exporter ; use Carp ; use Text::CSV ; use Data::Dumper ; use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS); our $VERSION = "1.0"; our @ISA = qw(Exporter); our @EXPORT = qw( get_csv_object get_value_from_csv_multi_header ); our %EXPORT_TAGS = ( ALL => [qw( get_csv_object get_value_from_csv_multi_header )] ); =head1 NAME My::Module - An example module =head1 SYNOPSIS use My::Module; my $object = My::Module->new(); print $object->as_string; =head1 DESCRIPTION This module does not really exist, it was made for the sole purpose of demonstrating how POD works. =head1 METHODS Methods are : =head2 METHOD new ## Description : new ## Input : $self ## Ouput : bless $self ; ## Usage : new() ; =cut sub new { ## Variables my $self={}; bless($self) ; return $self ; } ### END of SUB =head2 METHOD get_csv_object ## Description : builds a csv object and etablishes format ## Input : $separator ## Output : $csv ## Usage : my ( $csv ) = get_csv_object( $separator ) ; =cut ## START of SUB sub get_csv_object { ## Retrieve Values my $self = shift ; my ( $separator ) = @_ ; # my $csv = Text::CSV->new({'sep_char' => "$separator"}); my $csv = Text::CSV->new ( {'sep_char' => "$separator", binary => 1 } ) # should set binary attribute. or die "Cannot use CSV: ".Text::CSV->error_diag (); return($csv) ; } ## END of SUB =head2 METHOD get_value_from_csv_multi_header ## Description : extract a targeted column in a csv file ## Input : $csv, $file, $column, $is_header, $nb_header ## Output : $value ## Usage : my ( $value ) = get_value_from_csv_multi_header( $csv, $file, $column, $is_header, $nb_header ) ; =cut ## START of SUB sub get_value_from_csv_multi_header { ## Retrieve Values my $self = shift ; my ( $csv, $file, $column, $is_header, $nb_header ) = @_ ; my @value = () ; ## Adapte the number of the colunm : (nb of column to position in array) $column = $column - 1 ; open (CSV, "<", $file) or die $! ; my $line = 0 ; while (<CSV>) { $line++ ; chomp $_ ; # file has a header if ( defined $is_header and $is_header eq 'yes') { if ($line <= $nb_header) { next ; } } # parsing the targeted column if ( $csv->parse($_) ) { my @columns = $csv->fields(); push ( @value, $columns[$column] ) ; } else { my $err = $csv->error_input; die "Failed to parse line: $err"; } } close CSV; return(\@value) ; } ## END of SUB =head2 METHOD parse_csv_object ## Description : parse_all csv object and return a array of rows ## Input : $csv, $file ## Output : $csv_matrix ## Usage : my ( $csv_matrix ) = parse_csv_object( $csv, $file ) ; =cut ## START of SUB sub parse_csv_object { ## Retrieve Values my $self = shift ; my ( $csv, $file ) = @_ ; my @csv_matrix = () ; open my $fh, "<:encoding(utf8)", $$file or die "Can't open csv file $$file: $!"; while ( my $row = $csv->getline( $fh ) ) { push @csv_matrix, $row; } $csv->eof or $csv->error_diag(); close $fh; return(\@csv_matrix) ; } ## END of SUB =head2 METHOD parse_allcsv_object ## Description : parse_all csv object and return a array of rows with or without header ## Input : $csv, $file, $keep_header ## Output : $csv_matrix ## Usage : my ( $csv_matrix ) = parse_csv_object( $csv, $file, $keep_header ) ; =cut ## START of SUB sub parse_allcsv_object { ## Retrieve Values my $self = shift ; my ( $csv, $file, $keep_header ) = @_ ; my @csv_matrix = () ; my $line = 1 ; open my $fh, "<:encoding(utf8)", $$file or die "Can't open csv file $$file: $!"; while ( my $row = $csv->getline( $fh ) ) { if ( ( $keep_header eq 'n' ) and ($line == 1) ) { } else { push @csv_matrix, $row; } $line ++ ; } my $status = $csv->eof or $csv->error_diag(); close $fh; return(\@csv_matrix, $status) ; } ## END of SUB =head2 METHOD write_csv_from_arrays ## Description : write a csv file from list of rows ## Input : $csv, $file_name, $rows ## Output : $csv_file ## Usage : my ( $csv_file ) = write_csv_from_arrays( $csv, $file_name, $rows ) ; =cut ## START of SUB sub write_csv_from_arrays { ## Retrieve Values my $self = shift ; my ( $csv, $file_name, $rows ) = @_ ; my $fh = undef ; $csv->eol ("\n"); ## end-of-line string to add to rows # $csv->quote_char(undef) ; open $fh, ">:encoding(utf8)", "$file_name" or die "$file_name: $!"; my $status = $csv->print ($fh, $_) for @{$rows}; close $fh or die "$file_name: $!"; return(\$file_name) ; } ## END of SUB =head2 METHOD write_csv_from_hash ## Description : write a csv file from simple hash with headers ## Input : $csv, $file_name, $headers, $arrayofhash ## Output : $csv_file ## Usage : my ( $csv_file ) = write_csv_from_arrays( $csv, $file_name, $headers, $arrayofhash ) ; =cut ## START of SUB sub write_csv_from_array_of_hash { ## Retrieve Values my $self = shift ; my ( $csv, $file_name, $headers, $hash ) = @_ ; my $fh = undef ; $csv->eol ("\n"); ## end-of-line string to add to rows $csv->quote_char(undef) ; open $fh, ">:encoding(utf8)", "$file_name" or die "$file_name: $!"; if (defined $headers) { for my $field (@$headers) { print $fh join('\t', $field), "\n"; } ; } for my $row (keys %{$hash}) { print $fh join('\t', map { $_, $row->{$_} } sort keys %$row), "\n"; } close $fh or die "$file_name: $!"; return(\$file_name) ; } ## END of SUB 1 ; __END__ =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc csv.pm =head1 Exports =over 4 =item :ALL is get_csv_object, get_value_from_csv_multi_header =back =head1 AUTHOR Franck Giacomoni E<lt>franck.giacomoni@clermont.inra.frE<gt> =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 VERSION version 1 : 23 / 10 / 2013 version 2 : ?? =cut