File Coverage

blib/lib/Text/Ligature.pm

Criterion	Covered	Total	%
statement	33	33	100.0
branch	4	4	100.0
condition			n/a
subroutine	8	8	100.0
pod	0	2	0.0
total	45	47	95.7

package Text::Ligature;

use 5.006;
use strict;
use warnings;
use utf8;
use parent 'Exporter';
use Carp;

our $VERSION     = '0.02';
our @EXPORT_OK   = qw< to_ligatures from_ligatures to_ligature from_ligature >;
our %EXPORT_TAGS = ( all => \@EXPORT_OK );

# TODO: remove to_ligature/from_ligature in next release
*to_ligature   = \&to_ligatures;
*from_ligature = \&from_ligatures;

my @defaults = qw< ff fi fl ffi ffl >;

my %lig_for = (
    ff  => 'ff',
    fi  => 'fi',
    fl  => 'fl',
    ffi => 'ffi',
    ffl => 'ffl',
    ft  => 'ſt',
    st  => 'st',
);

my %chars_for = reverse %lig_for;

sub to_ligatures {
    my ($text) = @_;

    if (@_ != 1) {
        carp 'to_ligatures() expects one argument';
        return;
    }

    # longest token matching
    for my $chars (sort { length $b <=> length $a } @defaults) {
        $text =~ s/$chars/$lig_for{$chars}/g;
    }

    return $text;
}

sub from_ligatures {
    my ($text) = @_;

    if (@_ != 1) {
        carp 'from_ligatures() expects one argument';
        return;
    }

    for my $lig (keys %chars_for) {
        $text =~ s/$lig/$chars_for{$lig}/g;
    }

    return $text;
}

1;

__END__