<%doc> Add interface neighbors % % <%flags> inherit => undef % % <%args> $int_id => undef $neighbor => undef $Add => undef % % <%init> my $DEBUG = 0; my %state; my $intobj; my $device; my %devs; my $js_prefix = $r->dir_config('NetdotPath') . "java_script"; print '%ARGS is
', Dumper(%ARGS), '

' if $DEBUG; if ( $int_id ){ unless ( $intobj = Interface->retrieve($int_id) ){ $m->comp("/generic/error.mhtml", error => "Can't retrieve Interface id $int_id", showplainerror=>1); } $device = $intobj->device; # # Get a list of Devices in the same subnet(s) # my $subnets = $device->get_subnets(); foreach my $subnet ( keys %$subnets ){ next unless $subnets->{$subnet}; foreach my $ip ( $subnets->{$subnet}->children ){ if ( $ip->is_address ){ if ( $ip->interface && $ip->interface->device ){ # Exclude our device next if ( $ip->interface->device->id == $device->id ); $devs{$ip->interface->device->short_name}++; } } } } # If we have no devices yet, just get all of them unless ( %devs ){ map { $devs{$_->short_name}++ } Device->retrieve_all(); # Exclude our device delete $devs{$device->short_name}; } } $m->clear_buffer;
Add Neighbor
<%perl> if ( $Add ){ if ( !(defined $neighbor) ){ # note neighbor of 0 passes, not sure if this matters $m->comp('/generic/error.mhtml', error=>"Missing neighbor value!"); } if ( int($intobj->neighbor) == $neighbor ){ print "
Neighbor relationship already exists!

"; print '[close]
'; $m->abort; }else{ eval { $intobj->add_neighbor(id=>$neighbor, fixed=>1, score=>'manual'); }; if ( my $e = $@ ){ $m->comp('/generic/error.mhtml', error=>$e); } } my $lbl1 = $intobj->get_label(); my $nobj = $intobj->neighbor(); my $lbl2 = $nobj->get_label(); my $link = "$lbl1 <=> $lbl2";

The following link has been manually added:

  <% $link %>

This link has been marked as "fixed" and thus will not be affected by topology discovery processes.

[ok] % $m->abort; %}

<%perl> my (@field_headers, @cell_data) = (); push( @field_headers, "Interface: " ); push( @cell_data, $intobj->get_label ); push( @field_headers, "Neighbor: "); push( @cell_data, &{sub{ my $ac = "Select Device from list:"; $ac .= ''; $ac .= '
Or search:'; $ac .= ''; $ac .= ' '; $ac .= '
'; $ac .= ''; $ac; }} ); <& /generic/attribute_table.mhtml, field_headers=>\@field_headers, data=>\@cell_data &>