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

#! perl

# convert given .pod files to wiki style

# base path of arch tree, only used for new arch graphics
my $ARCH = "/root/devel/cvs/cf.schmorp.de/arch";

use strict;

use Storable;
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;

   $_
}

sub special {
   $MA_BEG . (join $MA_SEP, @_) . $MA_END
}

package AsParagraphs;

use strict;

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

# nodes (order must stay as it is)
sub N_PARENT (){ 0 }
sub N_PAR    (){ 1 }
sub N_LEVEL  (){ 2 }
sub N_KW     (){ 3 }
sub N_DOC    (){ 4 }

# paragraphs (order must stay as it is)
sub P_INDENT (){ 0 }
sub P_LEVEL  (){ 1 }
sub P_MARKUP (){ 2 }
sub P_INDEX  (){ 3 }

*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][P_INDEX] }, $_[1]; "" };

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

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

   $link =~ s/^(.*)\|//
      or $link =~ /([^\/]*)$/;

   my $text = $1;

   if ($link =~ /http:/) {
      "<u>" . (::asxml $link) . "</u>"
   } elsif ($link =~ /^\$ARCH\/(.+)$/) {
      my $path = $1;
      (my $base = $path) =~ s/.*\///;
      -f "$ARCH/$path" && system "rsync -av -c \Q$ARCH/$path\E \Qresources/arch/$base";
      ::special image => "arch/$base", 1;
   } else {
      ::special link => $text, $link
   }
}

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

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

sub view_head1 {
   push @result, [ $indent * 16, $level ];
   my $title = $_[1]->title->present ($_[0]);
   $result[-1][P_MARKUP] = ::special h1 => $title if length $title;
   $title = ::flatten $title;
   unshift @{ $result[-1][P_INDEX] }, $title
      if !$result[-1][P_INDEX];
   local $level = $level + 1;
   $_[1]->content->present ($_[0]);
   ()
};

sub view_head2 {
   push @result, [ $indent * 16, $level ];
   my $title = $_[1]->title->present ($_[0]);
   $result[-1][P_MARKUP] = ::special h2 => $title if length $title;
   $title = ::flatten $title;
   unshift @{ $result[-1][P_INDEX] }, $title
      if !$result[-1][P_INDEX];
   local $level = $level + 1;
   $_[1]->content->present ($_[0]);
   ()
};

sub view_head3 {
   push @result, [ $indent * 16, $level ];
   my $title = $_[1]->title->present ($_[0]);
   $result[-1][P_MARKUP] = ::special h3 => $title if length $title;
   $title = ::flatten $title;
   unshift @{ $result[-1][P_INDEX] || [] }, $title
      if !$result[-1][P_INDEX];
   local $level = $level + 1;
   $_[1]->content->present ($_[0]);
   ()
};

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

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

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

sub view_begin {
   ()
}

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

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

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

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

   local $indent = 0;
   local $level  = 2;
   local @result = ( [] );

   $pom->present ("AsParagraphs");

   [grep $_->[P_INDEX] || defined $_->[P_MARKUP], @result]
}

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

my %wiki;

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

   for (@{ $node->[N_KW] || {} }) {
      push @{$wiki{lc $_}}, $node;
   }
}

my $root;
$root->[N_KW] = ["Documents", "pod"];
$root->[N_DOC] = [[0, 0, ::special link => "All Documents", "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 $pod;
   $pod->[N_PARENT] = $root;
   $pod->[N_PAR]    = 0;
   $pod->[N_LEVEL]  = 1;
   $pod->[N_KW]     = [$base];
   $pod->[N_DOC]    = $para;

   my @parent = ($pod);

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

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

      if ($par->[P_INDEX]) {
         my $node;
         $node->[N_PARENT] = $parent[-1];
         $node->[N_PAR]    = $idx;
         $node->[N_LEVEL]  = $par->[P_LEVEL];
         $node->[N_KW]     = $par->[P_INDEX];
         $node->[N_DOC]    = $para;
         push @parent, $node;
         add_node $node;
      }
   }

   add_node $pod;
}

add_node $root;

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

