The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w

use strict;
use warnings;

use Net::Async::Tangence::Client;

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}, props=" . Data::Dump::dump($obj->{props}) . " )";
} );

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->loop_stop;
   },
);

$loop->add( $conn );

my $registry;

$conn->connect_url( 
   $URL,
   on_registry => sub { $registry = shift },
);

$loop->loop_once until defined $registry;

if( !@ARGV ) {
   $registry->get_property(
      property => "objects",

      on_value => sub {
         my ( $objshash ) = @_;

         foreach my $id ( sort { $a <=> $b } keys %$objshash ) {
            my $desc = $objshash->{$id};

            printf "%-6d: %s\n", $id, $desc;
         }

         $loop->loop_stop;
      },

   );
}
elsif( $ARGV[0] eq "-i" ) {
   shift @ARGV; # eat -i
   my $objid = shift @ARGV;

   $registry->call_method(
      method  => "get_by_id",
      args    => [ $objid ],

      on_result => sub {
         my ( $obj ) = @_;
         print Data::Dump::dump( $obj->introspect ) . "\n";
         $loop->loop_stop;
      },
   );
}
elsif( $ARGV[0] eq "-p" ) {
   shift @ARGV; # eat -p
   my $objid    = shift @ARGV;
   my $property = shift @ARGV;

   $registry->call_method(
      method => "get_by_id",
      args   => [ $objid ],

      on_result => sub {
         my ( $obj ) = @_;

         $obj->get_property(
            property => $property,

            on_value => sub {
               my ( $value ) = @_;
               print Data::Dump::dump( $value ) . "\n";
               $loop->loop_stop;
            },
         );
      },
   );
}
else {
   die "Unrecognised operation $ARGV[0]\n";
}

$loop->loop_forever;