# ObjectBinding.pm, Conrad Hughes 2005.

package XML::Parser::Style::ObjectBinding;

use warnings;
use strict;

sub Init {
  my $expat = shift;
  $expat->{Lists} = [];
  $expat->{Curlist} = [];
}

sub Start {
  my $expat = shift;
  my $tag = shift;
  push @{ $expat->{Lists} }, $expat->{Curlist};
  $expat->{Curlist} = [ [ @_ ] ];
}

sub End {
  my $expat = shift;
  my $tag = shift;
  my $class = "${$expat}{Pkg}::$tag";
  my $newobj = $class->new( @{ $expat->{Curlist} } );
  $expat->{Curlist} = pop @{ $expat->{Lists} };
  push @{ $expat->{Curlist} }, $newobj;
}

sub Char {
  my $expat = shift;
  my $text = shift;
  my $clist = $expat->{Curlist};
  my $pos = $#$clist;

  if ($pos >= 0 and ! ref($clist->[$pos])) {
    $clist->[$pos] .= $text;
  } else {
    push @$clist, $text;
  }
}

sub Final {
  my $expat = shift;
  delete $expat->{Lists};
  @{ delete $expat->{Curlist} }
}

1;
__END__

=head1 NAME

XML::Parser::Style::ObjectBinding

=head1 SYNOPSIS

  use XML::Parser;
  my $p = XML::Parser->new(Style => 'ObjectBinding', Pkg => 'MyPkg');
  my $foo = $p->parsefile('foo.xml');

  { package MyPkg::rootelement;

    sub new {
      my ($class, $attrs, @contents) = @_;
      bless {
        ATTRS    => $attrs,
        CONTENTS => \@contents
      }, $class
    }

    sub my_method {
      ...
    }
  }

=head1 DESCRIPTION

This module implements the ObjectBinding style for XML::Parser.

This expects a class corresponding to each element in the XML document
being parsed (with name created by appending "::" and the element name
to the package set with the Pkg option).  Once the end tag is reached
for each element, the corresponding class's new() method is called with
parameters consisting of a listref to the attributes from the start tag
followed by all of the objects contained between the start and end tags.
The return value from new will be supplied in the list of contents to
the element's containing element constructor, or (if this is the root
element) as return value from the parse method.

=head1 SEE ALSO

L<XML::Parser::Style::Tree>
L<XML::Parser::Style::Object>

=cut

##</code><code>##

#!/usr/bin/perl

use strict;
use warnings;

use XML::Parser;

my $parser = new XML::Parser(Style => 'ObjectBinding', Pkg => 'MyPkg');

my ($object) = $parser->parse('<container><thing>hi</thing><thing>there</thing></container>');
$object->my_method();

($object) = $parser->parse('<thing/>');
print "Got \"$object\"\n";

{ package MyPkg::container;

  sub new {
    my ($class, $attrs, @contents) = @_;
# Check contents are ok - a list of <thing>s.
    die "Non-thing (" . ref $_ . ") in container!" for
        grep ! $_->isa('MyPkg::thing'), @contents;
    bless {
      THINGS => \@contents
    }, $class
  }

  sub my_method { # Execute stuff on my things.
    my $self = shift;
    $_->say_hello for @{ $self->{THINGS} };
    print "(", scalar( @{ $self->{THINGS} } ), " things processed.)\n";
  }

}

{ package MyPkg::thing;

  sub new {
    my ($class, $attrs, @contents) = @_;
# Check contents are ok - a plain old string.
    @contents = ('') unless @contents;
    die "A <thing> should just contain text!" unless @contents == 1 and
        ! ref $contents[0];
    bless \$contents[0], $class
  }

  sub say_hello { # What it says.
    my $self = shift;
    print "This thing contains \"$$self\".\n";
  }

}