App-PerlGlue

 view release on metacpan or  search on metacpan

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

our $VERSION = '0.04';

sub run {
    my ($class, @argv) = @_;
    my $cmd = shift @argv // 'help';

    return _help() if $cmd eq 'help' || $cmd eq '--help' || $cmd eq '-h';

    if ($cmd eq 'version' || $cmd eq '--version' || $cmd eq '-v') {
        say "perlglue $VERSION";
        return 0;
    }

    return _cmd_command_help($cmd)            if @argv && ($argv[0] eq '--help' || $argv[0] eq '-h');

    return _cmd_upper()                      if $cmd eq 'upper';
    return _cmd_lower()                      if $cmd eq 'lower';
    return _cmd_lines(@argv)                 if $cmd eq 'lines';
    return _cmd_lines(@argv)                 if $cmd eq 'where';
    return _cmd_replace(@argv)               if $cmd eq 'replace';

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

    my $file = shift @argv // die "pick requires file\n";
    my $flag = shift @argv // '';
    die "pick expects --csv name,email\n" unless $flag eq '--csv';
    my @wanted = split /,/, (shift(@argv) // '');

    my $fh = _open_in($file);
    my @rows = _parse_csv_rows($fh);
    my $header = shift @rows // [];
    my %idx; @idx{@$header} = (0 .. $#$header);

    say join ',', @wanted;
    for my $r (@rows) {
        my @out = map { defined $idx{$_} ? $r->[ $idx{$_} ] : '' } @wanted;
        say join ',', @out;
    }
    return 0;
}

sub _cmd_convert {
    my (@argv) = @_;
    my $file = shift @argv // die "convert requires file\n";
    my $to;
    while (@argv) {
        my $a = shift @argv;
        $to = shift @argv if $a eq '--to';
    }
    die "convert only supports --to jsonl\n" unless defined $to && $to eq 'jsonl';

    my $fh = _open_in($file);
    my @rows = _parse_csv_rows($fh);
    my $header = shift @rows // [];
    for my $r (@rows) {
        my %obj;
        @obj{@$header} = @$r;
        say encode_json(\%obj);
    }
    return 0;
}

sub _cmd_jsonl {
    my (@argv) = @_;
    my ($file, $expr, $where);
    while (@argv) {
        my $a = shift @argv;
        if ($a eq '--where') { $where = shift @argv; }

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

    $expr = $where if defined $where;
    my $fh = _open_in($file);
    while (my $line = <$fh>) {
        chomp $line;
        next if $line eq '';
        local $_ = decode_json($line);
        if (defined $expr) {
            my $ok = eval $expr;
            next unless $ok;
        }
        say encode_json($_);
    }
    return 0;
}

sub _cmd_template {
    my (@argv) = @_;
    my $file = shift @argv // die "template requires file\n";
    my $tpl = shift @argv // die "template requires template string\n";

    my $fh = _open_in($file);
    my @rows = _parse_csv_rows($fh);
    my $header = shift @rows // [];
    for my $r (@rows) {
        my %obj;
        @obj{@$header} = @$r;
        (my $out = $tpl) =~ s/\{\{\s*(\w+)\s*\}\}/defined $obj{$1} ? $obj{$1} : ''/ge;
        say $out;
    }
    return 0;
}

sub _cmd_rename {
    my (@argv) = @_;
    my $expr = shift @argv // die "rename requires substitution expression\n";
    for my $old (@argv) {
        (my $new = $old);
        local $_ = $new;
        eval $expr;
        $new = $_;
        next if $new eq $old;
        die "Target exists: $new\n" if -e $new;
        rename $old, $new or die "rename $old -> $new failed: $!";
        say "$old -> $new";
    }
    return 0;
}

sub _cmd_command_help {
    my ($cmd) = @_;
    my %usage = (
        upper    => 'perlglue upper < input.txt',
        lower    => 'perlglue lower < input.txt',
        lines    => 'perlglue lines [file] [--where EXPR]',

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

        csv      => 'perlglue csv users.csv --to jsonl',
        'from-csv' => 'perlglue from-csv users.csv --to jsonl',
        jsonl    => q{perlglue jsonl logs.jsonl '\$_->{status} >= 500'},
        template => q{perlglue template users.csv 'Hello, {{name}}'},
        rename   => q{perlglue rename 's/\s+/_/g' files...},
        version  => 'perlglue version',
        help     => 'perlglue help',
    );

    if (exists $usage{$cmd}) {
        say $usage{$cmd};
        return 0;
    }

    warn "Unknown command: $cmd\n";
    return 2;
}

sub _help {
    print <<'HELP';
perlglue - glue messy text into useful shapes