package Amazon::API::Botocore::Shape::Serializer;

use strict;
use warnings;

BEGIN {
  use English qw(-no_match_vars);

  eval { require Log::Log4perl; };

  if ($EVAL_ERROR) {
    no strict qw(refs);  ## no critic (ProhibitNoStrict)

    for (qw(DEBUG INFO WARN ERROR FATAL)) {
      *{ __PACKAGE__ . "::$_" } = sub { };
    }
  }
  else {
    no warnings;         ## no critic (ProhibitNoWarnings)

    Log::Log4perl->import(qw(:easy));
  }
}

use parent qw(Class::Accessor::Fast);

use Amazon::API::Constants qw(:chars :booleans);
use Amazon::API::Botocore::Shape::Utils qw(require_shape is_hash is_array);

use Carp;
use Data::Dumper;
use English qw(-no_match_vars);
use JSON qw(decode_json encode_json);
use Scalar::Util qw(reftype blessed);
use List::Util qw(any none);
use POSIX qw(strftime);

use URL::Encode qw(url_decode_utf8);

our $VERSION = '2.1.4';  ## no critic (RequireInterpolationOfMetachars)

__PACKAGE__->follow_best_practice;

__PACKAGE__->mk_accessors(qw( service delete_empty_members debug logger ));

########################################################################
sub new {
########################################################################
  my ( $class, @args ) = @_;

  my %options = ref $args[0] ? %{ $args[0] } : @args;

  my $self = $class->SUPER::new( \%options );

  return $self;
}

########################################################################
sub _serialize_structure {
########################################################################
  my ( $self, $this, $data, $service, $exists ) = @_;

  $service ||= $self->get_service;

  my $members = $this->get_members;

  DEBUG(
    Dumper [
      class               => ref $this,
      serialize_structure => $this,
      data                => $data,
      exists              => $exists,
      members             => $members,
    ]
  );

  return if !defined $data;

  #  my $result = {};
  my $result = $exists ? {} : undef;

  foreach my $m ( keys %{$members} ) {
    my $member = $members->{$m};

    my $location_name = $member->{locationName} || $member->{location} || $m;
    next if !exists $data->{$location_name};

    my $has_location
      = ( exists $member->{locationName} ) || ( exists $member->{location} );

    my $shape = $member->{shape};
    my $serialized_data;

    DEBUG(
      sub {
        return Dumper(
          [ member_name  => $m,
            member       => $member,
            shape        => $shape,
            location     => $location_name,
            has_location => $has_location,
            exists       => $exists,
          ]
        );
      }
    );

    my $member_data = $data->{$location_name};

    DEBUG(
      sub {
        return Dumper(
          [ member       => $m,
            shape        => $shape,
            data         => $data,
            location     => $location_name,
            member_data  => $member_data,
            has_location => $has_location,
            exists       => $exists,
          ]
        );
      }
    );

    # because we may have serialized an XML object...this is a result
    # of how XMLin deserializes XML objects
    if ( $member_data && ref($member_data) && $shape eq 'String' ) {
      $member_data = $member_data->{content} // $EMPTY;
    }

    DEBUG(
      sub {
        return Dumper(
          [ member_data   => $member_data,
            member        => $member,
            location_name => $location_name,
            has_location  => $has_location,
            caller_exists => $exists,
            exists        => exists $data->{$location_name},
          ]
        );
      }
    );

    # has location means this structure member should be inserted into
    # a hash at that location - when it doesn't exist the data is
    # inserted directly into the member name

    # if member data does not exist, then entire data structure is
    # passed to the serializer
    if ( !$has_location || $member_data || exists $data->{$location_name} ) {
      $serialized_data = $self->serialize(
        shape   => $shape,
        data    => $member_data || $data,
        service => $service,
        exists  => exists $data->{$location_name},
      );

      DEBUG(
        sub {
          return Dumper(
            [ "back from serializing $shape",
              data          => $serialized_data,
              location_name => $location_name,
              member        => $m,
              flattened     => $this->{flattened},
            ]
          );
        }
      );
    }

    # skip empty members
    next if ( !exists $data->{$location_name} ) && !defined $serialized_data;

    $result //= {};
    if ( $this->{flattened} ) {
      $result->{$m} = $serialized_data;
    }
    else {
      if ( is_hash($serialized_data)
        && exists $serialized_data->{$location_name} ) {
        $result->{$m} = $serialized_data->{$location_name};
      }
      else {
        $result->{$m} = $serialized_data;
      }
    }

    DEBUG(
      sub {
        return Dumper(
          [ result          => $result,
            member          => $m,
            serialized_data => $serialized_data,
            location_name   => $location_name,
            exists          => $exists,
          ]
        );
      }
    );
  }

  return $result;
}

