#!/usr/bin/perl -w # -*- mode: perl; coding: utf-8 -*- use strict; use warnings FATAL => qw(all); use strict; use warnings FATAL => qw(all); use FindBin; use lib "$FindBin::Bin/.."; use YATT::Test qw(no_plan); use YATT::LRXML::Node; use YATT::Util qw(catch); use File::stat; require_ok('YATT::Registry'); &YATT::break_translator; my $TMPDIR = tmpbuilder(rootname($0) . ".tmp"); my $SESSION = 1; { my $DIR = $TMPDIR->([DIR => 'foo' , [FILE => 'bar.html', q{

bar.html

}]], [FILE => 'foo.html' , q{}]); my $root = new YATT::Registry(loader => [DIR => $DIR] , auto_reload => 1); is $root->cget('age'), 1, "[$SESSION] root age"; is_deeply [$root->list_ns], [qw(foo)], "[$SESSION] list_ns"; run("[$SESSION] wid_by_nsname - no error", sub { is defined($root->widget_by_nsname($root, qw(foo bar))), 1 , "[$SESSION] wid_by_nsname"; }); is $root->cget('age'), 1, "[$SESSION] root age"; } # [2] { $SESSION++; my $DIR = $TMPDIR->([DIR => 'app' , [FILE => 'foo.html', q{

foo

}]], [DIR => 'lib1' , [FILE => 'bar.html', q{

bar

}]]); my $root = new YATT::Registry(loader => [DIR => "$DIR/app" , LIB => "$DIR/lib1"] , auto_reload => 1); is_deeply [sort $root->list_ns], [qw(bar foo)], "[$SESSION] list_ns"; } # [3] { $SESSION++; my $DIR = $TMPDIR-> ([DIR => 'app' , [FILE => '.htyattrc' , q{use YATT::Registry base => '/normal'; sub foo {"FOO"}}] , [FILE => 'index.html', q{

foo

}]], [DIR => 'lib1' , [DIR => 'normal' , [FILE => '.htyattrc', q{sub bar {"BAR"}}] , [FILE => 'bar.html', q{

bar

}]]]); my $root = new YATT::Registry (loader => [DIR => "$DIR/app", LIB => "$DIR/lib1"] , app_prefix => "MyApp$SESSION" , auto_reload => 1); is_deeply [sort $root->list_ns], [qw(index normal)] , "[$SESSION] base => /normal"; isnt my $index = $root->get_ns(['index']), undef, "[$SESSION] index"; isnt $root->get_widget_from_template($index, qw(yatt bar)), undef , "[$SESSION] bar"; my $top = $root->get_package($root); is_can [$top, 'foo'], "FOO", "[$SESSION] top->foo"; is_can [$top, 'bar'], "BAR", "[$SESSION] top->bar"; is $top, "MyApp$SESSION", "[$SESSION] top == class app_prefix"; } # [4] { $SESSION++; my $DIR = $TMPDIR-> ([DIR => 'app' , [FILE => '.htyattrc' , q{use YATT::Registry base => 'normal'; sub foo {"FOO"}}] , [FILE => 'index.html', q{}] , [DIR => 'normal' , [FILE => 'simple.html', q{

simple

}]]]); my $root = new YATT::Registry (loader => [DIR => "$DIR/app"] , app_prefix => "MyApp$SESSION" , auto_reload => 1); isnt my $index = $root->get_ns(['index']), undef, "[$SESSION] index"; isa_ok $index, $root->Template, "[$SESSION] index"; isnt $root->get_widget_from_template($index, qw(yatt foo)), undef , "[$SESSION] foo"; } # [5] { require YATT::Types; import YATT::Types -base => 'YATT::Registry', [Base => []]; $SESSION++; my $builder = $TMPDIR->as_sub; my $DIR = $builder-> ([DIR => 'app' , [FILE => '.htyattrc' , q{use YATT::Registry base => 'normal'; Entity bar => sub {'baz'}; }] , [FILE => 'index.html', q{

