=pod

=head1 NAME

Pedigree::Language - encapsulating language issues for pedigree library

=head1 SYNOPSIS

use Pedigree::Language;

$lang = new Pedigree::Language(I<$language>[, I<$encoding>]);

$lang->Header();

$lang->Language();

$lang->Encoding();

$lang->GetFieldNames();

$lang->GetValues();

$lang->GetSpecialNames();

$lang->PrintField(I<$field>, $<$value>);


=head1 DESCRIPTION

This package defines the language-dependent parts of the pedigree
library.  The idea is to gather everything about language here, so adding
a new language should be (presumably) be easy.


=cut

####################################################################
# Define the package                                               #
####################################################################

package Pedigree::Language;
use strict;

#
# And package methods
#


####################################################################
#    new                                                           #
####################################################################

=pod

=over 4

=item B<new>(I<$language>[, I<$encoding>]);

Construct the new interpreter from the given language and encoding names.

=cut


sub new {
    my $self={};
    my ($class,$language,$encoding)=@_;
    $self->{'language'}=$language;
    if (!defined($encoding) && ($language eq 'russian')) {
	$encoding='cp1251';
    }
    if (defined($encoding)) {
	$self->{encoding}=$encoding;
    }
    bless $self, $class;
    return ($self);
}


####################################################################
#    Header                                                        #
####################################################################


=pod

=item B<Header> ()

Print the language-related lines of the document preamble

=cut

sub Header {
    my $self=shift;
    my $result;
    if ($self->Encoding()) {
	$result .= '\usepackage['.$self->Encoding().']{inputenc}'."\n";
    }
    if (!($self->Language() eq 'english')) {
	$result .= '\usepackage['.$self->Language().']{babel}'."\n";
    }
    return $result;

}


####################################################################
#    Language                                                      #
####################################################################


=pod

=item B<Language> ()

Print the current language

=cut

sub Language {
    my $self=shift;
    return $self->{'language'};
}

####################################################################
#    Encoding                                                      #
####################################################################


=pod

=item B<Encoding> ()

Print the current encoding

=cut

sub Encoding {
    my $self=shift;
    return $self->{'encoding'};
}


####################################################################
#    GetFieldNames                                                 #
####################################################################


=pod

=item B<GetFieldNames>();

Outputs  a reference to a hash
"field_name_in_this_language"=>"field_name_in_English"

=cut

sub GetFieldNames() {
    my $self=shift;
    my %result=();
    
    #
    # The English names are default
    #
    %result=(
	     'Id'=>'Id',
	     'Name'=>'Name',
	     'Sex'=>'Sex',
	     'DoB'=>'DoB',
	     'DoD'=>'DoD',
	     'Mother'=>'Mother',
	     'Father'=>'Father',
	     'Proband'=>'Proband',
	     'Condition'=>'Condition',
	     'Type'=>'Type',
	     'Twins'=>'Twins',
	     'Comment'=>'Comment',
	     'SortOrder'=>'SortOrder',
	     'Sort'=>'SortOrder');

    #
    # Russian names depend on the encoding
    #
    if (($self->Language() eq 'russian') && ($self->Encoding() eq 'koi8-r')) {
	$result{'Идент'}='Id';
	$result{'ФИО'}='Name';
	$result{'Пол'}='Sex';
	$result{'Рожд'}='DoB';
	$result{'Умер'}='DoD';
	$result{'Мать'}='Mother';
	$result{'Отец'}='Father';
	$result{'Пробанд'}='Proband';
	$result{'Состояние'}='Condition';
	$result{'Тип'}='Type';
	$result{'Близнецы'}='Twins';
	$result{'Комментарий'}='Comment';
	$result{'ПорядокСортировки'}='SortOrder';
	$result{'Сорт'}='SortOrder';
    }
    if (($self->Language() eq 'russian') && ($self->Encoding() eq 'cp1251')) {
	$result{'хДЕМР'}='Id';
	$result{'тхн'}='Name';
	$result{'оНК'}='Sex';
	$result{'пНФД'}='DoB';
	$result{'сЛЕП'}='DoD';
	$result{'лЮРЭ'}='Mother';
	$result{'нРЕЖ'}='Father';
	$result{'оПНАЮМД'}='Proband';
	$result{'яНЯРНЪМХЕ'}='Condition';
	$result{'рХО'}='Type';
	$result{'вМЙЪОЕГЩ'}='Twins';
	$result{'йНЛЛЕМРЮПХИ'}='Comment';
	$result{'оНПЪДНЙяНПРХПНБЙХ'}='SortOrder';
	$result{'яНПР'}='SortOrder';
    }


    return \%result;
}

####################################################################
#    GetValues                                                     #
####################################################################


=pod

=item B<GetValues>();

Outputs  a reference to a hash
"field_value_in_this_language"=>"field_value_in_English"

=cut

