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