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, 9 months ago) by root
Branch:	MAIN
Changes since 1.5:	+13 -3 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.3	package CFPlus::Pod;
2	root	1.1
3			use strict;
4
5	root	1.4	use Storable;
6	root	1.1
7	root	1.4	our $VERSION = 1;
8	root	1.1
9	root	1.4	our %wiki;
10	root	1.1
11	root	1.4	*wiki = Storable::retrieve CFPlus::find_rcfile "docwiki.pst";
12	root	1.1
13	root	1.4	sub is_prefix_of($@) {
14			my ($node, @path) = @_;
15	root	1.1
16	root	1.4	return 1 unless @path;
17	root	1.1
18	root	1.4	my $kw = pop @path;
19	root	1.1
20	root	1.4	$node = $node->{parent}
21			or return 0;
22	root	1.2
23	root	1.4	return ! ! grep $_ eq $kw, @{ $node->{kw} };
24	root	1.2	}
25
26	root	1.4	sub find(@) {
27			my (@path) = @_;
28	root	1.1
29	root	1.4	return unless @path;
30	root	1.1
31	root	1.4	my $kw = pop @path;
32	root	1.1
33	root	1.4	# TODO: make sure results are unique
34	root	1.1
35	root	1.4	grep { is_prefix_of $_, @path }
36			map @$_,
37			$kw eq "*" ? @wiki{sort keys %wiki}
38			: grep $_, $wiki{$kw}
39	root	1.1	}
40
41	root	1.4	sub full_path_of($) {
42			my ($node) = @_;
43	root	1.1
44	root	1.4	my $path = $node->{kw}[0];
45			$path = "$node->{kw}[0]/$path" while $node = $node->{parent};
46			$path
47	root	1.1	}
48
49	root	1.4	sub section_of($) {
50			my ($node) = @_;
51	root	1.1
52	root	1.4	my $doc = $node->{doc};
53			my $par = $node->{par};
54			my $lvl = $node->{level};
55	root	1.1
56	root	1.4	my @res;
57	root	1.1
58	root	1.4	do {
59			my $p = $doc->[$par];
60	root	1.1
61	root	1.5	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	root	1.4	}
74			} while $doc->[++$par]{level} > $lvl;
75	root	1.1
76	root	1.4	@res
77	root	1.1	}
78
79	root	1.4	sub section(@) {
80			map section_of $_, &find
81	root	1.2	}
82
83	root	1.4	sub as_label(@) {
84	root	1.6	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	root	1.1	}
98
99	root	1.4	1