line
stmt
bran
cond
sub
pod
time
code
1
=head1 NAME
2
3
SVG::Metadata - Perl module to capture metadata info about an SVG file
4
5
=head1 SYNOPSIS
6
7
use SVG::Metadata;
8
9
my $svgmeta = new SVG::Metadata;
10
11
$svgmeta->parse($filename)
12
or die "Could not parse $filename: " . $svgmeta->errormsg();
13
$svgmeta2->parse($filename2)
14
or die "Could not parse $filename: " . $svgmeta->errormsg();
15
16
# Do the files have the same metadata (author, title, license)?
17
if (! $svgmeta->compare($svgmeta2) ) {
18
print "$filename is different than $filename2\n";
19
}
20
21
if ($svgmeta->title() eq '') {
22
$svgmeta->title('Unknown');
23
}
24
25
if ($svgmeta->author() eq '') {
26
$svgmeta->author('Unknown');
27
}
28
29
if ($svgmeta->license() eq '') {
30
$svgmeta->license('Unknown');
31
}
32
33
if (! $svgmeta->keywords()) {
34
$svgmeta->addKeyword('unsorted');
35
} elsif ($svgmeta->hasKeyword('unsorted') && $svgmeta->keywords()>1) {
36
$svgmeta->removeKeyword('unsorted');
37
}
38
39
print $svgmeta->to_text();
40
41
=head1 DESCRIPTION
42
43
This module provides a way of extracting, browsing and using RDF
44
metadata embedded in an SVG file.
45
46
The SVG spec itself does not provide any particular mechanisms for
47
handling metadata, but instead relies on embedded, namespaced RDF
48
sections, as per XML philosophy. Unfortunately, many SVG tools don't
49
support the concept of RDF metadata; indeed many don't support the idea
50
of embedded XML "islands" at all. Some will even ignore and drop the
51
rdf data entirely when encountered.
52
53
The motivation for this module is twofold. First, it provides a
54
mechanism for accessing this metadata from the SVG files. Second, it
55
provides a means of validating SVG files to detect if they have the
56
metadata.
57
58
The motivation for this script is primarily for the Open Clip Art
59
Library (http://www.openclipart.org), as a way of filtering out
60
submissions that lack metadata from being included in the official
61
distributions. A secondary motivation is to serve as a testing tool for
62
SVG editors like Inkscape (http://www.inkscape.org).
63
64
=head1 FUNCTIONS
65
66
=cut
67
68
package SVG::Metadata;
69
70
2
2
67001
use 5.006;
2
8
2
85
71
2
2
12
use strict;
2
4
2
70
72
2
2
10
use warnings;
2
9
2
88
73
2
2
2221
use XML::Twig;
0
0
74
use HTML::Entities;
75
76
# use Data::Dumper; # DEBUG
77
78
require Exporter;
79
our @ISA = qw(Exporter);
80
our @EXPORT_OK = ();
81
82
our $VERSION = '0.28';
83
84
85
use fields qw(
86
_title
87
_description
88
_subject
89
_publisher
90
_publisher_url
91
_creator
92
_creator_url
93
_owner
94
_owner_url
95
_license
96
_license_date
97
_keywords
98
_language
99
_about_url
100
_date
101
_retain_xml
102
_strict_validation
103
_try_harder
104
_ERRORMSG
105
_RETAINED_XML
106
_RETAINED_DECLARATION
107
);
108
use vars qw( %FIELDS $AUTOLOAD );
109
110
111
=head2 new()
112
113
Creates a new SVG::Metadata object. Optionally, can pass in arguments
114
'title', 'author', 'license', etc..
115
116
my $svgmeta = new SVG::Metadata;
117
my $svgmeta = new SVG::Metadata(title=>'My title', author=>'Me', license=>'Public Domain');
118
119
=cut
120
121
sub new {
122
my $class = shift;
123
my %args = @_;
124
125
my $self = bless [\%FIELDS], $class;
126
127
while (my ($field, $value) = each %args) {
128
$self->{"_$field"} = $value
129
if (exists $FIELDS{"_$field"});
130
}
131
$self->{_creator} ||= $args{author} || '';
132
$self->{_language} ||= 'en';
133
$self->{_ERRORMSG} = '';
134
$self->{_strict_validation} = 0;
135
136
return $self;
137
}
138
139
# This automatically generates all the accessor functions for %FIELDS
140
sub AUTOLOAD {
141
my $self = shift;
142
my $attr = $AUTOLOAD;
143
$attr =~ s/.*:://;
144
return unless $attr =~ /[^A-Z]/; # skip DESTROY and all-cap methods
145
die "Invalid attribute method: ->$attr()\n" unless exists $FIELDS{"_$attr"};
146
$self->{"_$attr"} = shift if @_;
147
return $self->{"_$attr"};
148
}
149
150
=head2 author()
151
152
Alias for creator()
153
154
=cut
155
sub author {
156
my $self = shift;
157
return $self->creator(@_);
158
}
159
160
=head2 keywords_to_rdf()
161
162
Generates an rdf:Bag based on the data structure of keywords.
163
This can then be used to populate the subject section of the metadata.
164
I.e.:
165
166
$svgobj->subject($svg->keywords_to_rdf());
167
168
See:
169
http://www.w3.org/TR/rdf-schema/#ch_bag
170
http://www.w3.org/TR/rdf-syntax-grammar/#section-Syntax-list-element
171
http://dublincore.org/documents/2002/05/15/dcq-rdf-xml/#sec2
172
173
=cut
174
sub keywords_to_rdf {
175
my $self = shift;
176
177
my $text = '';
178
foreach my $keyword ($self->keywords()) {
179
$keyword = $self->esc_ents($keyword);
180
$text .= qq( $keyword \n);
181
}
182
183
if ($text ne '') {
184
return qq( \n$text );
185
} else {
186
return '';
187
}
188
}
189
190
191
=head2 errormsg()
192
193
Returns the last encountered error message. Most of the error messages
194
are encountered during file parsing.
195
196
print $svgmeta->errormsg();
197
198
=cut
199
200
sub errormsg {
201
my $self = shift;
202
return $self->{_ERRORMSG} || '';
203
}
204
205
206
=head2 parse($filename)
207
208
Extracts RDF metadata out of an existing SVG file.
209
210
$svgmeta->parse($filename) || die "Error: " . $svgmeta->errormsg();
211
212
This routine looks for a field in the rdf:RDF section of the document
213
named 'ns:Work' and then attempts to load the following keys from it:
214
'dc:title', 'dc:rights'->'ns:Agent', and 'ns:license'. If any are
215
missing, it
216
217
The $filename parameter can be a filename, or a text string containing
218
the XML to parse, or an open 'IO::Handle', or a URL.
219
220
Returns false if there was a problem parsing the file, and sets an
221
error message appropriately. The conditions under which it will return
222
false are as follows:
223
224
* No 'filename' parameter given.
225
* Filename does not exist.
226
* Document is not parseable XML.
227
* No rdf:RDF element was found in the document, and the try harder
228
option was not set.
229
* The rdf:RDF element did not have a ns:Work sub-element, and the
230
try_harder option was not set.
231
* Strict validation mode was turned on, and the document didn't
232
strictly comply with one or more of its extra criteria.
233
234
=cut
235
236
sub parse {
237
my ($self, $filename, %optn) = @_;
238
my $retaindecl;
239
240
# For backward-compatibility, support retain_xml as an option here:
241
if ($optn{retain_xml}) { $self->retain_xml($optn{retain_xml}); }
242
243
if (! defined($filename)) {
244
$self->{_ERRORMSG} = "No filename or text argument defined for parsing";
245
return;
246
}
247
248
my $twig = XML::Twig->new( map_xmlns => {
249
'http://www.w3.org/2000/svg' => "svg", # W3C's SVG namespace
250
'http://www.w3.org/1999/02/22-rdf-syntax-ns#' => "rdf", # W3C's metadata namespace
251
'http://purl.org/dc/elements/1.1/' => "dc", # Dublin Core metadata namespace
252
'http://web.resource.org/cc/' => "cc", # a license description namespace
253
},
254
pretty_print => 'indented',
255
comments => 'keep',
256
pi => 'keep',
257
keep_original_prefix => 1, # prevents superfluous svg:element prefixing.
258
);
259
260
if ($filename =~ m/\n.*\n/ || (ref $filename eq 'IO::Handle')) {
261
# Hmm, if it has newlines, it is likely to be a string instead of a filename
262
eval { $twig->parse($filename); };
263
if ($@) { $self->{_ERRORMSG} = "XML::Twig died; this may mean invalid XML."; return; }
264
if ($self->{_retain_xml}) {
265
($retaindecl) = $filename =~ /(.*?)(
266
}
267
} elsif ($filename =~ /^http/ or $filename =~ /^ftp/) {
268
eval { $twig->parseurl($filename); };
269
if ($@) { $self->{_ERRORMSG} = "XML::Twig died; this may mean invalid XML."; return; }
270
if ($self->{_retain_xml}) {
271
open XML, '<', $filename; local $/ = '
272
my $content = ; close XML;
273
($retaindecl) = $content =~ /(.*?)(
274
}
275
} elsif (! -e $filename) {
276
$self->{_ERRORMSG} = "Filename '$filename' does not exist"; return;
277
} else {
278
eval { $twig->parsefile($filename); };
279
if ($@) { $self->{_ERRORMSG} = "XML::Twig died; this may mean invalid XML."; return; }
280
if ($self->{_retain_xml}) {
281
open SVGIN, '<', $filename;
282
local $/ = '; close SVGIN;
283
($retaindecl) = $raw =~ /(.*?)(
284
}
285
}
286
287
if ($@) {
288
$self->{_ERRORMSG} = "Error parsing file: $@";
289
return;
290
}
291
292
if (not ref $twig) {
293
$self->{_ERRORMSG} = "XML::Twig did not return a valid XML object";
294
return;
295
}
296
# If we get this far, we should return a valid object if try_harder is set.
297
298
my $rdf;
299
my $metadata = $twig->root()->first_descendant('metadata') # preferred
300
|| $twig->root()->first_descendant('svg:metadata'); # deprecated
301
if (ref $metadata) {
302
# This is the preferred way, as the rfd SHOULD be within a metadata element.
303
$rdf = $metadata->first_descendant('rdf:RDF') || # preferred
304
$metadata->first_descendant('RDF') || # mildly deprecated
305
$metadata->first_descendant('rdf'); # mildly deprecated
306
} else {
307
# But in non-strict mode we try a little harder:
308
$rdf = $twig->root()->first_descendant('rdf:RDF') || # deprecated
309
$twig->root()->first_descendant('RDF') || # very deprecated
310
$twig->root()->first_descendant('rdf'); # very deprecated
311
}
312
if (not ref $rdf) {
313
$self->{_ERRORMSG} = "No 'RDF' element found in " .
314
((defined $metadata) ? "metadata element" : "document") . ".";
315
return unless $self->{_try_harder};
316
$rdf = $twig->root();
317
} elsif ($self->{_strict_validation} and not ref $metadata) {
318
$self->{_ERRORMSG} = "'RDF' element not contained in a block";
319
return unless $self->{_try_harder}; # undefined behavior, may change
320
}
321
322
my $work = $rdf->first_descendant('cc:Work') || # preferred
323
$rdf->first_descendant('Work'); # also okay, I think
324
if (! defined($work)) {
325
$self->{_ERRORMSG} = "No 'Work' element found in the 'RDF' element";
326
return unless $self->{_try_harder};
327
$work = $rdf;
328
}
329
330
my $getagent = sub {
331
my ($elt) = shift; return unless ref $elt;
332
return $elt->first_descendant('cc:Agent') # preferred
333
|| $elt->first_descendant('Agent') # also okay, I think
334
|| $elt; # and we treat the Agent wrapper as optional
335
};
336
my $getthingandurl = sub {
337
my ($thing, $elt, $thingdefault, $urldefault) = @_;
338
$thingdefault ||= ''; $urldefault ||= '';
339
$self->{'_'.$thing} = $thingdefault;
340
$self->{'_'.$thing.'_url'} = $urldefault;
341
342
if (ref $elt) {
343
my $agent = $getagent->($elt);
344
my $title = $agent->first_descendant('dc:title') # preferred
345
|| $agent->first_descendant('title'); # also okay, I think
346
my $about = $agent->att('rdf:about') # preferred
347
|| $agent->att('about'); # deprecated
348
$self->{'_'.$thing} = (ref $title) ? $title->text() : $thingdefault;
349
$self->{'_'.$thing.'_url'} = ($about) ? $about : $urldefault;
350
}
351
};
352
353
$getthingandurl->('publisher', $work->first_descendant('dc:publisher'),
354
# With defaults:
355
'Open Clip Art Library', 'http://www.openclipart.org/');
356
$getthingandurl->('creator', $work->first_descendant('dc:creator'));
357
$getthingandurl->('owner', $work->first_descendant('dc:rights'));
358
359
$self->{_title} = _get_content($work->first_descendant('dc:title')) || '';
360
$self->{_description} = _get_content($work->first_descendant('dc:description')) || '';
361
my $license = $work->first_descendant('cc:license');
362
if (ref $license) {
363
$self->{_license} = _get_content($license->first_descendant('rdf:resource'))
364
|| $license->att('rdf:resource') || '';
365
$self->{_license_date} = _get_content($license->first_descendant('dc:date')) || '';
366
}
367
$self->{_language} = _get_content($work->first_descendant('dc:language')) || 'en';
368
$self->{_about_url} = $work->att('rdf:about') || '';
369
$self->{_date} = _get_content($work->first_descendant('dc:date')) || '';
370
371
# If only one of creator or owner is defined, default the other to match:
372
$self->{_creator} ||= $self->{_owner};
373
$self->{_creator_url} ||= $self->{_owner_url};
374
$self->{_owner} ||= $self->{_creator};
375
$self->{_owner_url} ||= $self->{_creator_url};
376
377
if ($self->{_retain_xml}) {
378
$self->{_RETAINED_XML} = \$twig; # Keep the actual SVG around. (to_svg is worthless without this.)
379
$self->{_RETAINED_DECLARATION} = $retaindecl || ''; # and the XML declaration (and possibly also the doctype)
380
}
381
382
my $subject = $work->first_descendant('dc:subject');
383
if (ref $subject) {
384
my @keyword = $subject->descendants('rdf:li');
385
# rdf:li elements are strongly preferred, and they should be wrapped in rdf:Bag
386
# But if that returns nothing, we try harder:
387
if (not @keyword) {
388
push @keyword, grep { $_ } # (Throw out empty keywords.)
389
split /(?:(?![-])\W)*/, # (Split on non-word chars *except* hyphen)
390
$subject->text(); # But this is a last resort, very deprecated.
391
}
392
my @keywordtext = map { $_->text() } @keyword;
393
$self->{_subject} = +{ map { $_ => 1 } @keywordtext }; # We *could* also map a split here...
394
}
395
if (not keys %{$self->{_subject}}) {
396
$self->{_subject} = { unsorted => 1 };
397
} elsif (keys %{$self->{_subject}} > 1 and exists $self->{_subject}->{unsorted}) {
398
delete ($self->{_subject}->{unsorted});
399
}
400
$self->{_keywords} = $self->{_subject}; # to_rdf() rebuilds _subject from _keywords
401
undef $self->{_subject}; # The POD for subject() says we do this.
402
403
return $self; # references are always true in boolean context
404
}
405
406
# XML::Twig::simplify has a bug where it only accepts "forcecontent", but
407
# the option to do that function is actually recognized as "force_content".
408
# As a result, we have to test to see if we're at a HASH node or a scalar.
409
sub _get_content {
410
my ($content)=@_;
411
412
if (UNIVERSAL::isa($content,"HASH")
413
&& exists($content->{'content'})) {
414
return $content->{'content'};
415
} elsif (ref $content) {
416
return $content->text();
417
} else {
418
return $content;
419
}
420
}
421
422
=head2 title()
423
424
Gets or sets the title.
425
426
$svgmeta->title('My Title');
427
print $svgmeta->title();
428
429
=head2 description()
430
431
Gets or sets the description
432
433
=head2 subject()
434
435
Gets or sets the subject. Note that the parse() routine pulls the
436
keywords out of the subject and places them in the keywords
437
collection, so subject() will normally return undef. If you assign to
438
subject() it will override the internal keywords() mechanism, but this
439
may later be discarded again in favor of the keywords, if to_rdf() is
440
called, either directly or indirectly via to_svg().
441
442
=head2 publisher()
443
444
Gets or sets the publisher name. E.g., 'Open Clip Art Library'
445
446
=head2 publisher_url()
447
448
Gets or sets the web URL for the publisher. E.g., 'http://www.openclipart.org'
449
450
=head2 creator()
451
452
Gets or sets the creator.
453
454
$svgmeta->creator('Bris Geek');
455
print $svgmeta->creator();
456
457
=head2 creator_url()
458
459
Gets or sets the URL for the creator.
460
461
=head2 author()
462
463
Alias for creator() - does the same thing
464
465
$svgmeta->author('Bris Geek');
466
print $svgmeta->author();
467
468
=head2 owner()
469
470
Gets or sets the owner.
471
472
$svgmeta->owner('Bris Geek');
473
print $svgmeta->owner();
474
475
=head2 owner_url()
476
477
Gets or sets the owner URL for the item
478
479
=head2 license()
480
481
Gets or sets the license.
482
483
$svgmeta->license('Public Domain');
484
print $svgmeta->license();
485
486
=head2 license_date()
487
488
Gets or sets the date that the item was licensed
489
490
=head2 language()
491
492
Gets or sets the language for the metadata. This should be in the
493
two-letter lettercodes, such as 'en', etc.
494
495
=head2 retain_xml()
496
497
Gets or sets the XML retention option, which (if true) will cause any
498
subsequent call to parse() to retain the XML. You have to turn this
499
on if you want to_svg() to work later.
500
501
=head2 strict_validation()
502
503
Gets or sets the strict validation option, which (if true) will cause
504
subsequent calls to parse() to be pickier about how things are
505
structured and possibly set an error and return undef when it
506
otherwise would succeed.
507
508
=head2 try_harder()
509
510
Gets or sets the try harder option option, which causes subsequent
511
calls to parse() to try to return a valid Metadata object even if it
512
can't find any metadata at all. The resulting object may contain
513
mostly empty fields.
514
515
Parse will still fail and return undef if the input file does not
516
exist or cannot be parsed as XML, but otherwise it will attempt to
517
return an object.
518
519
If you set both this option and the strict validation option at the
520
same time, the Undefined Behavior Fairy will come and zap you with a
521
frap ray blaster and take away your cookie.
522
523
=head2 keywords()
524
525
Gets or sets an array of keywords. Keywords are a categorization
526
mechanism, and can be used, for example, to sort the files topically.
527
528
=cut
529
530
sub keywords {
531
my $self = shift;
532
if (@_) {
533
$self->addKeyword(@_);
534
}
535
return undef unless defined($self->{_keywords});
536
537
# warn Dumper(+{ _keywords => $self->{_keywords}}); # DEBUG
538
539
return keys %{$self->{_keywords}};
540
}
541
542
543
=head2 addKeyword($kw1 [, $kw2 ...])
544
545
Adds one or more a new keywords. Note that the keywords are stored
546
internally as a set, so only one copy of a given keyword will be stored.
547
548
$svgmeta->addKeyword('Fruits and Vegetables');
549
$svgmeta->addKeyword('Fruit','Vegetable','Animal','Mineral');
550
551
=cut
552
553
sub addKeyword {
554
my $self = shift;
555
foreach my $new_keyword (@_) {
556
$self->{_keywords}->{$new_keyword} = 1;
557
}
558
}
559
560
561
=head2 removeKeyword($kw)
562
563
Removes a given keyword
564
565
$svgmeta->removeKeyword('Fruits and Vegetables');
566
567
Return value: The keyword removed.
568
569
=cut
570
571
sub removeKeyword {
572
my $self = shift;
573
my $keyword = shift || return;
574
575
return delete $self->{_keywords}->{$keyword};
576
}
577
578
579
=head2 hasKeyword($kw)
580
581
Returns true if the metadata includes the given keyword
582
583
=cut
584
585
sub hasKeyword {
586
my $self = shift;
587
my $keyword = shift || return 0;
588
589
return 0 unless defined($self->{_keywords});
590
591
return (defined($self->{_keywords}->{$keyword}));
592
}
593
594
=head2 compare($meta2)
595
596
Compares this metadata to another metadata for equality.
597
598
Two SVG file metadata objects are considered equivalent if they
599
have exactly the same author, title, and license. Keywords can
600
vary, as can the SVG file itself.
601
602
=cut
603
604
sub compare {
605
my $self = shift;
606
my $meta = shift;
607
608
return ( $meta->author() eq $self->author() &&
609
$meta->title() eq $self->title() &&
610
$meta->license() eq $self->license()
611
);
612
}
613
614
615
=head2 to_text()
616
617
Creates a plain text representation of the metadata, suitable for
618
debuggery, emails, etc. Example output:
619
620
Title: SVG Road Signs
621
Author: John Cliff
622
License: http://web.resource.org/cc/PublicDomain
623
Keywords: unsorted
624
625
Return value is a string containing the title, author, license, and
626
keywords, each value on a separate line. The text always ends with
627
a newline character.
628
629
=cut
630
631
sub to_text {
632
my $self = shift;
633
634
my $text = '';
635
$text .= 'Title: ' . ($self->title()||'') . "\n";
636
$text .= 'Author: ' . ($self->author()||'') . "\n";
637
$text .= 'License: ' . ($self->license()||'') . "\n";
638
$text .= 'Keywords: ';
639
$text .= join("\n ", $self->keywords());
640
$text .= "\n";
641
642
return $text;
643
}
644
645
=head2 esc_ents($text)
646
647
Escapes '<', '>', and '&' and single and double quote
648
characters to avoid causing rdf to become invalid.
649
650
=cut
651
652
sub esc_ents {
653
my $self = shift;
654
my $text = shift;
655
return $text unless $text;
656
657
return encode_entities($text, qq(<>&"'));
658
}
659
660
=head2 to_rdf()
661
662
Generates an RDF snippet to describe the item. This includes the
663
author, title, license, etc. The text always ends with a newline
664
character.
665
666
=cut
667
668
sub to_rdf {
669
my $self = shift;
670
671
my $about_url = $self->esc_ents($self->about_url()) || '';
672
my $title = $self->esc_ents($self->title()) || '';
673
my $creator = $self->esc_ents($self->creator()) || '';
674
my $creator_url = $self->esc_ents($self->creator_url()) || '';
675
my $owner = $self->esc_ents($self->owner()) || '';
676
my $owner_url = $self->esc_ents($self->owner_url()) || '';
677
my $date = $self->esc_ents($self->date()) || '';
678
my $license = $self->esc_ents($self->license()) || '';
679
my $license_date = $self->esc_ents($self->license_date()) || '';
680
my $description = $self->esc_ents($self->description()) || '';
681
my $subject = $self->keywords_to_rdf() || '';
682
my $publisher = $self->esc_ents($self->publisher()) || '';
683
my $publisher_url = $self->esc_ents($self->publisher_url()) || '';
684
my $language = $self->esc_ents($self->language()) || 'en';
685
686
my $license_rdf = '';
687
if ($license eq 'Public Domain'
688
or $license eq 'http://web.resource.org/cc/PublicDomain') {
689
$license = "http://web.resource.org/cc/PublicDomain";
690
$license_rdf = qq(
691
692
693
694
695
696
);
697
} elsif ($license eq 'http://creativecommons.org/licenses/by-nc-nd/2.0/') {
698
$license_rdf = qq(
699
700
701
702
703
704
705
706
);
707
} elsif ($license eq 'http://creativecommons.org/licenses/by/2.0/') {
708
$license_rdf = qq(
709
710
711
712
713
714
715
716
);
717
} elsif ($license eq 'http://creativecommons.org/licenses/by-nc/2.0/') {
718
$license_rdf = qq(
719
720
721
722
723
724
725
726
727
);
728
} elsif ($license eq 'http://creativecommons.org/licenses/by-nd/2.0/') {
729
$license_rdf = qq(
730
731
732
733
734
735
736
);
737
} elsif ($license eq 'http://creativecommons.org/licenses/by-nc-nd/2.0/') {
738
$license_rdf = qq(
739
740
741
742
743
744
745
746
);
747
} elsif ($license eq 'http://creativecommons.org/licenses/by-nc-sa/2.0/') {
748
$license_rdf = qq(
749
750
751
752
753
754
755
756
757
758
);
759
} elsif ($license eq 'http://creativecommons.org/licenses/by-sa/2.0/') {
760
$license_rdf = qq(
761
762
763
764
765
766
767
768
769
);
770
}
771
772
my $pub_data = ($publisher_url ? ' rdf:about="'.$publisher_url.'"' : '');
773
my $creator_data = ($creator_url ? ' rdf:about="'.$creator_url.'"' : '');
774
my $owner_data = ($owner_url ? ' rdf:about="'.$owner_url.'"' : '');
775
return qq(
776
777
778
xmlns="http://web.resource.org/cc/"
779
xmlns:dc="http://purl.org/dc/elements/1.1/"
780
xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#">
781
782
$title
783
$description
784
785
$subject
786
787
788
789
$publisher
790
791
792
793
794
$creator
795
796
797
798
799
$owner
800
801
802
$date
803
image/svg+xml
804
805
806
$language
807
808
$license_rdf
809
810
811
);
812
813
}
814
815
=head2 to_svg()
816
817
Returns the SVG with the updated metadata embedded. This can only be
818
done if parse() was called with the retain_xml option. Note that the
819
code's layout can change a little, especially in terms of whitespace,
820
but the semantics SHOULD be the same, except for the updated metadata.
821
822
=cut
823
824
sub to_svg {
825
my ($self) = shift;
826
if (not $self->{_RETAINED_XML}) {
827
$self->{_ERRORMSG} = "Cannot do to_svg because the XML was not retained. Pass a true value for the retain_xml option to parse to retain the XML, and check the return value of parse to make sure it succeeded.";
828
return undef;
829
}
830
831
my $xml = ${$self->{_RETAINED_XML}};
832
my $metadata = XML::Twig->new(
833
map_xmlns => {
834
'http://web.resource.org/cc/' => "cc",
835
'http://www.w3.org/1999/02/22-rdf-syntax-ns#' => "rdf",
836
'http://purl.org/dc/elements/1.1/' => "dc",
837
},
838
pretty_print => 'indented',
839
);
840
$metadata->parse($self->to_rdf());
841
for ($xml->descendants(qr'metadata'),
842
$xml->descendants(qr'svg:metadata'),
843
# $xml->descendants(qr'rdf:RDF'), # These too? I'm not sure. Leaving them for now.
844
) {
845
# Out with the old...
846
$_->delete() if defined $_;
847
}
848
# In with the new...
849
$metadata->root()->copy();
850
$metadata->root()->paste( first_child => $xml->root());
851
return $self->{_RETAINED_DECLARATION} . $xml->root()->sprint();
852
}
853
854
1;
855
__END__