line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
# $Id : Meta.pm 2.017 2010-07-07 JMG$ |
4
|
|
|
|
|
|
|
# |
5
|
|
|
|
|
|
|
# Created and maintained by Jean-Marie Gouarne |
6
|
|
|
|
|
|
|
# Copyright 2010 by Genicorp, S.A. (www.genicorp.com) |
7
|
|
|
|
|
|
|
# |
8
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
package OpenOffice::OODoc::Meta; |
11
|
2
|
|
|
2
|
|
54
|
use 5.008_000; |
|
2
|
|
|
|
|
78
|
|
|
2
|
|
|
|
|
113
|
|
12
|
2
|
|
|
2
|
|
12
|
use strict; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
158
|
|
13
|
|
|
|
|
|
|
our $VERSION = '2.017'; |
14
|
2
|
|
|
2
|
|
3157
|
use OpenOffice::OODoc::XPath 2.237; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
our @ISA = qw ( OpenOffice::OODoc::XPath ); |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
BEGIN |
20
|
|
|
|
|
|
|
{ |
21
|
|
|
|
|
|
|
*author = *creator; |
22
|
|
|
|
|
|
|
*version = *editing_cycles; |
23
|
|
|
|
|
|
|
} |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
26
|
|
|
|
|
|
|
# constructor : calling OOXPath constructor with 'meta' as member choice |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
sub new |
29
|
|
|
|
|
|
|
{ |
30
|
|
|
|
|
|
|
my $caller = shift; |
31
|
|
|
|
|
|
|
my $class = ref ($caller) || $caller; |
32
|
|
|
|
|
|
|
my %options = |
33
|
|
|
|
|
|
|
( |
34
|
|
|
|
|
|
|
part => 'meta', |
35
|
|
|
|
|
|
|
body_path => '//office:meta', |
36
|
|
|
|
|
|
|
@_ |
37
|
|
|
|
|
|
|
); |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
my $object = $class->SUPER::new(%options); |
40
|
|
|
|
|
|
|
if ($object) |
41
|
|
|
|
|
|
|
{ |
42
|
|
|
|
|
|
|
bless $object, $class; |
43
|
|
|
|
|
|
|
$object->{'body'} = $object->getBody(); |
44
|
|
|
|
|
|
|
return $object; |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
else |
47
|
|
|
|
|
|
|
{ |
48
|
|
|
|
|
|
|
return undef; |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
53
|
|
|
|
|
|
|
# overrides getText() & setText() because meta elements contain flat text only |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
sub getText |
56
|
|
|
|
|
|
|
{ |
57
|
|
|
|
|
|
|
my $self = shift; |
58
|
|
|
|
|
|
|
return $self->getFlatText(@_); |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
sub setText |
62
|
|
|
|
|
|
|
{ |
63
|
|
|
|
|
|
|
my $self = shift; |
64
|
|
|
|
|
|
|
return $self->setFlatText(@_); |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
68
|
|
|
|
|
|
|
# generic read/write accessor for text elements |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
sub accessor |
71
|
|
|
|
|
|
|
{ |
72
|
|
|
|
|
|
|
my ($self, $path, $value) = @_; |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
my $element = $self->getElement($path, 0); |
75
|
|
|
|
|
|
|
unless ($element) |
76
|
|
|
|
|
|
|
{ |
77
|
|
|
|
|
|
|
return undef unless defined $value; |
78
|
|
|
|
|
|
|
my $name = $path; |
79
|
|
|
|
|
|
|
$name =~ s/\/*//g; |
80
|
|
|
|
|
|
|
$element = $self->appendElement |
81
|
|
|
|
|
|
|
($self->{'body'}, $name, text => $value); |
82
|
|
|
|
|
|
|
return $value; |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
return (defined $value) ? |
86
|
|
|
|
|
|
|
$self->setText($element, $value) : |
87
|
|
|
|
|
|
|
$self->getText($element); |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
91
|
|
|
|
|
|
|
# get/set the 'generator' field (i.e. the signature of the office software) |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
sub generator |
94
|
|
|
|
|
|
|
{ |
95
|
|
|
|
|
|
|
my $self = shift; |
96
|
|
|
|
|
|
|
return $self->accessor('//meta:generator', @_); |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
100
|
|
|
|
|
|
|
# get/set the 'title' field |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
sub title |
103
|
|
|
|
|
|
|
{ |
104
|
|
|
|
|
|
|
my $self = shift; |
105
|
|
|
|
|
|
|
return $self->accessor('//dc:title', @_); |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
109
|
|
|
|
|
|
|
# get/set the 'description' field |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
sub description |
112
|
|
|
|
|
|
|
{ |
113
|
|
|
|
|
|
|
my $self = shift; |
114
|
|
|
|
|
|
|
return $self->accessor('//dc:description', @_); |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
118
|
|
|
|
|
|
|
# get/set the 'subject' field |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
sub subject |
121
|
|
|
|
|
|
|
{ |
122
|
|
|
|
|
|
|
my $self = shift; |
123
|
|
|
|
|
|
|
return $self->accessor('//dc:subject', @_); |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
127
|
|
|
|
|
|
|
# get/set the 'creation-date' field |
128
|
|
|
|
|
|
|
# in OpenOffice.org (normally ISO-8601) date format |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
sub creation_date |
131
|
|
|
|
|
|
|
{ |
132
|
|
|
|
|
|
|
my $self = shift; |
133
|
|
|
|
|
|
|
return $self->accessor('//meta:creation-date', @_); |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
137
|
|
|
|
|
|
|
# get/set the 'creator' field (i.e. author) |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
sub creator |
140
|
|
|
|
|
|
|
{ |
141
|
|
|
|
|
|
|
my $self = shift; |
142
|
|
|
|
|
|
|
return $self->accessor('//dc:creator', @_); |
143
|
|
|
|
|
|
|
} |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
146
|
|
|
|
|
|
|
# get/set the 'initial-creator' field (i.e. author) |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
sub initial_creator |
149
|
|
|
|
|
|
|
{ |
150
|
|
|
|
|
|
|
my $self = shift; |
151
|
|
|
|
|
|
|
return $self->accessor('//meta:initial-creator', @_); |
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
155
|
|
|
|
|
|
|
# get/set the 'date' (i.e. the date of last update) field |
156
|
|
|
|
|
|
|
# in OpenOffice.org (normally ISO-8601) date format |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
sub date |
159
|
|
|
|
|
|
|
{ |
160
|
|
|
|
|
|
|
my $self = shift; |
161
|
|
|
|
|
|
|
return $self->accessor('//dc:date', @_); |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
165
|
|
|
|
|
|
|
# get/set the 'language' code (ex : 'fr-FR') of the document |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
sub language |
168
|
|
|
|
|
|
|
{ |
169
|
|
|
|
|
|
|
my $self = shift; |
170
|
|
|
|
|
|
|
return $self->accessor('//dc:language', @_); |
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
174
|
|
|
|
|
|
|
# get/set the 'editing-cycles' field (i.e. the number of editing sessions) |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
sub editing_cycles |
177
|
|
|
|
|
|
|
{ |
178
|
|
|
|
|
|
|
my $self = shift; |
179
|
|
|
|
|
|
|
return $self->accessor('//meta:editing-cycles', @_); |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
183
|
|
|
|
|
|
|
# increment the 'editing-cycles' field |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
sub increment_editing_cycles |
186
|
|
|
|
|
|
|
{ |
187
|
|
|
|
|
|
|
my $self = shift; |
188
|
|
|
|
|
|
|
my $v = $self->editing_cycles(); |
189
|
|
|
|
|
|
|
return $self->editing_cycles($v + 1); |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
193
|
|
|
|
|
|
|
# get/set the 'editing-duration' field (i.e. the total elapsed time for all |
194
|
|
|
|
|
|
|
# the editing sessions) in OpenOffice.org (ISO-8601) format |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
sub editing_duration |
197
|
|
|
|
|
|
|
{ |
198
|
|
|
|
|
|
|
my $self = shift; |
199
|
|
|
|
|
|
|
return $self->accessor('//meta:editing-duration', @_); |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
203
|
|
|
|
|
|
|
# get/set the 'keywords' list |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
sub _od_keywords # Open Document version |
206
|
|
|
|
|
|
|
{ |
207
|
|
|
|
|
|
|
my $self = shift; |
208
|
|
|
|
|
|
|
my @new_kws = @_; |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
my @list = $self->getTextList('//meta:keyword'); |
211
|
|
|
|
|
|
|
my $body = $self->{'body'}; |
212
|
|
|
|
|
|
|
NEW_KWS: foreach my $new_kw (@new_kws) |
213
|
|
|
|
|
|
|
{ |
214
|
|
|
|
|
|
|
foreach my $old_kw (@list) |
215
|
|
|
|
|
|
|
{ |
216
|
|
|
|
|
|
|
next NEW_KWS if ($old_kw eq $new_kw); |
217
|
|
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
$self->appendElement |
220
|
|
|
|
|
|
|
( |
221
|
|
|
|
|
|
|
$body, |
222
|
|
|
|
|
|
|
'meta:keyword', |
223
|
|
|
|
|
|
|
text => $new_kw |
224
|
|
|
|
|
|
|
); |
225
|
|
|
|
|
|
|
push @list, $new_kw; |
226
|
|
|
|
|
|
|
} |
227
|
|
|
|
|
|
|
return wantarray ? @list : join ", ", @list; |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
sub _oo_keywords # OpenOffice.org version |
231
|
|
|
|
|
|
|
{ |
232
|
|
|
|
|
|
|
my $self = shift; |
233
|
|
|
|
|
|
|
my @new_words = @_; |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
$self->_oo_addKeyword($_) for @new_words; |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
my $base = $self->getElement('//meta:keywords', 0); |
238
|
|
|
|
|
|
|
return undef unless $base; |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
my @list = (); |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
foreach my $element |
243
|
|
|
|
|
|
|
($self->selectChildElementsByName($base, 'meta:keyword')) |
244
|
|
|
|
|
|
|
{ push @list, $self->getText($element); } |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
return wantarray ? @list : join ", ", @list; |
247
|
|
|
|
|
|
|
} |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
sub keywords |
250
|
|
|
|
|
|
|
{ |
251
|
|
|
|
|
|
|
my $self = shift; |
252
|
|
|
|
|
|
|
return ($self->{'opendocument'}) ? |
253
|
|
|
|
|
|
|
$self->_od_keywords(@_) : $self->_oo_keywords(@_); |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
257
|
|
|
|
|
|
|
# append a new keyword (if unknown) in the keywords list |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
sub _od_addKeyword # Open Document version |
260
|
|
|
|
|
|
|
{ |
261
|
|
|
|
|
|
|
my $self = shift; |
262
|
|
|
|
|
|
|
my $new_kw = shift or return undef; |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
my @list = $self->getTextList('//meta:keyword'); |
265
|
|
|
|
|
|
|
foreach my $old_kw (@list) |
266
|
|
|
|
|
|
|
{ |
267
|
|
|
|
|
|
|
return undef if ($new_kw eq $old_kw); |
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
$self->appendElement |
271
|
|
|
|
|
|
|
( |
272
|
|
|
|
|
|
|
$self->{'body'}, |
273
|
|
|
|
|
|
|
'meta:keyword', |
274
|
|
|
|
|
|
|
text => $new_kw |
275
|
|
|
|
|
|
|
); |
276
|
|
|
|
|
|
|
return $new_kw; |
277
|
|
|
|
|
|
|
} |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
sub _oo_addKeyword # OpenOffice.org version |
280
|
|
|
|
|
|
|
{ |
281
|
|
|
|
|
|
|
my $self = shift; |
282
|
|
|
|
|
|
|
my $new_word = shift; |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
my $kw_base = $self->getElement('//meta:keywords', 0); |
285
|
|
|
|
|
|
|
if ($kw_base) |
286
|
|
|
|
|
|
|
{ |
287
|
|
|
|
|
|
|
foreach my $element |
288
|
|
|
|
|
|
|
($self->selectChildElementsByName($kw_base, 'meta:keyword')) |
289
|
|
|
|
|
|
|
{ |
290
|
|
|
|
|
|
|
my $old_word = $self->getText($element); |
291
|
|
|
|
|
|
|
return undef if ($old_word eq $new_word); |
292
|
|
|
|
|
|
|
} |
293
|
|
|
|
|
|
|
} |
294
|
|
|
|
|
|
|
else |
295
|
|
|
|
|
|
|
{ |
296
|
|
|
|
|
|
|
$kw_base = |
297
|
|
|
|
|
|
|
$self->appendElement('//office:meta', 0, 'meta:keywords'); |
298
|
|
|
|
|
|
|
} |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
$self->appendElement($kw_base, 'meta:keyword', text => $new_word); |
301
|
|
|
|
|
|
|
return $new_word; |
302
|
|
|
|
|
|
|
} |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
sub addKeyword |
305
|
|
|
|
|
|
|
{ |
306
|
|
|
|
|
|
|
my $self = shift; |
307
|
|
|
|
|
|
|
return $self->{'opendocument'} ? |
308
|
|
|
|
|
|
|
$self->_od_addKeyword(@_) : $self->_oo_addKeyword(@_); |
309
|
|
|
|
|
|
|
} |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
312
|
|
|
|
|
|
|
# remove a given keyword (if known) from the keyword list |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
sub _od_removeKeyword # Open Document version |
315
|
|
|
|
|
|
|
{ |
316
|
|
|
|
|
|
|
my $self = shift; |
317
|
|
|
|
|
|
|
my $kw = shift; |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
my @list = $self->getElementList('//meta:keyword'); |
320
|
|
|
|
|
|
|
my $count = 0; |
321
|
|
|
|
|
|
|
foreach my $element (@list) |
322
|
|
|
|
|
|
|
{ |
323
|
|
|
|
|
|
|
my $old_kw = $self->getText($element); |
324
|
|
|
|
|
|
|
if ($old_kw eq $kw) |
325
|
|
|
|
|
|
|
{ |
326
|
|
|
|
|
|
|
$self->removeElement($element); |
327
|
|
|
|
|
|
|
$count++; |
328
|
|
|
|
|
|
|
} |
329
|
|
|
|
|
|
|
} |
330
|
|
|
|
|
|
|
return $count; |
331
|
|
|
|
|
|
|
} |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
sub _oo_removeKeyword # OpenOffice.org version |
334
|
|
|
|
|
|
|
{ |
335
|
|
|
|
|
|
|
my $self = shift; |
336
|
|
|
|
|
|
|
my $word = shift; |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
my $kw_base = $self->getElement('//meta:keywords', 0); |
339
|
|
|
|
|
|
|
return undef unless $kw_base; |
340
|
|
|
|
|
|
|
my $count = 0; |
341
|
|
|
|
|
|
|
foreach my $element |
342
|
|
|
|
|
|
|
($self->selectChildElementsByName($kw_base, 'meta:keyword')) |
343
|
|
|
|
|
|
|
{ |
344
|
|
|
|
|
|
|
my $old_word = $self->getText($element); |
345
|
|
|
|
|
|
|
if ($old_word eq $word) |
346
|
|
|
|
|
|
|
{ |
347
|
|
|
|
|
|
|
$kw_base->removeChild($element); |
348
|
|
|
|
|
|
|
$count++; |
349
|
|
|
|
|
|
|
} |
350
|
|
|
|
|
|
|
} |
351
|
|
|
|
|
|
|
return $count; |
352
|
|
|
|
|
|
|
} |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
sub removeKeyword |
355
|
|
|
|
|
|
|
{ |
356
|
|
|
|
|
|
|
my $self = shift; |
357
|
|
|
|
|
|
|
return $self->{'opendocument'} ? |
358
|
|
|
|
|
|
|
$self->_od_removeKeyword(@_) : $self->_oo_removeKeyword(@_); |
359
|
|
|
|
|
|
|
} |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
362
|
|
|
|
|
|
|
# remove the keyword list |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
sub _od_removeKeywords # Open Document version |
365
|
|
|
|
|
|
|
{ |
366
|
|
|
|
|
|
|
my $self = shift; |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
my @list = $self->getElementList('//meta:keyword'); |
369
|
|
|
|
|
|
|
my $count = 0; |
370
|
|
|
|
|
|
|
foreach my $element (@list) |
371
|
|
|
|
|
|
|
{ |
372
|
|
|
|
|
|
|
$count++; |
373
|
|
|
|
|
|
|
$self->removeElement($element); |
374
|
|
|
|
|
|
|
} |
375
|
|
|
|
|
|
|
return $count; |
376
|
|
|
|
|
|
|
} |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
sub removeKeywords |
379
|
|
|
|
|
|
|
{ |
380
|
|
|
|
|
|
|
my $self = shift; |
381
|
|
|
|
|
|
|
return ($self->{'opendocument'}) ? |
382
|
|
|
|
|
|
|
$self->_od_removeKeywords(@_) : |
383
|
|
|
|
|
|
|
$self->removeElement('//meta:keywords', 0); |
384
|
|
|
|
|
|
|
} |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
387
|
|
|
|
|
|
|
# get/set the list of the user defined fields of the meta-data |
388
|
|
|
|
|
|
|
# without argument, returns a hash where keys are the field names |
389
|
|
|
|
|
|
|
# and values are the field values |
390
|
|
|
|
|
|
|
# to set/update the user-defined fields, arguments should be passed |
391
|
|
|
|
|
|
|
# as a hash with the same structure |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
sub user_defined |
394
|
|
|
|
|
|
|
{ |
395
|
|
|
|
|
|
|
my $self = shift; |
396
|
|
|
|
|
|
|
my %new_fields = @_; |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
my @elements = $self->getElementList('//meta:user-defined'); |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
if (%new_fields) |
401
|
|
|
|
|
|
|
{ |
402
|
|
|
|
|
|
|
my $count = 0; |
403
|
|
|
|
|
|
|
foreach my $key (sort keys %new_fields) |
404
|
|
|
|
|
|
|
{ |
405
|
|
|
|
|
|
|
my $element = $elements[$count]; |
406
|
|
|
|
|
|
|
last unless $element; |
407
|
|
|
|
|
|
|
$self->setAttribute($element, 'meta:name', $key); |
408
|
|
|
|
|
|
|
$self->setText($element, $new_fields{$key}); |
409
|
|
|
|
|
|
|
$count++; |
410
|
|
|
|
|
|
|
} |
411
|
|
|
|
|
|
|
} |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
my %fields = (); |
414
|
|
|
|
|
|
|
foreach my $element (@elements) |
415
|
|
|
|
|
|
|
{ |
416
|
|
|
|
|
|
|
my $name = $self->getAttribute($element, 'meta:name'); |
417
|
|
|
|
|
|
|
my $content = $self->getText($element); |
418
|
|
|
|
|
|
|
$fields{$name} = $content; |
419
|
|
|
|
|
|
|
} |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
return %fields; |
422
|
|
|
|
|
|
|
} |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
sub getUserPropertyElements |
427
|
|
|
|
|
|
|
{ |
428
|
|
|
|
|
|
|
my $self = shift; |
429
|
|
|
|
|
|
|
return $self->getElementList('//meta:user-defined'); |
430
|
|
|
|
|
|
|
} |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
sub removeUserProperties |
435
|
|
|
|
|
|
|
{ |
436
|
|
|
|
|
|
|
my $self = shift; |
437
|
|
|
|
|
|
|
my $count = 0; |
438
|
|
|
|
|
|
|
foreach my $element ($self->getUserPropertyElements()) |
439
|
|
|
|
|
|
|
{ |
440
|
|
|
|
|
|
|
$element->delete; $count++; |
441
|
|
|
|
|
|
|
} |
442
|
|
|
|
|
|
|
return $count; |
443
|
|
|
|
|
|
|
} |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
sub getUserPropertyElement |
448
|
|
|
|
|
|
|
{ |
449
|
|
|
|
|
|
|
my $self = shift; |
450
|
|
|
|
|
|
|
my $arg = shift; |
451
|
|
|
|
|
|
|
return undef unless defined $arg; |
452
|
|
|
|
|
|
|
if (ref $arg) |
453
|
|
|
|
|
|
|
{ |
454
|
|
|
|
|
|
|
return ($arg->hasTag('meta:user-defined')) ? |
455
|
|
|
|
|
|
|
$arg : |
456
|
|
|
|
|
|
|
undef; |
457
|
|
|
|
|
|
|
} |
458
|
|
|
|
|
|
|
else |
459
|
|
|
|
|
|
|
{ |
460
|
|
|
|
|
|
|
my $name = $self->inputTextConversion($arg); |
461
|
|
|
|
|
|
|
return $self->getNodeByXPath |
462
|
|
|
|
|
|
|
("//meta:user-defined[\@meta:name=\"$name\"]"); |
463
|
|
|
|
|
|
|
} |
464
|
|
|
|
|
|
|
} |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
sub getUserProperty |
469
|
|
|
|
|
|
|
{ |
470
|
|
|
|
|
|
|
my $self = shift; |
471
|
|
|
|
|
|
|
my $property = $self->getUserPropertyElement(shift); |
472
|
|
|
|
|
|
|
my $type = undef; |
473
|
|
|
|
|
|
|
my $value = undef; |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
if ($property) |
476
|
|
|
|
|
|
|
{ |
477
|
|
|
|
|
|
|
$type = $self->getAttribute($property, 'meta:value-type'); |
478
|
|
|
|
|
|
|
$value = $self->getText($property); |
479
|
|
|
|
|
|
|
} |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
return (wantarray) ? ($type, $value) : $value; |
482
|
|
|
|
|
|
|
} |
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
sub setUserProperty |
487
|
|
|
|
|
|
|
{ |
488
|
|
|
|
|
|
|
my $self = shift; |
489
|
|
|
|
|
|
|
my $name = shift; |
490
|
|
|
|
|
|
|
unless (defined $name) |
491
|
|
|
|
|
|
|
{ |
492
|
|
|
|
|
|
|
return (wantarray) ? (undef, undef) : undef; |
493
|
|
|
|
|
|
|
} |
494
|
|
|
|
|
|
|
my %opt = @_; |
495
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
my $property = $self->getUserPropertyElement($name); |
497
|
|
|
|
|
|
|
unless ($property) |
498
|
|
|
|
|
|
|
{ |
499
|
|
|
|
|
|
|
$property =$self->appendElement |
500
|
|
|
|
|
|
|
($self->{'body'}, 'meta:user-defined'); |
501
|
|
|
|
|
|
|
$self->setAttribute($property, 'meta:name', $name); |
502
|
|
|
|
|
|
|
} |
503
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
my $type = $opt{'type'} || |
505
|
|
|
|
|
|
|
$self->getAttribute |
506
|
|
|
|
|
|
|
($property, 'meta:value-type') || |
507
|
|
|
|
|
|
|
'string'; |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
$self->setAttribute($property, 'meta:value-type', $type); |
510
|
|
|
|
|
|
|
$self->setText($property, $opt{'value'}) if defined $opt{'value'}; |
511
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
return $self->getUserProperty($property); |
513
|
|
|
|
|
|
|
} |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
sub removeUserProperty |
518
|
|
|
|
|
|
|
{ |
519
|
|
|
|
|
|
|
my $self = shift; |
520
|
|
|
|
|
|
|
my $name = $self->inputTextConversion(shift); |
521
|
|
|
|
|
|
|
return undef unless defined $name; |
522
|
|
|
|
|
|
|
my $property = $self->getNodeByXPath |
523
|
|
|
|
|
|
|
("//meta:user-defined[\@meta:name=\"$name\"]"); |
524
|
|
|
|
|
|
|
return $self->removeElement($property); |
525
|
|
|
|
|
|
|
} |
526
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
528
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
sub statistic |
530
|
|
|
|
|
|
|
{ |
531
|
|
|
|
|
|
|
my $self = shift; |
532
|
|
|
|
|
|
|
my %new_fields = @_; |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
my $element = $self->getElement('//meta:document-statistic', 0); |
535
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
unless (%new_fields) |
537
|
|
|
|
|
|
|
{ return $self->getAttributes($element); } |
538
|
|
|
|
|
|
|
else |
539
|
|
|
|
|
|
|
{ return $self->setAttributes($element, %new_fields); } |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
} |
542
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
544
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
sub getTemplate |
546
|
|
|
|
|
|
|
{ |
547
|
|
|
|
|
|
|
my $self = shift; |
548
|
|
|
|
|
|
|
my $element = $self->getElement('//meta:template', 0) |
549
|
|
|
|
|
|
|
or return undef; |
550
|
|
|
|
|
|
|
my %t = $self->getAttributes($element); |
551
|
|
|
|
|
|
|
return (wantarray) ? |
552
|
|
|
|
|
|
|
($t{'xlink:href'}, $t{'meta:date'}, $t{'xlink:title'}) : |
553
|
|
|
|
|
|
|
$t{'xlink:href'}; |
554
|
|
|
|
|
|
|
} |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
557
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
sub unlinkTemplate |
559
|
|
|
|
|
|
|
{ |
560
|
|
|
|
|
|
|
my $self = shift; |
561
|
|
|
|
|
|
|
return $self->removeElement('//meta:template', 0); |
562
|
|
|
|
|
|
|
} |
563
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
565
|
|
|
|
|
|
|
1; |