File Coverage

blib/lib/Convert/Color/X11.pm
Criterion Covered Total %
statement 17 38 44.7
branch 3 18 16.6
condition n/a
subroutine 6 8 75.0
pod 3 3 100.0
total 29 67 43.2


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2009-2022 -- leonerd@leonerd.org.uk
5              
6             package Convert::Color::X11 0.14;
7              
8 11     11   66412 use v5.14;
  11         45  
9 11     11   60 use warnings;
  11         20  
  11         385  
10 11     11   64 use base qw( Convert::Color::RGB8 );
  11         35  
  11         1639  
11              
12             __PACKAGE__->register_color_space( 'x11' );
13              
14 11     11   77 use Carp;
  11         35  
  11         6489  
15              
16             # Different systems put it in different places. We'll try all of them taking
17             # the first we find
18              
19             our @RGB_TXT = (
20             '/etc/X11/rgb.txt',
21             '/usr/share/X11/rgb.txt',
22             '/usr/X11R6/lib/X11/rgb.txt',
23             '/usr/X11R6/share/X11/rgb.txt',
24             );
25              
26             =head1 NAME
27              
28             C - named lookup of colors from X11's F
29              
30             =head1 SYNOPSIS
31              
32             Directly:
33              
34             use Convert::Color::X11;
35              
36             my $red = Convert::Color::X11->new( 'red' );
37              
38             Via L:
39              
40             use Convert::Color;
41              
42             my $cyan = Convert::Color->new( 'x11:cyan' );
43              
44             =head1 DESCRIPTION
45              
46             This subclass of L provides lookup of color names
47             provided by X11's F file.
48              
49             =cut
50              
51             my @x11_color_names; # To preserve order
52             my $x11_colors;
53              
54             sub _load_x11_colors
55             {
56 1     1   2 my $rgbtxt;
57              
58 1         3 foreach ( @RGB_TXT ) {
59 4 50       121 -f $_ or next;
60              
61 0 0       0 open( $rgbtxt, "<", $_ ) or die "Cannot read $_ - $!\n";
62 0         0 last;
63             }
64              
65 1 50       11 $rgbtxt or die "No rgb.txt file was found\n";
66              
67 0         0 local $_;
68              
69 0         0 while( <$rgbtxt> ) {
70 0         0 s/^\s+//; # trim leading WS
71 0 0       0 next if m/^!/; # comment
72              
73 0 0       0 my ( $r, $g, $b, $name ) = m/^(\d+)\s+(\d+)\s+(\d+)\s+(.*)$/ or next;
74              
75 0         0 $x11_colors->{$name} = [ $r, $g, $b ];
76 0         0 push @x11_color_names, $name;
77             }
78             }
79              
80             =head1 CLASS METHODS
81              
82             =cut
83              
84             =head2 colors
85              
86             @colors = Convert::Color::X11->colors
87              
88             Returns a list of the defined color names, in the order they were found in the
89             F file.
90              
91             $num_colors = Convert::Color::X11->colors
92              
93             When called in scalar context, this method returns the count of the number of
94             defined colors.
95              
96             =cut
97              
98             sub colors
99             {
100 1     1 1 82 my $class = shift;
101              
102 1 50       6 $x11_colors or _load_x11_colors;
103              
104 0           return @x11_color_names;
105             }
106              
107             __PACKAGE__->register_palette(
108             enumerate => sub {
109             my $class = shift;
110             map { $class->new( $_ ) } $class->colors;
111             },
112             );
113              
114             =head1 CONSTRUCTOR
115              
116             =cut
117              
118             =head2 new
119              
120             $color = Convert::Color::X11->new( $name )
121              
122             Returns a new object to represent the named color.
123              
124             =cut
125              
126             sub new
127             {
128 0     0 1   my $class = shift;
129              
130 0 0         if( @_ == 1 ) {
131 0           my $name = $_[0];
132              
133 0 0         $x11_colors or _load_x11_colors;
134              
135 0 0         my $color = $x11_colors->{$name} or
136             croak "No such X11 color named '$name'";
137              
138 0           my $self = $class->SUPER::new( @$color );
139              
140 0           $self->[3] = $name;
141              
142 0           return $self;
143             }
144             else {
145 0           croak "usage: Convert::Color::X11->new( NAME )";
146             }
147             }
148              
149             =head1 METHODS
150              
151             =cut
152              
153             =head2 name
154              
155             $name = $color->name
156              
157             The name of the VGA color.
158              
159             =cut
160              
161             sub name
162             {
163 0     0 1   my $self = shift;
164 0           return $self->[3];
165             }
166              
167             =head1 SEE ALSO
168              
169             =over 4
170              
171             =item *
172              
173             L - color space conversions
174              
175             =back
176              
177             =head1 AUTHOR
178              
179             Paul Evans
180              
181             =cut
182              
183             0x55AA;