view release on metacpan or  search on metacpan

script/rank  view on Meta::CPAN

#!perl

our $DATE = '2018-05-01'; # DATE
our $VERSION = '0.007'; # VERSION

use 5.010001;
use strict;
use warnings;

use Getopt::Long qw(:config bundling no_ignore_case);

my %Opts = (
    action => 'rank',
    ignore_leading_blanks => 0,
    calc_percentile => [],
    reverse => 0,
    sort => 'ascii',
    field_separator => "\t",
    sort_field => 0,
    show_rank => 1,
    show_percentile => 0,
    rank => 'default',
    # TODO: --dictionary-order, -d
    # TODO: --ignore-nonprinting, -i
    # TODO: --human-numeric-sort, -h
    # TODO: --version-sort, -V
    # TODO: --percentile-format=s
);

sub parse_cmdline {
    my $res = GetOptions(
        'action=s' => \$Opts{action},
        'calc-percentile=s' => sub {
            $Opts{action} = 'calc-percentile';
            $Opts{calc_percentile} = [split /\s*,\s*/, $_[1]];
        },
        'ignore-leading-blanks|b' => \$Opts{ignore_leading_blanks},
        'ignore-case|f' => \$Opts{ignore_case},
        'reverse|r' => \$Opts{reverse},
        'field-separator|t=s' => \$Opts{field_separator},
        'numeric-sort|n' => sub { $Opts{sort} = 'numeric' },
        'sort=s' => \$Opts{sort},
        'sort-field=i' => \$Opts{sort_field},
        'rank=s' => \$Opts{rank},
        'show-rank!' => \$Opts{show_rank},
        'show-percentile!' => \$Opts{show_percentile},
        '-p' => sub { $Opts{show_percentile} = 1 },
        'help|h' => sub {
            print <<USAGE;
Usage:
  rank [OPTIONS]... [INPUT]...
  rank --help

For more details, see the manpage/documentation.
USAGE
            exit 0;
        },
        'version|v' => sub {
            no warnings 'once';
            say "rank version ".($main::VERSION // 'dev');
            exit 0;
        },
    );
    exit 99 if !$res;
}

sub run {
    my $fs = $Opts{field_separator};

    my @data; # elem: [sortkey, $orig_line]
    my $re_split_fields = qr/\Q$fs\E/;
    while (defined (my $line = <>)) {
        if ($Opts{ignore_leading_blanks}) {
            $line =~ s/\A\s+//;
        }
        my @fields = split $re_split_fields, $line;
        my $sortkey = $fields[$Opts{sort_field}] // '';
        if ($Opts{ignore_case}) { $sortkey = lc $sortkey };
        push @data, [$sortkey, $line];
    }

    my $sortsub;
    if ($Opts{sort} eq 'numeric') {
        if ($Opts{reverse}) {
            $sortsub = sub { $_[0] <=> $_[1] };
        } else {
            $sortsub = sub { $_[1] <=> $_[0] };
        }
    } else {
        if ($Opts{reverse}) {
            $sortsub = sub { $_[1] cmp $_[0] };
        } else {
            $sortsub = sub { $_[0] cmp $_[1] };
        }
    }

    @data = sort { $sortsub->($a->[0], $b->[0]) } @data;

    # exact percentiles to calculate
    my @percentiles;
    for (@{ $Opts{calc_percentile} }) {
        my $p = $_+0;
        die "rank: Invalid percentile '$_', must be (0,100]\n"
            unless $p > 0 && $p <= 100;
        push @percentiles, $p;
    }
    @percentiles = sort {$b <=> $a} @percentiles;

    # if we're using the 'no-skip' ranking system, we'll need to calculate
    # the lowest ranking (highest number)first
    my $lowest_rank;