File Coverage

blib/lib/Lingua/EN/Titlecase/Simple.pm
Criterion Covered Total %
statement 33 33 100.0
branch 14 16 87.5
condition n/a
subroutine 8 8 100.0
pod 1 1 100.0
total 56 58 96.5


line stmt bran cond sub pod time code
1 3     3   112586 use 5.008001; use strict; use warnings; use utf8;
  3     3   23  
  3     3   15  
  3     3   4  
  3         70  
  3         25  
  3         5  
  3         64  
  3         1444  
  3         36  
  3         13  
2              
3             package Lingua::EN::Titlecase::Simple;
4              
5             our $VERSION = '1.005';
6              
7             our @SMALL_WORD
8             = qw/ (?
9              
10             my $apos = q/ (?: ['’] [[:lower:]]* )? /;
11              
12             sub titlecase {
13 4 50   4 1 10159 my @str = @_ or return;
14              
15 4         10 for ( @str ) {
16 40         145 s{\A\s+}{}, s{\s+\z}{};
17              
18 40 100       109 $_ = lc $_ unless /[[:lower:]]/;
19              
20 40     2   5678 s{
  2         12  
  2         4  
  2         19  
21             \b (_*) (?:
22             ( (?<=[ ][/\\]) [[:alpha:]]+ [-_[:alpha:]/\\]+ | # file path or
23             [-_[:alpha:]]+ [@.:] [-_[:alpha:]@.:/]+ $apos | # URL, domain, or email or
24             [0-9] [0-9,._ ]+ $apos ) # a numeric literal
25             |
26 2         411 ( (?i) ${\join '|', @SMALL_WORD} $apos ) # or small word (case-insensitive)
27             |
28             ( [[:alpha:]] [[:lower:]'’()\[\]{}]* $apos ) # or word w/o internal caps
29             |
30             ( [[:alpha:]] [[:alpha:]'’()\[\]{}]* $apos ) # or some other word
31             ) (?= _* \b )
32             }{
33 230 100       46510 $1 .
    100          
    100          
34             ( defined $2 ? $2 # preserve URL, domain, or email
35             : defined $3 ? lc $3 # lowercase small word
36             : defined $4 ? ucfirst $4 # capitalize lower-case word
37             : $5 ) # preserve other kinds of word
38             }exgo;
39              
40             # exceptions for small words: capitalize at start and end of title
41 40         303 s{
42             ( \A [[:punct:]]* # start of title...
43             | [:.;?!][ ]+ # or of subsentence...
44             | [ ]['"“‘(\[][ ]* ) # or of inserted subphrase...
45 2         216 ( ${\join '|', @SMALL_WORD} ) \b # ... followed by small word
46             }{$1\u\L$2}xigo;
47              
48 40         246 s{
49 2         121 \b ( ${\join '|', @SMALL_WORD} ) # small word...
50             (?= [[:punct:]]* \Z # ... at the end of the title...
51             | ['"’”)\]] [ ] ) # ... or of an inserted subphrase?
52             }{\u\L$1}xigo;
53             }
54              
55 4 50       65 wantarray ? @str : ( @str > 1 ) ? \@str : $str[0];
    100          
56             }
57              
58             sub import {
59 3     3   30 my ( $class, $pkg, $file, $line ) = ( shift, caller );
60 3         11 die "Unknown symbol: $_ at $file line $line.\n" for grep 'titlecase' ne $_, @_;
61 3     3   1107 no strict 'refs';
  3         4  
  3         195  
62 3 100       63 *{ $pkg . '::titlecase' } = \&titlecase if @_;
  2         48  
63             }
64              
65             1;
66              
67             __END__