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