File Coverage

blib/lib/Lingua/IT/Conjugate.pm

Criterion	Covered	Total	%
statement	124	265	46.7
branch	75	184	40.7
condition	20	102	19.6
subroutine	10	14	71.4
pod	0	11	0.0
total	229	576	39.7

package Lingua::IT::Conjugate;

# use strict;
# use warnings;

@ISA = qw( Exporter );

@EXPORT_OK = qw(
	coniuga
	coniugazione
	declina
);

use FindBin;
#use Tie::RegexpHash;

use vars qw(
	$VERSION
	%Desinenza
	%Regolarizza
	%Irregolarita
	%Prefissi
	%Simile
	@Ausiliari_essere
	@Pronome
	@Pronome_riflessivo
	@Tempi
	$Errore
	%Opzioni
);

$VERSION = "0.50";

@Pronome = (
	'nessuno',
	'io  ',
	'tu  ',
	'lui ',
	'noi ',
	'voi ',
	'essi',
);
@Pronome_riflessivo = (
	'nessuno',
	'mi',
	'ti',
	'si',
	'ci',
	'vi',
	'si',
);

@Tempi = qw(
	presente				imperfetto
	passato_prossimo		trapassato_prossimo
	passato_remoto			trapassato_remoto
	futuro_semplice			futuro_anteriore
	congiuntivo_presente	congiuntivo_imperfetto
	congiuntivo_passato		congiuntivo_trapassato
	condizionale_presente	condizionale_passato
);

#tie %Opzioni, 'Tie::RegexpHash';
%Opzioni = (
#	qr/^(pronomi|pronouns)$/ => 1,
#	qr/^(coniuga_sconosciuti|conjugate_unknown)$/ => 1,
#	prefer_csv => 0,
#	qr/^(gender|sesso)$/ => 'M'
	pronomi => 1,
	coniuga_sconosciuti => 1,
	prefer_csv => 0,
	sesso => 'M',
);

inizializza();

sub inizializza {
	my($in_pod, $sezione, $verbo, $declinazione, $tempo, $tempo_ausiliare, $desinenze);
	my($forma_regolare, $tempi, $prefissi, $persona, $forma, $prefisso);
	$in_pod = 1;
	$sezione = "";
	while() {
		if($in_pod) {
			$in_pod = 0 if /^=cut/;
			next if $in_pod;
		}
		next if /^\s*#/ or /^\s*$/;
		chomp;
		s/^\s+|\s+$//;
		if(/^\[(.*)\]/) {
			$sezione = ucfirst(lc($1));
		} else {
			if($sezione eq "Desinenze") {
				($declinazione, $tempo, $desinenze) = split(/\s+/, $_, 3);
				$Desinenza{$declinazione} = {} unless exists $Desinenza{$declinazione};
				$Desinenza{$declinazione}{$tempo} = [] unless exists $Desinenza{$declinazione}{$tempo};
				$Desinenza{$declinazione}{$tempo} = [ split(/\s*,\s*/, $desinenze) ];

			} elsif($sezione eq "Composti") {
				($tempo, $tempo_ausiliare) = split(/\s+/, $_, 2);
				foreach $declinazione ( qw( are ere ire ) ) {
					$Desinenza{$declinazione} = {} unless exists $Desinenza{$declinazione};
					$Desinenza{$declinazione}{$tempo} = "ausiliare($tempo_ausiliare)+participio";
				}

			} elsif($sezione eq "Regolarizza") {
				($verbo, $forma_regolare, $tempi) = split(/\s+/, $_, 3);
				$Regolarizza{$verbo} = "$forma_regolare;$tempi";

			} elsif($sezione eq "Ausiliari_essere") {
				push(@Ausiliari_essere, $_);

			} elsif($sezione eq "Prefissi") {
				($verbo, $prefissi) = split(/\s+/, $_, 2);
				$Prefissi{$verbo} = [] unless exists $Prefissi{$verbo};
				$Prefissi{$verbo} = [ split(/\s+/, $prefissi) ];

			} elsif($sezione eq "Irregolarita") {
				($verbo, $tempo, $persona, $forma) = split(/\s+/, $_, 4);
				$Irregolarita{$verbo} = {} unless exists $Irregolarita{$verbo};
				$Irregolarita{$verbo}{$tempo} = {} unless exists $Irregolarita{$verbo}{$tempo};
				$Irregolarita{$verbo}{$tempo}{$persona} = $forma;
			}
		}
	}
	foreach $verbo (keys %Prefissi) {
		foreach $prefisso (@{$Prefissi{$verbo}}) {
			$Simile{ $prefisso.$verbo } = $verbo;
		}
	}
}

