%doc>
Cable management stuff...
%doc>
<%args>
$id => undef
$strand_sort => undef
$edit => undef
$edit_list => undef
$__edit_list => undef
$_action => undef
$number_strands => undef
$fiber_type => undef
$range1 => undef
$range2 => undef
$splice_bb_end => undef
$strand_range => undef
$user => $ui->get_current_user($r)
%args>
<%flags>
%flags>
<%attr>
title => 'Backbone Cable'
section => 'Plant'
%attr>
<%init>
my $DEBUG = 0;
my %cssitem = (0 => "formtablec1", 1 => "formtablec2");
my $editBackbone = 0;
my $editStrand = 0;
my ($o, $start_site, $end_site);
my ($start_site_id, $end_site_id) = (0, 0);
if ( $id && $id ne "NEW" ) {
$o = BackboneCable->retrieve($id);
if ( $o->start_closet->room->floor && $o->start_closet->room->floor->site ){
$start_site = $o->start_closet->room->floor->site;
}
if ( $o->end_closet->room->floor && $o->end_closet->room->floor->site ){
$end_site = $o->end_closet->room->floor->site;
}
$start_site_id = $start_site->id if ($start_site);
$end_site_id = $end_site->id if ($end_site);
}
$editBackbone = 1 if ($id eq "NEW" || $edit eq "cableinfo");
$editStrand = 1 if ($edit eq "strandinfo");
# For table building modules:
my (@field_headers, @cell_data, @headers, @rows);
my $manager = $ui->get_permission_manager($r);
%init>
<%perl>
print "
", Dumper(%ARGS), "
" if $DEBUG;
# code for inserting/updating
# -----------------------------------------------------------------------------
if (defined($_action) && ($_action eq "UPDATE" || $_action eq "STRAND_UPDATE")) {
print "inserting/updating, ARGS is
", Dumper(%ARGS), "
" if $DEBUG;
my %update_info;
unless ( %update_info = $ui->form_to_db(%ARGS) ) {
$m->comp("../generic/error.mhtml", error => $ui->error);
}
# Ignore id changes for anything but BackboneCable.
# (i.e., we do not care about CableStrand id update).
if (exists $update_info{BackboneCable}{id} ) {
$id = (keys %{$update_info{BackboneCable}{id}})[0];
}
print "update info is
", Dumper(%update_info), "
" if $DEBUG;
# Do this to 'flush' the values associated with the object
# before redisplaying
$o = undef;
if ($id && $id ne "NEW") {
$o = BackboneCable->retrieve($id);
if ( $o->start_closet->room->floor && $o->start_closet->room->floor->site ){
$start_site = $o->start_closet->room->floor->site;
}
if ( $o->end_closet->room->floor && $o->end_closet->room->floor->site ){
$end_site = $o->end_closet->room->floor->site;
}
$start_site_id = $start_site->id if ($start_site);
$end_site_id = $end_site->id if ($end_site);
$editBackbone = 0;
$editStrand = 0;
}
}
# Edit range
elsif ( defined($_action) && $_action eq "EDIT_RANGE" ){
$m->comp("../generic/error.mhtml", error => "Strand Range not specified.")
if (!$strand_range);
my ($start, $end) = split(/\-/o, $strand_range);
$m->comp("../generic/error.mhtml", error => "Invalid Range: $strand_range.")
unless ($start && $end);
my %args = (start=>$start, end=>$end);
foreach my $key ( qw/fiber_type status/ ){
$args{$key} = $ARGS{$key} if ( exists $ARGS{$key} && $ARGS{$key} ne "null" );
}
eval {
$o->update_range(%args);
};
if ( my $e = $@ ){
$m->comp("../generic/error.mhtml", error=>"$e");
}
}
# insert N number of strands...
elsif ( defined($_action) && $_action eq "ADD_STRANDS" ){
eval{
$o->insert_strands($number_strands, $fiber_type);
};
if ( my $e = $@ ){
$m->comp("../generic/error.mhtml", error=>"$e");
}
}
# splice cables by a range of strands
elsif (defined($_action) && $_action eq "ADD_SPLICE_RANGE") {
$m->comp("../generic/error.mhtml", error => "range1, range2, or backbone not specified.")
if (!$range1 || !$range2 || !$splice_bb_end);
my ($start_low, $start_high) = split(/\-/o, $range1);
my ($end_low, $end_high) = split(/\-/o, $range2);
my $bb_end = BackboneCable->retrieve($splice_bb_end);
if (($start_high - $start_low) != $end_high - $end_low) {
$m->comp("../generic/error.mhtml", error => "Mismatch between ranges.");
}
# build up arrays of strands we care about.
my (@start_strands, @end_strands);
for (my $i = $start_low; $i <= $start_high; ++$i) {
push(@start_strands, CableStrand->search(cable=>$id, number=>$i));
}
for (my $i = $end_low; $i <= $end_high; ++$i) {
push(@end_strands, CableStrand->search(cable=>$bb_end->id, number=>$i));
}
if ( scalar(@start_strands) != scalar(@end_strands) ){
$m->comp("../generic/error.mhtml", error => "Mismatch between start strand and end strand length.");
}
# first delete all splices associated with our starting strands
foreach my $strand ( @start_strands ){
eval {
$strand->delete_splices;
};
$m->comp("../generic/error.mhtml", error=>"$@") if $@;
}
# and now lets add our splices...
for (my $i = 0, my $len = scalar(@start_strands); $i < $len; ++$i) {
Splice->insert({strand1=>$start_strands[$i], strand2=>$end_strands[$i]});
}
}
# special case for updating splices
# -----------------------------------------------------------------------------
if (defined($_action) && $_action eq "STRAND_UPDATE") {
my @splices = ("__splice1_", "__splice2_");
my @strands = ();
# user can by either be operating on a subset of strands...
if ($__edit_list) {
foreach my $l (split(/,/o, $__edit_list)) {
push(@strands, CableStrand->retrieve($l));
}
}
# ...or all strands for this cable.
else {
@strands = $o->strands;
}
# first delete all splices for these strands
foreach my $strand ( @strands ){
eval {
$strand->delete_splices;
};
$m->comp("../generic/error.mhtml", error=>"$@") if ( $@ );
}
# then work through the post data and recreate splices as needed.
foreach my $strand ( @strands ) {
foreach my $sp ( @splices ) {
next if (!defined($ARGS{$sp . $strand->id}) || $ARGS{$sp . $strand->id} eq "");
my $strand2 = CableStrand->retrieve($ARGS{$sp . $strand->id});
eval {
Splice->insert({strand1=>$strand, strand2=>$strand2});
};
$m->comp("../generic/error.mhtml", error=>"$@") if $@;
}
}
}
# end insertion/update code
# -----------------------------------------------------------------------------
%perl>
% # interface...
% # ---------------------------------------------------------------------------
<%perl>
my @backbones = ();
if ($editStrand) {
# we need to grab all backbones for start and end sites of this strand.
foreach my $closet (($start_site->closets, $end_site->closets)) {
map { push (@backbones, $_) } (BackboneCable->search(start_closet=>$closet),
BackboneCable->search(end_closet=>$closet));
}
}
%perl>
% if (defined($o)) {
% if ( $manager && $manager->can($user, 'edit', $o) ){
% if ($edit ne "strandinfo") {
Edit Strand Range
% }
% }
% if ( $manager && $manager->can($user, 'edit', $o) ){
% if ($edit ne "strandinfo") {
Manually Add Strands
<%perl>
my @bbones;
foreach my $closet (($start_site->closets, $end_site->closets)) {
map { push (@bbones, $_) if ($_->id != $id && $_->strands) }
(BackboneCable->search(start_closet=>$closet),
BackboneCable->search(end_closet=>$closet));
}
%perl>
% if ( $o->strands && @bbones ){
Manually Add Splice Range
% }
% } # if edit ne strandinfo
% } # if manager
%} # if defined (about 300 lines up !)