Revision:	1.17
Committed:	Wed Apr 2 13:27:55 2008 UTC (16 years, 1 month ago) by root
Branch:	MAIN
Changes since 1.16:	+4 -1 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	#! perl
2
3	root	1.5	# convert given .pod files to wiki style
4	root	1.1
5	root	1.5	# base path of arch tree, only used for new arch graphics
6	elmex	1.7	my $ARCH = "/root/devel/cvs/cf.schmorp.de/arch";
7	root	1.1
8			use strict;
9
10	root	1.5	use Storable;
11	root	1.1	use Pod::POM;
12
13			our @result;
14			our $indent;
15			our $level;
16
17	root	1.3	my $MA_BEG = "\x{fcd0}";
18			my $MA_SEP = "\x{fcd1}";
19			my $MA_END = "\x{fcd2}";
20
21	root	1.1	sub asxml($) {
22			local $_ = $_[0];
23
24			s/&/&/g;
25			s/>/>/g;
26			s/</</g;
27
28			$_
29			}
30
31			sub flatten($) {
32			local $_ = $_[0];
33
34			s/<[^>]+>//g;
35			s/^\s+//;
36			s/\s+$//;
37			s/\s+/ /g;
38
39			$_
40			}
41
42	root	1.8	sub special {
43			$MA_BEG . (join $MA_SEP, @_) . $MA_END
44			}
45
46	root	1.1	package AsParagraphs;
47
48			use strict;
49
50			use base "Pod::POM::View";
51
52	root	1.11	# nodes (order must stay as it is)
53			sub N_PARENT (){ 0 }
54			sub N_PAR (){ 1 }
55			sub N_LEVEL (){ 2 }
56			sub N_KW (){ 3 }
57			sub N_DOC (){ 4 }
58
59			# paragraphs (order must stay as it is)
60			sub P_INDENT (){ 0 }
61			sub P_LEVEL (){ 1 }
62			sub P_MARKUP (){ 2 }
63			sub P_INDEX (){ 3 }
64
65	root	1.1	*view_seq_file =
66			*view_seq_code =
67			*view_seq_bold = sub { "<b>$_[1]</b>" };
68			*view_seq_italic = sub { "<i>$_[1]</i>" };
69			*view_seq_zero = sub { };
70			*view_seq_space = sub { my $text = $_[1]; $text =~ s/ / /g; $text };
71	root	1.11	*view_seq_index = sub { push @{ $result[-1][P_INDEX] }, $_[1]; "" };
72	root	1.1
73			sub view_seq_text {
74			my $text = $_[1];
75			$text =~ s/\s+/ /g;
76			::asxml $text
77			}
78
79			sub view_seq_link {
80			my (undef, $link) = @_;
81
82	root	1.17	$link =~ s/^(.*)\\|//
83			or $link =~ /([^\/]*)$/;
84
85			my $text = $1;
86	root	1.4
87	root	1.3	if ($link =~ /http:/) {
88			"<u>" . (::asxml $link) . "</u>"
89	root	1.5	} elsif ($link =~ /^\$ARCH\/(.+)$/) {
90			my $path = $1;
91			(my $base = $path) =~ s/.*\///;
92	root	1.6	-f "$ARCH/$path" && system "rsync -av -c \Q$ARCH/$path\E \Qresources/arch/$base";
93	root	1.8	::special image => "arch/$base", 1;
94	root	1.3	} else {
95	root	1.8	::special link => $text, $link
96	root	1.3	}
97	root	1.1	}
98
99			sub view_verbatim {
100	root	1.11	push @result, [ $indent * 16, $level, "<tt>" . (::asxml $_[1]) . "</tt>\n" ];
101	root	1.1	()
102			}
103
104			sub view_textblock {
105	root	1.11	push @result, [ $indent * 16, $level, "$_[1]\n" ];
106	root	1.1	()
107			}
108
109			sub view_head1 {
110	root	1.11	push @result, [ $indent * 16, $level ];
111	root	1.1	my $title = $_[1]->title->present ($_[0]);
112	root	1.15	$result[-1][P_MARKUP] = ::special h1 => $title if length $title;
113	root	1.16	$title = ::flatten $title;
114			unshift @{ $result[-1][P_INDEX] }, $title
115			if !$result[-1][P_INDEX];
116	root	1.1	local $level = $level + 1;
117			$_[1]->content->present ($_[0]);
118			()
119			};
120
121			sub view_head2 {
122	root	1.11	push @result, [ $indent * 16, $level ];
123	root	1.1	my $title = $_[1]->title->present ($_[0]);
124	root	1.15	$result[-1][P_MARKUP] = ::special h2 => $title if length $title;
125	root	1.16	$title = ::flatten $title;
126			unshift @{ $result[-1][P_INDEX] }, $title
127			if !$result[-1][P_INDEX];
128	root	1.1	local $level = $level + 1;
129			$_[1]->content->present ($_[0]);
130			()
131			};
132
133			sub view_head3 {
134	root	1.11	push @result, [ $indent * 16, $level ];
135	root	1.1	my $title = $_[1]->title->present ($_[0]);
136	root	1.15	$result[-1][P_MARKUP] = ::special h3 => $title if length $title;
137	root	1.16	$title = ::flatten $title;
138			unshift @{ $result[-1][P_INDEX] \|\| [] }, $title
139			if !$result[-1][P_INDEX];
140	root	1.1	local $level = $level + 1;
141			$_[1]->content->present ($_[0]);
142			()
143			};
144
145			sub view_over {
146			local $indent = $indent + $_[1]->indent;
147	root	1.11	push @result, [ $indent, $level ];
148	root	1.12	$_[1]->content->present ($_[0]);
149			()
150			}
151
152			sub view_item {
153			push @result, [ $indent * 8, $level ];
154			my $title = $_[1]->title->present ($_[0]);
155			$result[-1][P_MARKUP] = "$title\n" if length $title;
156	root	1.16	$title = ::flatten $title;
157			unshift @{ $result[-1][P_INDEX] \|\| [] }, $title
158			if !$result[-1][P_INDEX];
159	root	1.11	local $level = $level + 1;
160	root	1.1	$_[1]->content->present ($_[0]);
161			()
162			}
163
164			sub view_for {
165			if ($_[1]->format eq "image") {
166	root	1.11	push @result, [
167			$indent * 16,
168			$level,
169			(::special image => "pod/" . $_->text),
170			];
171	root	1.1	}
172			()
173			}
174
175	root	1.10	sub view_begin {
176			()
177			}
178
179	root	1.1	sub view {
180			my ($self, $type, $item) = @_;
181
182			$item->content->present ($self);
183			}
184
185			#############################################################################
186
187			sub as_paragraphs($) {
188			my ($pom) = @_;
189
190			local $indent = 0;
191	root	1.11	local $level = 2;
192			local @result = ( [] );
193	root	1.1
194			$pom->present ("AsParagraphs");
195
196	root	1.11	[grep $_->[P_INDEX] \|\| defined $_->[P_MARKUP], @result]
197	root	1.1	}
198
199			#############################################################################
200
201			my %wiki;
202
203			sub add_node($) {
204			my ($node) = @_;
205
206	root	1.12	for (@{ $node->[N_KW] \|\| {} }) {
207	root	1.5	push @{$wiki{lc $_}}, $node;
208	root	1.1	}
209			}
210
211	root	1.12	my $root;
212	root	1.16	$root->[N_KW] = ["Documents", "pod"];
213			$root->[N_DOC] = [[0, 0, ::special link => "All Documents", "pod/*"]];
214	root	1.1
215			for my $path (@ARGV) {
216			$path =~ /([^\/\\]+)\.pod$/ or die "$path: illegal pathname";
217			my $base = $1;
218			my $pom = Pod::POM->new->parse_text (do {
219			local $/;
220			open my $pod, "<:utf8", $path
221			or die "$path: $!";
222			<$pod>
223			});
224
225			my $para = as_paragraphs $pom;
226
227	root	1.12	my $pod;
228			$pod->[N_PARENT] = $root;
229			$pod->[N_PAR] = 0;
230			$pod->[N_LEVEL] = 1;
231			$pod->[N_KW] = [$base];
232			$pod->[N_DOC] = $para;
233
234			my @parent = ($pod);
235	root	1.1
236			for my $idx (0 .. $#$para) {
237			my $par = $para->[$idx];
238
239	root	1.12	while ($parent[-1][N_LEVEL] >= $par->[P_LEVEL]) {
240	root	1.1	pop @parent;
241			}
242
243	root	1.11	if ($par->[P_INDEX]) {
244	root	1.12	my $node;
245			$node->[N_PARENT] = $parent[-1];
246			$node->[N_PAR] = $idx;
247			$node->[N_LEVEL] = $par->[P_LEVEL];
248			$node->[N_KW] = $par->[P_INDEX];
249			$node->[N_DOC] = $para;
250	root	1.1	push @parent, $node;
251			add_node $node;
252			}
253			}
254	root	1.14
255			add_node $pod;
256	root	1.1	}
257
258	root	1.14	add_node $root;
259
260	root	1.1	Storable::nstore \%wiki, "docwiki.pst";
261