#!perl

# Note: This script is a CLI interface to Riap function /App/hr/hr_app
# and generated automatically using App::GenPericmdScript version 0.10

# PERICMD_INLINE_SCRIPT: {code_after_shebang=>"...",include=>undef,log=>undef,program_name=>"hr",program_version=>0.10,shebang=>"perl",subcommands=>undef,url=>"/App/hr/hr_app"}

# This script is generated by Perinci::CmdLine::Inline version 0.12 on Thu Jul  2 21:31:22 2015.
# You probably should not manually edit this file.

our $DATE = '2015-07-02'; # DATE
our $VERSION = '0.10'; # VERSION

# BEGIN DATAPACK CODE
{
    my $toc;
    my $data_linepos = 1;
    unshift @INC, sub {
        $toc ||= do {

            # calculate the line number of data section
            my $data_pos = tell(DATA);
            seek DATA, 0, 0;
            my $pos = 0;
            while (1) {
                my $line = <DATA>;
                $pos += length($line);
                $data_linepos++;
                last if $pos >= $data_pos;
            }
            seek DATA, $data_pos, 0;

            my $fh = \*DATA;
my $header_line = <$fh>;
        defined($header_line)
            or die "Unexpected end of data section while reading header line";
        chomp($header_line);
        $header_line eq 'Data::Section::Seekable v1'
            or die "Invalid header, must be 'Data::Section::Seekable v1' (got: $header_line)";

        my %toc;
        my $i = 0;
        while (1) {
            $i++;
            my $toc_line = <$fh>;
            defined($toc_line)
                or die "Unexpected end of data section while reading TOC line #$i";
            chomp($toc_line);
            $toc_line =~ /\S/ or last;
            $toc_line =~ /^([^,]+),(\d+),(\d+)(?:,(.*))?$/
                or die "Invalid TOC line #$i in data section: $toc_line";
            $toc{$1} = [$2, $3, $4];
        }
        my $pos = tell $fh;
        $toc{$_}[0] += $pos for keys %toc;

            \%toc;
        };
        if ($toc->{$_[1]}) {
            seek DATA, $toc->{$_[1]}[0], 0;
            read DATA, my($content), $toc->{$_[1]}[1];
            my ($order, $lineoffset) = split(';', $toc->{$_[1]}[2]);
            $content = "# line ".($data_linepos + 1 + keys(%$toc) + 1 + $order + $lineoffset)." \"".__FILE__."\"\n" . $content;
            open my $fh, '<', \$content
                or die "DataPacker error loading $_[1] (could be a perl installation issue?)";
            return $fh;
        }
        return;
    };
}
# END DATAPACK CODE

package main;
use 5.010001;
use strict;
use warnings;

# global variables

my $_pci_r;
my %_pci_args;

# subroutines

sub _pci_check_args {
    my $args = shift;
  FILL_FROM_POS: {
        1;
        if (@ARGV > 0) { if (exists $_pci_args{"pattern"}) { return [400, "You specified --pattern but also argument #0"]; } else { $_pci_args{"pattern"} = delete($ARGV[0]); } }
    }
    # fill defaults

    # check required args
    return [400, "Missing required value for argument: color"] if exists($_pci_args{"color"}) && !defined($_pci_args{"color"});
    return [400, "Missing required value for argument: pattern"] if exists($_pci_args{"pattern"}) && !defined($_pci_args{"pattern"});
    [200];

}

sub _pci_err {
    my $res = shift;
    print STDERR "ERROR $res->[0]: $res->[1]\n";
    exit $res->[0]-300;

}

