File Coverage

blib/lib/Linux/Virt/Plugin/LXC.pm

Criterion	Covered	Total	%
statement	19	52	36.5
branch	0	12	0.0
condition	0	4	0.0
subroutine	7	11	63.6
pod			n/a
total	26	79	32.9

package Linux::Virt::Plugin::LXC;
{
  $Linux::Virt::Plugin::LXC::VERSION = '0.15';
}
BEGIN {
  $Linux::Virt::Plugin::LXC::AUTHORITY = 'cpan:TEX';
}
# ABSTRACT: LXC (Linux Containers) plugin for Linux::Virt

use 5.010_000;
use mro 'c3';
use feature ':5.10';

use Moose;
use namespace::autoclean;

# use IO::Handle;
# use autodie;
# use MooseX::Params::Validate;

extends 'Linux::Virt::Plugin';

sub _init_priority { return 10; }

sub is_host {
    my $self = shift;
    my $opts = shift || {};

    my $cmd = '/usr/bin/lxc-checkconfig';
    return unless -x $cmd;
    return $self->sys()->run_cmd( $cmd, $opts );
} ## end sub is_host

sub is_vm {
    my $self = shift;

    # TODO can't find out, yet :(
    return;
} ## end sub is_vm

sub vms {
    my $self        = shift;
    my $vserver_ref = shift;
    my $opts        = shift || {};

    return unless -x '/usr/bin/lxc-ls';
    return unless -x '/usr/bin/lxc-info';

    local $ENV{LANG} = 'C';
    my $LXC;
    if ( !open( $LXC, '-|', '/usr/bin/lxc-ls' ) ) {
        my $msg = "Could not execute /usr/bin/lxc-ls! Is lxc installed?: $!";
        $self->logger()->log( message => $msg, level => 'warning', );
        return;
    }
    while ( my $line = <$LXC> ) {
        $line =~ s/^\s+//;
        $line =~ s/\s+$//;
        my $name = $line;
        $vserver_ref->{$name}{'virt'}{'type'} = 'lxc';

    } ## end while ( my $line = <$LXC>)
    close($LXC);

    foreach my $vs ( keys %{$vserver_ref} ) {
        next if !$vserver_ref->{$vs}{'virt'}{'type'} eq 'lxc';
        local $opts->{'CaptureOutput'} = 1;
        my $status = $self->sys()->run_cmd( '/usr/bin/lxc-info --name=' . $vs, $opts );
        if ( $status !~ m/RUNNING/ ) {
            delete( $vserver_ref->{$vs} );
        }
    } ## end foreach my $vs ( keys %{$vserver_ref...})
    return 1;
} ## end sub vms

no Moose;
__PACKAGE__->meta->make_immutable;

1;

__END__

=pod

=encoding utf-8

=head1 NAME

Linux::Virt::Plugin::LXC - LXC (Linux Containers) plugin for Linux::Virt

=head1 METHODS

=head2 is_host

Returns a true value if this is run on a LXC capable host.

=head2 is_vm

Returns a true value if this is run inside an LXC guest.

=head2 vms

Returns a list of all LXC VMs on the local host.

=head1 NAME

Linux::Virt::Plugin::LXC - LXC plugin for Linux::Virt.

=head1 AUTHOR

Dominik Schulz <[e-mail]>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2012 by Dominik Schulz.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut