File Coverage

blib/lib/XML/Handler/Dtd2Html.pm
Criterion Covered Total %
statement 60 1024 5.8
branch 0 362 0.0
condition 0 70 0.0
subroutine 20 85 23.5
pod 0 11 0.0
total 80 1552 5.1


line stmt bran cond sub pod time code
1            
2             package XML::Handler::Dtd2Html::Document;
3            
4 1     1   903 use strict;
  1         2  
  1         35  
5 1     1   5 use warnings;
  1         1  
  1         29  
6            
7 1     1   1841 use Parse::RecDescent;
  1         49307  
  1         15  
8            
9             sub new {
10 0     0     my $proto = shift;
11 0   0       my $class = ref($proto) || $proto;
12 0           my $self = {
13             xml_decl => undef,
14             dtd => undef,
15             root_name => undef,
16             list_decl => [],
17             hash_notation => {},
18             hash_entity => {},
19             hash_element => {},
20             hash_attr => {},
21             hlink => 1,
22             preformatted => "pre",
23             emphasis => "em",
24             width => 80,
25             };
26 0           bless($self, $class);
27 0           $self->{cm_parser} = Parse::RecDescent->new(<<'EndGrammar');
28            
29            
30             contentspec: 'EMPTY' | 'ANY' | Mixed | children
31            
32             children: ( choice | seq ) ( '?' | '*' | '+' )(?)
33            
34             cp: ( Name | choice | seq ) ( '?' | '*' | '+' )(?)
35            
36             choice: '(' cp ( '|' cp )(s) ')'
37            
38             seq: '(' cp ( ',' cp )(s?) ')'
39            
40             Mixed: '(' '#PCDATA' ( '|' Name )(s?) ')*' | '(' '#PCDATA' ')'
41            
42             Name: /[\w_:][\w\d\.\-_:]*/
43            
44             EndGrammar
45 0           return $self;
46             }
47            
48             ###############################################################################
49            
50             package XML::Handler::Dtd2Html;
51            
52 1     1   169 use strict;
  1         1  
  1         39  
53 1     1   6 use warnings;
  1         2  
  1         43  
54            
55 1     1   5 use vars qw($VERSION);
  1         2  
  1         796  
56            
57             $VERSION="0.42";
58            
59             sub new {
60 0     0 0   my $proto = shift;
61 0   0       my $class = ref($proto) || $proto;
62 0           my $self = {
63             doc => XML::Handler::Dtd2Html::Document->new(),
64             comments => []
65             };
66 0           bless($self, $class);
67 0           return $self;
68             }
69            
70             # Content Events (Basic)
71            
72             sub start_document {
73 0     0 0   my $self = shift;
74 0           my ($decl) = @_;
75 0 0         $self->{doc}->{xml_decl} = $decl if (%{$decl});
  0            
76 0           return;
77             }
78            
79             sub end_document {
80 0     0 0   my $self = shift;
81 0           return $self->{doc};
82             }
83            
84             # Declarations Events
85            
86             sub element_decl {
87 0     0 0   my $self = shift;
88 0           my ($decl) = @_;
89 0 0         if (scalar @{$self->{comments}}) {
  0            
90 0           $decl->{comments} = [@{$self->{comments}}];
  0            
91 0           $self->{comments} = [];
92             }
93 0           $decl->{type} = "element";
94 0           $decl->{used_by} = {};
95 0           $decl->{uses} = {};
96 0           my $name = $decl->{Name};
97 0           $self->{doc}->{hash_element}->{$name} = $decl;
98 0           push @{$self->{doc}->{list_decl}}, $decl;
  0            
99 0           return;
100             }
101            
102             sub attribute_decl {
103 0     0 0   my $self = shift;
104 0           my ($decl) = @_;
105 0 0         if (scalar @{$self->{comments}}) {
  0            
106 0           $decl->{comments} = [@{$self->{comments}}];
  0            
107 0           $self->{comments} = [];
108             }
109 0           my $elt_name = $decl->{eName};
110 0 0         $self->{doc}->{hash_attr}->{$elt_name} = []
111             unless (exists $self->{doc}->{hash_attr}->{$elt_name});
112 0           push @{$self->{doc}->{hash_attr}->{$elt_name}}, $decl;
  0            
113 0           return;
114             }
115            
116             sub internal_entity_decl {
117 0     0 0   my $self = shift;
118 0           my ($decl) = @_;
119 0 0         if (scalar @{$self->{comments}}) {
  0            
120 0           $decl->{comments} = [@{$self->{comments}}];
  0            
121 0           $self->{comments} = [];
122             }
123 0           $decl->{type} = "internal_entity";
124 0           my $name = $decl->{Name};
125 0 0         unless ($name =~ /^%/) {
126 0           $self->{doc}->{hash_entity}->{$name} = $decl;
127 0           push @{$self->{doc}->{list_decl}}, $decl;
  0            
128             }
129 0           return;
130             }
131            
132             sub external_entity_decl {
133 0     0 0   my $self = shift;
134 0           my ($decl) = @_;
135 0 0         if (scalar @{$self->{comments}}) {
  0            
136 0           $decl->{comments} = [@{$self->{comments}}];
  0            
137 0           $self->{comments} = [];
138             }
139 0           $decl->{type} = "external_entity";
140 0           my $name = $decl->{Name};
141 0 0         unless ($name =~ /^%/) {
142 0           $self->{doc}->{hash_entity}->{$name} = $decl;
143 0           push @{$self->{doc}->{list_decl}}, $decl;
  0            
144             }
145 0           return;
146             }
147            
148             # DTD Events
149            
150             sub notation_decl {
151 0     0 0   my $self = shift;
152 0           my ($decl) = @_;
153 0 0         if (scalar @{$self->{comments}}) {
  0            
154 0           $decl->{comments} = [@{$self->{comments}}];
  0            
155 0           $self->{comments} = [];
156             }
157 0           $decl->{type} = "notation";
158 0           my $name = $decl->{Name};
159 0           $self->{doc}->{hash_notation}->{$name} = $decl;
160 0           push @{$self->{doc}->{list_decl}}, $decl;
  0            
161 0           return;
162             }
163            
164             sub unparsed_entity_decl {
165 0     0 0   my $self = shift;
166 0           my ($decl) = @_;
167 0           $self->{comments} = [];
168 0           warn "unparsed entity $decl->{Name}.\n";
169 0           return;
170             }
171            
172             # Lexical Events
173            
174             sub start_dtd {
175 0     0 0   my $self = shift;
176 0           my ($dtd) = @_;
177 0 0         if (scalar @{$self->{comments}}) {
  0            
178 0           $dtd->{comments} = [@{$self->{comments}}];
  0            
179 0           $self->{comments} = [];
180             }
181 0           $dtd->{type} = "doctype";
182 0           $self->{doc}->{dtd} = $dtd;
183 0           $self->{doc}->{root_name} = $dtd->{Name};
184 0           return;
185             }
186            
187             sub comment {
188 0     0 0   my $self = shift;
189 0           my ($comment) = @_;
190 0           push @{$self->{comments}}, $comment;
  0            
191 0           return;
192             }
193            
194             # SAX1 Events
195            
196             # deprecated in favour of start_document (see XML::SAX::Expat 0.36)
197             #sub xml_decl {
198             # my $self = shift;
199             # my ($decl) = @_;
200             # $self->{doc}->{xml_decl} = $decl;
201             #}
202            
203             ###############################################################################
204            
205             package XML::Handler::Dtd2Html::ContentModelVisitor;
206            
207 1     1   6 use strict;
  1         1  
  1         35  
208 1     1   5 use warnings;
  1         2  
  1         1347  
