File Coverage

blib/lib/Lingua/Zompist/Verdurian.pm

Criterion	Covered	Total	%
statement	203	214	94.8
branch	172	188	91.4
condition	338	345	97.9
subroutine	13	13	100.0
pod	10	10	100.0
total	736	770	95.5

package Lingua::Zompist::Verdurian;
# vim:set tw=72 sw=2:

use 5.005;
use strict;

require Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $keep_accents);
@ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use Lingua::Zompist::Verdurian ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
%EXPORT_TAGS = ( 'all' => [ qw(
    demeric
    scrifel
    izhcrifel
    ctanec
    epesec
    befel
    classimp
    part
    noun
    adj
) ] );

@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

@EXPORT = qw(

);
$VERSION = '0.91';

# Keep accents on words by default, even if the accented syllable would
# be stressed anyway due to its position?
$keep_accents = 1;

my %verb = (demeric => \&demeric,
            scrifel => \&scrifel,
            izhcrifel => \&izhcrifel,
            ctanec => \&ctanec,
            epesec => \&epesec,
            befel => \&befel,
            classimp => \&classimp,
           );

my @persons = qw(se le il ta mu ca);

my @cases = qw(nom gen acc dat);

my @numbers = qw(sing pl);

my %endings = (
  N => [ qw( ai ei e am o u ) ],
  R => [ qw(  u eu e um o ü ) ],
  C => [ qw( ao eo e om o u ) ],
);

# Some handy things for -i- insertion and moving stress
my $cons = qr/(?:[szcdr]h|[pbtdcgkfvszmnlr])/;
my $vow  = qr/[aeiouAEIOU]/; # plain vowels only
my %acc = (
  'a' => 'á',
  'e' => 'é',
  'i' => 'í',
  'o' => 'ó',
  'u' => 'ú',
  'A' => 'Á',
  'E' => 'É',
  'I' => 'Í',
  'O' => 'Ó',
  'U' => 'Ú',
);

my %unacc = (
  'á' => 'a',
  'é' => 'e',
  'í' => 'i',
  'ó' => 'o',
  'ú' => 'u',
  'Á' => 'A',
  'É' => 'E',
  'Í' => 'I',
  'Ó' => 'O',
  'Ú' => 'U',
);


my %demeric = (
  esan    => [ qw( ai ei e am eo eu ) ],
  fassec  => [ qw( fassao fasseo fas fassom fasso fassu ) ],
  kies    => [ qw( kiai kiei kiet kaiam kaio kaiu ) ],
  'lübec' => [ qw( lübao lüo lü lübom lübo lübu ) ],
  mizec   => [ qw( mizao mizeo mis mizom mizo mizu ) ],
  shrifec => [ qw( shrifao shris shri shrifom shrifo shrifu ) ],
  zhanen  => [ qw( zhai zhes zhe zhanam zhano zhanu ) ],
  zhusir  => [ qw( zhui zhus zhu zhusum zhuso zhusü ) ],
);

sub demeric {
  my $verb = shift;
  my $stem = $verb;
  my $table;

  if($stem =~ s/^(\S+)(fassec|mizec|shrifec|zhanen|zhusir)$/$1/) {
    return [ map "$stem$_", @{$demeric{$2}} ];
  }

  return $demeric{$verb} if exists $demeric{$verb};

  if($stem =~ s/[ea]n$//) {
    $table = [ map "$stem$_", @{$endings{N}} ];
  } elsif($stem =~ s/[ie]r$//) {
    $table = [ map "$stem$_", @{$endings{R}} ];
  } elsif($stem =~ s/ec$//) {
    $table = [ map "$stem$_", @{$endings{C}} ];
  } else {
    return;
  }

  for(@$table) {
    s/zh(?=[aou][iom]?$)/g/;
  }

  return $table;
}

