package Wrangler::FileSystem::Linux;

# similar to the Filesys::Virtual API but with some additionas/ optimisations:
# list() returns an array-ref, and all dots
# xattr methods
# trash()

use strict;
use warnings;

use Carp;
use Cwd ();
use File::ExtAttr ();
use File::Path ();
use File::Basename ();
use File::Spec ();
use MIME::Types ();
use Encode;

sub new {
	my $class = shift;
 
	my $self = bless({ @_ }, $class);
  
	return $self;
}

##

sub cwd {
	return Cwd::cwd();
}

# for now, we even want to keep path translation tools in the FileSystem:: modules,
# that's why we have these additional two helpers here
sub fileparse {
	shift(@_);
	return File::Basename::fileparse(@_);
}
sub catfile {
	shift(@_);
	return File::Spec->catfile(@_);
}

sub available_properties {
	my ($self, $path, $args) = @_;
	$path = decode('UTF-8',$path);
	utf8::upgrade($path);

	my @keys;
	if($path){
		my %properties;
		for(@{ $self->list($path) }){
			for my $key (keys %$_ ){
				$properties{ $key } = 1;
			}
		}
		@keys = keys %properties;

		return \@keys;
	}

	return [
		'MIME::mediaType',
		'MIME::subType',
		'MIME::Type',
		'MIME::Description',
		'Filesystem::dev',
		'Filesystem::inode',
		'Filesystem::mode',
		'Filesystem::nlink',
		'Filesystem::uid',
		'Filesystem::gid',
		'Filesystem::rdef',
		'Filesystem::Size',
		'Filesystem::Accessed',
		'Filesystem::Modified',
		'Filesystem::Changed',
		'Filesystem::Blocksize',
		'Filesystem::Blocks',
		'Filesystem::Type',
		'Filesystem::Directory',
		'Filesystem::Path',
		'Filesystem::Filename',
		'Filesystem::Basename',
		'Filesystem::Suffix',
		'Filesystem::Hidden',
		'Filesystem::Xattr',	# numeric value; how many xattr keys are set; this should probably only be offered when xattr are set in a dir
	];
}

