lib/cf/pod.pm

#
# This file is part of Deliantra, the Roguelike Realtime MMORPG.
#
# Copyright (©) 2005,2006,2007,2008,2009,2010,2011,2012 Marc Alexander Lehmann / Robin Redeker / the Deliantra team
#
# Deliantra is free software: you can redistribute it and/or modify it under
# the terms of the Affero GNU General Public License as published by the
# Free Software Foundation, either version 3 of the License, or (at your
# option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the Affero GNU General Public License
# and the GNU General Public License along with this program. If not, see
# <http://www.gnu.org/licenses/>.
#
# The authors can be reached via e-mail to <support@deliantra.net>
#

package cf::pod;

use common::sense;

use Pod::POM;

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

package cf::pod::AsParagraphs;

use common::sense;

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

my %E = (
   "<" => "E<lt>",
   ">" => "E<gt>",
);

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

   s/[<>]/$E{$1}/g;

   $_
}

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

   s/^\s+//;
   s/\s+$//;
   s/\s+/ /g;

   $_
}

*view_seq_file   = sub { "C<$_[1]>" };
*view_seq_code   = sub { "C<$_[1]>" };
*view_seq_bold   = sub { "B<$_[1]>" };
*view_seq_italic = sub { "I<$_[1]>" };
*view_seq_T      = sub { "T<$_[1]>" };
*view_seq_G      = sub { "G<$_[1]>" };
*view_seq_zero   = sub { "Z<>" };
*view_seq_space  = sub { my $text = $_[1]; $text =~ s/ /\xa0/g; $text };
*view_seq_index  = sub { push @{ $result[-1]{index} }, $_[1]; "" };

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

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

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

   if ($link =~ /http:/) {
      "U<" . (aspod $link) . ">"
   } else {
      ()
   }
}

sub view_item {
   push @result, {
      type   => "item",
      indent => $indent * 8,
      level  => $level,
   };
   my $title = $_[1]->title->present ($_[0]);
   $result[-1]{markup} = $title 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, {
      type   => "verbatim",
      indent => $indent * 16,
      level  => $level,
      markup => $_[1],
   };
   ()
}

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

sub view_head1 {
   push @result, {
      type   => "head1",
      indent => $indent * 16,
      level  => $level,
   };
   my $title = $_[1]->title->present ($_[0]);
   $result[-1]{markup} = $title 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, {
      type   => "head2",
      indent => $indent * 16,
      level  => $level,
   };
   my $title = $_[1]->title->present ($_[0]);
   $result[-1]{markup} = $title 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, {
      type   => "head3",
      indent => $indent * 16,
      level  => $level,
   };
   my $title = $_[1]->title->present ($_[0]);
   $result[-1]{markup} = $title 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_begin {
   ()
}

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

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

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

package cf::pod;

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

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

   $pom->present ("cf::pod::AsParagraphs");

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

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

   # we suckers use global variables, unfortunately.
   my $guard = cf::lock_acquire "cf::pod::as_paragraphs";

   $pom->pom_as_paragraphs_ng
}

sub load_pod($) {
   my ($path) = @_;

   Coro::Storable::thaw cf::cache "cf::pod::as_paragraphs/$path" => [$path],
      8 => sub {
         my ($src) = @_;

         cf::fork_call {
            Coro::Storable::blocking_nfreeze
               pom_as_paragraphs_ng
                  +(Pod::POM->new->parse_text ($src->[0]))
         }
      };
}

# format as cfpod-style text
sub as_cfpod($) {
   my ($pars) = @_;

   my $res;

   for my $par (@$pars) {
      if ($par->{type} =~ /^head\d+$/) {
         $res .= "B<$par->{markup}>\n\n";
      } elsif ($par->{type} eq "verbatim") {
         $res .= "$par->{markup}\n\n";
      } elsif ($par->{type} eq "item") {
         $res .= "* I<$par->{markup}>\n\n";
      } else {
         $res .= "$par->{markup}\n\n";
      }
   }

   $res
}

1;

