line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package TM::ResourceAble; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
1041
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
42
|
|
4
|
1
|
|
|
1
|
|
6
|
use warnings; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
38
|
|
5
|
|
|
|
|
|
|
|
6
|
1
|
|
|
1
|
|
465
|
use Class::Trait 'base'; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
our @REQUIRES = qw(last_mod); |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
use Data::Dumper; |
11
|
|
|
|
|
|
|
use Time::HiRes; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
=pod |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
=head1 NAME |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
TM::ResourceAble - Topic Maps, abstract trait for resource-backed Topic Maps |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
=head1 SYNOPSIS |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
package MyNiftyMap; |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
use TM; |
24
|
|
|
|
|
|
|
use base qw(TM); |
25
|
|
|
|
|
|
|
use Class::Trait ('TM::ResourceAble'); |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
1; |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
my $tm = new MyNiftyMap; |
30
|
|
|
|
|
|
|
$tm->url ('http://nirvana/'); |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
warn $tm->mtime; |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
# or at runtime even: |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
use TM; |
37
|
|
|
|
|
|
|
Class::Trait->apply ('TM', qw(TM::ResourceAble)); |
38
|
|
|
|
|
|
|
my $tm = new TM; |
39
|
|
|
|
|
|
|
warn $tm->mtime; |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
=head1 DESCRIPTION |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
This traits adds methods to provide the role I to a map. That allows a map to be |
45
|
|
|
|
|
|
|
associated with a resource which is addressed by a URL (actually a URI for that matter). |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
=head2 Predefined URIs |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
The following resources, actually their URIs are predefined: |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
=over |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
=item C |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
Symbolizes the UNIX STDIN file descriptor. The resource is all text content coming from this file. |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
=item C |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
Symbolizes the UNIX STDOUT file descriptor. |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
=item C |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
Symbolizes a resource which never delivers any content and which can consume any content silently |
64
|
|
|
|
|
|
|
(like C under UNIX). |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
=back |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
=head2 Predefined URI Methods |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
=over |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
=item C |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
An I resource is a resource which contains all content as part of the URI. Currently |
75
|
|
|
|
|
|
|
the TM content is to be written in AsTMa=. |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
Example: |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
inlined:donald (duck) |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
=back |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
=head1 INTERFACE |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
=head2 Methods |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
=over |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
=item B |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
I<$url> = I<$tm>->url |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
I<$tm>->url (I<$url>) |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
Once an object of this class is instantiated it keeps the URL of the resource to which it is |
98
|
|
|
|
|
|
|
associated. With this method you can retrieve and set that. No special further action is taken |
99
|
|
|
|
|
|
|
otherwise. |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
=cut |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
sub url { |
104
|
|
|
|
|
|
|
my $self = shift; |
105
|
|
|
|
|
|
|
my $url = shift; |
106
|
|
|
|
|
|
|
return $url ? $self->{url} = $url : $self->{url}; |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=pod |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
=item B |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
I<$time> = I<$tm>->mtime |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
This function returns the UNIX time when the resource has been modified last. C<0> is returned |
116
|
|
|
|
|
|
|
if the result cannot be determined. All methods from L are supported. |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
Special resources are treated as follows: |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
=over |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
=item C |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
always has mtime C<0> |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
=item C |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
always has an mtime 1 second in the future. The idea is that STDIN always has new |
129
|
|
|
|
|
|
|
content. |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
=item C |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
always has mtime C<0>. The idea is that STDOUT never changes by itself. |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
=back |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
=cut |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
sub mtime { |
140
|
|
|
|
|
|
|
my $self = shift; |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
#warn "xxxx mtime in $self for url $self->{url}"; |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
my $url = $self->{url} or die "no URL specified for this resource\n"; |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
if ($url =~ /^file:(.+)/) { |
147
|
|
|
|
|
|
|
use File::stat; |
148
|
|
|
|
|
|
|
my $stats = stat ($1); |
149
|
|
|
|
|
|
|
return 0 unless $stats; # or die "file '$1' is not accessible (or does not exist)"; |
150
|
|
|
|
|
|
|
#warn "file stats ".Dumper $stats; |
151
|
|
|
|
|
|
|
#warn "will return ".$stats->mtime; |
152
|
|
|
|
|
|
|
return $stats->mtime; |
153
|
|
|
|
|
|
|
} elsif ($url =~ /^inline:/) { |
154
|
|
|
|
|
|
|
return $self->{created}; ## Time::HiRes::time + 1; # how can I know? |
155
|
|
|
|
|
|
|
} elsif ($url eq 'null:') { |
156
|
|
|
|
|
|
|
return 0; |
157
|
|
|
|
|
|
|
} elsif ($url eq 'io:stdin') { |
158
|
|
|
|
|
|
|
return Time::HiRes::time + 1; # this always changes, by definition |
159
|
|
|
|
|
|
|
} elsif ($url eq 'io:stdout') { |
160
|
|
|
|
|
|
|
return 0; |
161
|
|
|
|
|
|
|
} else { # using LWP is a bit heavyweight, but anyways |
162
|
|
|
|
|
|
|
use LWP::UserAgent; |
163
|
|
|
|
|
|
|
my $ua = LWP::UserAgent->new; |
164
|
|
|
|
|
|
|
$ua->agent("TimeTester 1.0"); |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
my $req = HTTP::Request->new(GET => $url); |
167
|
|
|
|
|
|
|
my $res = $ua->request($req); |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
use HTTP::Date; |
170
|
|
|
|
|
|
|
return str2time($res->headers->{'last-modified'}); |
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
=pod |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
=back |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=head1 SEE ALSO |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
L |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
=head1 AUTHOR INFORMATION |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
Copyright 200[67], Robert Barta , All rights reserved. |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify it under the same terms as Perl |
187
|
|
|
|
|
|
|
itself. http://www.perl.com/perl/misc/Artistic.html |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
=cut |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
our $VERSION = 0.2; |
192
|
|
|
|
|
|
|
our $REVISION = '$Id: ResourceAble.pm,v 1.3 2007/07/17 16:22:41 rho Exp $'; |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
1; |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
__END__ |