view release on metacpan or  search on metacpan

lib/App/CSVUtils.pm  view on Meta::CPAN

        cmdline_aliases => {f=>{}},
        element_completion => \&_complete_field,
    },
);

our %argspecopt_fields = (
    fields => {
        'x.name.is_plural' => 1,
        'x.name.singular' => 'field',
        summary => 'Field names',
        schema => ['array*', of=>['str*', min_len=>1], min_len=>1],
        cmdline_aliases => {f=>{}},
        element_completion => \&_complete_field,
    },
);

our %argspecsopt_field_selection = (
    include_fields => {
        'x.name.is_plural' => 1,
        'x.name.singular' => 'include_field',
        summary => 'Field names to include, takes precedence over --exclude-field-pat',
        schema => ['array*', of=>'str*'],
        cmdline_aliases => {
            f => {},
            field => {}, # backward compatibility
        },
        element_completion => \&_complete_field,
        tags => ['category:field-selection'],
    },
    include_field_pat => {
        summary => 'Field regex pattern to select, overidden by --exclude-field-pat',
        schema => 're*',
        cmdline_aliases => {
            field_pat => {}, # backward compatibility
            include_all_fields => { summary => 'Shortcut for --field-pat=.*, effectively selecting all fields', is_flag=>1, code => sub { $_[0]{include_field_pat} = '.*' } },
            a => { summary => 'Shortcut for --field-pat=.*, effectively selecting all fields', is_flag=>1, code => sub { $_[0]{include_field_pat} = '.*' } },
        },
        tags => ['category:field-selection'],
    },
    exclude_fields => {
        'x.name.is_plural' => 1,
        'x.name.singular' => 'exclude_field',
        summary => 'Field names to exclude, takes precedence over --fields',
        schema => ['array*', of=>'str*'],
        cmdline_aliases => {
            F => {},
        },
        element_completion => \&_complete_field,
        tags => ['category:field-selection'],
    },
    exclude_field_pat => {
        summary => 'Field regex pattern to exclude, takes precedence over --field-pat',
        schema => 're*',
        cmdline_aliases => {
            exclude_all_fields => { summary => 'Shortcut for --exclude-field-pat=.*, effectively excluding all fields', is_flag=>1, code => sub { $_[0]{exclude_field_pat} = '.*' } },
            A => { summary => 'Shortcut for --exclude-field-pat=.*, effectively excluding all fields', is_flag=>1, code => sub { $_[0]{exclude_field_pat} = '.*' } },
        },
        tags => ['category:field-selection'],
    },
    ignore_unknown_fields => {
        summary => 'When unknown fields are specified in --include-field (--field) or --exclude-field options, ignore them instead of throwing an error',
        schema => 'bool*',
    },
    show_selected_fields => {
        summary => 'Show selected fields and then immediately exit',
        schema => 'true*',
    },
);

our %argspec_eval = (
    eval => {
        summary => 'Perl code',
        schema => $sch_req_str_or_code,
        cmdline_aliases => { e=>{} },
        req => 1,
    },
);

our %argspecopt_eval = (
    eval => {
        summary => 'Perl code',
        schema => $sch_req_str_or_code,
        cmdline_aliases => { e=>{} },
    },
);

our %argspec_eval_1 = (
    eval => {
        summary => 'Perl code',
        schema => $sch_req_str_or_code,
        cmdline_aliases => { e=>{} },
        req => 1,
        pos => 1,
    },
);

our %argspec_eval_2 = (
    eval => {
        summary => 'Perl code',
        schema => $sch_req_str_or_code,
        cmdline_aliases => { e=>{} },
        req => 1,
        pos => 2,
    },
);

our %argspecopt_eval_2 = (
    eval => {
        summary => 'Perl code',
        schema => $sch_req_str_or_code,
        cmdline_aliases => { e=>{} },
        pos => 2,
    },
);

