%doc>
-- Device Worksheet --
Interface for viewing/updating a particular Device
and all its relevant info in one page
Special component for users that want to edit device information. Only allows them to edit very specific information
%doc>
%
<%attr>
title => 'Device'
section => 'Management'
%attr>
%
%
%#######################################################################
%#
%# Args section
%#
%#######################################################################
<%args>
$user => $ui->get_current_user($r)
$id => undef
$search => undef
$editints => undef
$ipsort => "address"
$ifsort => "number"
$showvlan => "all"
$submit => undef
%args>
%
%
%
%#######################################################################
%#
%# INIT section
%#
%#######################################################################
%
<%init>
my $DEBUG = 0;
my %cssitem = ( 0 => "formtablec1", 1 => "formtablec2" );
my $maxselect = 100;
my $o = undef;
my $ci = 0;
my $name;
my %ifvlans;
my %vlans;
my $fqdn;
my (@arp_caches, @fwt);
my @modules;
my %ifacecolors = (
manual => "cccccc",
removed => "ff8e8e",
);
print '%ARGS is
', Dumper(%ARGS), '
' if $DEBUG;
my $manager = $ui->get_permission_manager($r);
if ( $id ){
unless ($o = Device->retrieve($id)){
$m->comp('/generic/error.mhtml', error=>"Could not retrieve Device with id $id");
}
}
if ( $o ){
# Check if user can view this object
unless ( $manager && $manager->can($user, "view", $o) ){
$m->comp('/generic/error.mhtml', error=>"You don't have permission to view this object");
}
}
if( $submit ){
# insert/update
eval {
my %ret = $ui->form_to_db(%ARGS);
print 'form_to_db returned:
', Dumper(%ret), '
' if $DEBUG;
};
if ( my $e = $@ ){
$m->comp('/generic/error.mhtml', error=>$e);
}
}
if ( $o && $o->name ){
$name = (defined $o->name->name) ? $o->name->name : "Name N/A!";
$fqdn = $name . "." . $o->name->zone->name;
}elsif ( ! $search ){
$m->comp('/generic/error.mhtml', error=>"Device undefined or no name set");
}
# Build a hash of Interface Vlans
foreach my $if ( $o->interfaces ){
if ( my @ifv = $if->vlans ){
foreach my $ifv ( @ifv ){
my $vid = $ifv->vlan->vid;
$ifvlans{$if}{$vid} = "";
$vlans{$vid} = $ifv->vlan->id;
}
}
}
my $refresh_url = "user_device.html?id=$id";
%init>
<%perl>
my $ifs = $o->interfaces_by($ifsort);
#
# Store values in a hash first. Thay way we can quicly verify if
# at least one of the interfaces has that field set to some value
# and decide whether to add that column or not
#
my %intinfo;
foreach my $if ( @$ifs ){
foreach my $field ( qw/jack room_char jack_char description neighbor/ ){
if ( defined ($if->$field) ){
if ( ref($if->$field) ){
# If field is foreign object, make sure it's not an empty reference
$intinfo{$field}{$if->id} = $if->$field if int($if->$field);
}else{
$intinfo{$field}{$if->id} = $if->$field;
}
}
}
}
### Headers
my @closet_jacks;
(@headers, @rows) = ();
#the average user will never be deleting anything, so this dosn't need to appear
if ( $editints ){
# push @headers, '[del]';
}
push @headers, 'Number';
push @headers, 'Name';
#the average user should not be able to edit the following information, so we only need this header
#if they're not editing
if ( ! $editints ){
push @headers, 'Speed';
push @headers, 'VLAN';
push @headers, 'Mon?';
push @headers, 'SNMP?';
}
if ( exists $intinfo{jack} || $editints ){
push @headers, 'Jack(cable)';
my @closets = $o->room->closets if ( int($o->room) != 0 );
foreach my $cl (@closets) {
push @closet_jacks, $cl->horizontalcables;
}
}
if ( exists $intinfo{room_char} || $editints ){
push @headers, 'Room';
}
if ( exists $intinfo{jack_char} || $editints ){
push @headers, 'Jack';
}
if ( exists $intinfo{description} || $editints ){
push @headers, 'Descr.';
}
if (exists $intinfo{neighbor} && !$editints ){
push @headers, 'Neighbor';
}
### Actual data
foreach my $if ( @$ifs ){
next if ( !exists $ifvlans{$if}{$showvlan} && $showvlan ne "all" );
my (@row) = ();
if ( $editints ){
# push @row, 'id . "__delete" . '" >';
}
#the user should never be able to edit the number or name
push @row, $ui->form_field(object=>$if, column=>"number", htmlExtra=>"style=\"width: 5em;\"",
linkPage=>0, returnValOnly=>1);
push @row, $ui->form_field(object=>$if, column=>"name", htmlExtra=>"style=\"width: 10em;\"",
linkPage=>0, returnValOnly=>1);
if ( !$editints ){
push @row, $if->speed_pretty;
push @row,
&{sub{
my $ac = "";
if ( exists $ifvlans{$if} ){
my @list;
foreach my $v ( keys %{$ifvlans{$if}} ){
push @list, $v;
}
if ( scalar(@list) <= 3 ){
$ac .= join ', ', @list;
}else{
$ac .= '>3';
}
}
$ac;
}};
}
if(!$editints){
#the user should also not be able to edit information about monitoring or snmp managed
push @row, $ui->form_field(object=>$if, column=>"monitored", edit=>$editints, returnValOnly=>1);
push @row, $ui->form_field(object=>$if, column=>"snmp_managed", edit=>$editints, returnValOnly=>1);
}
if ( exists $intinfo{jack} || $editints ){
if ( @closet_jacks ){
push @row, $ui->form_field(object=>$if, table=>"Interface", column=>"jack", defaults=>\@closet_jacks,
linkPage=>0, edit=>$editints, new_button=>0, returnValOnly=>1);
}else{
push @row, $ui->form_field(object=>$if, table=>"Interface", column=>"jack", linkPage=>0,
edit=>$editints, new_button=>0, returnValOnly=>1);
}
}
if ( exists $intinfo{room_char} || $editints ){
push @row, $ui->form_field(object=>$if, column=>"room_char", edit=>$editints, htmlExtra =>"style=\"width: 4em;\"",
returnValOnly=>1);
}
if ( exists $intinfo{jack_char} || $editints ){
push @row, $ui->form_field(object=>$if, column=>"jack_char", edit=>$editints, htmlExtra =>"style=\"width: 7em;\"",
returnValOnly=>1);
}
if ( exists $intinfo{description} || $editints ){
push @row, $ui->form_field(object=>$if, column=>"description", edit=>$editints, returnValOnly=>1);
}
my $ac = "";
if ( exists $intinfo{neighbor}{$if->id} && !$editints){
$ac = $ui->form_field(object=>$if, column=>"neighbor", edit=>$editints, linkPage=>0, returnValOnly=>1);
$ac .= " ";
}
push @row, $ac;
push @rows, \@row;
my $doc_status = $if->doc_status;
if ( exists $ifacecolors{$doc_status} ){
push @rowstyles, "background-color: #$ifacecolors{$doc_status};";
}else{
push @rowstyles, "";
}
} #foreach
%perl>