sub opzioni_default {
	no warnings;
	my($opzioni) = @_;
	my %default;
	# tie %default, 'Tie::RegexpHash';
	foreach my $opzione (keys %Opzioni) {
		$default{$opzione} = $Opzioni{$opzione};
	}

	my $chiamante = (caller(1))[3];
	$chiamante =~ s/Lingua::IT::Conjugate:://;

	if($chiamante eq 'coniuga') {
		$default{ pronomi } = 0;
	} elsif($chiamante eq 'coniugazione') {
		$default{ pronomi } = 0;
	}
	if(defined $opzioni and ref($opzioni) eq "HASH") {
		foreach (keys %$opzioni) {
			$default{$_} = $opzioni->{$_};
		}
	}
	return \%default;
}

sub coniuga {
	my($verbo, $tempo, $persona, $opzioni) = @_;
	my @risultato;
	my %risultato;

	$opzioni = opzioni_default( $opzioni );

	if( $opzioni->{coniuga_sconosciuti} == 0) {
		if(not verbo_esistente( $verbo )) {
			$Errore = "unknown verb ('$verbo')";
			return "[unknown verb ('$verbo')]";
		}
	}

	if(defined $tempo and defined $persona) {
		return coniuga_forma($verbo, $tempo, $persona);
	} elsif(not defined $tempo and defined $persona) {
		foreach $tempo (@Tempi) {
			$risultato{$tempo} = coniuga_forma($verbo, $tempo, $persona);
		}
		return wantarray ? %risultato : \%risultato;
	} elsif(defined $tempo and not defined $persona) {
		foreach $persona (1..6) {
			push(@risultato, coniuga_forma($verbo, $tempo, $persona));
		}
		return wantarray ? @risultato : join(", ", @risultato);
	} else {
		foreach $tempo (@Tempi) {
			foreach $persona (1..6) {
				push(@risultato, coniuga_forma($verbo, $tempo, $persona));
			}
			$risultato{$tempo} = [ @risultato ];
		}
		return wantarray ? %risultato : \%risultato;
	}
}

sub applica_irregolarita {
	my($risultato, $verbo, $tempo) = @_;
	if(exists $Irregolarita{$verbo}{$tempo}{'*'}) {
		if($Irregolarita{$verbo}{$tempo}{'*'} =~ /^~/) {
			eval "\$risultato =".$Irregolarita{$verbo}{$tempo}{'*'}.";"
		} else {
			$risultato = $Irregolarita{$verbo}{$tempo}{'*'};
		}
	}
	return $risultato;
}

