File Coverage

blib/lib/Linux/LVM2.pm

Criterion	Covered	Total	%
statement	11	13	84.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	16	18	88.8

package Linux::LVM2;
{
  $Linux::LVM2::VERSION = '0.14';
}
BEGIN {
  $Linux::LVM2::AUTHORITY = 'cpan:TEX';
}
# ABSTRACT: a Linux LVM2 wrapper.

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;

use Carp;
use Try::Tiny;

use Linux::LVM2::VG;
use Linux::LVM2::PV;
use Linux::LVM2::LV;
use Linux::LVM2::Utils;
use Sys::FS;
use Sys::Run;

has 'vgs' => (
    'is'      => 'ro',
    'isa'     => 'HashRef[Linux::LVM2::VG]',
    'lazy'    => 1,
    'builder' => '_find_vgs',
);

has 'verbose' => (
    'is'      => 'rw',
    'isa'     => 'Bool',
    'default' => 0,
);

has 'logger' => (
    'is'       => 'ro',
    'isa'      => 'Log::Tree',
    'required' => 1,
);

has 'sys' => (
    'is'      => 'rw',
    'isa'     => 'Sys::Run',
    'lazy'    => 1,
    'builder' => '_init_sys',
);

has 'fs' => (
    'is'      => 'rw',
    'isa'     => 'Sys::FS',
    'lazy'    => 1,
    'builder' => '_init_fs',
);

sub _init_sys {
    my $self = shift;

    my $Sys = Sys::Run::->new( { 'logger' => $self->logger(), } );

    return $Sys;
}

sub _init_fs {
    my $self = shift;

    my $FS = Sys::FS::->new(
        {
            'logger' => $self->logger(),
            'sys'    => $self->sys(),
        }
    );

    return $FS;
}

