fuse_dbi/fuse-couchdb/DBI.pm

#!/usr/bin/perl

package Fuse::DBI;

use 5.008;
use strict;
use warnings;

use POSIX qw(ENOENT EISDIR EINVAL ENOSYS O_RDWR);
use Fuse;
use DBI;
use Carp;
use Data::Dumper;

our $VERSION = '0.09_1';

# block size for this filesystem
use constant BLOCK => 1024;

=head1 NAME

Fuse::DBI - mount your database as filesystem and use it

=head1 SYNOPSIS

  use Fuse::DBI;
  Fuse::DBI->mount( ... );

See C<run> below for examples how to set parameters.

=head1 DESCRIPTION

This module will use C<Fuse> module, part of C<FUSE (Filesystem in USErspace)>
available at L<http://fuse.sourceforge.net/> to mount
your database as file system.

That will give you possibility to use normal file-system tools (cat, grep, vi)
to manipulate data in database.

It's actually opposite of Oracle's intention to put everything into database.


=head1 METHODS

=cut

=head2 mount

Mount your database as filesystem.

Let's suppose that your database have table C<files> with following structure:

 id:            int
 filename:      text
 size:          int
 content:       text
 writable:      boolean

Following is example how to mount table like that to C</mnt>:

  my $mnt = Fuse::DBI->mount({
        'filenames' => 'select id,filename,size,writable from files',
        'read' => 'select content from files where id = ?',
        'update' => 'update files set content = ? where id = ?',
        'dsn' => 'DBI:Pg:dbname=test_db',
        'user' => 'database_user',
        'password' => 'database_password',
        'invalidate' => sub { ... },
  });

Options:

=over 5

=item filenames

SQL query which returns C<id> (unique id for that row), C<filename>,
C<size> and C<writable> boolean flag.

=item read

SQL query which returns only one column with content of file and has
placeholder C<?> for C<id>.

=item update

SQL query with two pace-holders, one for new content and one for C<id>.

=item dsn

C<DBI> dsn to connect to (contains database driver and name of database).

=item user

User with which to connect to database

=item password

Password for connecting to database

=item invalidate

Optional anonymous code reference which will be executed when data is updated in
database. It can be used as hook to delete cache (for example on-disk-cache)
which is created from data edited through C<Fuse::DBI>.

=item fork

Optional flag which forks after mount so that executing script will continue
running. Implementation is experimental.

=back

There is also alternative way which can generate C<read> and C<update>
queries on the fly:

  my $mnt = Fuse::DBI->mount({
        'filenames' => 'select id,filename,size,writable from files',
        'read' => sub {
                my ($path,$file) = @_;
                return( 'select content from files where id = ?', $file->{row}->{id} );
        },
        'update' => sub {
                my ($path,$file) = @_;
                return( 'update files set content = ? where id = ?', $file->{row}->{id} );
        },
        'dsn' => 'DBI:Pg:dbname=test_db',
        'user' => 'database_user',
        'password' => 'database_password',
        'invalidate' => sub { ... },
  });

=cut

my $dbh;
my $sth;
my $ctime_start;

sub read_filenames;
sub fuse_module_loaded;

# evil, evil way to solve this. It makes this module non-reentrant. But, since
# fuse calls another copy of this script for each mount anyway, this shouldn't
# be a problem.
my $fuse_self;

sub mount {
        my $class = shift;
        my $self = {};
        bless($self, $class);

        my $arg = shift;

        print Dumper($arg);

        unless ($self->fuse_module_loaded) {
                print STDERR "no fuse module loaded. Trying sudo modprobe fuse!\n";
                system "sudo modprobe fuse" || die "can't modprobe fuse using sudo!\n";
        }

        carp "mount needs 'dsn' to connect to (e.g. dsn => 'DBI:Pg:dbname=test')" unless ($arg->{'dsn'});
        carp "mount needs 'mount' as mountpoint" unless ($arg->{'mount'});

        # save (some) arguments in self
        foreach (qw(mount invalidate)) {
                $self->{$_} = $arg->{$_};
        }

        foreach (qw(filenames read update)) {
                carp "mount needs '$_' SQL" unless ($arg->{$_});
        }

        $ctime_start = time();

        my $pid;
        if ($arg->{'fork'}) {
                $pid = fork();
                die "fork() failed: $!" unless defined $pid;
                # child will return to caller
                if ($pid) {
                        my $counter = 4;
                        while ($counter && ! $self->is_mounted) {
                                select(undef, undef, undef, 0.5);
                                $counter--;
                        }
                        if ($self->is_mounted) {
                                return $self;
                        } else {
                                return undef;
                        }
                }
        }

        $dbh = DBI->connect($arg->{'dsn'},$arg->{'user'},$arg->{'password'}, {AutoCommit => 0, RaiseError => 1}) || die $DBI::errstr;

        $sth->{'filenames'} = $dbh->prepare($arg->{'filenames'}) || die $dbh->errstr();


        $self->{'sth'} = $sth;

        $self->{'read_filenames'} = sub { $self->read_filenames };
        $self->read_filenames;

        foreach my $op (qw/read update/) {
                if (ref($arg->{ $op }) ne 'CODE') {
                        $self->{ $op . '_ref' } = sub {
                                my $row = shift;
                                return ($arg->{ $op }, $row->{'id'});
                        }
                } else {
                        $self->{ $op . '_ref' } = $arg->{ $op };
                }
        }

        $fuse_self = \$self;

        Fuse::main(
                mountpoint=>$arg->{'mount'},
                getattr=>\&e_getattr,
                getdir=>\&e_getdir,
                open=>\&e_open,
                statfs=>\&e_statfs,
                read=>\&e_read,
                write=>\&e_write,
                utime=>\&e_utime,
                truncate=>\&e_truncate,
                unlink=>\&e_unlink,
                rmdir=>\&e_unlink,
                debug=>1,
        );
        
        exit(0) if ($arg->{'fork'});

        return 1;

};

