use Fcntl qw(O_RDONLY O_NOFOLLOW SEEK_SET);our $VERSION = v0.08;
my $HAVE_URI_FILE = eval {require URI::file; 1;};my $HAVE_DIGEST = eval {require Digest; 1;};my %_dot_comments_rating = (
0 => '06813a68-06f2-5d42-b230-28445e5f5dc1',
1 => '4b31eb8c-546a-578b-83bb-e5d6e6a53263',
2 => 'bb986cde-9f2e-5c1d-9f56-cb3fa019077d',
3 => 'c7ea5002-eed0-58f6-9707-edfd673c6e02',
4 => 'a0e425a4-a447-5b54-bafc-46ea54eb9d55',
5 => '14c1ebe1-9901-534d-b837-ea22cba1adfe',
);
my %_properties = (
link_basename => {loader => \&_load_basename},
link_basename_clean => {loader => \&_load_basename},
link_basename_boring=> {loader => \&_load_basename, rawtype => 'bool'},
link_dotfile => {loader => \&_load_basename, rawtype => 'bool'},
);
if ($HAVE_XML_SIMPLE) {
$_properties{'dotcomments_'.$_} = {loader => \&_load_dotcomments, dotcomments_key => $_} foreach qw(version note place time_v2_0 time_v3_0 keywords caption rating categories);
$_properties{dotcomments_time_v2_0}{rawtype} = 'unixts';
}
if ($HAVE_URI_FILE && $HAVE_DIGEST) {
$_properties{link_thumbnail} = {loader => \&_load_thumbnail, rawtype => 'filename'};
}
{
while (my ($key, $value) = each %_dot_comments_rating) {
Data::Identifier->new(uuid => $value, displayname => $key)->register;
}
}
sub _new {
my ($pkg, %opts) = @_;
my $self = $pkg->SUPER::_new(%opts, properties => \%_properties);
croak 'No path is given' unless defined $self->{path};
return $self;
}
sub inode {
my ($self) = @_;
unless (defined $self->{inode}) {
my $fh;
my $mode = 0;
if (($self->{symlinks} // '') ne 'follow') {
$mode |= O_NOFOLLOW;
}
sysopen($fh, $self->{path}, O_RDONLY|$mode) or opendir($fh, $self->{path}) or die $!;
$self->{inode} = File::Information::Inode->_new(
(map {$_ => $self->{$_}} qw(instance path)),
handle => $fh,
);
}
return $self->{inode} // croak 'No Inode';
}
sub deep {
my ($self, %opts) = @_;
return $self->{deep} if defined $self->{deep};
return $opts{default} if exists $opts{no_defaults};
return $self->{deep} = File::Information::Deep->_new(instance => $self->instance, path => $self->{path}, parent => $self);
}
sub filesystem {
my ($self, @args) = @_;
return $self->{filesystem} //= $self->inode->filesystem(@args);
}
sub tagpool {
my ($self, @args) = @_;
return $self->inode->tagpool(@args);
}
sub _load_dotcomments {
my ($self, $key) = @_;
unless ($self->{_loaded_dotcomments}) {
my $info = $self->{properties}{$key};
my $pv = ($self->{properties_values} //= {})->{current} //= {};
my ($volume, $directories, $file) = File::Spec->splitpath($self->{path});
my $comments_file = File::Spec->catfile($volume, $directories, '.comments', $file.'.xml');
my $xml;
$self->{_loaded_dotcomments} = 1;
return unless -f $comments_file;
croak 'Not supported, requires XML::Simple' unless $HAVE_XML_SIMPLE;
eval {
my $magic;
my $fh;
open($fh, '<', $comments_file) or die $!;
binmode($fh);
read($fh, $magic, 2);
seek($fh, 0, SEEK_SET);
if ($magic eq "\x1f\x8b") {
binmode($fh, ':gzip');
}
$xml = XML::Simple::XMLin($fh);
};
croak 'No valid .comments/ XML at: '.$comments_file unless defined $xml;
foreach my $key (qw(version note place caption keywords)) {
my $value = $xml->{$key} // $xml->{ucfirst $key};
if (defined($value) && !ref($value) && length($value)) {
$pv->{'dotcomments_'.$key} = {raw => $value};
}
}
{
my $value = $xml->{time} // $xml->{Time};
if (defined($value)) {
if ($xml->{version} eq '2.0') {
if (!ref($value) && $value =~ /^[0-9][1-9]+$/ && int($value)) {
$pv->{dotcomments_time_v2_0} = {raw => int($value)};
}
} elsif ($xml->{version} eq '3.0') {
if (ref($value) && defined($value->{value}) && !ref($value->{value}) && $value->{value} =~ /^[0-9]{4}:[0-9]{2}:[0-9]{2} [0-9]{2}:[0-9]{2}:[0-9]{2}$/) {
$pv->{dotcomments_time_v3_0} = {raw => $value->{value}};
}
}
}
}
{
my $value = $xml->{rating} // $xml->{Rating};
if (defined($value) && ref($value) && defined($value->{value}) && !ref($value->{value}) && $value->{value} =~ /^[1-5]$/) {
$pv->{dotcomments_rating} = {raw => int($value->{value})};
$pv->{dotcomments_rating}{uuid} = $_dot_comments_rating{$value->{value}} if defined $_dot_comments_rating{$value->{value}}
}
}
{
my $value = $xml->{categories} // $xml->{Categories};
my @list;
if (defined($value) && ref($value) && defined($value->{category}) && ref($value->{category})) {
$value = $value->{category};
if (ref($value)) {
foreach my $entry (@{$value}) {
if (ref($entry) && defined($entry->{value}) && length($entry->{value})) {
push(@list, {raw => $entry->{value}});
}
}
}
}
if (defined($pv->{dotcomments_keywords}) && defined($pv->{dotcomments_keywords}{raw})) {
push(@list, map {{raw => $_}} grep {length} split(/\s*,\s*/, $pv->{dotcomments_keywords}{raw}));
}
foreach my $entry (@list) {
$entry->{'Data::Identifier'} = Data::Identifier::Generate->generic(
displayname => $entry->{raw},
request => $entry->{raw},
style => 'name-based',
namespace => 'eb239013-7556-4091-959f-4d78ca826757',
);
}
$pv->{dotcomments_categories} = \@list;
}
}
}
sub _load_basename {
my ($self) = @_;
my $basename = File::Basename::basename($self->{path});
my $pv = ($self->{properties_values} //= {})->{current} //= {};
my $boring_extension = $self->instance->{boring_extension};
my $boring;
$pv->{link_basename} = {raw => $basename};
$pv->{link_dotfile} = {raw => !!($basename =~ /^\./)};
$boring ||= $basename =~ /thumb/i;
$boring ||= $basename =~ /[\~\
if ($basename =~ /\.([^\.]+)$/) {
$boring ||= $boring_extension->{fc($1)};
}
$pv->{link_basename_boring} = {raw => $boring};
$basename =~ s/(.)(?:\.tar)?\.[^\.]+$/$1/;
$basename =~ s/^[a-z]+\.[0-9a-f]{8}-(?:[0-9a-f]{4}-){3}[0-9a-f]{12}\.(.)/$1/;
$pv->{link_basename_clean} = {raw => $basename};
}
sub _load_thumbnail {
my ($self) = @_;
unless ($self->{_loaded_thumbnail}) {
my $instance = $self->instance;
my $pv = ($self->{properties_values} //= {})->{current} //= {};
my $uri = URI::file->new_abs($self->{path});
my $digest = Digest->new('MD5')->add($uri)->hexdigest;
my $mtime = $self->inode->get('st_mtime', default => undef);
$self->{_loaded_thumbnail} = 1;
return unless defined $mtime;
foreach my $size (qw(normal large x-large xx-large)) {
my $file = $instance->_path(XDG_CACHE_HOME => file => thumbnails => $size => $digest.'.png');
my @stat = stat($file);
if (scalar(@stat)) {
if ($mtime < $stat[9]) {
$pv->{link_thumbnail} = {raw => $file};
return;
}
}
}
}
}
1;