view release on metacpan or  search on metacpan

LICENSE  view on Meta::CPAN

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software Foundation,
    Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.

Also add information on how to contact you by electronic and paper mail.

If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:

    Gnomovision version 69, Copyright (C) 19xx name of author
    Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
    This is free software, and you are welcome to redistribute it
    under certain conditions; type `show c' for details.

The hypothetical commands `show w' and `show c' should show the
appropriate parts of the General Public License.  Of course, the
commands you use may be called something other than `show w' and `show
c'; they could even be mouse-clicks or menu items--whatever suits your
program.

You should also get your employer (if you work as a programmer) or your
school, if any, to sign a "copyright disclaimer" for the program, if
necessary.  Here a sample; alter the names:

lib/Acme/AwesomeQuotes.pm  view on Meta::CPAN

our @ISA = qw(Exporter);
our @EXPORT_OK = qw(GetAwesome);
our @EXPORT    = qw(GetAwesome);

use Carp qw(croak);
use Unicode::Normalize qw(NFC NFD);

# ABSTRACT: Make your text awesome!


my %chartypes = (
                 'all'      => qr/[\x{030C}\x{0300}\x{0301}]/,
                 'notgrave' => qr/[^\P{NonspacingMark}\x{0300}]/,
                 'notacute' => qr/[^\P{NonspacingMark}\x{0301}]/,
                 'notcaron' => qr/[^\P{NonspacingMark}\x{030C}]/,
                 'puncsep'  => qr/[\p{Separator}\p{Punctuation}]/,
                );


sub GetAwesome {
	(my $string = NFD($_[0])) =~ s/(?:^${chartypes{puncsep}}+|${chartypes{puncsep}}+$)//g;

	eval {checkstring($string)} or croak $@;

	# For individual characters, use a caron instead of terminal acute/grave accents:
	if ($string =~ /^\p{Letter}\p{NonspacingMark}*$/) {
		# Prep string – remove extant carons/accents:
		$string =~ s/^(\p{Letter}${chartypes{notcaron}}*)${chartypes{all}}+(${chartypes{notcaron}}*)$/$1$2/;

		# Make string awesome!
		$string = NFC($string);
		$string =~ s/^(.*)$/`$1\x{030C}´/;
	}
	else {
		# If there are initial acute/terminal grave accents, use a caron instead:
		my $initialaccent = ($string =~ s/^(\p{Letter}\p{NonspacingMark}*)[\x{0301}\x{030C}]+/${1}/g)
		  ? "\x{030C}" : "\x{0300}";
		my $finalaccent   = ($string =~ s/(\p{Letter}\p{NonspacingMark}*)[\x{0300}\x{030C}]+(\p{NonspacingMark}*)$/${1}${2}/g)
		  ? "\x{030C}" : "\x{0301}";

		# Prep string – remove extant terminal acute/grave accents:
		$string =~ s/^(\p{Letter}${chartypes{notgrave}}*)\x{0300}/$1/;
		$string =~ s/(\p{Letter}${chartypes{notacute}}*)\x{0301}(${chartypes{notacute}}*)$/$1$2/;

		# Make string awesome!
		$string = NFC($string);
		$string =~ s/^(\p{Letter}\p{ModifierLetter}*)/`${1}${initialaccent}/;
		$string =~ s/(\p{Letter}\p{ModifierLetter}*)$/${1}${finalaccent}´/;
	}

	return(NFC($string));
}


sub checkstring {
	my $string = $_[0];
	if ($string eq '') {
		die "String is empty!\n";
	}
	elsif ((($string =~ /^`\p{Letter}${chartypes{notgrave}}*\x{0300}/) &&
	        ($string =~ /\p{Letter}${chartypes{notacute}}*\x{0301}${chartypes{notacute}}*´$/)) ||
	       ($string =~ /^`\p{Letter}${chartypes{notcaron}}*\x{030C}${chartypes{notcaron}}*´$/)) {
		die "String '$string' is *already* awesome!\n";
	}
	elsif ($string !~ /^\p{Letter}/) {
		die "String '$string' begins with a non-letter character.\n";
	}
	elsif ($string !~ /\p{Letter}\p{NonspacingMark}*$/) {
		die "String '$string' terminates with a non-letter character.\n";
	}
	else {
		1;