#! /usr/bin/perl

use 5.010;
use strict;
use warnings;
use autodie qw(:all);
use Getopt::Long;
use Fuse;
use POSIX qw(setpgid :errno_h);
use IO::Uncompress::Gunzip qw(gunzip $GunzipError);
use Pod::Usage;
use Hash::Util qw(lock_keys);
use File::Temp;
use DB_File;
use File::Basename;

my %o = (
    debug => undef,
    detach => 1,
    tmp => undef,
); lock_keys %o;

use constant ME => basename $0;
my ($DATA, $IDX);

sub tie_vars;

MAIN: {

    GetOptions(
	"d|debug!" => \$o{debug},
	"detach!" => \$o{detach},
	"tmp:s" =>  sub { $o{tmp} = length  $_[1] ? $_[1] : $ENV{TMP}// "/tmp" },
	"h|help" => sub { pod2usage(-verbose => 1, -exit => 0) },
	"m|man" =>  sub { pod2usage(-verbose => 2, -exit => 0,
		-noperlpod => system("perldoc -V 1>/dev/null 2>&1")) },
	) and @ARGV == 2 or pod2usage;

    my ($src, $mp) = @ARGV;

    $DATA = "$src/data";
    $IDX = "$src/idx";

    die ME.": $DATA: $!" if not -d $DATA;
    die ME.": $IDX: $!" if not -d $IDX;

    if (!$o{debug} and $o{detach}) {
	fork() and exit;
	$0 = "FUSE $src $mp";
	open(STDOUT => ">/dev/null");
	open(STDIN => "/dev/null");

	setpgid($$ => $$);
    }

    tie_vars $o{tmp};

    Fuse::main(mountpoint => $mp,
	debug => $o{debug} // 0,
	getattr => \&getattr,
	getdir => \&getdir,
	open => \&openfile,
	read => \&readbuffer,
	write => \&writebuffer,
	);

    exit;

}

# not the fuse functions

{
    my (%IMAGE, %DIRTY);

sub tie_vars {
    return if not defined $_[0];
    my $file = -d $_[0] ? File::Temp->new(DIR => shift, TEMPLATE => "tmp.fuse.XXXXXX")->filename : shift;
    tie %DIRTY, "DB_File" => $file
	or die "Can't tie to $file: $!\n";
}

sub getattr {
    my $path = $IDX . shift;
    return stat $path if -d $path;
    my @attr = stat $path or return -(ENOENT);
    my %meta = _get_meta($path);
    $attr[7] = $meta{devsize};
    $attr[9] = $meta{timestamp};
    $attr[2] &= ~0222;		# r/o
    return @attr;
}

sub getdir {
    my $path = $IDX . shift;
    opendir(my $dh, $path) or return 0;
    return (readdir($dh), 0);
}

sub openfile {
    my $path = $IDX . shift;
    return 0 if exists $IMAGE{$path};
    $IMAGE{$path}{meta} = { _get_meta($path) };
    $IMAGE{$path}{blocklist} = {};

    # skip the file header
    open(my $fh => $path);
    {   local $/ = ""; scalar <$fh> }

    # should check for the format
    # $IMAGE{$path}{meta}{format}

    # now read the block list
    while (<$fh>) {
	/^#/ and last;
	my ($block, $cs, $file) = split;
	$IMAGE{$path}{blocklist}{$block} = $file;
    }
    close $fh;
    return 0;
}

sub readbuffer {
    my $path = $IDX . shift;
    my ($size, $offset) = @_;
    my $finfo = $IMAGE{$path} or die "File $path is not opened!";
    return "" if $offset >= $finfo->{meta}{devsize};

    my $buffer = "";
    for (my $need = $size; $need > 0; $need = $size - length($buffer)) {
	$buffer .= _readblock($finfo, $need, $offset + length($buffer));
    }

    return $buffer;
}

sub _readblock {
    my ($finfo, $size, $offset) = @_;

    my $block = int($offset / $finfo->{meta}{blocksize});
    my $blockoffset = $offset % $finfo->{meta}{blocksize};

    my $length = $finfo->{meta}{blocksize} - $blockoffset;
    $length = $size if $size <= $length;

    if (exists $DIRTY{$finfo.$block}) {
	return substr $DIRTY{$finfo.$block}, $blockoffset, $length;
    }

    my $fn = "$DATA/" . $finfo->{blocklist}{$block};
    if (-e $fn) {
	    open(my $fh => $fn);
	    binmode($fh);
	    seek($fh => $blockoffset, 0) or die "seek: $!";
	    local $/ = \$length;
	    return scalar <$fh>;
    }
    elsif (-e "$fn.gz") {
	    open(my $fh => "$fn.gz");
	    binmode($fh);
	    my $buffer;
	    gunzip($fh => \$buffer)
		    or die $GunzipError;
	    close($fh);
	    return substr($buffer, $blockoffset, $size);
    }
    
    die "$fn: $!\n";
}

sub writebuffer {
    my $path = $IDX . shift;
    my ($buffer, $offset) = @_;
    my $size = length($buffer);
    my $finfo = $IMAGE{$path} or die "File $path is not opened!";

    for (my $written = 0; $written < $size;) {
	 # OPTIMIZE: we should not ask for writing more than the
	 # blocksize
	 my $n = _writeblock($finfo, substr($buffer, $written), $offset + $written) 
	    or return $written;
	 $written += $n;
    }
    return $size;
}

sub _writeblock {
    my ($finfo, $buffer, $offset) = @_;
    my $size = length($buffer);

    my $block = int($offset / $finfo->{meta}{blocksize});
    my $blockoffset = $offset % $finfo->{meta}{blocksize};

    if (not exists $DIRTY{$finfo.$block}) {
	$DIRTY{$finfo.$block} = _readblock(
		$finfo, 
		$finfo->{meta}{blocksize}, 
		$block * $finfo->{meta}{blocksize});
    }

    my $length = $finfo->{meta}{blocksize} - $blockoffset;
    $length = $size if $size < $length;

    substr($DIRTY{$finfo.$block}, $blockoffset, $length)
	= substr($buffer, 0, $length);

    return $length;
}

sub _get_meta {
    my $path = shift;
    my %meta;
    open(my $fh => $path);
    while(<$fh>) {
	last if /^$/;
	/^(?<k>\S+):\s+(?<v>.*?)\s*$/ and do { $meta{$+{k}} = $+{v}; next; };
    }
    return %meta;
}

}


__END__

=head1 NAME

    fuse-imager - the fuse mount helper for imagers backups

=head1 SYNOPSIS

    fuse-imager [options] {src} {mount point}

=head1 DESCRIPTION

B<fuse-imager> mounts the src directory (containing F<data/> and F<idx/>
directories) the the specified mount point.

=head1 OPTIONS

=over 4

=item B<--tmp> [I<dir/>]

Write dirty blocks into a buffer file in the specified tmp directory.
If no directory is specified, the system default (usually F</tmp>) will
be used. (default: no temp file)

B<Beware>: The temporary file may get B<HUUGE>.

=item B<-d>|B<--debug>

Enables debugging output from B<Fuse>. When using this option,
B<Fuse> does not detach from the terminal. (default: off)

=item B<-->I<[no]>B<detach> 

Detach or don't detach from the terminal. (default: detach)

=item B<-h>|B<--help>

=item B<-m>|B<--man>

The common help and man options.

=back

=cut
