/[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 1 by dpavlin, Wed Aug 4 08:58:46 2004 UTC trunk/DBI.pm revision 26 by dpavlin, Fri Oct 8 22:55:36 2004 UTC
# Line 1  Line 1 
1  #!/usr/bin/perl  #!/usr/bin/perl
2    
3  use POSIX qw(ENOENT EISDIR EINVAL);  package Fuse::DBI;
 use Fuse;  
4    
5  use DBI;  use 5.008;
6  use strict;  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    
 my $sql_filenames = q{  
         select  
                 templateid as id,  
                 namespace||'/'||name as filename,  
                 length(template) as size,  
                 iseditable as writable  
         from template ;  
 };  
40    
41  my $sql_content = q{  =head1 METHODS
42          select template  
43          from template  =cut
44          where templateid = ?;  
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            }
88    
89            foreach (qw(filenames read update)) {
90                    carp "mount needs '$_' SQL" unless ($arg->{$_});
91            }
92    
93            $ctime_start = time();
94    
95            my $pid;
96            if ($arg->{'fork'}) {
97                    $pid = fork();
98                    die "fork() failed: $!" unless defined $pid;
99                    # child will return to caller
100                    if ($pid) {
101                            return $self;
102                    }
103            }
104    
105            $dbh = DBI->connect($arg->{'dsn'},$arg->{'user'},$arg->{'password'}, {AutoCommit => 0, RaiseError => 1}) || die $DBI::errstr;
106    
107            $sth->{'filenames'} = $dbh->prepare($arg->{'filenames'}) || die $dbh->errstr();
108    
109            $sth->{'read'} = $dbh->prepare($arg->{'read'}) || die $dbh->errstr();
110            $sth->{'update'} = $dbh->prepare($arg->{'update'}) || die $dbh->errstr();
111    
112    
113            $self->{'sth'} = $sth;
114    
115            $self->{'read_filenames'} = sub { $self->read_filenames };
116            $self->read_filenames;
117    
118            $self->{'mounted'} = 1;
119    
120            $fuse_self = \$self;
121    
122            Fuse::main(
123                    mountpoint=>$arg->{'mount'},
124                    getattr=>\&e_getattr,
125                    getdir=>\&e_getdir,
126                    open=>\&e_open,
127                    statfs=>\&e_statfs,
128                    read=>\&e_read,
129                    write=>\&e_write,
130                    utime=>\&e_utime,
131                    truncate=>\&e_truncate,
132                    unlink=>\&e_unlink,
133                    rmdir=>\&e_unlink,
134                    debug=>0,
135            );
136            
137            $self->{'mounted'} = 0;
138    
139            exit(0) if ($arg->{'fork'});
140    
141            return 1;
142    
143  };  };
144    
145    =head2 umount
146    
147  my $connect = "DBI:Pg:dbname=webgui";  Unmount your database as filesystem.
148    
149  my $dbh = DBI->connect($connect,"","") || die $DBI::errstr;    $mnt->umount;
150    
151  print STDERR "$sql_filenames\n";  This will also kill background process which is translating
152    database to filesystem.
153    
154  my $sth_filenames = $dbh->prepare($sql_filenames) || die $dbh->errstr();  =cut
 $sth_filenames->execute() || die $sth_filenames->errstr();  
155    
156  my $sth_content = $dbh->prepare($sql_content) || die $dbh->errstr();  sub umount {
157            my $self = shift;
158    
159  print "#",join(",",@{ $sth_filenames->{NAME} }),"\n";          if ($self->{'mounted'}) {
160                    system "fusermount -u ".$self->{'mount'} || croak "umount error: $!";
161            }
162    
163            return 1;
164    }
165    
166    $SIG{'INT'} = sub {
167            print STDERR "umount called by SIG INT\n";
168            umount;
169    };
170    
171    sub DESTROY {
172            my $self = shift;
173            return if (! $self->{'mounted'});
174            print STDERR "umount called by DESTROY\n";
175            $self->umount;
176    }
177    
178    =head2 fuse_module_loaded
179    
180  my $ctime_start = time();  Checks if C<fuse> module is loaded in kernel.
181    
182  my (%files) = (    die "no fuse module loaded in kernel"
183          '.' => {          unless (Fuse::DBI::fuse_module_loaded);
                 type => 0040,  
                 mode => 0755,  
         },  
 #       a => {  
 #               cont => "File 'a'.\n",  
 #               type => 0100,  
 #               ctime => time()-2000  
 #       },  
 );  
