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