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.07';

=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" ||
                        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() ) {
                $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} || 1024;
        my ($dev, $ino, $rdev, $blocks, $gid, $uid, $nlink, $blksize) = (0,0,0,int(($size+1023)/1024),0,0,1,1024);
        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});

        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+1023)/1024);

        my @ret = (255, $inodes+1000, $inodes, $size, $size-10, 1024);

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