File Coverage

blib/lib/Fuse/TagLayer.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package Fuse::TagLayer;

# use strict;
use warnings;

use Data::Dumper;
use File::ExtAttr ();
use File::Find ();
use File::Basename ();
use Fcntl qw(SEEK_SET);
use POSIX qw(S_ISDIR ENOENT EISDIR EINVAL ENOSYS);
use Encode;

our $VERSION = '0.12';
our $self;
our $numbers_regex = qr/^\d+$/;

sub new {
	my $class = shift;

	$self = bless({
		@_
	}, $class);

	$self->{uid} ||= 0;
	$self->{gid} ||= 0;

	print "TagLayer: version:$VERSION, debug:$self->{debug}\n" if $self->{debug} > 1;

	if($self->{backend} eq 'PurePerl'){
		require Fuse::TagLayer::PurePerl;
		Fuse::TagLayer::PurePerl->import();
	}else{
		require Fuse::TagLayer::SQLite;
		Fuse::TagLayer::SQLite->import();
	}

	print "TagLayer: Building TagLayer tags database, using '$self->{backend}' backend...\n" if $self->{debug};
	## init db backend
	db_init( debug => $self->{debug} );

	## prepare a mountpoint regex
	my $mntre = quotemeta($self->{mountpoint});
	$self->{mountpoint_regex} = qr/^$mntre/;

	## build SQL tables
	# table:file_tags
	File::Find::find({ wanted => \&wanted }, $self->{realdir});
	db_sync(); # we assume backends to be non-auto-committing

	# table:tags
	for (keys %{ $self->{global_tags} }){
		print "## TagLayer::new: $_, ". $self->{global_tags}->{$_} ." \n" if $self->{debug} > 2;
		db_tags_add($_, $self->{global_tags}->{$_});

		$self->{tags_cnt}++;
		db_sync() if $self->{tags_cnt} && ($self->{tags_cnt} % 250) == 0;
	}
	delete($self->{global_tags});
	db_sync();

	$self->{db_epoch} = time();

	print "TagLayer: processed ".($self->{files_cnt}||0)." files with ".($self->{tags_cnt}||0)." tags.\n" if $self->{debug};

	return $self;
}

sub mount {
	my $self = shift;

	print '## TagLayer: mount() self:'.Dumper($self) if $self->{debug};

	## check local mount point
	if(!-d $self->{mountpoint}){
		die 'Fuse::TagLayer: Mountpoint '.$self->{mountpoint}.' does not exists!';
	}

	Fuse::main(
		mountpoint => $self->{mountpoint},
		threaded   => $self->{threaded} ? 1 : 0,
		debug	   => $self->{debug} > 2 ? 1 : 0,

		readdir	=> "Fuse::TagLayer::virt_readdir",
		getattr	=> "Fuse::TagLayer::virt_getattr",
		open	=> "Fuse::TagLayer::real_open",
		read	=> "Fuse::TagLayer::real_read",
		release	=> "Fuse::TagLayer::real_release",
		statfs	=> "Fuse::TagLayer::virt_statfs",
	);
	return;
}

