Added Build.PL and INSTALL text.
--- /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> };
+
+}