File Coverage

lib/Ubic/Multiservice/Dir.pm
Criterion Covered Total %
statement 79 82 96.3
branch 19 22 86.3
condition 2 3 66.6
subroutine 15 15 100.0
pod 5 5 100.0
total 120 127 94.4


line stmt bran cond sub pod time code
1             package Ubic::Multiservice::Dir;
2             $Ubic::Multiservice::Dir::VERSION = '1.59';
3 23     23   89 use strict;
  23         26  
  23         550  
4 23     23   72 use warnings;
  23         24  
  23         549  
5              
6             # ABSTRACT: multiservice which uses directory with configs to instantiate services
7              
8 23     23   73 use parent qw(Ubic::Multiservice);
  23         29  
  23         117  
9 23     23   968 use Params::Validate qw(:all);
  23         33  
  23         3359  
10 23     23   99 use Carp;
  23         29  
  23         1041  
11 23     23   118 use File::Basename;
  23         41  
  23         1422  
12 23     23   88 use Scalar::Util qw(blessed);
  23         25  
  23         830  
13 23     23   6145 use Ubic::ServiceLoader;
  23         36  
  23         18267  
14              
15             sub new {
16 19     19 1 32 my $class = shift;
17 19         125 my ($dir, @options) = validate_pos(@_, 1, 0);
18              
19 19         47 my $options = {};
20 19 100       78 if (@options) {
21 13         112 $options = validate(@options, {
22             protected => 0,
23             });
24             }
25 19         170 return bless { service_dir => $dir, %$options } => $class;
26             }
27              
28             sub has_simple_service {
29 13     13 1 18 my $self = shift;
30 13         224 my ($name) = validate_pos(@_, {type => SCALAR, regex => qr/^[\w.-]+$/});
31 13 100       167 if ($self->_name2file($name)) {
32 12         74 return 1;
33             }
34             else {
35 1         4 return;
36             }
37             }
38              
39             sub _filter_files {
40 47     47   66 my $self = shift;
41 47         104 my @files = @_;
42              
43 47         77 my @filtered;
44 47         105 for my $name (@files) {
45             # list of taboo extensions is stolen from logrotate(8)
46 59 50       288 if ($name =~ /(
47             \.rpmorig |
48             \.rpmsave |
49             ,v |
50             \.swp |
51             \.rpmnew |
52             ~ |
53             \.cfsaved |
54             \.rhn-cfg-tmp-.* |
55             \.dpkg-dist |
56             \.dpkg-old |
57             \.dpkg-new |
58             \.disabled
59             )$/x
60             ) {
61 0         0 next; # skip silently
62             }
63 59         103 push @filtered, $name;
64             }
65 47         130 return @filtered;
66             }
67              
68             sub _name2file {
69 44     44   69 my $self = shift;
70 44         67 my ($name) = @_;
71              
72 44         119 my $base = "$self->{service_dir}/$name";
73 44         2075 my @files = glob "$base.*";
74 44 100       585 unshift @files, $base if -e $base;
75              
76 44         152 @files = $self->_filter_files(@files);
77              
78 44 100       110 unless (@files) {
79 3         10 return;
80             }
81              
82 41 100       108 if (@files > 1) {
83 1         4 for my $file (@files[1 .. $#files]) {
84 1         28 warn "Ignoring duplicate service config '$file', using '$files[0]' instead";
85             }
86             }
87 41         114 return shift @files;
88             }
89              
90             sub simple_service {
91 31     31 1 47 my $self = shift;
92 31         383 my ($name) = validate_pos(@_, {type => SCALAR, regex => qr/^[\w.-]+$/});
93              
94 31         340 my $file = $self->_name2file($name);
95 31 100       72 unless (defined $file) {
96 2         454 croak "Service '$name' not found";
97             }
98              
99 29 100       245 if (-d $file) {
100             # directory => multiservice
101 6         29 my $service = Ubic::Multiservice::Dir->new($file);
102 6         25 $service->name($name);
103 6         18 return $service;
104             }
105              
106 23         192 my $service = Ubic::ServiceLoader->load($file);
107 23         164 $service->name($name);
108 23         85 return $service;
109             }
110              
111             sub service_names {
112 3     3 1 201 my $self = shift;
113              
114 3         5 my %names;
115              
116 3         246 my @files = glob("$self->{service_dir}/*");
117 3         14 @files = $self->_filter_files(@files);
118 3         8 for my $file (@files) {
119 17 50 66     169 next unless -f $file or -d $file;
120 17         352 my $name = basename($file);
121              
122 17         42 my ($service_name, $ext) = Ubic::ServiceLoader->split_service_filename($name);
123 17 50       31 unless (defined $service_name) {
124 0         0 warn "Invalid file $file - only alphanumerics, underscores and hyphens are allowed\n";
125 0         0 next;
126             }
127              
128 17         37 $names{ $service_name }++;
129             }
130 3         41 return sort keys %names;
131             }
132              
133             sub multiop {
134 2     2 1 649 my $self = shift;
135 2 100       41 $self->{protected} ? 'protected' : 'allowed';
136             }
137              
138              
139             1;
140              
141             __END__