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 ref $opt{-parent} ?
                 $opt{-parent}->append_text ($opt{-attr_bare_text})
               : $opt{-class}->new (type => '#text',
                                    value => $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 ($key eq '-boolean') {
          $p->{$val} = 1;
        } else {
          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} > 0) {
    $p->{-parse_flag}->{$name} = -1;
    $p->{$name} = $self->replace ($p->{$name},
                                  %{$opt{option}}, param => $o,
                                  -parent => $opt{-parent});
  } elsif ($p->{-parse_flag}->{$name} < 0) {
    $p->{$name};
  } elsif ($opt{-non_parsed_to_node}) {
    $p->{$name} = $self->call (-attr_bare_text => 'main', $p, $o,
                               %{$opt{option}},
                               -attr_bare_text => $p->{$name},
                               -parent => $opt{-parent});
  } else {
    undef;
  }
}

=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/16 11:44:24 $
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	wakaba	1.2	return ref $opt{-parent} ?
31			$opt{-parent}->append_text ($opt{-attr_bare_text})
32			: $opt{-class}->new (type => '#text',
33			value => $opt{-attr_bare_text});
34	wakaba	1.1	},
35			},
36			-bare_text => {
37			main => sub {
38			my ($self, $name, $p, $o, %opt) = @_;
39			return $p->{-parent}->append_text ($p->{-bare_text});
40			},
41			},
42			-undef => {
43			main => sub {
44			my ($self, $name, $p, $o) = @_;
45			$p->{-parent}->append_text ("[undef: $name]");
46			},
47			},
48			-default => {
49			pre => sub {
50	wakaba	1.2	# my ($self, $name, $p, $o, %opt) = @_;
51			# local $p->{-parent} = $o->{-result};
52	wakaba	1.1	},
53			post => sub {
54			my ($self, $name, $p, $o, %opt) = @_;
55			local $p->{-parent} = $o->{-result};
56			$self->call ($name, 'main', $p, $o, %opt);
57			},
58			attr => sub {
59			my ($self, $name, $p, $o, $key, $val, %opt) = @_;
60	wakaba	1.2	if ($key eq '-boolean') {
61			$p->{$val} = 1;
62			} else {
63			if ($opt{-value_flag} and index ($opt{-value_flag}, 'p') > -1) {
64			$p->{-parse_flag}->{$key} = 1;
65			}
66			$p->{$key} = $val;
67	wakaba	1.1	}
68			},
69			main => sub {
70			},
71			},
72			-entire => {
73			pre => sub {
74			my ($self, $name, $p, $o, %opt) = @_;
75			if (ref $opt{option}->{-parent}) {
76			$o->{-result} = $opt{option}->{-parent};
77			} else {
78			$o->{-result} = $opt{option}->{-class}->new
79			(type => '#fragment');
80			}
81			},
82			post => sub {
83			},
84			attr => sub {
85			},
86			},
87			percent => {
88			main => sub {
89			my ($self, $name, $p, $o) = @_;
90			$p->{-parent}->append_text ('%');
91			},
92			},
93			}}
94
95			sub new ($;%) {
96			my ($class, %opt) = @_;
97			my $rule = $opt{rule};
98			$opt{rule} = sub {
99			$_[0]->rule_def->{$_[1]}
100			or
101			__PACKAGE__->rule_def->{$_[1]}
102			};
103			$class->SUPER::new (%opt);
104			}
105
106			sub parse_attr ($$$$;%) {
107			my ($self, $p, $name, $o, %opt) = @_;
108	wakaba	1.2	if ($p->{-parse_flag}->{$name} > 0) {
109			$p->{-parse_flag}->{$name} = -1;
110			$p->{$name} = $self->replace ($p->{$name},
111			%{$opt{option}}, param => $o,
112			-parent => $opt{-parent});
113			} elsif ($p->{-parse_flag}->{$name} < 0) {
114			$p->{$name};
115	wakaba	1.1	} elsif ($opt{-non_parsed_to_node}) {
116	wakaba	1.2	$p->{$name} = $self->call (-attr_bare_text => 'main', $p, $o,
117			%{$opt{option}},
118			-attr_bare_text => $p->{$name},
119			-parent => $opt{-parent});
120			} else {
121			undef;
122	wakaba	1.1	}
123			}
124
125			=head1 LICENSE
126
127			Copyright 2003 Wakaba <[email protected]>
128
129			This program is free software; you can redistribute it and/or
130			modify it under the same terms as Perl itself.
131
132			=cut
133
134	wakaba	1.2	1; # $Date: 2003/11/16 11:44:24 $