use strict;
use warnings;

my $data = <<DATA;
 BEGIN DSRECORD
      Identifier "ROOT"
...
      CenturyBreakYear "30"
   END DSRECORD
DATA

open my $fh, '<', \$data or die "Unable to open data file: $!";
my $obj = main->new (undef, fh => $fh);

1 while defined $obj->nextLine ();
close $fh;


sub new {
    my ($class, $context, %params) = @_;
    
    $class = ref $class || $class;
    my $self = bless {%params}, $class;

    if (defined $context && ref $context) {
        $self->{$_} = $context->{$_} for keys %$context;
    }
    $self->{context} = $context;
    return $self;
}


sub nextLine {
    my $self = shift;
    my $fh = $self->{fh};
    
    while (defined (my $line = <$fh>)) {
        chomp $line;
        return $line unless $line =~ /^\s*begin\s+(\w+)/i;
    
        if ($self->{skipping}) {
            $self->skip ();
            next;
        }

        my $recType = lc $1;
        my $handler = $self->can ("rec_$recType");
        my $nested = $self->new ($self);

        $handler ? $nested->$handler () : $self->skip ($recType);
        next;
    }
    
    return undef;
}


sub skip {
    my ($self, $recType) = @_;
    
    warn ">>> Can't handle $recType records (line $.)\n"
        if defined $recType;

    ++$self->{skipping};
    1 while defined $self->nextLine ();
    --$self->{skipping};
}


sub rec_dsrecord {
    my ($self) = @_;
    my $fh = $self->{fh};
    my @wantedFields = qw/identifier name description/;
    my $matchStr = join '|', @wantedFields;
    my $fieldsMatch = qr/$matchStr/i;

    while (defined (my $line = $self->nextLine ())) {
        next unless $line =~ /($fieldsMatch)\s+(.*)/;
        $self->{lc $1} = $2;
    }
    
    my @missingFields = grep {! exists $self->{$_}} @wantedFields;
    my @gotFields = grep {exists $self->{$_}} @wantedFields;
    
    warn "Missing @missingFields fields in DSRECORD ending line $."
        if @missingFields;
        
    print join (', ', map {"$_: $self->{$_}"} @gotFields), "\n";
}