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

package Ubic::Multiservice::Dir;
$Ubic::Multiservice::Dir::VERSION = '1.58_01'; # TRIAL
use strict;
use warnings;

# ABSTRACT: multiservice which uses directory with configs to instantiate services

use parent qw(Ubic::Multiservice);
use Params::Validate qw(:all);
use Carp;
use File::Basename;
use Scalar::Util qw(blessed);
use Ubic::ServiceLoader;

sub new {
    my $class = shift;
    my ($dir, @options) = validate_pos(@_, 1, 0);

    my $options = {};
    if (@options) {
        $options = validate(@options, {
            protected => 0,
        });
    }
    return bless { service_dir => $dir, %$options } => $class;
}

sub has_simple_service {
    my $self = shift;
    my ($name) = validate_pos(@_, {type => SCALAR, regex => qr/^[\w.-]+$/});
    if ($self->_name2file($name)) {
        return 1;
    }
    else {
        return;
    }
}

sub _filter_files {
    my $self = shift;
    my @files = @_;

    my @filtered;
    for my $name (@files) {
        # list of taboo extensions is stolen from logrotate(8)
        if ($name =~ /(
                \.rpmorig   |
                \.rpmsave   |
                ,v          |
                \.swp       |
                \.rpmnew    |
                ~           |
                \.cfsaved   |
                \.rhn-cfg-tmp-.*    |
                \.dpkg-dist |
                \.dpkg-old  |
                \.dpkg-new  |
                \.disabled
            )$/x
        ) {
            next; # skip silently
        }
        push @filtered, $name;
    }
    return @filtered;
}

sub _name2file {
    my $self = shift;
    my ($name) = @_;

    my $base = "$self->{service_dir}/$name";
    my @files = glob "$base.*";
    unshift @files, $base if -e $base;

    @files = $self->_filter_files(@files);

    unless (@files) {
        return;
    }

    if (@files > 1) {
        for my $file (@files[1 .. $#files]) {
            warn "Ignoring duplicate service config '$file', using '$files[0]' instead";
        }
    }
    return shift @files;
}

sub simple_service {
    my $self = shift;
    my ($name) = validate_pos(@_, {type => SCALAR, regex => qr/^[\w.-]+$/});

    my $file = $self->_name2file($name);
    unless (defined $file) {
        croak "Service '$name' not found";
    }

    if (-d $file) {
        # directory => multiservice
        my $service = Ubic::Multiservice::Dir->new($file);
        $service->name($name);
        return $service;
    }

    my $service = Ubic::ServiceLoader->load($file);
    $service->name($name);
    return $service;
}

sub service_names {
    my $self = shift;

    my %names;

    my @files = glob("$self->{service_dir}/*");
    @files = $self->_filter_files(@files);
    for my $file (@files) {
        next unless -f $file or -d $file;
        my $name = basename($file);

        my ($service_name, $ext) = Ubic::ServiceLoader->split_service_filename($name);
        unless (defined $service_name) {
            warn "Invalid file $file - only alphanumerics, underscores and hyphens are allowed\n";
            next;
        }

        $names{ $service_name }++;
    }
    return sort keys %names;
}

sub multiop {
    my $self = shift;
    $self->{protected} ? 'protected' : 'allowed';
}


1;

__END__