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/^\E$dirname\Q\///) {
 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         $files{$file}{ctime} = time();
 368         print "file '$file' content [",length($files{$file}{cont})," bytes] read in cache\n";
 369 }
 370
 371
 372 sub e_open {
 373         # VFS sanity check; it keeps all the necessary state, not much to do here.
 374         my $file = filename_fixup(shift);
 375         my $flags = shift;
 376
 377         return -ENOENT() unless exists($files{$file});
 378         return -EISDIR() unless exists($files{$file}{id});
 379
 380         read_content($file,$files{$file}{id}) unless exists($files{$file}{cont});
 381
 382         print "open '$file' ",length($files{$file}{cont})," bytes\n";
 383         return 0;
 384 }
 385
 386 sub e_read {
 387         # return an error numeric, or binary/text string.
 388         # (note: 0 means EOF, "0" will give a byte (ascii "0")
 389         # to the reading program)
 390         my ($file) = filename_fixup(shift);
 391         my ($buf_len,$off) = @_;
 392
 393         return -ENOENT() unless exists($files{$file});
 394
 395         my $len = length($files{$file}{cont});
 396
 397         print "read '$file' [$len bytes] offset $off length $buf_len\n";
 398
 399         return -EINVAL() if ($off > $len);
 400         return 0 if ($off == $len);
 401
 402         $buf_len = $len-$off if ($len - $off < $buf_len);
 403
 404         return substr($files{$file}{cont},$off,$buf_len);
 405 }
 406
 407 sub clear_cont {
 408         print "transaction rollback\n";
 409         $dbh->rollback || die $dbh->errstr;
 410         print "invalidate all cached content\n";
 411         foreach my $f (keys %files) {
 412                 delete $files{$f}{cont};
 413         }
 414         print "begin new transaction\n";
 415         #$dbh->begin_work || die $dbh->errstr;
 416 }
 417
 418
 419 sub update_db {
 420         my $file = shift || die;
 421
 422         $files{$file}{ctime} = time();
 423
 424         my ($cont,$id) = (
 425                 $files{$file}{cont},
 426                 $files{$file}{id}
 427         );
 428
 429         if (!$sth->{'update'}->execute($cont,$id)) {
 430                 print "update problem: ",$sth->{'update'}->errstr;
 431                 clear_cont;
 432                 return 0;
 433         } else {
 434                 if (! $dbh->commit) {
 435                         print "ERROR: commit problem: ",$sth->{'update'}->errstr;
 436                         clear_cont;
 437                         return 0;
 438                 }
 439                 print "updated '$file' [",$files{$file}{id},"]\n";
 440
 441                 $$fuse_self->{'invalidate'}->() if (ref $$fuse_self->{'invalidate'});
 442         }
 443         return 1;
 444 }
 445
 446 sub e_write {
 447         my $file = filename_fixup(shift);
 448         my ($buffer,$off) = @_;
 449
 450         return -ENOENT() unless exists($files{$file});
 451
 452         my $cont = $files{$file}{cont};
 453         my $len = length($cont);
 454
 455         print "write '$file' [$len bytes] offset $off length ",length($buffer),"\n";
 456
 457         $files{$file}{cont} = "";
 458
 459         $files{$file}{cont} .= substr($cont,0,$off) if ($off > 0);
 460         $files{$file}{cont} .= $buffer;
 461         $files{$file}{cont} .= substr($cont,$off+length($buffer),$len-$off-length($buffer)) if ($off+length($buffer) < $len);
 462
 463         $files{$file}{size} = length($files{$file}{cont});
 464
 465         if (! update_db($file)) {
 466                 return -ENOSYS();
 467         } else {
 468                 return length($buffer);
 469         }
 470 }
 471
 472 sub e_truncate {
 473         my $file = filename_fixup(shift);
 474         my $size = shift;
 475
 476         print "truncate to $size\n";
 477
 478         $files{$file}{cont} = substr($files{$file}{cont},0,$size);
 479         $files{$file}{size} = $size;
 480         return 0
 481 };
 482
 483
 484 sub e_utime {
 485         my ($atime,$mtime,$file) = @_;
 486         $file = filename_fixup($file);
 487
 488         return -ENOENT() unless exists($files{$file});
 489
 490         print "utime '$file' $atime $mtime\n";
 491
 492         $files{$file}{time} = $mtime;
 493         return 0;
 494 }
 495
 496 sub e_statfs { return 255, 1, 1, 1, 1, 2 }
 497
 498 sub e_unlink {
 499         my $file = filename_fixup(shift);
 500
 501         if (exists( $dirs{$file} )) {
 502                 print "unlink '$file' will re-read template names\n";
 503                 print Dumper($fuse_self);
 504                 $$fuse_self->{'read_filenames'}->();
 505                 return 0;
 506         } elsif (exists( $files{$file} )) {
 507                 print "unlink '$file' will invalidate cache\n";
 508                 read_content($file,$files{$file}{id});
 509                 return 0;
 510         }
 511
 512         return -ENOENT();
 513 }
 514 1;
 515 __END__
 516
 517 =head1 EXPORT
 518
 519 Nothing.
 520
 521 =head1 SEE ALSO
 522
 523 C<FUSE (Filesystem in USErspace)> website
 524 L<http://sourceforge.net/projects/avf>
 525
 526 Example for WebGUI which comes with this distribution in
 527 directory C<examples/webgui.pl>. It also contains a lot of documentation
 528 about design of this module, usage and limitations.
 529
 530 =head1 AUTHOR
 531
 532 Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
 533
 534 =head1 COPYRIGHT AND LICENSE
 535
 536 Copyright (C) 2004 by Dobrica Pavlinusic
 537
 538 This library is free software; you can redistribute it and/or modify
 539 it under the same terms as Perl itself, either Perl version 5.8.4 or,
 540 at your option, any later version of Perl 5 you may have available.
 541
 542
 543 =cut
 544