view release on metacpan or  search on metacpan

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

            summary => 'Allow/show duplicates',
            schema => 'bool*',
            cmdline_aliases => {r=>{}},
            tags => [
                'category:shuf-action', 'category:pick-action',
                'category:uniq-action', 'category:nauniq-action',
            ],
            description => <<'_',

For shuf/pick actions, setting this option means sampling with replacement which
makes a single row can be sampled/picked multiple times. The default is to
sample without replacement.

For uniq/nauniq actions, setting this option means instructing to return
duplicate rows instead of the unique rows.

_
        },

        weight_column => {
            summary => 'Select a column that contains weight',
            schema => 'str*',
            tags => ['category:shuf-action', 'category:pick-action'],
        },

        exclude_columns => {
            'x.name.is_plural' => 1,
            'x.name.singular' => 'exclude_column',
            schema => ['array*', of=>'str*'],
            cmdline_aliases => {E=>{}},
            tags => ['category:select-action', 'category:uniq-action', 'category:nauniq-action'],
        },
        include_columns => {
            'x.name.is_plural' => 1,
            'x.name.singular' => 'include_column',
            schema => ['array*', of=>'str*'],
            cmdline_aliases => {I=>{}},
            tags => ['category:select-action', 'category:uniq-action', 'category:nauniq-action'],
        },

        case_insensitive => {
            schema => ['true*'],
            cmdline_aliases => {i=>{}},
            tags => ['category:uniq-action', 'category:nauniq-action'],
        },

        no_header_column => {
            summary => "Don't make the first column as column names of the transposed table; ".
                "instead create column named 'row1', 'row2', ...",
            schema => 'true*',
            tags => ['category:transpose-action'],
        },
    },
};
sub td {
    my %args = @_;
    my $action = $args{action};
    my $argv   = $args{argv};

    my ($input, $input_form, $input_obj, $input_form_err);
  GET_INPUT:
    {
        last unless $actions{$action}{req_input} // 1;
        eval {
            local $/;
            $input = _decode_json(~~<STDIN>);
        };
        return [400, "Input is not valid JSON: $@"] if $@;

        # give envelope if not enveloped
        unless (ref($input) eq 'ARRAY' &&
                    @$input >= 2 && @$input <= 4 &&
                    $input->[0] =~ /\A[2-5]\d\d\z/ &&
                    !ref($input->[1])
                ) {
            $input = [200, "Envelope added by td", $input];
        }

        # detect table form
        ($input_form, $input_obj, $input_form_err) = _get_td_obj($input);
        return [400, "Input is not table data: $input_form_err"]
            unless $input_form;
    } # GET_INPUT

    my $output;
  PROCESS:
    {
        if ($action eq 'actions') {
            if ($args{detail}) {
                $output = [200, "OK", [map {+{name=>$_, summary=>$actions{$_}{summary}}} sort keys %actions]];
            } else {
                $output = [200, "OK", [sort keys %actions]];
            }
            last;
        }

        if ($action eq 'cat') {
            my $cols = $input_obj->cols_by_idx;
            $output = [200, "OK", $input_obj->{data}, {'table.fields'=>$cols}];
            last;
        }

        if ($action eq 'info') {
            my $form = ref($input_obj); $form =~ s/^Data::TableData::Object:://;
            my $info = {
                form => $form,
                rowcount => $input_obj->row_count,
                colcount => $input_obj->col_count,
                cols => join(", ", @{ $input_obj->cols_by_idx }),
            };
            $output = [200, "OK", $info];
            last;
        }

        if ($action eq 'rowcount' || $action eq 'wc') {
            $output = [200, "OK", $input_obj->row_count];
            last;
        }

        if ($action eq 'as-aoaos') {
            my $cols = $input_obj->cols_by_idx;
            my $rows = $input_obj->rows_as_aoaos;
            $output = [200, "OK", $rows, {'table.fields' => $cols}];
            last;
        }

        if ($action eq 'as-csv') {
            require Text::CSV_XS;
            my $csv = Text::CSV_XS->new({binary=>1}) or die "Can't instantiate CSV parser";
            my $cols = $input_obj->cols_by_idx;
            my $res = "";
            $csv->combine(@$cols) or die "Can't combine header row to CSV: ".join(", ", @$cols);
            $res .= $csv->string . "\n";
            for my $row (@{ $input_obj->rows_as_aoaos }) {
                $csv->combine(@$row) or die "Can't combine data row to CSV: ".join(", ", @$row);
                $res .= $csv->string . "\n";
            }
            $output = [200, "OK", $res, {'cmdline.skip_format' => 1}];
            last;
        }

        if ($action eq 'as-aohos') {
            my $cols = $input_obj->cols_by_idx;

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

            my $output_cols = [];
            for my $col_idx (0 .. $#{ $input_cols }) {
                my $code_res;
                {
                    no warnings 'once';
                    local $_              = $input_cols->[$col_idx];
                    local $main::colname  = $input_cols->[$col_idx];
                    local $main::colidx   = $col_idx;
                    local $main::td       = $input_obj;
                    $code_res = $code->($_);
                }
                push @$output_cols, $code_res ? $input_cols->[$col_idx] : undef;
            }

            if ($input_form eq 'hash' || $input_form eq 'aos') {
                $input_obj = _get_td_obj($input_form->rows_as_aoaos);
                $input_form = 'aoaos';
            }
            for my $col_idx (reverse 0..$#{ $output_cols }) {
                unless (defined $output_cols->[$col_idx]) {
                    $input_obj->del_col($col_idx);
                }
            }
            $output = [
                200,
                "OK",
                $input_form eq 'aohos' ? $input_obj->rows_as_aohos : $input_obj->rows_as_aoaos,
                $input_form eq 'aohos' ? $input->[3] : undef
            ];
            last;
        }

        if ($action eq 'transpose') {
            my $input_rows = $input_obj->rows_as_aoaos;
            my $input_cols = $input_obj->cols_by_idx;

            my @output_cols;
            if ($args{no_header_column} || !@$input_rows) {
                @output_cols = map {"row$_"} 1 .. @$input_rows;
            } else {
                @output_cols = map { $input_rows->[$_-1][0] } 1 .. @$input_rows;
            }

            my @output_rows;

            for my $inputrowidx (0..$#{ $input_rows }) {
                my $inputrow = $input_rows->[$inputrowidx];
                for my $inputcolidx (0..$#{ $input_cols }) {
                    $output_rows[$inputcolidx] //= [];
                    $output_rows[$inputcolidx][$inputrowidx] = $inputrow->[$inputcolidx];
                }
            }

            $output = [200, "OK", \@output_rows, {'table.fields'=>\@output_cols}];
            last;
        }

        return [400, "Unknown action '$action'"];
    } # PROCESS

  POSTPROCESS_OUTPUT:
    {
        require Pipe::Find;
        my $pipeinfo = Pipe::Find::get_stdout_pipe_process();
        last unless $pipeinfo;
        last unless
            $pipeinfo->{exe} =~ m![/\\]td\z! ||
            $pipeinfo->{cmdline} =~ m!\A([^\0]*[/\\])?perl\0([^\0]*[/\\])?td\0!;
        $output->[3]{'cmdline.default_format'} = 'json';
    }
    $output;
}