sub _pci_firstidx(&@) {
    my $f = shift;
    foreach my $i ( 0 .. $#_ )
    {
        local *_ = \$_[$i];
        return $i if $f->();
    }
    return -1;

}

sub _pci_json {
     state $json = do {
        # XXX try JSON::XS first, fallback to JSON::PP
        require JSON::PP;
        JSON::PP->new->canonical(1)->allow_nonref;
    };
    $json;

}


$_pci_r = { format=>"text", naked_res=>0, };

# parse cmdline options

{
require Getopt::Long::EvenLess;
my %mentioned_args;
my $go_spec = {
    'c=s' => sub {
        $_pci_args{color} = $_[1];
    },
    'color=s' => sub {
        $_pci_args{color} = $_[1];
    },
    'format=s' => sub {
        $_pci_r->{format} = $_[1];
    },
    'help|h|?' => sub {
        print "hr - Print horizontal bar on the terminal\n\nUsage:\n  hr --help (or -h, -?)\n  hr --version (or -v)\n  hr [options] [pattern]\n\n    % hr\n    ============================================================================\n\n    % hr -c red  ;# will output the same bar, but in red\n\n    % hr x----\n    x----x----x----x----x----x----x----x----x----x----x----x----x----x----x----x\n\n    % hr --random-pattern\n\n    % hr --random-color\n\n    % hr -r  ;# shortcut for --random-pattern --random-color\n\n    % hr -- -x-  ;# specify a pattern that starts with a dash\n    % hr -p -x-  ;# ditto\n\n    % hr --help\n\nYou can also use the `hr` function in `App::hr` module.\n\nOutput options:\n  --format=s  Choose output format, e.g. json, text\n  --json      Set output format to json\n\nOther options:\n  --color=s, -c                  Specify a color (see Term::ANSIColor)\n  --help, -h, -?                 Display help message and exit\n  --naked-res                    When outputing as JSON, strip result envelope\n  --no-naked-res, --nonaked-res  When outputing as JSON, don't strip result envelope\n  --pattern=s, -p                Specify a pattern (=arg[0])\n  --random-color                 \n  --random-pattern               \n  --version, -v                  Display program's version and exit\n  -r                             Alias for --random-pattern --random-color\n"; exit 0;
    },
    'json' => sub {
        $_pci_r->{format} = (-t STDOUT) ? "json-pretty" : "json";
    },
    'naked-res' => sub {
        $_pci_r->{naked_res} = 1;
    },
    'no-naked-res|nonaked-res' => sub {
        $_pci_r->{naked_res} = 0;
    },
    'p=s' => sub {
        $_pci_args{pattern} = $_[1];
    },
    'pattern=s' => sub {
        $_pci_args{pattern} = $_[1];
    },
    'r' => sub {
        my $code = sub {    package App::hr;    use warnings;    use strict;    no feature ':all';    use feature ':5.10';    $_[0]{'random_color'} = 1;    $_[0]{'random_pattern'} = 1;}; $code->(\%_pci_args);
    },
    'random-color' => sub {
        $_pci_args{random_color} = $_[1];
    },
    'random-pattern' => sub {
        $_pci_args{random_pattern} = $_[1];
    },
    'version|v' => sub {
        print "hr version 0.10\n";
        print "  Generated by Perinci::CmdLine::Inline version 0.12 (2015-07-02)\n";
        exit 0;
    },
};
my $res = Getopt::Long::EvenLess::GetOptions(%$go_spec);
_pci_err([500, "GetOptions failed"]) unless $res;
$res = _pci_check_args(\%_pci_args);
_pci_err($res) if $res->[0] != 200;
}

# call function

{
require App::hr;
eval { $_pci_r->{res} = App::hr::hr_app(%_pci_args) };
if ($@) { $_pci_r->{res} = [500, "Function died: $@"] }
}

# display result

{
my $fres;
if ($_pci_r->{res}[3]{"cmdline.skip_format"}) { $fres = $_pci_r->{res}[2] } else { require Inlined::_pci_format_result; $fres = _pci_format_result($_pci_r) }
print $fres;
}

# exit

{
my $status = $_pci_r->{res}[0];
exit($status =~ /200|304/ ? 0 : ($status-300));
}

=pod

=encoding UTF-8

=head1 NAME

main

=head1 VERSION

This document describes version 0.10 of main (from Perl distribution App-hr), released on 2015-07-02.

=head1 HOMEPAGE

Please visit the project's homepage at L<https://metacpan.org/release/App-hr>.

=head1 SOURCE

Source repository is at L<https://github.com/perlancar/perl-App-hr>.

=head1 BUGS

Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=App-hr>

When submitting a bug or request, please include a test-file or a
patch to an existing test-file that illustrates the bug or desired
feature.

=head1 AUTHOR

perlancar <perlancar@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2015 by perlancar@cpan.org.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut

__DATA__
Data::Section::Seekable v1
Data/Check/Structure.pm,32,3390,0;0
Getopt/Long/EvenLess.pm,3454,4552,1;165
Inlined/_pci_clean_json.pm,8041,2719,2;334
Inlined/_pci_format_result.pm,10798,2731,3;378
Inlined/_pci_gen_table.pm,13563,2153,4;449
Text/Table/Tiny.pm,15743,2417,5;519

### Data/Check/Structure.pm ###
package Data::Check::Structure;

our $DATE = '2014-07-14'; 
our $VERSION = '0.03'; 

use 5.010001;
use strict;
use warnings;

require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(
                       is_aoa
                       is_aoaos
                       is_aoh
                       is_aohos
                       is_aos
                       is_hoa
                       is_hoaos
                       is_hoh
                       is_hohos
                       is_hos
               );

sub is_aos {
    my ($data, $opts) = @_;
    $opts //= {};
    my $max = $opts->{max};

    return 0 unless ref($data) eq 'ARRAY';
    for my $i (0..@$data-1) {
        last if defined($max) && $i >= $max;
        return 0 if ref($data->[$i]);
    }
    1;
}

sub is_aoa {
    my ($data, $opts) = @_;
    $opts //= {};
    my $max = $opts->{max};

    return 0 unless ref($data) eq 'ARRAY';
    for my $i (0..@$data-1) {
        last if defined($max) && $i >= $max;
        return 0 unless ref($data->[$i]) eq 'ARRAY';
    }
    1;
}

sub is_aoaos {
    my ($data, $opts) = @_;
    $opts //= {};
    my $max = $opts->{max};

    return 0 unless ref($data) eq 'ARRAY';
    my $aos_opts = {max=>$max};
    for my $i (0..@$data-1) {
        last if defined($max) && $i >= $max;
        return 0 unless is_aos($data->[$i], $aos_opts);
    }
    1;
}

sub is_aoh {
    my ($data, $opts) = @_;
    $opts //= {};
    my $max = $opts->{max};

    return 0 unless ref($data) eq 'ARRAY';
    for my $i (0..@$data-1) {
        last if defined($max) && $i >= $max;
        return 0 unless ref($data->[$i]) eq 'HASH';
    }
    1;
}

sub is_aohos {
    my ($data, $opts) = @_;
    $opts //= {};
    my $max = $opts->{max};

    return 0 unless ref($data) eq 'ARRAY';
    my $hos_opts = {max=>$max};
    for my $i (0..@$data-1) {
        last if defined($max) && $i >= $max;
        return 0 unless is_hos($data->[$i], $hos_opts);
    }
    1;
}

sub is_hos {
    my ($data, $opts) = @_;
    $opts //= {};
    my $max = $opts->{max};

    return 0 unless ref($data) eq 'HASH';
    my $i = 0;
    for my $k (keys %$data) {
        last if defined($max) && ++$i >= $max;
        return 0 if ref($data->{$k});
    }
    1;
}

sub is_hoa {
    my ($data, $opts) = @_;
    $opts //= {};
    my $max = $opts->{max};

    return 0 unless ref($data) eq 'HASH';
    my $i = 0;
    for my $k (keys %$data) {
        last if defined($max) && ++$i >= $max;
        return 0 unless ref($data->{$k}) eq 'ARRAY';
    }
    1;
}

sub is_hoaos {
    my ($data, $opts) = @_;
    $opts //= {};
    my $max = $opts->{max};

    return 0 unless ref($data) eq 'HASH';
    my $i = 0;
    for my $k (keys %$data) {
        last if defined($max) && ++$i >= $max;
        return 0 unless is_aos($data->{$k});
    }
    1;
}

sub is_hoh {
    my ($data, $opts) = @_;
    $opts //= {};
    my $max = $opts->{max};

    return 0 unless ref($data) eq 'HASH';
    my $i = 0;
    for my $k (keys %$data) {
        last if defined($max) && ++$i >= $max;
        return 0 unless ref($data->{$k}) eq 'HASH';
    }
    1;
}

sub is_hohos {
    my ($data, $opts) = @_;
    $opts //= {};
    my $max = $opts->{max};

    return 0 unless ref($data) eq 'HASH';
    my $i = 0;
    for my $k (keys %$data) {
        last if defined($max) && ++$i >= $max;
        return 0 unless is_hos($data->{$k});
    }
    1;
}

1;

__END__

### Getopt/Long/EvenLess.pm ###
package Getopt::Long::EvenLess;

our $DATE = '2015-06-19'; 
our $VERSION = '0.04'; 

use 5.010001;
use strict 'subs', 'vars';

our @EXPORT   = qw(GetOptions);
our @EXPORT_OK = qw(GetOptionsFromArray);

sub import {
    my $pkg = shift;
    my $caller = caller;
    my @imp = @_ ? @_ : @EXPORT;
    for my $imp (@imp) {
        if (grep {$_ eq $imp} (@EXPORT, @EXPORT_OK)) {
            *{"$caller\::$imp"} = \&{$imp};
        } else {
            die "$imp is not exported by ".__PACKAGE__;
        }
    }
}

sub GetOptionsFromArray {
    my ($argv, %spec) = @_;

    my $success = 1;

    my %spec_by_opt_name;
    for (keys %spec) {
        my $orig = $_;
        s/=[fios]\@?\z//;
        s/\|.+//;
        $spec_by_opt_name{$_} = $orig;
    }

    my $code_find_opt = sub {
        my ($wanted, $short_mode) = @_;
        my @candidates;
      OPT_SPEC:
        for my $spec (keys %spec) {
            $spec =~ s/=[fios]\@?\z//;
            my @opts = split /\|/, $spec;
            for my $o (@opts) {
                next if $short_mode && length($o) > 1;
                if ($o eq $wanted) {
                    @candidates = ($opts[0]);
                    last OPT_SPEC;
                } elsif (index($o, $wanted) == 0) {
                    push @candidates, $opts[0];
                    next OPT_SPEC;
                }
            }
        }
        if (!@candidates) {
            warn "Unknown option: $wanted\n";
            $success = 0;
            return undef; 
        } elsif (@candidates > 1) {
            warn "Option $wanted is ambiguous (" .
                join(", ", @candidates) . ")\n";
            $success = 0;
            return ''; 
        }
        return $candidates[0];
    };

    my $code_set_val = sub {
        my $name = shift;

        my $spec_key = $spec_by_opt_name{$name};
        my $handler  = $spec{$spec_key};

        $handler->({name=>$name}, @_ ? $_[0] : 1);
    };

    my $i = -1;
    my @remaining;
  ELEM:
    while (++$i < @$argv) {
        if ($argv->[$i] eq '--') {

            push @remaining, @{$argv}[$i+1 .. @$argv-1];
            last ELEM;

        } elsif ($argv->[$i] =~ /\A--(.+?)(?:=(.*))?\z/) {

            my ($used_name, $val_in_opt) = ($1, $2);
            my $opt = $code_find_opt->($used_name);
            if (!defined($opt)) {
                push @remaining, $argv->[$i];
                next ELEM;
            } elsif (!length($opt)) {
                next ELEM; 
            }

            my $spec = $spec_by_opt_name{$opt};
            if ($spec =~ /=[fios]\@?\z/) {
                if (defined $val_in_opt) {
                    if (length $val_in_opt) {
                        $code_set_val->($opt, $val_in_opt);
                    } else {
                        warn "Option $used_name requires an argument\n";
                        $success = 0;
                        next ELEM;
                    }
                } else {
                    if ($i+1 >= @$argv) {
                        warn "Option $used_name requires an argument\n";
                        $success = 0;
                        last ELEM;
                    }
                    $i++;
                    $code_set_val->($opt, $argv->[$i]);
                }
            } else {
                $code_set_val->($opt);
            }

        } elsif ($argv->[$i] =~ /\A-(.*)/) {

            my $str = $1;
          SHORT_OPT:
            while ($str =~ s/(.)//) {
                my $used_name = $1;
                my $opt = $code_find_opt->($1, 'short');
                next SHORT_OPT unless defined($opt) && length($opt);

                my $spec = $spec_by_opt_name{$opt};
                if ($spec =~ /=[fios]\@?\z/) {
                    if (length $str) {
                        $code_set_val->($opt, $str);
                        next ELEM;
                    } else {
                        if ($i+1 >= @$argv) {
                            warn "Option $used_name requires an argument\n";
                            $success = 0;
                            last ELEM;
                        }
                        $i++;
                        $code_set_val->($opt, $argv->[$i]);
                    }
                } else {
                    $code_set_val->($opt);
                }
            }

        } else { 

            push @remaining, $argv->[$i];
            next;

        }
    }

  RETURN:
    splice @$argv, 0, ~~@$argv, @remaining; 
    return $success;
}

sub GetOptions {
    GetOptionsFromArray(\@ARGV, @_);
}

1;

__END__

### Inlined/_pci_clean_json.pm ###
require Scalar::Util; use feature 'state'; sub _pci_clean_json { sub {
my $data = shift;
state %refs;
state $ctr_circ;
state $process_array;
state $process_hash;
if (!$process_array) { $process_array = sub { my $a = shift; for my $e (@$a) { my $ref=ref($e);
    if ($ref eq 'DateTime') { $e = $e->epoch; $ref = ref($e) }
    elsif ($ref eq 'Regexp') { $e = "$e" }
    elsif ($ref eq 'SCALAR') { $e = ${ $e }; $ref = ref($e) }
    elsif ($ref eq 'Time::Moment') { $e = $e->epoch; $ref = ref($e) }
    elsif (Scalar::Util::blessed($e)) { if (!$Data::Clean::Base::_clone && 0) { $e = Acme::Damn::damn($e) } else { $e = Function::Fallback::CoreOrPP::_unbless_fallback($e) } $ref = ref($e) }
    if ($ref && $refs{ $e }++) { if (++$ctr_circ <= 1) { $e = Data::Clone::clone($e); redo } else { $e = 'CIRCULAR' } $ref = ref($e) }
    if ($ref eq 'ARRAY') { $process_array->($e) }
    elsif ($ref eq 'HASH') { $process_hash->($e) }
    elsif ($ref) { $e = $ref; $ref = "" }
} } }
if (!$process_hash) { $process_hash = sub { my $h = shift; for my $k (keys %$h) { my $ref=ref($h->{$k});
    if ($ref eq 'DateTime') { $h->{$k} = $h->{$k}->epoch; $ref = ref($h->{$k}) }
    elsif ($ref eq 'Regexp') { $h->{$k} = "$h->{$k}" }
    elsif ($ref eq 'SCALAR') { $h->{$k} = ${ $h->{$k} }; $ref = ref($h->{$k}) }
    elsif ($ref eq 'Time::Moment') { $h->{$k} = $h->{$k}->epoch; $ref = ref($h->{$k}) }
    elsif (Scalar::Util::blessed($h->{$k})) { if (!$Data::Clean::Base::_clone && 0) { $h->{$k} = Acme::Damn::damn($h->{$k}) } else { $h->{$k} = Function::Fallback::CoreOrPP::_unbless_fallback($h->{$k}) } $ref = ref($h->{$k}) }
    if ($ref && $refs{ $h->{$k} }++) { if (++$ctr_circ <= 1) { $h->{$k} = Data::Clone::clone($h->{$k}); redo } else { $h->{$k} = 'CIRCULAR' } $ref = ref($h->{$k}) }
    if ($ref eq 'ARRAY') { $process_array->($h->{$k}) }
    elsif ($ref eq 'HASH') { $process_hash->($h->{$k}) }
    elsif ($ref) { $h->{$k} = $ref; $ref = "" }
} } }
%refs = (); $ctr_circ=0;
for ($data) { my $ref=ref($_);
    if ($ref eq 'DateTime') { $_ = $_->epoch; $ref = ref($_) }
    elsif ($ref eq 'Regexp') { $_ = "$_" }
    elsif ($ref eq 'SCALAR') { $_ = ${ $_ }; $ref = ref($_) }
    elsif ($ref eq 'Time::Moment') { $_ = $_->epoch; $ref = ref($_) }
    elsif (Scalar::Util::blessed($_)) { if (!$Data::Clean::Base::_clone && 0) { $_ = Acme::Damn::damn($_) } else { $_ = Function::Fallback::CoreOrPP::_unbless_fallback($_) } $ref = ref($_) }
    if ($ref && $refs{ $_ }++) { if (++$ctr_circ <= 1) { $_ = Data::Clone::clone($_); redo } else { $_ = 'CIRCULAR' } $ref = ref($_) }
    if ($ref eq 'ARRAY') { $process_array->($_) }
    elsif ($ref eq 'HASH') { $process_hash->($_) }
    elsif ($ref) { $_ = $ref; $ref = "" }
}
$data
}
; }
1;
### Inlined/_pci_format_result.pm ###
sub _pci_format_result {
    require Data::Check::Structure;

    my $r = shift;

    my $res    = $r->{res};
    my $format = $r->{format} // 'text';

    if ($format =~ /\Atext(-simple|-pretty)?\z/) {
        my $is_pretty = $format eq 'text-pretty' ? 1 :
            $format eq 'text-simple' ? 0 : (-t STDOUT);
        no warnings 'uninitialized';
        if ($res->[0] !~ /^(2|304)/) {
            my $fres = "ERROR $res->[0]: $res->[1]";
            if (my $prev = $res->[3]{prev}) {
                $fres .= " ($prev->[0]: $prev->[1])";
            }
            return "$fres\n";
        } elsif ($res->[3] && $res->[3]{"x.hint.result_binary"}) {
            return $res->[2];
        } else {
            my $data = $res->[2];
            my $max = 5;
            if (!ref($data)) {
                $data //= "";
                $data .= "\n" unless !length($data) || $data =~ /\n\z/;
                return $data;
            } elsif (ref($data) eq 'ARRAY' && !@$data) {
                return "";
            } elsif (Data::Check::Structure::is_aos($data, {max=>$max})) {
                return join("", map {"$_\n"} @$data);
            } elsif (Data::Check::Structure::is_aoaos($data, {max=>$max})) {
                require Inlined::_pci_gen_table;
                return _pci_gen_table($data, 0, $res->[3], $is_pretty);
            } elsif (Data::Check::Structure::is_hos($data, {max=>$max})) {
                $data = [map {[$_, $data->{$_}]} sort keys %$data];
                unshift @$data, ["key", "value"];
                require Inlined::_pci_gen_table;
                return _pci_gen_table($data, 1, $res->[3], $is_pretty);
            } elsif (Data::Check::Structure::is_aohos($data, {max=>$max})) {
                my %fieldnames;
                for my $row (@$data) {
                    $fieldnames{$_}++ for keys %$row;
                }
                my @fieldnames = sort keys %fieldnames;
                my $newdata = [];
                for my $row (@$data) {
                    push @$newdata, [map {$row->{$_}} @fieldnames];
                }
                unshift @$newdata, \@fieldnames;
                require Inlined::_pci_gen_table;
                return _pci_gen_table($newdata, 1, $res->[3], $is_pretty);
            } else {
                $format = 'json-pretty';
            }
        }
    }

    $res = $res->[2] if $r->{naked_res};

    warn "Unknown format '$format', fallback to json-pretty"
        unless $format =~ /\Ajson(-pretty)?\z/;
    require Inlined::_pci_clean_json;
    _pci_clean_json($res);
    if ($format eq 'json') {
        return _pci_json()->encode($res) . "\n";
    } else {
        return _pci_json()->canonical(1)->pretty->encode($res);
    }
}
1;
### Inlined/_pci_gen_table.pm ###
sub _pci_gen_table {
    my ($data, $header_row, $resmeta, $is_pretty) = @_;

    $resmeta //= {};

    my @columns;
    if ($header_row) {
        @columns = @{$data->[0]};
    } else {
        @columns = map {"col$_"} 0..@{$data->[0]}-1;
    }

    my $column_orders; 
  SET_COLUMN_ORDERS: {

        my $tcos;
        if ($ENV{FORMAT_PRETTY_TABLE_COLUMN_ORDERS}) {
            $tcos = _pci_json()->decode($ENV{FORMAT_PRETTY_TABLE_COLUMN_ORDERS});
        } elsif (my $rfos = ($resmeta->{'cmdline.format_options'} //
                                 $resmeta->{format_options})) {
            my $rfo = $rfos->{'text-pretty'} // $rfos->{text} // $rfos->{any};
            if ($rfo) {
                $tcos = $rfo->{table_column_orders};
            }
        }
        if ($tcos) {
          COLS:
            for my $cols (@$tcos) {
                for my $col (@$cols) {
                    next COLS unless first {$_ eq $col} @columns;
                }
                $column_orders = $cols;
                last SET_COLUMN_ORDERS;
            }
        }

        $column_orders = $resmeta->{'table.fields'};
    }

    if ($column_orders) {
        my @map0 = sort {
            my $idx_a = _pci_firstidx(sub {$_ eq $a->[1]},
                                                  @$column_orders) // 9999;
            my $idx_b = _pci_firstidx(sub {$_ eq $b->[1]},
                                                  @$column_orders) // 9999;
            $idx_a <=> $idx_b || $a->[1] cmp $b->[1];
        } map {[$_, $columns[$_]]} 0..@columns-1;
        my @map;
        for (0..@map0-1) {
            $map[$_] = $map0[$_][0];
        }
        my $newdata = [];
        for my $row (@$data) {
            my @newrow;
            for (0..@map-1) { $newrow[$_] = $row->[$map[$_]] }
            push @$newdata, \@newrow;
        }
        $data = $newdata;
    }

    if ($is_pretty) {
        require Text::Table::Tiny;
        Text::Table::Tiny::table(rows=>$data, header_row=>$header_row) . "\n";
    } else {
        no warnings 'uninitialized';
        shift @$data if $header_row;
        join("", map {join("\t", @$_)."\n"} @$data);
    }
}
1;
### Text/Table/Tiny.pm ###
use strict;
use warnings;
package Text::Table::Tiny;
use List::Util qw();



our $COLUMN_SEPARATOR = '|';
our $ROW_SEPARATOR = '-';
our $CORNER_MARKER = '+';
our $HEADER_ROW_SEPARATOR = '=';
our $HEADER_CORNER_MARKER = 'O';

sub table {

    my %params = @_;
    my $rows = $params{rows} or die "Must provide rows!";

    my $widths = _maxwidths($rows);
    my $max_index = _max_array_index($rows);

    my $format = _get_format($widths);
    my $row_sep = _get_row_separator($widths);
    my $head_row_sep = _get_header_row_separator($widths);

    my @table;
    push @table, $row_sep;

    my $data_begins = 0;
    if ( $params{header_row} ) {
        my $header_row = $rows->[0];
	$data_begins++;
        push @table, sprintf(
	    $format, 
	    map { defined($header_row->[$_]) ? $header_row->[$_] : '' } (0..$max_index)
	);
        push @table, $params{separate_rows} ? $head_row_sep : $row_sep;
    }

    foreach my $row ( @{ $rows }[$data_begins..$#$rows] ) {
        push @table, sprintf(
	    $format, 
	    map { defined($row->[$_]) ? $row->[$_] : '' } (0..$max_index)
	);
        push @table, $row_sep if $params{separate_rows};
    }

    push @table, $row_sep unless $params{separate_rows};
    return join("\n",grep {$_} @table);
}

sub _get_cols_and_rows ($) {
    my $rows = shift;
    return ( List::Util::max( map { scalar @$_ } @$rows), scalar @$rows);
}

sub _maxwidths {
    my $rows = shift;
    my $max_index = _max_array_index($rows);
    my $widths = [];
    for my $i (0..$max_index) {
        my $max = List::Util::max(map {defined $$_[$i] ? length($$_[$i]) : 0} @$rows);
        push @$widths, $max;
    }
    return $widths;
}

sub _max_array_index {
    my $rows = shift;
    return List::Util::max( map { $#$_ } @$rows );
}

sub _get_format {
    my $widths = shift;
    return "$COLUMN_SEPARATOR ".join(" $COLUMN_SEPARATOR ",map { "%-${_}s" } @$widths)." $COLUMN_SEPARATOR";
}

sub _get_row_separator {
    my $widths = shift;
    return "$CORNER_MARKER$ROW_SEPARATOR".join("$ROW_SEPARATOR$CORNER_MARKER$ROW_SEPARATOR",map { $ROW_SEPARATOR x $_ } @$widths)."$ROW_SEPARATOR$CORNER_MARKER";
}

sub _get_header_row_separator {
    my $widths = shift;
    return "$HEADER_CORNER_MARKER$HEADER_ROW_SEPARATOR".join("$HEADER_ROW_SEPARATOR$HEADER_CORNER_MARKER$HEADER_ROW_SEPARATOR",map { $HEADER_ROW_SEPARATOR x $_ } @$widths)."$HEADER_ROW_SEPARATOR$HEADER_CORNER_MARKER";
}

1;

__END__

