package Froody::Walker::XML;
use strict;
use warnings;
use base 'Froody::Walker::Driver';

use Froody::Logger;
my $logger = get_logger('froody.walker.xml');

use XML::LibXML;
  
=head1 NAME

Froody::Walker::XML - read and write XML

=head1 SYNOPSIS

=head1 DESCRIPTION

Turn xml into data in the form of Implementation class returns.

=cut

sub init_source {
  my ($self, $source) = @_;
  
  if ($source and !ref($source)) {
    $source = XML::LibXML->new->parse_string( $source )->documentElement;
  }
  
  return $source;
}

sub init_target {
  my ($self, $xpath, $parent) = @_;
  
  my $doc = $parent ? $parent->ownerDocument 
                    : XML::LibXML->createDocument("1.0", "UTF8");
                    
  return $doc->createDocumentFragment unless $xpath;
 
  my $name = (split '/', $xpath)[-1];
 
  return $doc->createElement($name);
}

sub validate_source {
  my ($self, $source, $path) = @_;
  my $spec = $self->spec_for_xpath($path);

  my %check = map { $_ => 1 } @{ $spec->{attr} };
  my @my_attr = map { $_->name } $source->attributes();
  for (@my_attr) {
    $logger->warn("bad attr '$_' in node '$path' (not in spec)") unless $check{$_};
  }

  %check = map { ($path ? "$path/$_" : $path) => 1 } @{ $spec->{elts} };
  my @my_elem = map { $_->nodeType == 1 ? $_->nodeName : () } $source->childNodes();
  for (@my_elem) {
    $logger->warn("bad element '$_' in node '$path' (not in spec)") unless $check{($path ? "$path/$_" : $path)};
  }

  if (!$spec->{text} and my $text = $self->read_text($source, $path)) {
    warn $source->toString(1);
    $logger->warn("bad text content '$text' for node '$path' (not in spec)");
  }

  return 1;
}

sub read_attribute {
  my ($self, $source, $path, $attr) = @_;
  return $source->getAttribute($attr);
}

sub read_text {
  my ($self, $source, $path) = @_;
  
  my $text = $source->findvalue('./text()');
  $text =~ s/^\s+//;
  $text =~ s/\s+$//;
  return $text;
}

sub child_sources {
  my ($self, $source, $xpath, $element) = @_;
  return $source->findnodes( "./$element" ) ;
}

sub _encode {
  my ($target,$value) = @_;
  return Encode::encode($target->ownerDocument->encoding, $value)
}

sub write_attribute {
  my ($self, $target, $path, $attr, $value) = @_;
  
  $target->setAttribute($attr, _encode($target, $value));
  return $target;
}

sub write_text {
  my ($self, $target, $xpath_key, $value) = @_;
  $target->appendText(_encode($target, $value));
  return $target;
}


sub add_child_to_target {
  my ($self, $target, $xpath, $element, $child) = @_;
  $target->addChild($child);
  return $target;
}


=head1 BUGS

None known.

Please report any bugs you find via the CPAN RT system.
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Froody>

=head1 AUTHOR

Copyright Fotango 2005.  All rights reserved.

Please see the main L<Froody> documentation for details of who has worked
on this project.

This module is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.

=head1 SEE ALSO

L<Froody>, L<Froody::Walker>

=cut

1;