########################################################################
sub _serialize_list {
########################################################################
  my ( $self, $this, $data, $service, $exists ) = @_;

  $service ||= $self->get_service;

  DEBUG( Dumper( [ 'serialize_list', $this, $data, $service ] ) );

  my $member        = $this->get_member;
  my $location_name = $member->{locationName};

  if ( !$location_name ) {
    if ( ref $data && reftype($data) eq 'HASH' && exists $data->{member} ) {
      $location_name = 'member';
    }
  }

  my $list = $location_name ? $data->{$location_name} : $data;

  my $member_shape = $member->{shape};

  DEBUG(
    Dumper(
      [ 'serialize_list',
        member        => $member,
        location_name => $location_name,
        list          => $list,
        member_shape  => $member_shape,
      ]
    )
  );

  my $result = [];

  if ( $list && !ref $list ) {
    $list = [$list];
  }
  elsif ( $list && reftype($list) eq 'HASH' ) {

    my @key_values;

    if ( $this->{flattened} ) {
      DEBUG(
        Dumper(
          [ list      => $list,
            flattened => $this->{flattened}
          ]
        )
      );

      my @flattened_list;

      foreach ( keys %{$list} ) {
        if ( reftype( $list->{$_} ) eq 'ARRAY' ) {
          push @flattened_list, @{ $list->{$_} };
        }
      }

      $list = @flattened_list ? \@flattened_list : [ values %{$list} ];
    }
    else {
      TRACE(
        Dumper(
          [ message => 'unreliable deserialization?',
            this    => $this,
            list    => $list,
            data    => $data,
          ]
        )
      );

      $list = [$list];
    }

    DEBUG( Dumper( [ key_values => $member_shape, \@key_values ] ) );

    my %result;

    foreach my $p ( @{$list} ) {

      DEBUG( Dumper( [ p => $p, member_shape => $member_shape ] ) );

      my $serialized_data = $self->serialize(
        shape   => $member_shape,
        data    => $p,
        service => $service,
        exists  => $location_name && exists $data->{$location_name},
      );

      next if !defined $serialized_data;

      push @{$result}, $serialized_data;
    }

    local $LIST_SEPARATOR = q{,};

    DEBUG(
      sub {
        return Dumper(
          [ 'ref(self)' => ref($self),
            'ref(this)' => ref($this),
            result      => $result,
            list        => $list
          ]
        );
      }
    );
  }
  else {
    foreach my $elem ( @{$list} ) {

      DEBUG(
        sub {
          return Dumper(
            [ shape => $member->{shape},
              elem  => $elem
            ]
          );
        }
      );

      my $serialized_data = $self->serialize(
        shape   => $member->{shape},
        data    => $elem,
        service => $service,
        exists  => $exists,
      );

      next if !defined $serialized_data;

      push @{$result}, $serialized_data;

    }
  }

  return if !$exists && !@{$result};

  return $result;
}