# my $regex_xattr = qr/xattr/i;
my $regex_dotfile = qr/^\./; # on Linux, the convention is .dotfiles are "hidden"
my $regex_updir = qr/\/\.\.$/;
my $regex_filesystem = qr/^Filesystem::/;
my $regex_filesystem_contains = qr/\bFilesystem::/;
my $regex_mime_contains = qr/\bMIME::/;
my $regex_xattr = qr/^Extended Attributes::/;
my $regex_xattr_contains = qr/\bExtended Attributes::/;
sub properties {
	my ($self, $path, $wishlist) = @_;

	$wishlist = undef if $wishlist && @$wishlist == 0;

	my (@filesystem,@stat,@fileparse,$type,$type_human);
	if(!$wishlist || 'Filesystem' ~~ @$wishlist || "@$wishlist" =~ $regex_filesystem_contains || 'MIME' ~~ @$wishlist){
		# print STDOUT "   ** properties:  -asks for Filesystem\n";
		# 0$dev,1$ino,2$mode,3$nlink,4$uid,5$gid,6$rdev,7$size,8$atime,9$mtime,10$chtime,11$blksize,12$blocks)
		@stat = CORE::lstat($path);

		if(-l _){
			@filesystem = (
				'Filesystem::Link'	=> 'Symlink',
				'Filesystem::LinkTarget' => CORE::readlink($path),
			);
			@stat = CORE::stat($path);
		}

		($type,$type_human) = inode_type_from_mode($stat[2]);
		@fileparse = File::Basename::fileparse($path,qr/\.[^.]*/);
		my $filename = ($fileparse[2] ? $fileparse[0].$fileparse[2] : $fileparse[0]);

		@filesystem = (
			'Filesystem::dev'	=> $stat[0],
			'Filesystem::inode'	=> $stat[1],
			'Filesystem::mode'	=> $stat[2],
			'Filesystem::nlink'	=> $stat[3],
			'Filesystem::uid'	=> $stat[4],
			'Filesystem::gid'	=> $stat[5],
			'Filesystem::rdef'	=> $stat[6],
			'Filesystem::Size'	=> $stat[7],
			'Filesystem::Accessed'	=> $stat[8],
			'Filesystem::Modified'	=> $stat[9],
			'Filesystem::Changed'	=> $stat[10],
			'Filesystem::Blocksize'	=> $stat[11],
			'Filesystem::Blocks'	=> $stat[12],
			'Filesystem::Type'	=> $type_human,
			'Filesystem::Path'	=> $path,
			'Filesystem::Directory'	=> $fileparse[1],
			'Filesystem::Filename'	=> $filename,
			'Filesystem::Basename'	=> $fileparse[0],
			'Filesystem::Suffix'	=> ($fileparse[2] ? substr($fileparse[2],1) : ''),
			'Filesystem::Hidden'	=> $filename ne '..' && $filename =~ $regex_dotfile ? 1 : 0,
			@filesystem
		);
	}

	my @mime;
	if(!$wishlist || 'MIME' ~~ @$wishlist || "@$wishlist" =~ $regex_mime_contains){
		# print STDOUT "   ** properties:  -asks for MIME\n";
		if($type eq '-' && $fileparse[2] && $stat[7] != 0){
			my ($mediaType,$subType,$mimeDesc) = type_from_ext($fileparse[2]);
			@mime = (
				'MIME::mediaType'	=> $mediaType,
				'MIME::subType'		=> $subType,
				'MIME::Type'		=> $mediaType.'/'.$subType
			);
			push(@mime, 'MIME::Description' => $mimeDesc || 'File');
		}elsif($type eq 'd'){
			@mime = (
				'MIME::mediaType'	=> 'inode',	# this is not a standard!
				'MIME::subType'		=> 'directory',
				'MIME::Type'		=> 'inode/directory',
				'MIME::Description'	=> 'Directory'
			);
		}
	}

	## are xattr part of Filesystem or not: that's tricky: they come from Filesys
	# and yet, they usually end up in a separate namespace, as they are not part
	# of traditional stat() return-values; here, we could treat them in a separate
	# driver, but on the other side, the get/set/list xattr calls are part of the
	# FUSE and POSIX filesystem-methods sets; so for now, we combine them in this
	# Filesystem::Linux properties() method, which is able to return both namespaces
	my (@xattr,@xattr_summary);
	# only poll xattr when no $wishlist is given (so getting xattr is the default), or in case $wishlist is given, skip when xattr is omitted
	if(!$wishlist || 'Extended Attributes' ~~ @$wishlist || 'Filesystem::Xattr' ~~ @$wishlist){
		my @keys = $self->listfattr($path);
		# print STDOUT "   ** properties:  -asks for all XATTR \n";
		for my $key ( @keys ){
			next unless $key;
			push(@xattr, 'Extended Attributes::'.$key => $self->getfattr($path, $key) );
		}
		@xattr_summary = ( 'Filesystem::Xattr'	=> scalar(@keys) );
	}elsif("@$wishlist" =~ $regex_xattr_contains){
		# print STDOUT "   ** properties:  -asks for selected XATTR \n";
		my @keys = grep { /$regex_xattr/ } @$wishlist;
		s/$regex_xattr// for @keys;
		for ( @keys ){
			next unless $_;
			my $value = $self->getfattr($path, $_) or next;	# getting undef means this attrib is not there, at all
			push(@xattr, 'Extended Attributes::'.$_ => $value );
		}
	}

	$path = $self->parent($path) if $path =~ $regex_updir; # at this point it's safe to clean up the path of the parent-dir

	my %properties = (
		@filesystem,
		@xattr_summary,
		@mime,
		@xattr
	);

	return \%properties;
}

