implement simple d3 based netmap

Netdisco/lib/Netdisco/Web/Device.pm

@@ -82,6 +82,69 @@ ajax '/ajax/content/device/:thing' => sub {
     return "<p>Hello, this is where the ". param('thing') ." content goes.</p>";
 };
 
+ajax '/ajax/content/device/netmap' => sub {
+    content_type('text/html');
+    template 'ajax/device/netmap.tt', {}, { layout => undef };
+};
+
+sub _get_name {
+    my $ip = shift;
+    my $domain = quotemeta( setting('domain_suffix') || '' );
+
+    (my $dns = (var('devices')->{$ip} || '')) =~ s/$domain$//;
+    return ($dns || $ip);
+}
+
+sub _add_children {
+    my ($ptr, $childs) = @_;
+    my @legit = ();
+
+    foreach my $c (@$childs) {
+        next if exists var('seen')->{$c};
+        var('seen')->{$c}++;
+        push @legit, $c;
+        push @{$ptr}, { name => _get_name($c) };
+    }
+
+    for (my $i = 0; $i < @legit; $i++) {
+        $ptr->[$i]->{children} = [];
+        _add_children($ptr->[$i]->{children}, var('links')->{$legit[$i]});
+    }
+}
+
+# d3 seems not to use proper json semantics, so get instead of ajax
+get '/ajax/data/device/netmap' => sub {
+    my $start = param('q');
+    return unless $start;
+
+    my @devices = schema->resultset('Device')->search({}, {
+      result_class => 'DBIx::Class::ResultClass::HashRefInflator',
+      columns => ['ip', 'dns'],
+    })->all;
+    var(devices => { map { $_->{ip} => $_->{dns} } @devices });
+
+    var(links => {});
+    my $rs = schema->resultset('Virtual::DeviceLinks')->search({}, {
+      result_class => 'DBIx::Class::ResultClass::HashRefInflator',
+    });
+
+    while (my $l = $rs->next) {
+        var('links')->{ $l->{left_ip} } ||= [];
+        push @{ var('links')->{ $l->{left_ip} } }, $l->{right_ip};
+    }
+
+    my %tree = (
+        name => _get_name($start),
+        children => [],
+    );
+
+    var(seen => {});
+    _add_children($tree{children}, var('links')->{$start});
+
+    content_type('application/json');
+    return to_json(\%tree);
+};
+
 # device interface addresses
 ajax '/ajax/content/device/addresses' => sub {
     my $ip = param('q');
@@ -202,6 +265,7 @@ get '/device' => sub {
         { id => 'details',   label => 'Details'   },
         { id => 'ports',     label => 'Ports'     },
         { id => 'modules',   label => 'Modules'   },
+        { id => 'netmap',    label => 'Neighbors' },
         { id => 'addresses', label => 'Addresses' },
     ]);