view release on metacpan or  search on metacpan

utils/csv2pheno_ranker/csv2pheno-ranker  view on Meta::CPAN

    ) unless defined $array_sep && length($array_sep);

    my $ok = eval { qr/$array_sep/; 1 };
    pod2usage(
        -message => "Please specify a valid regular expression for --array-separator\n",
        -exitval => 1
    ) unless $ok;
    return 1;
}

package CSV2PhenoRanker;

use strict;
use warnings;
use autodie;
use feature qw(say);
use Data::Dumper;
use Path::Tiny;
use File::Basename;
use File::Spec::Functions qw(catdir catfile);
use YAML::XS qw(LoadFile DumpFile);
use JSON::XS;
use Text::CSV_XS;

sub new {
    my ( $class, $self ) = @_;
    bless $self, $class;
    return $self;
}

sub run {
    my $self = shift;

    # Read the input file
    my ( $data, $arrays, $non_arrays ) = $self->read_csv();

    # Define output directory
    my ( $name, $path, undef ) = fileparse( $self->{input}, qr/\.[^.]*/ );
    my $output_dir = $self->{output_dir} // $path;    # Use defined-or operator

    # Write data as JSON
    my $json_file = catfile( $output_dir, qq/${name}.json/ );
    say "Writing <$json_file> " if $self->{verbose};
    write_json( { filepath => $json_file, data => $data } );

    # Load the configuration file data
    my $config = $self->create_config( $arrays, $non_arrays );

    # Write the configuration file as YAML
    my $yaml_file = catfile( $output_dir, qq/${name}_config.yaml/ );
    say "Writing <$yaml_file> " if $self->{verbose};
    write_yaml( { filepath => $yaml_file, data => $config } );
    return 1;
}

sub write_json {
    my $arg       = shift;
    my $file      = $arg->{filepath};
    my $json_data = $arg->{data};

    # Note that canonical DOES not match the order of nsort from Sort::Naturally
    my $json = JSON::XS->new->utf8->canonical->pretty->encode($json_data);
    path($file)->spew($json);
    return 1;
}

sub write_yaml {
    my $arg       = shift;
    my $file      = $arg->{filepath};
    my $json_data = $arg->{data};
    local $YAML::XS::Boolean = 'JSON::PP';
    DumpFile( $file, $json_data );
    return 1;
}

sub read_csv {
    my $self                 = shift;
    my $input                = $self->{input};
    my $primary_key_name     = $self->{primary_key_name};       # has to be non-array
    my $generate_primary_key = $self->{generate_primary_key};
    my $sep                  = $self->{sep};
    my $array_sep            = $self->{array_sep};
    my $array_sep_qr         = qr/$array_sep/;

    # Create a Text::CSV object with semicolon as the separator
    my $csv = Text::CSV_XS->new(
        {
            binary    => 1,
            sep_char  => define_separator( $input, $sep ),
            auto_diag => 1
        }
    );

    # Open filehandle
    open my $fh, '<:encoding(utf-8)', $input;

    # Parse the CSV data
    my $headers = $csv->getline($fh);
    die "Input file <$input> does not contain a header row\n"
      unless $headers && @{$headers};

    # Get rid of problematic characters on headers
    $_ =~ tr/()//d for @$headers;
    validate_headers($headers);

    # Add $primary_key_name to headers if $generate_primary_key
    if ($generate_primary_key) {

        # Check that primary_key_name does not exist
        die
"Primary key <$primary_key_name> already exists. Are you sure you need the <--generate-primary-key> flag?\n"
          if ( grep { $_ eq $primary_key_name } @$headers );

        # Make it last element of the array
        push @$headers, $primary_key_name if $generate_primary_key;
    }

    #####################
    # START READING CSV #
    #####################