From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

LION / Data-URIID-v0.13 / lib / Data / URIID / Colour.pm 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
—
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135

              
# Copyright (c) 2023-2024 Löwenfelsen UG (haftungsbeschränkt)
# Copyright (c) 2023-2024 Philipp Schafft
# licensed under Artistic License 2.0 (see LICENSE file)
# ABSTRACT: Extractor for identifiers from URIs
package Data::URIID::Colour;
use strict;
use warnings;
use overload '""' => \&rgb;
use Carp;
use UUID::Tiny ':std';
use Scalar::Util qw(weaken);
our $VERSION = v0.13;
use parent 'Data::URIID::Base';
sub new {
    my ($pkg, %opts) = @_;
    die 'No RGB value given' unless defined $opts{rgb};
    $opts{rgb} = uc($opts{rgb});
    $opts{rgb} =~ /^#[0-9A-F]{6}$/ or die 'Bad format';
    weaken($opts{extractor});
    return bless \%opts, $pkg;
}
sub rgb {
    my ($self) = @_;
    return $self->{rgb} // croak 'No RGB value';
}
# --- Overrides for Data::URIID::Base ---
sub ise {
    my ($self, %opts) = @_;
    unless (defined $self->{ise}) {
        my $req = lc($self->rgb);
        $req = sprintf('#%s%s%s', $1 x 6, $2 x 6, $3 x 6) if $req =~ /^#([a-f0-9]{2})([a-f0-9]{2})([a-f0-9]{2})$/;
        if ($req =~ /^#[a-f0-9]{36}$/) {
            $self->{ise} = create_uuid_as_string(UUID_SHA1, '88d3944f-a13b-4e35-89eb-e3c1fbe53e76', $req);
        } else {
            croak 'Bad format for colour';
        }
    }
    return $self->SUPER::ise(%opts);
}
sub displayname {
    my ($self, %opts) = @_;
    return $self->SUPER::displayname(%opts, _fallback => $self->rgb);
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Data::URIID::Colour - Extractor for identifiers from URIs
=head1 VERSION
version v0.13
=head1 SYNOPSIS
    use Data::URIID::Colour;
    my $colour = Data::URIID::Colour->new(rgb => '#FF0000');
This module represents a single colour.
This package inherits from L<Data::URIID::Base>.
=head1 METHODS
=head2 new
    my $colour = Data::URIID::Colour->new( option => value, ... );
Returns a new object for the given colour.
The following options are defined:
=over
=item C<rgb>
The RGB value in hex notation. E.g. C<#FF0000>.
=item C<extractor>
optionally, an instance of L<Data::URIID>.
=back
=head2 rgb
    my $rgb = $colour->rgb;
Returns the colour in six digit hex notation with prepended pound (C<#>) if successful or C<die> otherwise.
The returned value is suitable for use in CSS.
=head1 AUTHOR
Löwenfelsen UG (haftungsbeschränkt) <support@loewenfelsen.net>
=head1 COPYRIGHT AND LICENSE
This software is Copyright (c) 2023-2025 by Löwenfelsen UG (haftungsbeschränkt) <support@loewenfelsen.net>.
This is free software, licensed under:
  The Artistic License 2.0 (GPL Compatible)
=cut