t/private-library.t - metacpan.org

#!/usr/bin/perl -w

use strict;

use FindBin qw($Bin);

use Test::More tests => 179;
#use Test::More 'no_plan';

use_ok('Rose::HTML::Objects');

use File::Spec;
use File::Path;

#
# In-memory
#

my %code =
(
  'My::HTML::Object::Message::Localizer' =>
  {
    filter => sub { s/__FOO__//g },
    code   =><<'EOF',
sub get_localized_message_text__FOO____BAR__
{
  my($self) = shift;
  no warnings 'uninitialized';
  return uc $self->SUPER::get_localized_message_text(@_);
}
EOF
  },

  'My::HTML::Form::Field::File' =><<'EOF',
our $JCS = 123;
EOF
);

#$Rose::HTML::Objects::Debug = 3;
my($packages, $perl) = 
  Rose::HTML::Objects->make_private_library(in_memory    => 1, 
                                            prefix       => 'My::',
                                            class_filter => sub { !/Email/ },
                                            code_filter  => sub {  s/__BAR__//g },
                                            code         => \%code);

is(scalar @My::HTML::Form::Field::Email::ISA, 0, 'class_filter');

QUIET:
{
  no warnings;
  is($My::HTML::Form::Field::File::JCS, 123, 'code additions');
}

my $field     = My::HTML::Form::Field::Text->new(name => 'x', required => 1);
my $std_field = Rose::HTML::Form::Field::Text->new(name => 'x', required => 1);

$field->validate;
$std_field->validate;

is($field->error, uc $std_field->error, 'upcase error 1');

$field = My::HTML::Form::Field::PopUpMenu->new(name => 'x');

$field->options(a => 'Apple', b => 'Pear');

is(ref $field->option('a'), 'My::HTML::Form::Field::Option', 'option 1');

my $object = My::HTML::Object->new('xyz');

is($object->validate_html_attrs, 0, 'generic object 1');

eval { $object->html_attr(foo => 'bar') };
ok(!$@, 'generic object 2');

foreach my $type (My::HTML::Object->object_type_names)
{
  my $std_class = Rose::HTML::Object->object_type_class($type);
  (my $new_class = $std_class) =~ s/^Rose::/My::/;

  is(My::HTML::Object->object_type_class($type), $new_class, "object type class: $type");
}

GENERIC_FIELD:
{
  package My::Field;
  our @ISA = ('My::HTML::Form::Field');

  package main;
  $field = My::Field->new;
  ok($field->isa('Rose::HTML::Form::Field'), 'generic field 1');
}

#
# Module files
#

my $lib_dir = File::Spec->catfile($Bin, 'tmplib');

mkdir($lib_dir)  unless(-d $lib_dir);
die "Could not mkdir($lib_dir) - $!"  unless(-d $lib_dir);

%code =
(
  'My2::HTML::Object::Message::Localizer' =><<'EOF',
our $TwiddleCase = 1;

sub get_localized_message_text
{
  my($self) = shift;

  if($TwiddleCase)
  {
    no warnings 'uninitialized';
    return rand > 0.5 ? uc $self->SUPER::get_localized_message_text(@_) :
                        lc $self->SUPER::get_localized_message_text(@_);
  }
  else
  {
    return $self->SUPER::get_localized_message_text(@_);
  }
}
EOF

  'My2::HTML::Object::Messages' =><<'EOF',
use constant FIELD_ERROR_BAD_NICKNAME    => 100_000;
use constant FIELD_ERROR_BAD_NICKNAME_AR => 100_001;
use constant FIELD_ERROR_TOO_MANY_DAYS   => 100_002;

use constant FIELD_LABEL_NICKNAME        => 200_000;
EOF

  'My2::HTML::Object::Errors' =><<'EOF',
use constant FIELD_ERROR_BAD_NICKNAME    => 100_000;
use constant FIELD_ERROR_BAD_NICKNAME_AR => 100_001;
use constant FIELD_ERROR_TOO_MANY_DAYS   => 100_002;
EOF
);

$packages =
  Rose::HTML::Objects->make_private_library(modules_dir => $lib_dir, 
                                            overwrite   => 1,
                                            prefix      => 'My2::',
                                            code        => \%code);

unshift(@INC, $lib_dir);

GENERIC_FIELD:
{
  package My2::Field;
  require My2::HTML::Form::Field;
  our @ISA = ('My2::HTML::Form::Field');

  package main;
  $field = My2::Field->new;
  ok($field->isa('Rose::HTML::Form::Field'), 'generic field 2');
}

require My2::HTML::Form::Field::Text;

$field     = My2::HTML::Form::Field::Text->new(name => 'x', required => 1);
$std_field = Rose::HTML::Form::Field::Text->new(name => 'x', required => 1);

$field->validate;
$std_field->validate;

my @errors;

for(1 .. 10)
{
  push(@errors, $field->error . '');
}

ok((scalar grep { lc $std_field->error } @errors), 'lowercase error 1');
ok((scalar grep { lc $std_field->error } @errors), 'uppercase error 1');

require My2::HTML::Form::Field::PopUpMenu;

$field = My2::HTML::Form::Field::PopUpMenu->new(name => 'x');

$field->options(a => 'Apple', b => 'Pear');

is(ref $field->option('a'), 'My2::HTML::Form::Field::Option', 'option 1');

require My2::HTML::Object;

$object = My2::HTML::Object->new('xyz');

is($object->validate_html_attrs, 0, 'generic object 1');

eval { $object->html_attr(foo => 'bar') };
ok(!$@, 'generic object 2');

foreach my $type (My2::HTML::Object->object_type_names)
{
  my $std_class = Rose::HTML::Object->object_type_class($type);
  (my $new_class = $std_class) =~ s/^Rose::/My2::/;

  is(My2::HTML::Object->object_type_class($type), $new_class, "object type class: $type");
}

my @parts = split('::', 'My2::HTML::Form::Field::Nickname');
$parts[-1] .= '.pm';

my $nick_pm = File::Spec->catfile($lib_dir, @parts);
#warn "# WRITE: $nick_pm\n";

open(my $fh, '>', $nick_pm) or die "Could not create '$nick_pm' - $!";

my $code=<<'EOF';
package My2::HTML::Form::Field::Nickname;

use My2::HTML::Object::Errors qw(FIELD_ERROR_BAD_NICKNAME);
use My2::HTML::Object::Messages qw(FIELD_LABEL_NICKNAME);

use base qw(My2::HTML::Form::Field::Text);

sub init
{
  my($self) = shift;
  $self->label_id(FIELD_LABEL_NICKNAME);
  $self->SUPER::init(@_);
}

sub validate
{
  my($self) = shift;

  my $ret = $self->SUPER::validate(@_);
  return $ret  unless($ret);

  my $nick  = $self->internal_value;
  my $class = $self->html_attr('class') || 'default';

  if($nick =~ /bob/)
  {
    $self->error_id(FIELD_ERROR_BAD_NICKNAME, { nickname => $nick, class => $class, list => [ 'a' .. 'e' ] });
    return 0;
  }
  elsif($nick =~ /lob/)
  {
    $self->error_id(FIELD_ERROR_BAD_NICKNAME_AR, [ $class, [ 'a' .. 'e' ], $nick ]);
    return 0;
  }

  return 1;
}

if(__PACKAGE__->localizer->auto_load_messages)
{
  __PACKAGE__->localizer->load_all_messages;
}

1;

__DATA__

[% LOCALE en %]

FIELD_ERROR_BAD_NICKNAME = "[class] - \\\[\]Invalid nickname: [@list]:[nickname]"
FIELD_ERROR_BAD_NICKNAME_AR = "[1] - \\\[\]Invalid nickname: [@2]:[3]"

FIELD_LABEL_NICKNAME = "Nickname"

[% LOCALE fr %]

FIELD_ERROR_BAD_NICKNAME = "[class] - \\\[\]Le nickname est mal: [@list]:[nickname]"

FIELD_LABEL_NICKNAME = "Le Nickname"

EOF

print $fh $code;
close($fh) or die "Could not write '$nick_pm' - $!";

require My2::HTML::Form::Field::Nickname;

$field = My2::HTML::Form::Field::Nickname->new;

is(ref($field->localizer), 'My2::HTML::Object::Message::Localizer', 'custom field localizer');

my $label = $field->label . '';

ok($label eq 'nickname' || $label eq 'NICKNAME', 'custom field label (en)');

$field->locale('fr');

$label = $field->label . '';

ok($label eq 'le nickname' || $label eq 'LE NICKNAME', 'custom field label (fr)');

BLAH:
{
  no warnings;
  $My2::HTML::Object::Message::Localizer::TwiddleCase = 0;
}

$field->input_value('lob');
$field->validate;
is($field->error . '', 'default - \[]Invalid nickname: a, b, c, d, e:lob', 'placeholders (arrayref, fallback) 1');

$field->html_attr(class => 'c');
$field->validate;
is($field->error. '', 'c - \[]Invalid nickname: a, b, c, d, e:lob', 'placeholders (arrayref, fallback) 2');

$field->input_value('bob');
$field->validate;

$field->locale('en');
is($field->error. '', 'c - \[]Invalid nickname: a, b, c, d, e:bob', 'placeholders (hashref) 1');

$field->locale('fr');
is($field->error. '', 'c - \[]Le nickname est mal: a, b, c, d, e:bob', 'placeholders (hashref) 2');

require My2::HTML::Form;

My2::HTML::Form->field_type_class
(
  nick => 'My2::HTML::Form::Field::Nickname',
);

# My2::HTML::Form->field_type_class
# (
#   nickname => 'My2::HTML::Form::Field::Nickname',
# );

My2::HTML::Form->add_field_type_classes
(
  #nick     => 'My2::HTML::Form::Field::Nickname',
  nickname => 'My2::HTML::Form::Field::Nickname',
);

my $form = My2::HTML::Form->new;
$field = My2::HTML::Form::Field::Nickname->new;
$field->html_attr(class => 'c');

$form->add_field(nick => $field);

$form->params(nick => 'bob');
$form->init_fields;
$form->validate;

is($form->field('nick')->error. '', 'c - \[]Invalid nickname: a, b, c, d, e:bob', 'form locale 1');

$form->locale('fr');

is($form->field('nick')->error. '', 'c - \[]Le nickname est mal: a, b, c, d, e:bob', 'form locale 2');

$form = My2::HTML::Form->new;

$form->add_field(nick => { type => 'nick', class => 'c' });

$form->params({nick => 'bob'});
$form->init_fields;
$form->validate;

is($form->field('nick')->error. '', 'c - \[]Invalid nickname: a, b, c, d, e:bob', 'localizer locale 1');

My2::HTML::Object->localizer->locale('fr');

is($form->field('nick')->error. '', 'c - \[]Le nickname est mal: a, b, c, d, e:bob', 'localizer locale 2');

My2::HTML::Object->localizer->locale('en');

#
# Days field
#

@parts = split('::', 'My2::HTML::Form::Field::Days');
$parts[-1] .= '.pm';

my $days_pm = File::Spec->catfile($lib_dir, @parts);
#warn "# WRITE: $days_pm\n";

open($fh, '>', $days_pm) or die "Could not create '$days_pm' - $!";

$code=<<'EOF';
package My2::HTML::Form::Field::Days;

use My2::HTML::Object::Errors qw(FIELD_ERROR_TOO_MANY_DAYS);

use base qw(My2::HTML::Form::Field::Integer);


if(__PACKAGE__->localizer->auto_load_messages)
{
  __PACKAGE__->localizer->load_all_messages;
}

1;

__DATA__

[% LOCALE en %]

FIELD_ERROR_TOO_MANY_DAYS = "Too many days."
FIELD_ERROR_TOO_MANY_DAYS(one) = "One day is too many."
FIELD_ERROR_TOO_MANY_DAYS(two) = "Two days is too many."
FIELD_ERROR_TOO_MANY_DAYS(few) = "[count] days is too many (few)."

[% LOCALE fr %]

FIELD_ERROR_TOO_MANY_DAYS = "Trop de jours."

EOF

print $fh $code;
close($fh) or die "Could not write '$days_pm' - $!";

require My2::HTML::Form::Field::Days;

require My2::HTML::Object::Errors;

My2::HTML::Form::Field::Days->localizer->load_messages_from_string(<<"EOF");
[% LOCALE en %]

FIELD_ERROR_TOO_MANY_DAYS(few) = "[count] days is too many (few)."
FIELD_ERROR_TOO_MANY_DAYS(many) = "[count] days is too many (many)."
FIELD_ERROR_TOO_MANY_DAYS(plural) = "[count] days is too many."

[% LOCALE fr %]

FIELD_ERROR_TOO_MANY_DAYS(one) = "Un jour est un trop grand nombre."
FIELD_ERROR_TOO_MANY_DAYS(plural) = "[count] jours est un trop grand nombre."

[% LOCALE xx %]

FIELD_ERROR_TOO_MANY_DAYS = "[count] [variant] xx too many days."

EOF

$field = My2::HTML::Form::Field::Days->new(name => 'days');

my $error_id = My2::HTML::Object::Errors::FIELD_ERROR_TOO_MANY_DAYS();

$field->error_id($error_id, { count => 0 });
is($field->error, '0 days is too many.', 'zero variant (en)');

$field->error_id($error_id, { count => 1 });

is($field->error, 'One day is too many.', 'one variant (en)');

$field->error_id($error_id, { count => 2 });

is($field->error, 'Two days is too many.', 'two variant (en)');

$field->error_id($error_id, { count => 3 });
is($field->error, '3 days is too many.', 'plural fallback variant (en)');

$field->error_id($error_id, { count => 3, variant => 'few' });
is($field->error, '3 days is too many (few).', 'few explicit variant (en)');

$field->error_id($error_id, { count => 3, variant => 'many' });
is($field->error, '3 days is too many (many).', 'many explicit variant (en)');

$field->locale('fr');

$field->error_id($error_id, { count => 0 });
is($field->error, '0 jours est un trop grand nombre.', 'zero variant (fr)');

$field->error_id($error_id, { count => 1 });

is($field->error, 'Un jour est un trop grand nombre.', 'one variant (fr)');

$field->error_id($error_id, { count => 2 });

is($field->error, '2 jours est un trop grand nombre.', 'two variant (fr)');

$field->error_id($error_id, { count => 3 });
is($field->error, '3 jours est un trop grand nombre.', 'plural fallback variant (fr)');

$field->error_id($error_id, { count => 3, variant => 'few' });
is($field->error, '3 jours est un trop grand nombre.', 'few explicit variant (fr)');

$field->error_id($error_id, { count => 3, variant => 'many' });
is($field->error, '3 jours est un trop grand nombre.', 'many explicit variant (fr)');

$field->locale('xx');

ok(!$field->localizer->localized_message_exists('FIELD_ERROR_TOO_MANY_DAYS', 'xx', 'zero'), 'localized_message_exists 1');

$field->error_id($error_id, { count => 0 });

is($field->error, '0  xx too many days.', 'zero variant (xx)');

$field->error_id($error_id, { count => 1 });

is($field->error, '1  xx too many days.', 'one variant (xx)');

$field->error_id($error_id, { count => 2 });

is($field->error, '2  xx too many days.', 'two variant (xx)');

$field->error_id($error_id, { count => 3 });
is($field->error, '3  xx too many days.', 'plural fallback variant (xx)');

$field->error_id($error_id, { count => 3, variant => 'few' });
is($field->error, '3 few xx too many days.', 'few explicit variant (xx)');

$field->error_id($error_id, { count => 3, variant => 'many' });
is($field->error, '3 many xx too many days.', 'many explicit variant (xx)');

($packages, $perl) = 
  Rose::HTML::Objects->make_private_library(in_memory => 1, 
                                            rename    => sub { s/Rose::H/MyH/ });

ok(MyHTML::Object->isa('Rose::HTML::Object'), 'rename sub 1');

END
{
  if($lib_dir && -d $lib_dir)
  {
    #rmtree($lib_dir);
  }
}
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)