[Clipart] New version of keyword-adding script, includes the ability to print usage information.

[Jonadab the Unsightly One]

I'll check this into CVS when that becomes available again, but for
now, here is a new version of the keyword-adding script.  The key
improvement is that if you run it with no arguments, it prints up
some information on how to use it, including examples.

Here it is:

#!/usr/bin/perl
# -*- 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";
USAGE:
    $0 [options] files

EXAMPLES:
    $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.

OPTIONS:
    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.

  SPECIFIC OPTIONS:
    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.

CAVEATS:
   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.15 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
   metainformation.

USAGE
}
__END__

-- 
$;=sub{$/};@;=map{my($a,$b)=($_,$;);$;=sub{$a.$b->()}}
split//,"ten.thgirb\@badanoj$/ --";$\=$ ;-> ();print$/