#============================================================= -*-Perl-*-
#
# Template::Plugin::XML::View
#
# DESCRIPTION
#   Template Toolkit plugin to parse XML and generate a view by raising
#   events to a Template::View object for each element in the XML source.
#
#   -- UNDER CONSTRUCTION -- NOT INCLUDED IN THE MAIN DISTRIBUTION --
#
# AUTHOR
#   Andy Wardley   <abw@cpan.org>
#
# COPYRIGHT
#   Copyright (C) 2001-2004 Andy Wardley.  All Rights Reserved.
#
#   This module is free software; you can redistribute it and/or
#   modify it under the same terms as Perl itself.
#
# REVISION
#   $Id: View.pm,v 2.4 2003/03/17 22:29:16 abw Exp $
#
#============================================================================

package Template::Plugin::XML::View;

require 5.004;

use strict;
use Template::Plugin;
use XML::Parser;

use base qw( Template::Plugin );
use vars qw( $VERSION $DEBUG $XML_PARSER_ARGS $ELEMENT );

$VERSION = sprintf("%d.%02d", q$Revision: 2.4 $ =~ /(\d+)\.(\d+)/);
$DEBUG   = 0 unless defined $DEBUG;
$XML_PARSER_ARGS = {
    ErrorContext  => 4,
    Namespaces    => 1,
    ParseParamEnt => 1,
    NoExpand      => 1,
};

$ELEMENT = 'Template::Plugin::XML::View::Element';

#------------------------------------------------------------------------
# new($context, $file_or_text, \%config)
#------------------------------------------------------------------------

sub new {
    my $class   = shift;
    my $context = shift;
    my $args    = ref $_[-1] eq 'HASH' ? pop(@_) : { };
    my ($input, $about);

    # determine the input source from a positional parameter (may be a 
    # filename or XML text if it contains a '<' character) or by using
    # named parameters which may specify one of 'file', 'filename', 'text'
    # or 'xml'

    if ($input = shift) {
        if ($input =~ /\</) {
            $about  = 'xml text';
        }
        else {
            $about = "xml file $input";
            $input = $class->file_contents($input);
        }
    }
    elsif ($input = $args->{ text } || $args->{ xml }) {
        $about = 'xml text';
    }
    elsif ($input = $args->{ file } || $args->{ filename }) {
        $about = "xml file $input";
        $input = $class->file_contents($input);
    }
    else {
        $class->throw('no filename or xml text specified');
    }
    
    # munge input to protect entity refs
    $input =~ s/&/&amp;/g;
    
    my $xpargs = {
        map { exists $args->{$_} 
              ? ( $_, $args->{ $_ } )
                  : ( $_, $XML_PARSER_ARGS->{ $_ } ) }
        keys %$XML_PARSER_ARGS,
    };
    
    my $parser = XML::Parser->new(
        %$xpargs,
        Style    => 'Template::Plugin::XML::View::Parser',
        Handlers => {
            Init => sub {
                my $expat = shift;
                DEBUG("[Init]\n") if $DEBUG;
                $expat->{ _TT2_XVIEW_TEXT    }  = '';
                $expat->{ _TT2_XVIEW_RESULT  }  = '';
                $expat->{ _TT2_XVIEW_CONTEXT }  = $context;
                $expat->{ _TT2_XVIEW_STACK   }  = [ ];
            },
        },
    );
    my $result = $parser->parse($input);

    DEBUG("result: $result\n") if $DEBUG;
    return $result;
}


sub file_contents {
    my ($self, $file) = @_;
    my $text;
    local *FP;
    local $/ = undef;
    open(FP, $file) || $self->throw("cannot read XML file $file: $!");
    $text = <FP>;
    close(FP);
    return $text;
}
    

#------------------------------------------------------------------------
# _throw($errmsg)
#
# Raise a Template::Exception of type XML.View via die().
#------------------------------------------------------------------------

sub throw {
    my ($self, $error) = @_;
    die (Template::Exception->new('XML.View', $error));
}

sub DEBUG { print STDERR @_ };


#========================================================================
# Template::Plugin::XML::View::Parser
#
# Package defines subroutines which are called by the XML::Parser
# instance.  They manipulate a stack of T-::P-::XML::View::Element
# objects which each represent nested elements currently under parse
# at any time, with the innermost element object on top of the stack.
# These subs call the element() 
#========================================================================

package Template::Plugin::XML::View::Parser;
use vars qw( $DEBUG $ELEMENT );

*DEBUG   = \*Template::Plugin::XML::View::DEBUG;
$ELEMENT = 'Template::Plugin::XML::View::Element';


