[ViewVC] Annotation of: cvs/deliantra/Deliantra-Client/bin/pod2wiki

#! perl

use Storable;

# convert given .pod files to wiki style

use strict;

use Pod::POM;

our @result;
our $indent;
our $level;

my $MA_BEG = "\x{fcd0}";
my $MA_SEP = "\x{fcd1}";
my $MA_END = "\x{fcd2}";

sub asxml($) {
   local $_ = $_[0];

   s/&/&amp;/g;
   s/>/&gt;/g;
   s/</&lt;/g;

   $_
}

sub flatten($) {
   local $_ = $_[0];

   s/<[^>]+>//g;
   s/^\s+//;
   s/\s+$//;
   s/\s+/ /g;

   $_
}

package AsParagraphs;

use strict;

use base "Pod::POM::View";

*view_seq_file   =
*view_seq_code   =
*view_seq_bold   = sub { "<b>$_[1]</b>" };
*view_seq_italic = sub { "<i>$_[1]</i>" };
*view_seq_zero   = sub { };
*view_seq_space  = sub { my $text = $_[1]; $text =~ s/ /&#160;/g; $text };
*view_seq_index  = sub { push @{ $result[-1]{index} }, $_[1]; "" };

sub view_seq_text {
   my $text = $_[1];
   $text =~ s/\s+/ /g;
   ::asxml $text
}

sub view_seq_link {
   my (undef, $link) = @_;

   my $text = $link =~ s/^(.*)\|// ? $1 : $link;

   if ($link =~ /http:/) {
      "<u>" . (::asxml $link) . "</u>"
   } else {
      "${MA_BEG}link$MA_SEP$text$MA_SEP$link$MA_END"
   }
}

sub view_item {
   push @result, {
      indent => $indent * 8,
      level  => $level,
   };
   my $title = $_[1]->title->present ($_[0]);
   $result[-1]{markup} = "$title\n\n" if length $title;
   $title = ::flatten $title; unshift @{ $result[-1]{index} }, $title if length $title;
   local $level = $level + 1;
   $_[1]->content->present ($_[0]);
   ()
}

sub view_verbatim {
   push @result, {
      indent => $indent * 16,
      level  => $level,
      markup => "<tt>" . (::asxml $_[1]) . "</tt>\n",
   };
   ()
}

sub view_textblock {
   push @result, {
      indent => $indent * 16,
      level  => $level,
      markup => "$_[1]\n",
   };
   ()
}

sub view_head1 {
   push @result, {
      indent => $indent * 16,
      level  => $level,
   };
   my $title = $_[1]->title->present ($_[0]);
   $result[-1]{markup} = "\n\n<span foreground='#ffff00' size='x-large'>$title</span>\n" if length $title;
   $title = ::flatten $title; unshift @{ $result[-1]{index} }, $title if length $title;
   local $level = $level + 1;
   $_[1]->content->present ($_[0]);
   ()
};

sub view_head2 {
   push @result, {
      indent => $indent * 16,
      level  => $level,
   };
   my $title = $_[1]->title->present ($_[0]);
   $result[-1]{markup} = "\n\n<span foreground='#ccccff' size='large'>$title</span>\n" if length $title;
   $title = ::flatten $title; unshift @{ $result[-1]{index} }, $title if length $title;
   local $level = $level + 1;
   $_[1]->content->present ($_[0]);
   ()
};

sub view_head3 {
   push @result, {
      indent => $indent * 16,
      level  => $level,
   };
   my $title = $_[1]->title->present ($_[0]);
   $result[-1]{markup} = "\n\n<span size='large'>$title</span>\n" if length $title;
   $title = ::flatten $title; unshift @{ $result[-1]{index} }, $title if length $title;
   local $level = $level + 1;
   $_[1]->content->present ($_[0]);
   ()
};

sub view_over {
   local $indent = $indent + $_[1]->indent;
   push @result, { indent => $indent };
   $_[1]->content->present ($_[0]);
   ()
}

sub view_for {
   if ($_[1]->format eq "image") {
      push @result, {
         indent => $indent * 16,
         level  => $level,
         markup => "${MA_BEG}image${MA_SEP}pod/" . $_->text . $MA_END,
      };
   }
   ()
}

sub view {
   my ($self, $type, $item) = @_;

   $item->content->present ($self);
}

#############################################################################

sub as_paragraphs($) {
   my ($pom) = @_;

   local $indent = 0;
   local $level  = 1;
   local @result = ( { } );

   $pom->present ("AsParagraphs");

   [grep $_->{index} || exists $_->{markup}, @result]
}

#############################################################################

my %wiki;

sub add_node($) {
   my ($node) = @_;

   for (@{ $node->{kw} || {} }) {
      push @{$wiki{$_}}, $node;
   }
}

my $root = {
   kw => ["pod"],
};

for my $path (@ARGV) {
   $path =~ /([^\/\\]+)\.pod$/ or die "$path: illegal pathname";
   my $base = $1;
   my $pom = Pod::POM->new->parse_text (do {
      local $/;
      open my $pod, "<:utf8", $path
         or die "$path: $!";
      <$pod>
   });

   my $para = as_paragraphs $pom;

   my @parent = (
      { parent => $root, kw => [$base], doc => $para, par => 0, level => 0 },
   );
   add_node $parent[-1];

   for my $idx (0 .. $#$para) {
      my $par = $para->[$idx];

      while ($parent[-1]{level} >= $par->{level}) {
         pop @parent;
      }

      if ($par->{index}) {
         my $node = {
            kw     => $par->{index},
            parent => $parent[-1],
            doc    => $para,
            par    => $idx,
            level  => $par->{level},
         };
         push @parent, $node;
         add_node $node;
      }
   }
}

Storable::nstore \%wiki, "docwiki.pst";

Revision:	1.4
Committed:	Sun Aug 13 19:47:06 2006 UTC (17 years, 10 months ago) by root
Branch:	MAIN
Changes since 1.3:	+3 -1 lines
Log Message:	docviewer psrtial rewrite
#	User	Rev	Content
1	root	1.1	#! perl
2
3			use Storable;
4
5			# convert given .pod files to wiki style
6
7			use strict;
8
9			use Pod::POM;
10
11			our @result;
12			our $indent;
13			our $level;
14
15	root	1.3	my $MA_BEG = "\x{fcd0}";
16			my $MA_SEP = "\x{fcd1}";
17			my $MA_END = "\x{fcd2}";
18
19	root	1.1	sub asxml($) {
20			local $_ = $_[0];
21
22			s/&/&/g;
23			s/>/>/g;
24			s/</</g;
25
26			$_
27			}
28
29			sub flatten($) {
30			local $_ = $_[0];
31
32			s/<[^>]+>//g;
33			s/^\s+//;
34			s/\s+$//;
35			s/\s+/ /g;
36
37			$_
38			}
39
40			package AsParagraphs;
41
42			use strict;
43
44			use base "Pod::POM::View";
45
46			*view_seq_file =
47			*view_seq_code =
48			*view_seq_bold = sub { "<b>$_[1]</b>" };
49			*view_seq_italic = sub { "<i>$_[1]</i>" };
50			*view_seq_zero = sub { };
51			*view_seq_space = sub { my $text = $_[1]; $text =~ s/ / /g; $text };
52			*view_seq_index = sub { push @{ $result[-1]{index} }, $_[1]; "" };
53
54			sub view_seq_text {
55			my $text = $_[1];
56			$text =~ s/\s+/ /g;
57			::asxml $text
58			}
59
60			sub view_seq_link {
61			my (undef, $link) = @_;
62
63	root	1.4	my $text = $link =~ s/^(.*)\\|// ? $1 : $link;
64
65	root	1.3	if ($link =~ /http:/) {
66			"<u>" . (::asxml $link) . "</u>"
67			} else {
68	root	1.4	"${MA_BEG}link$MA_SEP$text$MA_SEP$link$MA_END"
69	root	1.3	}
70	root	1.1	}
71
72			sub view_item {
73			push @result, {
74			indent => $indent * 8,
75			level => $level,
76			};
77			my $title = $_[1]->title->present ($_[0]);
78	root	1.2	$result[-1]{markup} = "$title\n\n" if length $title;
79			$title = ::flatten $title; unshift @{ $result[-1]{index} }, $title if length $title;
80	root	1.1	local $level = $level + 1;
81			$_[1]->content->present ($_[0]);
82			()
83			}
84
85			sub view_verbatim {
86			push @result, {
87			indent => $indent * 16,
88			level => $level,
89			markup => "<tt>" . (::asxml $_[1]) . "</tt>\n",
90			};
91			()
92			}
93
94			sub view_textblock {
95			push @result, {
96			indent => $indent * 16,
97			level => $level,
98			markup => "$_[1]\n",
99			};
100			()
101			}
102
103			sub view_head1 {
104			push @result, {
105			indent => $indent * 16,
106			level => $level,
107			};
108			my $title = $_[1]->title->present ($_[0]);
109	root	1.2	$result[-1]{markup} = "\n\n<span foreground='#ffff00' size='x-large'>$title</span>\n" if length $title;
110			$title = ::flatten $title; unshift @{ $result[-1]{index} }, $title if length $title;
111	root	1.1	local $level = $level + 1;
112			$_[1]->content->present ($_[0]);
113			()
114			};
115
116			sub view_head2 {
117			push @result, {
118			indent => $indent * 16,
119			level => $level,
120			};
121			my $title = $_[1]->title->present ($_[0]);
122	root	1.2	$result[-1]{markup} = "\n\n<span foreground='#ccccff' size='large'>$title</span>\n" if length $title;
123			$title = ::flatten $title; unshift @{ $result[-1]{index} }, $title if length $title;
124	root	1.1	local $level = $level + 1;
125			$_[1]->content->present ($_[0]);
126			()
127			};
128
129			sub view_head3 {
130			push @result, {
131			indent => $indent * 16,
132			level => $level,
133			};
134			my $title = $_[1]->title->present ($_[0]);
135	root	1.2	$result[-1]{markup} = "\n\n<span size='large'>$title</span>\n" if length $title;
136			$title = ::flatten $title; unshift @{ $result[-1]{index} }, $title if length $title;
137	root	1.1	local $level = $level + 1;
138			$_[1]->content->present ($_[0]);
139			()
140			};
141
142			sub view_over {
143			local $indent = $indent + $_[1]->indent;
144			push @result, { indent => $indent };
145			$_[1]->content->present ($_[0]);
146			()
147			}
148
149			sub view_for {
150			if ($_[1]->format eq "image") {
151			push @result, {
152			indent => $indent * 16,
153			level => $level,
154	root	1.3	markup => "${MA_BEG}image${MA_SEP}pod/" . $_->text . $MA_END,
155	root	1.1	};
156			}
157			()
158			}
159
160			sub view {
161			my ($self, $type, $item) = @_;
162
163			$item->content->present ($self);
164			}
165
166			#############################################################################
167
168			sub as_paragraphs($) {
169			my ($pom) = @_;
170
171			local $indent = 0;
172			local $level = 1;
173	root	1.2	local @result = ( { } );
174	root	1.1
175			$pom->present ("AsParagraphs");
176
177	root	1.2	[grep $_->{index} \|\| exists $_->{markup}, @result]
178	root	1.1	}
179
180			#############################################################################
181
182			my %wiki;
183
184			sub add_node($) {
185			my ($node) = @_;
186
187			for (@{ $node->{kw} \|\| {} }) {
188			push @{$wiki{$_}}, $node;
189			}
190			}
191
192			my $root = {
193			kw => ["pod"],
194			};
195
196			for my $path (@ARGV) {
197			$path =~ /([^\/\\]+)\.pod$/ or die "$path: illegal pathname";
198			my $base = $1;
199			my $pom = Pod::POM->new->parse_text (do {
200			local $/;
201			open my $pod, "<:utf8", $path
202			or die "$path: $!";
203			<$pod>
204			});
205
206			my $para = as_paragraphs $pom;
207
208			my @parent = (
209			{ parent => $root, kw => [$base], doc => $para, par => 0, level => 0 },
210			);
211			add_node $parent[-1];
212
213			for my $idx (0 .. $#$para) {
214			my $par = $para->[$idx];
215
216			while ($parent[-1]{level} >= $par->{level}) {
217			pop @parent;
218			}
219
220			if ($par->{index}) {
221			my $node = {
222			kw => $par->{index},
223			parent => $parent[-1],
224			doc => $para,
225			par => $idx,
226			level => $par->{level},
227			};
228			push @parent, $node;
229			add_node $node;
230			}
231			}
232			}
233
234			Storable::nstore \%wiki, "docwiki.pst";
235