t/fcp-01.t


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131

#!/usr/bin/perl 
use strict;
use warnings;
use Test::More qw(no_plan);
use Test::Exception;
use Path::Class;
use File::Temp;
 
BEGIN { use_ok('File::Cache::Parsed') or die }
 
my $fc=File::Cache::Parsed->new();
my %calls;
$fc->add_parser(qr{\.t$} => sub { $calls{t}++;return ['t',@_] });
$fc->add_parser(qr{\.pm$} => sub { $calls{pm}++;return ['pm',@_] });
$fc->add_writer(qr{\.stuff$} => sub { $calls{stuff}++;
                                      print {file($_[0])->openw} "gino\n",$_[1]; });
$fc->add_parser(qr{\.stuff$} => sub { $calls{rstuff}++; return 'bad'});
 
my $base=file(__FILE__)->parent->parent;
 
{
my $module_file=$base->file('lib','File','Cache','Parsed.pm');
my $module_contents=$module_file->slurp;
my $test_file=$base->file('t','fcp-01.t');
my $test_contents=$test_file->slurp;
 
is_deeply($fc->get($module_file->stringify),
          ['pm',$module_file->stringify,$module_contents],
          'parser ok 1');
is_deeply($fc->get($test_file->stringify),
          ['t',$test_file->stringify,$test_contents],
          'parser ok 2');
is($calls{t},1,'called ok 1');
is($calls{pm},1,'called ok 2');
is_deeply($fc->get($test_file->stringify),
          ['t',$test_file->stringify,$test_contents],
          'cache ok 1');
is($calls{t},1,'cache no-call ok 1');
is($calls{pm},1,'cache no-call ok 2');
$fc->del_parser(qr{\.t$});
is($fc->get($test_file->stringify),
   $test_contents,
   'default parser & invalidate ok');
is($fc->get($test_file),
   $test_contents,
   'cache ok 2');
 
my $fc_l=File::Cache::Parsed->new(follow=>1);
$fc_l->add_parser(qr{\.t$} => sub { return ['t',@_] });
 
$fc->add_parser(qr{\.t$} => sub { return ['t',@_] });
 
my $link_file=$base->file('symlink.t');
symlink $test_file->stringify,$link_file->stringify;
END { $link_file->remove }
 
is_deeply($fc_l->get($link_file->stringify),
          ['t',$test_file->absolute->stringify,$test_contents],
          'followed symlink');
is_deeply($fc->get($link_file->stringify),
          ['t',$link_file->stringify,$test_contents],
          q{didn't follow symlink});
}
 
{
my $wr_tfile=File::Temp->new(SUFFIX=>'.stuff');
my $wr_file=file("$wr_tfile");
my $wr_contents="something\nor\nother\n";
 
$fc->put($wr_file->stringify,$wr_contents);
is($calls{stuff},1,'called ok 3');
is($wr_file->slurp,"gino\n$wr_contents",'written ok');
is($fc->get($wr_file->stringify),$wr_contents,'read back from cache');
ok(! exists $calls{rstuff},'no reader call');
 
$fc->put($wr_file->stringify,$wr_contents.2);
is($calls{stuff},2,'no caching on write');
is($wr_file->slurp,"gino\n${wr_contents}2",'written ok 2');
is($fc->get($wr_file->stringify),$wr_contents.2,'cache updated');
ok(! exists $calls{rstuff},'no reader call');
}
 
{
my $wr_tfile=File::Temp->new(SUFFIX=>'.none');
my $wr_file=file("$wr_tfile");
my $wr_contents="something\nor\nother\n";
 
$fc->put($wr_file->stringify,$wr_contents);
is($calls{stuff},2,'default writer');
is($wr_file->slurp,$wr_contents,'written ok passthrough');
$wr_contents={bad=>'stuff'};
throws_ok(sub {$fc->put($wr_file->stringify,$wr_contents)},
          qr/not a scalar/i,
          'exception on putting a ref with the default writer');
}
{
my $wr_tfile=File::Temp->new(SUFFIX=>'.stuff');
my $wr_file=file("$wr_tfile");
my $wr_contents={good=>'stuff'};
 
$fc->put($wr_file->stringify,$wr_contents);
is($calls{stuff},3,'called ok 4');
is($wr_file->slurp,"gino\n${wr_contents}",'written ok 3 (ref)');
is_deeply($fc->get($wr_file->stringify),$wr_contents,'no stringification');
ok(! exists $calls{rstuff},'no reader call');
 
$fc->del_writer(qr{\.stuff$});
$wr_contents='buh';
$fc->put($wr_file->stringify,$wr_contents);
is($calls{rstuff},1,'called reader');
is($fc->get($wr_file->stringify),
   'bad',
   'parsed after put');
 
$fc->add_writer(qr{\.stuff$} => sub { die 'bad call' });
$wr_contents='buh';
$fc->put($wr_file->stringify,$wr_contents);
is($calls{rstuff},2,'called reader on writer exception');
is($fc->get($wr_file->stringify),
   'bad',
   'parsed after put with writer exception');
}
 
 
is($fc->get('nosuchfile'),undef,'return undef on non-existant files');
 
{
    my $module_file=$base->file('lib','File','Cache','Parsed.pm');
    is($fc->stat($module_file)->size,
       $module_file->stat->size,'ok stat');
}