Util/Formatter/Node.pm


=head1 NAME

Message::Util::Formatter::Node --- Manakai : Generating Node tree with formatting rule

=head1 DESCRIPTION

This module is an application of Message::Util::Formatter mechanism,
used to generate a node tree (fragment) with given formatting
rule text and formatting functions.

Although this module is intended to be used in combination with 
Message::Markup::XML::Node, it can be useful as a base class for
other node module interface.

This module is part of manakai.

=cut

package Message::Util::Formatter::Node;
use strict;
our $VERSION = do{my @r=(q$Revision: 1.1 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
require Message::Util::Formatter::Base;
our @ISA = 'Message::Util::Formatter::Base';

sub rule_def () {+{
    -attr_bare_text => {
      main => sub {
        my ($self, $name, $p, $o, %opt) = @_;
        return $opt{-parent}->append_text ($opt{-attr_bare_text});
      },
    },
    -bare_text => {
      main => sub {
        my ($self, $name, $p, $o, %opt) = @_;
        return $p->{-parent}->append_text ($p->{-bare_text});
      },
    },
    -undef     => {
      main => sub {
        my ($self, $name, $p, $o) = @_;
        $p->{-parent}->append_text ("[undef: $name]");
      },             
    },
    -default   => {
      pre => sub { 
        my ($self, $name, $p, $o, %opt) = @_;
        local $p->{-parent} = $o->{-result};
      },
      post => sub { 
        my ($self, $name, $p, $o, %opt) = @_;
        local $p->{-parent} = $o->{-result};
        $self->call ($name, 'main', $p, $o, %opt);
      },
      attr => sub {
        my ($self, $name, $p, $o, $key, $val, %opt) = @_;
        if ($opt{-value_flag} and index ($opt{-value_flag}, 'p') > -1) {
          $p->{-parse_flag}->{$key} = 1;
        }
        $p->{$key} = $val;
      },                 
      main => sub {
      },
    },
    -entire    => {
      pre => sub {
        my ($self, $name, $p, $o, %opt) = @_;
        if (ref $opt{option}->{-parent}) {
          $o->{-result} = $opt{option}->{-parent};
        } else {
          $o->{-result} = $opt{option}->{-class}->new
            (type => '#fragment');
        }
      },
      post => sub {
      },
      attr => sub {
      },
    },
    percent => {
      main => sub {
        my ($self, $name, $p, $o) = @_;
        $p->{-parent}->append_text ('%');
      },
    },
}}

sub new ($;%) {
  my ($class, %opt) = @_;
  my $rule = $opt{rule};
  $opt{rule} = sub {
    $_[0]->rule_def->{$_[1]}
      or
    __PACKAGE__->rule_def->{$_[1]}
  };
  $class->SUPER::new (%opt);
}

sub parse_attr ($$$$;%) {
  my ($self, $p, $name, $o, %opt) = @_;
  if ($p->{-parse_flag}->{$name}) {
    $p->{$name} = $self->replace ($p->{$name}, param => $o, 
                                  -parent => $opt{-parent},
                                  %{$opt{option}});
  } elsif ($opt{-non_parsed_to_node}) {
    $self->call (-attr_bare_text => 'main', $p, $o,
                 -attr_bare_text => $p->{$name},
                 -parent => $opt{-parent},
                 %{$opt{option}});
  }
}

=head1 LICENSE

Copyright 2003 Wakaba <[email protected]>

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 12:30:42 $
1	wakaba	1.1
2			=head1 NAME
3
4			Message::Util::Formatter::Node --- Manakai : Generating Node tree with formatting rule
5
6			=head1 DESCRIPTION
7
8			This module is an application of Message::Util::Formatter mechanism,
9			used to generate a node tree (fragment) with given formatting
10			rule text and formatting functions.
11
12			Although this module is intended to be used in combination with
13			Message::Markup::XML::Node, it can be useful as a base class for
14			other node module interface.
15
16			This module is part of manakai.
17
18			=cut
19
20			package Message::Util::Formatter::Node;
21			use strict;
22			our $VERSION = do{my @r=(q$Revision: 1.1 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
23			require Message::Util::Formatter::Base;
24			our @ISA = 'Message::Util::Formatter::Base';
25
26			sub rule_def () {+{
27			-attr_bare_text => {
28			main => sub {
29			my ($self, $name, $p, $o, %opt) = @_;
30			return $opt{-parent}->append_text ($opt{-attr_bare_text});
31			},
32			},
33			-bare_text => {
34			main => sub {
35			my ($self, $name, $p, $o, %opt) = @_;
36			return $p->{-parent}->append_text ($p->{-bare_text});
37			},
38			},
39			-undef => {
40			main => sub {
41			my ($self, $name, $p, $o) = @_;
42			$p->{-parent}->append_text ("[undef: $name]");
43			},
44			},
45			-default => {
46			pre => sub {
47			my ($self, $name, $p, $o, %opt) = @_;
48			local $p->{-parent} = $o->{-result};
49			},
50			post => sub {
51			my ($self, $name, $p, $o, %opt) = @_;
52			local $p->{-parent} = $o->{-result};
53			$self->call ($name, 'main', $p, $o, %opt);
54			},
55			attr => sub {
56			my ($self, $name, $p, $o, $key, $val, %opt) = @_;
57			if ($opt{-value_flag} and index ($opt{-value_flag}, 'p') > -1) {
58			$p->{-parse_flag}->{$key} = 1;
59			}
60			$p->{$key} = $val;
61			},
62			main => sub {
63			},
64			},
65			-entire => {
66			pre => sub {
67			my ($self, $name, $p, $o, %opt) = @_;
68			if (ref $opt{option}->{-parent}) {
69			$o->{-result} = $opt{option}->{-parent};
70			} else {
71			$o->{-result} = $opt{option}->{-class}->new
72			(type => '#fragment');
73			}
74			},
75			post => sub {
76			},
77			attr => sub {
78			},
79			},
80			percent => {
81			main => sub {
82			my ($self, $name, $p, $o) = @_;
83			$p->{-parent}->append_text ('%');
84			},
85			},
86			}}
87
88			sub new ($;%) {
89			my ($class, %opt) = @_;
90			my $rule = $opt{rule};
91			$opt{rule} = sub {
92			$_[0]->rule_def->{$_[1]}
93			or
94			__PACKAGE__->rule_def->{$_[1]}
95			};
96			$class->SUPER::new (%opt);
97			}
98
99			sub parse_attr ($$$$;%) {
100			my ($self, $p, $name, $o, %opt) = @_;
101			if ($p->{-parse_flag}->{$name}) {
102			$p->{$name} = $self->replace ($p->{$name}, param => $o,
103			-parent => $opt{-parent},
104			%{$opt{option}});
105			} elsif ($opt{-non_parsed_to_node}) {
106			$self->call (-attr_bare_text => 'main', $p, $o,
107			-attr_bare_text => $p->{$name},
108			-parent => $opt{-parent},
109			%{$opt{option}});
110			}
111			}
112
113			=head1 LICENSE
114
115			Copyright 2003 Wakaba <[email protected]>
116
117			This program is free software; you can redistribute it and/or
118			modify it under the same terms as Perl itself.
119
120			=cut
121
122			1; # $Date: 2003/11/15 12:30:42 $