my %scrifel = (
  esan      => [ qw( fuai fuei fue/esne fuam fuo fueu/esnu ) ],
  fassec    => [ map "fashsh$_", @{$endings{C}} ],
  dan       => [ map "don$_",    @{$endings{N}} ],
  kies      => [ map "kaiv$_",   @{$endings{N}} ],
  shushchan => [ map "shushd$_", @{$endings{N}} ],
);

sub scrifel {
  my $verb = shift;
  my $stem = $verb;
  my $table;
  my $add = 0;  # did we have to add an -i-?

  return $scrifel{$verb} if exists $scrifel{$verb};

  if($stem =~ s/($cons[lr])([ea]n|[ie]r|ec)$/$1i$2/) {
    $add = 1;
  }

  if($stem =~ s/c[ea]n$/sn/  ||
     $stem =~ s/ch[ea]n$/dn/ ||
     $stem =~ s/d[ea]n$/zn/  ||
     $stem =~ s/g[ea]n$/zhn/ ||
     $stem =~ s/[ea]n$/n/) {
    $table = [ map "$stem$_", @{$endings{N}} ];
  } elsif($stem =~ s/ch[ie]r$/dr/ ||
          $stem =~ s/m[ie]r$/mbr/ ||
          $stem =~ s/n[ie]r$/ndr/ ||
          $stem =~ s/z[ie]r$/dr/  ||
          $stem =~ s/[ie]r$/r/) {
    $table = [ map "$stem$_", @{$endings{R}} ];
  } elsif($stem =~ s/cec$/sc/   ||
          $stem =~ s/chec$/shc/ ||
          $stem =~ s/mec$/nc/   ||
          $stem =~ s/sec$/sh/   ||
          $stem =~ s/zec$/zh/   ||
          $stem =~ s/ec$/c/) {
    $table = [ map "$stem$_", @{$endings{C}} ];
  } else {
    return;
  }

  if($add) {
    for(@$table) {
      # replace -VC+[lr]i[nrc]VC* with -V'C+[lr]i[nrc]VC*
      s{
        ($vow)        # a vowel, which we'll accent (to $1)
        (             # begin capturing to $2
          (?:$cons)+  # one or more consonants
                      # (never zero, since otherwise we wouldn't have had
                      # to insert the -i-)
	  [lr]        # one of 'l' or 'r'
          i           # the epenthetic -i- which must not receive the stress
          [nrc]       # endings are either -n-, -r-, or -c-
          $vow        # followed by only one (unstressed) vowel
          m?          # and possibly an -m (for the -am -um -om endings
                      # of the Ist person plural)
          $           # and finally end-of-string
        )             # end of $2
      }{$acc{$1}$2}ox;
    }
  }

  return $table;
}

my %izhcrifel = (
  fassec    => [ map "fashsher$_", @{$endings{C}} ],
  dan       => [ map "doner$_",    @{$endings{N}} ],
  kies      => [ map "kaiver$_",   @{$endings{N}} ],
  shushchan => [ map "shushder$_", @{$endings{N}} ],
);

sub izhcrifel {
  my $verb = shift;
  my $stem = $verb;
  my $table;
  my $add = 0;

  return $izhcrifel{$verb} if exists $izhcrifel{$verb};

  if($stem =~ s/($cons[lr])([ea]n|[ie]r|ec)$/$1i$2/) {
    $add = 1;
  }

  if($stem =~ s/c[ea]n$/sner/  ||
     $stem =~ s/ch[ea]n$/dner/ ||
     $stem =~ s/d[ea]n$/zner/  ||
     $stem =~ s/g[ea]n$/zhner/ ||
     $stem =~ s/[ea]n$/ner/) {
    $table = [ map "$stem$_", @{$endings{N}} ];
  } elsif($stem =~ s/ch[ie]r$/dre/ ||
          $stem =~ s/m[ie]r$/mbre/ ||
          $stem =~ s/n[ie]r$/ndre/ ||
          $stem =~ s/z[ie]r$/dre/  ||
          $stem =~ s/[ie]r$/re/) {
    $table = [ map "$stem$_", @{$endings{R}} ];
  } elsif($stem =~ s/cec$/scer/   ||
          $stem =~ s/chec$/shcer/ ||
          $stem =~ s/mec$/ncer/   ||
          $stem =~ s/sec$/sher/   ||
          $stem =~ s/zec$/zher/   ||
          $stem =~ s/ec$/cer/) {
    $table = [ map "$stem$_", @{$endings{C}} ];
  } else {
    return;
  }

  # Don't need to shift stress since the ending will always have at least
  # two vowels

  return $table;
}

