| Subject: | No export for obo relationships |
perl version: v5.10.0
operation system: Linux fm2pc74 2.6.27.19-170.2.35.fc10.i686 #1 SMP
The export function does not export relationships as in obo format
(probably not in other formats as well, not tested).
The attachment contains a patch proposal, that fixes the bug for obo
format and adds the export function for missing saved-by parameter.
| Subject: | patch.Ontology.pm |
--- OBO/Core/Ontology.pm 2009-03-13 12:59:30.000000000 +0200
+++ OBO/Core/Ontology.pm.new 2009-03-13 12:58:26.000000000 +0200
@@ -1259,9 +1259,9 @@
my @heads;
if ($element && $relationship_type) {
my @rels = values(%{$self->{SOURCE_RELATIONSHIPS}->{$element}});
- my $relationship_type_id = $relationship_type->id();
+# my $relationship_type_id = $relationship_type->id();
foreach my $rel (@rels) {
- push @heads, $rel->head() if ($rel->type() eq $relationship_type_id);
+ push @heads, $rel->head() if ($rel->type() eq $relationship_type->name());
}
}
return \@heads;
@@ -1383,6 +1383,8 @@
print $file_handle "format-version: 1.2\n";
chomp(my $local_date = __date()); # `date '+%d:%m:%Y %H:%M'` # date: 11:05:2008 12:52
print $file_handle "date: ", (defined $self->date())?$self->date():$local_date, "\n";
+ my $saved_by = $self->saved_by();
+ print $file_handle "saved-by: ", $saved_by, "\n" if (defined $saved_by);
print $file_handle "auto-generated-by: ONTO-PERL\n";
# import
@@ -1501,7 +1503,7 @@
#
# is_a:
#
- my $rt = $self->get_relationship_type_by_id("is_a");
+ my $rt = $self->get_relationship_type_by_name("is_a");
if (defined $rt) {
my %saw_is_a; # avoid duplicated arrows (RelationshipSet?)
my @heads = @{$self->get_head_by_relationship_type($term, $rt)};
@@ -1542,13 +1544,13 @@
my %saw1;
# foreach $rt (sort {lc($a->id()) cmp lc($b->id())} @{$self->get_relationship_types()}) {
foreach $rt (grep (!$saw1{$_}++, sort {lc($a->id()) cmp lc($b->id())} @{$self->get_relationship_types()})) { # use this foreach-line if there are duplicated rel's
- my $rt_id = $rt->id();
- if ($rt_id ne "is_a") { # is_a is printed above
+ my $rt_name = $rt->name();
+ if ($rt_name ne "is_a") { # is_a is printed above
my @heads = @{$self->get_head_by_relationship_type($term, $rt)};
my %saw2;
#foreach my $head (sort {lc($a->id()) cmp lc($b->id())} @heads) {
foreach my $head (grep (!$saw2{$_}++, sort {lc($a->id()) cmp lc($b->id())} @heads)) { # use this foreach-line if there are duplicated rel's
- print $file_handle "\nrelationship: ", $rt_id, " ", $head->id(), " ! ", $head->name();
+ print $file_handle "\nrelationship: ", $rt_name, " ", $head->id(), " ! ", $head->name();
}
}
}