1#!/usr/bin/perl -w 2 3use strict; 4 5use FindBin qw($Bin); 6 7use Test::More tests => 179; 8#use Test::More 'no_plan'; 9 10use_ok('Rose::HTML::Objects'); 11 12use File::Spec; 13use File::Path; 14 15# 16# In-memory 17# 18 19my %code = 20( 21 'My::HTML::Object::Message::Localizer' => 22 { 23 filter => sub { s/__FOO__//g }, 24 code =><<'EOF', 25sub get_localized_message_text__FOO____BAR__ 26{ 27 my($self) = shift; 28 no warnings 'uninitialized'; 29 return uc $self->SUPER::get_localized_message_text(@_); 30} 31EOF 32 }, 33 34 'My::HTML::Form::Field::File' =><<'EOF', 35our $JCS = 123; 36EOF 37); 38 39#$Rose::HTML::Objects::Debug = 3; 40my($packages, $perl) = 41 Rose::HTML::Objects->make_private_library(in_memory => 1, 42 prefix => 'My::', 43 class_filter => sub { !/Email/ }, 44 code_filter => sub { s/__BAR__//g }, 45 code => \%code); 46 47is(scalar @My::HTML::Form::Field::Email::ISA, 0, 'class_filter'); 48 49QUIET: 50{ 51 no warnings; 52 is($My::HTML::Form::Field::File::JCS, 123, 'code additions'); 53} 54 55my $field = My::HTML::Form::Field::Text->new(name => 'x', required => 1); 56my $std_field = Rose::HTML::Form::Field::Text->new(name => 'x', required => 1); 57 58$field->validate; 59$std_field->validate; 60 61is($field->error, uc $std_field->error, 'upcase error 1'); 62 63$field = My::HTML::Form::Field::PopUpMenu->new(name => 'x'); 64 65$field->options(a => 'Apple', b => 'Pear'); 66 67is(ref $field->option('a'), 'My::HTML::Form::Field::Option', 'option 1'); 68 69my $object = My::HTML::Object->new('xyz'); 70 71is($object->validate_html_attrs, 0, 'generic object 1'); 72 73eval { $object->html_attr(foo => 'bar') }; 74ok(!$@, 'generic object 2'); 75 76foreach my $type (My::HTML::Object->object_type_names) 77{ 78 my $std_class = Rose::HTML::Object->object_type_class($type); 79 (my $new_class = $std_class) =~ s/^Rose::/My::/; 80 81 is(My::HTML::Object->object_type_class($type), $new_class, "object type class: $type"); 82} 83 84GENERIC_FIELD: 85{ 86 package My::Field; 87 our @ISA = ('My::HTML::Form::Field'); 88 89 package main; 90 $field = My::Field->new; 91 ok($field->isa('Rose::HTML::Form::Field'), 'generic field 1'); 92} 93 94# 95# Module files 96# 97 98my $lib_dir = File::Spec->catfile($Bin, 'tmplib'); 99 100mkdir($lib_dir) unless(-d $lib_dir); 101die "Could not mkdir($lib_dir) - $!" unless(-d $lib_dir); 102 103%code = 104( 105 'My2::HTML::Object::Message::Localizer' =><<'EOF', 106our $TwiddleCase = 1; 107 108sub get_localized_message_text 109{ 110 my($self) = shift; 111 112 if($TwiddleCase) 113 { 114 no warnings 'uninitialized'; 115 return rand > 0.5 ? uc $self->SUPER::get_localized_message_text(@_) : 116 lc $self->SUPER::get_localized_message_text(@_); 117 } 118 else 119 { 120 return $self->SUPER::get_localized_message_text(@_); 121 } 122} 123EOF 124 125 'My2::HTML::Object::Messages' =><<'EOF', 126use constant FIELD_ERROR_BAD_NICKNAME => 100_000; 127use constant FIELD_ERROR_BAD_NICKNAME_AR => 100_001; 128use constant FIELD_ERROR_TOO_MANY_DAYS => 100_002; 129 130use constant FIELD_LABEL_NICKNAME => 200_000; 131EOF 132 133 'My2::HTML::Object::Errors' =><<'EOF', 134use constant FIELD_ERROR_BAD_NICKNAME => 100_000; 135use constant FIELD_ERROR_BAD_NICKNAME_AR => 100_001; 136use constant FIELD_ERROR_TOO_MANY_DAYS => 100_002; 137EOF 138); 139 140$packages = 141 Rose::HTML::Objects->make_private_library(modules_dir => $lib_dir, 142 overwrite => 1, 143 prefix => 'My2::', 144 code => \%code); 145 146unshift(@INC, $lib_dir); 147 148GENERIC_FIELD: 149{ 150 package My2::Field; 151 require My2::HTML::Form::Field; 152 our @ISA = ('My2::HTML::Form::Field'); 153 154 package main; 155 $field = My2::Field->new; 156 ok($field->isa('Rose::HTML::Form::Field'), 'generic field 2'); 157} 158 159require My2::HTML::Form::Field::Text; 160 161$field = My2::HTML::Form::Field::Text->new(name => 'x', required => 1); 162$std_field = Rose::HTML::Form::Field::Text->new(name => 'x', required => 1); 163 164$field->validate; 165$std_field->validate; 166 167my @errors; 168 169for(1 .. 10) 170{ 171 push(@errors, $field->error . ''); 172} 173 174ok((scalar grep { lc $std_field->error } @errors), 'lowercase error 1'); 175ok((scalar grep { lc $std_field->error } @errors), 'uppercase error 1'); 176 177require My2::HTML::Form::Field::PopUpMenu; 178 179$field = My2::HTML::Form::Field::PopUpMenu->new(name => 'x'); 180 181$field->options(a => 'Apple', b => 'Pear'); 182 183is(ref $field->option('a'), 'My2::HTML::Form::Field::Option', 'option 1'); 184 185require My2::HTML::Object; 186 187$object = My2::HTML::Object->new('xyz'); 188 189is($object->validate_html_attrs, 0, 'generic object 1'); 190 191eval { $object->html_attr(foo => 'bar') }; 192ok(!$@, 'generic object 2'); 193 194foreach my $type (My2::HTML::Object->object_type_names) 195{ 196 my $std_class = Rose::HTML::Object->object_type_class($type); 197 (my $new_class = $std_class) =~ s/^Rose::/My2::/; 198 199 is(My2::HTML::Object->object_type_class($type), $new_class, "object type class: $type"); 200} 201 202my @parts = split('::', 'My2::HTML::Form::Field::Nickname'); 203$parts[-1] .= '.pm'; 204 205my $nick_pm = File::Spec->catfile($lib_dir, @parts); 206#warn "# WRITE: $nick_pm\n"; 207 208open(my $fh, '>', $nick_pm) or die "Could not create '$nick_pm' - $!"; 209 210my $code=<<'EOF'; 211package My2::HTML::Form::Field::Nickname; 212 213use My2::HTML::Object::Errors qw(FIELD_ERROR_BAD_NICKNAME); 214use My2::HTML::Object::Messages qw(FIELD_LABEL_NICKNAME); 215 216use base qw(My2::HTML::Form::Field::Text); 217 218sub init 219{ 220 my($self) = shift; 221 $self->label_id(FIELD_LABEL_NICKNAME); 222 $self->SUPER::init(@_); 223} 224 225sub validate 226{ 227 my($self) = shift; 228 229 my $ret = $self->SUPER::validate(@_); 230 return $ret unless($ret); 231 232 my $nick = $self->internal_value; 233 my $class = $self->html_attr('class') || 'default'; 234 235 if($nick =~ /bob/) 236 { 237 $self->error_id(FIELD_ERROR_BAD_NICKNAME, { nickname => $nick, class => $class, list => [ 'a' .. 'e' ] }); 238 return 0; 239 } 240 elsif($nick =~ /lob/) 241 { 242 $self->error_id(FIELD_ERROR_BAD_NICKNAME_AR, [ $class, [ 'a' .. 'e' ], $nick ]); 243 return 0; 244 } 245 246 return 1; 247} 248 249if(__PACKAGE__->localizer->auto_load_messages) 250{ 251 __PACKAGE__->localizer->load_all_messages; 252} 253 2541; 255 256__DATA__ 257 258[% LOCALE en %] 259 260FIELD_ERROR_BAD_NICKNAME = "[class] - \\\[\]Invalid nickname: [@list]:[nickname]" 261FIELD_ERROR_BAD_NICKNAME_AR = "[1] - \\\[\]Invalid nickname: [@2]:[3]" 262 263FIELD_LABEL_NICKNAME = "Nickname" 264 265[% LOCALE fr %] 266 267FIELD_ERROR_BAD_NICKNAME = "[class] - \\\[\]Le nickname est mal: [@list]:[nickname]" 268 269FIELD_LABEL_NICKNAME = "Le Nickname" 270 271EOF 272 273print $fh $code; 274close($fh) or die "Could not write '$nick_pm' - $!"; 275 276require My2::HTML::Form::Field::Nickname; 277 278$field = My2::HTML::Form::Field::Nickname->new; 279 280is(ref($field->localizer), 'My2::HTML::Object::Message::Localizer', 'custom field localizer'); 281 282my $label = $field->label . ''; 283 284ok($label eq 'nickname' || $label eq 'NICKNAME', 'custom field label (en)'); 285 286$field->locale('fr'); 287 288$label = $field->label . ''; 289 290ok($label eq 'le nickname' || $label eq 'LE NICKNAME', 'custom field label (fr)'); 291 292BLAH: 293{ 294 no warnings; 295 $My2::HTML::Object::Message::Localizer::TwiddleCase = 0; 296} 297 298$field->input_value('lob'); 299$field->validate; 300is($field->error . '', 'default - \[]Invalid nickname: a, b, c, d, e:lob', 'placeholders (arrayref, fallback) 1'); 301 302$field->html_attr(class => 'c'); 303$field->validate; 304is($field->error. '', 'c - \[]Invalid nickname: a, b, c, d, e:lob', 'placeholders (arrayref, fallback) 2'); 305 306$field->input_value('bob'); 307$field->validate; 308 309$field->locale('en'); 310is($field->error. '', 'c - \[]Invalid nickname: a, b, c, d, e:bob', 'placeholders (hashref) 1'); 311 312$field->locale('fr'); 313is($field->error. '', 'c - \[]Le nickname est mal: a, b, c, d, e:bob', 'placeholders (hashref) 2'); 314 315require My2::HTML::Form; 316 317My2::HTML::Form->field_type_class 318( 319 nick => 'My2::HTML::Form::Field::Nickname', 320); 321 322# My2::HTML::Form->field_type_class 323# ( 324# nickname => 'My2::HTML::Form::Field::Nickname', 325# ); 326 327My2::HTML::Form->add_field_type_classes 328( 329 #nick => 'My2::HTML::Form::Field::Nickname', 330 nickname => 'My2::HTML::Form::Field::Nickname', 331); 332 333my $form = My2::HTML::Form->new; 334$field = My2::HTML::Form::Field::Nickname->new; 335$field->html_attr(class => 'c'); 336 337$form->add_field(nick => $field); 338 339$form->params(nick => 'bob'); 340$form->init_fields; 341$form->validate; 342 343is($form->field('nick')->error. '', 'c - \[]Invalid nickname: a, b, c, d, e:bob', 'form locale 1'); 344 345$form->locale('fr'); 346 347is($form->field('nick')->error. '', 'c - \[]Le nickname est mal: a, b, c, d, e:bob', 'form locale 2'); 348 349$form = My2::HTML::Form->new; 350 351$form->add_field(nick => { type => 'nick', class => 'c' }); 352 353$form->params({nick => 'bob'}); 354$form->init_fields; 355$form->validate; 356 357is($form->field('nick')->error. '', 'c - \[]Invalid nickname: a, b, c, d, e:bob', 'localizer locale 1'); 358 359My2::HTML::Object->localizer->locale('fr'); 360 361is($form->field('nick')->error. '', 'c - \[]Le nickname est mal: a, b, c, d, e:bob', 'localizer locale 2'); 362 363My2::HTML::Object->localizer->locale('en'); 364 365# 366# Days field 367# 368 369@parts = split('::', 'My2::HTML::Form::Field::Days'); 370$parts[-1] .= '.pm'; 371 372my $days_pm = File::Spec->catfile($lib_dir, @parts); 373#warn "# WRITE: $days_pm\n"; 374 375open($fh, '>', $days_pm) or die "Could not create '$days_pm' - $!"; 376 377$code=<<'EOF'; 378package My2::HTML::Form::Field::Days; 379 380use My2::HTML::Object::Errors qw(FIELD_ERROR_TOO_MANY_DAYS); 381 382use base qw(My2::HTML::Form::Field::Integer); 383 384 385if(__PACKAGE__->localizer->auto_load_messages) 386{ 387 __PACKAGE__->localizer->load_all_messages; 388} 389 3901; 391 392__DATA__ 393 394[% LOCALE en %] 395 396FIELD_ERROR_TOO_MANY_DAYS = "Too many days." 397FIELD_ERROR_TOO_MANY_DAYS(one) = "One day is too many." 398FIELD_ERROR_TOO_MANY_DAYS(two) = "Two days is too many." 399FIELD_ERROR_TOO_MANY_DAYS(few) = "[count] days is too many (few)." 400 401[% LOCALE fr %] 402 403FIELD_ERROR_TOO_MANY_DAYS = "Trop de jours." 404 405EOF 406 407print $fh $code; 408close($fh) or die "Could not write '$days_pm' - $!"; 409 410require My2::HTML::Form::Field::Days; 411 412require My2::HTML::Object::Errors; 413 414My2::HTML::Form::Field::Days->localizer->load_messages_from_string(<<"EOF"); 415[% LOCALE en %] 416 417FIELD_ERROR_TOO_MANY_DAYS(few) = "[count] days is too many (few)." 418FIELD_ERROR_TOO_MANY_DAYS(many) = "[count] days is too many (many)." 419FIELD_ERROR_TOO_MANY_DAYS(plural) = "[count] days is too many." 420 421[% LOCALE fr %] 422 423FIELD_ERROR_TOO_MANY_DAYS(one) = "Un jour est un trop grand nombre." 424FIELD_ERROR_TOO_MANY_DAYS(plural) = "[count] jours est un trop grand nombre." 425 426[% LOCALE xx %] 427 428FIELD_ERROR_TOO_MANY_DAYS = "[count] [variant] xx too many days." 429 430EOF 431 432$field = My2::HTML::Form::Field::Days->new(name => 'days'); 433 434my $error_id = My2::HTML::Object::Errors::FIELD_ERROR_TOO_MANY_DAYS(); 435 436$field->error_id($error_id, { count => 0 }); 437is($field->error, '0 days is too many.', 'zero variant (en)'); 438 439$field->error_id($error_id, { count => 1 }); 440 441is($field->error, 'One day is too many.', 'one variant (en)'); 442 443$field->error_id($error_id, { count => 2 }); 444 445is($field->error, 'Two days is too many.', 'two variant (en)'); 446 447$field->error_id($error_id, { count => 3 }); 448is($field->error, '3 days is too many.', 'plural fallback variant (en)'); 449 450$field->error_id($error_id, { count => 3, variant => 'few' }); 451is($field->error, '3 days is too many (few).', 'few explicit variant (en)'); 452 453$field->error_id($error_id, { count => 3, variant => 'many' }); 454is($field->error, '3 days is too many (many).', 'many explicit variant (en)'); 455 456$field->locale('fr'); 457 458$field->error_id($error_id, { count => 0 }); 459is($field->error, '0 jours est un trop grand nombre.', 'zero variant (fr)'); 460 461$field->error_id($error_id, { count => 1 }); 462 463is($field->error, 'Un jour est un trop grand nombre.', 'one variant (fr)'); 464 465$field->error_id($error_id, { count => 2 }); 466 467is($field->error, '2 jours est un trop grand nombre.', 'two variant (fr)'); 468 469$field->error_id($error_id, { count => 3 }); 470is($field->error, '3 jours est un trop grand nombre.', 'plural fallback variant (fr)'); 471 472$field->error_id($error_id, { count => 3, variant => 'few' }); 473is($field->error, '3 jours est un trop grand nombre.', 'few explicit variant (fr)'); 474 475$field->error_id($error_id, { count => 3, variant => 'many' }); 476is($field->error, '3 jours est un trop grand nombre.', 'many explicit variant (fr)'); 477 478$field->locale('xx'); 479 480ok(!$field->localizer->localized_message_exists('FIELD_ERROR_TOO_MANY_DAYS', 'xx', 'zero'), 'localized_message_exists 1'); 481 482$field->error_id($error_id, { count => 0 }); 483 484is($field->error, '0 xx too many days.', 'zero variant (xx)'); 485 486$field->error_id($error_id, { count => 1 }); 487 488is($field->error, '1 xx too many days.', 'one variant (xx)'); 489 490$field->error_id($error_id, { count => 2 }); 491 492is($field->error, '2 xx too many days.', 'two variant (xx)'); 493 494$field->error_id($error_id, { count => 3 }); 495is($field->error, '3 xx too many days.', 'plural fallback variant (xx)'); 496 497$field->error_id($error_id, { count => 3, variant => 'few' }); 498is($field->error, '3 few xx too many days.', 'few explicit variant (xx)'); 499 500$field->error_id($error_id, { count => 3, variant => 'many' }); 501is($field->error, '3 many xx too many days.', 'many explicit variant (xx)'); 502 503($packages, $perl) = 504 Rose::HTML::Objects->make_private_library(in_memory => 1, 505 rename => sub { s/Rose::H/MyH/ }); 506 507ok(MyHTML::Object->isa('Rose::HTML::Object'), 'rename sub 1'); 508 509END 510{ 511 if($lib_dir && -d $lib_dir) 512 { 513 #rmtree($lib_dir); 514 } 515} 516