# $Id: Decorate.pm,v 1.1 2007/09/24 01:42:10 altblue Exp $
package Acme::Decorate;
use warnings;
use strict;
use Carp;
use Encode          ();
use Encode::Detect  ();
use charnames       ();
use encoding 'utf8';
use vars qw($AUTOLOAD $VERSION $maps $combs);
$VERSION = sprintf '0.%d.%d', '\$Revision: 1.1 $' =~ /(\d+)\.(\d+)/xm;

# return all POSSIBLE combiners
# - use a list of "guessed" ranges as browsing through all UCD is very slow!
# - build up $combs structure while iterating ;-)
sub combiners {
    my @ranges = (
        768 .. 879,      # COMBINING DIACRITICAL MARKS
        1155 .. 1158,    # CYRILLIC
        1160, 1161,      # CYRILLIC
        7616 .. 7679,    # COMBINING DIACRITICAL MARKS SUPPLEMENT
        8400 .. 8447,    # COMBINING DIACRITICAL MARKS FOR SYMBOLS
        65056 .. 65071   # COMBINING HALF MARKS
    );
    my @combiners;
    for my $id (@ranges) {
        my $name = charnames::viacode($id) || next;
        $name =~ s/^COMBINING\s+//i or next;
        $combs->{$name} ||= {
            id   => $id,
            char => chr $id,
        };
        for ($name) {
            s/\s+ACCENT$//i;
            s/ /_/g;
        }
        push @combiners, lc $name;
    }
    return sort @combiners;
}

# find a combiner, iterating through possible variations
sub find_combiner {
    my $str = uc $_[0];
    for ($str) {
        s/_+/ /gs;
        s/^\s+//gs;
        s/\s+$//gs;
    }
    my @try = ($str);
    for my $vr (qw(ACCENT ABOVE BELOW)) {
        $str =~ s/ $vr$//
            and push @try, $str
            or  push @try, "$str $vr";
    }
    for my $comb (@try) {
        return $comb if exists $combs->{$comb};
        my $id = charnames::vianame("COMBINING $comb") || next;
        $combs->{$comb} = {
            id   => $id,
            char => chr $id,
        };
        return $comb;
    }
    return;
}

# build a map with chars that have an "acute/grave/umlaut/etc" version
sub build_map {
    my ($comb) = @_;
    return if !exists $combs->{$comb};
    for my $letter ( 'A' .. 'Z' ) {
        for my $case (qw(CAPITAL SMALL)) {
            my $id
                = charnames::vianame("LATIN $case LETTER $letter WITH $comb")
                || next;
            $maps->{$comb}{ $case eq 'CAPITAL' ? $letter : lc $letter }
                = chr $id;
        }
    }
}

# decode provided argument to UTF-8
sub to_utf8 {
    my ( $str ) = @_;
    return $str if Encode::is_utf8($str);
    eval { $str = Encode::decode_utf8($str) };
    if ($@) {
        $str = Encode::decode( 'Detect', $str );
    }
    return $str;
}

# decorate provided strings with requested combiner
sub decorate {
    my ($comb, @strings) = @_;
    return if !exists $combs->{$comb};
    @strings = map {
        join q{},
            map {
                exists $maps->{$comb}{$_}
                ? $maps->{$comb}{$_}
                : $_ . $combs->{$comb}{char}
            }
            split '', to_utf8($_);
    } @strings;
    return wantarray ? @strings : join q{ }, @strings;
}

# magically create string-decorator for any combiner
sub AUTOLOAD {
    no strict 'refs';
    if ( $AUTOLOAD =~ /.+::(.+)/ ) {
        my $name = $1;
        my $comb = find_combiner($name)
            || croak "Sorry, cannot find a combiner for '$name'";
        build_map($comb) if !exists $maps->{$comb};
        *{$AUTOLOAD} = eval "sub { return decorate('$comb', \@_) }";
        return $AUTOLOAD->(@_);
    }
    croak "No such method: $AUTOLOAD";
}

1;