#!/usr/bin/perl

#use strict;
#use warnings;
use diagnostics;

# Program: parse_pathways2obo_PWYid.pl
#
# Original Author: Mary Dolan
#
# Purpose: Given Pathway Tools files -- pathway-links.dat, classes.dat, pathways.dat
#    generates mousecyc_pathways.obo OBO format mousecyc pathways ontology
#
# Usage: perl parse_pathways2obo_PWYid.pl
#

open (PATH2OBO, ">mousecyc.obo") ||print "PATH2OBO open error";
open (PROBLEMS, ">problem_mousecyc_ids.txt") ||print "PROBLEMS open error";

open (NAMES, "pathway-links.dat") ||print "NAMES open error";
while (<NAMES>) {
## 
if (/^(.*?)\t(.*)$/) {
	$id = $1;
	$name{$id} = $2;
	}
}
close NAMES;

##### parse files to create obo file
%nodes = ();
$mousecyc_count = 0;
	&parse_class();
	&parse_path();

# assign nodes to ancestors
	foreach $query_node (keys %nodes) {
	@ancestor_nodes = ();
	&find_ancestors($query_node);
	}
	
# assign default names to pathways
	foreach $query_node (keys %nodes) {
		$node_name = $nodes{$query_node}->{"name"};
		if ($node_name eq "") {
		$nodes{$query_node}->{"name"} = $query_node;
		}
	}
	
# want only descendants of Pathways
# id: Pathways

# print obo file
	foreach $query_node (sort keys %nodes) {
		$node_name = $nodes{$query_node}->{"name"};
		#$mousecyc_id = $nodes{$query_node}->{"mousecyc_id"};
		$mousecyc_id = $query_node;
		
		$url_id = $query_node;
		$url_id =~ s/\+/\%2B/g;
		$url_id =~ s/ /\+/g;
		if ($url_id =~ /[^a-zA-Z0-9+%-:<]/) {
			print PROBLEMS "$url_id\n";
			}
		#print PATH2OBO "\n[Term]\nid: MC:";
		#printf PATH2OBO "%07d", $mousecyc_id;
		print PATH2OBO "\n[Term]\nid: $mousecyc_id";
		print PATH2OBO "\nname: $node_name\n";
		#print PATH2OBO "synonym: \"$url_id\" EXACT []\n";
		if ($url_id ne $query_node) {
			print PATH2OBO "comment: old id is $ query_node\n";
			}
		@parents = @ { $nodes{$query_node}->{"parents"} };
		foreach $parent (@parents) {
			$parent_node = $parent->{"id"};
			$parent_name = $nodes{$parent_node}->{"name"};
			#$parent_mousecyc_id = $nodes{$parent_node}->{"mousecyc_id"};
			$parent_mousecyc_id = $parent_node;
			#print PATH2OBO "is_a: MC:";
			#printf PATH2OBO "%07d", $parent_mousecyc_id;
			print PATH2OBO "is_a: $parent_mousecyc_id";
			print PATH2OBO " ! $parent_name\n";
		}
		#@ancestor_nodes = @ { $nodes{$query_node}->{"ancestors"} };
		#foreach $ancestor_node (@ancestor_nodes) {
		#	$ancestor_name = $nodes{$ancestor_node}->{"name"};
		#	#print PATH2OBO "ancestor: $ancestor_node ! $ancestor_name\n";
		#}
	}

close PROBLEMS;
close PATH2OBO;
exit (0);

############
sub parse_class()
{
    open (CLASS, "classes.dat") ||print "ontology open error";
    while (<CLASS>) {

    if (/^UNIQUE-ID - (.*)$/) {
    #new term
    $mousecyc_count++;
    $node_id = $1;
	$node_name = "";
	@parent_nodes = ();
	#print PATH2OBO "\nin parse_class $node_id\n";
	&get_classnode_info($node_id, $node_name, @parent_nodes);
	#print PATH2OBO "back in parseclass name: $node_name\n";
	$term = {
		"name" => $node_name,
		"parents" => [ @parent_nodes ],
		"ancestors" => [  ],
		"mousecyc_id" => $mousecyc_count,
		};

	$nodes{$node_id} = $term;
	} #end term test
     } #end read loop

     close (CLASS);
}

