fuse_dbi/trunk/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

=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();

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


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

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

        $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=>0,
        );
        
        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'} || 99,
                };


                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,$id) = @_;

        die "read_content needs file and id" unless ($file && $id);

        $sth->{'read'}->execute($id) || die $sth->{'read'}->errstr;
        $files->{$file}->{cont} = $sth->{'read'}->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;

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

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

        if (!$sth->{'update'}->execute($cont,$id)) {
                print "update problem: ",$sth->{'update'}->errstr;
                clear_cont;
                return 0;
        } else {
                if (! $dbh->commit) {
                        print "ERROR: commit problem: ",$sth->{'update'}->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	9	=cut
115
116			my $dbh;
117			my $sth;
118			my $ctime_start;
119
120	dpavlin	11	sub read_filenames;
121	dpavlin	21	sub fuse_module_loaded;
122	dpavlin	9
123	dpavlin	24	# evil, evil way to solve this. It makes this module non-reentrant. But, since
124			# fuse calls another copy of this script for each mount anyway, this shouldn't
125			# be a problem.
126			my $fuse_self;
127
128	dpavlin	11	sub mount {
129			my $class = shift;
130			my $self = {};
131			bless($self, $class);
132	dpavlin	9
133	dpavlin	11	my $arg = shift;
134	dpavlin	9
135	dpavlin	11	print Dumper($arg);
136
137	dpavlin	51	unless ($self->fuse_module_loaded) {
138			print STDERR "no fuse module loaded. Trying sudo modprobe fuse!\n";
139			system "sudo modprobe fuse" \|\| die "can't modprobe fuse using sudo!\n";
140			}
141
142	dpavlin	11	carp "mount needs 'dsn' to connect to (e.g. dsn => 'DBI:Pg:dbname=test')" unless ($arg->{'dsn'});
143			carp "mount needs 'mount' as mountpoint" unless ($arg->{'mount'});
144
145	dpavlin	12	# save (some) arguments in self
146	dpavlin	24	foreach (qw(mount invalidate)) {
147			$self->{$_} = $arg->{$_};
148			}
149	dpavlin	12
150	dpavlin	9	foreach (qw(filenames read update)) {
151	dpavlin	11	carp "mount needs '$_' SQL" unless ($arg->{$_});
152	dpavlin	9	}
153
154	dpavlin	21	$ctime_start = time();
155	dpavlin	9
156	dpavlin	22	my $pid;
157	dpavlin	21	if ($arg->{'fork'}) {
158	dpavlin	22	$pid = fork();
159	dpavlin	21	die "fork() failed: $!" unless defined $pid;
160			# child will return to caller
161			if ($pid) {
162	dpavlin	47	my $counter = 4;
163			while ($counter && ! $self->is_mounted) {
164			select(undef, undef, undef, 0.5);
165			$counter--;
166			}
167			if ($self->is_mounted) {
168			return $self;
169			} else {
170			return undef;
171			}
172	dpavlin	21	}
173			}
174	dpavlin	9
175	dpavlin	21	$dbh = DBI->connect($arg->{'dsn'},$arg->{'user'},$arg->{'password'}, {AutoCommit => 0, RaiseError => 1}) \|\| die $DBI::errstr;
176
177	dpavlin	26	$sth->{'filenames'} = $dbh->prepare($arg->{'filenames'}) \|\| die $dbh->errstr();
178	dpavlin	9
179			$sth->{'read'} = $dbh->prepare($arg->{'read'}) \|\| die $dbh->errstr();
180			$sth->{'update'} = $dbh->prepare($arg->{'update'}) \|\| die $dbh->errstr();
181
182	dpavlin	26
183			$self->{'sth'} = $sth;
184
185			$self->{'read_filenames'} = sub { $self->read_filenames };
186	dpavlin	21	$self->read_filenames;
187	dpavlin	9
188	dpavlin	26	$fuse_self = \$self;
189
190	dpavlin	22	Fuse::main(
191	dpavlin	21	mountpoint=>$arg->{'mount'},
192			getattr=>\&e_getattr,
193			getdir=>\&e_getdir,
194			open=>\&e_open,
195			statfs=>\&e_statfs,
196			read=>\&e_read,
197			write=>\&e_write,
198			utime=>\&e_utime,
199			truncate=>\&e_truncate,
200			unlink=>\&e_unlink,
201	dpavlin	26	rmdir=>\&e_unlink,
202	dpavlin	21	debug=>0,
203			);
204	dpavlin	26
205	dpavlin	22	exit(0) if ($arg->{'fork'});
206
207			return 1;
208
209	dpavlin	9	};
210
211	dpavlin	47	=head2 is_mounted
212
213			Check if fuse filesystem is mounted
214
215			if ($mnt->is_mounted) { ... }
216
217			=cut
218
219			sub is_mounted {
220			my $self = shift;
221
222			my $mounted = 0;
223			my $mount = $self->{'mount'} \|\| confess "can't find mount point!";
224			if (open(MTAB, "/etc/mtab")) {
225			while(<MTAB>) {
226			$mounted = 1 if (/ $mount fuse /i);
227			}
228			close(MTAB);
229			} else {
230			warn "can't open /etc/mtab: $!";
231			}
232
233			return $mounted;
234			}
235
236
237	dpavlin	11	=head2 umount
238
239			Unmount your database as filesystem.
240
241			$mnt->umount;
242
243			This will also kill background process which is translating
244			database to filesystem.
245
246			=cut
247
248			sub umount {
249			my $self = shift;
250
251	dpavlin	47	if ($self->{'mount'} && $self->is_mounted) {
252	dpavlin	53	system "( fusermount -u ".$self->{'mount'}." 2>&1 ) >/dev/null";
253			if ($self->is_mounted) {
254	dpavlin	51	system "sudo umount ".$self->{'mount'} \|\|
255			return 0;
256	dpavlin	53	}
257	dpavlin	47	return 1;
258			}
259	dpavlin	40
260	dpavlin	47	return 0;
261	dpavlin	21	}
262
263	dpavlin	26	$SIG{'INT'} = sub {
264	dpavlin	40	if ($fuse_self && $$fuse_self->umount) {
265			print STDERR "umount called by SIG INT\n";
266			}
267	dpavlin	26	};
268	dpavlin	24
269	dpavlin	40	$SIG{'QUIT'} = sub {
270			if ($fuse_self && $$fuse_self->umount) {
271			print STDERR "umount called by SIG QUIT\n";
272			}
273			};
274
275	dpavlin	24	sub DESTROY {
276			my $self = shift;
277	dpavlin	40	if ($self->umount) {
278			print STDERR "umount called by DESTROY\n";
279			}
280	dpavlin	24	}
281
282	dpavlin	21	=head2 fuse_module_loaded
283
284			Checks if C<fuse> module is loaded in kernel.
285
286			die "no fuse module loaded in kernel"
287			unless (Fuse::DBI::fuse_module_loaded);
288
289	dpavlin	28	This function in called by C<mount>, but might be useful alone also.
290	dpavlin	21
291			=cut
292
293			sub fuse_module_loaded {
294			my $lsmod = `lsmod`;
295			die "can't start lsmod: $!" unless ($lsmod);
296			if ($lsmod =~ m/fuse/s) {
297			return 1;
298	dpavlin	12	} else {
299	dpavlin	21	return 0;
300	dpavlin	12	}
301	dpavlin	11	}
302
303	dpavlin	61	my $files;
304	dpavlin	1
305	dpavlin	9	sub read_filenames {
306	dpavlin	11	my $self = shift;
307
308	dpavlin	26	my $sth = $self->{'sth'} \|\| die "no sth argument";
309
310	dpavlin	9	# create empty filesystem
311	dpavlin	61	$files = {
312	dpavlin	9	'.' => {
313			type => 0040,
314			mode => 0755,
315			},
316	dpavlin	40	'..' => {
317			type => 0040,
318			mode => 0755,
319			},
320	dpavlin	9	# a => {
321			# cont => "File 'a'.\n",
322			# type => 0100,
323			# ctime => time()-2000
324			# },
325	dpavlin	61	};
326	dpavlin	1
327	dpavlin	9	# fetch new filename list from database
328			$sth->{'filenames'}->execute() \|\| die $sth->{'filenames'}->errstr();
329
330			# read them in with sesible defaults
331			while (my $row = $sth->{'filenames'}->fetchrow_hashref() ) {
332	dpavlin	55	$row->{'filename'} \|\|= 'NULL-'.$row->{'id'};
333	dpavlin	61	$files->{$row->{'filename'}} = {
334	dpavlin	9	size => $row->{'size'},
335			mode => $row->{'writable'} ? 0644 : 0444,
336			id => $row->{'id'} \|\| 99,
337			};
338
339	dpavlin	55
340	dpavlin	9	my $d;
341			foreach (split(m!/!, $row->{'filename'})) {
342			# first, entry is assumed to be file
343			if ($d) {
344	dpavlin	61	$files->{$d} = {
345	dpavlin	9	mode => 0755,
346			type => 0040
347			};
348	dpavlin	61	$files->{$d.'/.'} = {
349	dpavlin	9	mode => 0755,
350			type => 0040
351			};
352	dpavlin	61	$files->{$d.'/..'} = {
353	dpavlin	9	mode => 0755,
354			type => 0040
355			};
356			}
357			$d .= "/" if ($d);
358			$d .= "$_";
359	dpavlin	1	}
360			}
361	dpavlin	9
362	dpavlin	61	print "found ",scalar(keys %{$files})," files\n";
363	dpavlin	1	}
364
365
366			sub filename_fixup {
367			my ($file) = shift;
368			$file =~ s,^/,,;
369			$file = '.' unless length($file);
370			return $file;
371			}
372
373			sub e_getattr {
374			my ($file) = filename_fixup(shift);
375			$file =~ s,^/,,;
376			$file = '.' unless length($file);
377	dpavlin	61	return -ENOENT() unless exists($files->{$file});
378			my ($size) = $files->{$file}->{size} \|\| 0;
379	dpavlin	52	my ($dev, $ino, $rdev, $blocks, $gid, $uid, $nlink, $blksize) = (0,0,0,int(($size+BLOCK-1)/BLOCK),0,0,1,BLOCK);
380	dpavlin	1	my ($atime, $ctime, $mtime);
381	dpavlin	61	$atime = $ctime = $mtime = $files->{$file}->{ctime} \|\| $ctime_start;
382	dpavlin	1
383	dpavlin	61	my ($modes) = (($files->{$file}->{type} \|\| 0100)<<9) + $files->{$file}->{mode};
384	dpavlin	1
385			# 2 possible types of return values:
386			#return -ENOENT(); # or any other error you care to
387	dpavlin	53	#print "getattr($file) ",join(",",($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks)),"\n";
388	dpavlin	1	return ($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks);
389			}
390
391			sub e_getdir {
392			my ($dirname) = shift;
393			$dirname =~ s!^/!!;
394			# return as many text filenames as you like, followed by the retval.
395	dpavlin	61	print((scalar keys %{$files})." files total\n");
396	dpavlin	1	my %out;
397	dpavlin	61	foreach my $f (sort keys %{$files}) {
398	dpavlin	1	if ($dirname) {
399	dpavlin	32	if ($f =~ s/^\Q$dirname\E\///) {
400	dpavlin	13	$out{$f}++ if ($f =~ /^[^\/]+$/);
401			}
402	dpavlin	1	} else {
403			$out{$f}++ if ($f =~ /^[^\/]+$/);
404			}
405			}
406			if (! %out) {
407			$out{'no files? bug?'}++;
408			}
409	dpavlin	8	print scalar keys %out," files in dir '$dirname'\n";
410	dpavlin	13	print "## ",join(" ",keys %out),"\n";
411	dpavlin	1	return (keys %out),0;
412			}
413
414	dpavlin	21	sub read_content {
415			my ($file,$id) = @_;
416
417			die "read_content needs file and id" unless ($file && $id);
418
419			$sth->{'read'}->execute($id) \|\| die $sth->{'read'}->errstr;
420	dpavlin	61	$files->{$file}->{cont} = $sth->{'read'}->fetchrow_array;
421	dpavlin	31	# I should modify ctime only if content in database changed
422	dpavlin	61	#$files->{$file}->{ctime} = time() unless ($files->{$file}->{ctime});
423			print "file '$file' content [",length($files->{$file}->{cont})," bytes] read in cache\n";
424	dpavlin	21	}
425
426
427	dpavlin	1	sub e_open {
428			# VFS sanity check; it keeps all the necessary state, not much to do here.
429	dpavlin	6	my $file = filename_fixup(shift);
430			my $flags = shift;
431
432	dpavlin	61	return -ENOENT() unless exists($files->{$file});
433			return -EISDIR() unless exists($files->{$file}->{id});
434	dpavlin	6
435	dpavlin	61	read_content($file,$files->{$file}->{id}) unless exists($files->{$file}->{cont});
436	dpavlin	21
437	dpavlin	61	$files->{$file}->{cont} \|\|= '';
438			print "open '$file' ",length($files->{$file}->{cont})," bytes\n";
439	dpavlin	1	return 0;
440			}
441
442			sub e_read {
443	dpavlin	3	# return an error numeric, or binary/text string.
444			# (note: 0 means EOF, "0" will give a byte (ascii "0")
445			# to the reading program)
446	dpavlin	1	my ($file) = filename_fixup(shift);
447	dpavlin	8	my ($buf_len,$off) = @_;
448	dpavlin	3
449	dpavlin	61	return -ENOENT() unless exists($files->{$file});
450	dpavlin	3
451	dpavlin	61	my $len = length($files->{$file}->{cont});
452	dpavlin	3
453	dpavlin	8	print "read '$file' [$len bytes] offset $off length $buf_len\n";
454	dpavlin	3
455			return -EINVAL() if ($off > $len);
456			return 0 if ($off == $len);
457
458	dpavlin	21	$buf_len = $len-$off if ($len - $off < $buf_len);
459	dpavlin	3
460	dpavlin	61	return substr($files->{$file}->{cont},$off,$buf_len);
461	dpavlin	1	}
462
463	dpavlin	6	sub clear_cont {
464	dpavlin	7	print "transaction rollback\n";
465			$dbh->rollback \|\| die $dbh->errstr;
466	dpavlin	6	print "invalidate all cached content\n";
467	dpavlin	61	foreach my $f (keys %{$files}) {
468			delete $files->{$f}->{cont};
469			delete $files->{$f}->{ctime};
470	dpavlin	6	}
471	dpavlin	7	print "begin new transaction\n";
472	dpavlin	21	#$dbh->begin_work \|\| die $dbh->errstr;
473	dpavlin	6	}
474
475
476			sub update_db {
477			my $file = shift \|\| die;
478
479	dpavlin	61	$files->{$file}->{ctime} = time();
480	dpavlin	8
481	dpavlin	21	my ($cont,$id) = (
482	dpavlin	61	$files->{$file}->{cont},
483			$files->{$file}->{id}
484	dpavlin	21	);
485
486			if (!$sth->{'update'}->execute($cont,$id)) {
487	dpavlin	9	print "update problem: ",$sth->{'update'}->errstr;
488	dpavlin	6	clear_cont;
489			return 0;
490			} else {
491	dpavlin	7	if (! $dbh->commit) {
492	dpavlin	9	print "ERROR: commit problem: ",$sth->{'update'}->errstr;
493	dpavlin	6	clear_cont;
494			return 0;
495			}
496	dpavlin	61	print "updated '$file' [",$files->{$file}->{id},"]\n";
497	dpavlin	24
498	dpavlin	26	$$fuse_self->{'invalidate'}->() if (ref $$fuse_self->{'invalidate'});
499	dpavlin	6	}
500			return 1;
501			}
502
503			sub e_write {
504			my $file = filename_fixup(shift);
505	dpavlin	18	my ($buffer,$off) = @_;
506	dpavlin	6
507	dpavlin	61	return -ENOENT() unless exists($files->{$file});
508	dpavlin	6
509	dpavlin	61	my $cont = $files->{$file}->{cont};
510	dpavlin	18	my $len = length($cont);
511	dpavlin	6
512	dpavlin	18	print "write '$file' [$len bytes] offset $off length ",length($buffer),"\n";
513	dpavlin	6
514	dpavlin	61	$files->{$file}->{cont} = "";
515	dpavlin	6
516	dpavlin	61	$files->{$file}->{cont} .= substr($cont,0,$off) if ($off > 0);
517			$files->{$file}->{cont} .= $buffer;
518			$files->{$file}->{cont} .= substr($cont,$off+length($buffer),$len-$off-length($buffer)) if ($off+length($buffer) < $len);
519	dpavlin	18
520	dpavlin	61	$files->{$file}->{size} = length($files->{$file}->{cont});
521	dpavlin	18
522	dpavlin	6	if (! update_db($file)) {
523			return -ENOSYS();
524			} else {
525	dpavlin	18	return length($buffer);
526	dpavlin	6	}
527			}
528
529			sub e_truncate {
530			my $file = filename_fixup(shift);
531			my $size = shift;
532
533	dpavlin	18	print "truncate to $size\n";
534
535	dpavlin	61	$files->{$file}->{cont} = substr($files->{$file}->{cont},0,$size);
536			$files->{$file}->{size} = $size;
537	dpavlin	6	return 0
538			};
539
540
541			sub e_utime {
542			my ($atime,$mtime,$file) = @_;
543			$file = filename_fixup($file);
544
545	dpavlin	61	return -ENOENT() unless exists($files->{$file});
546	dpavlin	6
547	dpavlin	8	print "utime '$file' $atime $mtime\n";
548
549	dpavlin	61	$files->{$file}->{time} = $mtime;
550	dpavlin	6	return 0;
551			}
552
553	dpavlin	51	sub e_statfs {
554	dpavlin	1
555	dpavlin	51	my $size = 0;
556			my $inodes = 0;
557
558	dpavlin	61	foreach my $f (keys %{$files}) {
559	dpavlin	51	if ($f !~ /(^\|\/)\.\.?$/) {
560	dpavlin	61	$size += $files->{$f}->{size} \|\| 0;
561	dpavlin	51	$inodes++;
562			}
563			print "$inodes: $f [$size]\n";
564			}
565
566	dpavlin	52	$size = int(($size+BLOCK-1)/BLOCK);
567	dpavlin	51
568	dpavlin	52	my @ret = (255, $inodes, 1, $size, $size-1, BLOCK);
569	dpavlin	51
570	dpavlin	53	#print "statfs: ",join(",",@ret),"\n";
571	dpavlin	51
572			return @ret;
573			}
574
575	dpavlin	21	sub e_unlink {
576			my $file = filename_fixup(shift);
577
578	dpavlin	51	# if (exists( $dirs{$file} )) {
579			# print "unlink '$file' will re-read template names\n";
580			# print Dumper($fuse_self);
581			# $$fuse_self->{'read_filenames'}->();
582			# return 0;
583	dpavlin	61	if (exists( $files->{$file} )) {
584	dpavlin	26	print "unlink '$file' will invalidate cache\n";
585	dpavlin	61	read_content($file,$files->{$file}->{id});
586	dpavlin	26	return 0;
587			}
588	dpavlin	21
589	dpavlin	26	return -ENOENT();
590	dpavlin	21	}
591	dpavlin	9	1;
592			__END__
593
594			=head1 EXPORT
595
596			Nothing.
597
598	dpavlin	40	=head1 BUGS
599
600			Size information (C<ls -s>) is wrong. It's a problem in upstream Fuse module
601			(for which I'm to blame lately), so when it gets fixes, C<Fuse::DBI> will
602			automagically pick it up.
603
604	dpavlin	9	=head1 SEE ALSO
605
606			C<FUSE (Filesystem in USErspace)> website
607	dpavlin	36	L<http://fuse.sourceforge.net/>
608	dpavlin	9
609	dpavlin	28	Example for WebGUI which comes with this distribution in
610	dpavlin	30	directory C<examples/webgui.pl>. It also contains a lot of documentation
611	dpavlin	28	about design of this module, usage and limitations.
612
613	dpavlin	9	=head1 AUTHOR
614
615			Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
616
617			=head1 COPYRIGHT AND LICENSE
618
619			Copyright (C) 2004 by Dobrica Pavlinusic
620
621			This library is free software; you can redistribute it and/or modify
622			it under the same terms as Perl itself, either Perl version 5.8.4 or,
623			at your option, any later version of Perl 5 you may have available.
624
625
626			=cut
627