manakai/t/util-formatter-base.t

#!/usr/bin/perl
use Message::Util::Formatter::Base;
use Test::Simple tests => 10;

sub OK ($$) {
  ok $_[0] eq $_[1], $_[0] eq $_[1] ? undef : qq("$_[0]" ("$_[1]" expected));
}

my $f = Message::Util::Formatter::Base->new
  (rule => {
            bar => {
                    pre => sub {
                      my ($f, $name, $p, $o) = @_;
                      $p->{-result} = '<:bar:>';
                    },
                    post => sub {
                      my ($f, $name, $p, $o) = @_;
                      $p->{-result} .= '</:bar:>';
                    },
                   },
            -default => {
                    pre => sub {
                      my ($f, $name, $p, $o) = @_;
                      $p->{-result} = "<$name>";
                    },
                    post => sub {
                      my ($f, $name, $p, $o) = @_;
                      $p->{-result} .= "</$name>";
                    },
                    attr => sub {
                      my ($f, $name, $p, $o, $key => $val, %opt) = @_;
                      $key = "$key\[$opt{-name_flag}]" if $opt{-name_flag};
                      $val = "$val\[$opt{-value_flag}]" if $opt{-value_flag};
                      $p->{-result} .= "{$key=$val}";
                    },
                   },
            -entire => {
                    pre => sub {
                      my ($f, $name, $p, $o) = @_;
                      $p->{-result} = '<<';
                    },
                    post => sub {
                      my ($f, $name, $p, $o) = @_;
                      $p->{-result} .= '>>';
                    },
                    attr => sub {
                      my ($f, $name, $p, $o, $key => $val) = @_;
                      $p->{-result} .= "[[$key:$val->{-result}]]";
                    },
                   },
           });

OK $f->replace ("foo%bar;%baz;foo&%  %  \n%% foo"), qq<<<[[-bare_text:<-bare_text>{-bare_text=foo}</-bare_text>]][[bar:<:bar:></:bar:>]][[baz:<baz></baz>]][[-bare_text:<-bare_text>{-bare_text=foo&%  %  \n%% foo}</-bare_text>]]>>>;

OK $f->replace (q(%foo({attr3}=>{value3});)),
   q<<<[[foo:<foo>{attr3=value3}</foo>]]>>>;

OK $f->replace (q(%foo(attr1=>value1,"attr2"=>"value2",{attr3}=>{value3});)),
   q<<<[[foo:<foo>{attr1=value1}{attr2=value2}{attr3=value3}</foo>]]>>>;

OK $f->replace (q(%foo(attr1,"\\\\attr\2"=>"\\\\value\2");)),
   q<<<[[foo:<foo>{-boolean=attr1}{\\attr2=\\value2}</foo>]]>>>;

OK $f->replace (q(%foo({{attr{1}}}=>{{value{1}}});)),
   q<<<[[foo:<foo>{{attr{1}}={value{1}}}</foo>]]>>>;

OK $f->replace (q(%foo 
                  ( ,  attr1  =>       value1
 ,               ,) ;)),
   q<<<[[foo:<foo>{attr1=value1}</foo>]]>>>;

OK $f->replace (q(%foo({{attr{1}}} flag =>{{value{1}}} flag);)),
   q<<<[[foo:<foo>{{attr{1}}[flag]={value{1}}[flag]}</foo>]]>>>;

use Message::Util::Error;
try {
  $f->replace (q(%invalid));
  OK 0, 1;
} catch Message::Util::Formatter::Base::error with {
  my $err = shift;
  OK $err->text, qq(Semicolon (";") expected at "%invalid"**here**"<empty>");
};

try {
  $f->replace (q(Something, Something%invalid! Syntax error! Syntax error!));
  OK 0, 2;
} catch Message::Util::Formatter::Base::error with {
  my $err = shift;
  OK $err->text, q(Semicolon (";") expected at "g, Something%invalid"**here**"! Syntax error! Synt");
};

