File Coverage

blib/lib/Lingua/PT/Capitalizer.pm

Criterion	Covered	Total	%
statement	42	43	97.6
branch	5	8	62.5
condition	4	6	66.6
subroutine	8	8	100.0
pod	1	2	50.0
total	60	67	89.5

package Lingua::PT::Capitalizer;

use common::sense;
use English qw[-no_match_vars];

use base qw[ Exporter ];
our @EXPORT = q(capitalize);

our $VERSION = '0.001'; # VERSION

our %lc_always = (
    q(a)   => 1,
    q(á)   => 1,
    q(à)   => 1,
    q(aos) => 1,
    q(às)  => 1,
    q(d')  => 1,    # elisão
    q(da)  => 1,
    q(das) => 1,
    q(de)  => 1,
    q(di)  => 1,
    q(do)  => 1,
    q(dos) => 1,
    q(e)   => 1,
    q(na)  => 1,
    q(nas) => 1,
    q(no)  => 1,
    q(nos) => 1,
    q(o)   => 1,
    q(os)  => 1,
);

sub capitalize {
    my ( $self, $text, $preserve_caps )
        = ref $_[0] eq __PACKAGE__
        ? @_
        : ( undef, @_ );

    $text //= $_;

    return unless defined $text;

    my @token = _pt_word_tokenizer($text);

    foreach ( my $i = 0; $i <= $#token; $i++ ) {
        foreach ( $token[$i] ) {
            if ( $preserve_caps ~~ q(1)
                && m{^\p{Lu}+(?:\N{APOSTROPHE})?$}msx )
            {
                next;
            }

            my $lc = lc;
            when ( $i == 0 ) { $_ = ucfirst $lc; }
            when ( substr( $_, -1 ) eq q(.) ) { $_ = ucfirst $lc; }
            when ( exists $lc_always{$lc} ) { $_ = $lc; }
            default {
                $_ = ucfirst $lc;
            }
        } ## end foreach ( $token[$i] )
    } ## end foreach ( my $i = 0; $i <= ...)

    $text = join q(), @token;

    return $text;
} ## end sub capitalize

sub _pt_word_tokenizer {
    my $text = shift;

    my $re = qr{(\p{L}+(?:\N{APOSTROPHE}|\p{L}{0,2}))}msx;

    my @token = split $re, $text;
    @token = grep { defined && $_ ne q() } @token;

    return @token;
}

sub new {
    my $class = shift;
    my $self  = {
        capitalize => \&capitalize,
        lc_always  => \%lc_always,
    };
    return bless $self, $class;
}

1;

__END__