Data-IconText

 view release on metacpan or  search on metacpan

lib/Data/IconText.pm  view on Meta::CPAN

# Copyright (c) 2025 Philipp Schafft

# licensed under Artistic License 2.0 (see LICENSE file)

# ABSTRACT: Work with icon text

package Data::IconText;

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.05;

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,
        },
        special => {
            directory           => 0x1F5C0,
            parent_directory    => 0x2B11,
            regular             => 0x2299,
            regular_not_in_pool => 0x2298,
        },
        identifier => {},
    },
    v0.02 => {
        parent => v0.01,
        identifier => {
            '8be115d2-dc2f-4a98-91e1-a6e3075cbc31' => { # uuid
                '3c2c155f-a4a0-49f3-bdaf-7f61d25c6b8c' => 0x1F30D,  # sid:60    Earth
                '7b177183-083c-4387-abd3-8793eb647373' => 0x21E5,   #           write-mode@none
                '4dc9fd07-7ef3-4215-8874-31d78ed55c22' => 0x21A3,   #           write-mode@append only
                '3877b2ef-6c77-423f-b15f-76508fbd48ed' => 0x21A6,   #           write-mode@random access
                'bccdaf71-0c82-422e-af44-bb8396bf90ed' => 0x1F331,  # sid:92    plant
                '0a24c834-90bd-4abd-ad97-4bd3ca7e784a' => 0x1F332,  #           conifer
                '85061c8c-be7a-4171-a008-f2035a4b8b61' => 0x1F333,  #           broadleaf
                'eba923c3-a425-425d-80ab-0064258d108a' => 0x1F334,  #           palm
                '571fe2aa-95f6-4b16-a8d2-1ff4f78bdad1' => 0x1F981,  # sid:82    lion
                '3694d8ca-c969-5705-beca-01f17b1487e8' => 0x2642,   #           gender@male
                'ae1072ef-0865-5104-b257-0d45441fa5e5' => 0x2642,   #           sex@male
                'd642eff3-bee6-5d09-aea9-7c47b181dd83' => 0x2642,   # sid:75    gender-or-sex@male
                '25dfeb8e-ef9a-52a1-b5f1-073387734988' => 0x2640,   #           gender@female
                '3c4b6cdf-f5a8-50d6-8a3a-b0c0975f7e69' => 0x2640,   #           sex@female
                'db9b0db1-a451-59e8-aa3b-9994e683ded3' => 0x2640,   # sid:76    gender-or-sex@female
                '310f2b49-73a8-5f27-aeaf-5f34bc8e583f' => 0x26A5,   #           gender@herm

lib/Data/IconText.pm  view on Meta::CPAN


    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) = @_;

    return ($self->{identifier} // $self->as('Data::Identifier'))->ise(%opts);
}


sub attach {
    my ($self, %opts) = @_;
    my $weak = delete $opts{weak};

    foreach my $key (keys %_types) {
        my $v = delete $opts{$key};
        next unless defined $v;
        croak 'Invalid type for key: '.$key unless eval {$v->isa($_types{$key})};
        $self->{$key} //= $v;
        croak 'Missmatch for key: '.$key unless $self->{$key} == $v;
        weaken($self->{$key}) if $weak;
    }

    croak 'Stray options passed' if scalar keys %opts;

    return $self;
}

# ---- Private helpers ----
sub _find_for_version_info {
    my ($self) = @_;
    my $for_version = $self->for_version;
    my $ret = $_for_version{$for_version};

    return $ret if defined $ret;

    if ($for_version le $VERSION) {
        foreach my $version (sort {$b cmp $a} keys %_for_version) {
            return $_for_version{$version} if $version le $for_version;
        }
    }

    croak 'Unsupported version given: '.sprintf("v%u.%u", unpack("cc", $for_version));
}

sub _merge {
    my ($d, $s, $dkey, $skey) = @_;

    $skey //= $dkey;

    if (exists $d->{$dkey}) {
        my $nd = $d->{$dkey};
        my $ns = $s->{$skey};

        foreach my $key (keys %{$ns}) {
            if (exists $nd->{$key}) {
                _merge($nd, $ns, $key);
            } else {
                $nd->{$key} = $ns->{$key};
            }
        }
    } else {
        $d->{$dkey} = $s->{$skey};
    }
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Data::IconText - Work with icon text

=head1 VERSION

version v0.05

lib/Data/IconText.pm  view on Meta::CPAN

If a L<Data::Identifier> is passed, a lookup is performed using the passed subobjects.

If the value passed has a I<small-identifier> but no I<uuid> a force load of L<Data::Identifier::Wellknown> with C<:all> may happen.
This can be be avoided by ensuring all objects that have a I<small-identifier> set also have a I<uuid> set.

=item C<mediasubtype>

The media subtype (e.g. C<audio/flac>). Only values assigned by IANA are valid.

=item C<mediatype>

The media type (e.g. C<audio>). Only values assigned by IANA are valid.

=item C<mimetype>

A low quality value that I<looks like> a mediasubtype (e.g. provided via HTTP's C<Content-type> or by type guessing modules).

=item C<special>

One of: C<directory>, C<parent-directory>, C<regular>, C<regular-not-in-pool>.

=item C<for_version>

The version of this module to use the rules for calculation of the icon text from.
Defaults to the current version of this module.
If a given version is not supported, this method C<die>s.

B<Note:>
This option alters only the rules for finding an icon text for a B<valid> input.
If an input is invalid but was erroneously accepted in an earlier version newer versions may still C<die> or behave differently.

=item C<no_defaults>

If set true and no match was found return C<undef> instead of the default character.

=back

Additionally subobjects can be attached:

=over

=item C<db>

A L<Data::TagDB> object.

=item C<extractor>

A L<Data::URIID> object.

=item C<fii>

A L<File::Information> object.

=item C<store>

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

    my $version = $icontext->for_version;

The version of this module from which the rules where used.

=head2 as

    my $xxx = $icontext->as($as, %opts);

This is a proxy for L<Data::Identifier/as>.

This method automatically adds all attached subobjects (if not given via C<%opts>).

=head2 ise

    my $ise = $icontext->ise(%opts);

THis is a proxy for L<Data::Identifier/ise>.

=head2 attach

    $icontext->attach(key => $obj, ...);
    # or:
    $icontext->attach(key => $obj, ..., weak => 1);

Attaches objects of the given type.
Takes the same list of objects as L</new>.

If an object is allready attached for the given key this method C<die>s unless the object is actually the same.

If C<weak> is set to a true value the object reference becomes weak.

Returns itself.

=head1 AUTHOR

Philipp Schafft <lion@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is Copyright (c) 2025 by Philipp Schafft <lion@cpan.org>.

This is free software, licensed under:



( run in 0.486 second using v1.01-cache-2.11-cpan-39bf76dae61 )