view release on metacpan or  search on metacpan

lib/SIL/Shoe/Control.pm  view on Meta::CPAN

package SIL::Shoe::Control;

=head1 NAME

SIL::Shoe::Control - Abstract superclass for SF Control files in Shoebox

=head1 DETAILS

This class parses a control file based on a parsing model passed by the
subclass. It handles groups and all the vagueries currently encountered in
Shoebox control files.

The following methods are available:

=cut

use strict;
use Carp;
use Symbol;

=head2 SIL::Shoe::Control->new("filename")

This creates a new type object, but only reads the name of the database type.
This allows SIL::Shoe::Settings to read all the type files without filling up
memory. The settings file is only fully read when $s->read is called.

=cut

sub new
{
    my ($class, $file) = @_;
    my ($self, $fh);

    $fh = Symbol->gensym();
    if (not open ($fh, "$file")) {
        croak("Unable to open $file");
        return undef;
    }

    $self->{' INFILE'} = $fh;
    $self->{' fname'} = $file;
    open($fh, "$file") and ($_ = <$fh>);
    s/^\xEF\xBB\xBF//o;        # BOM in UTF8
    chomp;
    if (m/^\\\+(\S+)\s+(.*?)\s*$/o)
    { $self->{'name'} = $2; }
    else
    { croak("Malformed database type file ($file)"); }
    close ($fh);
    bless $self, $class;
}

=head2 $s->read

This reads the type file into memory and readjusts everything to make stuff
easier to find.

=cut

sub read
{
    my ($self) = @_;

    return $self if $self->{' read'};
    
    open ($self->{' INFILE'}, $self->{' fname'})
        || &croak("Unable to re-open $self->{' fname'}");

    $self->parse($self->{' INFILE'});
    close ($self->{' INFILE'});
    $self->{' read'} = 1;
    return $self;
}

sub parse
{
    my ($self, $fh) = @_;
    my ($target, $name, $val, $curr_mark, $info, $new, $inlines, $multiline);
    my ($temp);

    $target = $self;
    while (<$fh>)
    {
#        chomp;
        s/\s+$//o;
        s/^\xEF\xBB\xBF//o;
        next unless $_ ne "";
        if (m/^\\\-(.*?)\s*$/oi)
        {
            $inlines = 0;
            if ($1 ne pop(@{$self->{' hiern'}}))      # ') for editor
            { &croak("Synchronisation error in $self->{' fname'} at $_"); }
            else
            {
                $target = pop(@{$self->{' hier'}});
                return $self if $#{$self->{' hier'}} < 0;
            }
        }           # ( /* for editor
        elsif (m/^\\\+(\S+)\s*(.*?)\s*$/oi)
        {
            $name = $1;
            $val = $2;
            $info = $self->group($name);