209            
210             sub new {
211 0     0     my $proto = shift;
212 0   0       my $class = ref($proto) || $proto;
213 0           my ($doc) = @_;
214 0           my $self = {
215             doc => $doc,
216             str => "",
217             raw => "",
218             tab => "",
219             max => $doc->{width},
220             need => 0,
221             };
222 0           bless($self, $class);
223 0           return $self;
224             }
225            
226             sub _inc_tab {
227 0     0     my $self = shift;
228 0           $self->{tab} .= " ";
229 0           return;
230             }
231            
232             sub _dec_tab {
233 0     0     my $self = shift;
234 0           $self->{tab} =~ s/ $//;
235 0           return;
236             }
237            
238             sub _add {
239 0     0     my $self = shift;
240 0           my ($raw, $str) = @_;
241 0 0         $str = $raw unless (defined $str);
242 0           $self->{raw} .= $raw;
243 0           $self->{str} .= $str;
244 0           return;
245             }
246            
247             sub _add_name {
248 0     0     my $self = shift;
249 0           my ($raw, $str) = @_;
250 0 0         $str = $raw unless (defined $str);
251 0 0         $self->_break()
252             if (length($self->{tab} . $self->{raw} . $raw) > $self->{max});
253 0           $self->{raw} .= $raw;
254 0           $self->{str} .= $str;
255 0           return;
256             }
257            
258             sub _break {
259 0     0     my $self = shift;
260 0           $self->{need} = 0;
261 0 0         if ($self->{raw} !~ /^\s*$/) {
262 0           $self->{raw} = "";
263 0           $self->{str} .= "\n" . $self->{tab};
264             }
265 0           return;
266             }
267            
268             sub _visit {
269 0     0     my $self = shift;
270 0           my $node = shift;
271            
272 0           my $func = "visit_" . ref $node;
273 0 0         if($self->can($func)) {
274 0           $self->$func($node, @_);
275             } else {
276 0           warn "Please implement a function '$func' in '",ref $self,"'.\n";
277             }
278 0           return;
279             }
280            
281             # contentspec: 'EMPTY' | 'ANY' | Mixed | children
282             sub visit_contentspec {
283 0     0     my $self = shift;
284 0           my ($node) = @_;
285            
286 0 0         if (exists $node->{__VALUE__}) {
    0          
    0          
287 0           $self->{str} .= $self->{doc}->_mk_value($node->{__VALUE__});
288             } elsif (exists $node->{Mixed}) {
289 0           $self->_visit($node->{Mixed});
290             } elsif (exists $node->{children}) {
291 0           $self->_visit($node->{children});
292             }
293 0           return;
294             }
295            
296             # children: ( choice | seq ) ( '?' | '*' | '+' )(?)
297             sub visit_children {
298 0     0     my $self = shift;
299 0           my ($node) = @_;
300            
301 0           my $altern1 = $node->{_alternation_1_of_production_1_of_rule_children};
302 0 0         if (exists $altern1->{choice}) {
    0          
303 0           $self->_visit($altern1->{choice});
304             } elsif (exists $altern1->{seq}) {
305 0           $self->_visit($altern1->{seq});
306             }
307 0           my $altern2 = shift @{$node->{'_alternation_2_of_production_1_of_rule_children(?)'}};
  0            
308 0 0         if (defined $altern2) {
309 0           $self->_add($altern2->{__VALUE__}); # '?' or '*' or '+'
310             }
311 0           return;
312             }
313            
314             # cp: ( Name | choice | seq ) ( '?' | '*' | '+' )(?)
315             sub visit_cp {
316 0     0     my $self = shift;
317 0           my ($node, $first) = @_;
318            
319 0           my $altern1 = $node->{_alternation_1_of_production_1_of_rule_cp};
320 0 0         if (exists $altern1->{Name}) {
    0          
    0          
321 0 0         $self->_break() if ($self->{need});
322 0           $self->_visit($altern1->{Name});
323             } elsif (exists $altern1->{choice}) {
324 0 0         $self->_break() unless ($first);
325 0           $self->_visit($altern1->{choice});
326 0           $self->{need} = 1;
327             } elsif (exists $altern1->{seq}) {
328 0 0         $self->_break() unless ($first);
329 0           $self->_visit($altern1->{seq});
330 0           $self->{need} = 1;
331             }
332 0           my $altern2 = shift @{$node->{'_alternation_2_of_production_1_of_rule_cp(?)'}};
  0            
333 0 0         if (defined $altern2) {
334 0           $self->_add($altern2->{__VALUE__}); # '?' or '*' or '+'
335             }
336 0           return;
337             }
338            
339             # choice: '(' cp ( '|' cp )(s) ')'
340             sub visit_choice {
341 0     0     my $self = shift;
342 0           my ($node) = @_;
343            
344 0           $self->_add($node->{__STRING1__} . " "); # '('
345 0           $self->_inc_tab();
346 0           $self->_visit($node->{cp}, 1);
347 0           foreach (@{$node->{'_alternation_1_of_production_1_of_rule_choice(s)'}}) {
  0            
348 0           $self->_add(" " . $_->{__STRING1__} . " "); # '|'
349 0           $self->_visit($_->{cp}, 0);
350             }
351 0           $self->_dec_tab();
352 0           $self->_add(" " . $node->{__STRING2__}); # ')'
353 0           return;
354             }
355            
356             # seq: '(' cp ( ',' cp )(s?) ')'
357             sub visit_seq {
358 0     0     my $self = shift;
359 0           my ($node) = @_;
360            
361 0           $self->_add($node->{__STRING1__} . " "); # '('
362 0           $self->_inc_tab();
363 0           $self->_visit($node->{cp}, 1);
364 0           foreach (@{$node->{'_alternation_1_of_production_1_of_rule_seq(s?)'}}) {
  0            
365 0           $self->_add(" " . $_->{__STRING1__} . " "); # ','
366 0           $self->_visit($_->{cp}, 0);
367             }
368 0           $self->_dec_tab();
369 0           $self->_add(" " . $node->{__STRING2__}); # ')'
370 0           return;
371             }
372            
373             # Mixed: '(' '#PCDATA' ( '|' Name )(s?) ')*' | '(' '#PCDATA' ')'
374             sub visit_Mixed {
375 0     0     my $self = shift;
376 0           my ($node) = @_;
377            
378 0           $self->_add($node->{__STRING1__} . " "); # '('
379 0           my $value = $self->{doc}->_mk_value($node->{__STRING2__});
380 0           $self->_inc_tab();
381 0           $self->_add_name($node->{__STRING2__}, $value); # '#PCDATA'
382 0           foreach (@{$node->{'_alternation_1_of_production_1_of_rule_Mixed(s?)'}}) {
  0            
383 0           $self->_add(" " . $_->{__STRING1__} . " "); # '|'
384 0           $self->_visit($_->{Name});
385             }
386 0           $self->_dec_tab();
387 0           $self->_add(" " . $node->{__STRING3__}); # ')*' or ')'
388 0           return;
389             }
390            
391             # Name: /[\w_:][\w\d\.\-_:]*/
392             sub visit_Name {
393 0     0     my $self = shift;
394 0           my ($node) = @_;
395            
396 0           my $anchor = $self->{doc}->_mk_text_anchor("elt", $node->{__VALUE__});
397 0           $self->_add_name($node->{__VALUE__}, $anchor);
398 0           return;
399             }
400            
401             ###############################################################################
402            
403             package XML::Handler::Dtd2Html::Document;
404            
405 1     1   5 use strict;
  1         2  
  1         32  
406 1     1   5 use warnings;
  1         1  
  1         26  
407            
408 1     1   1960 use HTML::Template;
  1         14490  
  1         39  
409 1     1   12 use File::Basename;
  1         2  
  1         12699  
