1 package BlockDev; |
1 package BlockDev; |
2 |
2 |
3 use 5.010; |
3 use 5.010; |
4 use strict; |
4 use Moose; |
5 use warnings; |
5 use autodie qw(:all); |
6 use Attribute::Params::Validate qw(:all); |
6 use Cwd qw(abs_path); |
7 |
7 |
8 our $VERSION = "0.0"; |
8 our $VERSION = "0.0"; |
9 |
9 |
10 my %X; |
10 # extend the PATH with *sbin* if not there already |
|
11 foreach my $p (qw(/sbin /usr/sbin /usr/local/sbin)) { |
|
12 $p ~~ [split(/:/ => $ENV{PATH})] |
|
13 or $ENV{PATH} = "$p:$ENV{PATH}"; |
|
14 } |
|
15 |
|
16 has dev => (is => "ro", isa => "Str"); |
11 |
17 |
12 sub list { |
18 sub list { |
13 open(my $fh => "/proc/partitions"); |
19 open(my $fh => "/proc/partitions"); |
14 return map { (split)[3] } grep /^\s*\d+/ => <$fh>; |
20 return map { (split)[3] } grep /^\s*\d+/ => <$fh>; |
15 } |
21 } |
|
22 |
|
23 # process the arguments before actually calling the |
|
24 # constructor |
|
25 |
|
26 sub BUILDARGS { |
|
27 my $class = shift; |
|
28 my ($key, $value) = @_; |
|
29 |
|
30 given ($key) { |
|
31 when ("dev") { |
|
32 $value = "/dev/$value" if $value !~ /^\// and not -e $value and -b "/dev/$value"; |
|
33 -b $value or die "no blockdevice `$value'"; |
|
34 return { dev => $value }; |
|
35 } |
|
36 when ("dir") { |
|
37 -d $value or die "`$value' is not a directory"; |
|
38 `df --portability '$value'` =~ /^(?<dev>\/\S+).*?(?<mp>\S+)$/m; |
|
39 die "$value does not have a real file system" |
|
40 if not $+{dev}; |
|
41 return { dev => $+{dev} }; |
|
42 } |
|
43 when (/^m(?:ount)?p(?:oint)?$/) { |
|
44 -d $value or die "`$value` is not a directory"; |
|
45 open(my $mounts => "/proc/mounts"); |
|
46 join("" => <$mounts>) =~ /^(?<dev>\S+)\s$value\s/m |
|
47 or die "$value is not a mountpoint"; |
|
48 return { dev => $+{dev} }; |
|
49 } |
|
50 when ("uuid") { |
|
51 chomp(my $dev = `blkid -c /dev/null -U '$value'`); |
|
52 die "'$value' does not exist as UUID" if not $dev; |
|
53 return { dev => $dev } |
|
54 } |
|
55 when ("label") { |
|
56 chomp(my $dev = `blkid -c /dev/null -L '$value'`); |
|
57 die "'$value' does not exist as label" if not $dev; |
|
58 return { dev => $dev } |
|
59 } |
|
60 default { die "unknown initialization" } |
|
61 } |
|
62 } |
|
63 |
|
64 sub path { abs_path shift->dev } |
|
65 sub major { (stat shift->dev)[6] >> 8 } |
|
66 sub minor { (stat shift->dev)[6] & 0xff } |
|
67 |
|
68 sub mami { |
|
69 my $self = shift; |
|
70 return ($self->major, $self->minor) if wantarray; |
|
71 return join " " => $self->major, $self->minor; |
|
72 } |
|
73 |
|
74 1; |
|
75 __END__ |
16 |
76 |
17 sub new : Validate(uuid => 0, dev => 0) : method { |
77 sub new : Validate(uuid => 0, dev => 0) : method { |
18 my $class = shift; |
78 my $class = shift; |
19 my $self = bless \my $x => $class; |
79 my $self = bless \my $x => $class; |
20 my %arg = @_; |
80 my %arg = @_; |