#!/usr/bin/perl -w
# file KLEIDER/web/src/addstory/cpimg_cat_to_web.pl
# Kopiert Bilddateien vom Katalogverzeichnis in das Web-Verzeichnis
# 2011-04-04 Herbert Schiemann <h.schiemann@herbaer.de>
# GPL Version 2 oder neuer

# 2012-08-25 neue Verzeichnisstruktur
# 2015-08-13 in Unterverzeichnis erst default-Story-Dateiname, .gz ausnehmen

package JpgTagsProcessor ;

use XML::SAX::ParserFactory;
use Fcntl;                 # wg O_RDONLY

=pod
Ein SAX-Handler, der alle jpg-Elemente aus einer XML-Datei verarbeitet
=cut

# Konstruktor
# $parser = new JpgTagsProcessor ($code)
# @param code: Subroutine, die für jedes öffnende jpg-Tag aufgerufen wird:
# code ($attr);
# $attr -> {"attrname"} # Attributwert
sub new {
   my ($class, $code) = @_;
   $class = ref($class) || $class;
   $self = {};
   $self -> {"parser"} = XML::SAX::ParserFactory -> parser (Handler => $self);
   $self -> {"code"}   = $code if ref ($code) eq "CODE";
   return bless ($self, $class);
} # new

# Setzt Subroutine, s. Konstruktor
sub set_code {
   my ($self, $code) = @_;
   $self -> {"code"} = $code if ref ($code) eq "CODE";
} # set_code

# SAX-Handler-Methode
sub start_element {
   my ($self, $el) = @_;
   my $ln = $el -> {'LocalName'};
   return if $ln ne 'jpg';
   my $attr = $el -> {'Attributes'};
   my $attrvals = {};
   my ($key, $val);
   while (($key, $val) = each %$attr) {
      $key =~ s/^\{\}//;
      $attrvals -> {$key} = $val -> {"Value"};
   }
   $self -> {"code"} -> ($attrvals);
} # start_element

# Verarbeitet eine Datei
sub parse_file {
   my ($self, $filename) = @_;
   my $fh;   # Dateihandle
   if (sysopen ($fh, $filename, O_RDONLY)) {
      eval ( '$self -> {"parser"} -> parse_file ($fh); 1;' ) or
         $self -> {"parser"} = XML::SAX::ParserFactory -> parser (Handler => $self);
      close ($fh);
   }
} # parse_file

1;

# ================================================================

package main;

use Cwd qw(realpath);
use File::Spec::Functions ; # catfile, catdir
use File::Copy ;            # copy
use Herbaer::Readargs;      # read_args ()

my $basedir = realpath($0);
$basedir =~ s/\/web\/src\/addstory\/cpimg_cat_to_web\.pl//;

# Hash der Kommandozeilen-Argumente
my $args = {
   "catalog"        => catdir ($basedir, "catalog", "stories"),
   "webdir"         => catdir ($basedir, "web", "docroot"),
   "wdepattern"     => undef,
   "wsdtemplate"    => 's${key}',
   "wsddeffname"    => "story.xml.de.",
   "cattemplate"    => 'story_${key}',
   "ifntemplate"    => '${img}.jpg',
   "[cnt]verbose"   => undef,
   "[cnt]overwrite" => undef,
};

sub version {
   print <<'VERSION' ;
KLEIDER/web/src/addstory/cpimg_cat_to_web.pl
2012-08-25 Herbert Schiemann <h.schiemann@herbaer.de>
VERSION
}
$args -> {"[sr]version"} = sub { version (); exit 0; };

