examples/zthes/tree2xml.pl

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4
   5
   6 package Node;
   7
   8 sub new {
   9     my $class = shift();
  10     my($name, $id, $parent, $note) = @_;
  11
  12     my $this = bless { name => $name,
  13                        id => $id,
  14                        parent => $parent,
  15                        children => [],
  16                        note => $note }, $class;
  17     push @{ $parent->{children} }, $this
  18         if defined $parent;
  19
  20     return $this;
  21 }
  22
  23 sub walk {
  24     my $this = shift();
  25     my($coderef) = @_;
  26
  27     &$coderef($this);
  28     foreach my $child (@{ $this->{children} }) {
  29         $child->walk($coderef)
  30     }
  31 }
  32
  33 sub write_zthes {
  34     my $this = shift();
  35
  36     print "<Zthes>\n";
  37     $this->write_term(1);
  38     my $note = $this->{note};
  39     print " <termNote>$note</termNote>\n" if defined $note;
  40     my $parent = $this->{parent};
  41     if (defined $parent) {
  42         $parent->write_relation('BT');
  43     }
  44     foreach my $child (@{ $this->{children} }) {
  45         $child->write_relation('NT');
  46     }
  47     print "</Zthes>\n";
  48 }
  49
  50 sub write_relation {
  51     my $this = shift();
  52     my($type) = @_;
  53
  54     print " <relation>\n";
  55     print "  <relationType>$type</relationType>\n";
  56     $this->write_term(2);
  57     print " </relation>\n";
  58 }
  59
  60 sub write_term {
  61     my $this = shift();
  62     my($level) = @_;
  63
  64     print ' ' x $level, "<termId>", $this->{id}, "</termId>\n";
  65     print ' ' x $level, "<termName>", $this->{name}, "</termName>\n";
  66     print ' ' x $level, "<termType>PT</termType>\n";
  67 }
  68
  69
  70 package main;
  71
  72 my @stack;
  73 my $id = 1;
  74
  75 while (<>) {
  76     chomp();
  77     s/\t/        /g;
  78     s/^( *)//;
  79     my $level = length($1);
  80     s/^\*+ //;
  81     my $note = undef;
  82     if (s/[ \t]+(.*)//) {
  83         $note = $1;
  84     }
  85     my $parent = undef;
  86     $parent = $stack[$level-1] if $level > 0;
  87     $stack[$level] = new Node($_, $id++, $parent, $note);
  88 }
  89
  90 $stack[0]->walk(\&Node::write_zthes);