Data-IconText
view release on metacpan or search on metacpan
lib/Data/IconText.pm view on Meta::CPAN
use v5.20;
use strict;
use warnings;
use Carp;
use Scalar::Util qw(looks_like_number weaken);
use Data::Identifier v0.12;
use constant {
WK_UNICODE_CP => Data::Identifier->new(uuid => '5f167223-cc9c-4b2f-9928-9fe1b253b560')->register, # unicode-code-point
WK_ASCII_CP => Data::Identifier->new(uuid => 'f4b073ff-0b53-4034-b4e4-4affe5caf72c')->register, # ascii-code-point
WK_FREEDESKTOP_ICON_NAME => Data::Identifier->new(uuid => '560906df-ebd1-41f6-b510-038b30522051')->register, # freedesktop-icon-name
};
use overload '""' => sub {$_[0]->as_string};
our $VERSION = v0.03;
my %_types = (
db => 'Data::TagDB',
extractor => 'Data::URIID',
fii => 'File::Information',
store => 'File::FStore',
);
my %_for_version = (
v0.01 => {
default_unicode => 0x2370, # U+2370 APL FUNCTIONAL SYMBOL QUAD QUESTION
media_type => {
text => 0x270D,
audio => 0x266B,
video => 0x2707,
image => 0x1F5BB,
},
media_subtype => {
'application/pdf' => 0x1F5BA,
'application/vnd.oasis.opendocument.text' => 0x1F5CE,
},
lib/Data/IconText.pm view on Meta::CPAN
);
sub new {
my ($pkg, %opts) = @_;
my $self = bless {for_version => (delete($opts{for_version}) // $VERSION)}, $pkg;
my $for_version_info = $self->_find_for_version_info;
my @mimetypes;
if (defined(my $unicode = delete $opts{unicode})) {
if (looks_like_number($unicode)) {
$self->{unicode} //= int($unicode);
} elsif ($unicode =~ /^U\+([0-9a-fA-F]{4,7})$/) {
$self->{unicode} //= hex($1);
} elsif (scalar(eval {$unicode->isa('Data::Identifier')}) && $unicode->type->eq(WK_UNICODE_CP) && $unicode->id =~ /^U\+([0-9a-fA-F]{4,7})$/) { # XXX: Experimental!
$self->{unicode} //= hex($1);
} else {
croak 'Passed unicode value is in wrong format';
}
}
if (defined(my $raw = delete $opts{raw})) {
croak 'Raw has wrong length' unless length($raw) == 1;
$self->{unicode} //= ord($raw);
}
if (defined(my $from = delete $opts{from})) {
my $type;
my $id;
unless (eval {$from->isa('Data::Identifier')}) {
$from = Data::Identifier->new(from => $from);
}
$type = $from->type;
$id = $from->id // croak 'Bad identifier';
if ($type->eq(WK_UNICODE_CP) && $id =~ /^U\+([0-9a-fA-F]{4,7})$/) {
$self->{unicode} //= hex($1);
} elsif ($type->eq(WK_ASCII_CP) && int($id) >= 0 && int($id) <= 127) {
$self->{unicode} //= int($id);
}
}
if (defined(my $for = delete $opts{for})) {
state $running = undef;
unless ($running) {
local $@ = undef;
unless (ref $for) {
$for = Data::Identifier->new(from => $for);
}
if (defined(my $table = $for_version_info->{identifier}{$for->type->uuid})) {
$self->{unicode} //= $table->{$for->id};
}
if (!defined($self->{unicode}) && $for->type->eq(WK_FREEDESKTOP_ICON_NAME)) {
if ($for->id =~ /^flag-([a-z]{2})$/) {
$opts{flag} //= $1;
}
}
unless (defined $self->{unicode}) {
state $sid_forceloaded;
if (!$sid_forceloaded && defined(my $sid = $for->sid(default => undef))) {
unless (defined($for->uuid(default => undef))) {
require Data::Identifier::Wellknown;
Data::Identifier::Wellknown->import(':all');
$for = Data::Identifier->new($for->type => $for->id);
$sid_forceloaded = 1;
}
}
foreach my $type (keys %_idtype_to_uuid) {
my $v = $for->as($type, default => undef) // next;
if (defined(my $table = $for_version_info->{identifier}{$_idtype_to_uuid{$type}})) {
$self->{unicode} //= $table->{$v};
}
last if defined $self->{unicode};
}
}
$running = 1;
eval {
if ($for->isa('Data::URIID::Base') && !$for->isa('Data::URIID::Result')) {
$for = $for->as('Data::Identifier');
}
if ($for->isa('Data::Identifier')) {
lib/Data/IconText.pm view on Meta::CPAN
unless (defined($opts{special})) {
$type = $for->get('tagpool_inode_type', default => undef, as => 'uuid');
$type //= eval { $for->inode->get('tagpool_inode_type', default => undef, as => 'uuid') };
$opts{special} //= $_type_to_special{$type} if defined $type;
}
} elsif ($for->isa('Data::TagDB::Tag')) {
require Encode;
my $icontext = $for->icontext(default => undef);
$self->{unicode} //= ord(Encode::decode('UTF-8' => $icontext)) if defined $icontext;
} elsif ($for->isa('Data::URIID::Result')) {
my $icontext = $for->attribute('icon_text', default => undef);
$self->{unicode} //= ord($icontext) if defined $icontext;
} elsif ($for->isa('Data::Identifier')) {
# no-op, handled above.
} else {
croak 'Invalid object passed for "for"';
}
};
$running = undef;
die $@ if $@;
}
}
if (defined(my $flag = delete $opts{flag})) {
if ($flag =~ /^[a-zA-Z]{2}$/) {
$self->{unicode} = [map {0x1F1E6 - 0x61 + ord} split //, lc $flag];
#} elsif ($flag =~ /^[a-zA-Z]+$/) {
#$self->{unicode} = [0x1F3F4, (map {0xE0061 - 0x61 + ord} split //, lc $flag), 0xE007F];
#warn join(' ', map {sprintf('U+%04X', $_)} @{$self->{unicode}});
} else {
croak 'Invalid format for flag';
}
}
{
my $v;
push(@mimetypes, $v) if defined($v = delete($opts{mediasubtype}));
push(@mimetypes, $v.'/*') if defined($v = delete($opts{mediatype}));
push(@mimetypes, $v) if defined($v = delete($opts{mimetype}));
foreach my $mimetype (@mimetypes) {
$mimetype = lc($mimetype);
$self->{unicode} //= $for_version_info->{media_subtype}{$mimetype};
$self->{unicode} //= $for_version_info->{media_type}{$1} if $mimetype =~ m#^([a-z]+)/#;
last if defined $self->{unicode};
}
}
if (defined(my $special = delete $opts{special})) {
$self->{unicode} //= $for_version_info->{special}{$special =~ s/-/_/gr};
}
if (delete $opts{no_defaults}) {
return undef unless defined $self->{unicode};
} else {
$self->{unicode} //= $for_version_info->{default_unicode};
}
# Attach subobjects:
$self->attach(map {$_ => delete $opts{$_}} keys(%_types), 'weak');
croak 'Stray options passed' if scalar keys %opts;
return $self;
}
sub unicode {
my ($self, @args) = @_;
croak 'Stray options passed' if scalar @args;
croak 'Bad object' if ref $self->{unicode};
return $self->{unicode};
}
sub as_string {
my ($self, @args) = @_;
my $unicode = $self->{unicode};
croak 'Stray options passed' if scalar @args;
if (ref $unicode) {
return join '' => map{chr} @{$unicode};
} else {
return chr($unicode);
}
}
sub for_version {
my ($self, @args) = @_;
croak 'Stray options passed' if scalar @args;
return $self->{for_version};
}
sub as {
my ($self, $as, %opts) = @_;
require Data::Identifier::Generate;
$self->{identifier} //= Data::Identifier::Generate->unicode_character(unicode => $self->unicode);
$opts{$_} //= $self->{$_} foreach keys %_types;
return $self->{identifier}->as($as, %opts);
}
sub ise {
my ($self, %opts) = @_;
lib/Data/IconText.pm view on Meta::CPAN
=head1 SYNOPSIS
use Data::IconText;
Allows icon text (single character text icons) to be handled in a nice way.
=head1 METHODS
=head2 new
my Data::IconText $icontext = Data::IconText->new(unicode => 0x1F981);
# or:
my Data::IconText $icontext = Data::IconText->new(raw => 'X');
Creates a new icon text object.
The icon text is tried to calculate from the options in the following order (first one wins):
C<unicode>, C<raw>, C<from>, C<for>, C<flag>, C<mediasubtype>, C<mediatype>, C<mimetype>, C<special>.
If none is found a fallback is used.
The following options are supported.
=over
=item C<unicode>
The unicode value (e.g. C<0x1F981>). May also be a string in standard format (e.g. C<'U+1F981'>).
=item C<raw>
The character as a raw perl string. Must be exactly one character long.
=item C<from>
Another object that represents the character.
If the object passed is not a L<Data::Identifier> it is passed via L<Data::Identifier/new> with C<from>.
Currently only identifiers of type unicode code point or ascii code point are supported.
See also:
L<Data::Identifier::Generate/unicode_character>.
=item C<flag>
A flag for a two letter country code (ISO 3166-1 alpha-2 codes).
=item C<for>
An object to find the icon text for.
Currently supported are objects of the following packages:
L<File::FStore::File>,
lib/Data/IconText.pm view on Meta::CPAN
A L<File::FStore> object.
=item C<weak>
Marks the value for all subobjects as weak.
If only a specific one needs needs to be weaken use L</attach>.
=back
=head2 unicode
my $unicode = $icontext->unicode;
This returns the numeric unicode value (e.g. 0x1F981) of the icon text.
If there is no single value associated with the icon text, this method C<die>s.
=head2 as_string
my $str = $icontext->as_string;
Gets the icon text as a perl string.
=head2 for_version
t/02_base.t view on Meta::CPAN
use strict;
use warnings;
use v5.10;
use lib 'lib', '../lib'; # able to run prove in project dir and .t locally
use Test::More tests => 5;
use_ok('Data::IconText');
my $icontext = Data::IconText->new(unicode => 0x1F981);
isa_ok($icontext, 'Data::IconText');
is($icontext->unicode, 0x1F981);
is(length($icontext->as_string), 1);
ok(defined($icontext->ise));
exit 0;
( run in 0.246 second using v1.01-cache-2.11-cpan-f29a10751f0 )