########################################################################
sub serialize {
########################################################################
  my ( $self, %args ) = @_;

  my ( $shape, $service, $data, $exists ) = @args{qw(shape service data exists)};

  $service ||= $self->get_service;

  DEBUG(
    sub {
      return Dumper(
        [ shape   => $shape,
          data    => $data,
          service => $service,
          exists  => $exists,
        ]
      );
    }
  );

  # this is a hack to deal with the way XML responses are ambiguously
  # returned by rest-xml services and ec2 APIs...sometimes there is a
  # response wrapper that is never articulated in the Botocore
  # metadata...sometimes it is the name of the top-level shape.
  #
  # "$exists" tells us the shape was not found, but it may now be in the
  # data structure if this was a deserialized XML payload and the shape
  # name was the wrapper.
  #
  # We really only want to do this on the top level element but we'll
  # see if this works consistently when serializing all elements below
  # the root.
  #
  # I hate you botocore!!!!
  #
  if ( !$exists ) {
    # if the shape name exists in the data, then that is our data to
    # serialize.
    if ( ref $data && exists $data->{$shape} ) {
      $data = $data->{$shape};
    }
    # else this may be ec2 with a response wrapper
    elsif ( ref $data && reftype($data) eq 'HASH' ) {
      my ($response_wrapper) = grep {/response$/ixsm}
        keys %{$data};

      DEBUG( Dumper( [ response_wrapper => $response_wrapper ] ) );

      if ($response_wrapper) {
        DEBUG(
          Dumper(
            [ response_wrapper => $response_wrapper,
              data             => $data,
              shape            => $shape
            ]
          )
        );
        $data = $data->{$response_wrapper};
        if ( exists $data->{$shape} ) {
          $data = $data->{$shape};
        }
      }
    }
  }

  my $class = require_shape( $shape, $service );

  croak "unable to require class for $shape: $EVAL_ERROR\n"
    if !$class;

  my $this = $class->new;

  my $type = $this->get_type;

  DEBUG(
    sub {
      return Dumper(
        [ class   => $class,
          type    => $type,
          exists  => $exists,
          data    => $data,
          service => $service,
          this    => $this,
        ]
      );
    }
  );

  my %serializers = (
    structure => sub {
      return $self->_serialize_structure( $this, $data, $service, $exists );
    },

    list => sub {
      return $self->_serialize_list( $this, $data, $service, $exists );
    },

    string => sub {

      if ($data) {
        $data = ref $data ? $data->{content} : $data;
      }

      return $data
        if $data;

      return $exists ? $EMPTY : $data;
    },

    boolean => sub {

      if ( ref $data ) {
        if ( !blessed $data) {
          $data = $data->{content};
        }
      }

      return
        if !defined $data;

      $data //= 0;

      if ( any { $data eq $_ } qw( 0 1 true false) ) {
        return {
          0     => JSON::false,
          1     => JSON::true,
          true  => JSON::true,
          false => JSON::false,
        }->{$data};
      }

      return $data;
    },

    integer => sub {
      return ref $data ? $data->{content} : $data;
    },

    long => sub {
      return ref $data ? $data->{content} : $data;
    },

    map => sub {
      return $data
        if !$this->{flattened};

      my $serialize           = {};
      my $key_location_name   = $this->{key}->{locationName};
      my $key_shape_name      = $this->{key}->{shape};
      my $value_location_name = $this->{value}->{locationName};
      my $value_shape_name    = $this->{value}->{shape};

      DEBUG(
        sub {
          return Dumper(
            [ type                => $type,
              data                => $data,
              locationName        => $this->{locationName},
              key_location_name   => $key_location_name,
              key_shape_name      => $key_shape_name,
              value_location_name => $value_location_name,
              value_shape_name    => $value_shape_name,
            ]
          );
        }
      );

      $data ||= [];

      if ( !$key_location_name && !$value_location_name ) {
        DEBUG(
          Dumper(
            [ value_shape_name => $value_shape_name,
              data             => $data,
              this             => $this
            ]
          )
        );

        # we might have to serialize this data too, however since it
        # is specified as a structure as a map and we have not
        # information regarding how to actual map it...we return the
        # data itself.
        return $data;
      }

      if ( ref $data && reftype($data) ne 'ARRAY' ) {
        $data = [$data];
      }

      foreach my $item ( @{$data} ) {
        DEBUG(
          sub {
            return Dumper( [ item => $item ] );
          }
        );

        my ( $key, $value );

        if ( $key_location_name || $key_shape_name ) {
          $key = $self->serialize(
            service => $service,
            data    => $key_location_name ? $item->{$key_location_name}->{content} : $item,
            shape   => $key_shape_name,

          );
        }

        if ( $value_location_name || $value_shape_name ) {

          $value = $self->serialize(
            service => $service,
            data    => $value_location_name ? $item->{$value_location_name}->{content} : $item,
            shape   => $value_shape_name,
          );
        }

        # This is almost certainly an unnecessary test as we have
        # handled the situation where location names are not provided
        # above by using the hash keys of the payload as the keys
        # themselves. This occurs in an API like SQS where the
        # attribute names become the keys but are not specifically
        # called out in the shape.
        if ( $key && defined $value ) {
          $serialize->{$key} = $value;
        }
        else {
          return $value;
        }
      }

      return { $this->{locationName} => $serialize };
    },
    blob => sub {
      return $data;
    },
    timestamp => sub {
      $data = ref $data ? $data->{content} : $data;

      return
        if !$data;

      $data =~ s/^(.*)[.]000Z$/$1\+00:00/xsm;

      if ( $data =~ /^[\d.]+$/xsm ) {
        my $epoch = $data;

        my $nanoseconds;

        ( $epoch, $nanoseconds ) = split /[.]/xsm, $epoch;

        if ( defined $nanoseconds ) {
          $data = strftime( '%Y-%m-%dT%H:%M:%S.%%d%z', localtime $epoch );
          $data = sprintf $data, ".$nanoseconds" * 1_000_000;
        }
        else {
          $data = strftime( '%Y-%m-%dT%H:%M:%S%z', localtime $epoch );
        }

        if ( $data =~ /(\d{4})$/xsm ) {
          my ( $h, $m ) = unpack 'A2A2', $1;
          $data =~ s/\d{4}$/$h:$m/xsm;
        }

      }

      return $data;
    },
  );

  DEBUG(
    sub {
      return Dumper(
        [ unknown_type => $type,
          this         => $this,
          data         => $data,
          exists       => $exists
        ]
      );
    }
  );

  my $result;

  if ( $serializers{$type} ) {
    $result = $serializers{$type}->($exists);
  }
  else {
    $result = $self->serialize(
      shape   => $this->{shape},
      data    => $data,
      service => $service,
      exists  => $exists,
    );
  }

  DEBUG( sub { return Dumper( [ result => $result ] ) } );

  return $result;
}

1;