my %ctanec = (
  fassec    => [ map "fasst$_",  @{$endings{C}} ],
  dan       => [ map "dom$_",    @{$endings{N}} ],
  kies      => [ map "kaim$_",   @{$endings{N}} ],
  shushchan => [ map "shushm$_", @{$endings{N}} ],
);

sub ctanec {
  my $verb = shift;
  my $stem = $verb;
  my $table;
  my $add = 0;

  return $ctanec{$verb} if exists $ctanec{$verb};

  if($stem =~ s/($cons[lr])([ea]n|[ie]r|ec)$/$1i$2/) {
    $add = 1;
  }

  if($stem =~ s/ch[ea]n$/dm/ ||
     $stem =~ s/g[ea]n$/zhm/ ||
     $stem =~ s/[ea]n$/m/) {
    $table = [ map "$stem$_", @{$endings{N}} ];
  } elsif($stem =~ s/ch[ie]r$/tret/ ||
          $stem =~ s/m[ie]r$/mbret/ ||
          $stem =~ s/n[ie]r$/ndret/ ||
          $stem =~ s/z[ie]r$/dret/  ||
          $stem =~ s/[ie]r$/ret/) {
    $table = [ map "$stem$_", @{$endings{R}} ];
  } elsif($stem =~ s/ec$/t/) {
    $table = [ map "$stem$_", @{$endings{C}} ];
  } else {
    return;
  }

  if($add) {
    for(@$table) {
      # replace -VC+[lr]i[mt]VC* with -V'C+[lr]i[nrc]VC*
      s{
        ($vow)        # a vowel, which we'll accent (to $1)
        (             # begin capturing to $2
          (?:$cons)+  # one or more consonants
                      # (never zero, since otherwise we wouldn't have had
                      # to insert the -i-)
	  [lr]        # one of 'l' or 'r'
          i           # the epenthetic -i- which must not receive the stress
          [mt]        # endings are either -m- or -t-
                      # (-ret- already has an extra vowel)
          $vow        # followed by only one (unstressed) vowel
          m?          # and possibly an -m (for the -am -um -om endings
                      # of the Ist person plural)
          $           # and finally end-of-string
        )             # end of $2
      }{$acc{$1}$2}ox;
    }
  }

  return $table;
}


my %epesec = (
  dan       => [ map "doncel$_",   @{$endings{N}} ],
  fassec    => [ map "fashshel$_", @{$endings{C}} ],
  kies      => [ map "keshel$_",   @{$endings{N}} ],
);