hello

}] , [DIR => 'normal' , [DIR => 'simple' , [FILE => 'widget.html', q{

simple

}]]]]); my $root = new YATT::Registry (loader => [DIR => "$DIR/app"] , app_prefix => "MyApp$SESSION" , default_base_class => Base() , auto_reload => 1); isnt my $index = $root->get_ns(['index']), undef, "[$SESSION] index"; isa_ok $index, $root->Template, "[$SESSION] index"; isnt $root->get_widget_from_template ($index, qw(yatt simple widget)), undef, "[$SESSION] simple widget"; if (my $sleep = wait_for_time(stat("$DIR/app/index.html")->mtime + 1)) { print STDERR "# slept $sleep sec\n" if $ENV{VERBOSE}; } $builder->([DIR => 'app' # To make sure directory mtime is changed. , [FILE => 'new.tmp', q{}] , [FILE => 'index.html', q{

world

}] , [FILE => '.htyattrc', q{use YATT::Registry base => 'normal'; Entity bar => sub {'baz'}; }] ]); isnt $root->get_widget_from_dir ($root, qw(index)), undef, "[$SESSION] index reload"; } # [6] Reload should not occur during initialization. { # # TEST_NO_RELOAD_DIR=app:lib1/normal # $SESSION++; my $builder = $TMPDIR->as_sub; my $DIR = $builder-> ([DIR => 'app' , [FILE => '.htyattrc' , q{ BEGIN {::main::wait_and_touch('app')} ;use YATT::Registry base => '/normal'; sub foo {"FOO"}}] , [FILE => 'index.html', q{

foo

}]], [DIR => 'lib1' , [DIR => 'normal' , [FILE => '.htyattrc' , q{BEGIN {::main::wait_and_touch('lib1/normal')} ;use YATT::Registry base => '/common'; sub bar {"BAR"}}] , [FILE => 'bar.html', q{

bar

}]] , [DIR => 'common' , [FILE => '.htyattrc' , q{sub baz {"BAZ"}}]]]); use File::stat; my %no_reload; $no_reload{$_} = 1 for split ":" , ($ENV{TEST_NO_RELOAD_DIR} || ''); my %prevDepth; sub wait_and_touch { my ($key) = @_; return if $no_reload{$key}; my $curDepth = call_depth(); if (defined $prevDepth{$key}) { # dir 修正は一度だけ。 return; } $prevDepth{$key} = $curDepth; my $fn = "$DIR/$key"; my $old = stat($fn)->mtime; print STDERR "# before check, now=@{[Time::HiRes::time]}\n" if $ENV{VERBOSE}; if (my $slept = wait_for_time($old + 1)) { print STDERR "# slept $slept sec for $fn\n" if $ENV{VERBOSE}; } # XXX: is system("touch", $fn), 0, "touch $fn"; isnt stat($fn)->mtime, $old , "[$SESSION] mtime should be changed $fn" . " (now=@{[Time::HiRes::time, ($old + 1) - Time::HiRes::time]})."; print STDERR "#caller: ", call_depth(), "\n" if $ENV{VERBOSE}; } sub call_depth { my $depth = 0; $depth++ while caller($depth); $depth; } my $root = new YATT::Registry (loader => [DIR => "$DIR/app", LIB => "$DIR/lib1"] , app_prefix => "MyApp$SESSION" , auto_reload => 1); is_deeply [sort $root->list_ns], [qw(common index normal)] , "[$SESSION] base => /normal"; isnt my $index = $root->get_ns(['index']), undef, "[$SESSION] index"; my $w; like(catch {$w = $root->get_widget_from_template($index, qw(yatt bar))} , qr{^\QUnknown declarator ()}, "[$SESSION] bar"); is $root->get_ns(['bar'])->{is_loaded} , undef, "[$SESSION] yatt bar is not yet loaded"; wait_and_touch("lib1/normal/bar.html"); # Now we have correct bar. $builder-> ([DIR => 'lib1' , [DIR => 'normal' , [FILE => 'bar.html' , (my $new_bar = q{

bar

}) . q{baz}]]]); $root->mark_load_failure; undef $w; like(catch {$w = $root->get_widget_from_template($index, qw(yatt bar))} , qr{^$}, "[$SESSION] bar, reload, noerror"); is $root->get_ns(['bar'])->{is_loaded} , 1, "[$SESSION] yatt bar *is* loaded"; eq_or_diff stringify_node($w->root) , $new_bar, "[$SESSION] bar, reloaded"; }