sub _find_vgs {
    my $self = shift;
    my $vg_ref = shift || {};

    my %sbin = ();
    $sbin{'vgdisplay'} = '/sbin/vgdisplay';
    $sbin{'lvdisplay'} = '/sbin/lvdisplay';
    $sbin{'lvs'}       = '/sbin/lvs';
    $sbin{'pvdisplay'} = '/sbin/pvdisplay';

    foreach my $key ( keys %sbin ) {
        if ( !-x $sbin{$key} ) {
            croak( 'Binary not executeable: ' . $sbin{$key} );
        }
    }

    # read in the command output in a batch,
    # keep the disabled warnings and output redirect as contained
    # and brief as possible.
    my ( @vgdisplay, @lvdisplay, @lvs, @pvdisplay );
    {

        # redirect stderr, to get rid of those useless lvm warnings
        ## no critic (ProhibitTwoArgOpen ProhibitBarewordFileHandles ProhibitNoWarnings RequireCheckedOpen RequireBriefOpen)
        no warnings 'once';
        open( OLDSTDERR, '>&STDERR' ) unless $self->verbose();
        use warnings 'once';
        open( STDERR, '/dev/null' ) unless $self->verbose();
        ## use critic

        ## no critic (RequireCheckedClose ProhibitPunctuationVars)
        local $ENV{LANG} = q{C};
        open( my $VGS, '-|', $sbin{'vgdisplay'} . ' -c' )
          or confess('Could not execute '.$sbin{'vgdisplay'}.'! Is LVM2 installed?: '.$!."\n");
        @vgdisplay = <$VGS>;
        close($VGS);
        open( my $PVS, '-|', $sbin{'pvdisplay'} . ' -c' )
          or confess('Could not execute '.$sbin{'pvdisplay'}.'! Is LVM2 installed?: '.$!."\n");
        @pvdisplay = <$PVS>;
        close($PVS);
        open( my $LVD, '-|', $sbin{'lvdisplay'} . ' -c' )
          or confess('Could not execute '.$sbin{'lvdisplay'}.'! Is LVM2 installed?: '.$!."\n");
        @lvdisplay = <$LVD>;
        close($LVD);
        open( my $LVS, '-|', $sbin{'lvs'} . ' --separator=: --units=b' )
          or confess('Could not execute '.$sbin{'lvs'}.'! Is LVM2 installed?: '.$!."\n");
        @lvs = <$LVS>;
        close($LVS);
        ## use critic

        ## no critic (ProhibitTwoArgOpen)
        open( STDERR, '>&OLDSTDERR' ) unless $self->verbose();
        ## use critic
    }

    # Process all VGs
    foreach my $line (@vgdisplay) {
        next unless $line;
        chomp($line);
        $line =~ s/^\s+//;
        $line =~ s/\s+$//;
        next unless $line;
        my %h;
        @h{qw(name access status vgid maxlvs curlvs openlvs maxlvsize maxpvs curpvs numpvs vgsize pesize totalpe allocpe freepe uuid)} = split( /:/, $line );
        $h{'parent'} = $self;

        # if the object exists, just update it
        if ( $vg_ref->{ $h{'name'} } && $vg_ref->{ $h{'name'} }->isa('Linux::LVM2::VG') ) {

            # some attrs are read-only, just update those which are rw
            foreach my $attr ( keys %h ) {
                try {
                    $vg_ref->{ $h{'name'} }->$attr( $h{$attr} );
                };
            }
        }
        else {
            $vg_ref->{ $h{'name'} } = Linux::LVM2::VG::->new( \%h );
        }
    }

    # Process all PVs
    foreach my $line (@pvdisplay) {
        next unless $line;
        chomp($line);
        $line =~ s/^\s+//;
        $line =~ s/\s+$//;
        next unless $line;
        my %h;
        @h{qw(name vg size pesize totalpe freepe allocpe uuid)} = split( /:/, $line );
        if ( $h{'vg'} && $vg_ref->{ $h{'vg'} } && $vg_ref->{ $h{'vg'} }->isa('Linux::LVM2::VG') ) {

            if ( $vg_ref->{ $h{'vg'} }->pvs()->{ $h{'name'} } && $vg_ref->{ $h{'vg'} }->pvs()->{ $h{'name'} }->isa('Linux::LVM2::PV') ) {
                foreach my $attr ( keys %h ) {
                    try {
                        $vg_ref->{ $h{'vg'} }->pvs()->{ $h{'name'} }->$attr( $h{$attr} );
                    };
                }
            }
            else {
                $h{'vg'} = $vg_ref->{ $h{'vg'} };
                my $PV = Linux::LVM2::PV::->new( \%h );

                # no need to do anything with $PV, its constructor will attach itself
                # to the vg passed it will be reachable via the associated VG
            }
        }
        else {
            next;
        }

    }

    # Process each LV (from lvdisplay)
    foreach my $line (@lvdisplay) {
        next unless $line;
        chomp($line);
        $line =~ s/^\s+//;
        $line =~ s/\s+$//;
        next unless $line;
        my %h;
        @h{qw(name vg access status intlvnum opencount lvsize leassoc lealloc allocpol rasect majornum minornum)} = split( /:/, $line );
        $h{'name'} =~ s#^/dev/##;
        $h{'name'} =~ s#^$h{'vg'}/##;

        if ( $h{'vg'} && $vg_ref->{ $h{'vg'} } ) {
            if ( $vg_ref->{ $h{'vg'} }->lvs()->{ $h{'name'} } && $vg_ref->{ $h{'vg'} }->lvs()->{ $h{'name'} }->isa('Linux::LVM2::LV') ) {
                foreach my $attr ( keys %h ) {

                    # some attrs are read-only, just update those which are rw
                    try {
                        $vg_ref->{ $h{'vg'} }->lvs()->{ $h{'name'} }->$attr( $h{$attr} );
                    };
                }
            }
            else {
                $h{'vg'} = $vg_ref->{ $h{'vg'} };
                my $VG = Linux::LVM2::LV::->new( \%h );

                # no need to do anything with $VG, its constructor will attach itself
                # to the vg passed it will be reachable via the associated VG
            }
        }
        else {
            next;
        }
    }

    # Try to get mount points for mounted devices
    my $mounts = $self->fs()->mounts( { 'DevAsKey' => 1, } );

    # Process each LV (from LVs, provides additional information about Snapshot and Copy Progress)
    foreach my $line (@lvs) {
        next unless $line;
        next if $line =~ m/\s*LV:VG:Attr/;
        chomp($line);
        $line =~ s/^\s+//;
        $line =~ s/\s+$//;
        next unless $line;
        my %h;
        @h{qw(name vg attr lsize origin snap_pc move log copy_pc convert)} = split( /:/, $line );

        if ( $h{'vg'} && $h{'name'} && $vg_ref->{ $h{'vg'} } && $vg_ref->{ $h{'vg'} }->lvs()->{ $h{'name'} } ) {
            my $lv = $vg_ref->{ $h{'vg'} }->lvs()->{ $h{'name'} };

            # convert percent
            foreach my $key (qw(snap_pc copy_pc)) {
                $h{$key} ||= 0;
                $h{$key} = int( $h{$key} * 100 );
            }

            # set parameters
            foreach my $attr (qw(snap_pc move log copy_pc convert)) {
                try {
                    $h{$attr} ||= q{};
                    $lv->$attr( $h{$attr} );
                };
            }

            # set origin of the new LV
            if ( $h{'origin'} && $vg_ref->{ $h{'vg'} }->lvs()->{ $h{'origin'} } && $vg_ref->{ $h{'vg'} }->lvs()->{ $h{'origin'} }->isa('Linux::LVM2::LV') ) {
                $lv->origin( $vg_ref->{ $h{'vg'} }->lvs()->{ $h{'origin'} } );
            }
            elsif ( $h{'origin'} ) {
                confess("Did not find origin ($h{'origin'}) of LV $h{'name'}. This is impossible!");
            }

            # set mount point
            if ( $mounts->{ $lv->mapper_path() } ) {
                $lv->mount_point( $mounts->{ $lv->mapper_path() }{'mount_point'} );
            }
            elsif ( $mounts->{ $lv->full_path() } ) {
                $lv->mount_point( $mounts->{ $lv->full_path() }{'mount_point'} );
            }
            else {
                warn 'No mount point found for LV ' . $lv->full_path() . "\n" if $self->verbose();
            }
        }
    }

    return $vg_ref;
}

