[Clipart] organize repository and access rights

[Jonadab the Unsightly One]

"Jonadab the Unsightly One" <jonadab at bright.net> writes:

> Alberto Simões <hashashin at gmail.com> writes:
>
>> I'll be off the next week (not 100% off, but almost), but when I
>> come back, I'll try to add some little metadata to SVG files (that
>> which do not contain it) so I can prepare the new keyword-based
>> navigation script.
>
> Okay.  I'll try to have an add-keyword script ready to make this
> easy.


I have a keyword script (below; I'll also be checking it into CVS as
clipart_web/keyword shortly) mostly done.  There are some important
caveats, however:

 1. For now, it *only* works on SVG files with embedded metadata.
    Trying to use it on anything else may unleash small dragons into
    your underwear drawer.

 2. You need SVG::Metadata version 0.11 or higher.  Attempting to use
    this script with an earlier version may cause mischevious wood
    sprites to play practical jokes involving your hard drive and a
    twenty-pound sledgehammer.

 3. If you use the -r option to descend recursively into
    subdirectories, #1 still applies.

 4. If you use the -r option to descend recursively into
    subdirectories, the name of each subdirectory will be
    treated as a keyword and added to all the files inside of that
    subdirectory, and inside of its subdirectories, and so on,
    recursively.  (This is to be construed as a feature.)

 5. If the image had any keywords previously, they will be
    removed.  As near as I can tell, this is because SVG::Metadata
    (version 0.11) does not parse the keywords.

With those things in mind, here's the script:

#!/usr/bin/perl
# -*- cperl -*-

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

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|<$_.*?</$_>||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;
}

__END__

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