Revision:	1.28
Committed:	Tue Nov 13 01:12:23 2012 UTC (11 years, 7 months ago) by root
Branch:	MAIN
Changes since 1.27:	+11 -5 lines
Log Message:	* empty log message *
#	Content
1	#
2	# This file is part of Deliantra, the Roguelike Realtime MMORPG.
3	#
4	# Copyright (©) 2005,2006,2007,2008,2009,2010,2011,2012 Marc Alexander Lehmann / Robin Redeker / the Deliantra team
5	#
6	# Deliantra is free software: you can redistribute it and/or modify it under
7	# the terms of the Affero GNU General Public License as published by the
8	# Free Software Foundation, either version 3 of the License, or (at your
9	# option) any later version.
10	#
11	# This program is distributed in the hope that it will be useful,
12	# but WITHOUT ANY WARRANTY; without even the implied warranty of
13	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14	# GNU General Public License for more details.
15	#
16	# You should have received a copy of the Affero GNU General Public License
17	# and the GNU General Public License along with this program. If not, see
18	# <http://www.gnu.org/licenses/>.
19	#
20	# The authors can be reached via e-mail to <support@deliantra.net>
21	#
22
23	package cf::pod;
24
25	use common::sense;
26
27	use Pod::POM;
28
29	our $indent;
30	our $level;
31	our @result;
32
33	package cf::pod::AsParagraphs;
34
35	use common::sense;
36
37	use base "Pod::POM::View";
38
39	my %E = (
40	"<" => "E<lt>",
41	">" => "E<gt>",
42	);
43
44	sub aspod($) {
45	local $_ = $_[0];
46
47	s/[<>]/$E{$1}/g;
48
49	$_
50	}
51
52	sub flatten($) {
53	local $_ = $_[0];
54
55	s/^\s+//;
56	s/\s+$//;
57	s/\s+/ /g;
58
59	$_
60	}
61
62	*view_seq_file = sub { "C<$_[1]>" };
63	*view_seq_code = sub { "C<$_[1]>" };
64	*view_seq_bold = sub { "B<$_[1]>" };
65	*view_seq_italic = sub { "I<$_[1]>" };
66	*view_seq_T = sub { "T<$_[1]>" };
67	*view_seq_G = sub { "G<$_[1]>" };
68	*view_seq_zero = sub { "Z<>" };
69	*view_seq_space = sub { my $text = $_[1]; $text =~ s/ /\xa0/g; $text };
70	*view_seq_index = sub { push @{ $result[-1]{index} }, $_[1]; "" };
71
72	sub view_seq_text {
73	my $text = $_[1];
74	$text =~ s/\s+/ /g;
75	aspod $text
76	}
77
78	sub view_seq_link {
79	my (undef, $link) = @_;
80
81	my $text = $link =~ s/^(.*)\\|// ? $1 : $link;
82
83	if ($link =~ /http:/) {
84	"U<" . (aspod $link) . ">"
85	} else {
86	()
87	}
88	}
89
90	sub view_item {
91	push @result, {
92	type => "item",
93	indent => $indent * 8,
94	level => $level,
95	};
96	my $title = $_[1]->title->present ($_[0]);
97	$result[-1]{markup} = $title if length $title;
98	$title = flatten $title; unshift @{ $result[-1]{index} }, $title if length $title;
99	local $level = $level + 1;
100	$_[1]->content->present ($_[0]);
101	()
102	}
103
104	sub view_verbatim {
105	push @result, {
106	type => "verbatim",
107	indent => $indent * 16,
108	level => $level,
109	markup => $_[1],
110	};
111	()
112	}
113
114	sub view_textblock {
115	push @result, {
116	indent => $indent * 16,
117	level => $level,
118	markup => flatten $_[1],
119	};
120	()
121	}
122
123	sub view_head1 {
124	push @result, {
125	type => "head1",
126	indent => $indent * 16,
127	level => $level,
128	};
129	my $title = $_[1]->title->present ($_[0]);
130	$result[-1]{markup} = $title if length $title;
131	$title = flatten $title; unshift @{ $result[-1]{index} }, $title if length $title;
132	local $level = $level + 1;
133	$_[1]->content->present ($_[0]);
134	()
135	};
136
137	sub view_head2 {
138	push @result, {
139	type => "head2",
140	indent => $indent * 16,
141	level => $level,
142	};
143	my $title = $_[1]->title->present ($_[0]);
144	$result[-1]{markup} = $title if length $title;
145	$title = flatten $title; unshift @{ $result[-1]{index} }, $title if length $title;
146	local $level = $level + 1;
147	$_[1]->content->present ($_[0]);
148	()
149	};
150
151	sub view_head3 {
152	push @result, {
153	type => "head3",
154	indent => $indent * 16,
155	level => $level,
156	};
157	my $title = $_[1]->title->present ($_[0]);
158	$result[-1]{markup} = $title if length $title;
159	$title = flatten $title; unshift @{ $result[-1]{index} }, $title if length $title;
160	local $level = $level + 1;
161	$_[1]->content->present ($_[0]);
162	()
163	};
164
165	sub view_over {
166	local $indent = $indent + $_[1]->indent;
167	push @result, { indent => $indent };
168	$_[1]->content->present ($_[0]);
169	()
170	}
171
172	sub view_for {
173	if ($_[1]->format eq "image") {
174	# push @result, {
175	# indent => $indent * 16,
176	# level => $level,
177	# markup => (::special image => "pod/" . $_->text),
178	# };
179	}
180	()
181	}
182
183	sub view_begin {
184	()
185	}
186
187	sub view {
188	my ($self, $type, $item) = @_;
189
190	$item->content->present ($self);
191	}
192
193	#############################################################################
194
195	package cf::pod;
196
197	sub pom_as_paragraphs_ng($) {
198	my ($pom) = @_;
199
200	local $indent = 0;
201	local $level = 1;
202	local @result = ( { } );
203
204	$pom->present ("cf::pod::AsParagraphs");
205
206	[grep $_->{index} \|\| exists $_->{markup}, @result]
207	}
208
209	sub pom_as_paragraphs($) {
210	my ($pom) = @_;
211
212	# we suckers use global variables, unfortunately.
213	my $guard = cf::lock_acquire "cf::pod::as_paragraphs";
214
215	$pom->pom_as_paragraphs_ng
216	}
217
218	sub load_pod($) {
219	my ($path) = @_;
220
221	Coro::Storable::thaw cf::cache "cf::pod::as_paragraphs/$path" => [$path],
222	8 => sub {
223	my ($src) = @_;
224
225	cf::fork_call {
226	Coro::Storable::blocking_nfreeze
227	pom_as_paragraphs_ng
228	+(Pod::POM->new->parse_text ($src->[0]))
229	}
230	};
231	}
232
233	# format as cfpod-style text
234	sub as_cfpod($) {
235	my ($pars) = @_;
236
237	my $res;
238
239	for my $par (@$pars) {
240	if ($par->{type} =~ /^head\d+$/) {
241	$res .= "B<$par->{markup}>\n\n";
242	} elsif ($par->{type} eq "verbatim") {
243	$res .= "$par->{markup}\n\n";
244	} elsif ($par->{type} eq "item") {
245	$res .= "* I<$par->{markup}>\n\n";
246	} else {
247	$res .= "$par->{markup}\n\n";
248	}
249	}
250
251	$res
252	}
253
254	1;
255