File Coverage

blib/lib/Lingua/Phonology.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

#!/usr/bin/perl -w

package Lingua::Phonology;

$VERSION = 0.35_03;

use strict;
use warnings;
use warnings::register;

use Carp qw/carp croak/;
use Lingua::Phonology::Common;
use Lingua::Phonology::Features;
use Lingua::Phonology::Segment;
use Lingua::Phonology::Symbols;
use Lingua::Phonology::Rules;
use Lingua::Phonology::Syllable;


=head1 NAME

Lingua::Phonology - an object model for lingistic phonology and sound change

=head1 SYNOPSIS

    use Lingua::Phonology;
    $phono = new Lingua::Phonology;

    # Get sub-objects
    $features = $phono->features;
    $symbols = $phono->symbols;
    $rules = $phono->rules;
    $syllabification = $phono->syllable;
    $segment = $phono->segment;

    # Load phonology defaults
    $phono->loadfile;

    # Load a phonology definition from a file
    $phono->loadfile('language.xml');

    # Save phonology definition to a file
    $phono->savefile('language.xml');

=head1 ABSTRACT

Lingua::Phonology is a unified module for handling phonological descriptions
and units. It includes sub-modules for hierarchical (feature-geometric) sets of
features, phonetic or orthographic symbols, individual segments, linguistic
rules, syllabification algorithms, etc. It is written as an object-oriented
module, wherein one will generally have a single object for the list of
features, one for the phonetic symbols, one for the set of rules, etc., and
multiple segment objects to be programatically manipulated.

=cut

# Remainder of POD is after the __END__ token

sub err ($) { warnings::warnif(shift); return; };

# Constructor - creates new (empty) objects
sub new {
	my $proto = shift;
	my $class = ref($proto) || $proto;
	my $self = bless {}, $class;

	$self->{FEATURES} = Lingua::Phonology::Features->new();
	$self->{SYMBOLS} = Lingua::Phonology::Symbols->new($self->{FEATURES});
	$self->{RULES} = Lingua::Phonology::Rules->new();
	$self->{SYLLABLE} = Lingua::Phonology::Syllable->new();

	return $self;
}

# Next section deals w/ making accessor methods
# Accessor methods to create and/or iterate over (order may be significant!)
my @accessors = qw/features symbols syllable rules/;

# Object types to create/expect--all accessors must be defined here
my %classes = (
    features => 'Lingua::Phonology::Features',
    symbols => 'Lingua::Phonology::Symbols',
    rules => 'Lingua::Phonology::Rules',
    syllable => 'Lingua::Phonology::Syllable'
);

# Continuations (if needed)
my %continue = (
    features => sub { $_[0]->{SYMBOLS}->features($_[1]) if defined $_[1] }
);

# Create methods for each of the accessors
while (my ($name, $class) = each %classes) {
    my $key = uc $name;
    no strict 'refs';
    *$name = sub {
        return $_[0]->{$key} unless @_ > 1;
        my ($self, $val) = @_;
        croak "Argument to $name() not a $class" unless _is($val, $class);
        $self->{$key} = $val;
        $continue{$name}->(@_) if exists $continue{$name};
        return $self->{$key};
    };
}

# Get blank segments
sub segment {
	my $self = shift;
	my $seg = Lingua::Phonology::Segment->new($self->{FEATURES});
	$seg->symbolset($self->{SYMBOLS});
	return $seg;
}

# Load a complete phonology definition from a file
sub loadfile {
    my ($self, $file) = @_;
    my $err = 0;

    # If called with one argument, load defaults. Submodules implement
    # "default" in different ways--that's their problem. They must do the right
    # thing when loadfile() is called on them with no arguments.
    if (not defined $file) {
        for (@accessors) {
            $self->$_->loadfile or $err = 1;
        }
    }

    # When given an actual filename
    else {
        my $parse;
        eval { $parse = _parse_from_file $file };
        return err($@) unless $parse;

        for (@accessors) {
            $self->$_->_load_from_struct($parse->{$_}) or $err = 1;
        }
    }

    # $return should
    return $err ? () : 1;
}

# Save a total phonology. We do this by concatenating the strings returned by
# the to_str() methods in the various submodules.
sub savefile {
    my ($self, $file) = @_;

    my $str = '';
    for (@accessors) {
        $str .= "\n" . $self->$_->_to_str;
    }
    $str = "\n$str\n";

    eval { $file = _to_handle($file, '>') };
    return err($@) if $@;

    print $file $str;
    return $str;
}

1;

__END__