diff options
Diffstat (limited to 'Master/texmf-dist/scripts/pedigree-perl/Pedigree/Language.pm')
-rw-r--r-- | Master/texmf-dist/scripts/pedigree-perl/Pedigree/Language.pm | 459 |
1 files changed, 459 insertions, 0 deletions
diff --git a/Master/texmf-dist/scripts/pedigree-perl/Pedigree/Language.pm b/Master/texmf-dist/scripts/pedigree-perl/Pedigree/Language.pm new file mode 100644 index 00000000000..bcae95d3074 --- /dev/null +++ b/Master/texmf-dist/scripts/pedigree-perl/Pedigree/Language.pm @@ -0,0 +1,459 @@ +=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. + +=over 4 + +=cut + +#################################################################### +# Define the package # +#################################################################### + +package Pedigree::Language; +use strict; + +# +# And package methods +# + + +#################################################################### +# new # +#################################################################### + +=pod + + +=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; |