Deliantra-Client/DC/Pod.pm

package CFClient::Pod;

use strict;

use Pod::POM;

use CFClient;
use CFClient::UI;

our $VERSION = 1; # bump if resultant formatting changes

our @result;
our $indent;

package CFClient::Pod::AsXML;

use strict;

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

*view_seq_code   =
*view_seq_bold   = sub { "<b>$_[1]</b>" };
*view_seq_italic = sub { "<i>$_[1]</i>" };
*view_seq_space  =
*view_seq_link   =
*view_seq_index  = sub { CFClient::asxml $_[1] };

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

sub view_item {
   ("\t" x ($indent / 4))
   . $_[1]->title->present ($_[0])
   . "\n\n"
   . $_[1]->content->present ($_[0])
}

sub view_verbatim {
   (join "",
       map +("\t" x ($indent / 2)) . "<tt>$_</tt>\n",
          split /\n/, CFClient::asxml $_[1])
   . "\n"
}

sub view_textblock {
   ("\t" x ($indent / 2)) . "$_[1]\n\n"
}

sub view_head1 {
   "\n\n<span foreground='#ffff00' size='x-large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
   . $_[1]->content->present ($_[0])
};

sub view_head2 {
   "\n<span foreground='#ccccff' size='large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
   . $_[1]->content->present ($_[0])
};

sub view_head3 {
   "\n<span size='large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
   . $_[1]->content->present ($_[0])
};

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

package CFClient::Pod::AsParagraphs;

use strict;

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

*view_seq_code   =
*view_seq_bold   = sub { "<b>$_[1]</b>" };
*view_seq_italic = sub { "<i>$_[1]</i>" };
*view_seq_space  =
*view_seq_link   =
*view_seq_index  = sub { CFClient::asxml $_[1] };

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

sub view_item {
   push @result, {
      indent => $indent * 8,
      text   => $_[1]->title->present ($_[0]) . "\n\n",
   };
   $_[1]->content->present ($_[0]);
   ()
}

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

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

sub view_head1 {
   push @result, {
      indent => $indent * 16,
      text   => "\n\n<span foreground='#ffff00' size='x-large'>" . $_[1]->title->present ($_[0]) . "</span>\n",
   };
   $_[1]->content->present ($_[0]);
   ()
};

sub view_head2 {
   push @result, {
      indent => $indent * 16,
      text   => "\n\n<span foreground='#ccccff' size='large'>" . $_[1]->title->present ($_[0]) . "</span>\n",
   };
   $_[1]->content->present ($_[0]);
   ()
};

sub view_head3 {
   push @result, {
      indent => $indent * 16,
      text   => "\n\n<span size='large'>" . $_[1]->title->present ($_[0]) . "</span>\n",
   };
   $_[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,
         text   => "\x{fffc}",
         obj    => [new CFClient::UI::Image path => "pod/" . $_[1]->text],
      };
   }
   ()
}

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

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

package CFClient::Pod;

my $pod_cache = CFClient::db_table "pod_cache";

sub load($$$$) {
   my ($path, $filtertype, $filterversion, $filtercb) = @_;

   stat $path
      or die "$path: $!";

   my $phash = join ",", $filterversion, $VERSION, (stat _)[7,9];

   my ($chash, $pom) = eval { @{ Storable::thaw $pod_cache->get ("$path/$filtertype") } };

   return $pom if $chash eq $phash;

   my $pod = do {
      local $/;
      open my $pod, "<:utf8", $_[0]
         or die "$_[0]: $!";
      <$pod>
   };

   #utf8::downgrade $pod;

   $pom = $filtercb->(Pod::POM->new->parse_text ($pod));

   $pod_cache->put ("$path/$filtertype" => Storable::nfreeze [$phash, $pom]);

   $pom
}

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

   local $indent = 0;

   $pom->present ("CFClient::Pod::AsXML")
}

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

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

   $pom->present ("CFClient::Pod::AsParagraphs");

   [grep exists $_->{text}, @result]
}