sub epesec {
  my $verb = shift;
  my $stem = $verb;
  my $table;
  my $add = 0;

  return $epesec{$verb} if exists $epesec{$verb};

  if($stem =~ s/($cons$cons)([ea]n|[ie]r|ec)$/$1i$2/) {
    $add = 1;
  }

  if($stem =~ s/c[ea]n$/scel/   ||
     $stem =~ s/ch[ea]n$/shcel/ ||
     $stem =~ s/m[ea]n$/ncel/   ||
     $stem =~ s/s[ea]n$/shel/   ||
     $stem =~ s/z[ea]n$/zhel/   ||
     $stem =~ s/[ea]n$/cel/) {
    $table = [ map "$stem$_", @{$endings{N}} ];
  } elsif($stem =~ s/c[ie]r$/scel/   ||
          $stem =~ s/ch[ie]r$/shcel/ ||
          $stem =~ s/m[ie]r$/ncel/   ||
          $stem =~ s/s[ie]r$/shel/   ||
          $stem =~ s/z[ie]r$/zhel/   ||
          $stem =~ s/[ie]r$/cel/) {
    $table = [ map "$stem$_", @{$endings{R}} ];
  } elsif($stem =~ s/cec$/scel/   ||
          $stem =~ s/chec$/shcel/ ||
          $stem =~ s/mec$/ncel/   ||
          $stem =~ s/sec$/shel/   ||
          $stem =~ s/zec$/zhel/   ||
          $stem =~ s/ec$/cel/) {
    $table = [ map "$stem$_", @{$endings{C}} ];
  } else {
    return;
  }

  # Don't need to shift stress since the ending will always have at least
  # two vowels

  return $table;
}

sub befel {
  my $verb = shift;
  my $stem = $verb;

  return if $verb eq 'kies'; # has no imperative, according to Mark

  if($stem =~ m/[ea]n$/) {
    return [ map "$stem$_", @{$endings{N}} ];
  } elsif($stem =~ m/[ie]r$/) {
    return [ map "$stem$_", @{$endings{R}} ];
  } elsif($stem =~ m/ec$/) {
    return [ map "$stem$_", @{$endings{C}} ];
  } else {
    return;
  }
}


# Form the so-called "classical imperative"
sub classimp {
  my $verb = shift;
  my $stem = $verb;

  return if $verb eq 'kies'; # has no imperative, according to Mark

  if($stem =~ s/[ea]n$//) {
    return [ undef, $stem . 'i', undef, undef, $stem . 'il', undef ];
  } elsif($stem =~ s/[ie]r$//) {
    return [ undef, $stem . 'u', undef, undef, $stem . 'ul', undef ];
  } elsif($stem =~ s/ec$//) {
    return [ undef, $stem . 'e', undef, undef, $stem . 'el', undef ];
  } else {
    return;
  }
}


my %part = (
  dan  => [ qw(donec  donul  donäm ) ],
  kies => [ qw(kaivec kaivul kaiväm) ],
);


# Participles
sub part {
  my $verb = shift;

  my($present, $past, $gerund);

  if(exists $part{$verb}) {
    ($present, $past, $gerund) = @{ $part{$verb} };
  } else {
    return unless $verb =~ /(?:ec|[ea]n|[ie]r)$/;

    ($present, $past, $gerund) = ($verb) x 3;

    for($present) {
      s/ec$/ë/ || s/(?:[ie]r|[ea]n)$/ec/;
    }

    for($past) {
      s/(?:ec|[ea]n|[ie]r)$/ul/;
    }

    for($gerund) {
      s/(?:ec|[ea]n|[ie]r)$/äm/;
    }
  }

  return wantarray ? ($present, $past, $gerund) : [ $present, $past, $gerund ];
}




my %masc = (
  creza => 1,
  'Ervëa' => 1,
  esta => 1,
  hezhiosa => 1,
  rhena => 1,
  didha => 1,
  vyozha => 1,
);