=head2 is_mounted

Check if fuse filesystem is mounted

  if ($mnt->is_mounted) { ... }

=cut

sub is_mounted {
        my $self = shift;

        my $mounted = 0;
        my $mount = $self->{'mount'} || confess "can't find mount point!";
        if (open(MTAB, "/etc/mtab")) {
                while(<MTAB>) {
                        $mounted = 1 if (/ $mount fuse /i);
                }
                close(MTAB);
        } else {
                warn "can't open /etc/mtab: $!";
        }

        return $mounted;
}


=head2 umount

Unmount your database as filesystem.

  $mnt->umount;

This will also kill background process which is translating
database to filesystem.

=cut

sub umount {
        my $self = shift;

        if ($self->{'mount'} && $self->is_mounted) {
                system "( fusermount -u ".$self->{'mount'}." 2>&1 ) >/dev/null";
                if ($self->is_mounted) {
                        system "sudo umount ".$self->{'mount'} ||
                        return 0;
                }
                return 1;
        }

        return 0;
}

$SIG{'INT'} = sub {
        if ($fuse_self && $$fuse_self->umount) {
                print STDERR "umount called by SIG INT\n";
        }
};

$SIG{'QUIT'} = sub {
        if ($fuse_self && $$fuse_self->umount) {
                print STDERR "umount called by SIG QUIT\n";
        }
};

sub DESTROY {
        my $self = shift;
        if ($self->umount) {
                print STDERR "umount called by DESTROY\n";
        }
}

=head2 fuse_module_loaded

Checks if C<fuse> module is loaded in kernel.

  die "no fuse module loaded in kernel"
        unless (Fuse::DBI::fuse_module_loaded);

This function in called by C<mount>, but might be useful alone also.

=cut

sub fuse_module_loaded {
        my $lsmod = `lsmod`;
        die "can't start lsmod: $!" unless ($lsmod);
        if ($lsmod =~ m/fuse/s) {
                return 1;
        } else {
                return 0;
        }
}

my $files;

sub read_filenames {
        my $self = shift;

        my $sth = $self->{'sth'} || die "no sth argument";

        # create empty filesystem
        $files = {
                '.' => {
                        type => 0040,
                        mode => 0755,
                },
                '..' => {
                        type => 0040,
                        mode => 0755,
                },
        #       a => {
        #               cont => "File 'a'.\n",
        #               type => 0100,
        #               ctime => time()-2000
        #       },
        };

        # fetch new filename list from database
        $sth->{'filenames'}->execute() || die $sth->{'filenames'}->errstr();

        # read them in with sesible defaults
        while (my $row = $sth->{'filenames'}->fetchrow_hashref() ) {
                $row->{'filename'} ||= 'NULL-'.$row->{'id'};
                $files->{$row->{'filename'}} = {
                        size => $row->{'size'},
                        mode => $row->{'writable'} ? 0644 : 0444,
                        id => $row->{'id'} || undef,
                        row => $row,
                };


                my $d;
                foreach (split(m!/!, $row->{'filename'})) {
                        # first, entry is assumed to be file
                        if ($d) {
                                $files->{$d} = {
                                                mode => 0755,
                                                type => 0040
                                };
                                $files->{$d.'/.'} = {
                                                mode => 0755,
                                                type => 0040
                                };
                                $files->{$d.'/..'} = {
                                                mode => 0755,
                                                type => 0040
                                };
                        }
                        $d .= "/" if ($d);
                        $d .= "$_";
                }
        }

        print "found ",scalar(keys %{$files})," files\n";
}


sub filename_fixup {
        my ($file) = shift;
        $file =~ s,^/,,;
        $file = '.' unless length($file);
        return $file;
}

sub e_getattr {
        my ($file) = filename_fixup(shift);
        $file =~ s,^/,,;
        $file = '.' unless length($file);
        return -ENOENT() unless exists($files->{$file});
        my ($size) = $files->{$file}->{size} || 0;
        my ($dev, $ino, $rdev, $blocks, $gid, $uid, $nlink, $blksize) = (0,0,0,int(($size+BLOCK-1)/BLOCK),0,0,1,BLOCK);
        my ($atime, $ctime, $mtime);
        $atime = $ctime = $mtime = $files->{$file}->{ctime} || $ctime_start;

        my ($modes) = (($files->{$file}->{type} || 0100)<<9) + $files->{$file}->{mode};

        # 2 possible types of return values:
        #return -ENOENT(); # or any other error you care to
        #print "getattr($file) ",join(",",($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks)),"\n";
        return ($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks);
}