Revision:	1.1
Committed:	Sun Jul 23 16:11:12 2006 UTC (17 years, 11 months ago) by root
Branch:	MAIN
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	package CFClient::Pod;
2
3			use strict;
4
5			use Pod::POM;
6
7			use CFClient;
8			use CFClient::UI;
9
10			our $VERSION = 1; # bump if resultant formatting changes
11
12			our @result;
13			our $indent;
14
15			package CFClient::Pod::AsXML;
16
17			use strict;
18
19			use base "Pod::POM::View::Text";
20
21			*view_seq_code =
22			*view_seq_bold = sub { "<b>$_[1]</b>" };
23			*view_seq_italic = sub { "<i>$_[1]</i>" };
24			*view_seq_space =
25			*view_seq_link =
26			*view_seq_index = sub { CFClient::asxml $_[1] };
27
28			sub view_seq_text {
29			my $text = $_[1];
30			$text =~ s/\s+/ /g;
31			CFClient::asxml $text
32			}
33
34			sub view_item {
35			("\t" x ($indent / 4))
36			. $_[1]->title->present ($_[0])
37			. "\n\n"
38			. $_[1]->content->present ($_[0])
39			}
40
41			sub view_verbatim {
42			(join "",
43			map +("\t" x ($indent / 2)) . "<tt>$_</tt>\n",
44			split /\n/, CFClient::asxml $_[1])
45			. "\n"
46			}
47
48			sub view_textblock {
49			("\t" x ($indent / 2)) . "$_[1]\n\n"
50			}
51
52			sub view_head1 {
53			"\n\n<span foreground='#ffff00' size='x-large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
54			. $_[1]->content->present ($_[0])
55			};
56
57			sub view_head2 {
58			"\n<span foreground='#ccccff' size='large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
59			. $_[1]->content->present ($_[0])
60			};
61
62			sub view_head3 {
63			"\n<span size='large'>" . $_[1]->title->present ($_[0]) . "</span>\n\n"
64			. $_[1]->content->present ($_[0])
65			};
66
67			sub view_over {
68			local $indent = $indent + $_[1]->indent;
69			$_[1]->content->present ($_[0])
70			}
71
72			package CFClient::Pod::AsParagraphs;
73
74			use strict;
75
76			use base "Pod::POM::View";
77
78			*view_seq_code =
79			*view_seq_bold = sub { "<b>$_[1]</b>" };
80			*view_seq_italic = sub { "<i>$_[1]</i>" };
81			*view_seq_space =
82			*view_seq_link =
83			*view_seq_index = sub { CFClient::asxml $_[1] };
84
85			sub view_seq_text {
86			my $text = $_[1];
87			$text =~ s/\s+/ /g;
88			CFClient::asxml $text
89			}
90
91			sub view_item {
92			push @result, {
93			indent => $indent * 8,
94			text => $_[1]->title->present ($_[0]) . "\n\n",
95			};
96			$_[1]->content->present ($_[0]);
97			()
98			}
99
100			sub view_verbatim {
101			push @result, {
102			indent => $indent * 16,
103			text => "<tt>" . (CFClient::asxml $_[1]) . "</tt>",
104			};
105			()
106			}
107
108			sub view_textblock {
109			push @result, {
110			indent => $indent * 16,
111			text => "$_[1]\n",
112			};
113			()
114			}
115
116			sub view_head1 {
117			push @result, {
118			indent => $indent * 16,
119			text => "\n\n<span foreground='#ffff00' size='x-large'>" . $_[1]->title->present ($_[0]) . "</span>\n",
120			};
121			$_[1]->content->present ($_[0]);
122			()
123			};
124
125			sub view_head2 {
126			push @result, {
127			indent => $indent * 16,
128			text => "\n\n<span foreground='#ccccff' size='large'>" . $_[1]->title->present ($_[0]) . "</span>\n",
129			};
130			$_[1]->content->present ($_[0]);
131			()
132			};
133
134			sub view_head3 {
135			push @result, {
136			indent => $indent * 16,
137			text => "\n\n<span size='large'>" . $_[1]->title->present ($_[0]) . "</span>\n",
138			};
139			$_[1]->content->present ($_[0]);
140			()
141			};
142
143			sub view_over {
144			local $indent = $indent + $_[1]->indent;
145			push @result, { indent => $indent };
146			$_[1]->content->present ($_[0]);
147			()
148			}
149
150			sub view_for {
151			if ($_[1]->format eq "image") {
152			push @result, {
153			indent => $indent * 16,
154			text => "\x{fffc}",
155			obj => [new CFClient::UI::Image path => "pod/" . $_[1]->text],
156			};
157			}
158			()
159			}
160
161			sub view {
162			my ($self, $type, $item) = @_;
163
164			$item->content->present ($self);
165			}
166
167			package CFClient::Pod;
168
169			my $pod_cache = CFClient::db_table "pod_cache";
170
171			sub load($$$$) {
172			my ($path, $filtertype, $filterversion, $filtercb) = @_;
173
174			stat $path
175			or die "$path: $!";
176
177			my $phash = join ",", $filterversion, $VERSION, (stat _)[7,9];
178
179			my ($chash, $pom) = eval { @{ Storable::thaw $pod_cache->get ("$path/$filtertype") } };
180
181			return $pom if $chash eq $phash;
182
183			my $pod = do {
184			local $/;
185			open my $pod, "<:utf8", $_[0]
186			or die "$_[0]: $!";
187			<$pod>
188			};
189
190			#utf8::downgrade $pod;
191
192			$pom = $filtercb->(Pod::POM->new->parse_text ($pod));
193
194			$pod_cache->put ("$path/$filtertype" => Storable::nfreeze [$phash, $pom]);
195
196			$pom
197			}
198
199			sub as_xml($) {
200			my ($pom) = @_;
201
202			local $indent = 0;
203
204			$pom->present ("CFClient::Pod::AsXML")
205			}
206
207			sub as_paragraphs($) {
208			my ($pom) = @_;
209
210			local @result = ( { } );
211			local $indent = 0;
212
213			$pom->present ("CFClient::Pod::AsParagraphs");
214
215			[grep exists $_->{text}, @result]
216			}
217