html-webhacc/WebHACC/Result.pm

package WebHACC::Result;
use strict;

sub new ($) {
  return bless {}, shift;
} # new

sub output ($;$) {
  if (@_ > 1) {
    if (defined $_[1]) {
      $_[0]->{output} = $_[1];
    } else {
      delete $_[0]->{output};
    }
  }

  return $_[0]->{output};
} # output

sub add_error ($%) {
  my ($self, %opt) = @_;

  my $out = $self->output;

  my $error_level = $opt{level};
  if (not defined $error_level) {
    $error_level = 'm'; ## NOTE: Unknown - an error of the implementation
  } elsif ({
    m => 1, s => 1, w => 1, i => 1, u => 1,
  }->{$error_level}) {
    #
  } else {
    $error_level = 'm'; ## NOTE: Unknown - an error of the implementation
  }

  my $error_layer = $opt{layer};
  if (not defined $error_layer) {
    $error_layer = 'syntax'; ## NOTE: Unknown - an error of the implementation
  } elsif ({
    transfer => 1,
    encode => 1,
    charset => 1,
    syntax => 1,
    structure => 1,
    semantics => 1,
  }->{$error_layer}) {
    #
  } else {
    $error_layer = 'syntax'; ## NOTE: Unknown - an error of the implementation
  }

  my $error_type_text = $opt{type};

  my $class = qq[level-$error_level layer-$error_layer];
 
  $out->start_tag ('dt', class => $class);

  ## URL
  
  if (defined $opt{url}) {
    $out->url ($opt{url});
  }

  ## Line & column number

  my $line;
  my $column;
    
  if (defined $opt{node}) {
    $line = $opt{node}->get_user_data ('manakai_source_line');
    if (defined $line) {
      $column = $opt{node}->get_user_data ('manakai_source_column');
    } else {
      if ($opt{node}->node_type == $opt{node}->ATTRIBUTE_NODE) {
        my $owner = $opt{node}->owner_element;
        if ($owner) {
          $line = $owner->get_user_data ('manakai_source_line');
          $column = $owner->get_user_data ('manakai_source_column');
        }
      } else {
        my $parent = $opt{node}->parent_node;
        if ($parent) {
          $line = $parent->get_user_data ('manakai_source_line');
          $column = $parent->get_user_data ('manakai_source_column');
        }
      }
    }
  }
  unless (defined $line) {
    if (defined $opt{token} and defined $opt{token}->{line}) {
      $line = $opt{token}->{line};
      $column = $opt{token}->{column};
    } elsif (defined $opt{line}) {
      $line = $opt{line};
      $column = $opt{column};
    }
  }
 
  if (defined $line) {
    if (defined $column and $column > 0) {
      $out->xref ('Line ' . $line, target => 'line-' . $line);
      $out->text (' column ' . $column);
    } else {
      $line = $line - 1 || 1;
      $out->xref ('Line ' . $line, target => 'line-' . $line);
    }
  }

  ## Node path

  if (defined $opt{node}) {
    $out->html (' ');
    $out->node_link ($opt{node});
  }

  if (defined $opt{index}) {
    if ($opt{index_has_link}) {
      $out->html (' ');
      $out->xref ('Index ' . (0+$opt{index}),
                  target => 'index-' . (0+$opt{index}));
    } else {
      $out->text (' Index ' . (0+$opt{index}));
    }
  }

  if (defined $opt{value}) {
    $out->html (' ');
    $out->code ($opt{value});
  }
 
  $out->start_tag ('dd', class => $class);
  $out->text ($error_type_text);

  if (defined $opt{text}) {
    $out->html (' (<q>');
    $out->text ($opt{text});
    $out->html ('</q>)');
  }

  my $fragment = $opt{type};
  $fragment =~ tr/ /-/;
  $fragment = $out->encode_url_component ($fragment);
  $out->text (' [');
  $out->link ('Description', url => '../error-description#' . $fragment);
  $out->text (']');


#    my ($type, $cls, $msg) = main::get_text ($opt{type}, $opt{level});
#    $out->html (qq[<dt class="$cls">] . $result->get_error_label ($input, \%opt));

  $error_layer = 'char'
      if $error_layer eq 'charset' or $error_layer eq 'encode';
  if ($error_level eq 's') {
    $self->{$error_layer}->{should}++;
    $self->{$error_layer}->{score_min} -= 2;
    $self->{conforming_min} = 0;
  } elsif ($error_level eq 'w') {
    $self->{$error_layer}->{warning}++;
  } elsif ($error_level eq 'u') {
    $self->{$error_layer}->{unsupported}++;
    $self->{unsupported} = 1;
  } elsif ($error_level eq 'i') {
    #
  } else {
    $self->{$error_layer}->{must}++;
    $self->{$error_layer}->{score_max} -= 2;
    $self->{$error_layer}->{score_min} -= 2;
    $self->{conforming_min} = 0;
    $self->{conforming_max} = 0;
  }
} # add_error