sub list {
	my ($self, $path, $wishlist) = @_;
	$path = decode('UTF-8',$path);
	utf8::upgrade( $path );

	$wishlist = undef if $wishlist && @$wishlist == 0;

	my $ok = opendir(my $dh, Cwd::abs_path($path) ); # not perfect, see http://www.perlmonks.org/?node_id=655134
	 return bless([], 'error') unless $ok;
	 my @items = readdir($dh);
	closedir($dh);

	# strings coming from filesystem are probably utf8 (although we'd better check the system's locale)
	# transfer them to perl-internal
	for(@items){
		$_ = decode('UTF-8',$_);
		utf8::upgrade( $_ );
	}

	my @richlist;
	if($wishlist && "@$wishlist" eq 'Plain'){	# we'll see what the final name for "only dir contents, no stats, nothing" will be
		for(@items){
			# not optimal: we're doing partly the same as in properties here; what we should do
			# is distinguish in properties() between Filesystem:: metadata that requires us to do
			# a stat() and metadata that can be derived simply from the dir-item name, without IO.
			# For that, we probably have to rethink our vocabulary - if we need to add a special
			# "fast-track" $wishlist keyword or if we separate Filesystem:: by adding Filesystem::Stat::
			# or something like that. Until then (as these sceleton dir-listings are used so seldomly):
			my @fileparse = File::Basename::fileparse($path,qr/\.[^.]*/);
			my $filename = ($fileparse[2] ? $fileparse[0].$fileparse[2] : $fileparse[0]);
			push(@richlist, {
				'Filesystem::Type'	=> 'inode',
				'Filesystem::Path'	=> File::Spec->catfile($path, $_),
				'Filesystem::Directory'	=> $fileparse[1],
				'Filesystem::Filename'	=> $filename,
				'Filesystem::Basename'	=> $fileparse[0],
				'Filesystem::Suffix'	=> ($fileparse[2] ? substr($fileparse[2],1) : ''),
				'Filesystem::Hidden'	=> $filename ne '..' && $filename =~ $regex_dotfile ? 1 : 0,
			});
		}
	}else{
		for(@items){
			push(@richlist, $self->properties( File::Spec->catfile($path, $_), $wishlist )  );
		}
	}

	return \@richlist;
}

sub inode_type_from_mode {
	my $mode = shift;

	my @ftype = qw(. p c ? d ? b ? - ? l ? s ? ? ?);	# learn about ftypes for example from File-Stat-ModeString
	$ftype[0] = '';

	if(wantarray){
		my $type = $ftype[($mode & 0170000)>>12];
		my $type_human;
		if($type eq '-'){	# first few ordered by probability
			$type_human = 'File';
		}elsif($type eq 'd'){
			$type_human = 'Directory';
		}elsif($type eq 'l'){
			$type_human = 'Link';
		}elsif($type eq 'p'){
			$type_human = 'FIFO';
		}elsif($type eq 'l'){
			$type_human = 'Character Device';
		}elsif($type eq 'b'){
			$type_human = 'Block Device';
		}elsif($type eq '-'){
			$type_human = 'File';
		}elsif($type eq 's'){
			$type_human = 'Socket';
		}else{
			$type_human = '?';
		}
		return ($type, $type_human);
	}else{
		return $ftype[($mode & 0170000)>>12];
	}
}

