From 73473e82024a4cb51058550ad28f6356687f43cb Mon Sep 17 00:00:00 2001
From: Darin McBride <dmcbride@cpan.org>
Date: Sat, 11 Jul 2015 22:49:03 -0600
Subject: [PATCH] Add some more command-line debug capability with LR->call and
 LR->jcall

---
 lib/LR.pm          | 60 ++++++++++++++++++++++++++++++++++++++++++++++
 lib/Lacuna/RPC.pm  |  2 +-
 lib/Lacuna/Util.pm |  1 +
 3 files changed, 62 insertions(+), 1 deletion(-)

diff --git a/lib/LR.pm b/lib/LR.pm
index 5b377f7c..d6de7685 100644
--- a/lib/LR.pm
+++ b/lib/LR.pm
@@ -1,6 +1,7 @@
 package LR;
 
 use Class::Load qw(load_first_existing_class);
+use 5.12.0;
 
 # Intended to be used from the command line to save a bunch of typing.
 
@@ -20,4 +21,63 @@ sub AUTOLOAD
     $ns->new();
 }
 
+# perl -ML -E 'LR->call(Empire=>view_profile=>LD->empire(2))'
+
+sub _clean(@)
+{
+    [
+     map {
+         if (ref $_) {
+             eval { $_->id } || ref $_
+         } else {
+             $_
+         }
+     } @_ 
+    ];
+}
+
+sub call
+{
+    my $class = shift;
+    my $type  = shift;
+    my $method= shift;
+
+    require Data::Dump;
+    $type = load_first_existing_class "Lacuna::RPC::$type", "Lacuna::RPC::Building::$type";
+
+    print "REQUEST: ";
+    Data::Dump::dd(_clean @_);
+    my $rc = eval { $type->new->$method(@_) } || $@;
+    print "RESULT: ";
+    Data::Dump::dd($rc);
+}
+
+sub jcall
+{
+    my $class = shift;
+    my $type  = shift;
+    my $method= shift;
+    require JSON::XS;
+
+    $type = load_first_existing_class "Lacuna::RPC::$type", "Lacuna::RPC::Building::$type";
+
+    if (ref $_[0] eq 'Lacuna::DB::Result::Empire')
+    {
+        # create a session for it.
+        $_[0] = $_[0]->start_session->id;
+    }
+    if (ref $_[0] eq 'HASH' && exists $_[0]->{session_id} && ref $_[0]->{session_id})
+    {
+        # create a session for it.
+        $_[0]->{session_id} = $_[0]->{session_id}->start_session->id;
+    }
+
+    say "Class: $type";
+    say "method: $method";
+    say "REQUEST params: ", JSON::XS::encode_json(_clean @_);
+    my $rc = eval { $type->new->$method(@_) } || $@;
+    say "RESULT: ", JSON::XS::encode_json(ref $rc ? $rc : [$rc]);
+}
+
+
 1;
diff --git a/lib/Lacuna/RPC.pm b/lib/Lacuna/RPC.pm
index dbf74708..43abac29 100644
--- a/lib/Lacuna/RPC.pm
+++ b/lib/Lacuna/RPC.pm
@@ -55,7 +55,7 @@ sub get_empire_by_session {
             }
             my $ipm = $session->ip_address eq $ipr;
             my @caller;
-            for (my $i = 1;$caller[0] !~ /Lacuna::RPC/;++$i) {
+            for (my $i = 1;@caller && $caller[0] !~ /Lacuna::RPC/;++$i) {
                 @caller = caller($i);
             }
             $log->info(sprintf "ACTUAL:ipr=%s,ipe=%s,ipm=%s,ses=%s,sat:%d,rpc=%s", $ipr, $session->ip_address, $ipm, $session_id, $session->is_sitter ? 1 : 0, $caller[3]);
diff --git a/lib/Lacuna/Util.pm b/lib/Lacuna/Util.pm
index 7812dcfe..606c24a5 100644
--- a/lib/Lacuna/Util.pm
+++ b/lib/Lacuna/Util.pm
@@ -111,6 +111,7 @@ sub consolidate_items {
 
 sub real_ip_address {
     my ($plack_request) = @_;
+    return unless $plack_request;
     $plack_request->headers->header('X-Real-IP') //
             $plack_request->address;
 }
-- 
2.51.2