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