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

use Encode qw(encode);

use Froody::Logger;

my $logger = get_logger('froody.walker.terse');

=head1 NAME

Froody::Walker::Terse - read and write Terse data.

=head1 SYNOPSIS

=head1 DESCRIPTION

Turn what Implementation class returns into the structure
L<Froody::Response> expects.

=over

=cut

=item text_only_spec( path )

returns true if the spec at this location specifies that there
is _only_ text content in this node.

=back

=cut

sub text_only_spec {
  my ($self, $path) = @_;
  my $spec = $self->spec_for_xpath($path);
  return 1 unless $spec;
  warn "No spec for $path" unless $spec;
  return 0 if (@{$spec->{elts}} || @{$spec->{attr}});
  return 1;
}



sub init_source {
  my ($self, $source) = @_;
  return $source;
}

sub init_target {
  my ($self, $path, $parent) = @_;
  my $target = {};
  # the target should have listref slots where we're expecting lists,
  # in case no elements get added to those lists later.
  if (my $spec = $self->spec_for_xpath($path)) {
    for (@{ $spec->{elts} }) {
      # initialize an empty list if we're expecting a list at all
      my $elt_spec = $self->spec_for_xpath( $path ."/". $_ );
      next unless $elt_spec;
      $target->{$_} = [] if $elt_spec->{multi};
    }
  }
  return $target;
}

sub validate_source {
  my ($self, $source, $path) = @_;
  
  #use Carp; Carp::cluck;
  
  my $spec = $self->spec_for_xpath($path);
  my $method = $self->walker->method || '<unknown>';
  
  if (!ref $source) {
    $logger->warn("Returned unexpected text at '$path' for structure '$method'.")
      unless $spec->{text};
    return 1;
  }
  
  my %keys = map { $_ => 1 } keys %$source;
  
  foreach (@{ $spec->{attr} } , @{$spec->{elts}}) {
    delete $keys{$_};
  }
  delete $keys{-text} if $spec->{text};
  
  for (keys %keys) {
    $logger->warn("unknown key '$_' defined within a terse structure at '$path' for structure '$method'.");
  }
  return !keys %keys;
}

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

sub read_text {
  my ($self, $source, $xpath_key) = @_;
  return ref $source ? $source->{-text} : $source;
}

sub child_sources {
  my ($self, $source, $xpath, $element) = @_;
    
  my $stuff = $source->{$element};
  $stuff = [] unless defined $stuff;
  
  return @{ $stuff } if ref $stuff eq 'ARRAY';
  return ( $stuff );
}

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

sub write_text {
  my ($self, $target, $path, $value) = @_;
  if ($self->text_only_spec($path)) {
    return $value;
  } else {
    $target->{-text} = $value;
    return $target;
  }
}


sub add_child_to_target {
  my ($self, $target, $xpath, $element, $child) = @_;
  if (ref ($target->{$element}) eq 'ARRAY') {
    push @{ $target->{$element} }, $child;
  } else {
    $target->{$element} = $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;