File Coverage

blib/lib/IRC/Toolkit/Role/CaseMap.pm
Criterion Covered Total %
statement 22 22 100.0
branch 3 6 50.0
condition n/a
subroutine 7 7 100.0
pod 3 3 100.0
total 35 38 92.1


line stmt bran cond sub pod time code
1             package IRC::Toolkit::Role::CaseMap;
2             $IRC::Toolkit::Role::CaseMap::VERSION = '0.092002';
3 1     1   18797 use strictures 2;
  1         1067  
  1         32  
4 1     1   137 use Carp;
  1         1  
  1         44  
5              
6 1     1   323 use IRC::Toolkit::Case;
  1         2  
  1         8  
7              
8              
9 1     1   307 use Role::Tiny;
  1         2  
  1         4  
10             requires 'casemap';
11              
12             sub lower {
13 1     1 1 2364 my ($self, $val) = @_;
14 1 50       3 confess "lower() called without a value" unless defined $val;
15 1         4 lc_irc $val, $self->casemap
16             }
17              
18             sub upper {
19 1     1 1 2 my ($self, $val) = @_;
20 1 50       3 confess "upper() called without a value" unless defined $val;
21 1         5 uc_irc $val, $self->casemap
22             }
23              
24             sub equal {
25 2 50   2 1 5 confess 'equal() expects two values' unless @_ == 3;
26 2         2 my ($self, $one, $two) = @_;
27 2         5 my $cmap = $self->casemap;
28 2         5 uc_irc($one, $cmap) eq uc_irc($two, $cmap)
29             }
30              
31             1;
32              
33             =pod
34              
35             =head1 NAME
36              
37             IRC::Toolkit::Role::CaseMap - Role for classes that track IRC casemapping
38              
39             =head1 SYNOPSIS
40              
41             package MyIRC;
42             use Moo;
43              
44             has casemap => (
45             is => 'rw',
46             default => sub { 'rfc1459' },
47             coerce => sub { lc $_[0] },
48             );
49              
50             with 'IRC::Toolkit::Role::CaseMap';
51              
52             sub mymeth {
53             my ($self, $nickname, $one, $two) = @_;
54              
55             my $lowered = $self->lower( $nickname );
56             my $uppered = $self->upper( $nickname );
57              
58             if ( $self->equal( $one, $two ) ) {
59             ...
60             }
61             }
62              
63             =head1 DESCRIPTION
64              
65             A L role that provides convenient helper methods for classes that
66             track IRC casemapping, such as IRC client libraries.
67              
68             This role C a B attribute that returns one of 'rfc1459',
69             'ascii', or 'strict-rfc1459' -- see L for details on IRC
70             casemap issues.
71              
72             =head2 lower
73              
74             Returns the IRC-lowercased string.
75              
76             =head2 upper
77              
78             Returns the IRC-uppercased string.
79              
80             =head2 equal
81              
82             Expects two strings; returns true if they are equal per the current B
83             rules. Returns empty list if the strings do not match.
84              
85             =head1 AUTHOR
86              
87             Jon Portnoy
88              
89             =cut