X-Git-Url: http://git.indexdata.com/?p=idzebra-moved-to-github.git;a=blobdiff_plain;f=examples%2Fzthes%2Ftree2xml.pl;fp=examples%2Fzthes%2Ftree2xml.pl;h=92544a902746adb15640a3f353bf7b05866257f7;hp=0000000000000000000000000000000000000000;hb=9d4e6632c1548802427457774ee51c70f47e08ce;hpb=c6870a73f20b8694063dc738d5b8127ff38d593f

diff --git a/examples/zthes/tree2xml.pl b/examples/zthes/tree2xml.pl
new file mode 100755
index 0000000..92544a9
--- /dev/null
+++ b/examples/zthes/tree2xml.pl
@@ -0,0 +1,90 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+
+package Node;
+
+sub new {
+    my $class = shift();
+    my($name, $id, $parent, $note) = @_;
+
+    my $this = bless { name => $name,
+		       id => $id,
+		       parent => $parent,
+		       children => [],
+		       note => $note }, $class;
+    push @{ $parent->{children} }, $this
+	if defined $parent;
+
+    return $this;
+}
+
+sub walk {
+    my $this = shift();
+    my($coderef) = @_;
+
+    &$coderef($this);
+    foreach my $child (@{ $this->{children} }) {
+	$child->walk($coderef)
+    }
+}
+
+sub write_zthes {
+    my $this = shift();
+
+    print "<Zthes>\n";
+    $this->write_term(1);
+    my $note = $this->{note};
+    print " <termNote>$note</termNote>\n" if defined $note;
+    my $parent = $this->{parent};
+    if (defined $parent) {
+	$parent->write_relation('BT');
+    }
+    foreach my $child (@{ $this->{children} }) {
+	$child->write_relation('NT');
+    }
+    print "</Zthes>\n";
+}
+
+sub write_relation {
+    my $this = shift();
+    my($type) = @_;
+
+    print " <relation>\n";
+    print "  <relationType>$type</relationType>\n";
+    $this->write_term(2);
+    print " </relation>\n";
+}
+
+sub write_term {
+    my $this = shift();
+    my($level) = @_;
+
+    print ' ' x $level, "<termId>", $this->{id}, "</termId>\n";
+    print ' ' x $level, "<termName>", $this->{name}, "</termName>\n";
+    print ' ' x $level, "<termType>PT</termType>\n";
+}
+
+
+package main;
+
+my @stack;
+my $id = 1;
+
+while (<>) {
+    chomp();
+    s/\t/        /g;
+    s/^( *)//;
+    my $level = length($1);
+    s/^\*+ //;
+    my $note = undef;
+    if (s/[ \t]+(.*)//) {
+	$note = $1;
+    }
+    my $parent = undef;
+    $parent = $stack[$level-1] if $level > 0;
+    $stack[$level] = new Node($_, $id++, $parent, $note);
+}
+
+$stack[0]->walk(\&Node::write_zthes);