Ubic
view release on metacpan - search on metacpan
view release on metacpan or search on metacpan
lib/Ubic/Service/Common.pm view on Meta::CPAN
package Ubic::Service::Common;
$Ubic::Service::Common::VERSION = '1.60';
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__
view all matches for this distributionview release on metacpan - search on metacpan
( run in 0.475 second using v1.00-cache-2.02-grep-82fe00e-cpan-2c419f77a38b )