sub noun {
  my $noun = shift;
  my $stem = $noun;
  my $type = 'fem';
  my $table;

  $type = 'masc' if exists $masc{$noun};

  # is it the article?
  return [ qw( so  soei so  soán soî soië soi  soin ) ] if $noun eq 'so';
  return [ qw( soa soe  soa soan soî soië soem soen ) ] if $noun eq 'soa';

  # is it a personal pronoun?
  return [ qw( se  esë  et    sen  ta taë tam tan ) ] if $noun eq 'se';
  return [ qw( le  lë   erh   len  mu muë mü  mun ) ] if $noun eq 'le';
  return [ qw( ilu lië  ilet  ilun ca caë cam can ) ] if $noun eq 'ilu';
  return [ qw( ila liue ilat  ilan ca caë cam can ) ] if $noun eq 'ila';
  return [ qw( il  lië  iler  ilon ca caë cam can ) ] if $noun eq 'il';
  return [ qw( ze  zië  zet   zen  za zaë zam zan ) ] if $noun eq 'ze';
  return [ qw( tu  tuë  tu/tü tun ), (undef) x 4    ] if $noun eq 'tu';
  return [ qw( ta  taë  tam   tan ), (undef) x 4    ] if $noun eq 'ta';
  return [ qw( mu  muë  mü    mun ), (undef) x 4    ] if $noun eq 'mu';
  return [ qw( ca  caë  cam   can ), (undef) x 4    ] if $noun eq 'ca';
  return [ qw( za  zaë  zam   zan ), (undef) x 4    ] if $noun eq 'za';

  # relative or interrogative pronoun?
  if($stem =~ s/^((?:if|nib|ti)?k)e$/$1/) {
    return [ map "$stem$_", qw( e ë et en aë aëne aëm aën ) ];
  } elsif($stem =~ s/^((?:if|nib|ti)?ki)o$/$1/) {
    return [ ( map "$stem$_", qw( o ei om on ) ), (undef) x 4 ];
  } elsif($stem =~ s/^((?:nëc|nik|sh|e)t)o$/$1/) {
    return [ ( map "$stem$_", qw( o ë o on ) ), (undef) x 4 ];
  } elsif($noun eq 'tot') {
    return [ qw( tot totë tot totán ), (undef) x 4 ];
  } elsif($noun eq 'fsya') {
    return [ qw( fsya fsye fsya fsyan ), (undef) x 4 ];
  } elsif($stem =~ s/^((?:if|nib|ti)c|kt|fs)ë$/$1/) {
    return [ ( map "$stem$_", qw( ë ëi ë ën ) ), (undef) x 4 ];
  } elsif($noun eq 'zdesy') {
    return [ qw( zdesy zdesii zdesy zdesín ), (undef) x 4 ];
  } elsif($noun eq 'cechel') {
    return [ qw( cechel cechelei cechel cechelán ), (undef) x 4 ];
  } elsif($noun eq 'nish') {
    return [ qw( nish nishei nish nishán ), (undef) x 4 ];
  }

  # else treat it as a noun.

  # apparently, -consonant and -a are the most common, so put those
  # first, followed by the other masculine and then the feminine
  # declensions
  # must, however, put '-ia' before '-a' or we'll get confused.
  if($stem =~ m/[pbtdhcgkfvszmnlr]$/) {
    $table = [ map "$stem$_", '', 'ei', '', 'án', 'î', 'ië', 'i', 'in' ];
  } elsif($type eq 'fem' && $stem =~ s/ia$//) {
    $table = [ map "$stem$_", qw( ia ë iam ian iî ië em en ) ];
  } elsif($type eq 'fem' && $stem =~ s/a$//) {
    $table = [ map "$stem$_", qw( a e a an î ië em en ) ];
  } elsif($stem =~ s/o$//) {
    $table = [ map "$stem$_", qw( o ei am on oi oë om oin ) ];
  } elsif($stem =~ s/u$//) {
    $table = [ map "$stem$_", qw( u ui um un î uë om uin ) ];
  } elsif($stem =~ s/iy$//) {
    $table = [ map "$stem$_", qw( iy ii iim iín iî ië iom iuin ) ];
  } elsif($stem =~ s/íy$//) {
    $table = [ map "$stem$_", $keep_accents
                              ? qw( íy íi íim iín íî íë íom íuin )
                              : qw( íy ii iim iín iî íë iom íuin ) ];
  } elsif($stem =~ s/y$//) {
    $table = [ map "$stem$_", qw( y ii im ín î uë om uin ) ];
  } elsif($type eq 'masc' && $stem =~ s/a$//) {
    $table = [ map "$stem$_", qw( a ei a an ai aë am ain ) ];
  } elsif($stem =~ s/i$//) {
    $table = [ map "$stem$_", qw( i ë a in î ië em in ) ];
  } elsif($stem =~ s/e$//) {
    $table = [ map "$stem$_", qw( e ei a en î ië em en ) ];
  } elsif($stem =~ s/ë$//) {
    $table = [ map "$stem$_", qw( ë ëi ä en î ië em en ) ];
  } elsif($type eq 'fem' && $stem =~ s/á$//) {
    $table = [ map "$stem$_", qw( á é á án í ië ém én ) ];
  } elsif($stem =~ s/ó$//) {
    $table = [ map "$stem$_", $keep_accents
                              ? qw( ó éi ám ón ói oë óm óin )
                              : qw( ó ei ám ón oi oë óm oin ) ];
  } elsif($stem =~ s/ú$//) {
    $table = [ map "$stem$_", $keep_accents
                              ? qw( ú úi úm ún í uë óm úin )
                              : qw( ú ui úm ún í uë óm uin ) ];
  } elsif($type eq 'masc' && $stem =~ s/á$//) {
    $table = [ map "$stem$_", $keep_accents
                              ? qw( á éi á án ái aë ám áin )
                              : qw( á ei á án ai aë ám ain ) ];
  } elsif($stem =~ s/í$//) {
    $table = [ map "$stem$_", qw( í ë á ín í ië ém ín ) ];
  } elsif($stem =~ s/é$//) {
    $table = [ map "$stem$_", $keep_accents
                              ? qw( é éi á én í ië ém én )
                              : qw( é ei á én í ië ém én ) ];
  } else {
    return;
  }

  # remove accents for words ending in án or ín
  # and put in irregular plurals
  for(@$table) {
    if(/[áí]n$/) {
      # remove all accents
      tr/áéíóúÁÉÍÓÚ/aeiouAEIOU/;
      # and put the last one back on
      s/an$/án/;
      s/in$/ín/;
    }

    # c, ca -> s; d -> z; g, ga -> zh; t -> dh or ch or s
    my $c  = qr/c(?=(?:î|i[ën]?)$)/;
    my $ca = qr/c(?=(?:î|ië|e[mn])$)/;
    my $d  = qr/d(?=(?:î|i[ën]?)$)/;
    my $g  = qr/g(?=(?:î|i[ën]?)$)/;
    my $ga = qr/g(?=(?:î|ië|e[mn])$)/;
    my $k  = qr/k(?=(?:î|i[ën]?)$)/;
    my $t  = qr/t(?=(?:î|i[ën]?)$)/;

    s/^aklogî$/aklozhi/ ||
    s/^aklo$g/aklozh/o ||
    s/^ánselcu$d/ánselcuz/o ||
    s/^barsú$c/barsús/o ||
    s/^bela$c/belas/o ||
    s/^bo$c/bos/o ||
    s/^brö$ca/brös/o ||
    s/^bü$t/büs/o ||
    s/^chedesnagî$/chedesnazhi/ ||
    s/^chedesna$ga/chedesnazh/o ||
    s/^chu$ca/chus/o ||
    s/^dosi$c/dosis/o ||
    s/^dra$c/dras/o ||
    s/^dushi$c/dushis/o ||
    s/^dha$c/dhas/o ||
    s/^dhie$c/dhies/o ||
    s/^ecelógî$/ecelózhi/ ||
    s/^eceló$g/ecelózh/o ||
    s/^etalógî$/etalózhi/ ||
    s/^etaló$g/etalózh/o ||
    s/^feri$ca/feris/o ||
    s/^fifachi$c/fifachis/o ||
    s/^formi$ca/formis/o ||
    s/^glä$ca/gläs/o ||
    s/^goratî$/goradhi/ ||
    s/^gora$t/goradh/o ||
    s/^gra$k/grah/o ||
    s/^gutî$/gudhi/ ||
    s/^gu$t/gudh/o ||
    s/^hu$ca/hus/o ||
    s/^ktëlogî$/ktëlozhi/ ||
    s/^ktëlo$g/ktëlozh/o ||
    s/^ku$d/kuz/o ||
    s/^lertlogî$/lertlozhi/ ||
    s/^lertlo$g/lertlozh/o ||
    s/^logî$/lozhi/ ||
    s/^lo$g/lozh/o ||
    s/^mati$ca/matis/o ||
    s/^me$ca/mes/o ||
    s/^mevlogî$/mevlozhi/ ||
    s/^mevlo$g/mevlozh/o ||
    s/^morutî$/morudhi/ ||
    s/^moru$t/morudh/o ||
    s/^nagî$/nazhi/ ||
    s/^na$ga/nazh/o ||
    s/^ni$d/niz/o ||
    s/^pagî$/pazhi/ ||
    s/^pa$g/pazh/o ||
    s/^prologî$/prolozhi/ ||
    s/^prolo$g/prolozh/o ||
    s/^ra$k/rah/o ||
    s/^rogî$/rozhi/ ||
    s/^ro$g/rozh/o ||
    s/^rhitî$/rhichi/ ||
    s/^rhi$t/rhich/o ||
    s/^sfi$ca/sfis/o ||
    s/^shan$k/shanh/o ||
    s/^smeri$c/smeris/o ||
    s/^veratî$/veradhi/ ||
    s/^vera$t/veradh/o ||
    s/^yagî$/yazhi/ ||
    s/^ya$g/yazh/o ||
    1;

    if(! $keep_accents) {
      # remove unnecessary accents: if the accented vowel is
      # the penultimate vowel and the last vowel is not umlauted
      s/([áéíóúÁÉÍÓÚ])(?=[pbtdhcgkfvszmnlr]*[aeiouî][pbtdhcgkfvszmnlr]*$)/$unacc{$1}/;
    }
  }

  return $table;
}