sub coniuga_forma {
    my($verbo, $tempo, $persona, $opzioni) = @_;

	my($tema, $coniugazione, $base, $prefisso, $prefisso_tema, $desinenza, $risultato);
	my($ausiliare, $verbo_ausiliare, $tempo_ausiliare, $riflessivo);
	my @aggiustamenti;
	my %opzioni;

	$opzioni = opzioni_default( $opzioni );

	if($verbo =~ s/si$/e/) { $riflessivo = 1; }
	if($verbo =~ /[ou]re$/) {
		my $prova;
		($prova = $verbo) =~ s/re$/rre/;
		$prova =~ s/urre$/ucere/i;
		$prova =~ s/orre$/onere/i;
		if(exists $Simile{$prova}
		or exists $Regolarizza{$prova}
		or exists $Prefissi{$prova}) {
			$verbo = $prova;
		}
	}

	$verbo =~ s/urre$/ucere/i;
	$verbo =~ s/orre$/onere/i;

	if(exists $Simile{$verbo}) {
		($prefisso_tema = $verbo) =~ s/$Simile{$verbo}$//;
		$verbo = $Simile{$verbo};
	}

	if(exists $Regolarizza{$verbo}) {
		my($forma_regolare, $tempi) = split(/;/, $Regolarizza{$verbo});
		if($tempi eq "*" or $tempi =~ /$tempo/) {
    		$verbo = $forma_regolare;
    	}
    }

	if(exists $Irregolarita{$verbo}{$tempo}{$persona}) {
		$risultato = $Irregolarita{$verbo}{$tempo}{$persona};
		$risultato = $prefisso_tema . $risultato if defined $prefisso_tema;
		if($riflessivo) {
			$risultato = $Pronome_riflessivo[$persona]." ".$risultato;
		}
		return $risultato;
	}

	foreach (keys %Desinenza) {
        if($verbo =~ /^(.*)$_$/i) {
            $tema = $1;
            $coniugazione = $_;
            last;
        }
    }
    if(defined $coniugazione) {
		if(ref( $Desinenza{$coniugazione}{$tempo} )) {

			$desinenza = $Desinenza{$coniugazione}{$tempo}[$persona-1];
			($tema, $desinenza) = aggiusta(
				$coniugazione,
				$tempo,
				$persona,
				$tema,
				$desinenza,
			);

			$risultato = $tema . $desinenza;
			$risultato = applica_irregolarita( $risultato, $verbo, $tempo );
			$risultato = $prefisso_tema . $risultato if defined $prefisso_tema;
			if($riflessivo) {
				$risultato = $Pronome_riflessivo[$persona]." ".$risultato;
			}
		} else {
			($prefisso, $base) = split(/\+/, $Desinenza{$coniugazione}{$tempo});

			if($prefisso =~ /^ausiliare/) {
				($tempo_ausiliare = $prefisso) =~ s/^.*\((.*)\)$/$1/;
				if(grep( /^$verbo$/, @Ausiliari_essere)
				or $riflessivo) {
					$verbo_ausiliare = "essere";
				} else {
					$verbo_ausiliare = "avere";
				}
				$ausiliare = coniuga_forma($verbo_ausiliare, $tempo_ausiliare, $persona);
				$desinenza = $Desinenza{$coniugazione}{$base}[$persona-1];
				($tema, $desinenza) = aggiusta(
					$coniugazione,
					$base,
					$persona,
					$tema,
					$desinenza,
				);

				$risultato = $tema . $desinenza;
				$risultato = applica_irregolarita( $risultato, $verbo, $base );
				if($verbo_ausiliare eq "essere" and $persona > 3) {
					$risultato =~ s/o$/i/;
				}
				$risultato = $prefisso_tema . $risultato if defined $prefisso_tema;
				$risultato = $ausiliare . " " . $risultato;
				if($riflessivo) {
					$risultato = $Pronome_riflessivo[$persona]." ".$risultato;
				}
			} else {

				($base, @aggiustamenti) = split(/;/, $base);

				my %aggiustamenti;
				map { /(\w+)=(\w+)/; $aggiustamenti{$1} = $2; } @aggiustamenti;

				$desinenza = $Desinenza{$coniugazione}{$base}[$persona-1];

				if( exists $aggiustamenti{$persona} ) {
					$desinenza = $aggiustamenti{$persona};
				}

				($tema, $desinenza) = aggiusta(
					$coniugazione,
					$tempo,
					$persona,
					$tema,
					$prefisso . $desinenza,
				);

				$risultato = $tema . $desinenza;
				$risultato = applica_irregolarita( $risultato, $verbo, $tempo );
				$risultato = $prefisso_tema . $risultato if defined $prefisso_tema;
				if($riflessivo) {
					$risultato = $Pronome_riflessivo[$persona]." ".$risultato;
				}
			}
		}
    	return $risultato;
	} else {
		return "NON LO ".uc(coniuga_forma("sapere", "presente", $persona))." FARE!";
	}
}

sub aggiusta {
	my($coniugazione, $tempo, $persona, $tema, $desinenza) = @_;
	my($prima, $seconda);

	if( $coniugazione eq "are" ) {
		if( $tema =~ /[gc]$/ and $desinenza =~ /^[ie]/ ) {
			$tema .= "h";
		} elsif( $tema =~ /[gc]i$/ and $desinenza =~ /^[ie]/ ) {
			chop $tema;
		} elsif( $tema =~ /i$/ and $desinenza =~ /^i/ ) {
			chop $tema;
		}
	} elsif( $coniugazione eq "ere" ) {

		if($tema =~ /g(n|li)$/) {
			if($tempo eq "participio") {
				$tema =~ s/g(l|n)i?$/($1 eq "n") ? "n" : "l"/e;
				$desinenza = "to";
			} elsif($tempo eq "passato_remoto"
			and ($persona == 1 or $persona == 3 or $persona == 6) ) {
				$tema =~ s/g(l|n)i?$/$1s/;
				$desinenza =~ s/ei/i/;
				$desinenza =~ s/Š/e/;
				$desinenza =~ s/erono/ero/;
			} elsif($tempo eq "presente") {
				if($persona == 1 or $persona == 6) {
					$tema =~ s/g(n|l)i?$/$1g/;
				} else {
					$desinenza =~ s/^i// if $tema =~ /i$/;
				}
			} elsif($tempo eq "congiuntivo_presente") {
				if($desinenza =~ /^a/) {
					$tema =~ s/g(n|l)i?$/$1g/;
				} else {
					$desinenza =~ s/^i// if $tema =~ /i$/;
				}
			}

		} elsif( $tema =~ /n$/ and $desinenza =~ /^[oa]/ ) {
			$tema .= "g";

		} elsif( $tema =~ /[gnr]g$/ and $tempo eq "passato_remoto"
		and ($persona == 1 or $persona == 3 or $persona == 6) ) {
			$tema =~ s/(.)g$/( ($1 eq "g") ? "s" : $1 ) . "s"/e;
			$desinenza =~ s/ei/i/;
			$desinenza =~ s/Š/e/;
			$desinenza =~ s/erono/ero/;

		} elsif( $tema =~ /[nr]d$/ and $tempo eq "passato_remoto"
		and ($persona == 1 or $persona == 3 or $persona == 6) ) {
			$tema =~ s/(.)d$/( ($1 eq "n") ? "" : $1 ) . "s"/e;
			$desinenza =~ s/ei/i/;
			$desinenza =~ s/Š/e/;
			$desinenza =~ s/erono/ero/;

		} elsif( $tema =~ /isc$/
		and ($tempo eq "presente" or $tempo eq "congiuntivo_presente")
		and ($persona == 4 or $persona == 5) ) {
			$tema =~ s/isc$//;
			$desinenza =~ s/^./i/;

		} elsif( $tema =~ /[aeious][cg]$/ and $tempo eq "participio") {
			$tema .= "i";

		} elsif( $tema =~ /([^aeiou])([^aeiou])$/ and $tempo eq "participio") {
			($prima, $seconda) = ($1, $2);
			if($seconda eq "g") {
				$prima = "t" if $prima eq $seconda;
				$seconda = "t";
				$desinenza = "o";
			} elsif($prima eq "m" and $seconda eq "p") {
				$prima = "t";
				$seconda = "t";
				$desinenza = "o";
			} elsif($prima eq "r" and $seconda eq "d") {
				$seconda = "s";
				$desinenza = "o";

			} elsif($prima eq "n" and $seconda eq "d") {
				if($tema =~ /o..$/) {
					$prima = "s";
					$seconda = "t";
					$desinenza = "o";
				} elsif($tema =~ /[ue]..$/) {
					$prima = "";
					$seconda="s";
					$desinenza = "o";
				}
			}
			$tema =~ s/..$/$prima$seconda/;
		}
	}
	return ($tema, $desinenza);
}

