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

#!/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');
}
 
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');
}