sub adj {
  my $adj = shift;
  my $stem = $adj;
  my $table;

  if($stem =~ m/[pbtdhcgkfvszmnlr]$/ || $stem eq 'so') {
    $table = [ [ map "$stem$_", '', 'ei', '', 'án', 'î', 'ië', 'i', 'in' ],
               [ map "$stem$_", qw( a e a an î ië em en ) ] ];
  } elsif($stem =~ s/e$//) {
    $table = [ [ map "$stem$_", qw( e ei em en î eë em ein ) ],
               [ map "$stem$_", qw( ë ëi ä en î ië em en ) ] ];
  } elsif($stem =~ s/y$//) {
    $table = [ [ map "$stem$_", qw( y ii im ín î uë om uin ) ],
               [ map "$stem$_", qw( y ye ya yan î yië yem yen ) ] ];
  } elsif($stem =~ s/ë$//) {
    $table = [ [ map "$stem$_", qw( ë ëi ä én ëi ëë óm ëin ) ],
               [ map "$stem$_", qw( a e a an î ië em en ) ] ];
  } else {
    return;
  }

  # remove accents for words ending in án or ín or én or óm
  for(@$table) {
    for(@$_) {
      if(/[áíé]n$/ || /óm$/) {
        # remove all accents
        tr/áéíóú/aeiou/;
        # and put the last one back on
        s/an$/án/;
        s/in$/ín/;
        s/en$/én/;
        s/om$/óm/;
      }

      if(! $keep_accents) {
        # remove unnecessary accents: if the accented vowel is
        # the penultimate vowel and the last vowel is not umlauted
        s/([áéíóúÁÉÍÓÚ])(?=[pbtdhcgkfvszmnlr]*[aeiouî][pbtdhcgkfvszmnlr]*$)/$unacc{$1}/;
      }
    }
  }

  return $table;
}


1;
__END__