sub GetValues {
    my $self=shift;
    my %result=();
    
    #
    # The English values are default
    #
    %result=(
	     'male'=>'male',
	     'female'=>'female',
	     'unknown'=>'unknown',
	     'yes'=>1,
	     'no'=>0,
	     'normal'=>'normal',
	     'obligatory'=>'obligatory',
	     'oblig'=>'obligatory',
	     'asymptomatic'=>'asymptomatic',
	     'asymp'=>'asymptomatic',
	     'affected'=>'affected',
	     'affect'=>'affected',
	     'infertile'=>'infertile',
	     'Infertile'=>'infertile',
	     'sab'=>'sab',
	     'Sab'=>'sab',
	     'monozygotic'=>'monozygotic',
	     'monozygot'=>'monozygotic',
	     'qzygotic'=>'qzygotic',
	     'qzygot'=>'qzygotic',
	     '?'=>'qzygotic',
	     );

    #
    # Russian names depend on the encoding
    #
    if (($self->Language() eq 'russian') && ($self->Encoding() eq 'koi8-r')) {
	$result{'муж'} = 'male';
	$result{'жен'} = 'female';
	$result{'м'} = 'male';
	$result{'ж'} = 'female';
	$result{'неизв'} = 'unknown';
	$result{'неизвестно'} = 'unknown';
	$result{'да'} = 1;
	$result{'нет'} = 0;
	$result{'Да'} = 1;
	$result{'Нет'} = 0;
	$result{'норм'} = 'normal';
	$result{'здоров'} = 'normal';
	$result{'облигат'} = 'obligatory';
	$result{'асимп'} = 'asymptomatic';
	$result{'больн'} = 'affected';
	$result{'болен'} = 'affected';
	$result{'бесплодн'} = 'infertile';
	$result{'выкидыш'} = 'sab';
	$result{'однояйцев'} = 'monozygotic';
	$result{'монозиготн'} = 'monozygotic';
	$result{'монозиг'} = 'monozygotic';
	$result{'дизиг'} = '';
    }

    if (($self->Language() eq 'russian') && ($self->Encoding() eq 'cp1251')) {
	$result{'ЛСФ'} = 'male';
	$result{'ФЕМ'} = 'female';
	$result{'Л'} = 'male';
	$result{'Ф'} = 'female';
	$result{'МЕХГБ'} = 'unknown';
	$result{'МЕХГБЕЯРМН'} = 'unknown';
	$result{'ДЮ'} = 1;
	$result{'МЕР'} = 0;
	$result{'дЮ'} = 1;
	$result{'мЕР'} = 0;
	$result{'МНПЛ'} = 'normal';
	$result{'ЪДПТПЧ'} = 'normal';
	$result{'НАКХЦЮР'} = 'obligatory';
	$result{'ЮЯХЛО'} = 'asymptomatic';
	$result{'АНКЭМ'} = 'affected';
	$result{'ВПМЕО'} = 'affected';
	$result{'ВЕУРМПДО'} = 'infertile';
	$result{'ЧЩЛЙДЩЫ'} = 'sab';
	$result{'ПДОПСКГЕЧ'} = 'monozygotic';
	$result{'НПОПЪЙЗПФО'} = 'monozygotic';
	$result{'НПОПЪЙЗ'} = 'monozygotic';
	$result{'ДЙЪЙЗ'} = '';
    }

    return \%result;
}

####################################################################
#    GetSpecialNames                                               #
####################################################################


=pod

=item B<GetSpecialNames>();

Some values for the 'Name' field start with C<#>.  They are special.
This subroutine outputs  a reference to a hash
"special_name_in_this_language"=>"special_name"

=cut

sub GetSpecialNames {
    my $self=shift;
    my %result=();
    
    #
    # The English values are default
    #
    %result=(
	     'abort'=>'abortion',
	     'childless'=>'childless',
	     );

    #
    # Russian names depend on the encoding
    #
    if (($self->Language() eq 'russian') && ($self->Encoding() eq 'koi8-r')) {
	$result{'аборт'} = 'abortion';
	$result{'бездетн'} = 'childless';
    }

    if (($self->Language() eq 'russian') && ($self->Encoding() eq 'cp1251')) {
	$result{'БВПТФ'} = 'abortion';
	$result{'ВЕЪДЕФО'} = 'childless';
    }

    return \%result;
}


####################################################################
#    PrintField                                                    #
####################################################################


=pod

=item B<PrintField>(I<$field>, I<$value>);

Formats the value I<$value> of the given field I<$field> according
to the rules of the given language.

=cut

sub PrintField {
    my $self=shift;
    my ($field, $value) = @_;

    
    #
    # The English values are default
    #

    if ($self->Language() eq 'english') {
	if ($field eq 'DoB' ) {
	    return "born: $value";
	}
	if ($field eq 'DoD' ) {
	    return "died: $value";
	}
	if ($field eq 'AgeAtDeath') {
	    return "age at death: $value";
	}
    }

    if ($self->Language() eq 'russian') {
	if ($value eq 'unknown') {
	    $value = '{\cyr\cyrn\cyre\cyri\cyrz\cyrv.}';
	}
	if ($field eq 'DoB' ) {
	    return '{\cyr\cyrr\cyro\cyrd.}'." $value";
	}
	if ($field eq 'DoD') {
	    return '{\cyr\cyru\cyrm.}'." $value";
	}
	if ($field eq 'AgeAtDeath') {
	    return '{\cyr\cyru\cyrm. \cyrv{} \cyrv\cyro\cyrz\cyrr. }'." $value";
	}
	#
	# Special name
	#
	if ($field eq 'Name' && $value eq 'abortion') {
	    return '{\cyr\cyra\cyrb\cyro\cyrr\cyrt}';
	}
    }


    #
    # The last resort
    #
    return $value;


}


####################################################################
#    THE END                                                       #
####################################################################


=pod

=back

=head1 ENVIRONMENT

The calling program should define B<$main::DEBUG> and set it to 0
or 1.

=head1 SEE ALSO

pedigree(1), Pedigree(3)

=head1  AUTHOR

Boris Veytsman, Leila Akhmadeeva, 2006, 2007


=cut

1;