$args -> {"[sr]help"} = sub {
   version ();
   set_default ($args);
   print_message_with_values (<<'HELP', $args);
cpimg_cat_to_web.pl --help     zeigt diese Hilfe an
cpimg_cat_to_web.pl --version  zeigt die Programm-Version an

cpimg_cat_to_web.pl OPTION.. [KENNUNG..]
--catalog     CATALOG  Katalog-Verzeichnis ${catalog}
--webdir      WEBDIR   Website-Verzeichnis ${webdir}
--wdepattern  WDEPAT   Regulärer "Extraktor" beschreibt Einträge im WEBDIR
                       ${wdepattern}
--wsdtemplate WSDTEMPL Vorlage für ein Unterverzeichnis der Website,
                       ${wsdtemplate}
--wsddeffname WDDFNAME Vorgabe-Dateiname für XML-Datei im Website-Unterverzeichnis
                       ${wsddeffname}
--cattemplate CATTEMPL Vorlage für Katalog-Unterverzeichnisse,
                       ${cattemplate}
--ifntemplate IFNTEMPL Vorlage für Namen von Bilddateien,
                       ${ifntemplate}
--verbose              Umfangreichere Ausgabe nach STDOUT ${[cnt]verbose}
--overwrite            existierende Bilddateien überschreiben ${[cnt]overwrite}
KENNUNG                Kennung einer "Story", deren Bilder kopiert werden.
HELP
   exit 0;
};

sub set_default {
   my $args = shift;
   my $r = $args -> {"wdepattern"};
   if (! $r) {
      $r = $args -> {"wsdtemplate"};
      $r =~ s/\$\{key\}/([0-9_][a-z0-9_]+)/;
      $args -> {"wdepattern"} = "^$r(?:\\.xml)?\$";
   }
} # set_default

read_args ($args);
set_default ($args);

my $verbose = $args -> {"[cnt]verbose"};

# kopiert eine Datei
# _copy_file ("von", "zu");
sub _copy_file {
   my ($from, $to) = @_;
   print "cp \"$from\" -> \"$to\"\n" if $verbose;
   copy ($from, $to);
} # _copy_file

my $parser = new JpgTagsProcessor ();

if ($args -> {"_argv"}) {
   process_keys ($args, $args -> {"_argv"});
}
else {
   process_webdir ($args, $args -> {"webdir"}, $args -> {"catalog"});
}

# verarbeitet eine Liste von Bildergeschichten-Kennungen
# @param keys   die Schlüssel der Stories als ARRAYREF
sub process_keys {
   my ($args, $keys) = @_;
   return unless ref ($keys) eq "ARRAY";
   my $verbose  = $args -> {"[cnt]verbose"}; 
   my $key;                                 # Schlüssel einer "Story"
   my $wsdt     = $args -> {"wsdtemplate"};
   my $webdir   = $args -> {"webdir"};      # Web-Verzeichnis
   my $catalog  = $args -> {"catalog"};     # Katalog-Verzeichnis
   my $websd;                               # Web-Unterverzeichnis
   foreach $key ($webdir, $catalog) {
      if (! -d $key) {
         print "\"$key\" ist kein Verzeichnis\n" if $verbose;
         return;
      }
   }
   $wsdt = '"' . $wsdt . '"';
   foreach $key (@$keys) {
      $websd = catdir ($webdir, eval ($wsdt));
      if (! -d $websd) {
         print "\"$websd\" ist kein Verzeichnis\n" if $verbose;
         next;
      }
      process_websubdir ($args, $websd, $key, $catalog);
   }
} # process_keys

# kopiert die Bilddateien
# @param webdir  das Web-Verzeichnis
# @param catalog das Katalog-Verzeichnis
sub process_webdir {
   my ($args, $webdir, $catalog) = @_;
   my $reweb = $args -> {"wdepattern"};
   $reweb = qr/$reweb/;
   my $dh;  # Handle des Web-Verzeichnisses
   my $de;  # Verzeichniseintrag im Web-Verzeichnis
   my $dep; # Voller Pfad eines Eintrags im Web-Verzeichnis
   my $fn;  # Dateiname oder Verzeichnisname
   my $key; # Kennung einer "Geschichte"
   my $wsdt    = $args -> {"wsdtemplate"};
   my $defname = $args -> {"wsddeffname"}; # Vorgabe-Name für XML-Dateien

   # erst alle Dateien im Web-Verzeichnis verarbeiten
   # Dateien, deren Namen dem Muster "wdepattern" entsprechen,
   # werden als Bildergeschichten behandelt.
   # Zu jeder "wdepattern"-Datei wird ein entsprechendes Unterverzeichnis erstellt
   # und die Datei in das Unterverzeichnis kopiert,
   # mit dem Standard-Namen ("story.xml") als Namen der Kopie, falls möglich.
   # Danach werden die Unterverzeichnisse des Web-Verzeichnisses verarbeitet.
   opendir ($dh, $webdir) or die "Kann Verzeichnis $webdir nicht öffnen: $!\n";
   while (defined ($de = readdir ($dh))) {
      next if $de =~ /^\./;
      next unless $de =~ $reweb;
      $key = $1;
      $dep  = catfile ($webdir, $de);
      next unless -f $dep;
      $fn = eval ($wsdt);
      $fn = catfile ($webdir, $fn);
      if (! -e $fn) {
         mkdir $fn;
         _copy_file ($dep, catfile ($fn, $defname));
      }
      elsif (-d $fn) {
         if (! -e catfile ($fn, $defname)) {
            _copy_file ($dep, catfile ($fn, $defname));
         }
         elsif (! -e catfile ($fn, $de)) {
            _copy_file ($dep, catfile ($fn, $de));
         }
      }
   }
   closedir ($dh);

   # dann die Unterverzeichnisse
   opendir ($dh, $webdir);
   while (defined ($de = readdir ($dh))) {
      next if $de =~ /^\./;
      next unless $de =~ $reweb;
      $key = $1;
      $dep = catfile ($webdir, $de);
      next unless -d $dep;
      process_websubdir ($args, $dep, $key, $catalog);
   }
   closedir ($dh);
} # process_webdir

