Deliantra-Client/DC/Pod.pm

package CFPlus::Pod;

use strict;

use Storable;

our $VERSION = 1;

our %wiki;

*wiki = Storable::retrieve CFPlus::find_rcfile "docwiki.pst";

sub is_prefix_of($@) {
   my ($node, @path) = @_;

   return 1 unless @path;

   my $kw = pop @path;

   $node = $node->{parent}
      or return 0;

   return ! ! grep $_ eq $kw, @{ $node->{kw} };
}

sub find(@) {
   my (@path) = @_;

   return unless @path;

   my $kw = pop @path;

   # TODO: make sure results are unique

   grep { is_prefix_of $_, @path }
      map @$_,
         $kw eq "*" ? @wiki{sort keys %wiki}
                    : grep $_, $wiki{$kw}
}

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

   my $path = $node->{kw}[0];
   $path = "$node->{kw}[0]/$path" while $node = $node->{parent};
   $path
}

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

   my $doc = $node->{doc};
   my $par = $node->{par};
   my $lvl = $node->{level};

   my @res;

   do {
      my $p = $doc->[$par];

      if (exists $p->{markup}) {
         my %para = (
            markup => $p->{markup},
            indent => $p->{indent},
         );

         for (@{ $p->{widget} || [] }) {
            my ($class, @args) = @$_;
            push @{ $para{widget} }, $class->new (@args);
         }

         push @res, \%para;
      }
   } while $doc->[++$par]{level} > $lvl;

   @res
}

sub section(@) {
   map section_of $_, &find
}

sub as_label(@) {
   my $text =
      join "\n",
         map +("\xa0" x ($_->{indent} / 4)) . $_->{markup},
            @_;

   $text =~ s/^\s+//;
   $text =~ s/\s+$//;

   $text
}

sub section_label(@) {
   as_label &section
}

1
Revision:	1.6
Committed:	Sun Aug 13 14:30:06 2006 UTC (17 years, 10 months ago) by root
Branch:	MAIN
Changes since 1.5:	+13 -3 lines
Log Message:	* empty log message *
#	Content
1	package CFPlus::Pod;
2
3	use strict;
4
5	use Storable;
6
7	our $VERSION = 1;
8
9	our %wiki;
10
11	*wiki = Storable::retrieve CFPlus::find_rcfile "docwiki.pst";
12
13	sub is_prefix_of($@) {
14	my ($node, @path) = @_;
15
16	return 1 unless @path;
17
18	my $kw = pop @path;
19
20	$node = $node->{parent}
21	or return 0;
22
23	return ! ! grep $_ eq $kw, @{ $node->{kw} };
24	}
25
26	sub find(@) {
27	my (@path) = @_;
28
29	return unless @path;
30
31	my $kw = pop @path;
32
33	# TODO: make sure results are unique
34
35	grep { is_prefix_of $_, @path }
36	map @$_,
37	$kw eq "*" ? @wiki{sort keys %wiki}
38	: grep $_, $wiki{$kw}
39	}
40
41	sub full_path_of($) {
42	my ($node) = @_;
43
44	my $path = $node->{kw}[0];
45	$path = "$node->{kw}[0]/$path" while $node = $node->{parent};
46	$path
47	}
48
49	sub section_of($) {
50	my ($node) = @_;
51
52	my $doc = $node->{doc};
53	my $par = $node->{par};
54	my $lvl = $node->{level};
55
56	my @res;
57
58	do {
59	my $p = $doc->[$par];
60
61	if (exists $p->{markup}) {
62	my %para = (
63	markup => $p->{markup},
64	indent => $p->{indent},
65	);
66
67	for (@{ $p->{widget} \|\| [] }) {
68	my ($class, @args) = @$_;
69	push @{ $para{widget} }, $class->new (@args);
70	}
71
72	push @res, \%para;
73	}
74	} while $doc->[++$par]{level} > $lvl;
75
76	@res
77	}
78
79	sub section(@) {
80	map section_of $_, &find
81	}
82
83	sub as_label(@) {
84	my $text =
85	join "\n",
86	map +("\xa0" x ($_->{indent} / 4)) . $_->{markup},
87	@_;
88
89	$text =~ s/^\s+//;
90	$text =~ s/\s+$//;
91
92	$text
93	}
94
95	sub section_label(@) {
96	as_label &section
97	}
98
99	1