Stop passing around an 'export_colours' value, instead add exclusion …

…to the bootstrap block before export.

Updates #630

lib/Biodiverse/GUI/Export.pm

@@ -27,7 +27,6 @@ sub Run {
     my ($object, %args) = @_;
 
     my $selected_format = $args{selected_format} || '';
-    my $export_colours = $args{export_colours} || 1;
 
     #  sometimes we get called on non-objects,
     #  eg if nothing is highlighted
@@ -117,7 +116,6 @@ sub Run {
             $object->export(
                 format         => $selected_format,
                 file           => $filename,
-                export_colours => $export_colours,
                 @$params,
             )
         };

lib/Biodiverse/GUI/Tabs/Tab.pm

@@ -969,22 +969,31 @@ sub do_export {
     my %args_hash;
 
     my $selected_format = $args->[1] // '';
-
-    $args_hash{ export_colours  } 
-       = $self->export_colours_dialog(output_ref => $self->{output_ref});
 
+    # handle export/non-export of colours
+    my $export_colours = $self->export_colours_dialog();
+    if(!$export_colours) {
+        my @node_refs = $self->{output_ref}->get_node_refs;
+        foreach my $node_ref (@node_refs) {
+            $node_ref->get_bootstrap_block->add_exclusion(exclusion => "color");
+        }
+    }
+
     $args_hash{ selected_format } = $selected_format;    
-
-
     Biodiverse::GUI::Export::Run($self->{output_ref}, %args_hash);
+
+    # clear any exclusions we set
+    my @node_refs = $self->{output_ref}->get_node_refs;
+    foreach my $node_ref (@node_refs) {
+        $node_ref->get_bootstrap_block->clear_exclusions();
+    }
 }
 
 
 
 sub export_colours_dialog {
     # ask whether they want to include colours 
     my ($self, %args) = @_;
-    my $output_ref = $args{output_ref};
 
     # check if we are in multiselect mode first
     if(!($self->{dendrogram}->get_cluster_colour_mode() eq 'multiselect')) {

lib/Biodiverse/Tree.pm

@@ -1150,7 +1150,6 @@ sub export_tabular_tree {
         symmetric          => 1,
         name               => $name,
         use_internal_names => 1,
-        export_colours => $args{export_colours},
         %args,
     );
 

lib/Biodiverse/TreeNode.pm

@@ -1612,8 +1612,8 @@ sub get_bootstrap_block {
 sub to_table {
     my $self = shift;
     my %args = @_;
-    my $export_colours = $args{export_colours};
     my $treename = $args{name} || "TREE";
+
 
     #  assign unique ID numbers if not already done
     defined ($self->get_value ('NODE_NUMBER')) || $self->number_nodes;
@@ -1625,6 +1625,10 @@ sub to_table {
             plot_coords_left_to_right => $args{plot_coords_left_to_right},
         );
     }
+
+    # figure out if we're meant to be exporting colours or not
+    my $export_colours
+        = !$self->get_bootstrap_block->has_exclusion( key => "color" );
 
     # create a BaseStruct object to contain the table
     my $bs = Biodiverse::BaseStruct->new (
@@ -1950,21 +1954,10 @@ sub to_newick {   #  convert the tree to a newick format.  Based on the NEXUS li
     }
 
     # build the bootstrap block
-    my @exclusions = ();    
-
-    # if they don't want colours, remove that from the block Don't
-    # change this to if($args{export_colours}) because we want 'undef'
-    # to result in including the colours. Should probably reimplement
-    # this as an array of bootstrap block exclusions if there are more
-    # bootstrap block items that get used.
-    if($args{export_colours} && $args{export_colours} == 0) {
-        push @exclusions, "color";
-    }
-
     my $bootstrap_block = $self->get_bootstrap_block();
 
     my $bootstrap_string = 
-        $bootstrap_block->encode_bootstrap_block(exclusions => \@exclusions);
+        $bootstrap_block->encode_bootstrap_block();
 
     $string .= $bootstrap_string;
 

lib/Biodiverse/TreeNode/BootstrapBlock.pm

@@ -81,6 +81,9 @@ sub encode_bootstrap_block {
             delete $boot_values{$exclusion};
         }
     }
+
+    # also make sure "exclusions:..." isn't in the encoding
+    delete $boot_values{"exclusions"};
 
     my $json_string = encode_json \%boot_values;
 
@@ -142,4 +145,15 @@ sub clear_exclusions {
     $self->{exclusions} = undef;
 }
 
+sub has_exclusion {
+    my ($self, %args) = @_;
+    my $key = $args{key};
+
+    my @exclusions = (defined $self->{exclusions}) 
+        ? @{$self->{exclusions}} 
+        : ();
+
+    return grep( /^$key$/, @exclusions );
+}
+
 1;

t/21-ReadNexus.t

@@ -279,8 +279,7 @@ sub test_tabular_tree_from_file {
 
     my $export_tree = $phylogeny_array->[0]; 
     $result = eval {
-        $export_tree->export_tabular_tree(file => $exported_tabular_file, 
-                                          export_colours => 1,);
+        $export_tree->export_tabular_tree(file => $exported_tabular_file);
     };
     my $e = $EVAL_ERROR;
     diag $e if $e;

t/32-BootstrapBlock.t

@@ -97,6 +97,11 @@ sub test_encode {
     # test an encoding with exclusions
     $bootstrap_block->add_exclusion( exclusion => "foo"    );
     $bootstrap_block->add_exclusion( exclusion => "footwo" );
+
+    ok($bootstrap_block->has_exclusion( key => "foo" ), "has_exclusion worked" );
+    ok($bootstrap_block->has_exclusion( key => "footwo" ), "has_exclusion worked" );
+    ok(!$bootstrap_block->has_exclusion( key => "foothree" ), "has_exclusion worked" );
+
     $actual = $bootstrap_block->encode_bootstrap_block();
 
     delete $hash{ "foo"    };
@@ -113,7 +118,7 @@ sub test_encode {
 
     # now test clearing the exclusions
     $bootstrap_block->clear_exclusions();
-    my $actual = $bootstrap_block->encode_bootstrap_block();
+    $actual = $bootstrap_block->encode_bootstrap_block();
 
     %hash = (    "foo"      => "bar", 
                  "footwo"   => "bartwo",