#!/usr/bin/perl

use v5.14;
use warnings;

use Tangence::Client 0.25; # ->get_registry
use Net::Async::Tangence::Client;
use Tangence::Constants;

use IO::Async::Loop 0.16;

use Data::Dump;

# We want to mangle the way Data::Dump prints our object proxies
# While we're at it, lets build a generic delegated printing system

{
   my $_dump = \&Data::Dump::_dump;

   my %dump_delegations;

   no warnings 'redefine';
   *Data::Dump::_dump = sub {
      if( exists $dump_delegations{ref $_[0]} ) {
         return $dump_delegations{ref $_[0]}->( @_ );
      }
      else {
         return $_dump->( @_ );
      }
   };

   sub register_dump_delegation
   {
      my ( $class, $cb ) = @_;
      $dump_delegations{$class} = $cb;
   }
}

register_dump_delegation( "Tangence::ObjectProxy" => sub {
      my ( $obj ) = @_;
      return "OBJPROXY( id=$obj->{id} )";
} );

my $loop = IO::Async::Loop->new();

my $URL = shift @ARGV or die "Need URL as argv[1]\n";

my $conn = Net::Async::Tangence::Client->new(
   on_closed => sub {
      print STDERR "Connection closed\n";
      exit(0);
   },
   on_error => sub {
      my ( $message ) = @_;
      print STDERR "Error: $message\n";
   },
);

$loop->add( $conn );

$conn->connect_url( $URL )->get;

my $registry = $conn->get_registry->get;

$registry->watch_property_with_initial(
   "objects",
   on_set => sub {
      my ( $objects ) = @_;
      new_object( $_ ) foreach keys %$objects;
   },
   on_add => sub {
      my ( $id, $obj ) = @_;
      new_object( $id );
   },
   on_del => sub {
      my ( $id ) = @_;
      print STDERR "deleted object $id\n";
   },
)->get;

$loop->loop_forever;

sub new_object
{
   my ( $objid ) = @_;

   print "Subscribing to events and properties on new object $objid\n";

   my $obj = $registry->call_method( "get_by_id", $objid )->get;
   unless( $obj ) {
      warn "Registry did not give us an object at ID=$objid\n";
      return;
   }

   my $class = $obj->class;

   my @f;

   foreach my $event ( keys %{ $class->events } ) {
      print "Subscribing to object $objid event $event\n";
      push @f, object_event( $obj, $event );
   }

   foreach my $prop ( keys %{ $class->properties } ) {
      # We're already watching 'objects' on the registry, so ignore that
      next if $objid == 0 and $prop eq "objects";
      print "Watching object $objid property $prop\n";
      # Need to handle based on the property dimension
      my $dim = $class->property( $prop )->dimension;
      my $install = $dim == DIM_SCALAR ? \&object_prop_scalar :
                    $dim == DIM_HASH   ? \&object_prop_hash :
                    $dim == DIM_QUEUE  ? \&object_prop_queue :
                    $dim == DIM_ARRAY  ? \&object_prop_array :
                    $dim == DIM_OBJSET ? \&object_prop_objset :
                    undef;

      push @f, $install->( $obj, $prop ) if defined $install;
   }

   Future->needs_all( @f )->get;
}

sub object_event
{
   my ( $obj, $event ) = @_;

   my $id = $obj->id;

   $obj->subscribe_event(
      $event,
      on_fire => sub {
         my ( @args ) = @_;

         print "EVENT $id -> $event\n";
         print "  " . Data::Dump::dump(@args) . "\n";
      },
   );
}

sub object_prop_scalar
{
   my ( $obj, $prop ) = @_;

   my $id = $obj->id;

   $obj->watch_property_with_initial(
      $prop,
      on_set => sub {
         my ( $scalar ) = @_;
         print "PROP SET $id [$prop]\n";
         print "  " . Data::Dump::dump($scalar) . "\n";
      },
   );
}

sub object_prop_hash
{
   my ( $obj, $prop ) = @_;

   my $id = $obj->id;

   $obj->watch_property_with_initial(
      $prop,
      on_set => sub {
         my ( $hash ) = @_;
         print "PROP SET $id [$prop]\n";
         print "  {$_} = " . Data::Dump::dump($hash->{$_}) . "\n" for sort keys %$hash;
      },
      on_add => sub {
         my ( $key, $value ) = @_;
         print "PROP ADD $id [$prop]\n";
         print "  {$key} = " . Data::Dump::dump($value) . "\n";
      },
      on_del => sub {
         my ( $key ) = @_;
         print "PROP DEL $id [$prop]\n";
         print "  {$key}\n";
      },
   );
}

sub object_prop_array
{
   my ( $obj, $prop ) = @_;

   my $id = $obj->id;

   $obj->watch_property(
      $prop,
      on_set => sub {
         my ( $array ) = @_;
         print "PROP SET $id [$prop]\n";
         print "  [$_] = " . Data::Dump::dump($array->[$_]) . "\n" for 0 .. $#$array;
      },
      on_push => sub {
         my ( @newvals ) = @_;
         print "PROP PUSH $id [$prop]\n";
         print "  : " . Data::Dump::dump($newvals[$_]) . "\n" for 0 .. $#newvals;
      },
      on_shift => sub {
         my ( $count ) = @_;
         print "PROP SHIFT $id [$prop]\n";
         print "  shift x $count\n";
      },
      on_splice => sub {
         my ( $index, $count, @newvals ) = @_;
         print "PROP SPLICE $id [$prop]\n";
         print "  splice[$index .. $index+$count] = \n";
         print "  : " . Data::Dump::dump($newvals[$_]) . "\n" for 0 .. $#newvals;
      },
      on_move => sub {
         my ( $index, $delta ) = @_;
         print "PROP MOVE $id [$prop]\n";
         print "  [$index] by ".($delta>0?"+$delta":"$delta")."\n";
      },
   );
}

sub object_prop_queue
{
   my ( $obj, $prop ) = @_;

   my $id = $obj->id;

   $obj->watch_property_with_initial(
      $prop,
      on_set => sub {
         my ( $queue ) = @_;
         print "PROP SET $id [$prop]\n";
         print "  [$_] = " . Data::Dump::dump($queue->[$_]) . "\n" for 0 .. $#$queue;
      },
      on_push => sub {
         my ( @newvals ) = @_;
         print "PROP PUSH $id [$prop]\n";
         print "  : " . Data::Dump::dump($newvals[$_]) . "\n" for 0 .. $#newvals;
      },
      on_shift => sub {
         my ( $count ) = @_;
         print "PROP SHIFT $id [$prop]\n";
         print "  shift x $count\n";
      },
   );
}

sub object_prop_objset
{
   my ( $obj, $prop ) = @_;

   my $id = $obj->id;

   $obj->watch_property_with_initial(
      $prop,
      on_set => sub {
         my ( $objs ) = @_;
         print "PROP SET $id [$prop]\n";
         print "  " . $_->id . " = " . Data::Dump::dump($_) . "\n" for values %$objs;
      },
      on_add => sub {
         my ( $newobj ) = @_;
         print "PROP ADD $id [$prop]\n";
         print "  " . $newobj->id . " = " . Data::Dump::dump($newobj) . "\n";
      },
      on_del => sub {
         my ( $delid ) = @_;
         print "PROP DEL $id [$prop]\n";
         print "  $delid\n";
      },
   );
}