=head1 NAME

=pod

=head1 NAME

Pedigree::Parser - parser for the input file

=head1 SYNOPSIS

use Pedigree::Parser;

$parser = new Pedigree::Parser(I{$inputline>, I<$lang>)

$parser->Parse($inputline);

=head1 DESCRIPTION

This package parses input for the pedigree library and is used to
define nodes.

=cut

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

package Pedigree::Parser;
use strict;

####################################################################
# package variables #
####################################################################

#
# %fields_to_convert: the hash of fields that contain limited
# number of values and the default value for such field
#

my %fields_to_convert = (
'Sex'=>'unknown',
'Proband'=>0,
'Condition'=>'normal',
'Type' => ''
);

####################################################################
# And package methods #
####################################################################

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

=pod

=over 4

=item B<new>(I<$inputline>, I<$lang>);

Construct a new parser from the pipe-separated line at input

=cut

sub new {
my ($class,$inputline,$lang)=@_;
my $self={};

#
# The hash $self->{fields} is the main stored data structure.
# The key is the field, the value is the number of the field
# in the input lines.
#
my %fieldnames=%{$lang->GetFieldNames()};
chomp $inputline;
$inputline =~ s/^\s+//;
$inputline =~ s/\s+$//;
my @input = split /\s*\|\s*/, $inputline;
for (my $i=0; $i<scalar @input; $i++) {
my $name=$input[$i];
if (exists $fieldnames{$name}) {
my $field=$fieldnames{$name};
$self->{fields}->{$field}=$i;
} else {
print STDERR "Warning: unknown field $name\n";
}
}

if ($main::DEBUG) {
print STDERR "Field names:\n";
foreach my $key (keys %fieldnames) {
my $field=$fieldnames{$key};
my $pos=$self->{fields}->{$field};
print STDERR "\t$key\t$field\t$pos\n";
}
}

#
# The hash $self->{values} contains values for fields
# with closed sets of values.
#
my %values=%{$lang->GetValues()};
$self->{values}=\%values;

if ($main::DEBUG) {
print STDERR "Field values:\n";
foreach my $key (keys %values) {
my $value=$values{$key};
print STDERR "\t$key\t$value\n";
}
}

#
# The hash $self->{special_names} contains special values
# for the 'Name' field
#
my %special=%{$lang->GetSpecialNames()};
$self->{'special_names'}=\%special;

if ($main::DEBUG) {
print STDERR "Special names:\n";
foreach my $key (keys %special) {
my $value=$special{$key};
print STDERR "\t$key\t$value\n";
}
}

if ($main::DEBUG) {
print STDERR "Special fields:\n";
foreach my $key (keys %fields_to_convert) {
my $value=$fields_to_convert{$key};
print STDERR "\t$key\t$value\n";
}
}

bless ($self,$class);
return $self;
}

####################################################################
# Parse #
####################################################################

=pod

=item B<Parse>(I<$inputline>);

Take a line of comma-separated values; return a reference to a
hash of parsed values

=cut

sub Parse {
my ($self,$inputline)=@_;
chomp $inputline;
$inputline =~ s/^\s+//;
$inputline =~ s/\s+$//;
my @input = split /\s*\|\s*/, $inputline;
if ($main::DEBUG) {
print STDERR "Parsing line:$inputline\n";
}

my %result;

foreach my $field (keys %{$self->{fields}}) {
my $i=$self->{fields}->{$field};
my $value=$input[$i];
#
# Special fields...
#
if (exists $self->{values}->{$value}) {
$value=$self->{values}->{$value};
}
if (exists $fields_to_convert{$field}) {
if (length($value) == 0 ) {
$value=$fields_to_convert{$field};
}
}
#
# Dropping empty fields
#
if (length($value) == 0 ) {
next;
}

#
# Converting Name field
#
if (($field eq 'Name') && ($value =~ /^\#/)) {
foreach my $regexp (keys %{$self->{'special_names'}}) {
my $name=$self->{'special_names'}->{$regexp};
$value =~ s/^(\#$regexp.*)/\#$name/i;
}
}

#
# And finishing
#
$result{$field}=$value;
if ($main::DEBUG) {
print STDERR "\t$field\t$value\n";
}
}

return \%result;

}

####################################################################
# 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;