# verarbeitet alle Dateien in einem Webdir-Unterverzeichnis
# $key   bestimmt das Katalog-Unterverzeichnis
# $wsdp  Pfad des Webdir-Unterverzeichnisses
sub process_websubdir {
   my ($args, $wsdp, $key, $catalog) = @_;
   my $verbose = $args -> {"[cnt]verbose"};
   my $imgsubdirs = []; # Bild-Unterverzeichnisse
   my $dh;              # Verzeichnis-Handle
   my $de;              # Verzeichnis-Eintrag
   my $dep;             # Pfad zu einem Verzeichnis-Eintrag
   my $defname = $args -> {"wsddeffname"}; # Vorgabe-Name für XML-Dateien

   my $csd = eval ('"' . $args -> {"cattemplate"} . '"');
   $csd = catfile ($catalog, $csd);
   opendir ($dh, $csd) or die  ("Kann Katalog-Unterverzeichnis $csd nicht lesen: $!\n");
   while (defined ($de = readdir ($dh))) {
      next if $de =~ /^\./;
      push (@$imgsubdirs, $de) if -d catfile ($csd, $de);
   }
   closedir ($dh);

   my $ifnt = '"' . $args -> {"ifntemplate"} . '"';
   my $over = $args -> {"[cnt]overwrite"};
   my $attr;
   my $img;    # Name einer Bilddatei
   my $idir;   # Bild-Unterverzeichnis
   my $widir;  # Pfad des Web-Bildunterverzeichnisses
   my $irp;    # relativer Bild-Pfad
   my $wif;    # Pfad eines Web-Bildes
   my $cif;    # Pfad eines Katalog-Bildes
   $parser -> set_code (
      sub {
         $attr = shift;
         $img = $attr -> {"src"};
         return unless $img;
         $img = eval ($ifnt);
         for $idir (@$imgsubdirs) {
            $irp   = catfile ($idir, $img);
            $cif   = catfile ($csd, $irp);
            if (-f $cif) {
               $widir = catfile ($wsdp, $idir);
               mkdir ($widir) unless -e $widir;
               $wif = catfile ($wsdp, $irp);
               _copy_file ($cif, $wif) if ($over || ! -e $wif);
            }
         }
      }
   );
   $dep = catfile ($wsdp, $defname);
   if (-f $dep) {
      print "Story-Datei $dep\n" if $verbose;
      $parser -> parse_file ($dep);
   }
   else {
      opendir ($dh, $wsdp) or die ("Kann Verzeichnis $wsdp nicht lesen: $!\n");
      while (defined ($de = readdir ($dh))) {
         next if $de =~ /^\./;
         next if $de =~ /~$/;
         next if $de =~ /\.gz$/;
         $dep = catfile ($wsdp, $de);
         next unless -f $dep;
         print "Story-Datei $dep\n" if $verbose;
         $parser -> parse_file ($dep);
      }
      closedir ($dh);
   }
} # process_websubdir
# end of file KLEIDER/web/src/addstory/cpimg_cat_to_web.pl