try {
  $f->replace (q(%invalid(a=>b!);));
  OK 0, 3;
} catch Message::Util::Formatter::error with {
  my $err = shift;
  OK $err->text, q[Separator ("," or ")") expected at "%invalid(a=>b"**here**"!);"];
};
1	#!/usr/bin/perl
2	use Message::Util::Formatter::Base;
3	use Test::Simple tests => 10;
4
5	sub OK ($$) {
6	ok $_[0] eq $_[1], $_[0] eq $_[1] ? undef : qq("$_[0]" ("$_[1]" expected));
7	}
8
9	my $f = Message::Util::Formatter::Base->new
10	(rule => {
11	bar => {
12	pre => sub {
13	my ($f, $name, $p, $o) = @_;
14	$p->{-result} = '<:bar:>';
15	},
16	post => sub {
17	my ($f, $name, $p, $o) = @_;
18	$p->{-result} .= '</:bar:>';
19	},
20	},
21	-default => {
22	pre => sub {
23	my ($f, $name, $p, $o) = @_;
24	$p->{-result} = "<$name>";
25	},
26	post => sub {
27	my ($f, $name, $p, $o) = @_;
28	$p->{-result} .= "</$name>";
29	},
30	attr => sub {
31	my ($f, $name, $p, $o, $key => $val, %opt) = @_;
32	$key = "$key\[$opt{-name_flag}]" if $opt{-name_flag};
33	$val = "$val\[$opt{-value_flag}]" if $opt{-value_flag};
34	$p->{-result} .= "{$key=$val}";
35	},
36	},
37	-entire => {
38	pre => sub {
39	my ($f, $name, $p, $o) = @_;
40	$p->{-result} = '<<';
41	},
42	post => sub {
43	my ($f, $name, $p, $o) = @_;
44	$p->{-result} .= '>>';
45	},
46	attr => sub {
47	my ($f, $name, $p, $o, $key => $val) = @_;
48	$p->{-result} .= "[[$key:$val->{-result}]]";
49	},
50	},
51	});
52
53	OK $f->replace ("foo%bar;%baz;foo&% % \n%% foo"), qq<<<[[-bare_text:<-bare_text>{-bare_text=foo}</-bare_text>]][[bar:<:bar:></:bar:>]][[baz:<baz></baz>]][[-bare_text:<-bare_text>{-bare_text=foo&% % \n%% foo}</-bare_text>]]>>>;
54
55	OK $f->replace (q(%foo({attr3}=>{value3});)),
56	q<<<[[foo:<foo>{attr3=value3}</foo>]]>>>;
57
58	OK $f->replace (q(%foo(attr1=>value1,"attr2"=>"value2",{attr3}=>{value3});)),
59	q<<<[[foo:<foo>{attr1=value1}{attr2=value2}{attr3=value3}</foo>]]>>>;
60
61	OK $f->replace (q(%foo(attr1,"\\\\attr\2"=>"\\\\value\2");)),
62	q<<<[[foo:<foo>{-boolean=attr1}{\\attr2=\\value2}</foo>]]>>>;
63
64	OK $f->replace (q(%foo({{attr{1}}}=>{{value{1}}});)),
65	q<<<[[foo:<foo>{{attr{1}}={value{1}}}</foo>]]>>>;
66
67	OK $f->replace (q(%foo
68	( , attr1 => value1
69	, ,) ;)),
70	q<<<[[foo:<foo>{attr1=value1}</foo>]]>>>;
71
72	OK $f->replace (q(%foo({{attr{1}}} flag =>{{value{1}}} flag);)),
73	q<<<[[foo:<foo>{{attr{1}}[flag]={value{1}}[flag]}</foo>]]>>>;
74
75	use Message::Util::Error;
76	try {
77	$f->replace (q(%invalid));
78	OK 0, 1;
79	} catch Message::Util::Formatter::Base::error with {
80	my $err = shift;
81	OK $err->text, qq(Semicolon (";") expected at "%invalid"here"<empty>");
82	};
83
84	try {
85	$f->replace (q(Something, Something%invalid! Syntax error! Syntax error!));
86	OK 0, 2;
87	} catch Message::Util::Formatter::Base::error with {
88	my $err = shift;
89	OK $err->text, q(Semicolon (";") expected at "g, Something%invalid"here"! Syntax error! Synt");
90	};
91
92	try {
93	$f->replace (q(%invalid(a=>b!);));
94	OK 0, 3;
95	} catch Message::Util::Formatter::error with {
96	my $err = shift;
97	OK $err->text, q[Separator ("," or ")") expected at "%invalid(a=>b"here"!);"];
98	};