File Coverage

blib/lib/Solaris/SMF.pm

Criterion	Covered	Total	%
statement	17	30	56.6
branch	0	10	0.0
condition			n/a
subroutine	6	7	85.7
pod	1	1	100.0
total	24	48	50.0

use strict;
use warnings;

package Solaris::SMF;
$Solaris::SMF::VERSION = '1.0.0';
# ABSTRACT: Manipulate Solaris 10 services from Perl

BEGIN {
    eval { require Data::Dumper; };
}
require Exporter;
our @ISA    = qw(Exporter);
our @EXPORT = qw( get_services );
use Params::Validate qw ( validate :types );
use Solaris::SMF::Service;
use Carp;

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


sub get_services {
    $debug && warn( 'get_services ' . join( ',', @_ ) );
    my %p =
        validate( @_, { wildcard => { type => SCALAR, default => '*' } } );
    local $ENV{PATH} = '/bin:/usr/bin:/sbin:/usr/sbin';
    my @service_list;
    open my $svc_list, '-|', " svcs -aH '$p{wildcard}' 2>/dev/null"
        or die 'Unable to query SMF services';
    while ( my $svc_line = <$svc_list> ) {
        $debug
            && warn($svc_line);
        my ( $state, $date, $FMRI ) = (
            $svc_line =~ m/
		^
		([^\s]+)	# Current state
		[\s]+
		([^\s]+)	# Date this state was set
		[\s]+
		( (?:svc:|lrc:) [^\s]+)	# FMRI
		\n?
		$
	/xms
        );
        $debug
            && warn(
            Data::Dumper->Dump(
                [ $state, $date, $FMRI ],
                [qw($state $date $FMRI)]
            )
            );
        if ($FMRI) {
            push( @service_list, Solaris::SMF::Service->new($FMRI) );
        }
    }
    close $svc_list;
    return @service_list;
}

1;

__END__