## currently uses MIME::Types, alt:
## - File::Type, nice but would need tweaks to handle filehandles (which we need for remote objects etc)
## - Media::Type::Simple allows an extension of the internal db
my $videosuffixes = qr/\.avi$|\.mpeg$|\.mpg$|\.m2v$|\.asf$|\.wmv$|\.mov$|\.rm$|\.flv$|\.ogg$|\.mkv$|\.mp4$|\.h264|\.webm|\.on2|\.3gp$|\.3g2$|\.mxf$|\.m2t$|\.vob$/i;
my $imagesuffixes = qr/\.ani$|\.cr2$|\.gif$|\.jls$|\.jpeg$|\.jpg$|\.thm$|\.jp2$|\.jpe$|\.jpx$|\.png$|\.pcx$|\.pnm$|\.tif$|\.pbm$|\.pgm$|\.pnm$|\.psd$|\.ppd$|\.ppm$|\.bmp$|\.xbm$|\.xpm$|\.rle$|\.tga$|\.tif$|\.iff$|\.ico$|\.cur$|\.raw$|\.dcr$/i;
my $audiosuffixes = qr/\.wav$|\.aiff$|\.mp3$|\.ogg$|\.mka$|\.flac$|\.aac$|\.mid$|\.mpa$|\.au$|\.ram$|\.smp$|\.ape$|\.gsm$/i;
my $textsuffixes  = qr/\.txt$|\.py$|\.pl$|\.mk$|\.pod$/i;
my $mt = MIME::Types->new;
my $regex_dot_first = qr/^\./;
sub type_from_ext {
	my $suffix = shift;
	my $ext = $suffix =~ $regex_dot_first ? substr($suffix,1) : $suffix;

	my ($mediaType,$subType,$mimeDesc) = ('unknown','unknown','');

	if($mediaType = $mt->mimeTypeOf($suffix)){
		($mediaType,$subType) = split(/\//,$mediaType,2);
	}else{
		if($suffix =~ $videosuffixes){
			$mediaType = 'video';
		}elsif($suffix =~ $imagesuffixes){
			$mediaType = 'image';
		}elsif($suffix =~ $audiosuffixes){
			$mediaType = 'audio';
		}elsif($suffix =~ $textsuffixes){
			$mediaType = 'text';
		}else{
			$mediaType = 'unknown'; # mediaType might have been reset by mimeTypeOf call above
		}
	}

	$ext = lc($ext);
	if(defined($Wrangler::FileSystem::Layers::exts{$ext})){
		if( ref($Wrangler::FileSystem::Layers::exts{$ext}) ){
			$mimeDesc = $Wrangler::FileSystem::Layers::exts{$ext}->[0];
			($mediaType,$subType) = split(/\//,$Wrangler::FileSystem::Layers::exts{$ext}->[1],2);
		}else{
			$mimeDesc = $Wrangler::FileSystem::Layers::exts{$ext};
		}
	}else{
		if($mediaType eq 'audio'){
			$mimeDesc = uc($ext) .'-'.'Audiofile';
		}elsif($mediaType eq 'image'){
			$mimeDesc = uc($ext) .'-'.'Imagefile';
		}elsif($mediaType eq 'video'){
			$mimeDesc = uc($ext) .'-'.'Videofile';
		}else{
			$mimeDesc = uc($ext) .'-'. 'File';
		}
	}

	return ($mediaType,$subType,$mimeDesc);
}

##

sub mount {
	my ($self, %cfg) = @_;

	$self->{driveletter}	= undef;		# nothing as a driveletter on *nix
	$self->{username}	= $cfg{username};
	$self->{password}	= $cfg{password};
}

sub parent {
	shift(@_);
	return Cwd::abs_path( $_[0] ) if $_[0] =~ $regex_updir;
	return Cwd::abs_path( File::Spec->catfile($_[0],'..') ); # see note on abs_path in list()
}

## these low level tests should probably all return a warning: "use 'properties()' instead!"
sub test {
	my ($self, $test, $path) = @_;

	# $path =~ s/'/\\'/g;
	# $test =~ s/^(.)/$1/;

	my $ret = eval("-$test '$path'");
	return ($@) ? undef : $ret;
}
sub stat {
	my ($self, $path) = @_;
				
	# $path =~ s/\s+/ /g;
	# $path = $self->_path_from_root($path);

	return CORE::stat($path);
}
sub lstat {
	my ($self, $path) = @_;
				
	# $path =~ s/\s+/ /g;
	# $path = $self->_path_from_root($path);

	return CORE::lstat($path);
}

sub symlink {
	my ($self, $old, $new) = @_;
	# $dir = $self->_path_from_root($dir);
	# print STDOUT " Linux::symlink(@_) \n";

	return CORE::symlink($old, $new);
}

sub mknod {
	# note: could be replace with Unix::Mknod
	# todo: does not use mode/dev
#	my $result = open(my $fh,'>', $_[0]);
#	close($fh);
	my $self = shift;
	# print "mknod(@_)\n";
	return 0 if -e $_[0];
	my $result = system('touch',@_); # return 0 on success, -1 or similar on error
	return $result == 0 ? 1 : 0;	 # mknod returns 1 on success
}

sub delete {
	my ($self, $path) = @_;
	# $path = $self->_path_from_root($path);
	# print "mknod(@_)\n";
	return ((-e $path) && (!-d $path) && (CORE::unlink($path))) ? 1 : 0;
}

sub mkdir {
	my ($self, $dir) = @_;
	# $dir = $self->_path_from_root($dir);

	return 2 if (-d $dir);
	
	return CORE::mkdir($dir);
}

sub rmdir {
	my ($self, $path, $recursive) = @_;

	if (-e $path) {
		if (-d $path) {
			if($recursive){
				# todo: support for recycle bin!
				return 1 if (File::Path::rmtree($path));
			}else{
				return 1 if (CORE::rmdir($path));
			}
		}
		## Filesys::Virtual optionally does a file unlink, we won't
	}

	return 0;
}

# move a file/dir to undo'able trash can
# see also: File::Trash::FreeDesktop, File::Trash::Undoable, File::Remove 
sub trash {
	my $self = shift;

	# don't allow empty values in list of supplied paths, because gvfs-trash would accept that as "current dir"
	for(@_){ return 0 if $_ eq ''; }

	my $result = system('gvfs-trash', @_); # return 0 on success, -1 or similar on error
	# print "trash(@_): $result\n";
	return $result == 0 ? 1 : 0;	 # mknod returns 1 on success
}

sub rename {
	my ($self, $path, $new) = @_;
	# print "rename(@_)\n";
	## todo: check if this is a 'rename' or a 'move' across filesystem boundaries
	return CORE::rename($path,$new);
}

sub move {
	my $self = shift;
	# print "move(@_)\n";
	return 0 if !-e $_[0];
	my $result = system('mv',@_);	# return 0 on success, -1 or similar on error
	return $result == 0 ? 1 : 0;	# move returns 1 on success
}

sub copy {
	my $self = shift;
	# print "copy(@_)\n";
	return 0 if !-e $_[0];
	my $result = system('cp','-R',@_); # return 0 on success, -1 or similar on error
	return $result == 0 ? 1 : 0;	 # copy returns 1 on success
}

sub utime {
	my ($self, $atime, $mtime, @path) = @_;

#	foreach my $i ( 0 .. $#path ) {
#		$path[$i] = $self->_path_from_root($path[$i]);
#	}
	
	return CORE::utime($atime, $mtime, @path);
}

sub listfattr {
	my ($self, $path) = @_;

	my @attr_list = File::ExtAttr::listfattr($path);

	# more recent WxWidgets expect decoded/Perl-internal'ed strings
	# Mark's note: http://grokbase.com/t/perl/wxperl-users/134pn2zyr7/can-we-print-utf-8-chars-in-wx-textctrl-fields#20130429gjrtttc5l3q6zxegl7hgngxwwa
	for(@attr_list){
		# we keep values in Perl-internal
		utf8::upgrade( $_ );
	}

	return @attr_list;
}

sub getfattr {
	my ($self, $path, $key) = @_;

	# we return values from the 'user.' namespace only, for now (and we omit the 'user.' prefix in keys)
	my $value = File::ExtAttr::getfattr($path, $key, { namespace => 'user' });

	# xattr are encoding agnostic, means they simply store bytes.
	# It's on us to store it in a useful encoding: we decide for utf-8
	if( defined($value) ){
		$value = decode('utf-8', $value);
		utf8::upgrade($value);	# Mark's note: http://grokbase.com/t/perl/wxperl-users/134pn2zyr7/can-we-print-utf-8-chars-in-wx-textctrl-fields#20130429gjrtttc5l3q6zxegl7hgngxwwa
	}

	# more recent WxWidgets expect decoded/Perl-internal'ed strings
#	return $value ? decode_utf8($value) : $value; # test for undef
	return $value;
}

sub setfattr {
	my ($self, $path, $key, $value) = @_;

	# It's on us to store it in a useful encoding: we decide for utf-8
	File::ExtAttr::setfattr($path, encode('utf-8',$key), encode('utf-8',$value), { namespace => 'user' });
#	File::ExtAttr::setfattr($path, $key, $value, { namespace => 'user' });
}

sub delfattr {
	my ($self, $path, $key) = @_;

	File::ExtAttr::delfattr($path, encode('utf-8',$key), { namespace => 'user' });
}

1;