File Coverage

blib/lib/Lingua/EN/Titlecase/Simple.pm

Criterion	Covered	Total	%
statement	30	30	100.0
branch	14	16	87.5
condition			n/a
subroutine	7	7	100.0
pod	1	1	100.0
total	52	54	96.3

use 5.008001; use strict; use warnings; use utf8;

package Lingua::EN::Titlecase::Simple;

our $VERSION = '1.015';

our @SMALL_WORD
	= qw/ (?

my $apos = q/ (?: ['’] [[:lower:]]* )? /;

sub titlecase {
	my @str = @_ or return;

	my $small_re = join '|', @SMALL_WORD;

	for ( @str ) {
		s{\A\s+}{}, s{\s+\z}{};

		$_ = lc $_ if not /[[:lower:]]/;

		s{
			\b (_*) (?:
				( (?<=[ ][/\\]) [[:alpha:]]+ [-_[:alpha:]/\\]+ |   # file path or
				[-_[:alpha:]]+ [@.:] [-_[:alpha:]@.:/]+ $apos |    # URL, domain, or email or
				[0-9] [0-9,._ ]+ $apos )                           # a numeric literal
				|
				( (?i: $small_re ) $apos )                         # or small word (case-insensitive)
				|
				( [[:alpha:]] [[:lower:]'’()\[\]{}]* $apos )       # or word w/o internal caps
				|
				( [[:alpha:]] [[:alpha:]'’()\[\]{}]* $apos )       # or some other word
			) (_*) \b
		}{
			$1 . (
			defined $2 ? $2         # preserve URL, domain, or email
			: defined $3 ? "\L$3"     # lowercase small word
			: defined $4 ? "\u\L$4"   # capitalize word w/o internal caps
			: $5                      # preserve other kinds of word
			) . $6
		}xeg;


		# Exceptions for small words: capitalize at start and end of title
		s{
			(  \A [[:punct:]]*         # start of title...
			|  [:.;?!][ ]+             # or of subsentence...
			|  [ ]['"“‘(\[][ ]*     )  # or of inserted subphrase...
			( $small_re ) \b           # ... followed by small word
		}{$1\u\L$2}xig;

		s{
			\b ( $small_re )      # small word...
			(?= [[:punct:]]* \Z   # ... at the end of the title...
			|   ['"’”)\]] [ ] )   # ... or of an inserted subphrase?
		}{\u\L$1}xig;

		# Exceptions for small words in hyphenated compound words
		## e.g. "in-flight" -> In-Flight
		s{
			\b
			(?
			( $small_re )
			(?= -[[:alpha:]]+)		# lookahead for "-someword"
		}{\u\L$1}xig;

		## # e.g. "Stand-in" -> "Stand-In" (Stand is already capped at this point)
		s{
			\b
			(?
			( [[:alpha:]]+- )		# $1 = first word and hyphen, should already be properly capped
			( $small_re )           # ... followed by small word
			(?!	- )					# Negative lookahead for another '-'
		}{$1\u$2}xig;
	}

	wantarray ? @str : ( @str > 1 ) ? \@str : $str[0];
}

sub import {
	my ( $class, $pkg, $file, $line ) = ( shift, caller );
	die "Unknown symbol: $_ at $file line $line.\n" for grep 'titlecase' ne $_, @_;
	no strict 'refs';
	*{ $pkg . '::titlecase' } = \&titlecase if @_;
}

1;

__END__