184    
185    This function in called by L<mount>, but might be useful alone also.
186    
187    =cut
188    
189    sub fuse_module_loaded {
190            my $lsmod = `lsmod`;
191            die "can't start lsmod: $!" unless ($lsmod);
192            if ($lsmod =~ m/fuse/s) {
193                    return 1;
194            } else {
195                    return 0;
196            }
197    }
198    
199    my %files;
200  my %dirs;  my %dirs;
201    
202  while (my $row = $sth_filenames->fetchrow_hashref() ) {  sub read_filenames {
203          $files{$row->{'filename'}} = {          my $self = shift;
204                  size => $row->{'size'},  
205                  mode => $row->{'writable'} ? 0644 : 0444,          my $sth = $self->{'sth'} || die "no sth argument";
206                  id => $row->{'id'} || 99,  
207          };          # create empty filesystem
208            (%files) = (
209          my $d;                  '.' => {
210          foreach (split(m!/!, $row->{'filename'})) {                          type => 0040,
211                  # first, entry is assumed to be file                          mode => 0755,
212                  if ($d) {                  },
213                          $files{$d} = {          #       a => {
214                                          size => $dirs{$d}++,          #               cont => "File 'a'.\n",
215                                          mode => 0755,          #               type => 0100,
216                                          type => 0040          #               ctime => time()-2000
217                          };          #       },
218                          $files{$d.'/.'} = {          );
219                                          mode => 0755,  
220                                          type => 0040          # fetch new filename list from database
221                          };          $sth->{'filenames'}->execute() || die $sth->{'filenames'}->errstr();
222                          $files{$d.'/..'} = {  
223                                          mode => 0755,          # read them in with sesible defaults
224                                          type => 0040          while (my $row = $sth->{'filenames'}->fetchrow_hashref() ) {
225                          };                  $files{$row->{'filename'}} = {
226                            size => $row->{'size'},
227                            mode => $row->{'writable'} ? 0644 : 0444,
228                            id => $row->{'id'} || 99,
229                    };
230    
231                    my $d;
232                    foreach (split(m!/!, $row->{'filename'})) {
233                            # first, entry is assumed to be file
234                            if ($d) {
235                                    $files{$d} = {
236                                                    size => $dirs{$d}++,
237                                                    mode => 0755,
238                                                    type => 0040
239                                    };
240                                    $files{$d.'/.'} = {
241                                                    mode => 0755,
242                                                    type => 0040
243                                    };
244                                    $files{$d.'/..'} = {
245                                                    mode => 0755,
246                                                    type => 0040
247                                    };
248                            }
249                            $d .= "/" if ($d);
250                            $d .= "$_";
251                  }                  }
                 $d .= "/" if ($d);  
                 $d .= "$_";  
252          }          }
253    
254            print "found ",scalar(keys %files)-scalar(keys %dirs)," files, ",scalar(keys %dirs), " dirs\n";
255  }  }
256    
 print scalar (keys %dirs), " dirs:",join(" ",keys %dirs),"\n";  
