# HG changeset patch
# User Heiko Schlittermann (JUMPER) <hs@schlittermann.de>
# Date 1311801969 -7200
# Node ID 28392c81e90966589b177ba0b6aca71084bcae9d
# Parent  d2562d0417a9f6f2ccf8f27120b53538beba86d9# Parent  a4f1369eaa6ee1075a5884e1190de813c5e81a19
merged from branch moose

diff -r d2562d0417a9 -r 28392c81e909 lib/.perltidyrc
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/.perltidyrc	Wed Jul 27 23:26:09 2011 +0200
@@ -0,0 +1,2 @@
+--paren-tightness=2
+--square-bracket-tightness=2
diff -r d2562d0417a9 -r 28392c81e909 lib/BlockDev.pm
--- a/lib/BlockDev.pm	Wed Jul 20 22:35:03 2011 +0200
+++ b/lib/BlockDev.pm	Wed Jul 27 23:26:09 2011 +0200
@@ -1,19 +1,81 @@
 package BlockDev;
 
 use 5.010;
-use strict;
-use warnings;
-use Attribute::Params::Validate qw(:all);
+use Moose;
+use POSIX;
+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 size  {
+    my $self = shift;
+    open(my $fh => $self->path);
+    seek($fh, 0, SEEK_END);
+    return tell($fh);
+}
+
+
+1;
+__END__
+
 sub new : Validate(uuid => 0, dev => 0) : method {
     my $class = shift;
     my $self = bless \my $x => $class;
@@ -49,11 +111,6 @@
     return $X{$self}{dev} if exists $X{$self}{dev};
 }
 
-sub DESTROY {
-    my $self = shift;
-    delete $X{$self};
-}
-
 1;
 
 __END__
diff -r d2562d0417a9 -r 28392c81e909 scratch/new
--- a/scratch/new	Wed Jul 20 22:35:03 2011 +0200
+++ b/scratch/new	Wed Jul 27 23:26:09 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;
 
diff -r d2562d0417a9 -r 28392c81e909 t/00-module.t
--- a/t/00-module.t	Wed Jul 20 22:35:03 2011 +0200
+++ b/t/00-module.t	Wed Jul 27 23:26:09 2011 +0200
@@ -8,16 +8,37 @@
     use_ok "BlockDev";
 }
 
+my %part;
+{
+    open(my $pp => "/proc/partitions");
+    while (<$pp>) { chomp;
+	$. <= 2 and next;
+	my ($ma, $mi, $si, $dev) = split;
+	$part{$dev} = { major => $ma,
+			minor => $mi,
+			size => $si * 1024 };
+    }
+}
+
 my @devices = BlockDev->list();
 {   # device list
 
-    my @proc = ();
-    open(my $fh, "/proc/partitions");
-    while (<$fh>) {
-	/^\s*(\d+\s+){3}(?<dev>\S+)/ or next;
-	push @proc => $+{dev};
+    is_deeply([sort @devices] => [sort keys %part], "got all devices");
+}
+
+foreach (@devices) {
+
+    my $dev = BlockDev->new(dev => $_);
+    isa_ok($dev, "BlockDev");
+
+    ok(-b $dev->dev, "block device " . $dev->dev);
+    is($dev->major, $part{$_}{major}, "major $_");
+    is($dev->minor, $part{$_}{minor}, "minor $_");
+    SKIP: {
+	skip "need root permission" => 1 if $<;
+	is($dev->size, $part{$_}{size}, "size $part{$_}{size}");
     }
-    is_deeply(\@devices => \@proc, "got all devices");
+
 }
 
 done_testing();