# HG changeset patch
# User Heiko Schlittermann (JUMPER) <hs@schlittermann.de>
# Date 1311194103 -7200
# Node ID d2562d0417a9f6f2ccf8f27120b53538beba86d9
# Parent  8220abbf27bb79fad37e3c909eee38a5edb07d5a
[snapshot]

diff -r 8220abbf27bb -r d2562d0417a9 lib/BlockDev.pm
--- a/lib/BlockDev.pm	Tue Jul 19 16:05:43 2011 +0200
+++ b/lib/BlockDev.pm	Wed Jul 20 22:35:03 2011 +0200
@@ -1,5 +1,90 @@
 package BlockDev;
+
+use 5.010;
 use strict;
 use warnings;
+use Attribute::Params::Validate qw(:all);
 
 our $VERSION = "0.0";
+
+my %X;
+
+sub list {
+    open(my $fh => "/proc/partitions");
+    return map { (split)[3] } grep /^\s*\d+/ => <$fh>;
+}
+
+sub new : Validate(uuid => 0, dev => 0) : method {
+    my $class = shift;
+    my $self = bless \my $x => $class;
+    my %arg = @_;
+    $X{$self} = \%arg;
+
+    if ($arg{dev}) {
+	die "ERROR device `$arg{dev}': $!\n"
+	    if not -b $arg{dev};
+	$self->_rdev_by_dev;
+    }
+
+    return $self;
+}
+
+sub major { return $X{+shift}{major} }
+sub minor { return $X{+shift}{minor} }
+
+sub _rdev_by_dev {
+    my $self = shift;
+    $X{$self}{major} = (stat $X{$self}{dev})[6] >> 8;
+    $X{$self}{minor} = (stat _)[6] & 0xFF;
+}
+
+sub rdev {
+    my $self = shift;
+    return $self->major, $self->minor if wantarray;
+    return join " " => $self->major, $self->minor;
+}
+
+sub dev {
+    my $self = shift;
+    return $X{$self}{dev} if exists $X{$self}{dev};
+}
+
+sub DESTROY {
+    my $self = shift;
+    delete $X{$self};
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+    BlockDev - library for doing various things on block devices
+
+=head1 SYNOPSIS
+
+    use BlockDev;
+
+    @devices = BlockDev->list();
+
+    $device = BlockDev->new(uuid => "02323-232-22...");
+    $device = BlockDev->new(dev => "/dev/sda1");
+
+    ($major, $minor) = $device->rdev;
+
+=head1 Static methods
+
+=over
+
+=item list()
+
+Lists all known block devices (basically listing of F</proc/partitions>)
+
+=item new()
+
+Create a new blockdev object. I<$>
+
+=back
+
+    
diff -r 8220abbf27bb -r d2562d0417a9 scratch/list
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/scratch/list	Wed Jul 20 22:35:03 2011 +0200
@@ -0,0 +1,9 @@
+#! /usr/bin/perl
+use 5.010;
+use strict;
+use warnings;
+use blib;
+use BlockDev;
+
+
+say BlockDev->list;
diff -r 8220abbf27bb -r d2562d0417a9 scratch/new
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/scratch/new	Wed Jul 20 22:35:03 2011 +0200
@@ -0,0 +1,11 @@
+#! /usr/bin/perl
+use 5.010;
+use strict;
+use warnings;
+use blib;
+use BlockDev;
+
+
+my $dev = BlockDev->new(dev => "/dev/sda1");
+say scalar $dev->rdev();
+
diff -r 8220abbf27bb -r d2562d0417a9 t/00-module.t
--- a/t/00-module.t	Tue Jul 19 16:05:43 2011 +0200
+++ b/t/00-module.t	Wed Jul 20 22:35:03 2011 +0200
@@ -1,9 +1,23 @@
+use 5.010;
 use strict;
 use warnings;
 use Test::More;
+use autodie qw(:all);
 
 BEGIN {
     use_ok "BlockDev";
 }
 
+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(\@devices => \@proc, "got all devices");
+}
+
 done_testing();