257    
258  sub filename_fixup {  sub filename_fixup {
259          my ($file) = shift;          my ($file) = shift;
# Line 114  sub e_getdir { Line 286  sub e_getdir {
286          # return as many text filenames as you like, followed by the retval.          # return as many text filenames as you like, followed by the retval.
287          print((scalar keys %files)." files total\n");          print((scalar keys %files)." files total\n");
288          my %out;          my %out;
289          foreach (keys %files) {          foreach my $f (sort keys %files) {
                 my $f = $_;  
                 $f =~ s/^\E$dirname\Q//;  
                 $f =~ s/^\///;  
290                  if ($dirname) {                  if ($dirname) {
291                          $out{$f}++ if (/^\E$dirname\Q/);                          if ($f =~ s/^\E$dirname\Q\///) {
292                                    $out{$f}++ if ($f =~ /^[^\/]+$/);
293                            }
294                  } else {                  } else {
295                          $out{$f}++ if ($f =~ /^[^\/]+$/);                          $out{$f}++ if ($f =~ /^[^\/]+$/);
296                  }                  }
                 print "f: $_ -> $f\n";  
297          }          }
298          if (! %out) {          if (! %out) {
299                  $out{'no files? bug?'}++;                  $out{'no files? bug?'}++;
300          }          }
301          print scalar keys %out," files found for '$dirname': ",keys %out,"\n";          print scalar keys %out," files in dir '$dirname'\n";
302            print "## ",join(" ",keys %out),"\n";
303          return (keys %out),0;          return (keys %out),0;
304  }  }
305    
306    sub read_content {
307            my ($file,$id) = @_;
308    
309            die "read_content needs file and id" unless ($file && $id);
310    
311            $sth->{'read'}->execute($id) || die $sth->{'read'}->errstr;
312            $files{$file}{cont} = $sth->{'read'}->fetchrow_array;
313            $files{$file}{ctime} = time();
314            print "file '$file' content [",length($files{$file}{cont})," bytes] read in cache\n";
315    }
316    
317    
318  sub e_open {  sub e_open {
319          # 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.
320          my ($file) = filename_fixup(shift);          my $file = filename_fixup(shift);
321          print("open called\n");          my $flags = shift;
322    
323          return -ENOENT() unless exists($files{$file});          return -ENOENT() unless exists($files{$file});
324          return -EISDIR() unless exists($files{$file}{id});          return -EISDIR() unless exists($files{$file}{id});
325          if (!exists($files{$file}{cont})) {  
326                  $sth_content->execute($files{$file}{id});          read_content($file,$files{$file}{id}) unless exists($files{$file}{cont});
327                  ($files{$file}{cont}) = $sth_content->fetchrow_array;  
328          }          print "open '$file' ",length($files{$file}{cont})," bytes\n";
         print("open ok\n");  
329          return 0;          return 0;
330  }  }
331    
332  sub e_read {  sub e_read {
333          # return an error numeric, or binary/text string.  (note: 0 means EOF, "0" will          # return an error numeric, or binary/text string.
334          # give a byte (ascii "0") to the reading program)          # (note: 0 means EOF, "0" will give a byte (ascii "0")
335            # to the reading program)
336          my ($file) = filename_fixup(shift);          my ($file) = filename_fixup(shift);
337          my ($buf,$off) = @_;          my ($buf_len,$off) = @_;
338    
339            return -ENOENT() unless exists($files{$file});
340    
341            my $len = length($files{$file}{cont});
342    
343            print "read '$file' [$len bytes] offset $off length $buf_len\n";
344    
345            return -EINVAL() if ($off > $len);
346            return 0 if ($off == $len);
347    
348            $buf_len = $len-$off if ($len - $off < $buf_len);
349    
350            return substr($files{$file}{cont},$off,$buf_len);
351    }
352    
353    sub clear_cont {
354            print "transaction rollback\n";
355            $dbh->rollback || die $dbh->errstr;
356            print "invalidate all cached content\n";
357            foreach my $f (keys %files) {
358                    delete $files{$f}{cont};
359            }
360            print "begin new transaction\n";
361            #$dbh->begin_work || die $dbh->errstr;
362    }
363    
364    
365    sub update_db {
366            my $file = shift || die;
367    
368            $files{$file}{ctime} = time();
369    
370            my ($cont,$id) = (
371                    $files{$file}{cont},
372                    $files{$file}{id}
373            );
374    
375            if (!$sth->{'update'}->execute($cont,$id)) {
376                    print "update problem: ",$sth->{'update'}->errstr;
377                    clear_cont;
378                    return 0;
379            } else {
380                    if (! $dbh->commit) {
381                            print "ERROR: commit problem: ",$sth->{'update'}->errstr;
382                            clear_cont;
383                            return 0;
384                    }
385                    print "updated '$file' [",$files{$file}{id},"]\n";
386    
387                    $$fuse_self->{'invalidate'}->() if (ref $$fuse_self->{'invalidate'});
388            }
389            return 1;
390    }
391    
392    sub e_write {
393            my $file = filename_fixup(shift);
394            my ($buffer,$off) = @_;
395    
396            return -ENOENT() unless exists($files{$file});
397    
398            my $cont = $files{$file}{cont};
399            my $len = length($cont);
400    
401            print "write '$file' [$len bytes] offset $off length ",length($buffer),"\n";
402    
403            $files{$file}{cont} = "";
404    
405            $files{$file}{cont} .= substr($cont,0,$off) if ($off > 0);
406            $files{$file}{cont} .= $buffer;
407            $files{$file}{cont} .= substr($cont,$off+length($buffer),$len-$off-length($buffer)) if ($off+length($buffer) < $len);
408    
409            $files{$file}{size} = length($files{$file}{cont});
410    
411            if (! update_db($file)) {
412                    return -ENOSYS();
413            } else {
414                    return length($buffer);
415            }
416    }
417    
418    sub e_truncate {
419            my $file = filename_fixup(shift);
420            my $size = shift;
421    
422            print "truncate to $size\n";
423    
424            $files{$file}{cont} = substr($files{$file}{cont},0,$size);
425            $files{$file}{size} = $size;
426            return 0
427    };
428    
429    
430    sub e_utime {
431            my ($atime,$mtime,$file) = @_;
432            $file = filename_fixup($file);
433    
434          return -ENOENT() unless exists($files{$file});          return -ENOENT() unless exists($files{$file});
435          return -EINVAL() if $off > length($files{$file}{cont});  
436          return 0 if $off == length($files{$file}{cont});          print "utime '$file' $atime $mtime\n";
437          return substr($files{$file}{cont},$off,$buf);  
438            $files{$file}{time} = $mtime;
439            return 0;
440  }  }
441    
442  sub e_statfs { return 255, 1, 1, 1, 1, 2 }  sub e_statfs { return 255, 1, 1, 1, 1, 2 }
443    
444  # If you run the script directly, it will run fusermount, which will in turn  sub e_unlink {
445  # re-run this script.  Hence the funky semantics.          my $file = filename_fixup(shift);
446  my ($mountpoint) = "";  
447  $mountpoint = shift(@ARGV) if @ARGV;          if (exists( $dirs{$file} )) {
448  Fuse::main(                  print "unlink '$file' will re-read template names\n";
449          mountpoint=>$mountpoint,                  print Dumper($fuse_self);
450          getattr=>\&e_getattr,                  $$fuse_self->{'read_filenames'}->();
451          getdir=>\&e_getdir,                  return 0;
452          open=>\&e_open,          } elsif (exists( $files{$file} )) {
453          statfs=>\&e_statfs,                  print "unlink '$file' will invalidate cache\n";
454          read=>\&e_read,                  read_content($file,$files{$file}{id});
455          debug=>1,                  return 0;
456  );          }
457    
458            return -ENOENT();
459    }
460    1;
461    __END__
462    
463    =head1 EXPORT
464    
465    Nothing.
466    
467    =head1 SEE ALSO
468    
469    C<FUSE (Filesystem in USErspace)> website
470    L<http://sourceforge.net/projects/avf>
471    
472    =head1 AUTHOR
473    
474    Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
475    
476    =head1 COPYRIGHT AND LICENSE
477    
478    Copyright (C) 2004 by Dobrica Pavlinusic
479    
480    This library is free software; you can redistribute it and/or modify
481    it under the same terms as Perl itself, either Perl version 5.8.4 or,
482    at your option, any later version of Perl 5 you may have available.
483    
484    
485    =cut
486    
Legend:
Removed from v.1  
changed lines
  Added in v.26
  ViewVC Help
Powered by ViewVC 1.1.26