our %argspecsopt_sortsub = (
    by_sortsub => {
        schema => 'str*',
        description => <<'_',

When sorting rows, usually combined with `--key` because most Sort::Sub routine

lib/App/CSVUtils.pm  view on Meta::CPAN

            schema => 'code*',
        },
        after_read_input => {
            schema => 'code*',
        },
        on_end => {
            schema => 'code*',
        },
    },
    result_naked => 1,
    result => {
        schema => 'bool*',
    },
};
sub gen_csv_util {
    my %gen_args = @_;

    my $name = delete($gen_args{name}) or die "Please specify name";
    my $summary = delete($gen_args{summary}) // '(No summary)';
    my $description = delete($gen_args{description}) // '(No description)';
    my $links = delete($gen_args{links}) // [];
    my $examples = delete($gen_args{examples}) // [];
    my $add_meta_props = delete $gen_args{add_meta_props};
    my $add_args = delete $gen_args{add_args};
    my $add_args_rels = delete $gen_args{add_args_rels};
    my $reads_multiple_csv = delete($gen_args{reads_multiple_csv});
    my $reads_csv = delete($gen_args{reads_csv}) // 1;
    my $tags = [ @{ delete($gen_args{tags}) // [] } ];
    $reads_csv = 1 if $reads_multiple_csv;
    my $writes_multiple_csv = delete($gen_args{writes_multiple_csv});
    my $writes_csv = delete($gen_args{writes_csv}) // 1;
    $writes_csv = 1 if $writes_multiple_csv;
    my $on_begin                 = delete $gen_args{on_begin};
    my $before_read_input        = delete $gen_args{before_read_input};
    my $before_open_input_files  = delete $gen_args{before_open_input_files};
    my $before_open_input_file   = delete $gen_args{before_open_input_file};
    my $on_input_header_row      = delete $gen_args{on_input_header_row};
    my $on_input_data_row        = delete $gen_args{on_input_data_row};
    my $after_close_input_file   = delete $gen_args{after_close_input_file};
    my $after_close_input_files  = delete $gen_args{after_close_input_files};
    my $after_read_input         = delete $gen_args{after_read_input};
    my $on_end                   = delete $gen_args{on_end};

    scalar(keys %gen_args) and die "Unknown argument(s): ".join(", ", keys %gen_args);

    my $code;
  CREATE_CODE: {
        $code = sub {
            my %util_args = @_;

            my $has_header = $util_args{input_header} // 1;
            my $outputs_header = $util_args{output_header} // $has_header;

            my $r = {
                gen_args => \%gen_args,
                util_args => \%util_args,
                name => $name,
            };

            # inside the main eval block, we call hook handlers. A handler can
            # throw an exception (which can be a string or an enveloped response
            # like [500, "some error message"], see Rinci::function). we trap
            # the exception so we can return the appropriate enveloped response.
          MAIN_EVAL:
            eval {

                # do some checking
                if ($util_args{inplace} && (!$reads_csv || !$writes_csv)) {
                    die [412, "--inplace cannot be specified when we do not read & write CSV"];
                }

                if ($on_begin) {
                    log_trace "[csvutil] Calling on_begin hook handler ...";
                    $on_begin->($r);
                }

                my $code_open_file = sub {
                    # set output filenames, if not yet
                    unless ($r->{output_filenames}) {
                        my @output_filenames;
                        if ($util_args{inplace}) {
                            for my $input_filename (@{ $r->{input_filenames} }) {
                                my $output_filename;
                                while (1) {
                                    $output_filename = $input_filename . "." . _randext(5);
                                    last unless -e $output_filename;
                                }
                                push @output_filenames, $output_filename;
                            }
                        } elsif ($writes_multiple_csv) {
                            @output_filenames = @{ $util_args{output_filenames} // ['-'] };
                        } else {
                            @output_filenames = ($util_args{output_filename} // '-');
                        }

                      CHECK_OUTPUT_FILENAME_SAME_AS_INPUT_FILENAME: {
                            my %seen_output_abs_path; # key = output filename
                            last unless $reads_csv && $writes_csv;
                            for my $input_filename (@{ $r->{input_filenames} }) {
                                next if $input_filename eq '-';
                                my $input_abs_path = Cwd::abs_path($input_filename);
                                die [500, "Can't get absolute path of input filename '$input_filename'"] unless $input_abs_path;
                                for my $output_filename (@output_filenames) {
                                    next if $output_filename eq '-';
                                    next if $seen_output_abs_path{$output_filename};
                                    my $output_abs_path = Cwd::abs_path($output_filename);
                                    die [500, "Can't get absolute path of output filename '$output_filename'"] unless $output_abs_path;
                                    die [412, "Cannot set output filename to '$output_filename' ".
                                         ($output_filename ne $output_abs_path ? "($output_abs_path) ":"").
                                         "because it is the same as input filename and input will be clobbered; use --inplace to avoid clobbering<"]
                                        if $output_abs_path eq $input_abs_path;
                                }
                            }
                        } # CHECK_OUTPUT_FILENAME_SAME_AS_INPUT_FILENAME

                        $r->{output_filenames} = \@output_filenames;
                        $r->{output_num_of_files} //= scalar(@output_filenames);
                    } # set output filenames

                    # open the next file, if not yet
                    if (!$r->{output_fh} || $r->{wants_switch_to_next_output_file}) {