[Clipart] Keys in flags

Jonadab the Unsightly One jonadab at bright.net
Fri Oct 1 17:36:51 PDT 2004

Christian Fredrik Kalager Schaller <uraeus at linuxrising.org> writes:

> Ok, I now have the latest svg_anotate working well for me. Only thing is
> how am I supposed to add the keywords? there is no -k option for
> svg_annotate and I assume I am not meant to add them to the title?

For adding keywords, use this script:

# -*- cperl -*-

use SVG::Metadata;
use File::Spec::Functions;
use Data::Dumper; $|=1;

if (not @ARGV) {
  printusage(); exit 0;

my @file = grep { not /^-/ } @ARGV;
my %flag = map { s/^-//; (/^-([^=]+)=(.*)/) ? ($1, $2) : ($_, 1) } grep { /^-/ } @ARGV;
$flag{dir} ||= ".";

process(\%flag, @file); exit 0;

sub process {
  my %flag = %{shift at _};
  warn "[Looking at @_]" if $flag{debug}>1;
  for $f (@_) {
    if (-f $f) {
      processfile(\%flag, $f);
    } elsif ($flag{r} and -d $f) {
      if (opendir DIR, $f) {
        warn "Descending into $f...\n" if $flag{debug};
        my @f   = map { catfile($flag{dir}, $f, $_) } grep { not /^[.]+$/ } readdir DIR; closedir DIR;
        my ($k) = $f =~ /(\w+)\s*$/;
        my %f   = %flag; $f{keywords} .= ",$k";
        $f{dir} = catfile($flag{dir}, $f);
        if ($f{rlimit}) {
          $f{rlimit}--; $f{r} = 0 unless $f{rlimit};
        warn "Descending with flags: " . Dumper(\%f) if $flag{debug} > 1;
        process(\%f, @f);
      } else {
        warn "Cannot descend into $f: $!\n";
    } elsif (-d $f) {
      warn "Ignoring directory $f (use -r to descend recursively into directories)\n";
    } else {
      warn "Ignoring $f (not a regular file, not a directory)\n";

sub processfile {
  # This version only supports SVG with embedded RDF:
  my %flag = %{shift at _};
  my ($file) = @_;

  warn "Processing $file\n" if $flag{debug}>1;
  my $meta = SVG::Metadata->new();
  $meta->parse($file) or warn "Failed to parse existing metadata for $file\n";
  warn "Starting metadata for $file:  " . Dumper(\$meta) if $flag{debug}>3;
  for (split /[,]/, $flag{keywords}) { $meta->addKeyword($_) }

  open SVG, "<" . $file or die "Cannot read $file: $!\n";
  my $svg; { local $/ = undef; $svg = <SVG> } close SVG;
  my $rdf = $meta->to_rdf();

  $svg =~ s|\s*<$_.*?</$_>||gs for 'metadata', 'rdf:RDF', 'rdf'; # Remove old RDF
  $svg =~ s|(?=</svg>)|$rdf|s;                                # Insert new RDF

  open SVG, ">" . $file or die "Cannot write $file: $!\n";
  print SVG $svg; close SVG;

sub printusage {
  print <<"USAGE";
    $0 [options] files

    $0 --keywords=party,festive,fun confetti-01.svg confetti-02.svg baloons-01.svg
         Adds the keywords 'party', 'festive', and 'fun' to those three SVG images.
    $0 -r *
         Descends recursively from the current directory, adding keywords to all the
         SVG images for each directory it descends through.  For example, the image
         in foo/bar/baz.svg will have the keywords 'foo' and 'bar' added.

    Any option preceded by a single hyphen is given a value of 1.  Any option preceded
    by two hyphens must have an equal sign and a value, as with the keywords option
    in the example.  This assigns the value after the equal sign to the option.

    debug      Turn on extra debugging output.  Higher value mean more info.
    keywords   Comma-separated list of whitespace-free keywords to add.
    r          Recurse through subdirectories, adding the subdirectory name to
               the list of keywords for everything under that subdirectory.

   Early versions of SVG::Metadata do not parse existing keywords.  If you use
   this program with one of those versions, existing keywords will be removed
   as a result of this, and only the keywords you add will remain.  You need
   at least version 0.14 of SVG::Metadata installed to avoid this.

   Additionally, any other metadata not fully supported by SVG::Metadata will
   be lost.  Please test on duplicate copies of your files before trusting this
   with your only copy of anything, to ensure that you do not lose any important


More information about the clipart mailing list