a lot of changes (0.03 API):
[Fuse-DBI] / DBI.pm
1 #!/usr/bin/perl
2
3 package Fuse::DBI;
4
5 use 5.008;
6 use strict;
7 use warnings;
8
9 use POSIX qw(ENOENT EISDIR EINVAL ENOSYS O_RDWR);
10 use Fuse;
11 use DBI;
12 use Carp;
13 use Data::Dumper;
14
15
16 our $VERSION = '0.03';
17
18 =head1 NAME
19
20 Fuse::DBI - mount your database as filesystem and use it
21
22 =head1 SYNOPSIS
23
24   use Fuse::DBI;
25   Fuse::DBI->mount( ... );
26
27 See L<run> below for examples how to set parametars.
28
29 =head1 DESCRIPTION
30
31 This module will use L<Fuse> module, part of C<FUSE (Filesystem in USErspace)>
32 available at L<http://sourceforge.net/projects/avf> to mount
33 your database as file system.
34
35 That will give you posibility to use normal file-system tools (cat, grep, vi)
36 to manipulate data in database.
37
38 It's actually opposite of Oracle's intention to put everything into database.
39
40
41 =head1 METHODS
42
43 =cut
44
45 =head2 mount
46
47 Mount your database as filesystem.
48
49   my $mnt = Fuse::DBI->mount({
50         filenames => 'select name from files_table as filenames',
51         read => 'sql read',
52         update => 'sql update',
53         dsn => 'DBI:Pg:dbname=webgui',
54         user => 'database_user',
55         password => 'database_password'
56   });
57
58 =cut
59
60 my $dbh;
61 my $sth;
62 my $ctime_start;
63
64 sub read_filenames;
65 sub fuse_module_loaded;
66
67 sub mount {
68         my $class = shift;
69         my $self = {};
70         bless($self, $class);
71
72         my $arg = shift;
73
74         print Dumper($arg);
75
76         carp "mount needs 'dsn' to connect to (e.g. dsn => 'DBI:Pg:dbname=test')" unless ($arg->{'dsn'});
77         carp "mount needs 'mount' as mountpoint" unless ($arg->{'mount'});
78
79         # save (some) arguments in self
80         $self->{$_} = $arg->{$_} foreach (qw(mount));
81
82         foreach (qw(filenames read update)) {
83                 carp "mount needs '$_' SQL" unless ($arg->{$_});
84         }
85
86         $ctime_start = time();
87
88         if ($arg->{'fork'}) {
89                 my $pid = fork();
90                 die "fork() failed: $!" unless defined $pid;
91                 # child will return to caller
92                 if ($pid) {
93                         $self ? return $self : return undef;
94                 }
95         }
96
97         $dbh = DBI->connect($arg->{'dsn'},$arg->{'user'},$arg->{'password'}, {AutoCommit => 0, RaiseError => 1}) || die $DBI::errstr;
98
99         $sth->{filenames} = $dbh->prepare($arg->{'filenames'}) || die $dbh->errstr();
100
101         $sth->{'read'} = $dbh->prepare($arg->{'read'}) || die $dbh->errstr();
102         $sth->{'update'} = $dbh->prepare($arg->{'update'}) || die $dbh->errstr();
103
104         $self->read_filenames;
105
106         my $mount = Fuse::main(
107                 mountpoint=>$arg->{'mount'},
108                 getattr=>\&e_getattr,
109                 getdir=>\&e_getdir,
110                 open=>\&e_open,
111                 statfs=>\&e_statfs,
112                 read=>\&e_read,
113                 write=>\&e_write,
114                 utime=>\&e_utime,
115                 truncate=>\&e_truncate,
116                 unlink=>\&e_unlink,
117                 debug=>0,
118         );
119
120         if (! $mount) {
121                 warn "mount on ",$arg->{'mount'}," failed!\n";
122                 return undef;
123         }
124 };
125
126 =head2 umount
127
128 Unmount your database as filesystem.
129
130   $mnt->umount;
131
132 This will also kill background process which is translating
133 database to filesystem.
134
135 =cut
136
137 sub umount {
138         my $self = shift;
139
140         system "fusermount -u ".$self->{'mount'} || croak "umount error: $!";
141
142         return 1;
143 }
144
145 =head2 fuse_module_loaded
146
147 Checks if C<fuse> module is loaded in kernel.
148
149   die "no fuse module loaded in kernel"
150         unless (Fuse::DBI::fuse_module_loaded);
151
152 This function in called by L<mount>, but might be useful alone also.
153
154 =cut
155
156 sub fuse_module_loaded {
157         my $lsmod = `lsmod`;
158         die "can't start lsmod: $!" unless ($lsmod);
159         if ($lsmod =~ m/fuse/s) {
160                 return 1;
161         } else {
162                 return 0;
163         }
164 }
165
166 my %files;
167 my %dirs;
168
169 sub read_filenames {
170         my $self = shift;
171
172         # create empty filesystem
173         (%files) = (
174                 '.' => {
175                         type => 0040,
176                         mode => 0755,
177                 },
178         #       a => {
179         #               cont => "File 'a'.\n",
180         #               type => 0100,
181         #               ctime => time()-2000
182         #       },
183         );
184
185         # fetch new filename list from database
186         $sth->{'filenames'}->execute() || die $sth->{'filenames'}->errstr();
187
188         # read them in with sesible defaults
189         while (my $row = $sth->{'filenames'}->fetchrow_hashref() ) {
190                 $files{$row->{'filename'}} = {
191                         size => $row->{'size'},
192                         mode => $row->{'writable'} ? 0644 : 0444,
193                         id => $row->{'id'} || 99,
194                 };
195
196                 my $d;
197                 foreach (split(m!/!, $row->{'filename'})) {
198                         # first, entry is assumed to be file
199                         if ($d) {
200                                 $files{$d} = {
201                                                 size => $dirs{$d}++,
202                                                 mode => 0755,
203                                                 type => 0040
204                                 };
205                                 $files{$d.'/.'} = {
206                                                 mode => 0755,
207                                                 type => 0040
208                                 };
209                                 $files{$d.'/..'} = {
210                                                 mode => 0755,
211                                                 type => 0040
212                                 };
213                         }
214                         $d .= "/" if ($d);
215                         $d .= "$_";
216                 }
217         }
218
219         print "found ",scalar(keys %files)-scalar(keys %dirs)," files, ",scalar(keys %dirs), " dirs\n";
220 }
221
222
223 sub filename_fixup {
224         my ($file) = shift;
225         $file =~ s,^/,,;
226         $file = '.' unless length($file);
227         return $file;
228 }
229
230 sub e_getattr {
231         my ($file) = filename_fixup(shift);
232         $file =~ s,^/,,;
233         $file = '.' unless length($file);
234         return -ENOENT() unless exists($files{$file});
235         my ($size) = $files{$file}{size} || 1;
236         my ($dev, $ino, $rdev, $blocks, $gid, $uid, $nlink, $blksize) = (0,0,0,1,0,0,1,1024);
237         my ($atime, $ctime, $mtime);
238         $atime = $ctime = $mtime = $files{$file}{ctime} || $ctime_start;
239
240         my ($modes) = (($files{$file}{type} || 0100)<<9) + $files{$file}{mode};
241
242         # 2 possible types of return values:
243         #return -ENOENT(); # or any other error you care to
244         #print(join(",",($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks)),"\n");
245         return ($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks);
246 }
247
248 sub e_getdir {
249         my ($dirname) = shift;
250         $dirname =~ s!^/!!;
251         # return as many text filenames as you like, followed by the retval.
252         print((scalar keys %files)." files total\n");
253         my %out;
254         foreach my $f (sort keys %files) {
255                 if ($dirname) {
256                         if ($f =~ s/^\E$dirname\Q\///) {
257                                 $out{$f}++ if ($f =~ /^[^\/]+$/);
258                         }
259                 } else {
260                         $out{$f}++ if ($f =~ /^[^\/]+$/);
261                 }
262         }
263         if (! %out) {
264                 $out{'no files? bug?'}++;
265         }
266         print scalar keys %out," files in dir '$dirname'\n";
267         print "## ",join(" ",keys %out),"\n";
268         return (keys %out),0;
269 }
270
271 sub read_content {
272         my ($file,$id) = @_;
273
274         die "read_content needs file and id" unless ($file && $id);
275
276         $sth->{'read'}->execute($id) || die $sth->{'read'}->errstr;
277         $files{$file}{cont} = $sth->{'read'}->fetchrow_array;
278         print "file '$file' content [",length($files{$file}{cont})," bytes] read in cache\n";
279 }
280
281
282 sub e_open {
283         # VFS sanity check; it keeps all the necessary state, not much to do here.
284         my $file = filename_fixup(shift);
285         my $flags = shift;
286
287         return -ENOENT() unless exists($files{$file});
288         return -EISDIR() unless exists($files{$file}{id});
289
290         read_content($file,$files{$file}{id}) unless exists($files{$file}{cont});
291
292         print "open '$file' ",length($files{$file}{cont})," bytes\n";
293         return 0;
294 }
295
296 sub e_read {
297         # return an error numeric, or binary/text string.
298         # (note: 0 means EOF, "0" will give a byte (ascii "0")
299         # to the reading program)
300         my ($file) = filename_fixup(shift);
301         my ($buf_len,$off) = @_;
302
303         return -ENOENT() unless exists($files{$file});
304
305         my $len = length($files{$file}{cont});
306
307         print "read '$file' [$len bytes] offset $off length $buf_len\n";
308
309         return -EINVAL() if ($off > $len);
310         return 0 if ($off == $len);
311
312         $buf_len = $len-$off if ($len - $off < $buf_len);
313
314         return substr($files{$file}{cont},$off,$buf_len);
315 }
316
317 sub clear_cont {
318         print "transaction rollback\n";
319         $dbh->rollback || die $dbh->errstr;
320         print "invalidate all cached content\n";
321         foreach my $f (keys %files) {
322                 delete $files{$f}{cont};
323         }
324         print "begin new transaction\n";
325         #$dbh->begin_work || die $dbh->errstr;
326 }
327
328
329 sub update_db {
330         my $file = shift || die;
331
332         $files{$file}{ctime} = time();
333
334         my ($cont,$id) = (
335                 $files{$file}{cont},
336                 $files{$file}{id}
337         );
338
339         if (!$sth->{'update'}->execute($cont,$id)) {
340                 print "update problem: ",$sth->{'update'}->errstr;
341                 clear_cont;
342                 return 0;
343         } else {
344                 if (! $dbh->commit) {
345                         print "ERROR: commit problem: ",$sth->{'update'}->errstr;
346                         clear_cont;
347                         return 0;
348                 }
349                 print "updated '$file' [",$files{$file}{id},"]\n";
350         }
351         return 1;
352 }
353
354 sub e_write {
355         my $file = filename_fixup(shift);
356         my ($buffer,$off) = @_;
357
358         return -ENOENT() unless exists($files{$file});
359
360         my $cont = $files{$file}{cont};
361         my $len = length($cont);
362
363         print "write '$file' [$len bytes] offset $off length ",length($buffer),"\n";
364
365         $files{$file}{cont} = "";
366
367         $files{$file}{cont} .= substr($cont,0,$off) if ($off > 0);
368         $files{$file}{cont} .= $buffer;
369         $files{$file}{cont} .= substr($cont,$off+length($buffer),$len-$off-length($buffer)) if ($off+length($buffer) < $len);
370
371         $files{$file}{size} = length($files{$file}{cont});
372
373         if (! update_db($file)) {
374                 return -ENOSYS();
375         } else {
376                 return length($buffer);
377         }
378 }
379
380 sub e_truncate {
381         my $file = filename_fixup(shift);
382         my $size = shift;
383
384         print "truncate to $size\n";
385
386         $files{$file}{cont} = substr($files{$file}{cont},0,$size);
387         $files{$file}{size} = $size;
388         return 0
389 };
390
391
392 sub e_utime {
393         my ($atime,$mtime,$file) = @_;
394         $file = filename_fixup($file);
395
396         return -ENOENT() unless exists($files{$file});
397
398         print "utime '$file' $atime $mtime\n";
399
400         $files{$file}{time} = $mtime;
401         return 0;
402 }
403
404 sub e_statfs { return 255, 1, 1, 1, 1, 2 }
405
406 sub e_unlink {
407         my $file = filename_fixup(shift);
408
409         return -ENOENT() unless exists($files{$file});
410
411         print "unlink '$file' will invalidate cache\n";
412
413         read_content($file,$files{$file}{id});
414
415         return 0;
416 }
417 1;
418 __END__
419
420 =head1 EXPORT
421
422 Nothing.
423
424 =head1 SEE ALSO
425
426 C<FUSE (Filesystem in USErspace)> website
427 L<http://sourceforge.net/projects/avf>
428
429 =head1 AUTHOR
430
431 Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
432
433 =head1 COPYRIGHT AND LICENSE
434
435 Copyright (C) 2004 by Dobrica Pavlinusic
436
437 This library is free software; you can redistribute it and/or modify
438 it under the same terms as Perl itself, either Perl version 5.8.4 or,
439 at your option, any later version of Perl 5 you may have available.
440
441
442 =cut
443