sub Start {
    my ($expat, $name, %attr) = @_;
    my $attr = \%attr;

    # flush any character content
    Text($expat) if length $expat->{ _TT2_XVIEW_TEXT };

    if ($DEBUG) {
        my $iattr = join(' ', map { "$_=\"$attr{$_}\"" } keys %attr);
        $attr = " $attr" if $attr;
        DEBUG("[Start] <$name$attr>\n");
    }

    my $stack = $expat->{ _TT2_XVIEW_STACK };

    my $element = $ELEMENT->new($name, \%attr)
        || $stack->[-1]->throw($ELEMENT->error());
    
    push(@$stack, $element);
}

sub End {
    my ($expat, $name) = @_;

    # flush any character content
    Text($expat) if length $expat->{ _TT2_XVIEW_TEXT };

    DEBUG("[End] </$name>\n") if $DEBUG;

    my $stack = $expat->{ _TT2_XVIEW_STACK };
    my $top = pop(@$stack);
    my $end = $top->end($expat, $name)
        || $top->throw($top->error());
    if (@$stack) {
        $stack->[-1]->child($expat, $name, $end);
    }
    else {
        DEBUG("popped last handler off stack\n") if $DEBUG;
#        die "corrupt stack\n";
        $expat->{ _TT2_XVIEW_RESULT } = $end;
    }
}

sub Char {
    my ($expat, $char) = @_;

    DEBUG("[Char] [$char]\n") if $DEBUG;

    # push character content onto buffer
    $expat->{ _TT2_XVIEW_TEXT } .= $char;

}


#------------------------------------------------------------------------
# Text()
#
# This is an extension subroutine which we're using to buffer chunks
# of Char input into complete text blocks.  These then get notified to 
# the parent in one happy bundle rather than several scraggly lumps.
#------------------------------------------------------------------------

sub Text {
    my $expat = shift;
    my $text  = $expat->{ _TT2_XVIEW_TEXT };

    if ($DEBUG) {
        my $dbgtext = $text;
        $dbgtext =~ s/\n/\\n/g;
        DEBUG("[Text] [$dbgtext]\n") if $DEBUG;
    }

    $expat->{ _TT2_XVIEW_STACK }->[-1]->text($expat, $text);
    $expat->{ _TT2_XVIEW_TEXT } = '';
}


sub Final {
    my $expat = shift;
    return $expat->{ _TT2_XVIEW_RESULT } || die "no result\n";

    my $stack = $expat->{ _TT2_XVIEW_STACK };
    my $top = pop(@$stack) || die "corrupt stack in Final";
    my $end = $top->end($expat)
        || $top->throw($top->error());
    my $r = $expat->{ _TT2_XVIEW_RESULT } || die "no result\n";# $end;
    DEBUG("[Final] => [$r]\n") if $DEBUG;
    return $r;
}



#========================================================================
# Template::Plugin::XML::View::Element
#
# Implements a parser handler for representing each element in the 
#========================================================================

package Template::Plugin::XML::View::Element;


sub new {
    my ($class, $name, $attr) = @_;
    bless {
        name    => $name,
        attr    => $attr,
        content => [ ],
    }, $class;
}

# called to receive character content
sub text {
    my $self = shift;
    my $expat = shift;
    push(@{ $self->{ content } }, @_);
}

# called to receive completed child element
sub child {
    my ($self, $expat, $name, $child) = @_;
    push(@{ $self->{ content } }, $child);    
}

# called at end of element
sub end {
    my ($self, $expat, $name) = @_;
    return $self;
}

# generate element as XML
sub xml {
    my $self = shift;
    my $name = $self->{ name };

    # generate XML representation of attributes
    my $attr = $self->{ attr };
    $attr = join(' ', map {
        "$_=\"$attr->{$_}\"";
    } keys %$attr);
    $attr = " $attr" if length $attr;

    # generate XML representation of content
    my $content = $self->{ content };
    $content = join(' ', map {
        ref $_ ? $_->xml() : $_;
    } @$content);

    # generate complete XML element
    return length $content 
        ? "<${name}${attr}>$content</$name>"
        : "<${name}${attr} />";
}


sub present {
    my ($self, $view) = @_;
    my $vars = {
        %$self,
        %{ $self->{ attr } },
        element => $self,
        content => sub { $self->content($view) },
    };
    $view->include($self->{ name }, $vars)
}

sub content {
    my ($self, $view) = @_;
    return $self->{ content } unless $view;
    my $output = '';
    foreach my $node (@{ $self->{ content } }) {
	$output .= ref $node ? $node->present($view) : $node;
    }
    return $output;
}


1;

__END__