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.60';
3 23     23   86 use strict;
  23         18  
  23         486  
4 23     23   59 use warnings;
  23         24  
  23         473  
5              
6             # ABSTRACT: multiservice which uses directory with configs to instantiate services
7              
8 23     23   60 use parent qw(Ubic::Multiservice);
  23         18  
  23         98  
9 23     23   951 use Params::Validate qw(:all);
  23         24  
  23         2805  
10 23     23   94 use Carp;
  23         24  
  23         886  
11 23     23   120 use File::Basename;
  23         16  
  23         1271  
12 23     23   79 use Scalar::Util qw(blessed);
  23         15  
  23         727  
13 23     23   5430 use Ubic::ServiceLoader;
  23         37  
  23         16296  
14              
15             sub new {
16 19     19 1 27 my $class = shift;
17 19         120 my ($dir, @options) = validate_pos(@_, 1, 0);
18              
19 19         38 my $options = {};
20 19 100       40 if (@options) {
21 13         116 $options = validate(@options, {
22             protected => 0,
23             });
24             }
25 19         145 return bless { service_dir => $dir, %$options } => $class;
26             }
27              
28             sub has_simple_service {
29 13     13 1 21 my $self = shift;
30 13         171 my ($name) = validate_pos(@_, {type => SCALAR, regex => qr/^[\w.-]+$/});
31 13 100       149 if ($self->_name2file($name)) {
32 12         70 return 1;
33             }
34             else {
35 1         3 return;
36             }
37             }
38              
39             sub _filter_files {
40 47     47   64 my $self = shift;
41 47         72 my @files = @_;
42              
43 47         52 my @filtered;
44 47         88 for my $name (@files) {
45             # list of taboo extensions is stolen from logrotate(8)
46 59 50       261 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         122 return @filtered;
66             }
67              
68             sub _name2file {
69 44     44   46 my $self = shift;
70 44         54 my ($name) = @_;
71              
72 44         123 my $base = "$self->{service_dir}/$name";
73 44         1907 my @files = glob "$base.*";
74 44 100       562 unshift @files, $base if -e $base;
75              
76 44         411 @files = $self->_filter_files(@files);
77              
78 44 100       102 unless (@files) {
79 3         7 return;
80             }
81              
82 41 100       85 if (@files > 1) {
83 1         2 for my $file (@files[1 .. $#files]) {
84 1         21 warn "Ignoring duplicate service config '$file', using '$files[0]' instead";
85             }
86             }
87 41         106 return shift @files;
88             }
89              
90             sub simple_service {
91 31     31 1 40 my $self = shift;
92 31         307 my ($name) = validate_pos(@_, {type => SCALAR, regex => qr/^[\w.-]+$/});
93              
94 31         298 my $file = $self->_name2file($name);
95 31 100       70 unless (defined $file) {
96 2         306 croak "Service '$name' not found";
97             }
98              
99 29 100       235 if (-d $file) {
100             # directory => multiservice
101 6         23 my $service = Ubic::Multiservice::Dir->new($file);
102 6         16 $service->name($name);
103 6         15 return $service;
104             }
105              
106 23         164 my $service = Ubic::ServiceLoader->load($file);
107 23         104 $service->name($name);
108 23         83 return $service;
109             }
110              
111             sub service_names {
112 3     3 1 282 my $self = shift;
113              
114 3         3 my %names;
115              
116 3         248 my @files = glob("$self->{service_dir}/*");
117 3         12 @files = $self->_filter_files(@files);
118 3         9 for my $file (@files) {
119 17 50 66     171 next unless -f $file or -d $file;
120 17         336 my $name = basename($file);
121              
122 17         42 my ($service_name, $ext) = Ubic::ServiceLoader->split_service_filename($name);
123 17 50       25 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         35 $names{ $service_name }++;
129             }
130 3         39 return sort keys %names;
131             }
132              
133             sub multiop {
134 2     2 1 381 my $self = shift;
135 2 100       22 $self->{protected} ? 'protected' : 'allowed';
136             }
137              
138              
139             1;
140              
141             __END__