Markup/SuikaWikiConfig20/Parser.pm


=head1 NAME

Message::Markup::SuikaWikiConfig20::Parser: manakai --- SuikaWikiConfig/2.0 parser

=head1 DESCRIPTION

SuikaWikiConfig/2.0 is a general configuration description format.
This module can be used to parse such configuration and to
generate node tree for it.

This module is part of manakai.

=cut

package Message::Markup::SuikaWikiConfig20::Parser;
use strict;
our $VERSION = do{my @r=(q$Revision: 1.2 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
require Message::Markup::SuikaWikiConfig20::Node;

=head1 METHODS

=over 4

=item $x = Message::Markup::SuikaWikiConfig20::Parser->new (%options)

Returns new instance of parser

=cut

sub new ($;%) {
  my $class = shift;
  my $self = bless {@_}, $class;
  $self;
}

sub parse_text ($$) {
  my ($self, $s) = @_;
  my $root = Message::Markup::SuikaWikiConfig20::Node->new
    (type => '#document');
  my $current = $root;
  my $current_element = $root;
  my $is_new_element = 0;
  my $is_list_element = 0;
  for my $line (split /\x0D?\x0A/, $s) {
    if ($line =~ /^([^#\s].*):\s*([^\s:][^:]*)?$/) {
      my ($name, $val) = ($1, $2);
      substr ($name, 0, 1) = '' if defined $name and 
                                   substr ($name, 0, 1) eq '\\';
      substr ($val, 0, 1) = '' if defined $val and
                                  substr ($val, 0, 1) eq '\\';
      if (substr ($name, -6) eq '[list]') {
        substr ($name, -6) = '';
        $val = length ($val) ? [$val] : [];
        $is_list_element = 1;
      } else {
        $is_list_element = 0;
      }
      $current_element = $root->append_new_node (type => '#element',
                                                 local_name => $name,
                                                 value => $val);
      if (defined $2) {  ## Foo: bar
        $current = $root;
        $current_element = $root;
      } else {           ## Foo:\n  bar\n  baz
        $current = $current_element;
        $is_new_element = 1;
      }
    } elsif ($line =~ /^\s+(\@+)(.*):\s*([^\s:][^:]*)?$/) {
      my ($nest, $name, $val) = (length $1, $2, $3);
      substr ($name, 0, 1) = '' if defined $name and 
                                   substr ($name, 0, 1) eq '\\';
      substr ($val, 0, 1) = '' if defined $val and
                                  substr ($val, 0, 1) eq '\\';
      if (substr ($name, -6) eq '[list]') {
        substr ($name, -6) = '';
        $val = (defined ($val) and length ($val)) ? [$val] : [];
        $is_list_element = 1;
      } else {
        $is_list_element = 0;
      }
      my $ce;
      if (length ($name)) {
        while ($current_element->flag ('p__nest_level', undef,
                                       default => 0) >= $nest) {
          $current_element = $current_element->parent_node;
        }
        $ce = $current_element->append_new_node (type => '#element',
                                                 local_name => $name,
                                                 value => $val);
        $ce->flag (p__nest_level
                   => $current_element->flag ('p__nest_level', undef,
                                              default => 0) + 1);
        unless (defined $3) {  ##  @foo: \nbar
          $current_element = $ce;
          $current = $ce;
          $is_new_element = 1;
        }
      } else {
        while ($current_element->flag ('p__nest_level', undef,
                                       default => 0) >= $nest - 1) {
          $current_element = $current_element->parent_node;
        }
        $current_element->append_text ($val);
        $current = $current_element;
        unless (defined $3) {  ##  @@: \nbar
          $is_new_element = 1;
        }
      }
    } elsif ($line =~ /^\s+([^\s#].*)$/) {
      my $val = $1;
      substr ($val, 0, 1) = '' if substr ($val, 0, 1) eq '\\';
      if ($is_new_element || $is_list_element) {
        $current_element->append_text ($val);
        $is_new_element = 0;
      } else {
        $current_element->append_text ("\x0A" . $val);
      }
    } elsif ($line =~ /^\s+$/) {
      # skip
    } elsif ($line =~ /^\s*\#(.*)$/) {
      if ($current->node_type eq '#comment') {
        $current->append_text ("\x0A" . $1);
      } else {
        $current = $root->append_new_node (type => '#comment', value => $1);
      }
    } else {
      $current = $root;
      #print STDERR qq(**$line**\n); 
    }
  }
  $root;
}

sub flag ($$;$) {
  my ($self, $name, $value) = @_;
  if (defined $value) {
    $self->{flag}->{$name} = $value;
  }
  $self->{flag}->{$name};
}

sub option ($$;$) {
  my ($self, $name, $value) = @_;
  if (defined $value) {
    $self->{option}->{$name} = $value;
  }
  $self->{option}->{$name};
}

=back

=head1 EXAMPLE

  use Message::Markup::SuikaWikiConfig20::Parser;
  my $parser = new Message::Markup::SuikaWikiConfig20::Parser;
  
  my $conf = $parser->parse_text ($config);
  print $conf->get_attribute ('Some Configuration Item');

=head1 SEE ALSO

Message::Markup::SuikaWikiConfig20::Node,
SuikaWiki <http://suika.fam.cx/~wakaba/-temp/wiki/wiki?SuikaWiki>,
<http://suika.fam.cx/~wakaba/-temp/wiki/wiki?SuikaWikiConfig/2.0>

=head1 HISTORY

This module was part of SuikaWiki 2, with the name of 
C<SuikaWiki::Markup::SuikaWikiConfig20::Parser>.

=head1 LICENSE

Copyright 2003 Wakaba <w@suika.fam.cx>

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut

1; # $Date: 2003/11/15 07:56:10 $
1	wakaba	1.1
2			=head1 NAME
3
4			Message::Markup::SuikaWikiConfig20::Parser: manakai --- SuikaWikiConfig/2.0 parser
5
6			=head1 DESCRIPTION
7
8			SuikaWikiConfig/2.0 is a general configuration description format.
9			This module can be used to parse such configuration and to
10			generate node tree for it.
11
12			This module is part of manakai.
13
14			=cut
15
16			package Message::Markup::SuikaWikiConfig20::Parser;
17			use strict;
18	wakaba	1.3	our $VERSION = do{my @r=(q$Revision: 1.2 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
19	wakaba	1.1	require Message::Markup::SuikaWikiConfig20::Node;
20
21			=head1 METHODS
22
23			=over 4
24
25			=item $x = Message::Markup::SuikaWikiConfig20::Parser->new (%options)
26
27			Returns new instance of parser
28
29			=cut
30
31			sub new ($;%) {
32			my $class = shift;
33			my $self = bless {@_}, $class;
34			$self;
35			}
36
37			sub parse_text ($$) {
38			my ($self, $s) = @_;
39	wakaba	1.2	my $root = Message::Markup::SuikaWikiConfig20::Node->new
40	wakaba	1.1	(type => '#document');
41			my $current = $root;
42			my $current_element = $root;
43			my $is_new_element = 0;
44			my $is_list_element = 0;
45			for my $line (split /\x0D?\x0A/, $s) {
46			if ($line =~ /^([^#\s].):\s([^\s:][^:]*)?$/) {
47			my ($name, $val) = ($1, $2);
48	wakaba	1.3	substr ($name, 0, 1) = '' if defined $name and
49			substr ($name, 0, 1) eq '\\';
50			substr ($val, 0, 1) = '' if defined $val and
51			substr ($val, 0, 1) eq '\\';
52	wakaba	1.1	if (substr ($name, -6) eq '[list]') {
53			substr ($name, -6) = '';
54			$val = length ($val) ? [$val] : [];
55			$is_list_element = 1;
56			} else {
57			$is_list_element = 0;
58			}
59			$current_element = $root->append_new_node (type => '#element',
60			local_name => $name,
61			value => $val);
62			if (defined $2) { ## Foo: bar
63			$current = $root;
64			$current_element = $root;
65			} else { ## Foo:\n bar\n baz
66			$current = $current_element;
67			$is_new_element = 1;
68			}
69			} elsif ($line =~ /^\s+(\@+)(.):\s([^\s:][^:]*)?$/) {
70			my ($nest, $name, $val) = (length $1, $2, $3);
71	wakaba	1.3	substr ($name, 0, 1) = '' if defined $name and
72			substr ($name, 0, 1) eq '\\';
73			substr ($val, 0, 1) = '' if defined $val and
74			substr ($val, 0, 1) eq '\\';
75	wakaba	1.1	if (substr ($name, -6) eq '[list]') {
76			substr ($name, -6) = '';
77	wakaba	1.3	$val = (defined ($val) and length ($val)) ? [$val] : [];
78	wakaba	1.1	$is_list_element = 1;
79			} else {
80			$is_list_element = 0;
81			}
82			my $ce;
83			if (length ($name)) {
84	wakaba	1.3	while ($current_element->flag ('p__nest_level', undef,
85			default => 0) >= $nest) {
86	wakaba	1.1	$current_element = $current_element->parent_node;
87			}
88			$ce = $current_element->append_new_node (type => '#element',
89			local_name => $name,
90			value => $val);
91			$ce->flag (p__nest_level
92	wakaba	1.3	=> $current_element->flag ('p__nest_level', undef,
93			default => 0) + 1);
94	wakaba	1.1	unless (defined $3) { ## @foo: \nbar
95			$current_element = $ce;
96			$current = $ce;
97			$is_new_element = 1;
98			}
99			} else {
100	wakaba	1.3	while ($current_element->flag ('p__nest_level', undef,
101			default => 0) >= $nest - 1) {
102	wakaba	1.1	$current_element = $current_element->parent_node;
103			}
104			$current_element->append_text ($val);
105			$current = $current_element;
106			unless (defined $3) { ## @@: \nbar
107			$is_new_element = 1;
108			}
109			}
110			} elsif ($line =~ /^\s+([^\s#].*)$/) {
111			my $val = $1;
112			substr ($val, 0, 1) = '' if substr ($val, 0, 1) eq '\\';
113			if ($is_new_element \|\| $is_list_element) {
114			$current_element->append_text ($val);
115			$is_new_element = 0;
116			} else {
117			$current_element->append_text ("\x0A" . $val);
118			}
119			} elsif ($line =~ /^\s+$/) {
120			# skip
121			} elsif ($line =~ /^\s\#(.)$/) {
122			if ($current->node_type eq '#comment') {
123			$current->append_text ("\x0A" . $1);
124			} else {
125			$current = $root->append_new_node (type => '#comment', value => $1);
126			}
127			} else {
128			$current = $root;
129			#print STDERR qq($line\n);
130			}
131			}
132			$root;
133			}
134
135			sub flag ($$;$) {
136			my ($self, $name, $value) = @_;
137			if (defined $value) {
138			$self->{flag}->{$name} = $value;
139			}
140			$self->{flag}->{$name};
141			}
142
143			sub option ($$;$) {
144			my ($self, $name, $value) = @_;
145			if (defined $value) {
146			$self->{option}->{$name} = $value;
147			}
148			$self->{option}->{$name};
149			}
150
151			=back
152
153			=head1 EXAMPLE
154
155			use Message::Markup::SuikaWikiConfig20::Parser;
156			my $parser = new Message::Markup::SuikaWikiConfig20::Parser;
157
158			my $conf = $parser->parse_text ($config);
159			print $conf->get_attribute ('Some Configuration Item');
160
161			=head1 SEE ALSO
162
163			Message::Markup::SuikaWikiConfig20::Node,
164			SuikaWiki <http://suika.fam.cx/~wakaba/-temp/wiki/wiki?SuikaWiki>,
165			<http://suika.fam.cx/~wakaba/-temp/wiki/wiki?SuikaWikiConfig/2.0>
166
167			=head1 HISTORY
168
169			This module was part of SuikaWiki 2, with the name of
170			C<SuikaWiki::Markup::SuikaWikiConfig20::Parser>.
171
172			=head1 LICENSE
173
174			Copyright 2003 Wakaba <w@suika.fam.cx>
175
176			This program is free software; you can redistribute it and/or
177			modify it under the same terms as Perl itself.
178
179			=cut
180
181	wakaba	1.3	1; # $Date: 2003/11/15 07:56:10 $