1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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);
|
