File Coverage

blib/lib/Solaris/SMF/Service.pm

Criterion	Covered	Total	%
statement	14	104	13.4
branch	0	54	0.0
condition			n/a
subroutine	5	21	23.8
pod	13	13	100.0
total	32	192	16.6

use strict;
use warnings;

package Solaris::SMF::Service;
$Solaris::SMF::Service::VERSION = '1.0.0';
# ABSTRACT: Encapsulate Solaris 10 services in Perl

BEGIN {
    eval { require Data::Dumper; };
}

use Params::Validate qw( validate validate_pos :types );
use Carp;

my $debug = $ENV{RELEASE_TESTING} ? $ENV{RELEASE_TESTING} : 0;


sub _svcs {
    my $self = shift;
    local $ENV{PATH} = '/bin:/usr/bin:/sbin:/usr/sbin';
    open my $svc_list, '-|', " svcs -aH '$self->{FMRI}' 2>/dev/null"
        or croak 'Unable to query SMF services';
    while ( my $svc_line = <$svc_list> ) {
        my ( $state, $date, $FMRI ) = (
            $svc_line =~ m/
                ^
                ([^\s]+)        # Current state
                [\s]+
                ([^\s]+)        # Date this state was set
                [\s]+
                ( (?: svc: | lrc: ) [^\s]+ ) # FMRI
                \n?
                $
        /xms
        );
        if ($FMRI) {
            close $svc_list;
            return ( $state, $date );
        }
    }
    croak "Unable to determine status of $self->{FMRI}";
}

sub _svcprop {
    $debug && warn( '_svcprop ' . join( ',', @_ ) );
    my $self = shift;
    local $ENV{PATH} = '/bin:/usr/bin:/sbin:/usr/sbin';
    open my $svcprop_list, '-|', " svcprop '$self->{FMRI}' 2>/dev/null"
        or croak 'Unable to query SMF service properties';
    my %properties;
    while ( my $svcprop_line = <$svcprop_list> ) {
        my ( $name, $type, $value ) = (
            $svcprop_line =~ m/
                ^
                ([^\s]+)        # Property name
                [\s]+
                ([^\s]+)        # Type of property
                [\s]+
                ([^\s]*[^\n]*)        # Value of property
                $
        /xms
        );
        if ($name) {
            $properties{$name}{type}  = $type;
            $properties{$name}{value} = $value;
        }
        $debug && print STDERR Data::Dumper->Dump( [ $name, $type, $value ],
            [qw($name $type $value)] );
    }
    $debug
        && print STDERR Data::Dumper->Dump( [ \%properties ],
        [qw(%properties)] );
    return \%properties;
}

sub _svcadm {
    $debug && warn( '_svcadm ' . join( ',', @_ ) );
    my $self          = shift;
    my $svcadm_action = shift;
    local $ENV{PATH} = '/bin:/usr/bin:/sbin:/usr/sbin';
    open my $svc_adm, '-|', " svcadm $svcadm_action '$self->{FMRI}' 2>&1"
        or croak 'Unable to administer SMF services';
    close $svc_adm;
}


sub new {
    $debug && warn( 'new ' . join( ',', @_ ) );
    my $class   = shift;
    my $FMRI    = shift;
    my $service = bless {}, __PACKAGE__;
    $service->{FMRI} = $FMRI;
    return $service;
}


sub status {
    $debug && warn( 'status ' . join( ',', @_ ) );
    my $self = shift;
    my ( $status, $date ) = $self->_svcs();
    $debug
        && warn(
        Data::Dumper->Dump( [ $status, $date ], [qw($status $date)] ) );
    return $status;
}


sub FMRI {
    $debug && warn( 'FMRI ' . join( ',', @_ ) );
    my $self = shift;
    return $self->{FMRI};
}


sub properties {
    $debug && warn( 'properties ' . join( ',', @_ ) );
    my $self       = shift;
    my $properties = $self->_svcprop();
    return %{$properties};
}


sub property {
    $debug && warn( 'property ' . join( ',', @_ ) );
    my $self            = shift;
    my $p               = validate_pos( @_, { type => SCALAR } );
    my ($property_name) = @{$p};

    my $properties = $self->_svcprop();
    $debug && warn( Data::Dumper->Dump( [$properties], [qw($properties)] ) );
    if ( defined $properties->{$property_name} ) {
        return $properties->{$property_name}{value};
    }
    else {
        carp "Unable to find property '$property_name' for " . $self->{FMRI};
        undef;
    }
}


sub property_type {
    $debug && warn( 'property_type ' . join( ',', @_ ) );
    my $self            = shift;
    my $p               = validate_pos( @_, { type => SCALAR } );
    my ($property_name) = @{$p};

    my $properties = $self->_svcprop();
    $debug && warn( Data::Dumper->Dump( [$properties], [qw($properties)] ) );
    if ( defined $properties->{$property_name} ) {
        return $properties->{$property_name}{type};
    }
    else {
        carp "Unable to find property '$property_name' for " . $self->{FMRI};
        undef;
    }
}


sub disable {
    $debug && warn( 'disable ' . join( ',', @_ ) );
    my $self = shift;
    return $self->_svcadm('disable');
}


sub stop {
    $debug && warn( 'stop ' . join( ',', @_ ) );
    my $self = shift;
    return $self->_svcadm('disable -t');
}


sub enable {
    $debug && warn( 'enable ' . join( ',', @_ ) );
    my $self = shift;
    return $self->_svcadm('enable');
}


sub start {
    $debug && warn( 'start ' . join( ',', @_ ) );
    my $self = shift;
    return $self->_svcadm('enable -t');
}


sub refresh {
    $debug && warn( 'refresh ' . join( ',', @_ ) );
    my $self = shift;
    return $self->_svcadm('refresh');
}


sub clear {
    $debug && warn( 'clear ' . join( ',', @_ ) );
    my $self = shift;
    return $self->_svcadm('clear');
}


sub mark {
    $debug && warn( 'mark ' . join( ',', @_ ) );
    my $self = shift;
    return $self->_svcadm('mark');
}

1;    # End of Solaris::SMF::Service

__END__