Added Build.PL and INSTALL text.
authorHeiko Schlittermann (JUMPER) <hs@schlittermann.de>
Sun, 07 Aug 2011 10:01:07 +0200
changeset 2 19a7554ddd6c
parent 1 ec7a3333127a
child 3 92690b23b317
Added Build.PL and INSTALL text.
.hgignore
Build.PL
INSTALL
bin/blockfuse
blockfuse
t/000-syntax.t
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/.hgignore	Sun Aug 07 10:01:07 2011 +0200
@@ -0,0 +1,3 @@
+blib
+_build
+Build
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Build.PL	Sun Aug 07 10:01:07 2011 +0200
@@ -0,0 +1,14 @@
+use strict;
+use warnings;
+use Module::Build;
+
+Module::Build->new(
+    dist_name => "blockfuse",
+    dist_author => "Heiko Schlittermann",
+    dist_version_from => "bin/blockfuse",
+    requires => {
+	perl => "5.10.0",
+	autodie => "0",
+	Fuse => "0",
+    },
+)->create_build_script();
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/INSTALL	Sun Aug 07 10:01:07 2011 +0200
@@ -0,0 +1,19 @@
+Just follow theses steps, [...] is optional.
+
+    [$ man Module::Build]
+
+     $perl Build.PL [install_base=$SOME_DIR]
+
+    [$ ./Build help]
+
+    [$ ./Build prereq_report]
+
+     $ ./Build 
+    [$ ./Build test [verbose=1]]
+
+    [$ ./Build fakeinstall]
+
+     $ ./Build install
+
+Heiko Schlittermann <hs@schlittermann.de>
+Sources from https://ssl.schlittermann.de/hg/blockfuse (hg repo).
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/bin/blockfuse	Sun Aug 07 10:01:07 2011 +0200
@@ -0,0 +1,99 @@
+#! /usr/bin/perl
+# © Heiko Schlittermann <hs@schlittermann.de>
+# source: https://ssl.schlittermann.de/hg/blockfuse (hg repo)
+#
+# RSYNC can't sync block devices to files (something like
+# rsync /dev/sda2 /images/sda2 does not work. There are
+# patches for rsync around, but I didn't like to patch
+# rsync…)
+#
+# blockfuse maps the block devices found in /dev/ to regular
+# files in your mountpoint. Currently it fakes the mtime to force
+# rsync comparing the source and destination!
+
+#   blockfuse /mnt
+#   rsync --inplace -Pa /mnt/sda1 /images/sda1
+
+# Just a short hack, not documentation, nothing else.
+# If your're insterested in extending this tool, please tell me, I'm
+# willing to put it under some Open Source License. (Currently it's
+# not!)
+
+use 5.010;
+use strict;
+use warnings;
+use POSIX;
+use autodie qw(:all);
+use Fuse;
+
+our $VERSION = "0.1";
+
+my $mountpoint = shift // die "$0: need mountpoint!\n";
+
+warn "Your're probably not running a 64bit system, the devices sizes "
+  . "will be incorrect!\n"
+  if not `uname -m` =~ /64/;
+
+fork() and exit 0;
+
+open(STDIN, "</dev/null");
+setpgid($$ => $$);
+
+Fuse::main(
+    mountpoint => $mountpoint,
+    getattr    => \&my_getattr,
+    getdir     => \&my_getdir,
+    open       => \&my_open,
+    release    => \&my_release,
+    read       => \&my_read,
+);
+exit 0;
+
+sub my_getattr {
+    my $path = "/dev" . shift;
+    my @attr = stat $path;
+    if (-b $path) {
+        $attr[9] = time;    # fake mtime
+        $attr[6] = 0;       # clear major/minor
+        $attr[2] |= 0b1000_0000_0000_0000;    # set regular file
+        $attr[2] &= 0b1001_1111_1111_1111;    # clear block device
+
+        eval {
+            open(my $fh => $path);            # size
+            seek($fh, 0, SEEK_END);
+            $attr[7] = tell($fh);
+        };
+
+    }
+    return @attr;
+}
+
+sub my_getdir {
+    my $path = "/dev" . shift;
+    opendir(my $dh => $path);
+    (grep { -e "$path/$_" and not -c _ } readdir($dh)), 0;
+}
+
+{
+    my %FD;
+
+    sub my_open {
+        my $path = "/dev" . shift;
+        eval { open($FD{$path} => $path) };
+        return $!;
+    }
+
+    sub my_release {
+        my $path = "/dev" . shift;
+        close delete $FD{$path};
+    }
+
+    sub my_read {
+        my $path = "/dev" . shift;
+        my ($size, $offset) = @_;
+        seek($FD{$path}, $offset, SEEK_SET);
+        my $_;
+        sysread($FD{$path}, $_, $size);
+        return $_;
+    }
+}
--- a/blockfuse	Wed Aug 03 23:49:55 2011 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,96 +0,0 @@
-#! /usr/bin/perl
-# © Heiko Schlittermann <hs@schlittermann.de>
-#
-# RSYNC can't sync block devices to files (something like
-# rsync /dev/sda2 /images/sda2 does not work. There are
-# patches for rsync around, but I didn't like to patch
-# rsync…)
-#
-# blockfuse maps the block devices found in /dev/ to regular
-# files in your mountpoint. Currently it fakes the mtime to force
-# rsync comparing the source and destination!
-
-#   blockfuse /mnt
-#   rsync --inplace -Pa /mnt/sda1 /images/sda1
-
-# Just a short hack, not documentation, nothing else.
-# If your're insterested in extending this tool, please tell me, I'm
-# willing to put it under some Open Source License. (Currently it's
-# not!)
-
-use 5.010;
-use strict;
-use warnings;
-use POSIX;
-use autodie qw(:all);
-use Fuse;
-
-my $mountpoint = shift // die "$0: need mountpoint!\n";
-
-warn "Your're probably not running a 64bit system, the devices sizes "
-  . "will be incorrect!\n"
-  if not `uname -m` =~ /64/;
-
-fork() and exit 0;
-
-open(STDIN, "</dev/null");
-setpgid($$ => $$);
-
-Fuse::main(
-    mountpoint => $mountpoint,
-    getattr    => \&my_getattr,
-    getdir     => \&my_getdir,
-    open       => \&my_open,
-    release    => \&my_release,
-    read       => \&my_read,
-);
-exit 0;
-
-sub my_getattr {
-    my $path = "/dev" . shift;
-    my @attr = stat $path;
-    if (-b $path) {
-        $attr[9] = time;    # fake mtime
-        $attr[6] = 0;       # clear major/minor
-        $attr[2] |= 0b1000_0000_0000_0000;    # set regular file
-        $attr[2] &= 0b1001_1111_1111_1111;    # clear block device
-
-        eval {
-            open(my $fh => $path);            # size
-            seek($fh, 0, SEEK_END);
-            $attr[7] = tell($fh);
-        };
-
-    }
-    return @attr;
-}
-
-sub my_getdir {
-    my $path = "/dev" . shift;
-    opendir(my $dh => $path);
-    (grep { -e "$path/$_" and not -c _ } readdir($dh)), 0;
-}
-
-{
-    my %FD;
-
-    sub my_open {
-        my $path = "/dev" . shift;
-        eval { open($FD{$path} => $path) };
-        return $!;
-    }
-
-    sub my_release {
-        my $path = "/dev" . shift;
-        close delete $FD{$path};
-    }
-
-    sub my_read {
-        my $path = "/dev" . shift;
-        my ($size, $offset) = @_;
-        seek($FD{$path}, $offset, SEEK_SET);
-        my $_;
-        sysread($FD{$path}, $_, $size);
-        return $_;
-    }
-}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/t/000-syntax.t	Sun Aug 07 10:01:07 2011 +0200
@@ -0,0 +1,23 @@
+use 5.010;
+use strict;
+use warnings;
+use Test::More;
+use File::Find;
+use File::Temp;
+
+my @files;
+find(sub {
+    -f -x and ~/^\./ or return;
+    push @files, $File::Find::name;
+}, "blib");
+
+plan tests => scalar @files;
+
+my $tmp = File::Temp->new();
+foreach my $file (@files) {
+    system("perl -c $file 1>$tmp 2>&1");
+    is($? => 0, "syntax $file is ok")
+	or do { seek $tmp, 0, 0;
+	        diag <$tmp> };
+
+}