File Coverage

blib/lib/TM/ResourceAble.pm
Criterion Covered Total %
statement 7 9 77.7
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 10 12 83.3


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__