sub generate_result_section ($) {
  my $result = shift;

  my $out = $result->output;

  $out->start_section (id => 'result-summary',
                       title => 'Result');

  if ($result->{unsupported} and $result->{conforming_max}) {  
    $out->html (qq[<p class=uncertain id=result-para>The conformance
        checker cannot decide whether the document is conforming or
        not, since the document contains one or more unsupported
        features.  The document might or might not be conforming.</p>]);
  } elsif ($result->{conforming_min}) {
    $out->html (qq[<p class=PASS id=result-para>No conformance-error is
        found in this document.</p>]);
  } elsif ($result->{conforming_max}) {
    $out->html (qq[<p class=SEE-RESULT id=result-para>This document
        is <strong>likely <em>non</em>-conforming</strong>, but in rare case
        it might be conforming.</p>]);
  } else {
    $out->html (qq[<p class=FAIL id=result-para>This document is 
        <strong><em>non</em>-conforming</strong>.</p>]);
  }

  $out->html (qq[<table>
<colgroup><col><colgroup><col><col><col><colgroup><col>
<thead>
<tr><th scope=col></th>
<th scope=col><a href="../error-description#level-m"><em class=rfc2119>MUST</em>-level
Errors</a></th>
<th scope=col><a href="../error-description#level-s"><em class=rfc2119>SHOULD</em>-level
Errors</a></th>
<th scope=col><a href="../error-description#level-w">Warnings</a></th>
<th scope=col>Score</th></tr></thead><tbody>]);

  ## TODO: Introduce "N/A" value (e.g. Character layer is not applicable
  ## to binary formats)

  my $must_error = 0;
  my $should_error = 0;
  my $warning = 0;
  my $score_min = 0;
  my $score_max = 0;
  my $score_base = 20;
  my $score_unit = $score_base / 100;
  for (
    [Transfer => 'transfer', ''],
    [Character => 'char', ''],
    [Syntax => 'syntax', '#parse-errors'],
    [Structure => 'structure', '#document-errors'],
  ) {
    $must_error += ($result->{$_->[1]}->{must} += 0);
    $should_error += ($result->{$_->[1]}->{should} += 0);
    $warning += ($result->{$_->[1]}->{warning} += 0);
    $score_min += (($result->{$_->[1]}->{score_min} *= $score_unit) += $score_base);
    $score_max += (($result->{$_->[1]}->{score_max} *= $score_unit) += $score_base);

    my $uncertain = $result->{$_->[1]}->{unsupported} ? '?' : '';
    my $label = $_->[0];
    if ($result->{$_->[1]}->{must} or
        $result->{$_->[1]}->{should} or
        $result->{$_->[1]}->{warning} or
        $result->{$_->[1]}->{unsupported}) {
      $label = qq[<a href="$_->[2]">$label</a>];
    }

    $out->html (qq[<tr class="@{[$uncertain ? 'uncertain' : '']}"><th scope=row>$label</th><td class="@{[$result->{$_->[1]}->{must} ? 'FAIL' : '']}">$result->{$_->[1]}->{must}$uncertain</td><td class="@{[$result->{$_->[1]}->{should} ? 'SEE-RESULT' : '']}">$result->{$_->[1]}->{should}$uncertain</td><td>$result->{$_->[1]}->{warning}$uncertain</td>]);
    if ($uncertain) {
      $out->html (qq[<td class="@{[$result->{$_->[1]}->{must} ? 'FAIL' : $result->{$_->[1]}->{should} ? 'SEE-RESULT' : '']}">&#x2212;&#x221E;..$result->{$_->[1]}->{score_max}]);
    } elsif ($result->{$_->[1]}->{score_min} != $result->{$_->[1]}->{score_max}) {
      $out->html (qq[<td class="@{[$result->{$_->[1]}->{must} ? 'FAIL' : 'SEE-RESULT']}">$result->{$_->[1]}->{score_min}..$result->{$_->[1]}->{score_max}]);
    } else {
      $out->html (qq[<td class="@{[$result->{$_->[1]}->{must} ? 'FAIL' : '']}">$result->{$_->[1]}->{score_min}]);
    }
    $out->html (qq[ / 20]);
  }

  $score_max += $score_base;

  $out->html (qq[
<tr class=uncertain><th scope=row>Semantics</th><td>0?</td><td>0?</td><td>0?</td><td>&#x2212;&#x221E;..$score_base / 20
</tbody>
<tfoot><tr class=uncertain><th scope=row>Total</th>
<td class="@{[$must_error ? 'FAIL' : '']}">$must_error?</td>
<td class="@{[$should_error ? 'SEE-RESULT' : '']}">$should_error?</td>
<td>$warning?</td>
<td class="@{[$must_error ? 'FAIL' : $should_error ? 'SEE-RESULT' : '']}"><strong>&#x2212;&#x221E;..$score_max</strong> / 100
</table>

<p><strong>Important</strong>: This conformance checking service
is <em>under development</em>.  The result above might be <em>wrong</em>.</p>]);
  $out->end_section;
} # generate_result_section

sub _get_error_label ($$) {
  my $self = shift;
  my ($input, $err) = @_;


} # get_error_label

sub get_error_level_label ($) {
  my $self = shift;
  my $err = shift;

  my $r = '';

  if (not defined $err->{level} or $err->{level} eq 'm') {
    $r = qq[<strong><a href="../error-description#level-m"><em class=rfc2119>MUST</em>-level
        error</a></strong>: ];
  } elsif ($err->{level} eq 's') {
    $r = qq[<strong><a href="../error-description#level-s"><em class=rfc2119>SHOULD</em>-level
        error</a></strong>: ];
  } elsif ($err->{level} eq 'w') {
    $r = qq[<strong><a href="../error-description#level-w">Warning</a></strong>:
        ];
  } elsif ($err->{level} eq 'u' or $err->{level} eq 'unsupported') {
    $r = qq[<strong><a href="../error-description#level-u">Not
        supported</a></strong>: ];
  } elsif ($err->{level} eq 'i') {
    $r = qq[<strong><a href="../error-description#level-i">Information</a></strong>: ];
  } else {
    my $elevel = htescape ($err->{level});
    $r = qq[<strong><a href="../error-description#level-$elevel">$elevel</a></strong>:
        ];
  }

  return $r;
} # get_error_level_label

sub get_node_path ($) {
  my $self = shift;
  my $node = shift;
  my @r;
  while (defined $node) {
    my $rs;
    if ($node->node_type == 1) {
      $rs = $node->node_name;
      $node = $node->parent_node;
    } elsif ($node->node_type == 2) {
      $rs = '@' . $node->node_name;
      $node = $node->owner_element;
    } elsif ($node->node_type == 3) {
      $rs = '"' . $node->data . '"';
      $node = $node->parent_node;
    } elsif ($node->node_type == 9) {
      @r = ('') unless @r;
      $rs = '';
      $node = $node->parent_node;
    } else {
      $rs = '#' . $node->node_type;
      $node = $node->parent_node;
    }
    unshift @r, $rs;
  }
  return join '/', @r;
} # get_node_path

use Scalar::Util qw/refaddr/;

sub get_node_link ($$) {
  my $self = shift;
  return qq[<a href="#$_[0]->{id_prefix}node-@{[refaddr $_[1]]}">] .
       ($self->get_node_path ($_[1])) . qq[</a>];
        ## BUG: ^ must be escaped
} # get_node_link

1;
1	wakaba	1.1	package WebHACC::Result;
2			use strict;
3
4			sub new ($) {
5			return bless {}, shift;
6			} # new
7
8	wakaba	1.2	sub output ($;$) {
9			if (@_ > 1) {
10			if (defined $_[1]) {
11			$_[0]->{output} = $_[1];
12			} else {
13			delete $_[0]->{output};
14			}
15			}
16
17			return $_[0]->{output};
18			} # output
19
20			sub add_error ($%) {
21			my ($self, %opt) = @_;
22
23			my $out = $self->output;
24
25			my $error_level = $opt{level};
26			if (not defined $error_level) {
27			$error_level = 'm'; ## NOTE: Unknown - an error of the implementation
28			} elsif ({
29			m => 1, s => 1, w => 1, i => 1, u => 1,
30			}->{$error_level}) {
31			#
32			} else {
33			$error_level = 'm'; ## NOTE: Unknown - an error of the implementation
34			}
35
36			my $error_layer = $opt{layer};
37			if (not defined $error_layer) {
38			$error_layer = 'syntax'; ## NOTE: Unknown - an error of the implementation
39			} elsif ({
40			transfer => 1,
41			encode => 1,
42			charset => 1,
43			syntax => 1,
44			structure => 1,
45			semantics => 1,
46			}->{$error_layer}) {
47			#
48			} else {
49			$error_layer = 'syntax'; ## NOTE: Unknown - an error of the implementation
50			}
51
52			my $error_type_text = $opt{type};
53
54			my $class = qq[level-$error_level layer-$error_layer];
55
56			$out->start_tag ('dt', class => $class);
57	wakaba	1.1
58	wakaba	1.2	## URL
59
60			if (defined $opt{url}) {
61			$out->url ($opt{url});
62			}
63	wakaba	1.1
64	wakaba	1.2	## Line & column number
65	wakaba	1.1
66			my $line;
67			my $column;
68
69	wakaba	1.2	if (defined $opt{node}) {
70			$line = $opt{node}->get_user_data ('manakai_source_line');
71	wakaba	1.1	if (defined $line) {
72	wakaba	1.2	$column = $opt{node}->get_user_data ('manakai_source_column');
73	wakaba	1.1	} else {
74	wakaba	1.2	if ($opt{node}->node_type == $opt{node}->ATTRIBUTE_NODE) {
75			my $owner = $opt{node}->owner_element;
76			if ($owner) {
77			$line = $owner->get_user_data ('manakai_source_line');
78			$column = $owner->get_user_data ('manakai_source_column');
79			}
80	wakaba	1.1	} else {
81	wakaba	1.2	my $parent = $opt{node}->parent_node;
82	wakaba	1.1	if ($parent) {
83			$line = $parent->get_user_data ('manakai_source_line');
84			$column = $parent->get_user_data ('manakai_source_column');
85			}
86			}
87			}
88			}
89			unless (defined $line) {
90	wakaba	1.2	if (defined $opt{token} and defined $opt{token}->{line}) {
91			$line = $opt{token}->{line};
92			$column = $opt{token}->{column};
93			} elsif (defined $opt{line}) {
94			$line = $opt{line};
95			$column = $opt{column};
96	wakaba	1.1	}
97			}
98
99			if (defined $line) {
100			if (defined $column and $column > 0) {
101	wakaba	1.2	$out->xref ('Line ' . $line, target => 'line-' . $line);
102			$out->text (' column ' . $column);
103	wakaba	1.1	} else {
104			$line = $line - 1 \|\| 1;
105	wakaba	1.2	$out->xref ('Line ' . $line, target => 'line-' . $line);
106	wakaba	1.1	}
107			}
108
109	wakaba	1.2	## Node path
110
111			if (defined $opt{node}) {
112			$out->html (' ');
113			$out->node_link ($opt{node});
114	wakaba	1.1	}
115
116	wakaba	1.2	if (defined $opt{index}) {
117			if ($opt{index_has_link}) {
118			$out->html (' ');
119			$out->xref ('Index ' . (0+$opt{index}),
120			target => 'index-' . (0+$opt{index}));
121	wakaba	1.1	} else {
122	wakaba	1.2	$out->text (' Index ' . (0+$opt{index}));
123	wakaba	1.1	}
124			}
125
126	wakaba	1.2	if (defined $opt{value}) {
127			$out->html (' ');
128			$out->code ($opt{value});
129	wakaba	1.1	}
130	wakaba	1.2
131			$out->start_tag ('dd', class => $class);
132			$out->text ($error_type_text);
133
134			if (defined $opt{text}) {
135			$out->html (' (<q>');
136			$out->text ($opt{text});
137			$out->html ('</q>)');
138			}
139
140			my $fragment = $opt{type};
141			$fragment =~ tr/ /-/;
142			$fragment = $out->encode_url_component ($fragment);
143			$out->text (' [');
144			$out->link ('Description', url => '../error-description#' . $fragment);
145			$out->text (']');
146
147
148			# my ($type, $cls, $msg) = main::get_text ($opt{type}, $opt{level});
149			# $out->html (qq[<dt class="$cls">] . $result->get_error_label ($input, \%opt));
150
151			$error_layer = 'char'
152			if $error_layer eq 'charset' or $error_layer eq 'encode';
153			if ($error_level eq 's') {
154			$self->{$error_layer}->{should}++;
155			$self->{$error_layer}->{score_min} -= 2;
156			$self->{conforming_min} = 0;
157			} elsif ($error_level eq 'w') {
158			$self->{$error_layer}->{warning}++;
159			} elsif ($error_level eq 'u') {
160			$self->{$error_layer}->{unsupported}++;
161			$self->{unsupported} = 1;
162			} elsif ($error_level eq 'i') {
163			#
164			} else {
165			$self->{$error_layer}->{must}++;
166			$self->{$error_layer}->{score_max} -= 2;
167			$self->{$error_layer}->{score_min} -= 2;
168			$self->{conforming_min} = 0;
169			$self->{conforming_max} = 0;
170			}
171			} # add_error
172
173			sub generate_result_section ($) {
174			my $result = shift;
175
176			my $out = $result->output;
177
178			$out->start_section (id => 'result-summary',
179			title => 'Result');
180
181			if ($result->{unsupported} and $result->{conforming_max}) {
182			$out->html (qq[<p class=uncertain id=result-para>The conformance
183			checker cannot decide whether the document is conforming or
184			not, since the document contains one or more unsupported
185			features. The document might or might not be conforming.</p>]);
186			} elsif ($result->{conforming_min}) {
187			$out->html (qq[<p class=PASS id=result-para>No conformance-error is
188			found in this document.</p>]);
189			} elsif ($result->{conforming_max}) {
190			$out->html (qq[<p class=SEE-RESULT id=result-para>This document
191			is <strong>likely <em>non</em>-conforming</strong>, but in rare case
192			it might be conforming.</p>]);
193			} else {
194			$out->html (qq[<p class=FAIL id=result-para>This document is
195			<strong><em>non</em>-conforming</strong>.</p>]);
196			}
197
198			$out->html (qq[<table>
199			<colgroup><col><colgroup><col><col><col><colgroup><col>
200			<thead>
201			<tr><th scope=col></th>
202			<th scope=col><a href="../error-description#level-m"><em class=rfc2119>MUST</em>-level
203			Errors</a></th>
204			<th scope=col><a href="../error-description#level-s"><em class=rfc2119>SHOULD</em>-level
205			Errors</a></th>
206			<th scope=col><a href="../error-description#level-w">Warnings</a></th>
207			<th scope=col>Score</th></tr></thead><tbody>]);
208
209			## TODO: Introduce "N/A" value (e.g. Character layer is not applicable
210			## to binary formats)
211
212			my $must_error = 0;
213			my $should_error = 0;
214			my $warning = 0;
215			my $score_min = 0;
216			my $score_max = 0;
217			my $score_base = 20;
218			my $score_unit = $score_base / 100;
219			for (
220			[Transfer => 'transfer', ''],
221			[Character => 'char', ''],
222			[Syntax => 'syntax', '#parse-errors'],
223			[Structure => 'structure', '#document-errors'],
224			) {
225			$must_error += ($result->{$_->[1]}->{must} += 0);
226			$should_error += ($result->{$_->[1]}->{should} += 0);
227			$warning += ($result->{$_->[1]}->{warning} += 0);
228			$score_min += (($result->{$_->[1]}->{score_min} *= $score_unit) += $score_base);
229			$score_max += (($result->{$_->[1]}->{score_max} *= $score_unit) += $score_base);
230
231			my $uncertain = $result->{$_->[1]}->{unsupported} ? '?' : '';
232			my $label = $_->[0];
233			if ($result->{$_->[1]}->{must} or
234			$result->{$_->[1]}->{should} or
235			$result->{$_->[1]}->{warning} or
236			$result->{$_->[1]}->{unsupported}) {
237			$label = qq[<a href="$_->[2]">$label</a>];
238			}
239
240			$out->html (qq[<tr class="@{[$uncertain ? 'uncertain' : '']}"><th scope=row>$label</th><td class="@{[$result->{$_->[1]}->{must} ? 'FAIL' : '']}">$result->{$_->[1]}->{must}$uncertain</td><td class="@{[$result->{$_->[1]}->{should} ? 'SEE-RESULT' : '']}">$result->{$_->[1]}->{should}$uncertain</td><td>$result->{$_->[1]}->{warning}$uncertain</td>]);
241			if ($uncertain) {
242			$out->html (qq[<td class="@{[$result->{$_->[1]}->{must} ? 'FAIL' : $result->{$_->[1]}->{should} ? 'SEE-RESULT' : '']}">−∞..$result->{$_->[1]}->{score_max}]);
243			} elsif ($result->{$_->[1]}->{score_min} != $result->{$_->[1]}->{score_max}) {
244			$out->html (qq[<td class="@{[$result->{$_->[1]}->{must} ? 'FAIL' : 'SEE-RESULT']}">$result->{$_->[1]}->{score_min}..$result->{$_->[1]}->{score_max}]);
245			} else {
246			$out->html (qq[<td class="@{[$result->{$_->[1]}->{must} ? 'FAIL' : '']}">$result->{$_->[1]}->{score_min}]);
247			}
248			$out->html (qq[ / 20]);
249			}
250
251			$score_max += $score_base;
252
253			$out->html (qq[
254			<tr class=uncertain><th scope=row>Semantics</th><td>0?</td><td>0?</td><td>0?</td><td>−∞..$score_base / 20
255			</tbody>
256			<tfoot><tr class=uncertain><th scope=row>Total</th>
257			<td class="@{[$must_error ? 'FAIL' : '']}">$must_error?</td>
258			<td class="@{[$should_error ? 'SEE-RESULT' : '']}">$should_error?</td>
259			<td>$warning?</td>
260			<td class="@{[$must_error ? 'FAIL' : $should_error ? 'SEE-RESULT' : '']}"><strong>−∞..$score_max</strong> / 100
261			</table>
262
263			<p><strong>Important</strong>: This conformance checking service
264			is <em>under development</em>. The result above might be <em>wrong</em>.</p>]);
265			$out->end_section;
266			} # generate_result_section
267
268			sub _get_error_label ($$) {
269			my $self = shift;
270			my ($input, $err) = @_;
271
272	wakaba	1.1
273			} # get_error_label
274
275			sub get_error_level_label ($) {
276			my $self = shift;
277			my $err = shift;
278
279			my $r = '';
280
281			if (not defined $err->{level} or $err->{level} eq 'm') {
282			$r = qq[<strong><a href="../error-description#level-m"><em class=rfc2119>MUST</em>-level
283			error</a></strong>: ];
284			} elsif ($err->{level} eq 's') {
285			$r = qq[<strong><a href="../error-description#level-s"><em class=rfc2119>SHOULD</em>-level
286			error</a></strong>: ];
287			} elsif ($err->{level} eq 'w') {
288			$r = qq[<strong><a href="../error-description#level-w">Warning</a></strong>:
289			];
290			} elsif ($err->{level} eq 'u' or $err->{level} eq 'unsupported') {
291			$r = qq[<strong><a href="../error-description#level-u">Not
292			supported</a></strong>: ];
293			} elsif ($err->{level} eq 'i') {
294			$r = qq[<strong><a href="../error-description#level-i">Information</a></strong>: ];
295			} else {
296			my $elevel = htescape ($err->{level});
297			$r = qq[<strong><a href="../error-description#level-$elevel">$elevel</a></strong>:
298			];
299			}
300
301			return $r;
302			} # get_error_level_label
303
304			sub get_node_path ($) {
305			my $self = shift;
306			my $node = shift;
307			my @r;
308			while (defined $node) {
309			my $rs;
310			if ($node->node_type == 1) {
311			$rs = $node->node_name;
312			$node = $node->parent_node;
313			} elsif ($node->node_type == 2) {
314			$rs = '@' . $node->node_name;
315			$node = $node->owner_element;
316			} elsif ($node->node_type == 3) {
317			$rs = '"' . $node->data . '"';
318			$node = $node->parent_node;
319			} elsif ($node->node_type == 9) {
320			@r = ('') unless @r;
321			$rs = '';
322			$node = $node->parent_node;
323			} else {
324			$rs = '#' . $node->node_type;
325			$node = $node->parent_node;
326			}
327			unshift @r, $rs;
328			}
329			return join '/', @r;
330			} # get_node_path
331
332			use Scalar::Util qw/refaddr/;
333
334			sub get_node_link ($$) {
335			my $self = shift;
336			return qq[<a href="#$_[0]->{id_prefix}node-@{[refaddr $_[1]]}">] .
337			($self->get_node_path ($_[1])) . qq[</a>];
338			## BUG: ^ must be escaped
339			} # get_node_link
340
341			1;