sub e_getdir {
        my ($dirname) = shift;
        $dirname =~ s!^/!!;
        # return as many text filenames as you like, followed by the retval.
        print((scalar keys %{$files})." files total\n");
        my %out;
        foreach my $f (sort keys %{$files}) {
                if ($dirname) {
                        if ($f =~ s/^\Q$dirname\E\///) {
                                $out{$f}++ if ($f =~ /^[^\/]+$/);
                        }
                } else {
                        $out{$f}++ if ($f =~ /^[^\/]+$/);
                }
        }
        if (! %out) {
                $out{'no files? bug?'}++;
        }
        print scalar keys %out," files in dir '$dirname'\n";
        print "## ",join(" ",keys %out),"\n";
        return (keys %out),0;
}

sub read_content {
        my $file = shift || die "need file";

        warn "file: $file\n", Dumper($fuse_self);

        my @args = $$fuse_self->{'read_ref'}->($files->{$file});
        my $sql = shift @args || die "need SQL for $file";

        $$fuse_self->{'read_sth'}->{$sql} ||= $$fuse_self->{sth}->prepare($sql) || die $dbh->errstr();
        my $sth = $$fuse_self->{'read_sth'}->{$sql} || die;

        $sth->execute(@args) || die $sth->errstr;
        $files->{$file}->{cont} = $sth->fetchrow_array;
        # I should modify ctime only if content in database changed
        #$files->{$file}->{ctime} = time() unless ($files->{$file}->{ctime});
        print "file '$file' content [",length($files->{$file}->{cont})," bytes] read in cache\n";
}


sub e_open {
        # VFS sanity check; it keeps all the necessary state, not much to do here.
        my $file = filename_fixup(shift);
        my $flags = shift;

        return -ENOENT() unless exists($files->{$file});
        return -EISDIR() unless exists($files->{$file}->{id});

        read_content($file,$files->{$file}->{id}) unless exists($files->{$file}->{cont});

        $files->{$file}->{cont} ||= '';
        print "open '$file' ",length($files->{$file}->{cont})," bytes\n";
        return 0;
}

sub e_read {
        # return an error numeric, or binary/text string.
        # (note: 0 means EOF, "0" will give a byte (ascii "0")
        # to the reading program)
        my ($file) = filename_fixup(shift);
        my ($buf_len,$off) = @_;

        return -ENOENT() unless exists($files->{$file});

        my $len = length($files->{$file}->{cont});

        print "read '$file' [$len bytes] offset $off length $buf_len\n";

        return -EINVAL() if ($off > $len);
        return 0 if ($off == $len);

        $buf_len = $len-$off if ($len - $off < $buf_len);

        return substr($files->{$file}->{cont},$off,$buf_len);
}

sub clear_cont {
        print "transaction rollback\n";
        $dbh->rollback || die $dbh->errstr;
        print "invalidate all cached content\n";
        foreach my $f (keys %{$files}) {
                delete $files->{$f}->{cont};
                delete $files->{$f}->{ctime};
        }
        print "begin new transaction\n";
        #$dbh->begin_work || die $dbh->errstr;
}


sub update_db {
        my $file = shift || die "need file";

        $files->{$file}->{ctime} = time();

        my ($cont,$id) = (
                $files->{$file}->{cont},
                $files->{$file}->{id}
        );

        my @args = $$fuse_self->{'update_ref'}->($files->{$file});
        my $sql = shift @args || die "need SQL for $file";

        my $sth = $$fuse_self->{'update_sth'}->{$sql}
                ||= $$fuse_self->{sth}->prepare($sql)
                || die $dbh->errstr();

        if (!$sth->execute(@args)) {
                print "update problem: ",$sth->errstr;
                clear_cont;
                return 0;
        } else {
                if (! $dbh->commit) {
                        print "ERROR: commit problem: ",$sth->errstr;
                        clear_cont;
                        return 0;
                }
                print "updated '$file' [",$files->{$file}->{id},"]\n";

                $$fuse_self->{'invalidate'}->() if (ref $$fuse_self->{'invalidate'});
        }
        return 1;
}

sub e_write {
        my $file = filename_fixup(shift);
        my ($buffer,$off) = @_;

        return -ENOENT() unless exists($files->{$file});

        my $cont = $files->{$file}->{cont};
        my $len = length($cont);

        print "write '$file' [$len bytes] offset $off length ",length($buffer),"\n";

        $files->{$file}->{cont} = "";

        $files->{$file}->{cont} .= substr($cont,0,$off) if ($off > 0);
        $files->{$file}->{cont} .= $buffer;
        $files->{$file}->{cont} .= substr($cont,$off+length($buffer),$len-$off-length($buffer)) if ($off+length($buffer) < $len);

        $files->{$file}->{size} = length($files->{$file}->{cont});

        if (! update_db($file)) {
                return -ENOSYS();
        } else {
                return length($buffer);
        }
}

sub e_truncate {
        my $file = filename_fixup(shift);
        my $size = shift;

        print "truncate to $size\n";

        $files->{$file}->{cont} = substr($files->{$file}->{cont},0,$size);
        $files->{$file}->{size} = $size;
        return 0
};


sub e_utime {
        my ($atime,$mtime,$file) = @_;
        $file = filename_fixup($file);

        return -ENOENT() unless exists($files->{$file});

        print "utime '$file' $atime $mtime\n";

        $files->{$file}->{time} = $mtime;
        return 0;
}

sub e_statfs {

        my $size = 0;
        my $inodes = 0;

        foreach my $f (keys %{$files}) {
                if ($f !~ /(^|\/)\.\.?$/) {
                        $size += $files->{$f}->{size} || 0;
                        $inodes++;
                }
                print "$inodes: $f [$size]\n";
        }

        $size = int(($size+BLOCK-1)/BLOCK);

        my @ret = (255, $inodes, 1, $size, $size-1, BLOCK);

        #print "statfs: ",join(",",@ret),"\n";

        return @ret;
}