sub is_lv {
    my $self    = shift;
    my $vg_name = shift;
    my $lv_name = shift;

    foreach my $vg ( keys %{ $self->vgs() } ) {
        next if $vg_name && $vg ne $vg_name;
        if ( $self->vgs()->{$vg}->lvs()->{$lv_name} ) {
            return 1;
        }
    }
    return;
}

sub is_vg {
    my $self    = shift;
    my $vg_name = shift;

    if ( $self->vgs()->{$vg_name} ) {
        return 1;
    }
    else {
        return;
    }
}

sub lv_from_path {
    my $self = shift;
    my $path = shift;

    # find out which device $path is located
    my ( $device, $fs_type, $fs_options, $mount_point ) = $self->fs()->get_mounted_device($path);

    my $LV = $self->lv_from_dev($device);
    if ($LV) {
        $LV->fs_type($fs_type);
        $LV->fs_options($fs_options);
        $LV->mount_point($mount_point);
        return $LV;
    }
    else {
        carp "Did not find lv from given path $path\n" if $self->verbose();
    }
    return;
}

sub lv_from_dev {
    my $self = shift;
    my $dev  = shift;

    if ( $dev =~ m#/mapper/# ) {
        warn "Trying to translate dev-mapper name to lvm name $dev\n" if $self->verbose();
        $dev = Linux::LVM2::Utils::translate_lvm_name($dev);
        warn "Translated to $dev\n" if $self->verbose();
    }
    $dev =~ s#^/dev/##;
    $dev =~ s#/$##;

    my ( $vg, $lv ) = split /\//, $dev;

    if ( $vg && $lv && $self->is_lv( $vg, $lv ) ) {
        return $self->vgs()->{$vg}->lvs()->{$lv};
    }

    # no lv found
    return;
}

sub update {
    my $self = shift;
    $self->_find_vgs( $self->vgs() );
    return 1;
}

no Moose;
__PACKAGE__->meta->make_immutable;

1;

__END__

=pod

=encoding utf-8

=head1 NAME

Linux::LVM2 - a Linux LVM2 wrapper.

=head1 SYNOPSIS

    use Linux::LVM2;
    my $LVM = Linux::LVM2::->new();

=head1 DESCRIPTION

This class wraps the Linux LVM2 subsystem into handy perl classes.

=head1 ATTRIBUTES

=head2 vgs

Contains all VGs present at the last update.

=head2 verbose

When true, be more verbose.

=head2 logger

An instance of Log::Tree.

=head2 sys

An instance of Sys::Run.

=head2 fs

An instance of Sys::FS.

=head1 METHODS

=head2 _find_vgs

Detect all available VGs w/ containing PVs and contained LVs.

=head2 is_lv

Returns true if the given vg/lv is a known LV.

=head2 is_vg

Returns true if the given vg is a known VG.

=head2 lv_from_dev

Translate the given /dev/mapper/... path to a LV object.

=head2 lv_from_path

Translate the given fs path to a LV object.

=head2 update

Update the internal LVM data-structures.

=head1 NAME

Linux::LVM2 - Linux LVM2 wrapper.

=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