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


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # system::zfs Brik
5             #
6             package Metabrik::System::Zfs;
7 1     1   710 use strict;
  1         2  
  1         29  
8 1     1   5 use warnings;
  1         2  
  1         29  
9              
10 1     1   5 use base qw(Metabrik::Shell::Command Metabrik::System::Package);
  1         2  
  1         825  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             attributes => {
19             },
20             attributes_default => {
21             },
22             commands => {
23             list => [ ],
24             list_snapshots => [ ],
25             delete_snapshot => [ qw(name|name_list) ],
26             },
27             require_modules => {
28             },
29             require_binaries => {
30             zfs => [ ],
31             },
32             optional_binaries => {
33             },
34             need_packages => {
35             },
36             };
37             }
38              
39             sub list {
40 0     0 0   my $self = shift;
41              
42 0           my $cmd = "zfs list";
43 0 0         my $lines = $self->capture($cmd) or return;
44              
45             # NAME USED AVAIL REFER MOUNTPOINT
46             # zroot 1.23T 526G 96K none
47              
48 0           my $header = 0;
49 0           my @list = ();
50 0           for (@$lines) {
51 0 0         if (! $header) { # Skip first header line
52 0           $header++;
53 0           next;
54             }
55              
56 0           my @t = split(/\s+/, $_);
57              
58 0           my $name = $t[0];
59 0           my $used = $t[1];
60 0           my $avail = $t[2];
61 0           my $refer = $t[3];
62 0           my $mountpoint = $t[4];
63              
64 0           push @list, {
65             name => $name,
66             used => $used,
67             avail => $avail,
68             refer => $refer,
69             mountpoint => $mountpoint,
70             };
71             }
72              
73 0           return \@list;
74             }
75              
76             sub list_snapshots {
77 0     0 0   my $self = shift;
78              
79 0           my $cmd = "zfs list -t snapshot";
80 0 0         my $lines = $self->capture($cmd) or return;
81              
82             # NAME USED AVAIL REFER MOUNTPOINT
83             # zroot/iocage/jails/... 228K - 898M -
84              
85 0           my $header = 0;
86 0           my @list = ();
87 0           for (@$lines) {
88 0 0         if (! $header) { # Skip first header line
89 0           $header++;
90 0           next;
91             }
92              
93 0           my @t = split(/\s+/, $_);
94              
95 0           my $name = $t[0];
96 0           my $used = $t[1];
97 0           my $avail = $t[2];
98 0           my $refer = $t[3];
99 0           my $mountpoint = $t[4];
100              
101 0           my $h = {
102             name => $name,
103             used => $used,
104             avail => $avail,
105             refer => $refer,
106             mountpoint => $mountpoint,
107             };
108              
109 0           my ($tag, $snapshot) = $name =~ m{^.*/([^\@]+)\@(.+)$};
110 0 0 0       if (defined($tag) && defined($snapshot)) {
111 0           $h->{tag} = $tag;
112 0           $h->{snapshot} = $snapshot;
113             }
114              
115 0           push @list, $h;
116             }
117              
118 0           return \@list;
119             }
120              
121             sub delete_snapshot {
122 0     0 0   my $self = shift;
123 0           my ($name) = @_;
124              
125 0 0         $self->brik_help_run_undef_arg('delete_snapshot', $name) or return;
126 0 0         my $ref = $self->brik_help_run_invalid_arg('delete_snapshot', $name, 'ARRAY', 'SCALAR')
127             or return;
128              
129 0 0         if ($ref eq 'ARRAY') {
130 0           for my $this (@$name) {
131 0           $self->log->info("delete_snapshot: deleting snapshot [$name]");
132 0           $self->delete_snapshot($this);
133             }
134             }
135             else {
136 0 0         if ($name !~ m{^.+@.+$}) {
137 0           return $self->log->error("delete_snapshot: name [$name] is not a snapshot");
138             }
139              
140 0           my $cmd = "zfs destroy $name";
141 0           $self->sudo_system($cmd);
142             }
143              
144 0           return 1;
145             }
146              
147             1;
148              
149             __END__