sub declina {
    my($verbo, $tempo, $opzioni) = @_;
    $opzioni = opzioni_default( $opzioni );
    my @result;
    for my $persona (1..6) {
    	if($opzioni{pronomi}) {
    		push(@result, $Pronome[$persona] . " " . coniuga_forma($verbo, $tempo, $persona, $opzioni));
    	} else {
    		push(@result, coniuga_forma($verbo, $tempo, $persona, $opzioni));
    	}
    }
    return @result;
}

sub verbo {
    my($forma) = @_;
}

sub verbo_esistente {
	my($verbo) = @_;
	$verbo =~ s/si$/e/;
	if($verbo =~ /[ou]re$/) {
		my $prova;
		($prova = $verbo) =~ s/re$/rre/;
		$prova =~ s/urre$/ucere/i;
		$prova =~ s/orre$/onere/i;
		if(exists $Simile{$prova}
		or exists $Regolarizza{$prova}
		or exists $Prefissi{$prova}) {
			$verbo = $prova;
		}
	}
	if(open(VERBI, "$FindBin::RealBin/verbi") ) {
		my $conosciuto = 0;
		while() {
			chomp;
			$_ eq $verbo and $conosciuto = 1, last;
		}
		return $conosciuto;
	} else {
		return 1;
	}
}

sub coniugazione {
	my($verbo, $opzioni) = @_;
	my($tempo, $persona, $risultato);

	$opzioni = opzioni_default( $opzioni );

	if( $opzioni->{coniuga_sconosciuti} == 0) {
		if(not verbo_esistente( $verbo )) {
			$Errore = "unknown verb ('$verbo')";
			return "[unknown verb ('$verbo')]";
		}
	}

	$risultato = "";
	foreach ($tempo = 0; $tempo <= $#Tempi; $tempo += 2) {
		$risultato .= centered(uc($Tempi[$tempo]), 35, "-");
		$risultato .= " ";
		$risultato .= centered(uc($Tempi[$tempo+1]), 35, "-");
		$risultato .= "\n";
		for $persona (1..6) {
			$risultato .= sprintf "%-35s %-35s\n",
				( ($opzioni->{pronomi} == 1) ? $Pronome[$persona]." " : "" ).coniuga_forma($verbo, $Tempi[$tempo], $persona),
				( ($opzioni->{pronomi} == 1) ? $Pronome[$persona]." " : "" ).coniuga_forma($verbo, $Tempi[$tempo+1], $persona);
		}
	}
	return $risultato;

	sub centered {
		my($string, $len, $fill) = @_;
		$fill = " " unless defined $fill;
		my $result = $fill x (($len-length($string))/2-1);
		$result .= " ";
		$result .= $string;
		$result .= " ";
		$result .= $fill x ($len-length($result));
		return $result;
	}
}

### TEST_START
if(defined $ARGV[0]) {
	if(not defined $ARGV[1] or $ARGV[1] eq "*") {
		print coniugazione( $ARGV[0] , { pronomi => 1 }), "\n";
	} else {
		print join("\n", declina($ARGV[0], $ARGV[1])), "\n";
	}
}
### TEST_END

1;

__DATA__