<%doc> Cable management stuff... <%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) <%flags> <%attr> title => 'Backbone Cable' section => 'Plant' <%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); <%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 # ----------------------------------------------------------------------------- % # interface... % # ---------------------------------------------------------------------------
% if (defined($o)) { Start: <% $start_site ? "id . "&page_type=BACKBONE\">" . $start_site->name . "" : "undefined" %>    End: <% $end_site ? "id . "&page_type=BACKBONE\">" . $end_site->name . "" : "undefined" %> %}
Backbone Cable
% if ($editBackbone) {    % } else { [refresh] % if ( $manager && $manager->can($user, 'edit', $o) ){ [edit] % } % if ( $manager && $manager->can($user, 'delete', $o) ){ [delete] % } % }
<%perl> (@field_headers, @cell_data) = (); my @fields = ('start_closet','end_closet','type'); $ui->add_to_fields(o=>$o, table=>"BackboneCable", edit=>$editBackbone, fields=>\@fields, field_headers=>\@field_headers, cell_data=>\@cell_data); <& /generic/attribute_table.mhtml, field_headers=>\@field_headers, data=>\@cell_data &> <%perl> (@field_headers, @cell_data) = (); my %tmp = $ui->form_field(object=>$o, table=>"BackboneCable", column=>"name", edit=>$editBackbone); my $name_tmp = $tmp{value}; if ($editBackbone) { $name_tmp .= '   '; } push( @field_headers, $tmp{label} ); push( @cell_data, $name_tmp ); $ui->add_to_fields(o=>$o, table=>"BackboneCable", edit=>$editBackbone, fields=>['owner', 'installdate', 'length'], field_headers=>\@field_headers, cell_data=>\@cell_data); if ( $id eq 'NEW' ){ push( @field_headers, "Number of Strands:" ); push( @cell_data, '' ); } <& /generic/attribute_table.mhtml, field_headers=>\@field_headers, data=>\@cell_data &>
<%perl> { my %tmp; %tmp = $ui->form_field(object=>$o, table=>"BackboneCable", column=>"info", edit=>$editBackbone, htmlExtra=>'rows="3" cols="80"'); print '
'.$tmp{label}.'
'; print $tmp{value}; }
<%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)); } } % if (defined($o)) {
% if ( $editStrand && $edit_list ) { % } % my $strand_count = scalar $o->strands;
Cable Strands (<% $strand_count %>)
% if ($editStrand) {    % }else { % if ( $manager && $manager->can($user, 'access_admin_section', 'cable_backbone:new') ){ [new] % } % if ( $manager && $manager->can($user, 'edit', $o) ){ [edit] % } % if ( $manager && $manager->can($user, 'edit', $o) ){ [edit all] % } % }
<%perl> my @strands; if ( $edit_list ) { # if the user has selected specific rows, only display those selected. foreach my $l (split(/,/o, $edit_list)) { push(@strands, CableStrand->retrieve($l)); } } else { @strands = $o->strands; } % if (scalar(@strands)) { <%perl> (@headers, @rows) = (); @headers = ( 'Name', 'Type', 'Status', 'Spliced With', ); if (!$editStrand) { push( @headers, 'Part of Sequence' ); if ( $manager && $manager->can($user, 'edit', $o) ){ push( @headers, 'Edit?' ); } } <%perl> my @sorted_strands; if ($strand_sort eq "name" || !$strand_sort) { # sort by name # ----------------------------------------------------------- @sorted_strands = sort { (split(/\./o, $a->name, 2))[1] <=> (split(/\./o, $b->name, 2))[1] } @strands; } elsif ($strand_sort eq "status") { # sort by status # ----------------------------------------------------------- @sorted_strands = sort { uc($a->status->name) cmp uc($b->status->name) } @strands; } elsif ($strand_sort eq "type") { # sort by status # ----------------------------------------------------------- @sorted_strands = sort { uc($a->fiber_type->name) cmp uc($b->fiber_type->name) } @strands; } <%perl> foreach my $st (@sorted_strands) { my @row = (); push( @row, &{sub{ my $ac = ""; if ($editStrand) { $ac .= 'id . "__delete" . '">[del]'; my %tmp = $ui->form_field(object=>$st, column=>"name", edit=>$editStrand); $ac .= $tmp{value}; } else { $ac .= '' . $st->name . ''; } $ac; }} ); my %tmp = $ui->form_field(object=>$st, column=>"fiber_type", edit=>$editStrand); push( @row, $tmp{value} ); %tmp = $ui->form_field(object=>$st, column=>"status", edit=>$editStrand); push( @row, $tmp{value} ); push( @row, &{sub{ my $ac = ""; if (!$editStrand) { my %seen; my @spliced_with; foreach my $splice ( $st->splices ){ my @strands = ($splice->strand1, $splice->strand2); foreach my $sstrand ( @strands ){ if ( ($sstrand->id == $st->id) || $seen{$sstrand->id} ){ next; } $seen{$sstrand->id} = 1; push @spliced_with, '' . $sstrand->name . ''; } } $ac = join ", ", @spliced_with; } else { $ac .= <<'HERE'; HERE $ac .= '   '; $ac .= ''; $ac .= '
'; $ac .= '   '; $ac .= ''; } $ac; }} ); if (!$editStrand) { push( @row, $m->scomp('display_sequence.mhtml', strands=>[$st]) ); if ( $manager && $manager->can($user, 'edit', $o) ){ push( @row, '' ); } # This scomp method is *very* helpful. It returns as a # string what the component would have printed. Like # sprintf vs printf. } push( @rows, \@row ); } # foreach % # Print the Cable Strands table <& /generic/data_table.mhtml, field_headers=>\@headers, data=>\@rows &> % } # if scalar strands
% if ( $manager && $manager->can($user, 'edit', $o) ){ % if ($edit ne "strandinfo") {
Edit Strand Range
Range (i.e., strands 1-12)  Type: Status:   
% } % } % if ( $manager && $manager->can($user, 'edit', $o) ){ % if ($edit ne "strandinfo") {
Manually Add Strands
Manually    strands of type
<%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)); } % if ( $o->strands && @bbones ){
Manually Add Splice Range
Manually   (i.e., strands 1-12)  strands    from this backbone, to strands    from
% } % } # if edit ne strandinfo % } # if manager %} # if defined (about 300 lines up !)