Commit bca66466 authored by Kevin Atkinson's avatar Kevin Atkinson

Implement front-end parts for backfill changes. Added the following

NS commands:
  tb-set-link-backfill <link> <bw>
  tb-set-link-simplex-backfill <link> <src node> <bw>
  tb-set-lan-backfill <lan> <bw>
  tb-set-node-lan-backfill <node> <lan> <bw>
  tb-set-lan-simplex-backfill <lan> <node> <tobw> <frombw>
for now the tbres/FBSD410-DEL-BACKFILL image needs to be used.
parent f51d925c
This diff is collapsed.
......@@ -186,71 +186,85 @@ foreach my $lan (keys(%virt_lans)) {
my $member0 = $virt_lans{$lan}->{"MEMBERS"}->{$members[0]};
my $member1 = $virt_lans{$lan}->{"MEMBERS"}->{$members[1]};
my $node0 = $member0->{"vnode"};
my $delay0 = $member0->{"delay"};
my $loss0 = $member0->{"lossrate"};
my $bw0 = $member0->{"bandwidth"};
my $rdelay0 = $member0->{"rdelay"};
my $rloss0 = $member0->{"rlossrate"};
my $rbw0 = $member0->{"rbandwidth"};
my $node0 = $member0->{"vnode"};
my $delay0 = $member0->{"delay"};
my $loss0 = $member0->{"lossrate"};
my $bw0 = $member0->{"bandwidth"};
my $backfill0 = $member0->{"backfill"};
my $rdelay0 = $member0->{"rdelay"};
my $rloss0 = $member0->{"rlossrate"};
my $rbw0 = $member0->{"rbandwidth"};
my $rbackfill0 = $member0->{"rbackfill"};
my $qtype0 = "droptail";
if ($member0->{"q_red"}) {
$qtype0 = ($member0->{"q_gentle"} ? "gred" : "red");
}
my $node1 = $member1->{"vnode"};
my $delay1 = $member1->{"delay"};
my $loss1 = $member1->{"lossrate"};
my $bw1 = $member1->{"bandwidth"};
my $rdelay1 = $member1->{"rdelay"};
my $rloss1 = $member1->{"rlossrate"};
my $rbw1 = $member1->{"rbandwidth"};
my $qtype1 = "droptail";
my $node1 = $member1->{"vnode"};
my $delay1 = $member1->{"delay"};
my $loss1 = $member1->{"lossrate"};
my $bw1 = $member1->{"bandwidth"};
my $backfill1 = $member1->{"backfill"};
my $rdelay1 = $member1->{"rdelay"};
my $rloss1 = $member1->{"rlossrate"};
my $rbw1 = $member1->{"rbandwidth"};
my $rbackfill1 = $member1->{"rbackfill"};
my $qtype1 = "droptail";
if ($member1->{"q_red"}) {
$qtype1 = ($member1->{"q_gentle"} ? "gred" : "red");
}
# ebw stands for effective bandwith, it is bw - backfill
my $delay = ($delay0+$rdelay1) / 1000.0 ;
my $loss = 1-(1-$loss0)*(1-$rloss1);
my $bw = &min($bw0,$rbw1) * 1000;
my $backfill = &max($backfill0,$rbackfill1) * 1000;
my $ebw = $bw - $backfill;
my $rdelay = ($rdelay0+$delay1) / 1000.0;
my $rloss = 1-(1-$rloss0)*(1-$loss1);
my $rbw = &min($rbw0,$bw1) * 1000;
my $rbackfill = &max($rbackfill0,$backfill1) * 1000;
my $rebw = $rbw - $rbackfill;
printf $LTOUT
"l $node0 $node1 $bw %.4f %.6f $lan $qtype0\n", $delay, $loss;
"l $node0 $node1 $ebw %.4f %.6f $lan $qtype0\n", $delay, $loss;
printf $LTOUT
"l $node1 $node0 $rbw %.4f %.6f $lan $qtype1\n", $rdelay, $rloss;
"l $node1 $node0 $rebw %.4f %.6f $lan $qtype1\n", $rdelay, $rloss;
}
else {
foreach my $memb0 (@members) {
my $member0 = $virt_lans{$lan}->{"MEMBERS"}->{$memb0};
my $node0 = $member0->{"vnode"};
my $delay0 = $member0->{"delay"};
my $loss0 = $member0->{"lossrate"};
my $bw0 = $member0->{"bandwidth"};
my $node0 = $member0->{"vnode"};
my $delay0 = $member0->{"delay"};
my $loss0 = $member0->{"lossrate"};
my $bw0 = $member0->{"bandwidth"};
my $backfill0 = $member0->{"backfill"};
foreach my $memb1 (@members) {
next
if ($memb0 eq $memb1);
my $member1 = $virt_lans{$lan}->{"MEMBERS"}->{$memb1};
my $node1 = $member1->{"vnode"};
my $rdelay1 = $member1->{"rdelay"};
my $rloss1 = $member1->{"rlossrate"};
my $rbw1 = $member1->{"rbandwidth"};
my $member1 = $virt_lans{$lan}->{"MEMBERS"}->{$memb1};
my $node1 = $member1->{"vnode"};
my $rdelay1 = $member1->{"rdelay"};
my $rloss1 = $member1->{"rlossrate"};
my $rbw1 = $member1->{"rbandwidth"};
my $rbackfill1 = $member1->{"rbackfill"};
my $qtype1 = "droptail";
if ($member1->{"q_red"}) {
$qtype1 = ($member1->{"q_gentle"} ? "gred" : "red");
}
# ebw stands for effective bandwith, it is bw - backfill
my $delay = ($delay0+$rdelay1) / 1000.0;
my $loss = 1-(1-$loss0)*(1-$rloss1);
my $bw = &min($bw0,$rbw1) * 1000;
my $backfill = &max($backfill0,$rbackfill1) * 1000;
my $ebw = $bw - $backfill;
printf $LTOUT
"l $node0 $node1 $bw %.4f %.6f $lan $qtype1\n",
"l $node0 $node1 $ebw %.4f %.6f $lan $qtype1\n",
$delay, $loss;
}
}
......
......@@ -256,6 +256,8 @@ LanLink instproc init {s nodes bw d type} {
$self instvar rbandwidth
$self instvar ebandwidth
$self instvar rebandwidth
$self instvar backfill
$self instvar rbackfill
$self instvar delay
$self instvar rdelay
$self instvar loss
......@@ -274,6 +276,8 @@ LanLink instproc init {s nodes bw d type} {
# Note - we don't set defaults for ebandwidth and rebandwidth - lack
# of an entry for a nodepair indicates that they should be left NULL
# in the output.
set backfill($nodepair) 0
set rbackfill($nodepair) 0
set delay($nodepair) [expr $d / 2.0]
set rdelay($nodepair) [expr $d / 2.0]
set loss($nodepair) 0
......@@ -695,6 +699,8 @@ Link instproc updatedb {DB} {
$self instvar rbandwidth
$self instvar ebandwidth
$self instvar rebandwidth
$self instvar backfill
$self instvar rbackfill
$self instvar delay
$self instvar rdelay
$self instvar loss
......@@ -768,7 +774,7 @@ Link instproc updatedb {DB} {
set nodeportraw [join $nodeport ":"]
set fields [list "vname" "member" "mask" "delay" "rdelay" "bandwidth" "rbandwidth" "lossrate" "rlossrate" "cost" "widearea" "emulated" "uselinkdelay" "nobwshaping" "encap_style" "q_limit" "q_maxthresh" "q_minthresh" "q_weight" "q_linterm" "q_qinbytes" "q_bytes" "q_meanpsize" "q_wait" "q_setbit" "q_droptail" "q_red" "q_gentle" "trivial_ok" "protocol" "vnode" "vport" "ip" "mustdelay"]
set fields [list "vname" "member" "mask" "delay" "rdelay" "bandwidth" "rbandwidth" "backfill" "rbackfill" "lossrate" "rlossrate" "cost" "widearea" "emulated" "uselinkdelay" "nobwshaping" "encap_style" "q_limit" "q_maxthresh" "q_minthresh" "q_weight" "q_linterm" "q_qinbytes" "q_bytes" "q_meanpsize" "q_wait" "q_setbit" "q_droptail" "q_red" "q_gentle" "trivial_ok" "protocol" "vnode" "vport" "ip" "mustdelay"]
# Treat estimated bandwidths differently - leave them out of the lists
# unless the user gave a value - this way, they get the defaults if not
......@@ -796,7 +802,7 @@ Link instproc updatedb {DB} {
lappend fields "fixed_iface"
}
set values [list $self $nodeportraw $netmask $delay($nodeport) $rdelay($nodeport) $bandwidth($nodeport) $rbandwidth($nodeport) $loss($nodeport) $rloss($nodeport) $cost($nodeport) $widearea $emulated $uselinkdelay $nobwshaping $encap $limit_ $maxthresh_ $thresh_ $q_weight_ $linterm_ ${queue-in-bytes_} $bytes_ $mean_pktsize_ $wait_ $setbit_ $droptail_ $red_ $gentle_ $trivial_ok $protocol $node $port $ip $mustdelay]
set values [list $self $nodeportraw $netmask $delay($nodeport) $rdelay($nodeport) $bandwidth($nodeport) $rbandwidth($nodeport) $backfill($nodeport) $rbackfill($nodeport) $loss($nodeport) $rloss($nodeport) $cost($nodeport) $widearea $emulated $uselinkdelay $nobwshaping $encap $limit_ $maxthresh_ $thresh_ $q_weight_ $linterm_ ${queue-in-bytes_} $bytes_ $mean_pktsize_ $wait_ $setbit_ $droptail_ $red_ $gentle_ $trivial_ok $protocol $node $port $ip $mustdelay]
if { [info exists ebandwidth($nodeport)] } {
lappend values $ebandwidth($nodeport)
......@@ -837,6 +843,8 @@ Lan instproc updatedb {DB} {
$self instvar rbandwidth
$self instvar ebandwidth
$self instvar rebandwidth
$self instvar backfill
$self instvar rbackfill
$self instvar delay
$self instvar rdelay
$self instvar loss
......@@ -930,7 +938,7 @@ Lan instproc updatedb {DB} {
set is_accesspoint 1
}
set fields [list "vname" "member" "mask" "delay" "rdelay" "bandwidth" "rbandwidth" "lossrate" "rlossrate" "cost" "widearea" "emulated" "uselinkdelay" "nobwshaping" "encap_style" "q_limit" "q_maxthresh" "q_minthresh" "q_weight" "q_linterm" "q_qinbytes" "q_bytes" "q_meanpsize" "q_wait" "q_setbit" "q_droptail" "q_red" "q_gentle" "trivial_ok" "protocol" "is_accesspoint" "vnode" "vport" "ip" "mustdelay"]
set fields [list "vname" "member" "mask" "delay" "rdelay" "bandwidth" "rbandwidth" "backfill" "rbackfill" "lossrate" "rlossrate" "cost" "widearea" "emulated" "uselinkdelay" "nobwshaping" "encap_style" "q_limit" "q_maxthresh" "q_minthresh" "q_weight" "q_linterm" "q_qinbytes" "q_bytes" "q_meanpsize" "q_wait" "q_setbit" "q_droptail" "q_red" "q_gentle" "trivial_ok" "protocol" "is_accesspoint" "vnode" "vport" "ip" "mustdelay"]
# Treat estimated bandwidths differently - leave them out of the lists
# unless the user gave a value - this way, they get the defaults if not
......@@ -958,7 +966,7 @@ Lan instproc updatedb {DB} {
lappend fields "fixed_iface"
}
set values [list $self $nodeportraw $netmask $delay($nodeport) $rdelay($nodeport) $bandwidth($nodeport) $rbandwidth($nodeport) $loss($nodeport) $rloss($nodeport) $cost($nodeport) $widearea $emulated $uselinkdelay $nobwshaping $encap $limit_ $maxthresh_ $thresh_ $q_weight_ $linterm_ ${queue-in-bytes_} $bytes_ $mean_pktsize_ $wait_ $setbit_ $droptail_ $red_ $gentle_ $trivial_ok $protocol $is_accesspoint $node $port $ip $mustdelay]
set values [list $self $nodeportraw $netmask $delay($nodeport) $rdelay($nodeport) $bandwidth($nodeport) $rbandwidth($nodeport) $backfill($nodeport) $rbackfill($nodeport) $loss($nodeport) $rloss($nodeport) $cost($nodeport) $widearea $emulated $uselinkdelay $nobwshaping $encap $limit_ $maxthresh_ $thresh_ $q_weight_ $linterm_ ${queue-in-bytes_} $bytes_ $mean_pktsize_ $wait_ $setbit_ $droptail_ $red_ $gentle_ $trivial_ok $protocol $is_accesspoint $node $port $ip $mustdelay]
if { [info exists ebandwidth($nodeport)] } {
lappend values $ebandwidth($nodeport)
......
......@@ -84,6 +84,11 @@ proc tb-set-node-id {vnode myid} {}
proc tb-set-link-est-bandwidth {srclink args} {}
proc tb-set-lan-est-bandwidth {lan bw} {}
proc tb-set-node-lan-est-bandwidth {node lan bw} {}
proc tb-set-link-backfill {srclink args} {}
proc tb-set-link-simplex-backfill {link src bw} {}
proc tb-set-lan-backfill {lan bw} {}
proc tb-set-node-lan-backfill {node lan bw} {}
proc tb-set-lan-simplex-backfill {lan node tobw frombw} {}
proc tb-set-node-plab-role {node role} {}
proc tb-set-node-plab-plcnet {node lanlink} {}
proc tb-set-dpdb {onoff} {}
......
......@@ -571,6 +571,10 @@ proc parse_bw {bspec {islink 1}} {
return $val
}
proc parse_backfill {bspec} {
return [parse_bw $bspec 0]
}
# parse_delay dspec
# This takes a delay specifier in the form of <amt><unit> where <unit>
# is any of s, ms, ns. If no unit is given then seconds (s) is
......
......@@ -570,6 +570,64 @@ proc tb-set-link-est-bandwidth {srclink args} {
}
}
# This takes two possible formats:
# tb-set-link-backfill <link> <bw>
# tb-set-link-backfill <src> <dst> <bw>
proc tb-set-link-backfill {srclink args} {
if {[llength $args] == 2} {
set dst [lindex $args 0]
set bw [lindex $args 1]
set sim [$srclink set sim]
set reallink [$sim find_link $srclink $dst]
if {$reallink == {}} {
perror "\[tb-set-link-backfill] No link between $srclink and $dst."
return
}
} else {
if {[$srclink info class] != "Link"} {
perror "\[tb-set-link-backfill] $srclink is not a link."
return
}
set reallink $srclink
set bw [lindex $args 0]
}
$reallink instvar bandwidth
$reallink instvar backfill
$reallink instvar rbackfill
foreach pair [array names bandwidth] {
set backfill($pair) [parse_bw $bw]
set rbackfill($pair) [parse_bw $bw]
}
}
# This takes two possible formats:
# tb-set-link-backfill <link> <src> <bw>
proc tb-set-link-simplex-backfill {link src bw} {
var_import ::TBCOMPAT::FLOAT
if {[$link info class] != "Link"} {
perror "\[tb-set-link-simplex-backfill] $link is not a link."
return
}
if {[$src info class] != "Node"} {
perror "\[tb-set-link-simplex-backfill] $src is not a node."
return
}
set port [$link get_port $src]
if {$port == {}} {
perror "\[tb-set-link-simplex-params] $src is not in $link."
return
}
set np [list $src $port]
foreach nodeport [$link set nodelist] {
if {$nodeport != $np} {
set onp $nodeport
}
}
set realbw [parse_bw $bw]
$link set backfill($np) $realbw
$link set rbackfill($onp) $realbw
}
proc tb-set-lan-loss {lan lossrate} {
var_import ::TBCOMPAT::FLOAT
if {[$lan info class] != "Lan"} {
......@@ -604,6 +662,21 @@ proc tb-set-lan-est-bandwidth {lan bw} {
}
}
proc tb-set-lan-backfill {lan bw} {
if {[$lan info class] != "Lan"} {
perror "\[tb-set-lan-backfill] $lan is not a lan."
return
}
$lan instvar bandwidth
$lan instvar backfill
$lan instvar rbackfill
foreach pair [array names bandwidth] {
set backfill($pair) [parse_bw $bw]
set rbackfill($pair) [parse_bw $bw]
}
}
proc tb-set-node-lan-delay {node lan delay} {
if {[$node info class] != "Node"} {
perror "\[tb-set-node-lan-delay] $node is not a node."
......@@ -659,6 +732,23 @@ proc tb-set-node-lan-est-bandwidth {node lan bw} {
$lan set ebandwidth([list $node $port]) [parse_bw $bw]
$lan set rebandwidth([list $node $port]) [parse_bw $bw]
}
proc tb-set-node-lan-backfill {node lan bw} {
if {[$node info class] != "Node"} {
perror "\[tb-set-node-lan-backfill] $node is not a node."
return
}
if {[$lan info class] != "Lan"} {
perror "\[tb-set-node-lan-backfill] $lan is not a lan."
return
}
set port [$lan get_port $node]
if {$port == {}} {
perror "\[tb-set-node-lan-backfill] $node is not in $lan."
return
}
$lan set backfill([list $node $port]) [parse_bw $bw]
$lan set rbackfill([list $node $port]) [parse_bw $bw]
}
proc tb-set-node-lan-loss {node lan loss} {
var_import ::TBCOMPAT::FLOAT
if {[$node info class] != "Node"} {
......@@ -763,7 +853,7 @@ proc tb-set-link-simplex-params {link src delay bw loss} {
return
}
if {[$src info class] != "Node"} {
perror "\[tb-set-link-simplex-params] $src is not a link."
perror "\[tb-set-link-simplex-params] $src is not a node."
return
}
set port [$link get_port $src]
......@@ -793,6 +883,28 @@ proc tb-set-link-simplex-params {link src delay bw loss} {
$link set rloss($onp) [expr $adjloss]
}
proc tb-set-lan-simplex-backfill {lan node tobw frombw} {
var_import ::TBCOMPAT::FLOAT
if {[$node info class] != "Node"} {
perror "\[tb-set-lan-simplex-params] $node is not a node."
return
}
if {[$lan info class] != "Lan"} {
perror "\[tb-set-lan-simplex-params] $lan is not a lan."
return
}
set port [$lan get_port $node]
if {$port == {}} {
perror "\[tb-set-lan-simplex-params] $node is not in $lan."
return
}
set realtobw [parse_backfill $tobw]
set realfrombw [parse_backfill $frombw]
$lan set backfill([list $node $port]) $realtobw
$lan set rbackfill([list $node $port]) $realfrombw
}
proc tb-set-lan-simplex-params {lan node todelay tobw toloss fromdelay frombw fromloss} {
var_import ::TBCOMPAT::FLOAT
if {[$node info class] != "Node"} {
......
......@@ -28,6 +28,8 @@ sub usage {
return 1;
}
sub dump_table($$$$);
my $TBROOT = "@prefix@";
my $DOMAIN = "@OURDOMAIN@";
......@@ -378,12 +380,7 @@ if ($showlinks) {
}
if ($vlan_result->numrows) {
print "Virtual Lan/Link Info:\n";
printf "%-15s %-15s %-15s %-9s %-9s %-9s\n",
"ID", "Member/Proto", "IP/Mask", "Delay","BW (Kbs)","Loss Rate";
print "--------------- --------------- --------------- --------- ".
"--------- ---------\n";
my @data;
while (my %row = $vlan_result->fetchhash()) {
my $vname = $row{"vname"};
my $vnode = $row{"vnode"};
......@@ -393,18 +390,26 @@ if ($showlinks) {
my $mask = $row{"mask"};
my $delay = $row{"delay"};
my $bandwidth = $row{"bandwidth"};
my $backfill = $row{"backfill"};
my $lossrate = $row{"lossrate"};
my $rdelay = $row{"rdelay"};
my $rbandwidth = $row{"rbandwidth"};
my $rbackfill = $row{"rbackfill"};
my $rlossrate = $row{"rlossrate"};
my $protocol = $row{"protocol"};
printf "%-15s %-15s %-15s %-9s %-9s %-9s\n", $vname,
$member, $ipmap{$member}, $delay, $bandwidth, $lossrate;
printf "%-15s %-15s %-15s %-9s %-9s %-9s\n", "",
$protocol, $mask, $rdelay, $rbandwidth, $rlossrate;
push @data, [$vname, $member, $ipmap{$member},
$delay, $bandwidth, $backfill, $lossrate];
push @data, ["", $protocol, $mask, $rdelay, $rbandwidth, $rbackfill, $rlossrate];
}
print "Virtual Lan/Link Info:\n";
dump_table(["ID", "Member/Proto", "IP/Mask",
"Delay","BW (Kbs)","Backfill", "Loss Rate"],
["Backfill"],
[15,15,15,9,9,9,9],
\@data);
print "\n";
$vlan_result->dataseek(0);
}
......@@ -697,14 +702,7 @@ if ($showdelays && $state eq EXPTSTATE_ACTIVE) {
"where pid='$pid' and eid='$eid' ".
"order by vlan,vnode,node_id");
if ($result_delays->numrows || $result_linkdelays->numrows) {
print "Physical Delay Info:\n";
printf "%-15s %-15s %-12s %-8s %-8s %-6s %-9s\n",
"ID", "Member", "Delay Node", "Delay", "BW (Kbs)", "PLR",
"Pipe";
print "--------------- --------------- ------------ -------- ".
"-------- ------ ---------\n";
}
my @data;
if ($result_delays->numrows) {
while (my %row = $result_delays->fetchhash()) {
......@@ -712,38 +710,44 @@ if ($showdelays && $state eq EXPTSTATE_ACTIVE) {
next
if ($row{'iface'} eq $row{'iface1'});
printf("%-15s %-15s %-12s %-8s %-8s %-6s %-9s\n",
$row{vname}, $row{vnode0}, $row{delayvname},
$row{delay0}, $row{bandwidth0}, $row{lossrate0},
$row{pipe0});
push @data, [$row{vname}, $row{vnode0}, $row{delayvname},
$row{delay0}, $row{bandwidth0}, $row{backfill0}, $row{lossrate0},
$row{pipe0}];
# If vnode0 eq vnode1, its a lan node. Print differently.
printf("%-15s %-15s %-12s %-8s %-8s %-6s %-9s\n",
($row{vnode0} eq $row{vnode1} ? "" : $row{vname}),
($row{vnode0} eq $row{vnode1} ? "" : $row{vnode1}),
($row{vnode0} eq $row{vnode1} ? "" : $row{delayvname}),
$row{delay1}, $row{bandwidth1}, $row{lossrate1},
$row{pipe1});
push @data, [($row{vnode0} eq $row{vnode1} ? "" : $row{vname}),
($row{vnode0} eq $row{vnode1} ? "" : $row{vnode1}),
($row{vnode0} eq $row{vnode1} ? "" : $row{delayvname}),
$row{delay1}, $row{bandwidth1}, $row{backfill1}, $row{lossrate1},
$row{pipe1}];
}
print "\n";
push @data, [];
}
if ($result_linkdelays->numrows) {
while (my %row = $result_linkdelays->fetchhash()) {
printf("%-15s %-15s %-12s %-8s %-8s %-6s %-9s\n",
$row{vlan}, $row{vnode}, $row{node_id},
$row{delay}, $row{bandwidth}, $row{lossrate},
$row{pipe});
push @data, [$row{vlan}, $row{vnode}, $row{node_id},
$row{delay}, $row{bandwidth}, $row{lossrate},
$row{pipe}];
# Lan node, from the switch
if ($row{type} eq "duplex") {
printf("%-15s %-15s %-12s %-8s %-8s %-6s %-9s\n", "", "", "",
$row{rdelay}, $row{rbandwidth}, $row{rlossrate},
$row{rpipe});
push @data, ["", "", "",
$row{rdelay}, $row{rbandwidth}, $row{rlossrate},
$row{rpipe}];
}
}
print "\n";
push @data, [];
}
if (@data) {
print "Physical Delay Info:\n";
dump_table(["ID", "Member", "Delay Node", "Delay", "BW (Kbs)",
"Backfill", "PLR", "Pipe"],
["Backfill"],
[15, 15, 12, 8, 8, 8, 6, 9],
\@data);
}
$result_delays->dataseek(0);
......@@ -1000,3 +1004,54 @@ if ($showfwinfo) {
}
}
exit(0);
#
# dump_table: Dumps a formated table, skipping over any column that
# don't have a value if they are listed in the optional array;
#
sub skip_over ($$);
sub dump_table($$$$) { # all parameters are expected to be array references
my ($names, $optional, $widths, $data) = @_;
my %names_map;
my $last = @$names - 1;
foreach (0 .. $last) {
$names_map{$$names[$_]} = $_;
}
my @optional;
foreach (@$optional) {
$optional[$names_map{$_}] = 1;
}
my @keep;
foreach (@$data) {
my @d = @$_;
for (0..$last) {
$keep[$_]++ if ($d[$_]);
}
}
foreach (0 .. $last) {
$keep[$_] = 1 unless $optional[$_];
}
my $format = join(' ', map {"%-${_}s"} skip_over($widths,\@keep))."\n";
printf($format,skip_over($names,\@keep));
print join(' ', map {'-'x$_} skip_over($widths,\@keep))."\n";
foreach (@$data) {
if (@$_ > 0) {
printf($format, skip_over($_,\@keep));
} else {
print "\n";
}
}
}
sub skip_over ($$) {
my ($data, $keep) = @_;
my @res;
foreach (0..$#$data) {
push @res, $$data[$_] if $$keep[$_];
}
return @res;
}
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment