1package Ubic::Multiservice::Dir; 2{ 3 $Ubic::Multiservice::Dir::VERSION = '1.58'; 4} 5 6use strict; 7use warnings; 8 9# ABSTRACT: multiservice which uses directory with configs to instantiate services 10 11use parent qw(Ubic::Multiservice); 12use Params::Validate qw(:all); 13use Carp; 14use File::Basename; 15use Scalar::Util qw(blessed); 16use Ubic::ServiceLoader; 17 18sub new { 19 my $class = shift; 20 my ($dir, @options) = validate_pos(@_, 1, 0); 21 22 my $options = {}; 23 if (@options) { 24 $options = validate(@options, { 25 protected => 0, 26 }); 27 } 28 return bless { service_dir => $dir, %$options } => $class; 29} 30 31sub has_simple_service { 32 my $self = shift; 33 my ($name) = validate_pos(@_, {type => SCALAR, regex => qr/^[\w.-]+$/}); 34 if ($self->_name2file($name)) { 35 return 1; 36 } 37 else { 38 return; 39 } 40} 41 42sub _filter_files { 43 my $self = shift; 44 my @files = @_; 45 46 my @filtered; 47 for my $name (@files) { 48 # list of taboo extensions is stolen from logrotate(8) 49 if ($name =~ /( 50 \.rpmorig | 51 \.rpmsave | 52 ,v | 53 \.swp | 54 \.rpmnew | 55 ~ | 56 \.cfsaved | 57 \.rhn-cfg-tmp-.* | 58 \.dpkg-dist | 59 \.dpkg-old | 60 \.dpkg-new | 61 \.disabled 62 )$/x 63 ) { 64 next; # skip silently 65 } 66 push @filtered, $name; 67 } 68 return @filtered; 69} 70 71sub _name2file { 72 my $self = shift; 73 my ($name) = @_; 74 75 my $base = "$self->{service_dir}/$name"; 76 my @files = glob "$base.*"; 77 unshift @files, $base if -e $base; 78 79 @files = $self->_filter_files(@files); 80 81 unless (@files) { 82 return; 83 } 84 85 if (@files > 1) { 86 for my $file (@files[1 .. $#files]) { 87 warn "Ignoring duplicate service config '$file', using '$files[0]' instead"; 88 } 89 } 90 return shift @files; 91} 92 93sub simple_service { 94 my $self = shift; 95 my ($name) = validate_pos(@_, {type => SCALAR, regex => qr/^[\w.-]+$/}); 96 97 my $file = $self->_name2file($name); 98 unless (defined $file) { 99 croak "Service '$name' not found"; 100 } 101 102 if (-d $file) { 103 # directory => multiservice 104 my $service = Ubic::Multiservice::Dir->new($file); 105 $service->name($name); 106 return $service; 107 } 108 109 my $service = Ubic::ServiceLoader->load($file); 110 $service->name($name); 111 return $service; 112} 113 114sub service_names { 115 my $self = shift; 116 117 my %names; 118 119 my @files = glob("$self->{service_dir}/*"); 120 @files = $self->_filter_files(@files); 121 for my $file (@files) { 122 next unless -f $file or -d $file; 123 my $name = basename($file); 124 125 my ($service_name, $ext) = Ubic::ServiceLoader->split_service_filename($name); 126 unless (defined $service_name) { 127 warn "Invalid file $file - only alphanumerics, underscores and hyphens are allowed\n"; 128 next; 129 } 130 131 $names{ $service_name }++; 132 } 133 return sort keys %names; 134} 135 136sub multiop { 137 my $self = shift; 138 $self->{protected} ? 'protected' : 'allowed'; 139} 140 141 1421; 143 144__END__ 145 146=pod 147 148=head1 NAME 149 150Ubic::Multiservice::Dir - multiservice which uses directory with configs to instantiate services 151 152=head1 VERSION 153 154version 1.58 155 156=head1 METHODS 157 158=over 159 160=item B<< new($dir) >> 161 162Constructor. 163 164=back 165 166=head1 SEE ALSO 167 168L<Ubic::Multiservice> - base interface of this class. 169 170L<Ubic> - main ubic module uses this class as root namespace of services. 171 172=head1 AUTHOR 173 174Vyacheslav Matyukhin <mmcleric@yandex-team.ru> 175 176=head1 COPYRIGHT AND LICENSE 177 178This software is copyright (c) 2015 by Yandex LLC. 179 180This is free software; you can redistribute it and/or modify it under 181the same terms as the Perl 5 programming language system itself. 182 183=cut 184