Option to export colours is now in the export metadata. Also slight t…

…weaks to bootstrap block encoding/decoding. Updates #630
shawnlaffan · Feb 14, 2017 · 20e63df · 20e63df
1 parent 0bd21ce
commit 20e63df
Show file tree

Hide file tree

Showing 4 changed files with 63 additions and 52 deletions.
diff --git a/lib/Biodiverse/GUI/Tabs/Tab.pm b/lib/Biodiverse/GUI/Tabs/Tab.pm
@@ -969,47 +969,9 @@ sub do_export {
     my %args_hash;
 
     my $selected_format = $args->[1] // '';
-
-    # 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) = @_;
-
-    # check if we are in multiselect mode first
-    if(!($self->{dendrogram}->get_cluster_colour_mode() eq 'multiselect')) {
-        return 0;
-    }
-
-    # TODO: allow choice of colour format for compatibility with other
-    # packages.
-    my $response = Biodiverse::GUI::YesNoCancel->run({
-        header => "Export colours?",
-        hide_cancel => 1,
-    });
-
-    return $response eq 'yes' ? 1 : 0;
-}
-
-
-
 1;
diff --git a/lib/Biodiverse/Tree.pm b/lib/Biodiverse/Tree.pm
@@ -894,6 +894,13 @@ sub get_metadata_export_nexus {
             type    => 'boolean',
             default => 0,
         },
+        {
+            name       => 'export_colours',
+            label_text => 'Export colours',
+            tooltip    => 'Place the colours you selected in the nexus bootstrap block',
+            type       => 'boolean',
+            default    => 0,
+        },
     );
     for (@parameters) {
         bless $_, $parameter_metadata_class;
@@ -916,31 +923,53 @@ sub export_nexus {
     open( my $fh, '>', $file )
       || croak "Could not open file '$file' for writing\n";
 
+    my $export_colours = $args{export_colours};
+    if(!$export_colours) {
+        my @node_refs = $self->get_node_refs;
+        foreach my $node_ref (@node_refs) {
+            $node_ref->get_bootstrap_block->add_exclusion(exclusion => "color");
+        }
+    }
+
     print {$fh} $self->to_nexus(
         tree_name => $self->get_param('NAME'),
         %args,
     );
 
     $fh->close;
+    # clear any exclusions we set
+    my @node_refs = $self->get_node_refs;
+    foreach my $node_ref (@node_refs) {
+        $node_ref->get_bootstrap_block->clear_exclusions();
+    }
 
+
     return 1;
 }
 
 sub get_metadata_export_newick {
     my $self = shift;
 
     my @parameters = (
-        bless(
             {
                 name       => 'use_internal_names',
                 label_text => 'Label internal nodes',
                 tooltip    => 'Should the internal node labels be included?',
                 type       => 'boolean',
                 default    => 1,
             },
-            $parameter_metadata_class
-        ),
-    );
+            {
+                name       => 'export_colours',
+                label_text => 'Export colours',
+                tooltip    => 'Place the colours you selected in the nexus bootstrap block',
+                type       => 'boolean',
+                default    => 0,
+            },
+        );
+
+    for (@parameters) {
+        bless $_, $parameter_metadata_class;
+    }  
 
     my %args = (
         format     => 'Newick',
@@ -960,9 +989,22 @@ sub export_newick {
 
     open( my $fh, '>', $file )
       || croak "Could not open file '$file' for writing\n";
+
+    my $export_colours = $args{export_colours};
+    if(!$export_colours) {
+        my @node_refs = $self->get_node_refs;
+        foreach my $node_ref (@node_refs) {
+            $node_ref->get_bootstrap_block->add_exclusion(exclusion => "color");
+        }
+    }
+
     print {$fh} $self->to_newick(%args);
     $fh->close;
 
+    my @node_refs = $self->get_node_refs;
+    foreach my $node_ref (@node_refs) {
+        $node_ref->get_bootstrap_block->clear_exclusions();
+    }   
     return 1;
 }
 

diff --git a/lib/Biodiverse/TreeNode/BootstrapBlock.pm b/lib/Biodiverse/TreeNode/BootstrapBlock.pm
@@ -99,29 +99,36 @@ sub encode_bootstrap_block {
 
     # if we have nothing in this block, we probably don't want to
     # write out [], makes the nexus file ugly.
-    return $bootstrap_string eq "[]" ? "" : $bootstrap_string;
+    return $bootstrap_string eq "[&]" ? "" : $bootstrap_string;
 }
 
 
 
 # add quotes to unquoted json blocks. Needed for the json decoder
-# e.g. {key:value,key2:value2} goes to {"key":"value","key2":"value2"}
+# e.g. {&key=value,key2=value2} goes to {"key":"value","key2":"value2"}
 sub fix_up_unquoted_bootstrap_block {
     my ($self, %args) = @_;
     my $block = $args{block};
 
     # Basic idea is to find a block starting and ending with '{' or
     # ','. Take what is inside this block, and find a 'key' and
-    # 'value' separated by a ':'. If these aren't already quoted, put
+    # 'value' separated by '='. If these aren't already quoted, put
     # quotes around them. We need to do this loop because the final
     # comma of one block is the starting comma of the next block. 
-
+
+    # first remove the leading ampersand
+    $block =~ s/\{\&/{/;
     my $old = "";
     while(!($old eq $block)) {
         $old = $block;
         # crazy regex here
-        $block =~ s/([\{,])([^\"]*?)\:([^\"]*?)([\},])/$1\"$2\":\"$3\"$4/;
+        $block =~ s/([\{,])([^\"]*?)\=([^\"]*?)([\},])/$1\"$2\":\"$3\"$4/;
     }
+
+    # also replace equals signs between quotes with colons so we can
+    # use a json decoder.
+    $block =~ s/\"=\"/\":\"/g;
+
     return $block;
 }
 

diff --git a/t/32-BootstrapBlock.t b/t/32-BootstrapBlock.t
@@ -48,7 +48,7 @@ sub test_basic_operations {
 }
 
 sub test_decode {
-    my @raw_inputs = ('"foo":"bar","footwo":"bartwo",foothree:barthree');
+    my @raw_inputs = ('"foo"="bar","footwo"="bartwo",foothree=barthree');
 
 
     my %hash = ( "foo"      => "bar", 
@@ -139,10 +139,10 @@ sub test_encode {
 sub test_fix_up_unquoted_bootstrap_block {
     my $bootstrap_block = Biodiverse::TreeNode::BootstrapBlock->new();
     my %test_hash = (
-        '{key:value,key2:value2}' => '{"key":"value","key2":"value2"}',
-        '{key:value}'             => '{"key":"value"}',
-        '{"key":"value"}'         => '{"key":"value"}',
-        '{"key":"value",key2:value2,"key3":"value3"}' 
+        '{key=value,key2=value2}' => '{"key":"value","key2":"value2"}',
+        '{key=value}'             => '{"key":"value"}',
+        '{"key"="value"}'         => '{"key":"value"}',
+        '{"key"="value",key2=value2,"key3"="value3"}' 
                    => '{"key":"value","key2":"value2","key3":"value3"}',
     );