| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package TM::Tau::Filter; |
|
2
|
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
1829
|
use TM; |
|
|
1
|
|
|
|
|
4
|
|
|
|
1
|
|
|
|
|
72
|
|
|
4
|
1
|
|
|
1
|
|
9
|
use base qw(TM); |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
106
|
|
|
5
|
1
|
|
|
1
|
|
2003
|
use Class::Trait (TM::Synchronizable => { exclude => [ 'mtime', 'sync_out' ] }); |
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
use Data::Dumper; |
|
8
|
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
=pod |
|
10
|
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
=head1 NAME |
|
12
|
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
TM::Tau::Filter - Topic Maps, abstract filter class |
|
14
|
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
16
|
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
my $tm = ... some map (or another filter) |
|
18
|
|
|
|
|
|
|
my $filter = new TM::Tau::Filter (left => $tm); |
|
19
|
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
$filter->sync_in; # this will pass on the sync in to the left operand |
|
21
|
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
# after that, the filter itself holds the result (which is a map) |
|
23
|
|
|
|
|
|
|
$filter->instances (....); |
|
24
|
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
26
|
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
Filters are special maps in that their content depends on another map and a particular |
|
28
|
|
|
|
|
|
|
transformation to get the map result. If you consider the expression |
|
29
|
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
some_map.atm * some_transformation |
|
31
|
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
then C is applied to the map coming from the map C. |
|
33
|
|
|
|
|
|
|
This scheme can be expanded to the left: |
|
34
|
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
some_map.atm * some_transformation1 * some_transformation2 |
|
36
|
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
so that a whole chain of transformations can be applied to a map. The expression has to be |
|
38
|
|
|
|
|
|
|
interpreted left-associative, so as if written as |
|
39
|
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
(some_map.atm * some_transformation1) * some_transformation2 |
|
41
|
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
When you build a filter expression, then you have to respect this left-associativeness: |
|
43
|
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
my $map = new TM....; |
|
45
|
|
|
|
|
|
|
my $trafo1 = new TM::Tau::Filter (left => $map); |
|
46
|
|
|
|
|
|
|
my $trafo2 = new TM::Tau::Filter (left => $trafo1); |
|
47
|
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
The variable C<$trafo2> then holds this expression, but nothing is actually computed at this |
|
49
|
|
|
|
|
|
|
stage. To trigger this process, the method C can be used (read: apply). It will trigger the |
|
50
|
|
|
|
|
|
|
in-synchronisation of C<$trafo1> and that will pass it on to the C<$map>. That will do something (or |
|
51
|
|
|
|
|
|
|
not) to ensure that the map is up-to-date relative to the resource it is possibly associated with. |
|
52
|
|
|
|
|
|
|
Once this is done, the filter C<$trafo1> will do its work. Once the result is available, C<$trafo2> |
|
53
|
|
|
|
|
|
|
will do its work. |
|
54
|
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
=head2 Transformations |
|
56
|
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
Filters are not constrained in what they are doing. Some filters might only extract a particular |
|
58
|
|
|
|
|
|
|
portion out of a map. Others will make more complex conversions, say, to adapt to a different |
|
59
|
|
|
|
|
|
|
background ontology. Others will completely change the map, or compute new stuff from it. It is also |
|
60
|
|
|
|
|
|
|
possible to have transformers which actually do nothing, except than mediating between different |
|
61
|
|
|
|
|
|
|
formats a map is written in. |
|
62
|
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
To specify B the transformation is supposed to do, you can either overload the method |
|
64
|
|
|
|
|
|
|
C, or alternatively keep it and overload only C: |
|
65
|
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
sub transform { |
|
67
|
|
|
|
|
|
|
my $self = shift; # this is the filter |
|
68
|
|
|
|
|
|
|
my $map = shift; # this is the left operand map |
|
69
|
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
.... # do whatever you need to do |
|
71
|
|
|
|
|
|
|
$result = ..... # this might be your result |
|
72
|
|
|
|
|
|
|
return $result; # return it |
|
73
|
|
|
|
|
|
|
} |
|
74
|
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
Your result will be used as content for the filter (which is a map itself, remember). See |
|
76
|
|
|
|
|
|
|
L for an example. |
|
77
|
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
The default transformation is the empty one, i.e. the map is simply passed through (not copied, |
|
79
|
|
|
|
|
|
|
btw). |
|
80
|
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
=head1 INTERFACE |
|
82
|
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
=head2 Constructor |
|
84
|
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
The constructor of implementations should expect a hash as parameter with the following fields: |
|
86
|
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
=over |
|
88
|
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
=item I (no default): |
|
90
|
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
This must be an object of class L. i.e. it can also be another filter. |
|
92
|
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
=item I (default C) |
|
94
|
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
If the URL is missing here (filters are resourced maps), then it defaults to C |
|
96
|
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
=back |
|
98
|
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=cut |
|
100
|
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
sub new { |
|
102
|
|
|
|
|
|
|
my $class = shift; |
|
103
|
|
|
|
|
|
|
my %options = @_; |
|
104
|
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
$options{url} ||= 'null:'; # a filter may have nothing to which it is attached outgoingly |
|
106
|
|
|
|
|
|
|
if ($options{left}) { |
|
107
|
|
|
|
|
|
|
ref ($options{left}) and $options{left}->isa ('TM') |
|
108
|
|
|
|
|
|
|
or $TM::log->logdie ( scalar __PACKAGE__ .": left operand must be an instance of TM" ); |
|
109
|
|
|
|
|
|
|
} |
|
110
|
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
$options{sync_in} ||= 0; # defaults |
|
112
|
|
|
|
|
|
|
$options{sync_out} ||= 0; |
|
113
|
|
|
|
|
|
|
my $self = bless $class->SUPER::new (%options), $class; |
|
114
|
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
$self->sync_in if $self->{sync_in}; # if user wants to sync at constructor time, lets do it |
|
116
|
|
|
|
|
|
|
return $self; |
|
117
|
|
|
|
|
|
|
} |
|
118
|
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
# the DESTROY of the underlying map is done automatically, and that should try a sync_out (if materialized) |
|
120
|
|
|
|
|
|
|
# in case the user does not want a synchronisation, I have to avoid it by overriding _sync_in (or even sync_in) |
|
121
|
|
|
|
|
|
|
sub DESTROY { |
|
122
|
|
|
|
|
|
|
my $self = shift; |
|
123
|
|
|
|
|
|
|
#warn "tau DESTROY"; #. Dumper $self; |
|
124
|
|
|
|
|
|
|
return if $@; # we do not do anything in case of errors/exceptions |
|
125
|
|
|
|
|
|
|
#warn "{sync_out} is ".$self->{sync_out}; |
|
126
|
|
|
|
|
|
|
#warn "and we can? ".$self->can ('source_out'); |
|
127
|
|
|
|
|
|
|
#warn "and where to? ".$self->url; |
|
128
|
|
|
|
|
|
|
$self->sync_out if $self->{sync_out} && $self->can ('source_out'); |
|
129
|
|
|
|
|
|
|
} |
|
130
|
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
=pod |
|
132
|
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
=head2 Methods |
|
134
|
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
=over |
|
136
|
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
=item B |
|
138
|
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
I<$tm> = I<$filter>->left |
|
140
|
|
|
|
|
|
|
I<$filter>->left (I<$tm>) |
|
141
|
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
This is an accessor (read and write) to get the left operand. In any case the left component is |
|
143
|
|
|
|
|
|
|
returned. |
|
144
|
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
=cut |
|
146
|
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
sub left { |
|
148
|
|
|
|
|
|
|
my $self = shift; |
|
149
|
|
|
|
|
|
|
my $left = shift; |
|
150
|
|
|
|
|
|
|
return $left ? $self->{left} = $left : $self->{left}; |
|
151
|
|
|
|
|
|
|
} |
|
152
|
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
=pod |
|
154
|
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
=item B |
|
156
|
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
I<$filter>->mtime |
|
158
|
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
This retrieves the last modification time of the resource on which this filter operates on. |
|
160
|
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
=cut |
|
162
|
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
sub mtime { |
|
164
|
|
|
|
|
|
|
my $self = shift; |
|
165
|
|
|
|
|
|
|
#warn "filter mtime with $self->{left}"; |
|
166
|
|
|
|
|
|
|
return $self->{left}->mtime; |
|
167
|
|
|
|
|
|
|
} |
|
168
|
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
=pod |
|
170
|
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
=item B |
|
172
|
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
I<$tm2> = I<$filter>->transform (I<$tm>) |
|
174
|
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
This method performs the actual transformation. If you develop your own filter, then this has to be |
|
176
|
|
|
|
|
|
|
overloaded. The default implementation here only hands back the same map (I transformation). |
|
177
|
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=cut |
|
179
|
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
sub transform { |
|
181
|
|
|
|
|
|
|
return $_[1]; |
|
182
|
|
|
|
|
|
|
} |
|
183
|
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
sub source_in { |
|
185
|
|
|
|
|
|
|
#warn "filtrer source in"; |
|
186
|
|
|
|
|
|
|
my $self = shift; |
|
187
|
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
#warn __PACKAGE__ . " source in ". $self->url; |
|
189
|
|
|
|
|
|
|
#warn __PACKAGE__ . " baseuri ". $self->baseuri; |
|
190
|
|
|
|
|
|
|
$self->{left}->source_in; # lets get the upstream crap, uhm map |
|
191
|
|
|
|
|
|
|
#warn "left before melt".Dumper $self->{left}; |
|
192
|
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
# my $m = $self->{left}->insane; |
|
194
|
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
$self->melt ( $self->transform ($self->{left}, $self->baseuri) ); |
|
196
|
|
|
|
|
|
|
#warn __PACKAGE__ . " baseuri after melt". $self->baseuri; |
|
197
|
|
|
|
|
|
|
#warn "whole thing after melt".Dumper $self; |
|
198
|
|
|
|
|
|
|
} |
|
199
|
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
sub sync_out { |
|
201
|
|
|
|
|
|
|
my $self = shift; |
|
202
|
|
|
|
|
|
|
{ # temporarily delete left component, source_out should never see that |
|
203
|
|
|
|
|
|
|
my $left = delete $self->{left}; |
|
204
|
|
|
|
|
|
|
#warn "filter sync out ".$self->{left}; |
|
205
|
|
|
|
|
|
|
$self->source_out; # do not think twice |
|
206
|
|
|
|
|
|
|
$self->{left} = $left; |
|
207
|
|
|
|
|
|
|
} |
|
208
|
|
|
|
|
|
|
} |
|
209
|
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
=pod |
|
211
|
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
=back |
|
213
|
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
=head1 SEE ALSO |
|
215
|
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
L, L, L |
|
217
|
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
=head1 AUTHOR INFORMATION |
|
219
|
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
Copyright 200[4-6], Robert Barta , All rights reserved. |
|
221
|
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify it under the same terms as Perl |
|
223
|
|
|
|
|
|
|
itself. http://www.perl.com/perl/misc/Artistic.html |
|
224
|
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
=cut |
|
226
|
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
our $VERSION = 0.4; |
|
228
|
|
|
|
|
|
|
our $REVISION = '$Id: Filter.pm,v 1.13 2006/12/13 10:46:59 rho Exp $'; |
|
229
|
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
1; |
|
231
|
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
__END__ |