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