"Fossies" - the Fresh Open Source Software Archive 
Member "Grutatxt-2.20/Grutatxt.pm" (29 Nov 2019, 39227 Bytes) of package /linux/www/Grutatxt-2.20.tar.gz:
As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style:
standard) with prefixed line numbers and
code folding option.
Alternatively you can here
view or
download the uninterpreted source code file.
For more information about "Grutatxt.pm" see the
Fossies "Dox" file reference documentation.
1 #
2 # Grutatxt - A text to HTML (and other things) converter
3 #
4 # Angel Ortega <angel@triptico.com> et al.
5 #
6 # This software is released into the public domain.
7 # NO WARRANTY. See file LICENSE for details.
8 #
9
10 package Grutatxt;
11
12 use locale;
13
14 $VERSION = '2.20';
15
16 =pod
17
18 =head1 NAME
19
20 Grutatxt - Text to HTML (and other formats) converter
21
22 =head1 SYNOPSIS
23
24 use Grutatxt;
25
26 # create a new Grutatxt converter object
27 $grutatxt = new Grutatxt();
28
29 # process a Grutatxt format string
30 @output = $grutatxt->process($text);
31
32 # idem for a file
33 @output2 = $grutatxt->process_file($file);
34
35 =head1 DESCRIPTION
36
37 Grutatxt is a module to process text documents in
38 a special markup format (also called Grutatxt), very
39 similar to plain ASCII text. These documents can be
40 converted to HTML, troff or man.
41
42 The markup is designed to be fairly intuitive and
43 straightforward and can include headings, bold and italic
44 text effects, bulleted, numbered and definition lists, URLs,
45 function and variable names, preformatted text, horizontal
46 separators and tables. Special marks can be inserted in the
47 text and a heading-based structural index can be obtained
48 from it.
49
50 =for html <->
51
52 A comprehensive description of the markup is defined in
53 the README file, included with the Grutatxt package (it is
54 written in Grutatxt format itself, so it can be converted
55 using the I<grutatxt> tool to any of the supported formats).
56 The latest version (and more information) can be retrieved
57 from the Grutatxt home page at:
58
59 http://triptico.com/software/grutatxt.html
60
61 =head1 FUNCTIONS AND METHODS
62
63 =head2 new
64
65 $grutatxt = new Grutatxt([ "mode" => $mode, ]
66 [ "title" => \$title, ]
67 [ "marks" => \@marks, ]
68 [ "index" => \@index, ]
69 [ "abstract" => \$abstract, ]
70 [ "strip-parens" => $bool, ]
71 [ "strip-dollars" => $bool, ]
72 [ %driver_specific_arguments ] );
73
74 Creates a new Grutatxt object instance. All parameters are
75 optional.
76
77 =over 4
78
79 =item I<mode>
80
81 Output format. Can be HTML, troff or man. HTML is used if not specified.
82
83 =item I<title>
84
85 If I<title> is specified as a reference to scalar, the first
86 level 1 heading found in the text is stored inside it.
87
88 =item I<marks>
89
90 Marks in the Grutatxt markup are created by inserting the
91 string <-> alone in a line. If I<marks> is specified as a
92 reference to array, it will be filled with the subscripts
93 (relative to the output array) of the lines where the marks
94 are found in the text.
95
96 =item I<index>
97
98 If I<index> is specified as a reference to array, it will
99 be filled with two element arrayrefs with the level as first
100 argument and the heading as second.
101
102 This information can be used to build a table of contents
103 of the processed text.
104
105 =item I<strip-parens>
106
107 Function names in the Grutatxt markup are strings of
108 alphanumeric characters immediately followed by a pair
109 of open and close parentheses. If this boolean value is
110 set, function names found in the processed text will have
111 their parentheses deleted.
112
113 =item I<strip-dollars>
114
115 Variable names in the Grutatxt markup are strings of
116 alphanumeric characters preceded by a dollar sign.
117 If this boolean value is set, variable names found in
118 the processed text will have the dollar sign deleted.
119
120 =item I<abstract>
121
122 The I<abstract> of a Grutatxt document is the fragment of text
123 from the beginning of the document to the end of the first
124 paragraph after the title. If I<abstract> is specified as a
125 reference to scalar, it will contain (after each call to the
126 B<process()> method) the subscript of the element of the output
127 array that marks the end of the subject.
128
129 =item I<no-pure-verbatim>
130
131 Since version 2.0.15, text effects as italics and bold are not
132 processed in I<verbatim> (preformatted) mode. If you want to
133 revert to the old behaviour, use this option.
134
135 =item I<toc>
136
137 If set, a table of contents will be generated after the abstract.
138 The table of contents will be elaborated using headings from 2
139 and 3 levels.
140
141 =back
142
143 =cut
144
145 sub new
146 {
147 my ($class, %args) = @_;
148 my ($gh);
149
150 $args{'mode'} ||= 'HTML';
151
152 $class .= "::" . $args{'mode'};
153
154 $gh = new $class(%args);
155
156 return $gh;
157 }
158
159
160 sub escape
161 # escapes special characters, ignoring passthrough code
162 {
163 my ($gh, $l) = @_;
164
165 # splits between << and >>
166 my (@l) = split(/(<<|>>)/, $l);
167
168 @l = map {
169 my $l = $_;
170
171 # escape only text outside << and >>
172 unless ($l eq '<<' .. $l eq '>>') {
173 $l = $gh->_escape($l);
174 }
175
176 $_ = $l;
177 } @l;
178
179 # join again, stripping << and >>
180 $l = join('', grep(!/^(<<|>>)$/, @l));
181
182 return $l;
183 }
184
185
186 =head2 process
187
188 @output = $grutatxt->process($text);
189
190 Processes a text in Grutatxt format. The result is returned
191 as an array of lines.
192
193 =cut
194
195 sub process
196 {
197 my ($gh, $content) = @_;
198 my ($p);
199
200 # clean output
201 @{$gh->{'o'}} = ();
202
203 # clean title and paragraph numbers
204 $gh->{'-title'} = '';
205 $gh->{'-p'} = 0;
206
207 # clean marks
208 if (!defined $gh->{marks}) {
209 $gh->{marks} = [];
210 }
211
212 @{$gh->{'marks'}} = ();
213
214 # clean index
215 if (!$gh->{index}) {
216 $gh->{index} = [];
217 }
218
219 @{$gh->{'index'}} = ();
220
221 # reset abstract line
222 if (!$gh->{abstract}) {
223 $gh->{abstract} = \$gh->{_abstract};
224 }
225
226 ${$gh->{'abstract'}} = 0;
227
228 # insert prefix
229 $gh->_prefix();
230
231 $gh->{'-mode'} = undef;
232
233 foreach my $l (split(/\n/,$content)) {
234 # inline data (passthrough)
235 if ($l =~ /^<<$/ .. $l =~ /^>>$/) {
236 $gh->_inline($l);
237 next;
238 }
239
240 # marks
241 if ($l =~ /^\s*<\->\s*$/) {
242 push(@{$gh->{'marks'}},scalar(@{$gh->{'o'}}))
243 if ref($gh->{'marks'});
244
245 next;
246 }
247
248 # TOC mark
249 if ($l =~ /^\s*<\?>\s*$/) {
250 $gh->{toc} = $gh->{_toc_pos} = scalar(@{$gh->{o}});
251 next;
252 }
253
254 # escape possibly dangerous characters
255 $l = $gh->escape($l);
256
257 # empty lines
258 $l =~ s/^\r$//ge;
259 if ($l =~ s/^$/$gh->_empty_line()/ge) {
260 # mark the abstract end
261 if ($gh->{'-title'}) {
262 $gh->{'-p'}++;
263
264 # mark abstract if it's the
265 # second paragraph from the title
266 ${$gh->{'abstract'}} = scalar(@{$gh->{'o'}})-1
267 if $gh->{'-p'} == 2;
268 }
269 }
270
271 # line-mutating process
272 my $ol = $l;
273
274 if ($gh->{'-process-urls'}) {
275 # URLs followed by a parenthesized phrase
276 $l =~ s/(https?:\/\/\S+)\s+\(([^\)]+)\)/$gh->_url($1,$2)/ge;
277 $l =~ s/(ftps?:\/\/\S+)\s+\(([^\)]+)\)/$gh->_url($1,$2)/ge;
278 $l =~ s/(file:\/?\S+)\s+\(([^\)]+)\)/$gh->_url($1,$2)/ge;
279 $l =~ s|(\s+)\./(\S+)\s+\(([^\)]+)\)|$1.$gh->_url($2,$3)|ge;
280 $l =~ s|^\./(\S+)\s+\(([^\)]+)\)|$gh->_url($1,$2)|ge;
281 $l =~ s/(mailto:\S+)\s+\(([^\)]+)\)/$gh->_url($1,$2)/ge;
282
283 # URLs without phrase
284 $l =~ s/([^=][^\"])(https?:\/\/\S+)/$1.$gh->_url($2)/ge;
285 $l =~ s/([^=][^\"])(ftps?:\/\/\S+)/$1.$gh->_url($2)/ge;
286 $l =~ s/([^=][^\"])(file:\/?\S+)/$1.$gh->_url($2)/ge;
287 $l =~ s|(\s+)\./(\S+)|$1.$gh->_url($2)|ge;
288 $l =~ s/([^=][^\"])(mailto:)(\S+)/$1.$gh->_url($2.$3,$3)/ge;
289
290 $l =~ s/^(https?:\/\/\S+)/$gh->_url($1)/ge;
291 $l =~ s/^(ftps?:\/\/\S+)/$gh->_url($1)/ge;
292 $l =~ s/^(file:\/?\S+)/$gh->_url($1)/ge;
293 $l =~ s|^\./(\S+)|$gh->_url($1)|ge;
294 }
295
296 # change '''text''' and *text* into strong emphasis
297 $l =~ s/\'\'\'([^\'][^\'][^\']*)\'\'\'/$gh->_strong($1)/ge;
298 $l =~ s/\*(\S[^\*]+\S)\*/$gh->_strong($1)/ge;
299 $l =~ s/\*(\S+)\*/$gh->_strong($1)/ge;
300
301 # change ''text'' and _text_ into emphasis
302 $l =~ s/\'\'([^\'][^\']*)\'\'/$gh->_em($1)/ge;
303 $l =~ s/\b_(\S[^_]*\S)_\b/$gh->_em($1)/ge;
304 $l =~ s/\b_(\S+)_\b/$gh->_em($1)/ge;
305
306 # change `text' into code
307 $l =~ s/`([^\']*)\'/$gh->_code($1)/ge;
308
309 # james: change :-class-text--: into span class
310 $l =~ s/:-([^-]+)-(.+?)--:/$gh->_spanclass($1,$2)/ge;
311 # james: add :=class= text ==:
312 $l =~ s/:=([^=]+)=/$gh->_divclassopen($1)/ge; # open
313 $l =~ s/==:/$gh->_divclassclose()/ge; # close
314
315 # enclose function names
316 if ($gh->{'strip-parens'}) {
317 $l =~ s/(\w+)\(\)/$gh->_funcname($1)/ge;
318 }
319 else {
320 $l =~ s/(\w+)\(\)/$gh->_funcname($1."()")/ge;
321 }
322
323 # enclose variable names
324 if ($gh->{'strip-dollars'}) {
325 $l =~ s/\$([\w_\.]+)/$gh->_varname($1)/ge;
326 }
327 else {
328 $l =~ s/(\$[\w_\.]+)/$gh->_varname($1)/ge;
329 }
330
331 #
332 # main switch
333 #
334
335 # definition list
336 if ($l =~ /^\s\*\s+/ && $l =~ s/^\s\*\s+([^:\.,;]+)\:\s+/$gh->_dl($1)/e) {
337 $gh->{'-mode-elems'} ++;
338 }
339
340 # unsorted list
341 elsif ($gh->{'-mode'} ne 'pre' and
342 ($l =~ s/^(\s+)\*\s+/$gh->_unsorted_list($1)/e or
343 $l =~ s/^(\s+)\-\s+/$gh->_unsorted_list($1)/e)) {
344 $gh->{'-mode-elems'} ++;
345 }
346
347 # sorted list
348 elsif ($gh->{'-mode'} ne 'pre' and
349 ($l =~ s/^(\s+)\#\s+/$gh->_ordered_list($1)/e or
350 $l =~ s/^(\s+)1\s+/$gh->_ordered_list($1)/e)) {
351 $gh->{'-mode-elems'} ++;
352 }
353
354 # quoted block
355 elsif ($gh->{'-mode'} ne 'pre' and
356 $l =~ s/^\s\"/$gh->_blockquote()/e) {
357 }
358
359 # table rows
360 elsif ($l =~ s/^\s*\|(.*)\|\s*$/$gh->_table_row($1)/e) {
361 $gh->{'-mode-elems'} ++;
362 }
363
364 # table heading / end of row
365 elsif ($l =~ s/^\s*(\+[-\+\|]+\+)\s*$/$gh->_table($1)/e) {
366 }
367
368 # preformatted text
369 elsif ($l =~ s/^(\s.*\S)$/$gh->_pre($1)/e) {
370 if ($gh->{'-mode'} eq 'pre' &&
371 !$gh->{'no-pure-verbatim'}) {
372 # set line back to original
373 $l = $ol;
374 }
375 }
376
377 # anything else
378 else {
379 # back to normal mode
380 $gh->_new_mode(undef);
381 }
382
383 # 1 level heading
384 $l =~ s/^(=+)\s*$/$gh->_process_heading(1,$1)/e;
385
386 # 2 level heading
387 $l =~ s/^(-+)\s*$/$gh->_process_heading(2,$1)/e;
388
389 # 3 level heading
390 $l =~ s/^(~+)\s*$/$gh->_process_heading(3,$1)/e;
391
392 # change ------ into hr
393 $l =~ s/^----*$/$gh->_hr()/e;
394
395 # push finally
396 $gh->_push($l) if $l;
397 }
398
399 # flush
400 $gh->_new_mode(undef);
401
402 # postfix
403 $gh->_postfix();
404
405 # set title
406 ${$gh->{'title'}} = $gh->{'-title'} if ref($gh->{'title'});
407
408 # set abstract, if not set
409 ${$gh->{'abstract'}} = scalar(@{$gh->{'o'}})
410 if ref($gh->{'abstract'}) and not ${$gh->{'abstract'}};
411
412 # travel all lines again, post-escaping
413 @{$gh->{'o'}} = map { $_ = $gh->_escape_post($_); } @{$gh->{'o'}};
414
415 # add TOC after first paragraph
416 if ($gh->{toc} && @{$gh->{o}}) {
417 my $p = $gh->{_toc_pos} ||
418 $gh->{marks}->[0] ||
419 ${$gh->{abstract}};
420
421 @{$gh->{o}} = (@{$gh->{o}}[0 .. $p],
422 $gh->_toc(),
423 @{$gh->{o}}[$p + 1 ..
424 scalar(@{$gh->{o}})]);
425 }
426
427 return @{$gh->{'o'}};
428 }
429
430
431 =head2 process_file
432
433 @output = $grutatxt->process_file($filename);
434
435 Processes a file in Grutatxt format.
436
437 =cut
438
439 sub process_file
440 {
441 my ($gh, $file) = @_;
442
443 open F, $file or return(undef);
444
445 my ($content) = join('',<F>);
446 close F;
447
448 return $gh->process($content);
449 }
450
451
452 sub _push
453 {
454 my ($gh, $l) = @_;
455
456 push(@{$gh->{'o'}},$l);
457 }
458
459
460 sub _process_heading
461 {
462 my ($gh, $level, $hd) = @_;
463 my $l;
464 my $is_title = 0;
465
466 $l = pop(@{$gh->{'o'}});
467
468 if ($l eq $gh->_empty_line()) {
469 $gh->_push($l);
470 return $hd;
471 }
472
473 # store title
474 if ($level == 1 and not $gh->{'-title'}) {
475 $gh->{'-title'} = $l;
476 $is_title = 1;
477 }
478
479 # store index
480 if (ref($gh->{'index'})) {
481 push(@{$gh->{'index'}}, [ $level, $l ]);
482 }
483
484 return $gh->_heading($level, $l, $is_title);
485 }
486
487
488 sub _calc_col_span
489 {
490 my ($gh, $l) = @_;
491 my (@spans);
492
493 # strip first + and all -
494 $l =~ s/^\+//;
495 $l =~ s/-//g;
496
497 my ($t) = 1; @spans = ();
498 for (my $n = 0; $n < length($l); $n++) {
499 if (substr($l, $n, 1) eq '+') {
500 push(@spans, $t);
501 $t = 1;
502 }
503 else {
504 # it's a colspan mark:
505 # increment
506 $t++;
507 }
508 }
509
510 return @spans;
511 }
512
513
514 sub _table_row
515 {
516 my ($gh, $str) = @_;
517
518 my @s = split(/\|/,$str);
519
520 for (my $n = 0; $n < scalar(@s); $n++) {
521 ${$gh->{'-table'}}[$n] .= ' ' . $s[$n];
522 }
523
524 push(@{$gh->{'-table-raw'}}, $str);
525
526 return '';
527 }
528
529
530 sub _pre
531 {
532 my ($gh, $l) = @_;
533
534 # if any other mode is active, add to it
535 if ($gh->{'-mode'} and $gh->{'-mode'} ne 'pre') {
536 $l =~ s/^\s+//;
537
538 my ($a) = pop(@{$gh->{'o'}})." ".$l;
539 $gh->_push($a);
540 $l = '';
541 }
542 else {
543 # tabs to spaces if a non-zero tabsize is given (only in LaTex)
544 $l =~ s/\t/' ' x $gh->{'tabsize'}/ge if $gh->{'tabsize'} > 0;
545
546 $gh->_new_mode('pre');
547 }
548
549 return $l;
550 }
551
552
553 sub _multilevel_list
554 {
555 my ($gh, $str, $ind) = @_;
556 my (@l,$level);
557
558 @l = @{$gh->{$str}};
559 $ind = length($ind);
560 $level = 0;
561
562 if ($l[-1] < $ind) {
563 # if last level is less indented, increase
564 # nesting level
565 push(@l, $ind);
566 $level++;
567 }
568 elsif ($l[-1] > $ind) {
569 # if last level is more indented, decrease
570 # levels until the same is found (or back to
571 # the beginning if not)
572 while (pop(@l)) {
573 $level--;
574 last if $l[-1] == $ind;
575 }
576 }
577
578 $gh->{$str} = \@l;
579
580 return $level;
581 }
582
583
584 sub _unsorted_list
585 {
586 my ($gh, $ind) = @_;
587
588 return $gh->_ul($gh->_multilevel_list('-ul-levels', $ind));
589 }
590
591
592 sub _ordered_list
593 {
594 my ($gh, $ind) = @_;
595
596 return $gh->_ol($gh->_multilevel_list('-ol-levels', $ind));
597 }
598
599
600 # empty stubs for falling through the superclass
601
602 sub _inline { my ($gh, $l) = @_; $l; }
603 sub _escape { my ($gh, $l) = @_; $l; }
604 sub _escape_post { my ($gh, $l) = @_; $l; }
605 sub _empty_line { my ($gh) = @_; ''; }
606 sub _url { my ($gh, $url, $label) = @_; ''; }
607 sub _strong { my ($gh, $str) = @_; $str; }
608 sub _em { my ($gh, $str) = @_; $str; }
609 sub _code { my ($gh, $str) = @_; $str; }
610 sub _spanclass { my ($gh, $class, $str) = @_; $str; }
611 sub _divclassopen { my ($gh, $class) = @_; ''; }
612 sub _divclassclose { my ($gh) = @_; ''; }
613 sub _funcname { my ($gh, $str) = @_; $str; }
614 sub _varname { my ($gh, $str) = @_; $str; }
615 sub _new_mode { my ($gh, $mode) = @_; }
616 sub _dl { my ($gh, $str) = @_; $str; }
617 sub _ul { my ($gh, $level) = @_; ''; }
618 sub _ol { my ($gh, $level) = @_; ''; }
619 sub _blockquote { my ($gh, $str) = @_; $str; }
620 sub _hr { my ($gh) = @_; ''; }
621 sub _heading { my ($gh, $level, $l) = @_; $l; }
622 sub _table { my ($gh, $str) = @_; $str; }
623 sub _prefix { my ($gh) = @_; }
624 sub _postfix { my ($gh) = @_; }
625 sub _toc { my ($gh) = @_; return (); }
626
627 ###########################################################
628
629 =head1 DRIVER SPECIFIC INFORMATION
630
631 =cut
632
633 ###########################################################
634 # HTML Driver
635
636 package Grutatxt::HTML;
637
638 @ISA = ("Grutatxt");
639
640 =head2 HTML Driver
641
642 The additional parameters for a new Grutatxt object are:
643
644 =over 4
645
646 =item I<table-headers>
647
648 If this boolean value is set, the first row in tables
649 is assumed to be the heading and rendered using 'th'
650 instead of 'td' tags.
651
652 =item I<center-tables>
653
654 If this boolean value is set, tables are centered.
655
656 =item I<expand-tables>
657
658 If this boolean value is set, tables are expanded (width 100%).
659
660 =item I<dl-as-dl>
661
662 If this boolean value is set, definition lists will be
663 rendered using 'dl', 'dt' and 'dd' instead of tables.
664
665 =item I<header-offset>
666
667 Offset to be summed to the heading level when rendering
668 'h?' tags (default is 0).
669
670 =item I<class-oddeven>
671
672 If this boolean value is set, tables will be rendered
673 with an "oddeven" CSS class, and rows alternately classed
674 as "even" or "odd". If it's not set, no CSS class info
675 is added to tables.
676
677 =item I<url-label-max>
678
679 If an URL without label is given (that is, the URL itself
680 is used as the label), it's trimmed to have as much
681 characters as this value says. By default it's 80.
682
683 =back
684
685 =cut
686
687 sub new
688 {
689 my ($class, %args) = @_;
690 my ($gh);
691
692 bless(\%args, $class);
693 $gh = \%args;
694
695 $gh->{'-process-urls'} = 1;
696 $gh->{'url-label-max'} ||= 80;
697
698 return $gh;
699 }
700
701
702 sub _inline
703 {
704 my ($gh, $l) = @_;
705
706 # accept unnamed and HTML inlines
707 if ($l =~ /^<<$/ or $l =~ /^<<\s*html$/i) {
708 $gh->{'-inline'} = 'HTML';
709 return;
710 }
711
712 if ($l =~ /^>>$/) {
713 delete $gh->{'-inline'};
714 return;
715 }
716
717 if ($gh->{'-inline'} eq 'HTML') {
718 $gh->_push($l);
719 }
720 }
721
722
723 sub _escape
724 {
725 my ($gh, $l) = @_;
726
727 $l =~ s/&/&/g;
728 $l =~ s/</</g;
729 $l =~ s/>/>/g;
730
731 return $l;
732 }
733
734
735 sub _empty_line
736 {
737 my ($gh) = @_;
738
739 return('<p>');
740 }
741
742
743 sub _url
744 {
745 my ($gh, $url, $label) = @_;
746 my $more = '';
747
748 if (!$label) {
749 $label = $url;
750
751 if (length($label) > $gh->{'url-label-max'}) {
752 $label = substr($label, 0,
753 $gh->{'url-label-max'}) . '...';
754 }
755 }
756
757 if ($gh->{'href-new-window'}) {
758 $more = ' target="_blank"';
759 }
760
761 return "<a href=\"$url\"$more>$label</a>";
762 }
763
764
765 sub _strong
766 {
767 my ($gh, $str) = @_;
768 return "<strong>$str</strong>";
769 }
770
771
772 sub _em
773 {
774 my ($gh, $str) = @_;
775 return "<em>$str</em>";
776 }
777
778
779 sub _code
780 {
781 my ($gh, $str) = @_;
782 return "<code class='literal'>$str</code>";
783 }
784
785 sub _spanclass
786 {
787 my ($gh, $class, $str) = @_;
788 return "<span class=\"$class\">$str</span>";
789 }
790
791 sub _divclassopen
792 {
793 my ($gh, $class) = @_;
794 return "<div class=\"$class\">";
795 }
796
797 sub _divclassclose
798 {
799 my ($gh) = @_;
800 return "</div>";
801 }
802
803 sub _funcname
804 {
805 my ($gh, $str) = @_;
806 return "<code class='funcname'>$str</code>";
807 }
808
809
810 sub _varname
811 {
812 my ($gh, $str) = @_;
813 return "<code class='var'>$str</code>";
814 }
815
816
817 sub _new_mode
818 {
819 my ($gh, $mode, $params) = @_;
820
821 if ($mode ne $gh->{'-mode'}) {
822 my $tag;
823
824 # clean list levels
825 if ($gh->{'-mode'} eq 'ul') {
826 $gh->_push('</li>' . '</ul>' x scalar(@{$gh->{'-ul-levels'}}));
827 }
828 elsif ($gh->{'-mode'} eq 'ol') {
829 $gh->_push('</li>' . '</ol>' x scalar(@{$gh->{'-ol-levels'}}));
830 }
831 elsif ($gh->{'-mode'}) {
832 $gh->_push("</$gh->{'-mode'}>");
833 }
834
835 # send new one
836 $tag = $params ? "<$mode $params>" : "<$mode>";
837 $gh->_push($tag) if $mode;
838
839 $gh->{'-mode'} = $mode;
840 $gh->{'-mode-elems'} = 0;
841
842 # clean previous lists
843 $gh->{'-ul-levels'} = undef;
844 $gh->{'-ol-levels'} = undef;
845 }
846 }
847
848
849 sub _dl
850 {
851 my ($gh, $str) = @_;
852 my ($ret) = '';
853
854 if ($gh->{'dl-as-dl'}) {
855 $gh->_new_mode('dl');
856 $ret .= "<dt><strong class='term'>$str</strong><dd>";
857 }
858 else {
859 $gh->_new_mode('table');
860 $ret .= "<tr><td valign='top'><strong class='term'>$1</strong> </td><td valign='top'>";
861 }
862
863 return $ret;
864 }
865
866
867 sub _ul
868 {
869 my ($gh, $levels) = @_;
870 my ($ret);
871
872 $ret = '';
873
874 if ($levels > 0) {
875 $ret .= '<ul>';
876 }
877 elsif ($levels < 0) {
878 $ret .= '</li></ul>' x abs($levels);
879 }
880
881 if ($gh->{'-mode'} ne 'ul') {
882 $gh->{'-mode'} = 'ul';
883 }
884 else {
885 $ret .= '</li>' if $levels <= 0;
886 }
887
888 $ret .= '<li>';
889
890 return $ret;
891 }
892
893
894 sub _ol
895 {
896 my ($gh, $levels) = @_;
897 my ($ret);
898
899 $ret = '';
900
901 if ($levels > 0) {
902 $ret .= '<ol>';
903 }
904 elsif ($levels < 0) {
905 $ret .= '</li></ol>' x abs($levels);
906 }
907
908 if ($gh->{'-mode'} ne 'ol') {
909 $gh->{'-mode'} = 'ol';
910 }
911 else {
912 $ret .= '</li>' if $levels <= 0;
913 }
914
915 $ret .= '<li>';
916
917 return $ret;
918 }
919
920
921 sub _blockquote
922 {
923 my ($gh) = @_;
924
925 $gh->_new_mode('blockquote');
926 return "\"";
927 }
928
929
930 sub _hr
931 {
932 my ($gh) = @_;
933
934 return "<hr>";
935 }
936
937
938 sub __mkanchor
939 {
940 my $gh = shift;
941 my $a = shift;
942
943 $a =~ s/[^A-Za-z0-9_]+/-/g;
944 $a = lc($a);
945 $a =~ s/[\"\'\/]//g;
946 $a =~ s/\s/_/g;
947 $a =~ s/<[^>]+>//g;
948
949 return $a;
950 }
951
952
953 sub _heading
954 {
955 my ($gh, $level, $l, $title) = @_;
956
957 # creates a valid anchor
958 my $a = $gh->__mkanchor($l);
959
960 $l = sprintf(
961 "<a %s name='%s'></a>\n<h%d class='level$level'>%s</h%d>",
962 $title ? "class='title'" : '',
963 $a,
964 $level + $gh->{'header-offset'},
965 $l,
966 $level + $gh->{'header-offset'}
967 );
968
969 return $l;
970 }
971
972
973 sub _table
974 {
975 my ($gh, $str) = @_;
976
977 if ($gh->{'-mode'} eq 'table') {
978 my ($class) = '';
979 my (@spans) = $gh->_calc_col_span($str);
980
981 # calculate CSS class, if any
982 if ($gh->{'class-oddeven'}) {
983 $class = "class='" . ($gh->{'-tbl-row'} & 1) ? "odd'" : "even'";
984 }
985
986 $str = "<tr $class>";
987
988 # build columns
989 for (my $n = 0; $n < scalar(@{$gh->{'-table'}}); $n++) {
990 my ($i,$s);
991
992 $i = ${$gh->{'-table'}}[$n];
993 $i = " " if $i =~ /^\s*$/;
994
995 $s = " colspan='$spans[$n]'" if $spans[$n] > 1;
996
997 if ($gh->{'table-headers'} and $gh->{'-tbl-row'} == 1) {
998 $str .= "<th $class $s>$i</th>";
999 }
1000 else {
1001 $str .= "<td $class $s>$i</td>";
1002 }
1003 }
1004
1005 $str .= '</tr>';
1006
1007 @{$gh->{'-table'}} = ();
1008 $gh->{'-tbl-row'}++;
1009 }
1010 else {
1011 # new table
1012 my ($params);
1013
1014 $params = "border='1'";
1015 $params .= " width='100\%'" if $gh->{'expand-tables'};
1016 $params .= " align='center'" if $gh->{'center-tables'};
1017 $params .= " class='oddeven'" if $gh->{'class-oddeven'};
1018
1019 $gh->_new_mode('table', $params);
1020
1021 @{$gh->{'-table'}} = ();
1022 $gh->{'-tbl-row'} = 1;
1023 $str = '';
1024 }
1025
1026 return $str;
1027 }
1028
1029
1030 sub _toc
1031 {
1032 my $gh = shift;
1033 my @t = ();
1034
1035 push(@t, "<div class='TOC'>");
1036
1037 my $l = 0;
1038
1039 foreach my $e (@{$gh->{index}}) {
1040 # ignore level 1 headings
1041 if ($e->[0] == 1) {
1042 next;
1043 }
1044
1045 if ($l < $e->[0]) {
1046 push(@t, '<ol>');
1047 }
1048 elsif ($l > $e->[0]) {
1049 push(@t, '</ol>');
1050 }
1051
1052 $l = $e->[0];
1053
1054 push(@t, sprintf("<li><a href='#%s'>%s</a></li>",
1055 $gh->__mkanchor($e->[1]), $e->[1]));
1056 }
1057
1058 while (--$l) {
1059 push(@t, '</ol>');
1060 }
1061
1062 push(@t, "</div>");
1063
1064 return @t;
1065 }
1066
1067
1068 sub _postfix
1069 {
1070 my $gh = shift;
1071
1072 $gh->_push("<!-- grutatxt ${Grutatxt::VERSION} -->");
1073 }
1074
1075
1076 ###########################################################
1077 # troff Driver
1078
1079 package Grutatxt::troff;
1080
1081 @ISA = ("Grutatxt");
1082
1083 =head2 troff Driver
1084
1085 The troff driver uses the B<-me> macros and B<tbl>. A
1086 good way to post-process this output (to PostScript in
1087 the example) could be by using
1088
1089 groff -t -me -Tps
1090
1091 The additional parameters for a new Grutatxt object are:
1092
1093 =over 4
1094
1095 =item I<normal-size>
1096
1097 The point size of normal text. By default is 10.
1098
1099 =item I<heading-sizes>
1100
1101 This argument must be a reference to an array containing
1102 the size in points of the 3 different heading levels. By
1103 default, level sizes are [ 20, 18, 15 ].
1104
1105 =item I<table-type>
1106
1107 The type of table to be rendered by B<tbl>. Can be
1108 I<allbox> (all lines rendered; this is the default value),
1109 I<box> (only outlined) or I<doublebox> (only outlined by
1110 a double line).
1111
1112 =back
1113
1114 =cut
1115
1116 sub new
1117 {
1118 my ($class, %args) = @_;
1119 my ($gh);
1120
1121 bless(\%args,$class);
1122 $gh = \%args;
1123
1124 $gh->{'-process-urls'} = 0;
1125
1126 $gh->{'heading-sizes'} ||= [ 20, 18, 15 ];
1127 $gh->{'normal-size'} ||= 10;
1128 $gh->{'table-type'} ||= "allbox"; # box, allbox, doublebox
1129
1130 return $gh;
1131 }
1132
1133
1134 sub _prefix
1135 {
1136 my ($gh) = @_;
1137
1138 $gh->_push(".nr pp $gh->{'normal-size'}");
1139 $gh->_push(".nh");
1140 }
1141
1142
1143 sub _inline
1144 {
1145 my ($gh,$l) = @_;
1146
1147 # accept only troff inlines
1148 if ($l =~ /^<<\s*troff$/i) {
1149 $gh->{'-inline'} = 'troff';
1150 return;
1151 }
1152
1153 if ($l =~ /^>>$/) {
1154 delete $gh->{'-inline'};
1155 return;
1156 }
1157
1158 if ($gh->{'-inline'} eq 'troff') {
1159 $gh->_push($l);
1160 }
1161 }
1162
1163
1164 sub _escape
1165 {
1166 my ($gh,$l) = @_;
1167
1168 $l =~ s/\\/\\\\/g;
1169 $l =~ s/^'/\\&'/;
1170
1171 return $l;
1172 }
1173
1174
1175 sub _empty_line
1176 {
1177 my ($gh) = @_;
1178
1179 return '.lp';
1180 }
1181
1182
1183 sub _strong
1184 {
1185 my ($gh, $str) = @_;
1186 return "\\fB$str\\fP";
1187 }
1188
1189
1190 sub _em
1191 {
1192 my ($gh, $str) = @_;
1193 return "\\fI$str\\fP";
1194 }
1195
1196
1197 sub _code
1198 {
1199 my ($gh, $str) = @_;
1200 return "\\fI$str\\fP";
1201 }
1202
1203
1204 sub _funcname
1205 {
1206 my ($gh, $str) = @_;
1207 return "\\fB$str\\fP";
1208 }
1209
1210
1211 sub _varname
1212 {
1213 my ($gh, $str) = @_;
1214 return "\\fI$str\\fP";
1215 }
1216
1217
1218 sub _new_mode
1219 {
1220 my ($gh, $mode, $params) = @_;
1221
1222 if ($mode ne $gh->{'-mode'}) {
1223 my $tag;
1224
1225 # flush previous list
1226 if ($gh->{'-mode'} eq 'pre') {
1227 $gh->_push('.)l');
1228 }
1229 elsif ($gh->{'-mode'} eq 'table') {
1230 chomp($gh->{'-table-head'});
1231 $gh->{'-table-head'} =~ s/\s+$//;
1232 $gh->_push($gh->{'-table-head'} . '.');
1233 $gh->_push($gh->{'-table-body'} . '.TE\n.sp 0.6');
1234 }
1235 elsif ($gh->{'-mode'} eq 'blockquote') {
1236 $gh->_push('.)q');
1237 }
1238
1239 # send new one
1240 if ($mode eq 'pre') {
1241 $gh->_push('.(l L');
1242 }
1243 elsif ($mode eq 'blockquote') {
1244 $gh->_push('.(q');
1245 }
1246
1247 $gh->{'-mode'} = $mode;
1248 }
1249 }
1250
1251
1252 sub _dl
1253 {
1254 my ($gh, $str) = @_;
1255
1256 $gh->_new_mode('dl');
1257 return ".ip \"$str\"\n";
1258 }
1259
1260
1261 sub _ul
1262 {
1263 my ($gh) = @_;
1264
1265 $gh->_new_mode('ul');
1266 return ".bu\n";
1267 }
1268
1269
1270 sub _ol
1271 {
1272 my ($gh) = @_;
1273
1274 $gh->_new_mode('ol');
1275 return ".np\n";
1276 }
1277
1278
1279 sub _blockquote
1280 {
1281 my ($gh) = @_;
1282
1283 $gh->_new_mode('blockquote');
1284 return "\"";
1285 }
1286
1287
1288 sub _hr
1289 {
1290 my ($gh) = @_;
1291
1292 return '.hl';
1293 }
1294
1295
1296 sub _heading
1297 {
1298 my ($gh, $level, $l) = @_;
1299
1300 $l = '.sz ' . ${$gh->{'heading-sizes'}}[$level - 1] . "\n$l\n.sp 0.6";
1301
1302 return $l;
1303 }
1304
1305
1306 sub _table
1307 {
1308 my ($gh, $str) = @_;
1309
1310 if ($gh->{'-mode'} eq 'table') {
1311 my ($h, $b);
1312 my (@spans) = $gh->_calc_col_span($str);
1313
1314 # build columns
1315 $h = '';
1316 $b = '';
1317 for (my $n = 0; $n < scalar(@{$gh->{'-table'}}); $n++) {
1318 my ($i);
1319
1320 if ($gh->{'table-headers'} and $gh->{'-tbl-row'} == 1) {
1321 $h .= 'cB ';
1322 }
1323 else {
1324 $h .= 'l ';
1325 }
1326
1327 # add span columns
1328 $h .= 's ' x ($spans[$n] - 1) if $spans[$n] > 1;
1329
1330 $b .= '#' if $n;
1331
1332 $i = ${$gh->{'-table'}}[$n];
1333 $i =~ s/^\s+//;
1334 $i =~ s/\s+$//;
1335 $i =~ s/(\s)+/$1/g;
1336 $b .= $i;
1337 }
1338
1339 # add a separator
1340 $b .= "\n_" if $gh->{'table-headers'} and
1341 $gh->{'-tbl-row'} == 1 and
1342 $gh->{'table-type'} ne "allbox";
1343
1344 $gh->{'-table-head'} .= "$h\n";
1345 $gh->{'-table-body'} .= "$b\n";
1346
1347 @{$gh->{'-table'}} = ();
1348 $gh->{'-tbl-row'}++;
1349 }
1350 else {
1351 # new table
1352 $gh->_new_mode('table');
1353
1354 @{$gh->{'-table'}} = ();
1355 $gh->{'-tbl-row'} = 1;
1356
1357 $gh->{'-table-head'} = ".TS\n$gh->{'table-type'} tab (#);\n";
1358 $gh->{'-table-body'} = '';
1359 }
1360
1361 $str = '';
1362 return $str;
1363 }
1364
1365
1366 sub _postfix
1367 {
1368 my ($gh) = @_;
1369
1370 # add to top headings and footers
1371 unshift(@{$gh->{'o'}},".ef '\%' ''");
1372 unshift(@{$gh->{'o'}},".of '' '\%'");
1373 unshift(@{$gh->{'o'}},".eh '$gh->{'-title'}' ''");
1374 unshift(@{$gh->{'o'}},".oh '' '$gh->{'-title'}'");
1375 }
1376
1377
1378 ###########################################################
1379 # man Driver
1380
1381 package Grutatxt::man;
1382
1383 @ISA = ("Grutatxt::troff", "Grutatxt");
1384
1385 =head2 man Driver
1386
1387 The man driver is used to generate Unix-like man pages. Note that
1388 all headings have the same level with this output driver.
1389
1390 The additional parameters for a new Grutatxt object are:
1391
1392 =over 4
1393
1394 =item I<section>
1395
1396 The man page section (see man documentation). By default is 1.
1397
1398 =item I<page-name>
1399
1400 The name of the page. This is usually the name of the program
1401 or function the man page is documenting and will be shown in the
1402 page header. By default is the empty string.
1403
1404 =back
1405
1406 =cut
1407
1408 sub new
1409 {
1410 my ($class, %args) = @_;
1411 my ($gh);
1412
1413 bless(\%args,$class);
1414 $gh = \%args;
1415
1416 $gh->{'-process-urls'} = 0;
1417
1418 $gh->{'section'} ||= 1;
1419 $gh->{'page-name'} ||= "";
1420
1421 return $gh;
1422 }
1423
1424
1425 sub _prefix
1426 {
1427 my ($gh) = @_;
1428
1429 $gh->_push(".TH \"$gh->{'page-name'}\" \"$gh->{'section'}\" \"" . localtime() . "\"");
1430 }
1431
1432
1433 sub _inline
1434 {
1435 my ($gh, $l) = @_;
1436
1437 # accept only man markup inlines
1438 if ($l =~ /^<<\s*man$/i) {
1439 $gh->{'-inline'} = 'man';
1440 return;
1441 }
1442
1443 if ($l =~ /^>>$/) {
1444 delete $gh->{'-inline'};
1445 return;
1446 }
1447
1448 if ($gh->{'-inline'} eq 'man') {
1449 $gh->_push($l);
1450 }
1451 }
1452
1453
1454 sub _empty_line
1455 {
1456 my ($gh) = @_;
1457
1458 return ' ';
1459 }
1460
1461
1462 sub _new_mode
1463 {
1464 my ($gh,$mode,$params) = @_;
1465
1466 if ($mode ne $gh->{'-mode'}) {
1467 my $tag;
1468
1469 # flush previous list
1470 if ($gh->{'-mode'} eq 'pre' or
1471 $gh->{'-mode'} eq 'table') {
1472 $gh->_push('.fi');
1473 }
1474
1475 if ($gh->{'-mode'} eq 'blockquote') {
1476 $gh->_push('.RE');
1477 }
1478
1479 if ($gh->{'-mode'} eq 'ul') {
1480 $gh->_push(".RE\n" x scalar(@{$gh->{'-ul-levels'}}));
1481 }
1482
1483 if ($gh->{'-mode'} eq 'ol') {
1484 $gh->_push(".RE\n" x scalar(@{$gh->{'-ol-levels'}}));
1485 }
1486
1487 # send new one
1488 if ($mode eq 'pre' or $mode eq 'table') {
1489 $gh->_push('.nf');
1490 }
1491
1492 if ($mode eq 'blockquote') {
1493 $gh->_push('.RS 4');
1494 }
1495
1496 $gh->{'-mode'} = $mode;
1497 }
1498 }
1499
1500
1501 sub _dl
1502 {
1503 my ($gh, $str) = @_;
1504
1505 $gh->_new_mode('dl');
1506 return ".TP\n.B \"$str\"\n";
1507 }
1508
1509
1510 sub _ul
1511 {
1512 my ($gh, $levels) = @_;
1513 my ($ret) = '';
1514
1515 if ($levels > 0) {
1516 $ret = ".RS 4\n";
1517 }
1518 elsif ($levels < 0) {
1519 $ret = ".RE\n" x abs($levels);
1520 }
1521
1522 $gh->_new_mode('ul');
1523 return $ret . ".TP 4\n\\(bu\n";
1524 }
1525
1526
1527 sub _ol
1528 {
1529 my ($gh, $levels) = @_;
1530 my $l = @{$gh->{'-ol-levels'}};
1531 my $ret = '';
1532
1533 $gh->{'-ol-level'} += $levels;
1534
1535 if ($levels > 0) {
1536 $ret = ".RS 4\n";
1537
1538 $l[$gh->{'-ol-level'}] = 1;
1539 }
1540 elsif ($levels < 0) {
1541 $ret = ".RE\n" x abs($levels);
1542 }
1543
1544 $gh->_new_mode('ol');
1545 $ret .= ".TP 4\n" . $l[$gh->{'-ol-level'}]++ . ".\n";
1546
1547 return $ret;
1548 }
1549
1550
1551 sub _hr
1552 {
1553 my ($gh) = @_;
1554
1555 return '';
1556 }
1557
1558
1559 sub _heading
1560 {
1561 my ($gh, $level, $l) = @_;
1562
1563 # all headers are the same depth in man pages
1564 return ".SH \"" . uc($l) . "\"";
1565 }
1566
1567
1568 sub _table
1569 {
1570 my ($gh, $str) = @_;
1571
1572 if ($gh->{'-mode'} eq 'table') {
1573 foreach my $r (@{$gh->{'-table-raw'}}) {
1574 $gh->_push("|$r|");
1575 }
1576 }
1577 else {
1578 $gh->_new_mode('table');
1579 }
1580
1581 @{$gh->{'-table'}} = ();
1582 @{$gh->{'-table-raw'}} = ();
1583
1584 $gh->_push($str);
1585
1586 return '';
1587 }
1588
1589
1590 sub _postfix
1591 {
1592 }
1593
1594
1595 ###########################################################
1596 # latex Driver
1597
1598 package Grutatxt::latex;
1599
1600 @ISA = ("Grutatxt");
1601
1602 =head2 LaTeX Driver
1603
1604 The additional parameters for a new Grutatxt object are:
1605
1606 =over 4
1607
1608 =item I<docclass>
1609
1610 The LaTeX document class. By default is 'report'. You can also use
1611 'article' or 'book' (consult your LaTeX documentation for details).
1612
1613 =item I<papersize>
1614
1615 The paper size to be used in the document. By default is 'a4paper'.
1616
1617 =item I<encoding>
1618
1619 The character encoding used in the document. By default is 'latin1'.
1620
1621 =back
1622
1623 Note that you can't nest further than 4 levels in LaTeX; if you do,
1624 LaTeX will choke in the generated code with a 'Too deeply nested' error.
1625
1626 =cut
1627
1628 sub new
1629 {
1630 my ($class, %args) = @_;
1631 my ($gh);
1632
1633 bless(\%args,$class);
1634 $gh = \%args;
1635
1636 $gh->{'-process-urls'} = 0;
1637
1638 $gh->{'-docclass'} ||= 'report';
1639 $gh->{'-papersize'} ||= 'a4paper';
1640 $gh->{'-encoding'} ||= 'latin1';
1641
1642 return $gh;
1643 }
1644
1645
1646 sub _prefix
1647 {
1648 my ($gh) = @_;
1649
1650 if ($gh->{'no-pure-verbatim'}) {
1651 $gh->_push("\\usepackage{alttt}");
1652 }
1653
1654 $gh->_push("\\documentclass[$gh->{'-papersize'}]{$gh->{-docclass}}");
1655 $gh->_push("\\usepackage[$gh->{'-encoding'}]{inputenc}");
1656
1657 $gh->_push("\\begin{document}");
1658 }
1659
1660
1661 sub _inline
1662 {
1663 my ($gh, $l) = @_;
1664
1665 # accept only latex inlines
1666 if ($l =~ /^<<\s*latex$/i) {
1667 $gh->{'-inline'} = 'latex';
1668 return;
1669 }
1670
1671 if ($l =~ /^>>$/) {
1672 delete $gh->{'-inline'};
1673 return;
1674 }
1675
1676 if ($gh->{'-inline'} eq 'latex') {
1677 $gh->_push($l);
1678 }
1679 }
1680
1681
1682 sub _escape
1683 {
1684 my ($gh, $l) = @_;
1685
1686 $l =~ s/ _ / \\_ /g;
1687 $l =~ s/ ~ / \\~ /g;
1688 $l =~ s/ & / \\& /g;
1689
1690 return $l;
1691 }
1692
1693
1694 sub _escape_post
1695 {
1696 my ($gh, $l) = @_;
1697
1698 $l =~ s/ # / \\# /g;
1699 $l =~ s/^\\n$//g;
1700 $l =~ s/([^\s_])_([^\s_])/$1\\_$2/g;
1701
1702 return $l;
1703 }
1704
1705
1706 sub _empty_line
1707 {
1708 my ($gh) = @_;
1709
1710 return "\\n";
1711 }
1712
1713
1714 sub _strong
1715 {
1716 my ($gh, $str) = @_;
1717 return "\\textbf{$str}";
1718 }
1719
1720
1721 sub _em
1722 {
1723 my ($gh, $str) = @_;
1724 return "\\emph{$str}";
1725 }
1726
1727
1728 sub _code
1729 {
1730 my ($gh, $str) = @_;
1731 return "{\\tt $str}";
1732 }
1733
1734
1735 sub _funcname
1736 {
1737 my ($gh, $str) = @_;
1738 return "{\\tt $str}";
1739 }
1740
1741
1742 sub _varname
1743 {
1744 my ($gh, $str) = @_;
1745
1746 $str =~ s/^\$/\\\$/;
1747
1748 return "{\\tt $str}";
1749 }
1750
1751
1752 sub _new_mode
1753 {
1754 my ($gh, $mode, $params) = @_;
1755
1756 # mode equivalences
1757 my %latex_modes = (
1758 'pre' => $gh->{'no-pure-verbatim'} ? 'alttt' : 'verbatim',
1759 'blockquote' => 'quote',
1760 'table' => 'tabular',
1761 'dl' => 'description',
1762 'ul' => 'itemize',
1763 'ol' => 'enumerate'
1764 );
1765
1766 if ($mode ne $gh->{'-mode'}) {
1767 # close previous mode
1768 if ($gh->{'-mode'} eq 'ul') {
1769 $gh->_push("\\end{itemize}" x scalar(@{$gh->{'-ul-levels'}}));
1770 }
1771 elsif ($gh->{'-mode'} eq 'ol') {
1772 $gh->_push("\\end{enumerate}" x scalar(@{$gh->{'-ol-levels'}}));
1773 }
1774 elsif ($gh->{'-mode'} eq 'table') {
1775 $gh->_push("\\end{tabular}\n");
1776 }
1777 else {
1778 $gh->_push("\\end{" . $latex_modes{$gh->{'-mode'}} . "}")
1779 if $gh->{'-mode'};
1780 }
1781
1782 # send new one
1783 $gh->_push("\\begin{" . $latex_modes{$mode} . "}" . $params)
1784 if $mode;
1785
1786 $gh->{'-mode'} = $mode;
1787
1788 $gh->{'-ul-levels'} = undef;
1789 $gh->{'-ol-levels'} = undef;
1790 }
1791 }
1792
1793
1794 sub _dl
1795 {
1796 my ($gh, $str) = @_;
1797
1798 $gh->_new_mode('dl');
1799 return "\\item[$str]\n";
1800 }
1801
1802
1803 sub _ul
1804 {
1805 my ($gh, $levels) = @_;
1806 my ($ret);
1807
1808 $ret = '';
1809
1810 if ($levels > 0) {
1811 $ret .= "\\begin{itemize}\n";
1812 }
1813 elsif ($levels < 0) {
1814 $ret .= "\\end{itemize}\n" x abs($levels);
1815 }
1816
1817 $gh->{'-mode'} = 'ul';
1818
1819 $ret .= "\\item\n";
1820
1821 return $ret;
1822 }
1823
1824
1825 sub _ol
1826 {
1827 my ($gh, $levels) = @_;
1828 my ($ret);
1829
1830 $ret = '';
1831
1832 if ($levels > 0) {
1833 $ret .= "\\begin{enumerate}\n";
1834 }
1835 elsif ($levels < 0) {
1836 $ret .= "\\end{enumerate}\n" x abs($levels);
1837 }
1838
1839 $gh->{'-mode'} = 'ol';
1840
1841 $ret .= "\\item\n";
1842
1843 return $ret;
1844 }
1845
1846
1847 sub _blockquote
1848 {
1849 my ($gh) = @_;
1850
1851 $gh->_new_mode('blockquote');
1852 return "``";
1853 }
1854
1855
1856 sub _hr
1857 {
1858 my ($gh) = @_;
1859
1860 return "------------\n";
1861 }
1862
1863
1864 sub _heading
1865 {
1866 my ($gh, $level, $l) = @_;
1867
1868 my @latex_headings = ( "\\section*{", "\\subsection*{",
1869 "\\subsubsection*{");
1870
1871 $l = "\n" . $latex_headings[$level - 1] . $l . "}";
1872
1873 return $l;
1874 }
1875
1876
1877 sub _table
1878 {
1879 my ($gh,$str) = @_;
1880
1881 if ($gh->{'-mode'} eq 'table') {
1882 my ($class) = '';
1883 my (@spans) = $gh->_calc_col_span($str);
1884 my (@cols);
1885
1886 $str = '';
1887
1888 # build columns
1889 for (my $n = 0; $n < scalar(@{$gh->{'-table'}}); $n++) {
1890 my ($i, $s);
1891
1892 $i = ${$gh->{'-table'}}[$n];
1893 $i = " " if $i =~ /^\s*$/;
1894
1895 # $s = " colspan='$spans[$n]'" if $spans[$n] > 1;
1896
1897 # multispan columns
1898 $i = "\\multicolumn{$spans[$n]}{|l|}{$i}"
1899 if $spans[$n] > 1;
1900
1901 $i =~ s/\s{2,}/ /g;
1902 $i =~ s/^\s+//;
1903 $i =~ s/\s+$//;
1904
1905 push(@cols, $i);
1906 }
1907
1908 $str .= join('&', @cols) . "\\\\\n\\hline";
1909
1910 # $str .= "\n\\hline" if $gh->{'-tbl-row'} == 1;
1911
1912 @{$gh->{'-table'}} = ();
1913 $gh->{'-tbl-row'}++;
1914 }
1915 else {
1916 # new table
1917
1918 # count the number of columns
1919 $str =~ s/[^\+]//g;
1920 my $params = "{" . "|l" x (length($str) - 1) . "|}\n\\hline";
1921
1922 $gh->_push();
1923 $gh->_new_mode('table', $params);
1924
1925 @{$gh->{'-table'}} = ();
1926 $gh->{'-tbl-row'} = 1;
1927 $str = '';
1928 }
1929
1930 return $str;
1931 }
1932
1933
1934 sub _postfix
1935 {
1936 my ($gh) = @_;
1937
1938 $gh->_push("\\end{document}");
1939 }
1940
1941
1942 ###########################################################
1943 # RTF Driver
1944
1945 package Grutatxt::rtf;
1946
1947 @ISA = ("Grutatxt");
1948
1949 =head2 RTF Driver
1950
1951 The additional parameters for a new Grutatxt object are:
1952
1953 =over 4
1954
1955 =item I<normal-size>
1956
1957 The point size of normal text. By default is 20.
1958
1959 =item I<heading-sizes>
1960
1961 This argument must be a reference to an array containing
1962 the size in points of the 3 different heading levels. By
1963 default, level sizes are [ 34, 30, 28 ].
1964
1965 =back
1966
1967 =cut
1968
1969 sub new
1970 {
1971 my ($class, %args) = @_;
1972 my ($gh);
1973
1974 bless(\%args, $class);
1975 $gh = \%args;
1976
1977 $gh->{'-process-urls'} = 0;
1978
1979 $gh->{'heading-sizes'} ||= [ 34, 30, 28 ];
1980 $gh->{'normal-size'} ||= 20;
1981
1982 return $gh;
1983 }
1984
1985
1986 sub _prefix
1987 {
1988 my $gh = shift;
1989
1990 $gh->_push('{\rtf1\ansi {\plain \fs' . $gh->{'normal-size'} . ' \sa227');
1991 }
1992
1993
1994 sub _empty_line
1995 {
1996 my $gh = shift;
1997
1998 return '\par';
1999 }
2000
2001
2002 sub _heading
2003 {
2004 my ($gh, $level, $l) = @_;
2005
2006 return '{\b \fs' . $gh->{'heading-sizes'}->[$level] . ' ' . $l . '}';
2007 }
2008
2009
2010 sub _strong
2011 {
2012 my ($gh, $str) = @_;
2013 return "{\\b $str}";
2014 }
2015
2016
2017 sub _em
2018 {
2019 my ($gh, $str) = @_;
2020 return "{\\i $str}";
2021 }
2022
2023
2024 sub _code
2025 {
2026 my ($gh, $str) = @_;
2027 return "{\\tt $str}";
2028 }
2029
2030
2031 sub _ul
2032 {
2033 my ($gh, $levels) = @_;
2034
2035 $gh->_new_mode('ul');
2036 return "{{\\bullet \\li" . $levels . ' ';
2037 }
2038
2039
2040 sub _dl
2041 {
2042 my ($gh, $str) = @_;
2043
2044 $gh->_new_mode('dl');
2045 return "{{\\b $str \\par} {\\li566 ";
2046 }
2047
2048
2049 sub _new_mode
2050 {
2051 my ($gh, $mode, $params) = @_;
2052
2053 if ($mode ne $gh->{'-mode'}) {
2054 if ($gh->{'-mode'} =~ /^(dl|ul)$/) {
2055 $gh->_push('}}');
2056 }
2057
2058 $gh->{'-mode'} = $mode;
2059
2060 $gh->{'-ul-levels'} = undef;
2061 $gh->{'-ol-levels'} = undef;
2062 }
2063 else {
2064 if ($mode =~ /^(dl|ul)$/) {
2065 $gh->_push('}\par}');
2066 }
2067 }
2068 }
2069
2070
2071 sub _postfix
2072 {
2073 my $gh = shift;
2074
2075 @{$gh->{o}} = map { $_ . ' '; } @{$gh->{o}};
2076
2077 $gh->_push('}}');
2078 }
2079
2080
2081 =head1 AUTHOR
2082
2083 Angel Ortega angel@triptico.com et al.
2084
2085 =cut
2086
2087 1;