File Coverage

lib/Ubic/Service/Common.pm

Criterion	Covered	Total	%
statement	43	48	89.5
branch	5	12	41.6
condition			n/a
subroutine	14	15	93.3
pod	10	10	100.0
total	72	85	84.7

package Ubic::Service::Common;
$Ubic::Service::Common::VERSION = '1.58_01'; # TRIAL
use strict;
use warnings;

# ABSTRACT: common way to construct new service by specifying several callbacks


use Params::Validate qw(:all);

use parent qw(Ubic::Service::Skeleton);

use Carp;

sub new {
    my $class = shift;
    my $params = validate(@_, {
        start       => { type => CODEREF },
        stop        => { type => CODEREF },
        status      => { type => CODEREF },
        name        => { type => SCALAR, regex => qr/^[\w-]+$/, optional => 1 }, # violates Ubic::Service encapsulation...
        port        => { type => SCALAR, regex => qr/^\d+$/, optional => 1 },
        custom_commands => { type => HASHREF, default => {} },
        user        => { type => SCALAR, optional => 1 },
        group       => { type => SCALAR | ARRAYREF, optional => 1 },
        timeout_options => { type => HASHREF, default => {} },
    });
    if ($params->{custom_commands}) {
        for (keys %{$params->{custom_commands}}) {
            ref($params->{custom_commands}{$_}) eq 'CODE' or croak "Callback expected at custom command $_";
        }
    }
    my $self = bless {%$params} => $class;
    return $self;
}

sub port {
    my $self = shift;
    return $self->{port};
}

sub status_impl {
    my $self = shift;
    return $self->{status}->();
}

sub start_impl {
    my $self = shift;
    return $self->{start}->();
}

sub stop_impl {
    my $self = shift;
    return $self->{stop}->();
}

sub timeout_options {
    my $self = shift;
    return $self->{timeout_options};
}

sub custom_commands {
    my $self = shift;
    return keys %{$self->{custom_commands}};
}

sub user {
    my $self = shift;
    return $self->{user} if defined $self->{user};
    return $self->SUPER::user();
}

# copypasted from Ubic::Service::SimpleDaemon... maybe we need moose after all
sub group {
    my $self = shift;
    my $groups = $self->{group};
    return $self->SUPER::group() if not defined $groups;
    return @$groups if ref $groups eq 'ARRAY';
    return $groups;
}

sub do_custom_command {
    my ($self, $command) = @_;
    unless (exists $self->{custom_commands}{$command}) {
        croak "Command '$command' not implemented";
    }
    $self->{custom_commands}{$command}->();
}

1;

__END__