sub dirpath_to_tags {
	## explode path into tags
	# if path comes from wanted, it returns unclean "tags",
	# if path comes from our paths, tags should already be cleaned

	my @pathtags = split(/\//,shift);
	shift(@pathtags); # root path means no dirtags

	return @pathtags;
}

sub wanted {
	## if our mountpoint is within the realdir, ignore ourself
	return if $File::Find::dir =~ $self->{mountpoint_regex};

	## only dirs with files qualify
	return if !-f $File::Find::name;

	my $realdir = $self->{realdir};
	my $rel_dir = $File::Find::dir;
	$rel_dir =~ s/^$realdir//;

	my @tags;
	## dir tags
	@tags = dirpath_to_tags($rel_dir) unless $self->{no_tags_from_path};

	if($self->{more_tags}){
		my $filename = lc($_);
		$filename =~ s/(\.[a-zA-Z0-9]{2,5})$//;
		if(my $suffix = $1){
			$suffix =~ s/jpeg/jpg/;
			push(@tags, 'zsuffix-'.$suffix);
		}

		my @newtags = split(/[^\p{L}\p{N}]/,$filename);	# matches all (Unicode) characters that are neither letters nor numbers
		for(@newtags){
			next unless defined $_;
			next if length($_) < 2;
			next if $self->{ignore_numbers_only} && $_ =~ $numbers_regex;
			push(@tags, $_);
		}
	}

	## xattr tags
	if(!$self->{no_tags_from_xattr}){
		if(my $xattrtags = File::ExtAttr::getfattr( $File::Find::dir.'/'.$_, 'tags') ){
			$xattrtags = decode_utf8($xattrtags);
			my @newtags = split(/,\s*/,$xattrtags);
			for(@newtags){
				next unless defined $_;
				next if length($_) < 2;
				next if $self->{ignore_numbers_only} && $_ =~ $numbers_regex;
				push(@tags, $_);
			}
		}
	}

	# clean and dedup, as there might be duplicates after cleansing
	my %tags;
	for(@tags){
		my $tag_cleaned = lc($_);
		$tag_cleaned =~ s/[^\p{L}\p{N}]//g;	# matches all (Unicode) characters that are neither letters nor numbers
		next if length($tag_cleaned) < 2;
		next if $self->{ignore_numbers_only} && $tag_cleaned =~ $numbers_regex;
		$tags{$tag_cleaned}++;

		$self->{global_tags}->{$tag_cleaned}++;
	}

	# insert "/path/to", "filename", "tags as csv string"
	db_files_add( $File::Find::dir, $_, keys(%tags) );
	$self->{files_cnt}++;
#	print "File: $self->{files_cnt}: $File::Find::dir, $_, ".join(", ", keys %tags)."\n";

	if($self->{files_cnt} && ($self->{files_cnt} % 250) == 0){
		db_sync();
		print " $self->{files_cnt} files processed\n" if $self->{debug};
	}
}

## note the singular "file", as it should return only one file
sub file_by_tagpath {
	my ($basename,$directory) = File::Basename::fileparse(shift);

	# 1st: only by tags
	my @pathtags = dirpath_to_tags($directory);
	print "file_by_tagpath: directory:$directory ; basename:$basename ; pathtags:@pathtags\n" if $self->{debug};

	return undef if !@pathtags;

	my ($files_for_tags, $subtags) = db_files_for_tags(@pathtags);
## print "PREFAIL: tags: @tags (".@tags.") ;; SELECT `file`,`basename` FROM `file_tags` WHERE $sql_files;\n";
#	my $pre = database()->selectall_arrayref("SELECT `file`,`basename` FROM `file_tags` WHERE $sql_files; ", {Columns=>[1,2]}); # push first two rows into arrayref

	return undef if !@$files_for_tags;

	# 2nd: by basename
	my @files;
	for(@$files_for_tags){
		my ($thisbasename,$thisdirectory) = File::Basename::fileparse($_);
		push(@files, $_) if $thisbasename eq $basename;
	}

	print "TagLayer: ++ WARNING ++ file_by_tagpath($basename,@_) found multiple files: @files\n" if @files > 1;

	return @files ? shift(@files) : undef;
}

sub virt_readdir {
	my ($path,$offset) = @_;

	my (@dirs,@files);
	if($path eq '/'){
		## return all tags:
		@dirs = @{ db_tags_all() };
	}else{
		## return a list of:
		## 1. all files tagged with the tags found in the path
		## 2. Sub-dirs (tags left) found in theses files but not yet applied
		my @pathtags = dirpath_to_tags($path);

		my ($files_for_tags, $subtags) = db_files_for_tags(@pathtags);

		for(@$files_for_tags){
			($basename,$directory) = File::Basename::fileparse($_);
			push(@files, $basename);
		}
		@dirs = keys %$subtags;
	}

	print "## virt_readdir: $path: sub-tags left (as dirs):@dirs ; files:".scalar(@files)."\n" if $self->{debug};
	print "## virt_readdir: \n    ".join("\n    ",@files)."\n" if $self->{debug} > 1 && @files;
	return (@dirs || @files) ? ((@dirs,@files), 0) : 0;
}

sub real_getattr {
	my $file = shift; # we have real paths in the db anyway
	print "real_getattr: file:$file\n" if $self->{debug};
	my (@list) = lstat($file);
	return -ENOENT() unless @list;	# "-ENOENT" was "-$!", but if we compare both in Dumper, "-$!" is a string, and ENOENT is numeric
	return @list;
}

sub virt_getattr {
	my ($path) = shift;
	print "## virt_getattr: path:$path => " if $self->{debug};

	return -ENOENT() unless $self->{tags_cnt};

#	my $cnt = () = $path =~ /\//g; # from an older approach, to find out how deep we are in the tag-path

	## find which file exactly is meant here
	my $file = file_by_tagpath($path);

	if($file){
		return real_getattr( $file );
	}else{
		print "## virt_getattr: path:$path ; file_by_tagpath() returned \n" if $self->{debug};
		my ($modes) = (0040<<9) + 0775;
		my ($dev, $ino, $rdev, $blocks, $uid, $gid, $nlink, $blksize) = (0,0,0,1,$self->{uid},$self->{gid},1,1024);
		my $size = 0;
		$blocks = $size;
		my ($atime, $ctime, $mtime);
		$atime = $ctime = $mtime = $self->{db_epoch};

		return ($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks);
	}
	return -ENOENT(); # never
}

sub real_open {
	my ($path,$mode) = @_;

	## find which file exactly is meant here
	my $file = file_by_tagpath($path);

	return -ENOSYS() if !$file;
	return -ENOENT() unless -e $file;

	my $fh;
	sysopen($fh,$file,$mode) or return -$!;

	return (0, $fh);
}

sub real_read {
	my ($path,$bufsize,$off,$fh) = @_;

	my $rv = -ENOSYS();

	if(seek($fh,$off,SEEK_SET)) {
		read($fh,$rv,$bufsize);
	}

	return $rv;
}

sub real_release {
	my ($path,$mode,$fh) = @_;

	close($fh) or return -$!;

	return 0;
}

sub virt_statfs { return 255, 1, 1, 1, 1, 2 }

sub umount {
	db_disconnect();
}


1;

__END__