File Coverage

blib/lib/String/IRC.pm
Criterion Covered Total %
statement 32 32 100.0
branch 2 2 100.0
condition 4 5 80.0
subroutine 12 12 100.0
pod 5 5 100.0
total 55 56 98.2


line stmt bran cond sub pod time code
1             package String::IRC;
2              
3 6     17   3756 use warnings;
  6         11  
  6         167  
4 6     6   31 use strict;
  6         12  
  6         161  
5 6     6   33 use Carp;
  6         9  
  6         647  
6              
7             our $VERSION = '0.04';
8              
9             use overload (
10 6         49 q{""} => 'stringify',
11             fallback => 'stringify',
12 6     6   1745 );
  6         1109  
13              
14             sub new {
15 14     14 1 21 my $class = shift;
16 14         25 my $self = {};
17 14         31 bless $self, $class;
18              
19 14   100     258 $self->{string} = shift || "";
20              
21 14         36 return $self;
22             }
23              
24             sub _add_code_l {
25 21     21   35 my ($self, $code) = @_;
26 21         50 $self->{string} = $code . $self->{string};
27 21         49 return $self;
28             }
29              
30             my %color_table = (
31             0 => [qw(white)],
32             1 => [qw(black)],
33             2 => [qw(blue navy)],
34             3 => [qw(green)],
35             4 => [qw(red)],
36             5 => [qw(brown maroon)],
37             6 => [qw(purple)],
38             7 => [qw(orange olive)],
39             8 => [qw(yellow)],
40             9 => [qw(light_green lime)],
41             10 => [qw(teal)],
42             11 => [qw(light_cyan cyan aqua)],
43             12 => [qw(light_blue royal)],
44             13 => [qw(pink light_purple fuchsia)],
45             14 => [qw(grey)],
46             15 => [qw(light_grey silver)],
47             );
48             my %color_name_table;
49             {
50             ## no critic
51 6     6   1921 no strict 'refs';
  6         17  
  6         2079  
52             while (my ($code, $colors) = each %color_table) {
53             for my $color (@$colors) {
54             $color_name_table{ $color } = $code;
55              
56             *{__PACKAGE__.'::'.$color} = sub {
57 11     11   48 my $color_code = "";
58 11 100 66     63 if ($_[1] && exists $color_name_table{ $_[1] }) {
59 3         14 $color_code .= sprintf "%02d,%02d", $code, $color_name_table{ $_[1] };
60             } else {
61 8         38 $color_code .= sprintf "%02d", $code;
62             }
63 11         44 $_[0]->_add_code_l("$color_code");
64             };
65             }
66             }
67             }
68              
69 5     5 1 43 sub bold { $_[0]->_add_code_l(""); }
70 3     3 1 18 sub underline { $_[0]->_add_code_l(""); }
71 2     2 1 15 sub inverse { $_[0]->_add_code_l(""); }
72              
73 17     17 1 130 sub stringify { $_[0]->{string} . ""; }
74              
75             1;
76              
77             __END__