File Coverage

blib/lib/Lingua/FI/Inflect.pm

Criterion	Covered	Total	%
statement	9	43	20.9
branch	0	36	0.0
condition	0	348	0.0
subroutine	3	5	60.0
pod	0	2	0.0
total	12	434	2.7

package Lingua::FI::Inflect;

use 5.008;
use strict;
use warnings;
require Exporter;

our @ISA = qw(Exporter);
our %EXPORT_TAGS = ( 'all' => [ qw(taivuta to_number %sijamuodot) ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw( );
our $VERSION = '0.02';

our %sijamuodot=(
   monikko     => 0,
   genetiivi   => 1,
   inessiivi   => 2,
   elatiivi    => 3,
   adessiivi   => 4,
   ablatiivi   => 5,
   partitiivi  => 6,
   essiivi     => 7,
   illatiivi   => 8,
   translatiivi=> 9,
);

# haluaa taivuttamattoman sanan
# palauttaa taivutetun sanan
sub taivuta{
    my($sijamuoto_id,$sana)=@_;

    # järjestä ao. lista ensin pituuden mukaan, sitten aakkosjärjestykseen
    # konsonantit
    # viimeinen id=6

    my $k ="bcdfghjklmnpqrstvwxz";
    my $k2="smnl";
    my $k5="k";
    my $k4="lr";
    my $k3="vh";
    my $k6="h";
    my $k7="kptq";

    # järjestä ao. lista ensin pituuden mukaan, sitten aakkosjärjestykseen
    # vokaalit
    # viimeinen id=2

    my $v ="aeiouy:;";
    my $v2="i";


    # muuta ä-kirjaimet kaksoispisteiksi ja ö-kirjaimet puolipisteiksi
    # hae käytetäänkö sanassa skandeja vai ei
    # $a == a tai ä
    # $o == o tai ö

    (local $_,my $a,my $o)=to_number($sana);


    # määritä sijamuodon sijapääte $p-muuttujaan
    # määritä $p1-muuttujaan sijapääte ilman skandeja
    # määritä $p2-muuttujaan sijapääte skandeilla varustettuna

    my($p)=(
         $sijamuoto_id == 0 ? "t"      # monikko
       : $sijamuoto_id == 1 ? "n"      # genetiivi
       : $sijamuoto_id == 2 ? "ss$a"   # inessiivi
       : $sijamuoto_id == 3 ? "st$a"   # elatiivi
       : $sijamuoto_id == 4 ? "ll$a"   # adessiivi
       : $sijamuoto_id == 5 ? "lt$a"   # ablatiivi
       : $sijamuoto_id == 6 ? "$a"     # partitiivi
       : $sijamuoto_id == 7 ? "n$a"    # essiivi
       : $sijamuoto_id == 8 ? "$a"."n" # illatiivi
       : $sijamuoto_id == 9 ? "ksi"    # translatiivi
    : die "Wrong case");
    (my $p1=$p) =~ tr/y:;/uao/;
    (my $p2=$p) =~ tr/aou/:;y/;


    # 1 = regex
    # 2 = käytettävän säännön id; viimeinen id = 111
    # 3 = esimerkkisanan alku
    # 4 = esimerkkisanan loppu         ; isolla kirjaimet, jotka ovat aina juuri nämä
    # 5 = esimerkkisanan lopun käännös ; isolla kirjaimet, jotka ovat aina juuri nämä
    # 6 = ryhmän id, johon regex kuuluu; viimeinen id = 10
    # 7 = ryhmän järjestys; pienin ensin. Laita perään +, jos järjestys jaetaan jonkun muun kanssa
    #
    #  1                                         2       3      4      5      6 7

       # illatiivi (kotiin)
       $sijamuoto_id == 8 && (
             s/(.*[$v])([$v])             $ /$1$2h$2n    !77 /x

          # poikkeukset
          || s/^([th])(uu?l)i             $ /$1$2een     !92 /x
          || s/^kivi                      $ /kiveen      !93 /x #

          # monikko
          || s/(.*)([$v])(\2)t            $ /$1$2isiin   !94 /x # lampaat lampaisiin
          || s/(.*)([$k])([a:])t          $ /$1$2$o\0ihin!95 /x # perunat perunoihin

          || s/(.*)(s)                    $ /$1kseen     !96 /x # sirkus kseen
          || s/(.*)(e)                    $ /$1$2$2seen  !78 /x # hame   hameeseen
          || s/(.*)(nk)(i)                $ /$1$2een     !79 /x # henki  henkeen
          || s/(.*)([$v])                 $ /$1$2$2n     !80 /x # kissa  kissaan
          || s/(.*)([$k]+)                $ /$1$2iin     !81 /x # kiss   kissiin
       )

       # partitiivi
       || $sijamuoto_id == 6 && (
             s/(.*[$v])([$v])             $ /$1$2t$a     !82 /x

          # poikkeukset
          || s/^([th])(uu?l)i             $ /$1$2ta      !108/x #
          || s/^kivi                      $ /kive$a      !98 /x #

          # monikko
          || s/(.*)([$v])(\2)t            $ /$1$2it$a    !99 /x # lampaat lampaita
          || s/(.*)([$v])([$k])([a:])t    $ /$1$2$3$o\0it$a!100/x # perunat perunoita
          || s/(.*)([$k])([a:])t          $ /$1$2$o\0j$a !   /x # aika    aikoja
          || s/(.*)([$k])([$v])t          $ /$1$2$3j$a   !   /x # jauhot  jauhoja

          || s/(.*)(s)                    $ /$1$2ta      !109/x # sirkus ta
          || s/(.*)(e)                    $ /$1$2tt$a    !83 /x # hame   hametta
          || s/(.*)(nk)(i)                $ /$1$2e$a     !84 /x # henki  henkeä
          || s/(.*)([$v])                 $ /$1$2$a      !85 /x # kissa  kissaa
          || s/(.*)([$k]+)                $ /$1$2i$a     !86 /x # kiss   kissiä
       )

       # essiivi
       || $sijamuoto_id == 7 && (
             s/(.*[$v])([$v])             $ /$1$2n$a     !87 /x

          # poikkeukset
          || s/^([th])(uu?l)i             $ /$1$2ena     !110/x
          || s/^kivi                      $ /kiven$a     !102/x #

          # monikko
          || s/(.*)([$v])(\2)t            $ /$1$2in$a    !103/x # lampaat lampaina
          || s/(.*)([$k])([a:])t          $ /$1$2$o\0in$a!104/x # perunat perunoina

          || s/(.*)(s)                    $ /$1ksena     !111/x # sirkus ksena
          || s/(.*)(e)                    $ /$1$2$2n$a   !88 /x # hame   hameena
          || s/(.*)(nk)i                  $ /$1$2en$a    !89 /x # henki  henkenä
          || s/(.*)([$v])                 $ /$1$2n$a     !90 /x # kissa  kissana
          || s/(.*)([$k]+)                $ /$1$2in$a    !91 /x # kiss   kissinä
       )

       # lainasanat, jotka päättyvät vokaaliin
       || s/(
          andante
          |anime
          |apache
          |appassionato
          |beta
          |beeta
          |blanko
          |byte
          |delta
          |data
          |desi
          |curry
          |copy
          |collie
          |college
          |chippendale
          |city
          |bluffi
          |beige
          |bridge
          |boutique
          |cache
          |case
          |deadline
          |freestyle
          |foto
          |fleece
          |empire
          |epo
          |esperanto
          |extreme
          |fluori
          |expo
          |folklore
          |ellipsi
          |ensemble
          |forte
          )                       $ /$1$p       !59 /x

    # lainasanat, jotka päättyvät konsonanttiin

    || s/(
           blues
          |charleston
          |evergreen
          |automarket
          |bouquet
          |bullshit
          |burnout
          |chat
          |debet
          |et
          |exit
          |fahrenheit
          |kermit
          )                       $ /$1i$p      !60 /x

    # monikko
    || /t$/ && (
         s/([a:])t                    $ /$o\0i$p     !105/x # kal   AT     oi   10 2
      || s/([$v])t                    $ /$1$p        !106/x # pul   u      u
      || s/(.)                        $ /$1i$p       !107/x # marke T      tIT
    )

    # numerot 8-10

    || s/(
          seitsem:
         |ykdeks:
         |kahdeksa
         |kymmene
         )n                         $ /$1$p        !73 /x #                  10 1

    # säännöt, jotka toimivat myös nimille

    || s/nen                        $ /se$p        !22 /x # kisu NEN    SEN  10 2

    # nimet
    || s/^([A-Z45].*)([$k7])\2([$v])$ /$1$2$3$p    !67 /x # Ja   tta    ta    9 0
    || s/^([A-Z45].*[$v])           $ /$1$p        !61 /x # Vil  e      e     9 1
    || s/^([A-Z45].*)               $ /$1i$p       !62 /x # Ki   m      mI    9 2

    # pronominit

    || $sijamuoto_id == 0 && (
          s/^min:                   $ /me          !63 /x
       || s/^sin:                   $ /te          !63 /x
       || s/^h:n                    $ /he          !63 /x
       || s/^t:m:                   $ /n:m:        !63 /x
       || s/^tuo                    $ /nuo         !63 /x
       || s/^se                     $ /ne          !63 /x
    )

    || (
          s/^min:                   $ /minu$p1     !63 /x
       || s/^sin:                   $ /sinu$p1     !63 /x
       || s/^h:n                    $ /h:ne$p2     !63 /x
       || s/^me                     $ /meid:$p2    !63 /x
       || s/^te                     $ /teid:$p2    !63 /x
       || s/^he                     $ /heid:$p2    !63 /x
       || s/^n:m:                   $ /n:ide$p2    !63 /x
       || s/^nuo                    $ /noide$p1    !63 /x
       || s/^ne                     $ /niide$p2    !63 /x
       || s/^t:m:                   $ /t:m:$p2     !63 /x
       || s/^tuo                    $ /tuo$p1      !63 /x
       || s/^se                     $ /se$p2       !63 /x
    )

    # yksittäiset sanat, joita ei voi laittaa yhdyssanaan

    || s/^aika                   $ /aja$p       !64 /x # vrt. taika   -> taia
    || s/^([th])(uu?l)i          $ /$1$2e$p     !64 /x # vrt. kuli    -> kulin

    # yksittäiset sanat, mahdolliset myös yhdyssanoissa

    || s/poika                   $ /poja$p      !66 /x # reliikki
    || s/mies                    $ /miehe$p     !66 /x # vrt. hies    -> hiekse
    || s/yhteys                  $ /yhteyde$p   !66 /x # vrt. risteys -> risteykse
    || s/haku                    $ /hau$p       !66 /x # vrt. laku    -> laku
    || s/laki                    $ /lai$p       !66 /x # vrt. khaki   -> khaki
    || s/tuoli                   $ /tuoli$p     !66 /x # vrt. huoli   -> huole
    || s/henki                   $ /henge$p     !66 /x # vrt. renki   -> rengi
    || s/puomi                   $ /puomi$p     !66 /x # vrt. luomi   -> luome
    || s/(th])uli                $ /$1uule$p    !66 /x # vrt. muuli   -> muuli
    || s/nauris                  $ /naurii$p    !66 /x
    || s/veli                    $ /velje$p     !66 /x # vrt. peli    -> peli
    || s/ruis                    $ /rukii$p     !66 /x
    || s/ananas                  $ /ananakse$p  !66 /x
    || s/business                $ /businekse$p !66 /x
    || s/kirves                  $ /kirvee$p    !66 /x

    # numerot 1-6

    || s/(y|ka)ksi               $ /$1hde$p     !1  /x
    || s/(kolme|nelj:)           $ /$1$p        !1  /x
    || s/^(vii)si                $ /$1de$p      !1  /x # numero - kuitenkin aviisi -> aviisi
    || s/(kuu)si                 $ /$1de$p      !1  /x

    # numerot 11-19

    || s/(.+)(toista)            $ /(taivuta($sijamuoto_id,$1))[0].$2.'!74' /ex

    # järjestysluvut 1-10

    || s/(
          yhde
         |kahde
         |kolma
         |nelj:
         |viide
         |kuude
         |seitsem:
         |kahdeksa
         |yhdeks:
         |kymmene
         )s                      $ /$1nne$p     !75 /x



    # varmat säännöt, joissa etsimisosan säännöt ovat ilman muuttujia (esim. $1)
    || s/^([vm])(er)i            $ /$1$2e$p     !33 /x #        vERI  > verE
    || s/(n)si                   $ /$1$1e$p     !38 /x # ka     NSI   > nnE
    || s/(m)pi                   $ /$1$1e$p     !11 /x # la     MPI   > mmE
    || s/(iel)i                  $ /$1e$p       !19 /x # k      IELI  > elE
    || s/([yu]psi)               $ /$1$p        !55 /x # r      yPSI  > ypsi    8 1
    || s/(p)(s)i                 $ /$1$2e$p     !32 /x # la     PSI   > psE     8 2
    || s/d([a:])s                $ /t$1$1$p     !24 /x # hi     DAS   > TAA
    || s/([st])(([ou]u)|([;y]y))s$ /$1$2de$p    !44 /x # out    oUS   > ouDE
    || s/([$v])\1                $ /$1$1$p      !58 /x # atelj  ee    > ee

    # sekalaiset säännöt

    || s/(m)\1([a:])s            $ /$1p$2$2$p   !41 /x # ha     MmAS  > hamPaa  3 -2
    || s/(n)\1([a:])s            $ /$1$1$2kse$p !42 /x # ka     NnAS  > nnaKSE  3 0
    || s/([$k])\1([a:])s         $ /$1t$2$2$p   !36 /x # ma     llAS  > malTaa  3 -1
    || s/([$k])d([a:])s          $ /$1t$2$2$p   !40 /x # a      hDAS  > ahTaa   3 -0.5
    || s/(n)\1e                  $ /$1tee$p     !12 /x # la     NnE   > nTEE    3 1+
    || s/(m)\1e                  $ /$1$1ee$p    !13 /x # a      MmE   > mmEE    3 1+
    || s/([$k2])\1([$v])         $ /$1$1$2$p    !29 /x # ki     ssa   > ssa     3 2
    || s/([$k7])\1([$v])         $ /$1$2$p      !02 /x # ta     tti   > ti
    || s/(r)si                   $ /$1$1e$p     !43 /x # vi     RSI   > rrE
    || s/(sv|rm|sm)(i)           $ /$1$2$p      !68 /x # ka     RmI   > rmI
    || s/([$k])([$k3])$v2        $ /$1$2e$p     ! 3 /x # hi     rvi   > rvE
    || s/([$v])\1s               $ /$1$1de$p    ! 4 /x # tilais uus   > uuDE    1 1
    || s/([$v])([$v])s           $ /$1$2kse$p   ! 5 /x # lauk   auS   > auKSE   1 2
    || s/([$v])([$v])k([a:])     $ /$1$2$3$p    ! 9 /x # s      iiKA  > iiA
    || s/([$v])p([$v])           $ /$1v$2$p     !16 /x # n      aPa   > aVa
    || s/([$v])([$k])([a:])s     $ /$1$2$2$3$3$p!25 /x # hi     DAS   > TAA     4 0
    || s/([$k])([$k])([a:])s     $ /$1$2$3$3$p  !37 /x # ka     rvAS  > karvaa  3 0
    || s/([$v])s                 $ /$1kse$p     !23 /x # tik    aS    > aKSE    4 1
    || s/(tt)([$v])n             $ /$1$2i$p     !28 /x #                        4 3
    || s/(t)(i)n                 $ /$1$1$2me$p  !45 /x # lii    TIN   > ttiME   4 4+
    || s/(t)([o;])n              $ /$1$1$2m$a$p !26 /x # ehdo   TON   > ttoMA   4 4+
    || s/(l)(i)n                 $ /$1$2me$p    !30 /x # puhe   LIN   > liME    4 4+
    || s/(e)(n)                  $ /$1$2e$p     !49 /x # ahv    EN    > enE     4 5
    || s/([$v])([$k])            $ /$1$2i$p     !17 /x # kerm   it    > itI     4 6
    || s/([$v])(\1si)            $ /$1$2$p      !52 /x # m      uuSI  > uusi    6 1
    || s/([$v])si                $ /$1de$p      ! 6 /x # ka     uSI   > uDE     6 2
    || s/([$v])(t)(e)            $ /$1$2$2$3$3$p!20 /x # ka     TE    > ttee    2 -2
    || s/d(e)                    $ /t$1$1$p     !21 /x # kai    DE    > Tee     2 -1
    || s/(sk)(e)                 $ /$1$2$2$p    !50 /x # rui    SKE   > skee    2 -0.5
    || s/(k)(e)                  $ /$1$1$2$2$p  !46 /x # pil    KE    > kkee    2 -0.5
    || s/(e)                     $ /$1$1$p      !18 /x # ven    E     > ee      2 0
    || s/(te[$k6])ti             $ /$1di$p      !56 /x # arkki  TEhTI > tehDI   2 1.1
    || s/(e[$k6])ti              $ /$1de$p      !57 /x # le     hTI   > hDE     2 1.2
    || s/([$k6])t([$v])          $ /$1d$2$p     !27 /x # jo     hTo   > hDo     2 1
    || s/([$v])t([$v])           $ /$1d$2$p     !10 /x # ha     uTa   > uDa     2 2
    || s/([$k])(i)(v)i           $ /$1$2$3e$p   !14 /x # k      ivI   > ivE     2 3
    || s/([$k])([o;])([$k])i     $ /$1$2$3i$p   !51 /x # aero   sOlI  > olI     5 1
    || s/([o;]ni)                $ /$1$p        !54 /x # p      ONI   > oni     5 3
    || s/([o;])\1([$k])i         $ /$1$1$2i$p   !69 /x # b      OolI  > ooli    5 4
    || s/([o;])([$k])i           $ /$1$2e$p     !31 /x # hu     OlI   > olE     5 5
    || s/([$k4])t([a:])          $ /$1$1$2$p    ! 7 /x # si     lTA   > llA
    || s/(n)k([$v])              $ /$1g$2$p     !28 /x # la     NKo   > ngo
    || s/(n)t([$v])              $ /$1$1$2$p    !15 /x # ka     NTo   > nno
    || s/((au)|(:y))ki           $ /$1e$p       !47 /x # h      AUKI  > auE
    || s/([o;]im|ie[$k])i        $ /$1e$p       !48 /x # t      OIMI  > oimE
    || s/(l)t([$v])              $ /$1$1$2$p    !70 /x # pe     LTi   > lli
    || s/(l)k([i])               $ /$1je$p      !72 /x # ky     LKI   > lJE
    || s/(l)k([a:])              $ /$1$2$p      !71 /x # su     LKa   > a

    # perussäännöt
    || s/([$v])                  $/$1$p         ! 8 /x # kirj   a    > a        7 1
    || s/(.*)                    $/$1i$p        !53 /x # aid    S    > sI       7 2
    ;

    tr/:;/\ä\ö/;

    m/^(.*?) *!(.*)/;
    return $1,$2;
}

# change scandinavic letters 'ä' to ':' and 'ö' to ';' in the given word
# return changed word,a-skand,o-scand
# a-skand == 'a' if scands are not used and ':' if they are
# o-skand == 'o' if scands are not used and ';' if they are
sub to_number{
   my($temp)=@_;
   my($muisti,$apu,$scand)=undef;
   $scand=1;
   foreach my $kirjain(split //,$temp){
      my $ascii=ord($kirjain);
      if($ascii == 195){
         $muisti=1;
      }else{
         if($ascii == 164 && $muisti){
            $kirjain=":";
         }elsif($ascii == 182 && $muisti){
            $kirjain=";";
         }
         $muisti=0;
         $apu.=$kirjain;
      }
      $scand=1 if $kirjain =~ /[y:;]/;
      $scand=0 if $kirjain =~ /[aou]/;
   }
   return $apu,$scand ? ":" : "a",$scand ? ";" : "o";
}

1;

__END__