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
|
use strict;
use warnings;
# change 'tests => 1' to 'tests => last_test_to_print';
use Test::More qw(no_plan);
use Data::Dumper;
$Data::Dumper::Indent = 1;
use Time::HiRes qw ( time );
my $warn = shift @ARGV;
unless ($warn) {
close STDERR;
open (STDERR, ">/dev/null");
select (STDERR); $| = 1;
}
#== TESTS ===========================================================================
use TM;
require_ok( 'TM::ResourceAble' );
can_ok 'TM::ResourceAble', 'apply';
Class::Trait->apply ('TM' => 'TM::ResourceAble');
{ # structural tests
my $tm = new TM (baseuri => 'tm:');
ok ($tm->isa('TM'), 'correct class');
is ($tm->baseuri, 'tm:', 'baseuri ok');
ok ($tm->does ('TM::ResourceAble'), 'trait: ResourceAble');
ok ($tm->can ('url'), 'trait: can url');
}
{
my $tm = new TM (baseuri => 'tm:');
is ($tm->url ('http://whatever'), $tm->url, 'url setter');
my $t = time;
$tm->url ('io:stdin');
ok ($t <= $tm->mtime, 'io:stdin time');
$tm->url ('io:stdout');
is ($tm->mtime, 0, 'io:stdout time');
$t = time;
warn "# time on that platform gives: ".$t; # get strange errors from Solaris?
$tm->url ('inline:xxx');
warn "# mtime gives: ". $tm->mtime;
ok ($t >= $tm->mtime, 'inline: time'); # must be created
ok ($tm->{created} == $tm->mtime, 'inline: time');
}
__END__
{
my $tm = new TM (url => 'io:stdin');
is ($tm->url, 'io:stdin', 'url survives constructor');
}
# TODO file mtime, http mtime
__END__
#-- setup ------------------------------------------
package Testus;
use TM::Resource;
use base qw(TM::Resource);
our $in = 0;
our $out = 0;
sub _sync_in {
# warn "innnn";
$in++;
}
sub _sync_out {
# warn "outtttt";
$out++;
}
sub last_mod {
# warn "lasttttttttt";
return time();
}
1;
{
my $tm = new Testus (url => 'xxx:');
$tm->sync_in;
sleep 2;
$tm->sync_out;
Test::More::is ($Testus::in, 1, 'synced in once');
Test::More::is ($Testus::out, 0, 'synced out never');
$tm->consolidate; # do something, whatever
$tm->sync_out;
Test::More::is ($Testus::out, 1, 'synced out now');
}
__END__
|
