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

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

        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) {
                        return $self;
                }
        }

        $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 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'}) {
                if (open(MTAB, "/etc/mtab")) {
                        my $mounted = 0;
                        my $mount = $self->{'mount'};
                        while(<MTAB>) {
                                $mounted = 1 if (/ $mount fuse /i);
                        }
                        close(MTAB);
                
                        if ($mounted) {
                                system "fusermount -u ".$self->{'mount'}." 2>&1 >/dev/null" || return 0;
                                return 1;
                        }

                } else {
                        warn "can't open /etc/mtab: $!";
                        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;
my %dirs;

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} = {
                                                size => $dirs{$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)-scalar(keys %dirs)," files, ",scalar(keys %dirs), " dirs\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} || 1;
        my ($dev, $ino, $rdev, $blocks, $gid, $uid, $nlink, $blksize) = (0,0,0,1,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(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 { return 255, 1, 1, 1, 1, 2 }

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