view release on metacpan or  search on metacpan

Phonology/Symbols.pm  view on Meta::CPAN

    # Sort diacritics by number of keys.
	$self->{DCRINDEX} = [ 
        sort
        {
            my %a = $self->{DIACRITS}->{$a}->all_values;
            my %b = $self->{DIACRITS}->{$b}->all_values;
            return keys(%b) <=> keys(%a);
        } 
        keys %{$self->{DIACRITS}}
    ];

    # Also add diacritics to VALINDEX
	for (keys %{$self->{DIACRITS}}) {
		my %feats = $self->{DIACRITS}->{$_}->all_values;
		$self->{VALINDEX}->{$_} = \%feats;
	}

	return 1;
} 

sub loadfile {
	my ($self, $file) = @_;

    my $parse;
    
    # Loading default symbols
    if (not defined $file) {
        my $start = tell DATA;
        my $string = join '', <DATA>;
        eval { $parse = _parse_from_string($string, 'symbols') };
        return err $@ if $@;
        seek DATA, $start, 0;
    }

    # Loading an actual file
    else {
        eval { $parse = _parse_from_file($file, 'symbols') };
        if (!$parse) {
            return $self->old_loadfile($file);
        }
    }

    $self->_load_from_struct($parse);
}

sub old_loadfile {
    my ($self, $file) = @_;

    eval { $file = _to_handle($file, '<') };
    return err $@ if $@;
    err "Deprecated method";

	while (<$file>) {
		s/#.*$//; # Remove comments
		if (/^\s*(\S*)\t+(.*)/) { # General line format
			my $symbol = $1;
			my @desc = split(/\s+/, $2);

			my $proto = Lingua::Phonology::Segment->new( $self->features );
			for (@desc) {
				if (/(\S+)=(\S+)/) { # Feature defs like coronal=1
					$proto->value($1, $2);
				} 
				elsif (/([*+-])?(\S+)/) { # Feature defs like +feature or feature
					my $val = $1 ? $1 : 1;
					$proto->value($2, $val);
				}
			} 
			$self->symbol($symbol => $proto);
		} 
	} 

    close $file;

	$self->{REINDEX} = 1;
} 

sub _load_from_struct {
	my ($self, $parse) = @_;

	while ( my ($sym, $val) = each %$parse ) {
		my $proto = new Lingua::Phonology::Segment($self->{FEATURES},
			{ map { $_ => $val->{feature}->{$_}->{value} } keys %{$val->{feature}} } );
		$self->symbol($sym => $proto);
	}
	$self->{REINDEX} = 1;
}

sub _to_str {
	my $self = shift;

	my $href = {};
	for ($self->{SYMBOLS}, $self->{DIACRITS}) {
		for my $sym (keys %$_) {
			my %h = $_->{$sym}->all_values;
			for (keys %h) {
                $h{$_} = '*' if not defined $h{$_};
				$href->{$sym}->{feature}->{$_} = { value => $h{$_} };
			}
		}
	}

    return eval { _string_from_struct({ symbols => { symbol => $href } }) };
}

sub spell {
	my $self = shift;

	my @return = ();
	for my $comp (@_) {
		return err("Bad argument to spell()") unless _is_seg($comp);
		my $winner = $self->score($comp);
		push (@return, $winner ? $winner : '_?_');
	} 

	local $" = '';
	return wantarray ? @return : "@return";
} 
	
sub score {
	my $self = shift;