File Coverage

lib/Ubic/Multiservice.pm

Criterion	Covered	Total	%
statement	59	68	86.7
branch	17	20	85.0
condition			n/a
subroutine	11	13	84.6
pod	5	5	100.0
total	92	106	86.7

package Ubic::Multiservice;
# ABSTRACT: interface of multiservice representing several named services
$Ubic::Multiservice::VERSION = '1.58_01'; # TRIAL
use strict;
use warnings;

sub simple_service($$);

sub service_names($);



use Carp;
use Params::Validate qw(:all);
use Try::Tiny;
use parent qw(Ubic::Service);

sub service($$) {
    my $self = shift;
    my ($name) = validate_pos(@_, { type => SCALAR, regex => qr{^[\w-]+(?:\.[\w-]+)*$} });
    my @parts = split '\\.', $name;

    if ($self->{service_cache}{$name}) {
        if (my $error = $self->{service_cache}{$name}{error}) {
            die $error;
        }
        else {
            return $self->{service_cache}{$name}{service};
        }
    }

    my $service;
    try {
        if (@parts == 1) {
            $service = $self->simple_service($name);
            unless (defined $service->name) {
                $service->name($name);
            }
            $service->parent_name($self->full_name);
        }
        else {
            # complex service
            my $top_level = $self->simple_service($parts[0]);
            unless ($top_level->isa('Ubic::Multiservice')) {
                croak "top-level service '$parts[0]' is not a multiservice";
            }
            unless (defined $top_level->name) {
                $top_level->name($parts[0]);
            }
            $top_level->parent_name($self->full_name);
            $service = $top_level->service(join '.', @parts[1..$#parts]);
        }
        $self->{service_cache}{$name} = { service => $service };
    }
    catch {
        $self->{service_cache}{$name} = { error => $_ };
        die $_;
    };
    return $service;
}


sub has_service($$) {
    my $self = shift;
    my ($name) = validate_pos(@_, { type => SCALAR, regex => qr{^[\w-]+(?:\.[\w-]+)*$} });
    my @parts = split '\\.', $name;
    if (@parts == 1) {
        return $self->has_simple_service($name);
    }
    # complex service
    return undef unless $self->has_service($parts[0]);
    my $top_level = $self->service($parts[0]);
    unless ($top_level->isa('Ubic::Multiservice')) {
        # strange, top-level service is not a multiservice
        return undef;
    }
    return $top_level->has_service(join '.', @parts[1..$#parts]);
}

sub services($) {
    my $self = shift;
    my @services;
    for my $name ($self->service_names) {
        my $service = eval { $self->service($name) };
        if ($@) {
            warn "Can't construct '$name': $@";
            next;
        }
        push @services, $service;
    }
    return @services;
}

sub has_simple_service($$) {
    my $self = shift;
    my ($name) = validate_pos(@_, { type => SCALAR, regex => qr{^[\w-]+$} });
    return grep { $_ eq $name } $self->service_names;
}

sub multiop($) {
    return 'allowed';
}


1;

__END__