1;
# ABSTRACT: Manipulate table data

__END__

=pod

=encoding UTF-8

=head1 NAME

App::td - Manipulate table data

=head1 VERSION

This document describes version 0.112 of App::td (from Perl distribution App-td), released on 2024-06-26.

=head1 FUNCTIONS


=head2 td

Usage:

 td(%args) -> [$status_code, $reason, $payload, \%result_meta]

Manipulate table data.

B<What is td?>

I<td> receives table data from standard input and performs an action on it. It
has functionality similar to some Unix commands like I<head>, I<tail>, I<wc>,
I<cut>, I<sort> except that it operates on table rows/columns instead of
lines/characters. This is convenient to use with CLI scripts that output table
data.

B<What is table data?>

A I<table data> is JSON-encoded data in the form of either: C<hos> (hash of
scalars, which is viewed as a two-column table where the columns are C<key> and
C<value>), C<aos> (array of scalars, which is viewed as a 1-column array where the
column is C<elem>), C<aoaos> (array of arrays of scalars), or C<aohos> (array of
hashes of scalars).

The input can also be an I<enveloped> table data, where the envelope is an array:
C<[status, message, content, meta]> and C<content> is the actual table data. This
kind of data is produced by C<Perinci::CmdLine>-based scripts and can contain
more detailed table specification in the C<meta> hash, which C<td> can parse.