Hello!

To see the file structure, click on "tree".

Note that updates take place every 10 minutes, commits may not be seen immediately.
Added more node attribute changes
authorpreecej <preecej@localhost>
Wed, 10 Aug 2011 18:58:38 +0000 (18:58 +0000)
committerpreecej <preecej@localhost>
Wed, 10 Aug 2011 18:58:38 +0000 (18:58 +0000)
svn path=/; revision=147

preecej/perl_singletons/pathway_gene_swapper.pl

index 65b41eed0731b546d45104c551a95420d91187c2..f8cbeaa8cb51716152e9c0ec8453f7de48da17fc 100644 (file)
@@ -320,9 +320,7 @@ sub swap_genes
 
     my $data_nodes = $pathway_node->getElementsByTagName("DataNode");
 
-    #print $data_nodes->getLength . "\n";
-    # if ($debug) { print "...<DEBUG: \@$data_nodes>\n"
-    #     . Dumper(@$data_nodes) . "\n\n"; }
+    # TEST: print $data_nodes->getLength . "\n";
 
     for (@$data_nodes)
     {
@@ -330,7 +328,7 @@ sub swap_genes
         my $biopaxref_nodes = $curr_datanode->getElementsByTagName("BiopaxRef");
         for (@$biopaxref_nodes)
         {
-            # print $_->getTagName . "\n";
+            # TEST: print $_->getTagName . "\n";
             $curr_datanode->removeChild($_);
         }
     }
@@ -345,7 +343,7 @@ sub swap_genes
     my %existing_hex_ids;
     for (@$data_nodes)
     {
-        #print $_ . "\n";
+        # TEST: print $_ . "\n";
         if ($_->getAttributeNode("GraphId"))
         {
             $existing_hex_ids{$_->getAttributeNode("GraphId")->getValue}
@@ -402,21 +400,16 @@ sub swap_genes
     # iterate through gene mappings from csv file
     foreach my $old_gene (keys %swap_genes)
     {
-        #print $old_gene . "\n";
+        # TEST: print $old_gene . "\n";
 
         # find curr old gene node in doc
         if (exists $data_nodes_by_gene_id{$old_gene})
         {
             my $curr_old_gene_node = $data_nodes_by_gene_id{$old_gene};
-            # print $curr_old_gene_node . "\n";
+            # TEST: print $curr_old_gene_node . "\n";
 
             # holds list of newly-created nodes, used to replace old node
-            my @new_nodes;
-
-            # testing...
-            # $new_node->setAttribute("GraphId","zzzzz");
-            # #print $new_node->getAttributeNode("GraphId")->getValue . "\n";
-            # print $new_node->toString;
+            my @new_nodes_map;
 
             # iterate through new gene replacements
             for (@{$swap_genes{$old_gene}})
@@ -424,19 +417,16 @@ sub swap_genes
                 # copy the curr old gene node
                 my $new_node = $curr_old_gene_node->cloneNode("deep");
 
-                # testing...
-                # print "[$_]\n";
-                # print $new_node->toString;
-                # print "\n\n";
+                # TEST: print "[$_]\n$new_node->toString\n\n";
 
                 # add to new nodes ary
                 # TODO: if this errs, perhaps catch and skip?
-                push @new_nodes, $new_node;
+                push @new_nodes_map, [$new_node, $_];
             }
-            # print "@new_nodes\n";
+            # TEST: print "@new_nodes_map\n";
 
             # if more than one new gene maps, you'll need a group for multiple gene boxes
-            if (scalar(@new_nodes) > 1)
+            if (scalar(@new_nodes_map) > 1)
             {
                 # if curr old gene does not belong to a group
                     # create a new group node
@@ -451,10 +441,14 @@ sub swap_genes
             my $is_first_paralog = 1; 
 
             # for new nodes ary
-            for (@new_nodes)
+            for (@new_nodes_map)
             {
                 # TODO: check for new group ref to use
                 # TODO: integrate attr settings into the if..else below 
+               
+                my $curr_new_node = $$_[0];
+                my $curr_paralog = $$_[1];
+                # TEST: print "$_: $curr_new_node, $curr_paralog\n";
                 
                 if ($is_first_paralog) 
                 {
@@ -471,28 +465,35 @@ sub swap_genes
                 }                
                 # update all new nodes w/ attributes...
 
-                # rename TextLabel (prefix (config), suffix: -alpha or numeric, based on regex)
-                $_->setAttribute("TextLabel",
+                # rename TextLabel (prefix (config), TODO: suffix: -alpha or numeric, based on regex)
+                $curr_new_node->setAttribute("TextLabel",
                     $configs{"LabelPrefix"} 
-                        . $_->getAttributeNode("TextLabel")->getValue);
+                        . $curr_new_node->getAttributeNode("TextLabel")->getValue);
                 
                 # add Comment back-referencing TAIR locus id (use "source" attribute)
                 # NOTE: order is important in GPML; the <Comment> tags are first
                 my $new_comment = $gpml_doc->createElement("Comment");
                 $new_comment->setAttribute("Source",$configs{"Source"});
                 $new_comment->addText($configs{"CommentPrefix"} . $old_gene . ".");
-                $_->insertBefore($new_comment,$_->getFirstChild); # assumes other child nodes  
+                $curr_new_node->insertBefore($new_comment,$curr_new_node->getFirstChild); # assumes other child nodes  
                 
                 # edit <Xref Database="JGI" ID="Egrandis..." />
-                # change box Width
-                # color the box (<Graphics...Color="4488ff" />)
+                my $curr_xref = ($curr_new_node->getElementsByTagName("Xref"))[0];
+                $curr_xref->setAttribute("Database",$configs{"Database"});
+                $curr_xref->setAttribute("ID",$curr_paralog);
+
+                # change box width and colors (<Graphics...Color="4488ff" ... />)
+                my $curr_graphics = ($curr_new_node->getElementsByTagName("Graphics"))[0];
+                $curr_graphics->setAttribute("Width",$configs{"BoxWidth"});
+                $curr_graphics->setAttribute("Color",$configs{"BoxBorder"});
+                $curr_graphics->setAttribute("FillColor",$configs{"BoxColor"});
             }
             
             # TODO: roll these node statments into the loop above
             # replace old node w/ new node(s); do this in place
-            for (@new_nodes) {
+            for (@new_nodes_map) {
                 # replace one...
-                $pathway_node->replaceChild($_,$curr_old_gene_node);
+                $pathway_node->replaceChild($$_[0],$curr_old_gene_node);
                 # ...and add the others immediately preceding
                 #insertBefore();
             }