[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";

*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>"
   } 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_item {
   push @result, {
      indent => $indent * 8,
      level  => $level,
   };
   my $title = $_[1]->title->present ($_[0]);
   $result[-1]{markup} = "$title\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 => (::special image => "pod/" . $_->text),
      };
   }
   ()
}

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{lc $_}}, $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.9
Committed:	Mon Aug 14 19:17:09 2006 UTC (17 years, 9 months ago) by root
Branch:	MAIN
Changes since 1.8:	+1 -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			*view_seq_file =
53			*view_seq_code =
54			*view_seq_bold = sub { "<b>$_[1]</b>" };
55			*view_seq_italic = sub { "<i>$_[1]</i>" };
56			*view_seq_zero = sub { };
57			*view_seq_space = sub { my $text = $_[1]; $text =~ s/ / /g; $text };
58			*view_seq_index = sub { push @{ $result[-1]{index} }, $_[1]; "" };
59
60			sub view_seq_text {
61			my $text = $_[1];
62			$text =~ s/\s+/ /g;
63			::asxml $text
64			}
65
66			sub view_seq_link {
67			my (undef, $link) = @_;
68
69	root	1.4	my $text = $link =~ s/^(.*)\\|// ? $1 : $link;
70
71	root	1.3	if ($link =~ /http:/) {
72			"<u>" . (::asxml $link) . "</u>"
73	root	1.5	} elsif ($link =~ /^\$ARCH\/(.+)$/) {
74			my $path = $1;
75			(my $base = $path) =~ s/.*\///;
76	root	1.6	-f "$ARCH/$path" && system "rsync -av -c \Q$ARCH/$path\E \Qresources/arch/$base";
77	root	1.8	::special image => "arch/$base", 1;
78	root	1.3	} else {
79	root	1.8	::special link => $text, $link
80	root	1.3	}
81	root	1.1	}
82
83			sub view_item {
84			push @result, {
85			indent => $indent * 8,
86			level => $level,
87			};
88			my $title = $_[1]->title->present ($_[0]);
89	root	1.9	$result[-1]{markup} = "$title\n" if length $title;
90	root	1.2	$title = ::flatten $title; unshift @{ $result[-1]{index} }, $title if length $title;
91	root	1.1	local $level = $level + 1;
92			$_[1]->content->present ($_[0]);
93			()
94			}
95
96			sub view_verbatim {
97			push @result, {
98			indent => $indent * 16,
99			level => $level,
100			markup => "<tt>" . (::asxml $_[1]) . "</tt>\n",
101			};
102			()
103			}
104
105			sub view_textblock {
106			push @result, {
107			indent => $indent * 16,
108			level => $level,
109			markup => "$_[1]\n",
110			};
111			()
112			}
113
114			sub view_head1 {
115			push @result, {
116			indent => $indent * 16,
117			level => $level,
118			};
119			my $title = $_[1]->title->present ($_[0]);
120	root	1.2	$result[-1]{markup} = "\n\n<span foreground='#ffff00' size='x-large'>$title</span>\n" if length $title;
121			$title = ::flatten $title; unshift @{ $result[-1]{index} }, $title if length $title;
122	root	1.1	local $level = $level + 1;
123			$_[1]->content->present ($_[0]);
124			()
125			};
126
127			sub view_head2 {
128			push @result, {
129			indent => $indent * 16,
130			level => $level,
131			};
132			my $title = $_[1]->title->present ($_[0]);
133	root	1.2	$result[-1]{markup} = "\n\n<span foreground='#ccccff' size='large'>$title</span>\n" if length $title;
134			$title = ::flatten $title; unshift @{ $result[-1]{index} }, $title if length $title;
135	root	1.1	local $level = $level + 1;
136			$_[1]->content->present ($_[0]);
137			()
138			};
139
140			sub view_head3 {
141			push @result, {
142			indent => $indent * 16,
143			level => $level,
144			};
145			my $title = $_[1]->title->present ($_[0]);
146	root	1.2	$result[-1]{markup} = "\n\n<span size='large'>$title</span>\n" if length $title;
147			$title = ::flatten $title; unshift @{ $result[-1]{index} }, $title if length $title;
148	root	1.1	local $level = $level + 1;
149			$_[1]->content->present ($_[0]);
150			()
151			};
152
153			sub view_over {
154			local $indent = $indent + $_[1]->indent;
155			push @result, { indent => $indent };
156			$_[1]->content->present ($_[0]);
157			()
158			}
159
160			sub view_for {
161			if ($_[1]->format eq "image") {
162			push @result, {
163			indent => $indent * 16,
164			level => $level,
165	root	1.8	markup => (::special image => "pod/" . $_->text),
166	root	1.1	};
167			}
168			()
169			}
170
171			sub view {
172			my ($self, $type, $item) = @_;
173
174			$item->content->present ($self);
175			}
176
177			#############################################################################
178
179			sub as_paragraphs($) {
180			my ($pom) = @_;
181
182			local $indent = 0;
183			local $level = 1;
184	root	1.2	local @result = ( { } );
185	root	1.1
186			$pom->present ("AsParagraphs");
187
188	root	1.2	[grep $_->{index} \|\| exists $_->{markup}, @result]
189	root	1.1	}
190
191			#############################################################################
192
193			my %wiki;
194
195			sub add_node($) {
196			my ($node) = @_;
197
198			for (@{ $node->{kw} \|\| {} }) {
199	root	1.5	push @{$wiki{lc $_}}, $node;
200	root	1.1	}
201			}
202
203			my $root = {
204			kw => ["pod"],
205			};
206
207			for my $path (@ARGV) {
208			$path =~ /([^\/\\]+)\.pod$/ or die "$path: illegal pathname";
209			my $base = $1;
210			my $pom = Pod::POM->new->parse_text (do {
211			local $/;
212			open my $pod, "<:utf8", $path
213			or die "$path: $!";
214			<$pod>
215			});
216
217			my $para = as_paragraphs $pom;
218
219			my @parent = (
220			{ parent => $root, kw => [$base], doc => $para, par => 0, level => 0 },
221			);
222			add_node $parent[-1];
223
224			for my $idx (0 .. $#$para) {
225			my $par = $para->[$idx];
226
227			while ($parent[-1]{level} >= $par->{level}) {
228			pop @parent;
229			}
230
231			if ($par->{index}) {
232			my $node = {
233			kw => $par->{index},
234			parent => $parent[-1],
235			doc => $para,
236			par => $idx,
237			level => $par->{level},
238			};
239			push @parent, $node;
240			add_node $node;
241			}
242			}
243			}
244
245			Storable::nstore \%wiki, "docwiki.pst";
246