sub e_unlink {
        my $file = filename_fixup(shift);

#       if (exists( $dirs{$file} )) {
#               print "unlink '$file' will re-read template names\n";
#               print Dumper($fuse_self);
#               $$fuse_self->{'read_filenames'}->();
#               return 0;
        if (exists( $files->{$file} )) {
                print "unlink '$file' will invalidate cache\n";
                read_content($file,$files->{$file}->{id});
                return 0;
        }

        return -ENOENT();
}
1;
__END__

=head1 EXPORT

Nothing.

=head1 BUGS

Size information (C<ls -s>) is wrong. It's a problem in upstream Fuse module
(for which I'm to blame lately), so when it gets fixes, C<Fuse::DBI> will
automagically pick it up.

=head1 SEE ALSO

C<FUSE (Filesystem in USErspace)> website
L<http://fuse.sourceforge.net/>

Example for WebGUI which comes with this distribution in
directory C<examples/webgui.pl>. It also contains a lot of documentation
about design of this module, usage and limitations.

=head1 AUTHOR

Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2004 by Dobrica Pavlinusic

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.4 or,
at your option, any later version of Perl 5 you may have available.


=cut

1	dpavlin	1	#!/usr/bin/perl
2
3	dpavlin	9	package Fuse::DBI;
4
5			use 5.008;
6			use strict;
7			use warnings;
8
9	dpavlin	7	use POSIX qw(ENOENT EISDIR EINVAL ENOSYS O_RDWR);
10	dpavlin	1	use Fuse;
11			use DBI;
12	dpavlin	11	use Carp;
13			use Data::Dumper;
14	dpavlin	1
15	dpavlin	61	our $VERSION = '0.09_1';
16	dpavlin	1
17	dpavlin	52	# block size for this filesystem
18			use constant BLOCK => 1024;
19
20	dpavlin	9	=head1 NAME
21	dpavlin	1
22	dpavlin	9	Fuse::DBI - mount your database as filesystem and use it
23	dpavlin	1
24	dpavlin	9	=head1 SYNOPSIS
25	dpavlin	6
26	dpavlin	9	use Fuse::DBI;
27	dpavlin	11	Fuse::DBI->mount( ... );
28	dpavlin	1
29	dpavlin	28	See C<run> below for examples how to set parameters.
30	dpavlin	1
31	dpavlin	9	=head1 DESCRIPTION
32	dpavlin	1
33	dpavlin	23	This module will use C<Fuse> module, part of C<FUSE (Filesystem in USErspace)>
34	dpavlin	36	available at L<http://fuse.sourceforge.net/> to mount
35	dpavlin	9	your database as file system.
36	dpavlin	1
37	dpavlin	28	That will give you possibility to use normal file-system tools (cat, grep, vi)
38	dpavlin	9	to manipulate data in database.
39	dpavlin	1
40	dpavlin	9	It's actually opposite of Oracle's intention to put everything into database.
41	dpavlin	1
42
43	dpavlin	9	=head1 METHODS
44
45			=cut
46
47	dpavlin	11	=head2 mount
48	dpavlin	9
49			Mount your database as filesystem.
50
51	dpavlin	28	Let's suppose that your database have table C<files> with following structure:
52
53			id: int
54			filename: text
55			size: int
56			content: text
57			writable: boolean
58
59			Following is example how to mount table like that to C</mnt>:
60
61	dpavlin	11	my $mnt = Fuse::DBI->mount({
62	dpavlin	28	'filenames' => 'select id,filename,size,writable from files',
63			'read' => 'select content from files where id = ?',
64			'update' => 'update files set content = ? where id = ?',
65			'dsn' => 'DBI:Pg:dbname=test_db',
66			'user' => 'database_user',
67			'password' => 'database_password',
68			'invalidate' => sub { ... },
69	dpavlin	9	});
70
71	dpavlin	28	Options:
72
73			=over 5
74
75			=item filenames
76
77			SQL query which returns C<id> (unique id for that row), C<filename>,
78			C<size> and C<writable> boolean flag.
79
80			=item read
81
82			SQL query which returns only one column with content of file and has
83			placeholder C<?> for C<id>.
84
85			=item update
86
87			SQL query with two pace-holders, one for new content and one for C<id>.
88
89			=item dsn
90
91			C<DBI> dsn to connect to (contains database driver and name of database).
92
93			=item user
94
95			User with which to connect to database
96
97			=item password
98
99			Password for connecting to database
100
101			=item invalidate
102
103			Optional anonymous code reference which will be executed when data is updated in
104			database. It can be used as hook to delete cache (for example on-disk-cache)
105			which is created from data edited through C<Fuse::DBI>.
106
107			=item fork
108
109			Optional flag which forks after mount so that executing script will continue
110			running. Implementation is experimental.
111
112			=back
113
114	dpavlin	62	There is also alternative way which can generate C<read> and C<update>
115			queries on the fly:
116
117			my $mnt = Fuse::DBI->mount({
118			'filenames' => 'select id,filename,size,writable from files',
119			'read' => sub {
120			my ($path,$file) = @_;
121			return( 'select content from files where id = ?', $file->{row}->{id} );
122			},
123			'update' => sub {
124			my ($path,$file) = @_;
125			return( 'update files set content = ? where id = ?', $file->{row}->{id} );
126			},
127			'dsn' => 'DBI:Pg:dbname=test_db',
128			'user' => 'database_user',
129			'password' => 'database_password',
130			'invalidate' => sub { ... },
131			});
132
133	dpavlin	9	=cut
134
135			my $dbh;
136			my $sth;
137			my $ctime_start;
138
139	dpavlin	11	sub read_filenames;
140	dpavlin	21	sub fuse_module_loaded;
141	dpavlin	9
142	dpavlin	24	# evil, evil way to solve this. It makes this module non-reentrant. But, since
143			# fuse calls another copy of this script for each mount anyway, this shouldn't
144			# be a problem.
145			my $fuse_self;
146
147	dpavlin	11	sub mount {
148			my $class = shift;
149			my $self = {};
150			bless($self, $class);
151	dpavlin	9
152	dpavlin	11	my $arg = shift;
153	dpavlin	9
154	dpavlin	11	print Dumper($arg);
155
156	dpavlin	51	unless ($self->fuse_module_loaded) {
157			print STDERR "no fuse module loaded. Trying sudo modprobe fuse!\n";
158			system "sudo modprobe fuse" \|\| die "can't modprobe fuse using sudo!\n";
159			}
160
161	dpavlin	11	carp "mount needs 'dsn' to connect to (e.g. dsn => 'DBI:Pg:dbname=test')" unless ($arg->{'dsn'});
162			carp "mount needs 'mount' as mountpoint" unless ($arg->{'mount'});
163
164	dpavlin	12	# save (some) arguments in self
165	dpavlin	24	foreach (qw(mount invalidate)) {
166			$self->{$_} = $arg->{$_};
167			}
168	dpavlin	12
169	dpavlin	9	foreach (qw(filenames read update)) {
170	dpavlin	11	carp "mount needs '$_' SQL" unless ($arg->{$_});
171	dpavlin	9	}
172
173	dpavlin	21	$ctime_start = time();
174	dpavlin	9
175	dpavlin	22	my $pid;
176	dpavlin	21	if ($arg->{'fork'}) {
177	dpavlin	22	$pid = fork();
178	dpavlin	21	die "fork() failed: $!" unless defined $pid;
179			# child will return to caller
180			if ($pid) {
181	dpavlin	47	my $counter = 4;
182			while ($counter && ! $self->is_mounted) {
183			select(undef, undef, undef, 0.5);
184			$counter--;
185			}
186			if ($self->is_mounted) {
187			return $self;
188			} else {
189			return undef;
190			}
191	dpavlin	21	}
192			}
193	dpavlin	9
194	dpavlin	21	$dbh = DBI->connect($arg->{'dsn'},$arg->{'user'},$arg->{'password'}, {AutoCommit => 0, RaiseError => 1}) \|\| die $DBI::errstr;
195
196	dpavlin	26	$sth->{'filenames'} = $dbh->prepare($arg->{'filenames'}) \|\| die $dbh->errstr();
197	dpavlin	9
198
199	dpavlin	26	$self->{'sth'} = $sth;
200
201			$self->{'read_filenames'} = sub { $self->read_filenames };
202	dpavlin	21	$self->read_filenames;
203	dpavlin	9
204	dpavlin	62	foreach my $op (qw/read update/) {
205			if (ref($arg->{ $op }) ne 'CODE') {
206			$self->{ $op . '_ref' } = sub {
207			my $row = shift;
208			return ($arg->{ $op }, $row->{'id'});
209			}
210			} else {
211			$self->{ $op . '_ref' } = $arg->{ $op };
212			}
213			}
214
215	dpavlin	26	$fuse_self = \$self;
216
217	dpavlin	22	Fuse::main(
218	dpavlin	21	mountpoint=>$arg->{'mount'},
219			getattr=>\&e_getattr,
220			getdir=>\&e_getdir,
221			open=>\&e_open,
222			statfs=>\&e_statfs,
223			read=>\&e_read,
224			write=>\&e_write,
225			utime=>\&e_utime,
226			truncate=>\&e_truncate,
227			unlink=>\&e_unlink,
228	dpavlin	26	rmdir=>\&e_unlink,
229	dpavlin	62	debug=>1,
230	dpavlin	21	);
231	dpavlin	26
232	dpavlin	22	exit(0) if ($arg->{'fork'});
233
234			return 1;
235
236	dpavlin	9	};
237
238	dpavlin	47	=head2 is_mounted
239
240			Check if fuse filesystem is mounted
241
242			if ($mnt->is_mounted) { ... }
243
244			=cut
245
246			sub is_mounted {
247			my $self = shift;
248
249			my $mounted = 0;
250			my $mount = $self->{'mount'} \|\| confess "can't find mount point!";
251			if (open(MTAB, "/etc/mtab")) {
252			while(<MTAB>) {
253			$mounted = 1 if (/ $mount fuse /i);
254			}
255			close(MTAB);
256			} else {
257			warn "can't open /etc/mtab: $!";
258			}
259
260			return $mounted;
261			}
262
263
264	dpavlin	11	=head2 umount
265
266			Unmount your database as filesystem.
267
268			$mnt->umount;
269
270			This will also kill background process which is translating
271			database to filesystem.
272
273			=cut
274
275			sub umount {
276			my $self = shift;
277
278	dpavlin	47	if ($self->{'mount'} && $self->is_mounted) {
279	dpavlin	53	system "( fusermount -u ".$self->{'mount'}." 2>&1 ) >/dev/null";
280			if ($self->is_mounted) {
281	dpavlin	51	system "sudo umount ".$self->{'mount'} \|\|
282			return 0;
283	dpavlin	53	}
284	dpavlin	47	return 1;
285			}
286	dpavlin	40
287	dpavlin	47	return 0;
288	dpavlin	21	}
289
290	dpavlin	26	$SIG{'INT'} = sub {
291	dpavlin	40	if ($fuse_self && $$fuse_self->umount) {
292			print STDERR "umount called by SIG INT\n";
293			}
294	dpavlin	26	};
295	dpavlin	24
296	dpavlin	40	$SIG{'QUIT'} = sub {
297			if ($fuse_self && $$fuse_self->umount) {
298			print STDERR "umount called by SIG QUIT\n";
299			}
300			};
301
302	dpavlin	24	sub DESTROY {
303			my $self = shift;
304	dpavlin	40	if ($self->umount) {
305			print STDERR "umount called by DESTROY\n";
306			}
307	dpavlin	24	}
308
309	dpavlin	21	=head2 fuse_module_loaded
310
311			Checks if C<fuse> module is loaded in kernel.
312
313			die "no fuse module loaded in kernel"
314			unless (Fuse::DBI::fuse_module_loaded);
315
316	dpavlin	28	This function in called by C<mount>, but might be useful alone also.
317	dpavlin	21
318			=cut
319
320			sub fuse_module_loaded {
321			my $lsmod = `lsmod`;
322			die "can't start lsmod: $!" unless ($lsmod);
323			if ($lsmod =~ m/fuse/s) {
324			return 1;
325	dpavlin	12	} else {
326	dpavlin	21	return 0;
327	dpavlin	12	}
328	dpavlin	11	}
329
330	dpavlin	61	my $files;
331	dpavlin	1
332	dpavlin	9	sub read_filenames {
333	dpavlin	11	my $self = shift;
334
335	dpavlin	26	my $sth = $self->{'sth'} \|\| die "no sth argument";
336
337	dpavlin	9	# create empty filesystem
338	dpavlin	61	$files = {
339	dpavlin	9	'.' => {
340			type => 0040,
341			mode => 0755,
342			},
343	dpavlin	40	'..' => {
344			type => 0040,
345			mode => 0755,
346			},
347	dpavlin	9	# a => {
348			# cont => "File 'a'.\n",
349			# type => 0100,
350			# ctime => time()-2000
351			# },
352	dpavlin	61	};
353	dpavlin	1
354	dpavlin	9	# fetch new filename list from database
355			$sth->{'filenames'}->execute() \|\| die $sth->{'filenames'}->errstr();
356
357			# read them in with sesible defaults
358			while (my $row = $sth->{'filenames'}->fetchrow_hashref() ) {
359	dpavlin	55	$row->{'filename'} \|\|= 'NULL-'.$row->{'id'};
360	dpavlin	61	$files->{$row->{'filename'}} = {
361	dpavlin	9	size => $row->{'size'},
362			mode => $row->{'writable'} ? 0644 : 0444,
363	dpavlin	62	id => $row->{'id'} \|\| undef,
364			row => $row,
365	dpavlin	9	};
366
367	dpavlin	55
368	dpavlin	9	my $d;
369			foreach (split(m!/!, $row->{'filename'})) {
370			# first, entry is assumed to be file
371			if ($d) {
372	dpavlin	61	$files->{$d} = {
373	dpavlin	9	mode => 0755,
374			type => 0040
375			};
376	dpavlin	61	$files->{$d.'/.'} = {
377	dpavlin	9	mode => 0755,
378			type => 0040
379			};
380	dpavlin	61	$files->{$d.'/..'} = {
381	dpavlin	9	mode => 0755,
382			type => 0040
383			};
384			}
385			$d .= "/" if ($d);
386			$d .= "$_";
387	dpavlin	1	}
388			}
389	dpavlin	9
390	dpavlin	61	print "found ",scalar(keys %{$files})," files\n";
391	dpavlin	1	}
392
393
394			sub filename_fixup {
395			my ($file) = shift;
396			$file =~ s,^/,,;
397			$file = '.' unless length($file);
398			return $file;
399			}
400
401			sub e_getattr {
402			my ($file) = filename_fixup(shift);
403			$file =~ s,^/,,;
404			$file = '.' unless length($file);
405	dpavlin	61	return -ENOENT() unless exists($files->{$file});
406			my ($size) = $files->{$file}->{size} \|\| 0;
407	dpavlin	52	my ($dev, $ino, $rdev, $blocks, $gid, $uid, $nlink, $blksize) = (0,0,0,int(($size+BLOCK-1)/BLOCK),0,0,1,BLOCK);
408	dpavlin	1	my ($atime, $ctime, $mtime);
409	dpavlin	61	$atime = $ctime = $mtime = $files->{$file}->{ctime} \|\| $ctime_start;
410	dpavlin	1
411	dpavlin	61	my ($modes) = (($files->{$file}->{type} \|\| 0100)<<9) + $files->{$file}->{mode};
412	dpavlin	1
413			# 2 possible types of return values:
414			#return -ENOENT(); # or any other error you care to
415	dpavlin	53	#print "getattr($file) ",join(",",($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks)),"\n";
416	dpavlin	1	return ($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks);
417			}
418
419			sub e_getdir {
420			my ($dirname) = shift;
421			$dirname =~ s!^/!!;
422			# return as many text filenames as you like, followed by the retval.
423	dpavlin	61	print((scalar keys %{$files})." files total\n");
424	dpavlin	1	my %out;
425	dpavlin	61	foreach my $f (sort keys %{$files}) {
426	dpavlin	1	if ($dirname) {
427	dpavlin	32	if ($f =~ s/^\Q$dirname\E\///) {
428	dpavlin	13	$out{$f}++ if ($f =~ /^[^\/]+$/);
429			}
430	dpavlin	1	} else {
431			$out{$f}++ if ($f =~ /^[^\/]+$/);
432			}
433			}
434			if (! %out) {
435			$out{'no files? bug?'}++;
436			}
437	dpavlin	8	print scalar keys %out," files in dir '$dirname'\n";
438	dpavlin	13	print "## ",join(" ",keys %out),"\n";
439	dpavlin	1	return (keys %out),0;
440			}
441
442	dpavlin	21	sub read_content {
443	dpavlin	62	my $file = shift \|\| die "need file";
444	dpavlin	21
445	dpavlin	62	warn "file: $file\n", Dumper($fuse_self);
446	dpavlin	21
447	dpavlin	62	my @args = $$fuse_self->{'read_ref'}->($files->{$file});
448			my $sql = shift @args \|\| die "need SQL for $file";
449
450			$$fuse_self->{'read_sth'}->{$sql} \|\|= $$fuse_self->{sth}->prepare($sql) \|\| die $dbh->errstr();
451			my $sth = $$fuse_self->{'read_sth'}->{$sql} \|\| die;
452
453			$sth->execute(@args) \|\| die $sth->errstr;
454			$files->{$file}->{cont} = $sth->fetchrow_array;
455	dpavlin	31	# I should modify ctime only if content in database changed
456	dpavlin	61	#$files->{$file}->{ctime} = time() unless ($files->{$file}->{ctime});
457			print "file '$file' content [",length($files->{$file}->{cont})," bytes] read in cache\n";
458	dpavlin	21	}
459
460
461	dpavlin	1	sub e_open {
462			# VFS sanity check; it keeps all the necessary state, not much to do here.
463	dpavlin	6	my $file = filename_fixup(shift);
464			my $flags = shift;
465
466	dpavlin	61	return -ENOENT() unless exists($files->{$file});
467			return -EISDIR() unless exists($files->{$file}->{id});
468	dpavlin	6
469	dpavlin	61	read_content($file,$files->{$file}->{id}) unless exists($files->{$file}->{cont});
470	dpavlin	21
471	dpavlin	61	$files->{$file}->{cont} \|\|= '';
472			print "open '$file' ",length($files->{$file}->{cont})," bytes\n";
473	dpavlin	1	return 0;
474			}
475
476			sub e_read {
477	dpavlin	3	# return an error numeric, or binary/text string.
478			# (note: 0 means EOF, "0" will give a byte (ascii "0")
479			# to the reading program)
480	dpavlin	1	my ($file) = filename_fixup(shift);
481	dpavlin	8	my ($buf_len,$off) = @_;
482	dpavlin	3
483	dpavlin	61	return -ENOENT() unless exists($files->{$file});
484	dpavlin	3
485	dpavlin	61	my $len = length($files->{$file}->{cont});
486	dpavlin	3
487	dpavlin	8	print "read '$file' [$len bytes] offset $off length $buf_len\n";
488	dpavlin	3
489			return -EINVAL() if ($off > $len);
490			return 0 if ($off == $len);
491
492	dpavlin	21	$buf_len = $len-$off if ($len - $off < $buf_len);
493	dpavlin	3
494	dpavlin	61	return substr($files->{$file}->{cont},$off,$buf_len);
495	dpavlin	1	}
496
497	dpavlin	6	sub clear_cont {
498	dpavlin	7	print "transaction rollback\n";
499			$dbh->rollback \|\| die $dbh->errstr;
500	dpavlin	6	print "invalidate all cached content\n";
501	dpavlin	61	foreach my $f (keys %{$files}) {
502			delete $files->{$f}->{cont};
503			delete $files->{$f}->{ctime};
504	dpavlin	6	}
505	dpavlin	7	print "begin new transaction\n";
506	dpavlin	21	#$dbh->begin_work \|\| die $dbh->errstr;
507	dpavlin	6	}
508
509
510			sub update_db {
511	dpavlin	62	my $file = shift \|\| die "need file";
512	dpavlin	6
513	dpavlin	61	$files->{$file}->{ctime} = time();
514	dpavlin	8
515	dpavlin	21	my ($cont,$id) = (
516	dpavlin	61	$files->{$file}->{cont},
517			$files->{$file}->{id}
518	dpavlin	21	);
519
520	dpavlin	62	my @args = $$fuse_self->{'update_ref'}->($files->{$file});
521			my $sql = shift @args \|\| die "need SQL for $file";
522
523			my $sth = $$fuse_self->{'update_sth'}->{$sql}
524			\|\|= $$fuse_self->{sth}->prepare($sql)
525			\|\| die $dbh->errstr();
526
527			if (!$sth->execute(@args)) {
528			print "update problem: ",$sth->errstr;
529	dpavlin	6	clear_cont;
530			return 0;
531			} else {
532	dpavlin	7	if (! $dbh->commit) {
533	dpavlin	62	print "ERROR: commit problem: ",$sth->errstr;
534	dpavlin	6	clear_cont;
535			return 0;
536			}
537	dpavlin	61	print "updated '$file' [",$files->{$file}->{id},"]\n";
538	dpavlin	24
539	dpavlin	26	$$fuse_self->{'invalidate'}->() if (ref $$fuse_self->{'invalidate'});
540	dpavlin	6	}
541			return 1;
542			}
543
544			sub e_write {
545			my $file = filename_fixup(shift);
546	dpavlin	18	my ($buffer,$off) = @_;
547	dpavlin	6
548	dpavlin	61	return -ENOENT() unless exists($files->{$file});
549	dpavlin	6
550	dpavlin	61	my $cont = $files->{$file}->{cont};
551	dpavlin	18	my $len = length($cont);
552	dpavlin	6
553	dpavlin	18	print "write '$file' [$len bytes] offset $off length ",length($buffer),"\n";
554	dpavlin	6
555	dpavlin	61	$files->{$file}->{cont} = "";
556	dpavlin	6
557	dpavlin	61	$files->{$file}->{cont} .= substr($cont,0,$off) if ($off > 0);
558			$files->{$file}->{cont} .= $buffer;
559			$files->{$file}->{cont} .= substr($cont,$off+length($buffer),$len-$off-length($buffer)) if ($off+length($buffer) < $len);
560	dpavlin	18
561	dpavlin	61	$files->{$file}->{size} = length($files->{$file}->{cont});
562	dpavlin	18
563	dpavlin	6	if (! update_db($file)) {
564			return -ENOSYS();
565			} else {
566	dpavlin	18	return length($buffer);
567	dpavlin	6	}
568			}
569
570			sub e_truncate {
571			my $file = filename_fixup(shift);
572			my $size = shift;
573
574	dpavlin	18	print "truncate to $size\n";
575
576	dpavlin	61	$files->{$file}->{cont} = substr($files->{$file}->{cont},0,$size);
577			$files->{$file}->{size} = $size;
578	dpavlin	6	return 0
579			};
580
581
582			sub e_utime {
583			my ($atime,$mtime,$file) = @_;
584			$file = filename_fixup($file);
585
586	dpavlin	61	return -ENOENT() unless exists($files->{$file});
587	dpavlin	6
588	dpavlin	8	print "utime '$file' $atime $mtime\n";
589
590	dpavlin	61	$files->{$file}->{time} = $mtime;
591	dpavlin	6	return 0;
592			}
593
594	dpavlin	51	sub e_statfs {
595	dpavlin	1
596	dpavlin	51	my $size = 0;
597			my $inodes = 0;
598
599	dpavlin	61	foreach my $f (keys %{$files}) {
600	dpavlin	51	if ($f !~ /(^\|\/)\.\.?$/) {
601	dpavlin	61	$size += $files->{$f}->{size} \|\| 0;
602	dpavlin	51	$inodes++;
603			}
604			print "$inodes: $f [$size]\n";
605			}
606
607	dpavlin	52	$size = int(($size+BLOCK-1)/BLOCK);
608	dpavlin	51
609	dpavlin	52	my @ret = (255, $inodes, 1, $size, $size-1, BLOCK);
610	dpavlin	51
611	dpavlin	53	#print "statfs: ",join(",",@ret),"\n";
612	dpavlin	51
613			return @ret;
614			}
615
616	dpavlin	21	sub e_unlink {
617			my $file = filename_fixup(shift);
618
619	dpavlin	51	# if (exists( $dirs{$file} )) {
620			# print "unlink '$file' will re-read template names\n";
621			# print Dumper($fuse_self);
622			# $$fuse_self->{'read_filenames'}->();
623			# return 0;
624	dpavlin	61	if (exists( $files->{$file} )) {
625	dpavlin	26	print "unlink '$file' will invalidate cache\n";
626	dpavlin	61	read_content($file,$files->{$file}->{id});
627	dpavlin	26	return 0;
628			}
629	dpavlin	21
630	dpavlin	26	return -ENOENT();
631	dpavlin	21	}
632	dpavlin	9	1;
633			__END__
634
635			=head1 EXPORT
636
637			Nothing.
638
639	dpavlin	40	=head1 BUGS
640
641			Size information (C<ls -s>) is wrong. It's a problem in upstream Fuse module
642			(for which I'm to blame lately), so when it gets fixes, C<Fuse::DBI> will
643			automagically pick it up.
644
645	dpavlin	9	=head1 SEE ALSO
646
647			C<FUSE (Filesystem in USErspace)> website
648	dpavlin	36	L<http://fuse.sourceforge.net/>
649	dpavlin	9
650	dpavlin	28	Example for WebGUI which comes with this distribution in
651	dpavlin	30	directory C<examples/webgui.pl>. It also contains a lot of documentation
652	dpavlin	28	about design of this module, usage and limitations.
653
654	dpavlin	9	=head1 AUTHOR
655
656			Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
657
658			=head1 COPYRIGHT AND LICENSE
659
660			Copyright (C) 2004 by Dobrica Pavlinusic
661
662			This library is free software; you can redistribute it and/or modify
663			it under the same terms as Perl itself, either Perl version 5.8.4 or,
664			at your option, any later version of Perl 5 you may have available.
665
666
667			=cut
668