/[fuse_dbi]/trunk/DBI.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /trunk/DBI.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/fuse_dbi.pl revision 7 by dpavlin, Sat Aug 7 14:48:23 2004 UTC trunk/DBI.pm revision 24 by dpavlin, Fri Oct 8 20:07:12 2004 UTC
# Line 1  Line 1 
1  #!/usr/bin/perl  #!/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);  use POSIX qw(ENOENT EISDIR EINVAL ENOSYS O_RDWR);
10  use Fuse;  use Fuse;
   
11  use DBI;  use DBI;
12  use strict;  use Carp;
13    use Data::Dumper;
14    
 my $sql_filenames = q{  
         select  
                 oid as id,  
                 namespace||'/'||name||' ['||oid||']' as filename,  
                 length(template) as size,  
                 iseditable as writable  
         from template ;  
 };  
15    
16  my $sql_read = q{  our $VERSION = '0.03';
17          select template  
18                  from template  =head1 NAME
19                  where oid = ?;  
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    
 my $sql_update = q{  
         update template  
                 set template = ?          
                 where oid = ?;  
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  my $connect = "DBI:Pg:dbname=webgui";  sub umount {
147            my $self = shift;
148    
149  my $dbh = DBI->connect($connect,"","", { AutoCommit => 0 }) || die $DBI::errstr;          system "fusermount -u ".$self->{'mount'} || croak "umount error: $!";
150    
151  print "start transaction\n";          return 1;
152  #$dbh->begin_work || die $dbh->errstr;  }
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  my $sth_filenames = $dbh->prepare($sql_filenames) || die $dbh->errstr();  This function in called by L<mount>, but might be useful alone also.
173  $sth_filenames->execute() || die $sth_filenames->errstr();  
174    =cut
175  my $sth_read = $dbh->prepare($sql_read) || die $dbh->errstr();  
176  my $sth_update = $dbh->prepare($sql_update) || die $dbh->errstr();  sub fuse_module_loaded {
177            my $lsmod = `lsmod`;
178  my $ctime_start = time();          die "can't start lsmod: $!" unless ($lsmod);
179            if ($lsmod =~ m/fuse/s) {
180  my (%files) = (                  return 1;
181          '.' => {          } else {
182                  type => 0040,                  return 0;
183                  mode => 0755,          }
184          },  }
 #       a => {  
 #               cont => "File 'a'.\n",  
 #               type => 0100,  
 #               ctime => time()-2000  
 #       },  
 );  
185    
186    my %files;
187  my %dirs;  my %dirs;
188    
189  while (my $row = $sth_filenames->fetchrow_hashref() ) {  sub read_filenames {
190          $files{$row->{'filename'}} = {          my $self = shift;
191                  size => $row->{'size'},  
192                  mode => $row->{'writable'} ? 0644 : 0444,          # create empty filesystem
193                  id => $row->{'id'} || 99,          (%files) = (
194          };                  '.' => {
195                            type => 0040,
196          my $d;                          mode => 0755,
197          foreach (split(m!/!, $row->{'filename'})) {                  },
198                  # first, entry is assumed to be file          #       a => {
199                  if ($d) {          #               cont => "File 'a'.\n",
200                          $files{$d} = {          #               type => 0100,
201                                          size => $dirs{$d}++,          #               ctime => time()-2000
202                                          mode => 0755,          #       },
203                                          type => 0040          );
204                          };  
205                          $files{$d.'/.'} = {          # fetch new filename list from database
206                                          mode => 0755,          $sth->{'filenames'}->execute() || die $sth->{'filenames'}->errstr();
207                                          type => 0040  
208                          };          # read them in with sesible defaults
209                          $files{$d.'/..'} = {          while (my $row = $sth->{'filenames'}->fetchrow_hashref() ) {
210                                          mode => 0755,                  $files{$row->{'filename'}} = {
211                                          type => 0040                          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                  }                  }
                 $d .= "/" if ($d);  
                 $d .= "$_";  
237          }          }
238    
239            print "found ",scalar(keys %files)-scalar(keys %dirs)," files, ",scalar(keys %dirs), " dirs\n";
240  }  }
241    
 print "found ",scalar(keys %files)-scalar(keys %dirs)," files, ",scalar(keys %dirs), " dirs\n";  
242    
243  sub filename_fixup {  sub filename_fixup {
244          my ($file) = shift;          my ($file) = shift;
# Line 120  sub e_getdir { Line 271  sub e_getdir {
271          # return as many text filenames as you like, followed by the retval.          # return as many text filenames as you like, followed by the retval.
272          print((scalar keys %files)." files total\n");          print((scalar keys %files)." files total\n");
273          my %out;          my %out;
274          foreach (keys %files) {          foreach my $f (sort keys %files) {
                 my $f = $_;  
                 $f =~ s/^\E$dirname\Q//;  
                 $f =~ s/^\///;  
275                  if ($dirname) {                  if ($dirname) {
276                          $out{$f}++ if (/^\E$dirname\Q/ && $f =~ /^[^\/]+$/);                          if ($f =~ s/^\E$dirname\Q\///) {
277                                    $out{$f}++ if ($f =~ /^[^\/]+$/);
278                            }
279                  } else {                  } else {
280                          $out{$f}++ if ($f =~ /^[^\/]+$/);                          $out{$f}++ if ($f =~ /^[^\/]+$/);
281                  }                  }
# Line 133  sub e_getdir { Line 283  sub e_getdir {
283          if (! %out) {          if (! %out) {
284                  $out{'no files? bug?'}++;                  $out{'no files? bug?'}++;
285          }          }
286          print scalar keys %out," files found for '$dirname': ",keys %out,"\n";          print scalar keys %out," files in dir '$dirname'\n";
287            print "## ",join(" ",keys %out),"\n";
288          return (keys %out),0;          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 {  sub e_open {
303          # VFS sanity check; it keeps all the necessary state, not much to do here.          # VFS sanity check; it keeps all the necessary state, not much to do here.
304          my $file = filename_fixup(shift);          my $file = filename_fixup(shift);
# Line 145  sub e_open { Line 307  sub e_open {
307          return -ENOENT() unless exists($files{$file});          return -ENOENT() unless exists($files{$file});
308          return -EISDIR() unless exists($files{$file}{id});          return -EISDIR() unless exists($files{$file}{id});
309    
310          if (!exists($files{$file}{cont})) {          read_content($file,$files{$file}{id}) unless exists($files{$file}{cont});
311                  $sth_read->execute($files{$file}{id}) || die $sth_read->errstr;  
                 $files{$file}{cont} = $sth_read->fetchrow_array;  
                 print "file '$file' content read in cache\n";  
         }  
312          print "open '$file' ",length($files{$file}{cont})," bytes\n";          print "open '$file' ",length($files{$file}{cont})," bytes\n";
313          return 0;          return 0;
314  }  }
# Line 159  sub e_read { Line 318  sub e_read {
318          # (note: 0 means EOF, "0" will give a byte (ascii "0")          # (note: 0 means EOF, "0" will give a byte (ascii "0")
319          # to the reading program)          # to the reading program)
320          my ($file) = filename_fixup(shift);          my ($file) = filename_fixup(shift);
321          my ($buf,$off) = @_;          my ($buf_len,$off) = @_;
322    
323          return -ENOENT() unless exists($files{$file});          return -ENOENT() unless exists($files{$file});
324    
325          my $len = length($files{$file}{cont});          my $len = length($files{$file}{cont});
326    
327          print "read '$file' [$len bytes] offset $off length $buf\n";          print "read '$file' [$len bytes] offset $off length $buf_len\n";
328    
329          return -EINVAL() if ($off > $len);          return -EINVAL() if ($off > $len);
330          return 0 if ($off == $len);          return 0 if ($off == $len);
331    
332          $buf = $len-$off if ($off+$buf > $len);          $buf_len = $len-$off if ($len - $off < $buf_len);
333    
334          return substr($files{$file}{cont},$off,$buf);          return substr($files{$file}{cont},$off,$buf_len);
335  }  }
336    
337  sub clear_cont {  sub clear_cont {
# Line 183  sub clear_cont { Line 342  sub clear_cont {
342                  delete $files{$f}{cont};                  delete $files{$f}{cont};
343          }          }
344          print "begin new transaction\n";          print "begin new transaction\n";
345          $dbh->begin_work || die $dbh->errstr;          #$dbh->begin_work || die $dbh->errstr;
346  }  }
347    
348    
349  sub update_db {  sub update_db {
350          my $file = shift || die;          my $file = shift || die;
351    
352          if (!$sth_update->execute($files{$file}{cont},$files{$file}{id})) {          $files{$file}{ctime} = time();
353                  print "update problem: ",$sth_update->errstr;  
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;                  clear_cont;
362                  return 0;                  return 0;
363          } else {          } else {
364                  if (! $dbh->commit) {                  if (! $dbh->commit) {
365                          print "ERROR: commit problem: ",$sth_update->errstr;                          print "ERROR: commit problem: ",$sth->{'update'}->errstr;
366                          clear_cont;                          clear_cont;
367                          return 0;                          return 0;
368                  }                  }
369                  print "updated '$file' [",$files{$file}{id},"]\n";                  print "updated '$file' [",$files{$file}{id},"]\n";
370    
371                    $fuse_self->{'invalidate'}->() if (ref $fuse_self->{'invalidate'});
372          }          }
373          return 1;          return 1;
374  }  }
375    
376  sub e_write {  sub e_write {
377          my $file = filename_fixup(shift);          my $file = filename_fixup(shift);
378          my ($buf,$off) = @_;          my ($buffer,$off) = @_;
379    
380          return -ENOENT() unless exists($files{$file});          return -ENOENT() unless exists($files{$file});
381    
382          my $len = length($files{$file}{cont});          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          print "write '$file' [$len bytes] offset $off length $buf\n";          $files{$file}{cont} = "";
388    
389          $files{$file}{cont} =          $files{$file}{cont} .= substr($cont,0,$off) if ($off > 0);
390                  substr($files{$file}{cont},0,$off) .          $files{$file}{cont} .= $buffer;
391                  $buf .          $files{$file}{cont} .= substr($cont,$off+length($buffer),$len-$off-length($buffer)) if ($off+length($buffer) < $len);
392                  substr($files{$file}{cont},$off+length($buf));  
393            $files{$file}{size} = length($files{$file}{cont});
394    
395          if (! update_db($file)) {          if (! update_db($file)) {
396                  return -ENOSYS();                  return -ENOSYS();
397          } else {          } else {
398                  return length($buf);                  return length($buffer);
399          }          }
400  }  }
401    
# Line 231  sub e_truncate { Line 403  sub e_truncate {
403          my $file = filename_fixup(shift);          my $file = filename_fixup(shift);
404          my $size = shift;          my $size = shift;
405    
406            print "truncate to $size\n";
407    
408          $files{$file}{cont} = substr($files{$file}{cont},0,$size);          $files{$file}{cont} = substr($files{$file}{cont},0,$size);
409            $files{$file}{size} = $size;
410          return 0          return 0
411  };  };
412    
# Line 242  sub e_utime { Line 417  sub e_utime {
417    
418          return -ENOENT() unless exists($files{$file});          return -ENOENT() unless exists($files{$file});
419    
420            print "utime '$file' $atime $mtime\n";
421    
422          $files{$file}{time} = $mtime;          $files{$file}{time} = $mtime;
423          return 0;          return 0;
424  }  }
425    
426  sub e_statfs { return 255, 1, 1, 1, 1, 2 }  sub e_statfs { return 255, 1, 1, 1, 1, 2 }
427    
428  # If you run the script directly, it will run fusermount, which will in turn  sub e_unlink {
429  # re-run this script.  Hence the funky semantics.          my $file = filename_fixup(shift);
430  my ($mountpoint) = "";  
431  $mountpoint = shift(@ARGV) if @ARGV;          return -ENOENT() unless exists($files{$file});
432  Fuse::main(  
433          mountpoint=>$mountpoint,          print "unlink '$file' will invalidate cache\n";
434          getattr=>\&e_getattr,  
435          getdir=>\&e_getdir,          read_content($file,$files{$file}{id});
436          open=>\&e_open,  
437          statfs=>\&e_statfs,          return 0;
438          read=>\&e_read,  }
439          write=>\&e_write,  1;
440          utime=>\&e_utime,  __END__
441          truncate=>\&e_truncate,  
442          debug=>0,  =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    
Legend:
Removed from v.7  
changed lines
  Added in v.24
  ViewVC Help
Powered by ViewVC 1.1.26