sqlfs-perl
view release on metacpan or search on metacpan
lib/DBI/Filesystem.pm view on Meta::CPAN
return $self->_inode2path($parent)."/".$name;
}
sub _dirname {
my $self = shift;
my $path = shift;
my $dir = dirname($path);
$dir = '/' if $dir eq '.'; # work around funniness in dirname()
return $dir;
}
sub _path2inode_sql {
my $self = shift;
my $path = shift;
my (undef,$dir,$name) = File::Spec->splitpath($path);
my ($parent,@base) = $self->_path2inode_subselect($dir); # something nicely recursive
my $sql = <<END;
select p.inode,p.parent,p.name from metadata as m,path as p
where p.name=? and p.parent in ($parent)
and m.inode=p.inode
END
;
return ($sql,$name,@base);
}
sub _path2inode_subselect {
my $self = shift;
my $path = shift;
return 'select 1' if $path eq '/' or !length($path);
$path =~ s!/$!!;
my (undef,$dir,$name) = File::Spec->splitpath($path);
my ($parent,@base) = $self->_path2inode_subselect($dir); # something nicely recursive
return (<<END,$name,@base);
select p.inode from metadata as m,path as p
where p.name=? and p.parent in ($parent)
and m.inode=p.inode
END
;
}
=head2 $groups = $fs->get_groups($uid,$gid)
This method takes a UID and GID, and returns the primary and
supplemental groups to which the user is assigned, and is used during
permission checking. The result is a hashref in which the keys are the
groups to which the user belongs.
=cut
sub get_groups {
my $self = shift;
my ($uid,$gid) = @_;
return $self->{_group_cache}{$uid} ||= $self->_get_groups($uid,$gid);
}
sub _get_groups {
my $self = shift;
my ($uid,$gid) = @_;
my %result;
$result{$gid}++;
my $username = getpwuid($uid) or return \%result;
while (my($name,undef,$id,$members) = getgrent) {
next unless $members =~ /\b$username\b/;
$result{$id}++;
}
endgrent;
return \%result;
}
=head2 $ctx = $fs->get_context
This method is a wrapper around the fuse_get_context() function
described in L<Fuse>. If called before the filesystem is mounted, then
it fakes the call, returning a context object based on the information
in the current process.
=cut
sub get_context {
my $self = shift;
return fuse_get_context() if $self->mounted;
my ($gid) = $( =~ /^(\d+)/;
return {
uid => $<,
gid => $gid,
pid => $$,
umask => umask()
}
}
################# a few SQL fragments; most are inline or in the DBD-specific descendents ######
sub _fgetattr_sql {
my $self = shift;
my $inode = shift;
my $times = join ',',map{$self->_get_unix_timestamp_sql($_)} 'ctime','mtime','atime';
return <<END;
select inode,mode,uid,gid,rdev,links,
$times,size
from metadata
where inode=$inode
END
}
sub _create_inode_sql {
my $self = shift;
my $now = $self->_now_sql;
return "insert into metadata (mode,uid,gid,rdev,links,mtime,ctime,atime) values(?,?,?,?,?,$now,$now,$now)";
}
1;
=head1 SUBCLASSING
Subclass this module as you ordinarily would by creating a new package
that has a "use base DBI::Filesystem". You can then tell the
command-line sqlfs.pl tool to load your subclass rather than the
original by providing a --module (or -M) option, as in:
$ sqlfs.pl -MDBI::Filesystem::MyClass <database> <mtpt>
( run in 1.637 second using v1.01-cache-2.11-cpan-df04353d9ac )