--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/.perltidyrc Wed Jul 27 23:07:42 2011 +0200
@@ -0,0 +1,2 @@
+--paren-tightness=2
+--square-bracket-tightness=2
--- a/lib/BlockDev.pm Wed Jul 20 22:35:03 2011 +0200
+++ b/lib/BlockDev.pm Wed Jul 27 23:07:42 2011 +0200
@@ -1,19 +1,79 @@
package BlockDev;
use 5.010;
-use strict;
-use warnings;
-use Attribute::Params::Validate qw(:all);
+use Moose;
+use autodie qw(:all);
+use Cwd qw(abs_path);
our $VERSION = "0.0";
-my %X;
+# extend the PATH with *sbin* if not there already
+foreach my $p (qw(/sbin /usr/sbin /usr/local/sbin)) {
+ $p ~~ [split(/:/ => $ENV{PATH})]
+ or $ENV{PATH} = "$p:$ENV{PATH}";
+}
+
+has dev => (is => "ro", isa => "Str");
sub list {
open(my $fh => "/proc/partitions");
return map { (split)[3] } grep /^\s*\d+/ => <$fh>;
}
+# process the arguments before actually calling the
+# constructor
+
+sub BUILDARGS {
+ my $class = shift;
+ my ($key, $value) = @_;
+
+ given ($key) {
+ when ("dev") {
+ $value = "/dev/$value" if $value !~ /^\// and not -e $value and -b "/dev/$value";
+ -b $value or die "no blockdevice `$value'";
+ return { dev => $value };
+ }
+ when ("dir") {
+ -d $value or die "`$value' is not a directory";
+ `df --portability '$value'` =~ /^(?<dev>\/\S+).*?(?<mp>\S+)$/m;
+ die "$value does not have a real file system"
+ if not $+{dev};
+ return { dev => $+{dev} };
+ }
+ when (/^m(?:ount)?p(?:oint)?$/) {
+ -d $value or die "`$value` is not a directory";
+ open(my $mounts => "/proc/mounts");
+ join("" => <$mounts>) =~ /^(?<dev>\S+)\s$value\s/m
+ or die "$value is not a mountpoint";
+ return { dev => $+{dev} };
+ }
+ when ("uuid") {
+ chomp(my $dev = `blkid -c /dev/null -U '$value'`);
+ die "'$value' does not exist as UUID" if not $dev;
+ return { dev => $dev }
+ }
+ when ("label") {
+ chomp(my $dev = `blkid -c /dev/null -L '$value'`);
+ die "'$value' does not exist as label" if not $dev;
+ return { dev => $dev }
+ }
+ default { die "unknown initialization" }
+ }
+}
+
+sub path { abs_path shift->dev }
+sub major { (stat shift->dev)[6] >> 8 }
+sub minor { (stat shift->dev)[6] & 0xff }
+
+sub mami {
+ my $self = shift;
+ return ($self->major, $self->minor) if wantarray;
+ return join " " => $self->major, $self->minor;
+}
+
+1;
+__END__
+
sub new : Validate(uuid => 0, dev => 0) : method {
my $class = shift;
my $self = bless \my $x => $class;
@@ -49,11 +109,6 @@
return $X{$self}{dev} if exists $X{$self}{dev};
}
-sub DESTROY {
- my $self = shift;
- delete $X{$self};
-}
-
1;
__END__
--- a/scratch/new Wed Jul 20 22:35:03 2011 +0200
+++ b/scratch/new Wed Jul 27 23:07:42 2011 +0200
@@ -6,6 +6,10 @@
use BlockDev;
-my $dev = BlockDev->new(dev => "/dev/sda1");
-say scalar $dev->rdev();
+my $dev = BlockDev->new(@ARGV);
+say $dev->major;
+say $dev->minor;
+#say $dev->mami;
+say $dev->dev;
+say $dev->path;
--- a/t/00-module.t Wed Jul 20 22:35:03 2011 +0200
+++ b/t/00-module.t Wed Jul 27 23:07:42 2011 +0200
@@ -20,4 +20,10 @@
is_deeply(\@devices => \@proc, "got all devices");
}
+foreach (@devices) {
+ my $dev = BlockDev->new(dev => $_);
+ isa_ok($dev, "BlockDev");
+ ok(-b $dev->dev, "block device " . $dev->dev);
+}
+
done_testing();