1package Ubic::Service::Common; 2{ 3 $Ubic::Service::Common::VERSION = '1.58'; 4} 5 6use strict; 7use warnings; 8 9# ABSTRACT: common way to construct new service by specifying several callbacks 10 11 12use Params::Validate qw(:all); 13 14use parent qw(Ubic::Service::Skeleton); 15 16use Carp; 17 18sub new { 19 my $class = shift; 20 my $params = validate(@_, { 21 start => { type => CODEREF }, 22 stop => { type => CODEREF }, 23 status => { type => CODEREF }, 24 name => { type => SCALAR, regex => qr/^[\w-]+$/, optional => 1 }, # violates Ubic::Service encapsulation... 25 port => { type => SCALAR, regex => qr/^\d+$/, optional => 1 }, 26 custom_commands => { type => HASHREF, default => {} }, 27 user => { type => SCALAR, optional => 1 }, 28 group => { type => SCALAR | ARRAYREF, optional => 1 }, 29 timeout_options => { type => HASHREF, default => {} }, 30 }); 31 if ($params->{custom_commands}) { 32 for (keys %{$params->{custom_commands}}) { 33 ref($params->{custom_commands}{$_}) eq 'CODE' or croak "Callback expected at custom command $_"; 34 } 35 } 36 my $self = bless {%$params} => $class; 37 return $self; 38} 39 40sub port { 41 my $self = shift; 42 return $self->{port}; 43} 44 45sub status_impl { 46 my $self = shift; 47 return $self->{status}->(); 48} 49 50sub start_impl { 51 my $self = shift; 52 return $self->{start}->(); 53} 54 55sub stop_impl { 56 my $self = shift; 57 return $self->{stop}->(); 58} 59 60sub timeout_options { 61 my $self = shift; 62 return $self->{timeout_options}; 63} 64 65sub custom_commands { 66 my $self = shift; 67 return keys %{$self->{custom_commands}}; 68} 69 70sub user { 71 my $self = shift; 72 return $self->{user} if defined $self->{user}; 73 return $self->SUPER::user(); 74} 75 76# copypasted from Ubic::Service::SimpleDaemon... maybe we need moose after all 77sub group { 78 my $self = shift; 79 my $groups = $self->{group}; 80 return $self->SUPER::group() if not defined $groups; 81 return @$groups if ref $groups eq 'ARRAY'; 82 return $groups; 83} 84 85sub do_custom_command { 86 my ($self, $command) = @_; 87 unless (exists $self->{custom_commands}{$command}) { 88 croak "Command '$command' not implemented"; 89 } 90 $self->{custom_commands}{$command}->(); 91} 92 931; 94 95__END__ 96 97=pod 98 99=head1 NAME 100 101Ubic::Service::Common - common way to construct new service by specifying several callbacks 102 103=head1 VERSION 104 105version 1.58 106 107=head1 SYNOPSIS 108 109 $service = Ubic::Service::Common->new({ 110 start => sub { 111 # implementation-specific 112 }, 113 stop => sub { 114 # implementation-specific 115 }, 116 status => sub { 117 # implementation-specific 118 }, 119 name => "my-service", 120 port => 1234, 121 }); 122 $service->start; 123 124=head1 DESCRIPTION 125 126Each service should provide safe C<start()>, C<stop()> and C<status()> methods. 127 128=head1 CONSTRUCTOR 129 130=over 131 132=item B<< Ubic::Service::Common->new($params) >> 133 134Construct service object. 135 136Possible parameters: 137 138=over 139 140=item I<start> 141 142Mandatory sub reference providing service start mechanism. 143 144=item I<stop> 145 146The same for stop. 147 148=item I<status> 149 150Mandatory sub reference checking if service is alive. 151 152It should return one of C<running>, C<not running>, C<broken> values. 153 154This code will be used as safety check against double start and in watchdog checks. 155 156=item I<name> 157 158Service's name. 159 160Optional, will usually be set by upper-level multiservice. Don't set it unless you know what you're doing. 161 162=item I<user> 163 164User under which daemon will be started. Optional, default is C<root>. 165 166=item I<group> 167 168Group under which daemon will be started. Optional, default is all user groups. 169 170Value can be scalar or arrayref. 171 172=item I<port> 173 174Service's port. 175 176=back 177 178=back 179 180=head1 AUTHOR 181 182Vyacheslav Matyukhin <mmcleric@yandex-team.ru> 183 184=head1 COPYRIGHT AND LICENSE 185 186This software is copyright (c) 2015 by Yandex LLC. 187 188This is free software; you can redistribute it and/or modify it under 189the same terms as the Perl 5 programming language system itself. 190 191=cut 192