File Coverage

blib/lib/Net/Hadoop/YARN/Roles/AppMasterHistoryServer.pm

Criterion	Covered	Total	%
statement	35	69	50.7
branch	0	6	0.0
condition	4	19	21.0
subroutine	8	13	61.5
pod			n/a
total	47	107	43.9

package Net::Hadoop::YARN::Roles::AppMasterHistoryServer;
$Net::Hadoop::YARN::Roles::AppMasterHistoryServer::VERSION = '0.203';
use strict;
use warnings;
use 5.10.0;

use Carp qw( croak );
use Hash::Path;
use Moo::Role;

my %validation_pattern = (
    appid     => 'application_[0-9]+_[0-9]+',
    jobid     => 'job_[0-9]+_[0-9]+',
    taskid    => 'task_[0-9]+_[0-9]+_[a-z]_[0-9]+',
    attemptid => 'attempt_[0-9]+_[0-9]+_[a-z]_[0-9]+_[0-9]+',
);

my $RE_EXTRACT_VALIDS = sprintf '(?:%s)',
                                join '|',
                                    map { $validation_pattern{$_} }
                                    keys %validation_pattern;

# used by consuming classes, for specific cases
sub _validate_id {
    my $self = shift;
    return $_[1] =~ /^$validation_pattern{$_[0]}$/;
}

sub _extract_valid_params {
    # TODO: this doesn't recognise container or attempt etc ids per above hash
    #
    my $self = shift;
    my $str  = shift || return;

    my @ids;
    while ( my($type) = $str =~ /$RE_EXTRACT_VALIDS/gc ) {
        push @ids, $type;
    }

    return @ids;
}

sub _mk_subs {
    my $methods_urls = shift;
    my $opt          = shift || {};
    my $pfix         = $opt->{prefix} || '';

    for my $key ( keys %{$methods_urls} ) {

        # use a closure to only run the preprocessing once per method for
        # validation. URL params are of the form {appid}, {taskid}, hence the
        # regexes to find them
        my @param_names = $methods_urls->{$key}[0] =~ m/\{([a-z]+)\}/g;
        my @validations = map {
            my $name = $_;
            {
                name     => $name,
                validate => sub {
                    my $val = shift || return;
                    $val =~ /^$validation_pattern{$name}$/
                },
            };
        } @param_names;

        my $url       = $methods_urls->{$key}[0];
        my $json_path = $methods_urls->{$key}[1];

        my $new_method = sub {
            my $self       = shift;
            # check the list of params validates against the list of
            # placeholders gathered in the url split above
            my $params_idx = 0;

            for my $param ( @_ ) {
                my $v = $validations[ $params_idx ]
                            || do {
                                my $what = $key =~ m{ \A _ }xms
                                         ? do {
                                                if ( my $who = (caller 1)[3] ) {
                                                    my($short) = (split m{ [:]{2} }xms, $who)[-1];
                                                    sprintf qq{%s` via: `%s}, $short, $who;
                                                }
                                                else {
                                                    $key;
                                                }
                                            }
                                         : $key
                                         ;
                                croak sprintf "No validator for `%s` [%s]. Be sure that `%s` is a valid API endpoint for this object",
                                                    $param,
                                                    $params_idx,
                                                    $what,
                                    ;
                                };

                if ( ! ref $param && ! $v->{validate}->( $param ) ) {
                    croak sprintf "Param `%s` doesn't satisfy pattern /%s/ in call to `%s`.",
                                    $param || '',
                                    $validation_pattern{  $v->{name}  },
                                    $key,
                    ;
                }
                $params_idx++;
            }

            # now replace all url placeholders with the params we were given;
            # extra parameters (in a hashref) will be passed as regular URL
            # params, not interpolated in the path
            my $interp_url = $url;
            my $extra_params;
            while (my $param = shift) {
                if (! @_ && ref $param) {
                    $extra_params = $param;
                    last;
                }
                $interp_url =~ s/\{[a-z]+\}/$param/;
            }
            my $res = $self->_get($interp_url, { params => $extra_params });

            # Only return the JSON fragment we need
            return Hash::Path->get($res, split(/\./, $json_path));
        };
        {
            # limit the scope of non-strict-ness
            # insert the method for the endpoint in the using class
            no strict 'refs';
            *{ ( caller() )[0] . '::' . $pfix . $key } = $new_method;
        }
    }
}

sub _mk_uri {
    my $self = shift;
    my ($server, $path, $params) = @_;
    my $uri = $server . "/" . $path;
    $uri =~ s#//+#/#g;
    $uri = URI->new("http://" . $uri);
    if ($params) {
        $uri->query_form($params);
    }
    return $uri;
}

1;

__END__