410            
411             sub _process_args {
412 0     0     my $self = shift;
413 0           my %hash = @_;
414            
415 0           $self->{outfile} = $hash{outfile};
416            
417 0 0         if (defined $hash{title}) {
418 0           $self->{title} = $hash{title};
419             } else {
420 0           foreach my $comment (@{$self->{dtd}->{comments}}) {
  0            
421 0           my ($doc, $r_tags) = $self->_extract_doc($comment);
422 0           foreach (@{$r_tags}) {
  0            
423 0           my ($href, $entry, $data) = @{$_};
  0            
424 0 0         if (uc($entry) eq "TITLE") {
425 0           $self->{title} = $data;
426             }
427             }
428             }
429 0 0         $self->{title} = "DTD " . $self->{root_name}
430             unless ($self->{title});
431             }
432            
433 0           $self->{css} = $hash{css};
434 0           $self->{examples} = $hash{examples};
435 0           $self->{dirname} = dirname($hash{outfile});
436 0           $self->{basename} = basename($hash{outfile});
437 0           $self->{filebase} = $hash{outfile};
438 0           $self->{filebase} =~ s/^([^\/]+\/)+//;
439 0           $self->{flag_comment} = $hash{flag_comment};
440 0           $self->{flag_href} = $hash{flag_href};
441            
442 0 0         $self->{now} = $hash{flag_date} ? localtime() : "";
443 0           $self->{generator} = "dtd2html " . $XML::Handler::Dtd2Html::VERSION . " (Perl " . $] . ")";
444            
445 0 0         if (defined $hash{path_tmpl}) {
446 0           $self->{path_tmpl} = [ $hash{path_tmpl} ];
447             } else {
448 0   0       my $language = $hash{language} || 'en';
449 0           my $path = $INC{'XML/Handler/Dtd2Html.pm'};
450 0           $path =~ s/\.pm$//i;
451 0           $self->{path_tmpl} = [ $path . '/' . $language, $path ];
452             }
453            
454 0           $self->_cross_ref($hash{flag_zombi});
455            
456 0 0         if ($hash{flag_multi}) {
457 0           foreach my $decl (@{$self->{list_decl}}) {
  0            
458 0           my $type = $decl->{type};
459 0           my $name = $decl->{Name};
460 0 0         if (exists $decl->{comments}) {
461 0           $decl->{comments} = [ ${$decl->{comments}}[-1] ];
  0            
462             }
463 0 0 0       if ($type eq "element" and exists $self->{hash_attr}->{$name}) {
464 0           foreach my $attr (@{$self->{hash_attr}->{$name}}) {
  0            
465 0 0         if (exists $attr->{comments}) {
466 0           $attr->{comments} = [ ${$attr->{comments}}[-1] ];
  0            
467             }
468             }
469             }
470             }
471             }
472 0           return;
473             }
474            
475             sub _cross_ref {
476 0     0     my $self = shift;
477 0           my($flag_zombi) = @_;
478            
479 0           while (my($name, $decl) = each %{$self->{hash_element}}) {
  0            
480 0           my $model = $decl->{Model};
481 0           while ($model) {
482 0           for ($model) {
483 0           s/^[ \n\r\t\f\013]+//; # whitespaces
484            
485 0 0         s/^[\?\*\+\(\),\|]//
486             and last;
487 0 0         s/^EMPTY//
488             and last;
489 0 0         s/^ANY//
490             and last;
491 0 0         s/^#PCDATA//
492             and last;
493 0 0 0       s/^([A-Za-z_:][0-9A-Za-z\.\-_:]*)//
494             and $self->{hash_element}->{$name}->{uses}->{$1} = 1,
495             and $self->{hash_element}->{$1}->{used_by}->{$name} = 1,
496             last;
497 0 0         s/^([\S]+)//
498             and warn __PACKAGE__,":_cross_ref INTERNAL_ERROR $1\n",
499             last;
500             }
501             }
502             }
503            
504 0 0         if ($flag_zombi) {
505 0           my $one_more_time = 1;
506 0           while ($one_more_time) {
507 0           $one_more_time = 0;
508 0           while (my($elt_name, $elt_decl) = each %{$self->{hash_element}}) {
  0            
509 0 0         next if ($elt_name eq $self->{root_name});
510 0 0         unless (scalar keys %{$elt_decl->{used_by}}) {
  0            
511 0           delete $self->{hash_element}->{$elt_name};
512 0           foreach my $child (keys %{$elt_decl->{uses}}) {
  0            
513 0           my $decl = $self->{hash_element}->{$child};
514 0           delete $decl->{used_by}->{$elt_name};
515 0           $one_more_time = 1;
516             }
517             }
518             }
519             }
520             }
521 0           return;
522             }
523            
524             sub _format_content_model {
525 0     0     my $self = shift;
526 0           my ($model) = @_;
527 0           my $visitor = XML::Handler::Dtd2Html::ContentModelVisitor->new($self);
528 0           $visitor->_visit($self->{cm_parser}->contentspec($model));
529 0           my $str = $visitor->{str};
530 0           return $str;
531             }
532            
533             sub _include_doc {
534 0     0     my $self = shift;
535 0           my($filename) = @_;
536 0           my $doc = "";
537            
538 0 0         open my $IN, '<', $filename
539             or warn "can't open $filename ($!).\n",
540             return $doc;
541            
542 0           while (<$IN>) {
543 0           $doc .= $_;
544             }
545 0           close $IN;
546 0           return $doc;
547             }
548            
549             sub _extract_doc {
550 0     0     my $self = shift;
551 0           my($comment) = @_;
552 0           my $doc = undef;
553 0           my @tags = ();
554 0           my @lines = split /\n/, $comment->{Data};
555 0           foreach (@lines) {
556 0 0         if (/^\s*@(@?)\s*([\s0-9A-Z_a-z]+):\s*(.*)/) {
    0          
557 0           my $href = $1;
558 0           my $tag = $2;
559 0           my $value = $3;
560 0           $tag =~ s/\s*$//;
561 0 0         if (uc($tag) eq "INCLUDE") {
562 0           $doc .= $self->_include_doc($value);
563             } else {
564 0           push @tags, [$href, $tag, $value];
565             }
566             } elsif (/^\s*@(@?)\s*([A-Z_a-z][0-9A-Z_a-z]*)\s+(.*)/) {
567 0           my $href = $1;
568 0           my $tag = $2;
569 0           my $value = $3;
570 0 0         if (uc($tag) eq "INCLUDE") {
571 0           $doc .= $self->_include_doc($value);
572             } else {
573 0           push @tags, [$href, $tag, $value];
574             }
575             } else {
576 0           $doc .= $_;
577 0           $doc .= "\n";
578             }
579             }
580 0           return ($doc, \@tags);
581             }
582            
583             sub _process_text {
584 0     0     my $self = shift;
585 0           my($text, $current, $href) = @_;
586            
587             # keep track of leading and trailing white-space
588 0 0         my $lead = ($text =~ s/\A(\s+)//s ? $1 : "");
589 0 0         my $trail = ($text =~ s/(\s+)\Z//s ? $1 : "");
590            
591             # split at space/non-space boundaries
592 0           my @words = split( /(?<=\s)(?=\S)|(?<=\S)(?=\s)/, $text );
593            
594             # process each word individually
595 0           foreach my $word (@words) {
596             # skip space runs
597 0 0         next if ($word =~ /^\s*$/);
598 0 0         next if ($word eq $current);
599 0 0         if ($word =~ /^[A-Za-z_:][0-9A-Za-z\.\-_:]*$/) {
    0          
    0          
600 0 0 0       next if ($self->{flag_href} and !$href);
601             # looks like a DTD name
602 0 0         if (exists $self->{hash_notation}->{$word}) {
    0          
    0          
603 0           $word = $self->_mk_text_anchor("not", $word);
604             }
605             elsif (exists $self->{hash_entity}->{$word}) {
606 0           $word = $self->_mk_text_anchor("ent", $word);
607             }
608             elsif (exists $self->{hash_element}->{$word}) {
609 0           $word = $self->_mk_text_anchor("elt", $word);
610             }
611             } elsif ($word =~ /^\w+:\/\/\w/) {
612             # looks like a URL
613             # Don't relativize it: leave it as the author intended
614 0 0         $word = "" . $word . ""
615             if ($self->{hlink});
616             } elsif ($word =~ /^[\w.-]+\@[\w.-]+/) {
617             # looks like an e-mail address
618 0 0         $word = "" . $word . ""
619             if ($self->{hlink});
620             }
621             }
622            
623             # put everything back together
624 0           return $lead . join('', @words) . $trail;
625             }
626            
627             sub _mk_value {
628 0     0     my $self = shift;
629 0           my($value) = @_;
630            
631 0           return "" . $value . " ";
632             }
633            
634             sub _mk_index_anchor {
635 0     0     my $self = shift;
636 0           my($type, $name) = @_;
637            
638 0           my $href = $self->_mk_index_href($type, $name);
639 0           return "" . $name ."";
640             }
641            
642             sub _mk_text_anchor {
643 0     0     my $self = shift;
644 0           my($type, $name) = @_;
645            
646 0           my $href = $self->_mk_index_href($type, $name);
647 0           return "" . $name . "";
648             }
649            
650             sub _mk_index_href {
651 0     0     my $self = shift;
652 0           my($type, $name) = @_;
653            
654 0           return "#" . $type . "_" . $name;
655             }
656            
657             sub generateAlphaElement {
658 0     0     my $self = shift;
659 0           my ($nb, $a_link, $flg_brief) = @_;
660            
661 0 0         $nb = 'nb_element' unless (defined $nb);
662 0 0         $a_link = 'a_elements' unless (defined $a_link);
663            
664 0           my @elements = sort keys %{$self->{hash_element}};
  0            
665 0           my @a_link = ();
666 0           foreach (@elements) {
667 0           my $a = $self->_mk_index_anchor("elt", $_);
668 0 0         if ($flg_brief) {
669 0           my $brief = $self->_get_brief($self->{hash_element}->{$_});
670 0           push @a_link, {
671             a => $a,
672             brief => $brief,
673             root => ($_ eq $self->{root_name}),
674             };
675             } else {
676 0           push @a_link, {
677             a => $a,
678             };
679             }
680             }
681 0           $self->{template}->param(
682             $nb => scalar @elements,
683             $a_link => \@a_link,
684             );
685 0           return;
686             }
687            
688             sub generateAlphaEntity {
689 0     0     my $self = shift;
690 0           my ($nb, $a_link, $flg_brief) = @_;
691            
692 0 0         $nb = 'nb_entity' unless (defined $nb);
693 0 0         $a_link = 'a_entities' unless (defined $a_link);
694            
695 0           my @entities = sort keys %{$self->{hash_entity}};
  0            
696 0           my @a_link = ();
697 0           foreach (@entities) {
698 0           my $a = $self->_mk_index_anchor("ent", $_);
699 0 0         if ($flg_brief) {
700 0           my $brief = $self->_get_brief($self->{hash_element}->{$_});
701 0           push @a_link, {
702             a => $a,
703             brief => $brief,
704             root => undef,
705             };
706             } else {
707 0           push @a_link, {
708             a => $a,
709             };
710             }
711             }
712 0           $self->{template}->param(
713             $nb => scalar @entities,
714             $a_link => \@a_link,
715             );
716 0           return;
717             }
718            
719             sub generateAlphaNotation {
720 0     0     my $self = shift;
721 0           my ($nb, $a_link, $flg_brief) = @_;
722            
723 0 0         $nb = 'nb_notation' unless (defined $nb);
724 0 0         $a_link = 'a_notations' unless (defined $a_link);
725            
726 0           my @notations = sort keys %{$self->{hash_notation}};
  0            
727 0           my @a_link = ();
728 0           foreach (@notations) {
729 0           my $a = $self->_mk_index_anchor("not", $_);
730 0 0         if ($flg_brief) {
731 0           my $brief = $self->_get_brief($self->{hash_element}->{$_});
732 0           push @a_link, {
733             a => $a,
734             brief => $brief,
735             root => undef,
736             };
737             } else {
738 0           push @a_link, {
739             a => $a,
740             };
741             }
742             }
743 0           $self->{template}->param(
744             $nb => scalar @notations,
745             $a_link => \@a_link,
746             );
747 0           return;
748             }
749            
750             sub generateExampleIndex {
751 0     0     my $self = shift;
752 0           my ($nb, $a_link) = @_;
753            
754 0 0         $nb = 'nb_example' unless (defined $nb);
755 0 0         $a_link = 'a_examples' unless (defined $a_link);
756            
757 0           my @examples = @{$self->{examples}};
  0            
758 0           my @a_link = ();
759 0           foreach (@examples) {
760 0           my $a = $self->_mk_index_anchor("ex", $_);
761 0           push @a_link, {
762             a => $a,
763             };
764             }
765 0           $self->{template}->param(
766             $nb => scalar @examples,
767             $a_link => \@a_link,
768             );
769 0           return;
770             }
771            
772             sub _mk_tree {
773 0     0     my $self = shift;
774 0           my ($name, $depth) = @_;
775            
776 0 0         return if ($self->{hash_element}->{$name}->{done});
777 0           $self->{hash_element}->{$name}->{done} = 1;
778 0 0         die __PACKAGE__,"_mk_tree: INTERNAL ERROR ($name).\n"
779             unless (defined $self->{hash_element}->{$name}->{uses});
780 0 0         return unless (scalar keys %{$self->{hash_element}->{$name}->{uses}});
  0            
781            
782 0           my %done = ();
783 0 0         $self->{_tree_depth} = $depth if ($depth > $self->{_tree_depth});
784 0           $self->{_tree} .= "
    \n";
785 0           foreach (keys %{$self->{hash_element}->{$name}->{uses}}) {
  0            
786 0 0         next if ($_ eq $name);
787 0 0         next if (exists $done{$_});
788 0           $done{$_} = 1;
789 0           $self->{_tree} .= "
  • " . $self->_mk_index_anchor("elt", $_) . "\n";
  • 790 0           $self->_mk_tree($_, $depth+1);
    791 0           $self->{_tree} .= " \n";
    792             }
    793 0           $self->{_tree} .= "\n";
    794 0           return;
    795             }
    796            
    797             sub generateTree {
    798 0     0     my $self = shift;
    799            
    800 0           $self->{_tree_depth} = 1;
    801 0           $self->{_tree} = "
      \n";
    802 0           $self->{_tree} .= "
  • " . $self->_mk_index_anchor("elt", $self->{root_name}) . "\n";
  • 803 0 0         if (exists $self->{hash_element}->{$self->{root_name}}) {
    804 0           $self->_mk_tree($self->{root_name}, $self->{_tree_depth});
    805             } else {
    806 0           warn "$self->{root_name} declared in DOCTYPE is an unknown element.\n";
    807             }
    808 0           $self->{_tree} .= " \n";
    809 0           $self->{_tree} .= "\n";
    810 0 0         $self->{_tree} = "" if ($self->{_tree_depth} > 7);
    811 0           $self->{template}->param(
    812             tree => $self->{_tree},
    813             );
    814 0           delete $self->{_tree};
    815 0           return;
    816             }
    817            
    818             sub _get_doc {
    819 0     0     my $self = shift;
    820 0           my ($decl) = @_;
    821            
    822 0           my $name = $decl->{Name};
    823 0           my @doc = ();
    824 0           my @tag = ();
    825 0 0 0       if ($self->{flag_comment} and exists $decl->{comments}) {
    826 0           foreach my $comment (@{$decl->{comments}}) {
      0            
    827 0           my ($doc, $r_tags) = $self->_extract_doc($comment);
    828 0 0         if (defined $doc) {
    829 0           my $data = $self->_process_text($doc, $name);
    830 0           push @doc, { data => $data };
    831             }
    832 0           foreach (@{$r_tags}) {
      0            
    833 0           my ($href, $entry, $data) = @{$_};
      0            
    834 0 0 0       unless ( uc($entry) eq "BRIEF"
          0        
          0        
    835             or uc($entry) eq "HIDDEN"
    836             or (uc($entry) eq "TITLE" and $decl->{type} eq "doctype") ) {
    837 0 0         if ($entry =~ /^SAMPLE($|\s)/i) {
    838 0           $entry =~ s/^SAMPLE\s*//i;
    839 0           $data = "<$self->{preformatted}>" . $self->_mk_example($data) . "{preformatted}>";
    840 0           push @tag, {
    841             entry => $entry,
    842             data => $data,
    843             };
    844             } else {
    845 0           $data = $self->_process_text($data, $name, $href);
    846 0           push @tag, {
    847             entry => $entry,
    848             data => $data,
    849             };
    850             }
    851             }
    852             }
    853             }
    854             }
    855            
    856 0           return (\@doc, \@tag);
    857             }
    858            
    859             sub _get_doc_attrs {
    860 0     0     my $self = shift;
    861 0           my ($name) = @_;
    862            
    863 0           my @doc_attrs = ();
    864 0 0 0       if ($self->{flag_comment} and exists $self->{hash_attr}->{$name}) {
    865 0           foreach my $attr (@{$self->{hash_attr}->{$name}}) {
      0            
    866 0 0         if (exists $attr->{comments}) {
    867 0           my @doc = ();
    868 0           my @tag = ();
    869 0           foreach my $comment (@{$attr->{comments}}) {
      0            
    870 0           my ($doc, $r_tags) = $self->_extract_doc($comment);
    871 0 0         if (defined $doc) {
    872 0           my $data = $self->_process_text($doc, $name);
    873 0           push @doc, { data => $data };
    874             }
    875 0           foreach (@{$r_tags}) {
      0            
    876 0           my ($href, $entry, $data) = @{$_};
      0            
    877 0 0 0       unless ( uc($entry) eq "BRIEF"
    878             or uc($entry) eq "HIDDEN" ) {
    879 0 0         if ($entry =~ /^SAMPLE($|\s)/i) {
    880 0           $entry =~ s/^SAMPLE\s*//i;
    881 0           $data = "<$self->{preformatted}>" . $self->_mk_example($data) . "{preformatted}>";
    882 0           push @tag, {
    883             entry => $entry,
    884             data => $data,
    885             };
    886             } else {
    887 0           $data = $self->_process_text($data, $name, $href);
    888 0           push @tag, {
    889             entry => $entry,
    890             data => $data,
    891             };
    892             }
    893             }
    894             }
    895             }
    896 0           push @doc_attrs, {
    897             name => $attr->{aName},
    898             doc => [ @doc ],
    899             tag => [ @tag ],
    900             }
    901             }
    902             }
    903             }
    904            
    905 0           return \@doc_attrs;
    906             }
    907            
    908             sub _get_style {
    909 0     0     my $self = shift;
    910 0           my ($name) = @_;
    911            
    912 0           my $style = "";
    913 0           my $path = ${$self->{path_tmpl}}[-1];
      0            
    914 0 0         open my $IN, '<', "$path/$name"
    915             or warn "can't open $path/$name ($!)",
    916             return $style;
    917            
    918 0           while (<$IN>) {
    919 0           $style .= $_;
    920             }
    921 0           close $IN;
    922 0           return $style;
    923             }
    924            
    925             sub generateMain {
    926 0     0     my $self = shift;
    927            
    928 0           my $standalone = "";
    929 0           my $version;
    930             my $encoding;
    931 0 0         if (defined $self->{xml_decl}) {
    932 0           $standalone = $self->{xml_decl}->{Standalone};
    933 0           $version = $self->{xml_decl}->{Version};
    934 0           $encoding = $self->{xml_decl}->{Encoding};
    935             }
    936 0           my $decl = $self->{dtd};
    937 0           my $name = $decl->{Name};
    938 0           my ($r_doc, $r_tag) = $self->_get_doc($decl);
    939 0           $self->{template}->param(
    940             dtd => "" . $name . "",
    941             standalone => ($standalone eq "yes"),
    942             version => $version,
    943             encoding => $encoding,
    944             publicId => $decl->{PublicId},
    945             systemId => $decl->{SystemId},
    946             doc => $r_doc,
    947             tag => $r_tag,
    948             );
    949            
    950 0           my @decls = ();
    951 0           foreach my $decl (@{$self->{list_decl}}) {
      0            
    952 0           my $type = $decl->{type};
    953 0           my $name = $decl->{Name};
    954 0           ($r_doc, $r_tag) = $self->_get_doc($decl);
    955 0 0         if ($type eq "notation") {
        0          
        0          
        0          
    956 0   0       push @decls, {
    957             is_notation => 1,
    958             is_internal_entity => 0,
    959             is_external_entity => 0,
    960             is_element => 0,
    961             name => $name,
    962             a => "",
    963             publicId => $decl->{PublicId},
    964             systemId => $decl->{SystemId},
    965             both_id => defined($decl->{PublicId}) && defined($decl->{SystemId}),
    966             doc => $r_doc,
    967             tag => $r_tag,
    968             };
    969             } elsif ($type eq "internal_entity") {
    970 0           push @decls, {
    971             is_notation => 0,
    972             is_internal_entity => 1,
    973             is_external_entity => 0,
    974             is_element => 0,
    975             name => $name,
    976             a => "",
    977             value => "&#" . ord $decl->{Value} . ";",
    978             doc => $r_doc,
    979             tag => $r_tag,
    980             };
    981             } elsif ($type eq "external_entity") {
    982 0           push @decls, {
    983             is_notation => 0,
    984             is_internal_entity => 0,
    985             is_external_entity => 1,
    986             is_element => 0,
    987             name => $name,
    988             a => "",
    989             publicId => $decl->{PublicId},
    990             systemId => $decl->{SystemId},
    991             doc => $r_doc,
    992             tag => $r_tag,
    993             };
    994             } elsif ($type eq "element") {
    995 0           my $model = $decl->{Model};
    996 0           my @attrs = ();
    997 0 0         if (exists $self->{hash_attr}->{$name}) {
    998 0           foreach my $attr (@{$self->{hash_attr}->{$name}}) {
      0            
    999 0           my $type = $attr->{Type};
    1000 0   0       my $tokenized_type = $type eq "CDATA"
    1001             || $type eq "ID"
    1002             || $type eq "IDREF"
    1003             || $type eq "IDREFS"
    1004             || $type eq "ENTITY"
    1005             || $type eq "ENTITIES"
    1006             || $type eq "NMTOKEN"
    1007             || $type eq "NMTOKENS";
    1008 0 0         unless ($tokenized_type) {
    1009 0           $type =~ s/\(/\( /;
    1010 0           $type =~ s/\)/ \)/;
    1011 0           $type =~ s/\|/ \| /g;
    1012             }
    1013 0           my $value = $attr->{Value};
    1014 0 0         $value = "\"$attr->{Value}\"" if ($value);
    1015 0           push @attrs, {
    1016             name => $name,
    1017             attr_name => $attr->{aName},
    1018             type => $type,
    1019             tokenized_type => $tokenized_type,
    1020             value_default => $attr->{ValueDefault},
    1021             value => $value,
    1022             };
    1023             }
    1024             }
    1025 0           push @decls, {
    1026             is_notation => 0,
    1027             is_internal_entity => 0,
    1028             is_external_entity => 0,
    1029             is_element => 1,
    1030             name => $name,
    1031             a => "",
    1032             model => $self->_format_content_model($model),
    1033             attrs => \@attrs,
    1034             doc => $r_doc,
    1035             tag => $r_tag,
    1036             doc_attrs => $self->_get_doc_attrs($name),
    1037             };
    1038             } else {
    1039 0           warn __PACKAGE__,":generateMain INTERNAL_ERROR (type:$type)\n";
    1040             }
    1041             }
    1042 0           $self->{template}->param(
    1043             decls => \@decls,
    1044             );
    1045 0           return;
    1046             }
    1047            
    1048             sub _process_example {
    1049 0     0     my $self = shift;
    1050 0           my($text) = @_;
    1051            
    1052             # keep track of leading and trailing white-space
    1053 0 0         my $lead = ($text =~ s/\A(\s+)//s ? $1 : "");
    1054 0 0         my $trail = ($text =~ s/(\s+)\Z//s ? $1 : "");
    1055            
    1056             # split at space/non-space boundaries
    1057 0           my @words = split( /(?<=\s)(?=\S)|(?<=\S)(?=\s)/, $text );
    1058            
    1059             # process each word individually
    1060 0           foreach my $word (@words) {
    1061             # skip space runs
    1062 0 0         next if $word =~ /^\s*$/;
    1063 0 0         if ($word =~ /^<([A-Za-z_:][0-9A-Za-z\.\-_:]*)(>[\S]*)?$/) {
    1064             # looks like a DTD name, in example file
    1065 0 0         if (exists $self->{hash_notation}->{$1}) {
        0          
        0          
    1066 0           $word = "<" . $self->_mk_text_anchor("not", $1);
    1067 0 0         $word .= $2 if (defined $2);
    1068             }
    1069             elsif (exists $self->{hash_entity}->{$1}) {
    1070 0           $word = "<" . $self->_mk_text_anchor("ent", $1);
    1071 0 0         $word .= $2 if (defined $2);
    1072             }
    1073             elsif (exists $self->{hash_element}->{$1}) {
    1074 0           $word = "<" . $self->_mk_text_anchor("elt", $1);
    1075 0 0         $word .= $2 if (defined $2);
    1076             }
    1077             }
    1078             }
    1079            
    1080             # put everything back together
    1081 0           return $lead . join('', @words) . $trail;
    1082             }
    1083            
    1084             sub _mk_example {
    1085 0     0     my $self = shift;
    1086 0           my ($example, $emphasis) = @_;
    1087            
    1088 0 0         open my $IN, '<', $example
    1089             or warn "can't open $example ($!)",
    1090             next;
    1091 0           my $data;
    1092 0           while (<$IN>) {
    1093 0           s/&/&/g;
    1094 0           s/
    1095 0           s/>/>/g;
    1096 0           s/'/'/g;
    1097 0           s/\"/"/g;
    1098 0           s/<!--/<$self->{emphasis}><!--/g;
    1099 0           s/-->/--><\/$self->{emphasis}>/g;
    1100 0           $data .= $self->_process_example($_);
    1101             }
    1102 0           close $IN;
    1103            
    1104 0           return $data;
    1105             }
    1106            
    1107             sub generateExample {
    1108 0     0     my $self = shift;
    1109            
    1110 0           my @examples = ();
    1111 0           foreach my $ex (@{$self->{examples}}) {
      0            
    1112 0           push @examples, {
    1113             filename => $ex,
    1114             a => "",
    1115             text => $self->_mk_example($ex),
    1116             };
    1117             }
    1118 0           $self->{template}->param(
    1119 0           nb_example => scalar @{$self->{examples}},
    1120             examples => \@examples,
    1121             );
    1122 0           return;
    1123             }
    1124            
    1125             sub generateCSS {
    1126 0     0     my $self = shift;
    1127 0           my ($style) = @_;
    1128            
    1129 0           my $outfile = $self->{dirname} . "/" . $self->{css} . ".css";
    1130            
    1131 0 0         unless ( -e $outfile) {
    1132 0 0         open my $OUT, '>', $outfile
    1133             or die "can't open $outfile ($!)\n";
    1134 0           print $OUT $style;
    1135 0           close $OUT;
    1136             }
    1137 0           return;
    1138             }
    1139            
    1140             sub GenerateHTML {
    1141 0     0     my $self = shift;
    1142            
    1143 0           warn "No element declaration captured.\n"
    1144 0 0         unless (scalar keys %{$self->{hash_element}});
    1145            
    1146 0           $self->_process_args(@_);
    1147            
    1148 0           my $style = $self->_get_style("simple.css");
    1149            
    1150 0 0         $self->generateCSS($style) if ($self->{css});
    1151            
    1152 0           my $template = "simple.tmpl";
    1153 0           $self->{template} = HTML::Template->new(
    1154             filename => $template,
    1155             path => $self->{path_tmpl},
    1156             );
    1157 0 0         die "can't create template with $template ($!).\n"
    1158             unless (defined $self->{template});
    1159            
    1160 0           $self->{template}->param(
    1161             generator => $self->{generator},
    1162             date => $self->{now},
    1163             title => $self->{title},
    1164             );
    1165 0           $self->generateAlphaElement();
    1166 0           $self->generateAlphaEntity();
    1167 0           $self->generateAlphaNotation();
    1168 0           $self->generateExampleIndex();
    1169 0           $self->generateTree();
    1170 0           $self->generateMain();
    1171 0           $self->generateExample();
    1172            
    1173 0           my $filename = $self->{outfile} . ".html";
    1174 0 0         open my $OUT, '>', $filename
    1175             or die "can't open $filename ($!)\n";
    1176 0           print $OUT $self->{template}->output();
    1177 0           close $OUT;
    1178 0           return;
    1179             }
    1180            
    1181             ###############################################################################
    1182            
    1183             package XML::Handler::Dtd2Html::DocumentFrame;
    1184            
    1185 1     1   13 use strict;
      1         3  
      1         51  
    1186 1     1   21 use warnings;
      1         2  
      1         59  
    1187            
    1188 1     1   5 use base qw(XML::Handler::Dtd2Html::Document);
      1         2  
      1         1504  
    1189            
    1190             sub _mk_index_href {
    1191 0     0     my $self = shift;
    1192 0           my($type, $name) = @_;
    1193            
    1194 0           return $self->{filebase} . ".main.html#" . $type . "_" . $name;
    1195             }
    1196            
    1197             sub GenerateHTML {
    1198 0     0     my $self = shift;
    1199            
    1200 0           warn "No element declaration captured.\n"
    1201 0 0         unless (scalar keys %{$self->{hash_element}});
    1202            
    1203 0           $self->_process_args(@_);
    1204            
    1205 0           my $style = $self->_get_style("frame.css");
    1206            
    1207 0 0         $self->generateCSS($style) if ($self->{css});
    1208            
    1209 0           my $template = "frame.tmpl";
    1210 0           $self->{template} = HTML::Template->new(
    1211             filename => $template,
    1212             path => $self->{path_tmpl},
    1213             );
    1214 0 0         die "can't create template with $template ($!).\n"
    1215             unless (defined $self->{template});
    1216            
    1217 0           $self->{template}->param(
    1218             generator => $self->{generator},
    1219             date => $self->{now},
    1220             title => $self->{title},
    1221             file => $self->{filebase},
    1222             );
    1223            
    1224 0           my $filename = $self->{outfile} . ".html";
    1225 0 0         open my $OUT, '>', $filename
    1226             or die "can't open $filename ($!)\n";
    1227 0           print $OUT $self->{template}->output();
    1228 0           close $OUT;
    1229            
    1230 0           $template = "alpha.tmpl";
    1231 0           $self->{template} = HTML::Template->new(
    1232             filename => $template,
    1233             path => $self->{path_tmpl},
    1234             );
    1235 0 0         die "can't create template with $template ($!).\n"
    1236             unless (defined $self->{template});
    1237            
    1238 0           $self->{template}->param(
    1239             generator => $self->{generator},
    1240             date => $self->{now},
    1241             css => $self->{css},
    1242             title_page => $self->{title} . " (Alpha)",
    1243             );
    1244 0           $self->generateAlphaElement();
    1245 0           $self->generateAlphaEntity();
    1246 0           $self->generateAlphaNotation();
    1247 0           $self->generateExampleIndex();
    1248            
    1249 0           $filename = $self->{outfile} . ".alpha.html";
    1250 0 0         open $OUT, '>', $filename
    1251             or die "can't open $filename ($!)\n";
    1252 0           print $OUT $self->{template}->output();
    1253 0           close $OUT;
    1254            
    1255 0           $template = "tree.tmpl";
    1256 0           $self->{template} = HTML::Template->new(
    1257             filename => $template,
    1258             path => $self->{path_tmpl},
    1259             );
    1260 0 0         die "can't create template with $template ($!).\n"
    1261             unless (defined $self->{template});
    1262            
    1263 0           $self->{template}->param(
    1264             generator => $self->{generator},
    1265             date => $self->{now},
    1266             css => $self->{css},
    1267             title_page => $self->{title} . " (Tree)",
    1268             );
    1269 0           $self->generateTree();
    1270            
    1271 0           $filename = $self->{outfile} . ".tree.html";
    1272 0 0         open $OUT, '>', $filename
    1273             or die "can't open $filename ($!)\n";
    1274 0           print $OUT $self->{template}->output();
    1275 0           close $OUT;
    1276            
    1277 0           $template = "main.tmpl";
    1278 0           $self->{template} = HTML::Template->new(
    1279             filename => $template,
    1280             path => $self->{path_tmpl},
    1281             );
    1282 0 0         die "can't create template with $template ($!).\n"
    1283             unless (defined $self->{template});
    1284            
    1285 0           $self->{template}->param(
    1286             generator => $self->{generator},
    1287             date => $self->{now},
    1288             css => $self->{css},
    1289             title => $self->{title},
    1290             title_page => $self->{title} . " (Main)",
    1291             );
    1292 0           $self->generateMain();
    1293 0           $self->generateExample();
    1294            
    1295 0           $filename = $self->{outfile} . ".main.html";
    1296 0 0         open $OUT, '>', $filename
    1297             or die "can't open $filename ($!)\n";
    1298 0           print $OUT $self->{template}->output();
    1299 0           close $OUT;
    1300 0           return;
    1301             }
    1302            
    1303             ###############################################################################
    1304            
    1305             package XML::Handler::Dtd2Html::DocumentBook;
    1306            
    1307 1     1   6 use strict;
      1         2  
      1         29  
    1308 1     1   5 use warnings;
      1         1  
      1         38  
    1309            
    1310 1     1   4 use base qw(XML::Handler::Dtd2Html::Document);
      1         2  
      1         1240  
    1311            
    1312             sub _get_brief {
    1313 0     0     my $self = shift;
    1314 0           my ($decl) = @_;
    1315            
    1316 0 0 0       if ($self->{flag_comment} and exists $decl->{comments}) {
    1317 0           foreach my $comment (@{$decl->{comments}}) {
      0            
    1318 0           my ($doc, $r_tags) = $self->_extract_doc($comment);
    1319 0           foreach my $tag (@{$r_tags}) {
      0            
    1320 0           my $entry = ${$tag}[1];
      0            
    1321 0           my $data = ${$tag}[2];
      0            
    1322 0 0         if (uc($entry) eq "BRIEF") {
    1323 0           return $data;
    1324             }
    1325             }
    1326             }
    1327             }
    1328 0           return undef;
    1329             }
    1330            
    1331             sub _get_parents {
    1332 0     0     my $self = shift;
    1333 0           my ($decl) = @_;
    1334            
    1335 0           my @parents = ();
    1336 0           foreach (sort keys %{$decl->{used_by}}) {
      0            
    1337 0           push @parents, { a => $self->_mk_text_anchor("elt", $_) };
    1338             }
    1339            
    1340 0           return \@parents;
    1341             }
    1342            
    1343             sub _get_childs {
    1344 0     0     my $self = shift;
    1345 0           my ($decl) = @_;
    1346            
    1347 0           my @childs = ();
    1348 0           foreach (sort keys %{$decl->{uses}}) {
      0            
    1349 0           push @childs, { a => $self->_mk_text_anchor("elt", $_) };
    1350             }
    1351            
    1352 0           return \@childs;
    1353             }
    1354            
    1355             sub _get_attributes {
    1356 0     0     my $self = shift;
    1357 0           my ($name) = @_;
    1358            
    1359 0           my @attrs = ();
    1360 0 0         if (exists $self->{hash_attr}->{$name}) {
    1361 0           foreach my $attr (@{$self->{hash_attr}->{$name}}) {
      0            
    1362 0           my @enum = ();
    1363 0           my $is_enum;
    1364             my $is_notation;
    1365 0           my $type = $attr->{Type};
    1366 0 0 0       if ( $type ne "CDATA"
          0        
          0        
          0        
          0        
          0        
          0        
    1367             and $type ne "ID"
    1368             and $type ne "IDREF"
    1369             and $type ne "IDREFS"
    1370             and $type ne "ENTITY"
    1371             and $type ne "ENTITIES"
    1372             and $type ne "NMTOKEN"
    1373             and $type ne "NMTOKENS" ) {
    1374 0 0         if ($type =~ /^NOTATION/) {
    1375 0           $is_notation = 1;
    1376 0           $type =~ s/^NOTATION\s*\(//;
    1377 0           $type =~ s/\)$//;
    1378 0           foreach (split /\|/, $type) {
    1379 0           push @enum, {
    1380             val => $_,
    1381             };
    1382             }
    1383             } else {
    1384 0           $is_enum = 1;
    1385 0           $type =~ s/^\(//;
    1386 0           $type =~ s/\)$//;
    1387 0           foreach (split /\|/, $type) {
    1388 0           push @enum, {
    1389             val => $_,
    1390             };
    1391             }
    1392             }
    1393             }
    1394 0           my $value_default = $attr->{ValueDefault};
    1395 0           my $value = $attr->{Value};
    1396 0 0         if ($value) {
    1397 0           $value_default .= " \"" . $value . "\"";
    1398             }
    1399 0 0         $value_default = " " unless ($value_default);
    1400 0           push @attrs, {
    1401             attr_name => $attr->{aName},
    1402             is_enum => $is_enum,
    1403             is_notation => $is_notation,
    1404             enum => \@enum,
    1405             type => $type,
    1406             value_default => $value_default,
    1407             };
    1408             }
    1409             }
    1410            
    1411 0           return \@attrs;
    1412             }
    1413            
    1414             sub _mk_value {
    1415 0     0     my $self = shift;
    1416 0           my($value) = @_;
    1417            
    1418 0           return $value;
    1419             }
    1420            
    1421             sub _mk_index_href {
    1422 0     0     my $self = shift;
    1423 0           my($type, $name) = @_;
    1424            
    1425 0           my $uri_name = $name;
    1426 0           $uri_name =~ s/[ :]/_/g;
    1427 0           $uri_name = $self->_mk_filename($uri_name);
    1428            
    1429 0           return $self->{filebase} . "." . $type . "." . $uri_name . ".html";
    1430             }
    1431            
    1432             sub _mk_nav_href {
    1433 0     0     my $self = shift;
    1434 0           my($type, $name) = @_;
    1435            
    1436 0 0         return undef unless ($name);
    1437            
    1438 0           return $self->_mk_index_href($type, $name);
    1439             }
    1440            
    1441             sub _mk_outfile {
    1442 0     0     my $self = shift;
    1443 0           my($type, $name) = @_;
    1444            
    1445 0           my $uri_name = $name;
    1446 0           $uri_name =~ s/[ :]/_/g;
    1447 0           $uri_name = $self->_mk_filename($uri_name);
    1448            
    1449 0           return $self->{outfile} . "." . $type . "." . $uri_name . ".html";
    1450             }
    1451            
    1452             sub _test_sensitive {
    1453 0     0     my $self = shift;
    1454 1     1   1266 use File::Temp qw(tempfile);
      1         14744  
      1         252  
    1455            
    1456 0           my ($fh, $filename) = tempfile("caseXXXX");
    1457 0           close $fh;
    1458 0 0 0       if (-e $filename and -e uc $filename) {
    1459 0           $self->{not_sensitive} = 1;
    1460             }
    1461 0           unlink $filename;
    1462 0           return;
    1463             }
    1464            
    1465             sub _mk_filename {
    1466 0     0     my $self = shift;
    1467 0           my ($name) = @_;
    1468 0 0         return $name unless (exists $self->{not_sensitive});
    1469 0           $name =~ s/([A-Z])/$1_/g;
    1470 0           $name =~ s/([a-z])/_$1/g;
    1471 0           return $name;
    1472             }
    1473            
    1474             sub copyPNG {
    1475 0     0     my $self = shift;
    1476 1     1   1139 use File::Copy;
      1         2624  
      1         3981  
    1477            
    1478 0           my $path = ${$self->{path_tmpl}}[-1];
      0            
    1479 0           foreach my $img (qw(next up home prev)) {
    1480 0           my $infile = $path . "/" . $img .".png";
    1481 0           my $outfile = $self->{dirname} . "/" . $img . ".png";
    1482 0 0         unless ( -e $infile) {
    1483 0           warn "can't find $infile.\n";
    1484 0           next;
    1485             }
    1486 0           copy($infile, $outfile);
    1487 0 0         unless ( -e $outfile) {
    1488 0           warn "$outfile is not copied.\n";
    1489             }
    1490             }
    1491 0           return;
    1492             }
    1493            
    1494             sub GenerateHTML {
    1495 0     0     my $self = shift;
    1496            
    1497 0           warn "No element declaration captured.\n"
    1498 0 0         unless (scalar keys %{$self->{hash_element}});
    1499            
    1500 0           $self->_process_args(@_);
    1501            
    1502 0           $self->_test_sensitive();
    1503            
    1504 0           my $style = $self->_get_style("book.css");
    1505            
    1506 0 0         $self->generateCSS($style) if ($self->{css});
    1507 0           $self->copyPNG();
    1508            
    1509 0           my $template = "book.tmpl";
    1510 0           $self->{template} = HTML::Template->new(
    1511             filename => $template,
    1512             path => $self->{path_tmpl},
    1513             );
    1514 0 0         die "can't create template with $template ($!).\n"
    1515             unless (defined $self->{template});
    1516            
    1517 0           $self->{template}->param(
    1518             generator => $self->{generator},
    1519             date => $self->{now},
    1520             css => $self->{css},
    1521             book_title => $self->{title},
    1522             );
    1523 0           $self->{template}->param(
    1524             page_title => $self->{title},
    1525             href_next => $self->_mk_nav_href("", ""),
    1526             href_prev => $self->_mk_nav_href("", ""),
    1527             href_home => $self->_mk_nav_href("book", "home"),
    1528             href_up => $self->_mk_nav_href("", ""),
    1529             lbl_next => " ",
    1530             lbl_prev => " ",
    1531             );
    1532 0           $self->{template}->param(
    1533             href_prolog => $self->{filebase} . ".book." . $self->_mk_filename("prolog") . ".html",
    1534             href_elt => $self->{filebase} . ".book." . $self->_mk_filename("elements_index") . ".html",
    1535             href_ent => $self->{filebase} . ".book." . $self->_mk_filename("entities_index") . ".html",
    1536             href_not => $self->{filebase} . ".book." . $self->_mk_filename("notations_index") . ".html",
    1537             href_ex => $self->{filebase} . ".book." . $self->_mk_filename("examples_list") . ".html",
    1538             );
    1539 0           $self->generateTree();
    1540            
    1541 0           my $filename = $self->_mk_outfile("book", "home");
    1542 0 0         open my $OUT, '>', $filename
    1543             or die "can't open $filename ($!)\n";
    1544 0           print $OUT $self->{template}->output();
    1545 0           close $OUT;
    1546            
    1547 0           $template = "prolog.tmpl";
    1548 0           $self->{template} = HTML::Template->new(
    1549             filename => $template,
    1550             path => $self->{path_tmpl},
    1551             );
    1552 0 0         die "can't create template with $template ($!).\n"
    1553             unless (defined $self->{template});
    1554            
    1555 0           $self->{template}->param(
    1556             generator => $self->{generator},
    1557             date => $self->{now},
    1558             css => $self->{css},
    1559             book_title => $self->{title},
    1560             );
    1561 0           $self->{template}->param(
    1562             page_title => $self->{title},
    1563             href_next => $self->_mk_nav_href("book", "elements index"),
    1564             href_prev => $self->_mk_nav_href("book", "home"),
    1565             href_home => $self->_mk_nav_href("book", "home"),
    1566             href_up => $self->_mk_nav_href("book", "home"),
    1567             lbl_next => "elements index",
    1568             lbl_prev => "home",
    1569             );
    1570 0           my ($r_doc, $r_tag) = $self->_get_doc($self->{dtd});
    1571 0           $self->{template}->param(
    1572             name => $self->{dtd}->{Name},
    1573             brief => $self->_get_brief($self->{dtd}),
    1574             publicId => $self->{dtd}->{PublicId},
    1575             systemId => $self->{dtd}->{SystemId},
    1576             doc => $r_doc,
    1577             tag => $r_tag,
    1578             );
    1579            
    1580 0           $filename = $self->_mk_outfile("book", "prolog");
    1581 0 0         open $OUT, '>', $filename
    1582             or die "can't open $filename ($!)\n";
    1583 0           print $OUT $self->{template}->output();
    1584 0           close $OUT;
    1585            
    1586 0           $template = "index.tmpl";
    1587 0           $self->{template} = HTML::Template->new(
    1588             filename => $template,
    1589             path => $self->{path_tmpl},
    1590             );
    1591 0 0         die "can't create template with $template ($!).\n"
    1592             unless (defined $self->{template});
    1593            
    1594 0           $self->{template}->param(
    1595             generator => $self->{generator},
    1596             date => $self->{now},
    1597             css => $self->{css},
    1598             book_title => $self->{title},
    1599             );
    1600 0           $self->{template}->param(
    1601             page_title => "Elements Index.",
    1602             href_next => $self->_mk_nav_href("book", "entities index"),
    1603             href_prev => $self->_mk_nav_href("book", "prolog"),
    1604             href_home => $self->_mk_nav_href("book", "home"),
    1605             href_up => $self->_mk_nav_href("book", "home"),
    1606             lbl_next => "entities index",
    1607             lbl_prev => "prolog",
    1608             );
    1609 0           $self->{template}->param(
    1610             idx_elt => 1,
    1611             idx_ent => 0,
    1612             idx_not => 0,
    1613             lst_ex => 0,
    1614             );
    1615 0           $self->generateAlphaElement("nb", "a_link", 1);
    1616 0           my @elements = sort keys %{$self->{hash_element}};
      0            
    1617            
    1618 0           $filename = $self->_mk_outfile("book", "elements_index");
    1619 0 0         open $OUT, '>', $filename
    1620             or die "can't open $filename ($!)\n";
    1621 0           print $OUT $self->{template}->output();
    1622 0           close $OUT;
    1623            
    1624 0 0         if (scalar @elements) {
    1625 0           $template = "element.tmpl";
    1626 0           $self->{template} = HTML::Template->new(
    1627             filename => $template,
    1628             path => $self->{path_tmpl},
    1629             loop_context_vars => 1,
    1630             );
    1631 0 0         die "can't create template with $template ($!).\n"
    1632             unless (defined $self->{template});
    1633            
    1634 0           $self->{template}->param(
    1635             generator => $self->{generator},
    1636             date => $self->{now},
    1637             css => $self->{css},
    1638             book_title => $self->{title},
    1639             );
    1640            
    1641 0           my @prevs = @elements;
    1642 0           my @nexts = @elements;
    1643 0           pop @prevs;
    1644 0           unshift @prevs, "elements index";
    1645 0           shift @nexts;
    1646 0           push @nexts, "";
    1647 0           my $first = 1;
    1648 0           foreach my $name (@elements) {
    1649 0           my $decl = $self->{hash_element}->{$name};
    1650 0 0         my $type_p = $first ? "book" : "elt";
    1651 0           my $type_n = "elt";
    1652 0           my $prev = shift @prevs;
    1653 0           my $next = shift @nexts;
    1654            
    1655 0 0         $self->{template}->param(
        0          
    1656             page_title => "Element " . $name,
    1657             href_next => $self->_mk_nav_href($type_n, $next),
    1658             href_prev => $self->_mk_nav_href($type_p, $prev),
    1659             href_home => $self->_mk_nav_href("book", "home"),
    1660             href_up => $self->_mk_nav_href("book", "elements index"),
    1661             lbl_next => ($next ? $next : " "),
    1662             lbl_prev => ($prev ? $prev : " "),
    1663             );
    1664 0           my $model = $decl->{Model};
    1665 0           ($r_doc, $r_tag) = $self->_get_doc($decl);
    1666 0 0         $self->{template}->param(
        0          
    1667             name => $name,
    1668             brief => $self->_get_brief($decl),
    1669             f_model => $self->_format_content_model($model),
    1670             attrs => $self->_get_attributes($name),
    1671             parents => $self->_get_parents($decl),
    1672             childs => $self->_get_childs($decl),
    1673             doc => $r_doc,
    1674             tag => $r_tag,
    1675             doc_attrs => $self->_get_doc_attrs($name),
    1676             is_mixed => ($model =~ /#PCDATA/) ? 1 : 0,
    1677             is_element => ($model !~ /(ANY|EMPTY)/) ? 1 : 0,
    1678             );
    1679            
    1680 0           $filename = $self->_mk_outfile($type_n, $name);
    1681 0 0         open $OUT, '>', $filename
    1682             or die "can't open $filename ($!)\n";
    1683 0           print $OUT $self->{template}->output();
    1684 0           close $OUT;
    1685 0           $first = 0;
    1686             }
    1687             }
    1688            
    1689 0           $template = "index.tmpl";
    1690 0           $self->{template} = HTML::Template->new(
    1691             filename => $template,
    1692             path => $self->{path_tmpl},
    1693             );
    1694 0 0         die "can't create template with $template ($!).\n"
    1695             unless (defined $self->{template});
    1696            
    1697 0           $self->{template}->param(
    1698             generator => $self->{generator},
    1699             date => $self->{now},
    1700             css => $self->{css},
    1701             book_title => $self->{title},
    1702             );
    1703 0           $self->{template}->param(
    1704             page_title => "Entities Index.",
    1705             href_next => $self->_mk_nav_href("book", "notations index"),
    1706             href_prev => $self->_mk_nav_href("book", "elements index"),
    1707             href_home => $self->_mk_nav_href("book", "home"),
    1708             href_up => $self->_mk_nav_href("book", "home"),
    1709             lbl_next => "notations index",
    1710             lbl_prev => "elements index",
    1711             );
    1712 0           $self->{template}->param(
    1713             idx_elt => 0,
    1714             idx_ent => 1,
    1715             idx_not => 0,
    1716             lst_ex => 0,
    1717             );
    1718 0           my @entities = sort keys %{$self->{hash_entity}};
      0            
    1719 0           $self->generateAlphaEntity("nb", "a_link", 1);
    1720            
    1721 0           $filename = $self->_mk_outfile("book","entities_index");
    1722 0 0         open $OUT, '>', $filename
    1723             or die "can't open $filename ($!)\n";
    1724 0           print $OUT $self->{template}->output();
    1725 0           close $OUT;
    1726            
    1727 0 0         if (scalar @entities) {
    1728 0           $template = "entity.tmpl";
    1729 0           $self->{template} = HTML::Template->new(
    1730             filename => $template,
    1731             path => $self->{path_tmpl},
    1732             );
    1733 0 0         die "can't create template with $template ($!).\n"
    1734             unless (defined $self->{template});
    1735            
    1736 0           $self->{template}->param(
    1737             generator => $self->{generator},
    1738             date => $self->{now},
    1739             css => $self->{css},
    1740             book_title => $self->{title},
    1741             );
    1742            
    1743 0           my @prevs = @entities;
    1744 0           my @nexts = @entities;
    1745 0           pop @prevs;
    1746 0           unshift @prevs, "entities index";
    1747 0           shift @nexts;
    1748 0           push @nexts, "";
    1749 0           my $first = 1;
    1750 0           foreach (@entities) {
    1751 0           my $decl = $self->{hash_entity}->{$_};
    1752 0 0         my $type_p = $first ? "book" : "ent";
    1753 0           my $type_n = "ent";
    1754 0           my $prev = shift @prevs;
    1755 0           my $next = shift @nexts;
    1756            
    1757 0 0         $self->{template}->param(
        0          
    1758             page_title => "Entity " . $_,
    1759             href_next => $self->_mk_nav_href($type_n, $next),
    1760             href_prev => $self->_mk_nav_href($type_p, $prev),
    1761             href_home => $self->_mk_nav_href("book", "home"),
    1762             href_up => $self->_mk_nav_href("book", "entities index"),
    1763             lbl_next => ($next ? $next : " "),
    1764             lbl_prev => ($prev ? $prev : " "),
    1765             );
    1766 0           ($r_doc, $r_tag) = $self->_get_doc($decl);
    1767 0 0         $self->{template}->param(
    1768             name => $_,
    1769             brief => $self->_get_brief($decl),
    1770             value => (exists $decl->{Value}) ? ord($decl->{Value}) : undef,
    1771             publicId => $decl->{PublicId},
    1772             systemId => $decl->{SystemId},
    1773             doc => $r_doc,
    1774             tag => $r_tag,
    1775             );
    1776            
    1777 0           $filename = $self->_mk_outfile($type_n, $_);
    1778 0 0         open $OUT, '>', $filename
    1779             or die "can't open $filename ($!)\n";
    1780 0           print $OUT $self->{template}->output();
    1781 0           close $OUT;
    1782 0           $first = 0;
    1783             }
    1784             }
    1785            
    1786 0           $template = "index.tmpl";
    1787 0           $self->{template} = HTML::Template->new(
    1788             filename => $template,
    1789             path => $self->{path_tmpl},
    1790             );
    1791 0 0         die "can't create template with $template ($!).\n"
    1792             unless (defined $self->{template});
    1793            
    1794 0           $self->{template}->param(
    1795             generator => $self->{generator},
    1796             date => $self->{now},
    1797             css => $self->{css},
    1798             book_title => $self->{title},
    1799             );
    1800 0           $self->{template}->param(
    1801             page_title => "Notations Index.",
    1802             href_next => $self->_mk_nav_href("book", "examples list"),
    1803             href_prev => $self->_mk_nav_href("book", "entities index"),
    1804             href_home => $self->_mk_nav_href("book", "home"),
    1805             href_up => $self->_mk_nav_href("book", "home"),
    1806             lbl_next => "examples list",
    1807             lbl_prev => "entities index",
    1808             );
    1809 0           $self->{template}->param(
    1810             idx_elt => 0,
    1811             idx_ent => 0,
    1812             idx_not => 1,
    1813             lst_ex => 0,
    1814             );
    1815 0           my @notations = sort keys %{$self->{hash_notation}};
      0            
    1816 0           $self->generateAlphaNotation("nb", "a_link", 1);
    1817            
    1818 0           $filename = $self->_mk_outfile("book", "notations_index");
    1819 0 0         open $OUT, '>', $filename
    1820             or die "can't open $filename ($!)\n";
    1821 0           print $OUT $self->{template}->output();
    1822 0           close $OUT;
    1823            
    1824 0 0         if (scalar @notations) {
    1825 0           $template = "notation.tmpl";
    1826 0           $self->{template} = HTML::Template->new(
    1827             filename => $template,
    1828             path => $self->{path_tmpl},
    1829             );
    1830 0 0         die "can't create template with $template ($!).\n"
    1831             unless (defined $self->{template});
    1832            
    1833 0           $self->{template}->param(
    1834             generator => $self->{generator},
    1835             date => $self->{now},
    1836             css => $self->{css},
    1837             book_title => $self->{title},
    1838             );
    1839            
    1840 0           my @prevs = @notations;
    1841 0           my @nexts = @notations;
    1842 0           pop @prevs;
    1843 0           unshift @prevs, "notations_index";
    1844 0           shift @nexts;
    1845 0           push @nexts, "";
    1846 0           my $first = 1;
    1847 0           foreach (@notations) {
    1848 0           my $decl = $self->{hash_notation}->{$_};
    1849 0 0         my $type_p = $first ? "book" : "not";
    1850 0           my $type_n = "not";
    1851 0           my $prev = shift @prevs;
    1852 0           my $next = shift @nexts;
    1853            
    1854 0 0         $self->{template}->param(
        0          
    1855             page_title => "Notation " . $_,
    1856             href_next => $self->_mk_nav_href($type_n, $next),
    1857             href_prev => $self->_mk_nav_href($type_p, $prev),
    1858             href_home => $self->_mk_nav_href("book", "home"),
    1859             href_up => $self->_mk_nav_href("book", "notations index"),
    1860             lbl_next => ($next ? $next : " "),
    1861             lbl_prev => ($prev ? $prev : " "),
    1862             );
    1863 0           ($r_doc, $r_tag) = $self->_get_doc($decl);
    1864 0           $self->{template}->param(
    1865             name => $_,
    1866             brief => $self->_get_brief($decl),
    1867             publicId => $decl->{PublicId},
    1868             systemId => $decl->{SystemId},
    1869             doc => $r_doc,
    1870             tag => $r_tag,
    1871             );
    1872            
    1873 0           $filename = $self->_mk_outfile($type_n, $_);
    1874 0 0         open $OUT, '>', $filename
    1875             or die "can't open $filename ($!)\n";
    1876 0           print $OUT $self->{template}->output();
    1877 0           close $OUT;
    1878 0           $first = 0;
    1879             }
    1880             }
    1881            
    1882 0           $template = "index.tmpl";
    1883 0           $self->{template} = HTML::Template->new(
    1884             filename => $template,
    1885             path => $self->{path_tmpl},
    1886             );
    1887 0 0         die "can't create template with $template ($!).\n"
    1888             unless (defined $self->{template});
    1889            
    1890 0           $self->{template}->param(
    1891             generator => $self->{generator},
    1892             date => $self->{now},
    1893             css => $self->{css},
    1894             book_title => $self->{title},
    1895             );
    1896 0           $self->{template}->param(
    1897             page_title => "Examples List.",
    1898             href_next => $self->_mk_nav_href("", ""),
    1899             href_prev => $self->_mk_nav_href("book", "notations index"),
    1900             href_home => $self->_mk_nav_href("book", "home"),
    1901             href_up => $self->_mk_nav_href("book", "home"),
    1902             lbl_next => " ",
    1903             lbl_prev => "notations index",
    1904             );
    1905 0           $self->{template}->param(
    1906             idx_elt => 0,
    1907             idx_ent => 0,
    1908             idx_not => 0,
    1909             lst_ex => 1,
    1910             );
    1911 0           my @examples = @{$self->{examples}};
      0            
    1912 0           $self->generateExampleIndex("nb", "a_link");
    1913            
    1914 0           $filename = $self->_mk_outfile("book", "examples_list");
    1915 0 0         open $OUT, '>', $filename
    1916             or die "can't open $filename ($!)\n";
    1917 0           print $OUT $self->{template}->output();
    1918 0           close $OUT;
    1919            
    1920 0 0         if (scalar @examples) {
    1921 0           $template = "example.tmpl";
    1922 0           $self->{template} = HTML::Template->new(
    1923             filename => $template,
    1924             path => $self->{path_tmpl},
    1925             );
    1926 0 0         die "can't create template with $template ($!).\n"
    1927             unless (defined $self->{template});
    1928            
    1929 0           $self->{template}->param(
    1930             generator => $self->{generator},
    1931             date => $self->{now},
    1932             css => $self->{css},
    1933             book_title => $self->{title},
    1934             );
    1935            
    1936 0           my @prevs = @examples;
    1937 0           my @nexts = @examples;
    1938 0           pop @prevs;
    1939 0           unshift @prevs, "examples list";
    1940 0           shift @nexts;
    1941 0           push @nexts, "";
    1942 0           my $first = 1;
    1943 0           foreach my $example (@examples) {
    1944 0 0         my $type_p = $first ? "book" : "ex";
    1945 0           my $type_n = "ex";
    1946 0           my $prev = shift @prevs;
    1947 0           my $next = shift @nexts;
    1948            
    1949 0 0         $self->{template}->param(
        0          
    1950             page_title => "Example " . $example,
    1951             href_next => $self->_mk_nav_href($type_n, $next),
    1952             href_prev => $self->_mk_nav_href($type_p, $prev),
    1953             href_home => $self->_mk_nav_href("book", "home"),
    1954             href_up => $self->_mk_nav_href("book", "examples list"),
    1955             lbl_next => ($next ? $next : " "),
    1956             lbl_prev => ($prev ? $prev : " "),
    1957             );
    1958 0           $self->{template}->param(
    1959             example => $self->_mk_example($example),
    1960             );
    1961            
    1962 0           $filename = $self->_mk_outfile($type_n, $example);
    1963 0 0         open $OUT, '>', $filename
    1964             or die "can't open $filename ($!)\n";
    1965 0           print $OUT $self->{template}->output();
    1966 0           close $OUT;
    1967 0           $first = 0;
    1968             }
    1969             }
    1970 0           return;
    1971             }
    1972            
    1973             1;
    1974            
    1975             __END__