#! /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