############
sub parse_path()
{
#print PATH2OBO "\n***********\nreading reactions\n************\n";
    open (PATHWAY, "pathways.dat") ||print "PATHWAY open error";
    while (<PATHWAY>) {

    if (/^UNIQUE-ID - (.*)$/) {
    #new term
    $mousecyc_count++;
    $node_id = $1;
	$node_name = "";
	@parent_nodes = ();
	#print PATH2OBO "\nin parse_path $node_id\n";
	&get_pathnode_info($node_id, $node_name, @parent_nodes);
	#print PATH2OBO "back in parsepath name: $node_name\n";
	$term = {
		"name" => $node_name,
		"parents" => [ @parent_nodes ],
		"ancestors" => [  ],
		"mousecyc_id" => $mousecyc_count,
		};

	$nodes{$node_id} = $term;
	} #end term test
     } #end read loop

     close (PATHWAY);
}

############
sub get_classnode_info()
{

local $node_id = shift;
$node_name = "";
@parent_nodes = ();
    
while (<CLASS>) {
## 
#clear info
    
    chomp;
    $term_line = $_; 
    
    #node name
	if ($term_line =~ /^COMMON-NAME - (.*)$/) {
		$node_name = $1;
	#print PATH2OBO "in classnode $node_id name: $node_name\n";
		}
	
    #is_a
	if ($term_line =~ /^TYPES - (.*)$/) {
	    $parent_id=$1;
	    $parent_type = "is_a";
	#print PATH2OBO "in classnode $node_id is_a: $parent_id\n";
	    $parent = {
		      "id" => $parent_id,
		      "type" => $parent_type,
		      };
	    push @parent_nodes, $parent;
		}

    #end of Term
	if ($term_line eq "//") {
	    return();
	    }
	    
    } #end read node
} #end get_classnode_info routine

############
sub get_pathnode_info()
{
local $node_id = shift;
$node_name = "";
@parent_nodes = ();
    
while (<PATHWAY>) {
## 
#clear info
    
    chomp;
    $term_line = $_; 
    
    #node name
	if ($term_line =~ /^COMMON-NAME - (.*)$/) {
		$node_name = $1;
	#print PATH2OBO "in pathnode $node_id name: $node_name\n";
		}
	
    #is_a
	if ($term_line =~ /^TYPES - (.*)$/) {
	    $parent_id=$1;
	    $parent_type = "is_a";
	#print PATH2OBO "in pathnode $node_id is_a: $parent_id\n";
	    $parent = {
		      "id" => $parent_id,
		      "type" => $parent_type,
		      };
	    push @parent_nodes, $parent;
		}

    #end of Term
	if ($term_line eq "//") {
	    if (($node_name eq "") and (exists $name{$node_id})) {
	    	$node_name = $name{$node_id};
	print PATH2OBO "getting $node_id name from file: $node_name\n";
	    	}
	    return();
	    }
	    
    } #end read node
} #end get_pathnode_info routine

#############
sub find_ancestors()
{
	#find parents/ancestors
	&find_parents($query_node);

		# select unique objects
		%seen = ();
    		$seen{$query_node}++;
		foreach $item (@ancestor_nodes) {
    			$seen{$item}++;
			}
		@ancestor_nodes = keys %seen;
	$nodes{$query_node}->{"ancestors"} = [ @ancestor_nodes ];
}

#############
sub find_parents()
{
    local $node_id = shift;
    local @parent_nodes = @ { $nodes{$node_id}->{"parents"} };

    #no more parents (stopping condition)
    if (!@parent_nodes) {
	return();
	}
    #
    foreach $parent (@parent_nodes) {
	$parent_id = $parent->{"id"};
	push @ancestor_nodes, $parent_id;
	&find_parents($parent_id);
	}
} #end find_parents routine


__END__

//
UNIQUE-ID - Pathways
TYPES - Generalized-Reactions
COMMENT - This class is the root of a classification hierarchy for metabolic
/pathways.  Its subclasses divide pathways into groups
/based on their biological functions, and based on the classes
/of metabolites that they produce and/or consume.
//

open (RXN, "reactions.dat") ||print "RXN open error";
"mitochondrial inheritance" EXACT []

