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

[Alberto Simões]

Waiting for it on CVS >:)

On Sat, 07 Aug 2004 18:00:22 -0400, Jonadab the Unsightly One
<jonadab at bright.net> wrote:
> 
> 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$/
> 
> _______________________________________________
> clipart mailing list
> clipart at freedesktop.org
> http://freedesktop.org/mailman/listinfo/clipart
> 


-- 
Alberto Simões