File Coverage

blib/lib/Metabrik/System/Zfs.pm

Criterion	Covered	Total	%
statement	9	62	14.5
branch	0	18	0.0
condition	0	3	0.0
subroutine	3	7	42.8
pod	1	4	25.0
total	13	94	13.8

#
# $Id$
#
# system::zfs Brik
#
package Metabrik::System::Zfs;
use strict;
use warnings;

use base qw(Metabrik::Shell::Command Metabrik::System::Package);

sub brik_properties {
   return {
      revision => '$Revision$',
      tags => [ qw(unstable) ],
      author => 'GomoR ',
      license => 'http://opensource.org/licenses/BSD-3-Clause',
      attributes => {
      },
      attributes_default => {
      },
      commands => {
         list => [ ],
         list_snapshots => [ ],
         delete_snapshot => [ qw(name|name_list) ],
      },
      require_modules => {
      },
      require_binaries => {
         zfs => [ ],
      },
      optional_binaries => {
      },
      need_packages => {
      },
   };
}

sub list {
   my $self = shift;

   my $cmd = "zfs list";
   my $lines = $self->capture($cmd) or return;

   # NAME                                           USED  AVAIL  REFER  MOUNTPOINT
   # zroot                                         1.23T   526G    96K  none

   my $header = 0;
   my @list = ();
   for (@$lines) {
      if (! $header) {  # Skip first header line
         $header++;
         next;
      }

      my @t = split(/\s+/, $_);

      my $name = $t[0];
      my $used = $t[1];
      my $avail = $t[2];
      my $refer = $t[3];
      my $mountpoint = $t[4];

      push @list, {
         name => $name,
         used => $used,
         avail => $avail,
         refer => $refer,
         mountpoint => $mountpoint,
      };
   }

   return \@list;
}

sub list_snapshots {
   my $self = shift;

   my $cmd = "zfs list -t snapshot";
   my $lines = $self->capture($cmd) or return;

   # NAME                                           USED  AVAIL  REFER  MOUNTPOINT
   # zroot/iocage/jails/...                         228K      -   898M  -

   my $header = 0;
   my @list = ();
   for (@$lines) {
      if (! $header) {  # Skip first header line
         $header++;
         next;
      }

      my @t = split(/\s+/, $_);

      my $name = $t[0];
      my $used = $t[1];
      my $avail = $t[2];
      my $refer = $t[3];
      my $mountpoint = $t[4];

      my $h = {
         name => $name,
         used => $used,
         avail => $avail,
         refer => $refer,
         mountpoint => $mountpoint,
      };

      my ($tag, $snapshot) = $name =~ m{^.*/([^\@]+)\@(.+)$};
      if (defined($tag) && defined($snapshot)) {
         $h->{tag} = $tag;
         $h->{snapshot} = $snapshot;
      }

      push @list, $h;
   }

   return \@list;
}

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

   $self->brik_help_run_undef_arg('delete_snapshot', $name) or return;
   my $ref = $self->brik_help_run_invalid_arg('delete_snapshot', $name, 'ARRAY', 'SCALAR')
      or return;

   if ($ref eq 'ARRAY') {
      for my $this (@$name) {
         $self->log->info("delete_snapshot: deleting snapshot [$name]");
         $self->delete_snapshot($this);
      }
   }
   else {
      if ($name !~ m{^.+@.+$}) {
         return $self->log->error("delete_snapshot: name [$name] is not a snapshot");
      }

      my $cmd = "zfs destroy $name";
      $self->sudo_system($cmd);
   }

   return 1;
}

1;

__END__