# lädt die WSDL vom Netz herunter, und alle damit verknüpften XSD-Dateien ebenso,
# speichert dies in einem Unterordner eines Basis-Verzeichnisses. Ruft wsimport
# für die WSDL auf, um für Java brauchbare Klassen zu erzeugen.
# Dez. 14: Fehlerkorrekturen bei namespace-fehlender Verwendung, absolute/relative pfade; kein -p, dafür -b/XJB
# April. 15: Basic-Authentication bei HTTP noch beachten.

use strict;
use LWP::UserAgent;
use HTTP::Request;
use MIME::Base64;  # für basic authentication


my $ua = new LWP::UserAgent;

# Angabe WSDL-Ort samt zu nutzender Package-Bezeichnung
my $wo = "http://test.de:80/basis/stammdaten/KundenService/test";

# falls URL mit Benutzer/Passwort gesichert (=Basic authentication)
my $benutzer = "DOM\\Test";
my $passwort = "passx";
my $mitSec = 0;

# wenn wsimport gemacht werden soll, sonst nur Herunterladen der WSDL mit den imports/inkludes darin.
my $mitWsimport = 0;
# wenn folgendes aktiv, wird eine XJB-Datei genutzt bei wsimport
my $binding = ""; # "bind.xjb";


# Basisverzeichnis für die Unterordner
my $basis = "C:\\test_dir";



# Hauptprogramm: erst WSDL, dann ggf. rekursiv alle XSD runterladen
my $bis = rindex($wo, "/"); die "keine richtige URL\n" unless $bis >= 0;
my $datei = substr($wo, $bis+1).".wsdl";

# Unterverzeichnis ermitteln, wo die generierten Dateien abzulegen sind, aus URL abgeleitet
my $verzeichnis = "";
my $von = rindex($wo, "/");
if ($von >= 0)
{
  $verzeichnis = $basis."\\".substr($wo, $von+1);
}
else
{
  $verzeichnis = $basis."\\"."download";
}
if ($binding ne "")
{
 die "XJB-Datei $binding nicht gefunden" unless -r "$verzeichnis\\$binding";
}
system("mkdir $verzeichnis 2> nul");

&speichern($wo."?wsdl", $verzeichnis."\\$datei");
&bearbeiten_laden($verzeichnis, $datei, $wo);

if ($mitWsimport)
{
  # Noch wsimport nutzen, um Java zu erhalten, und zwar auf die lokale Datei
  # wichtig: kein -p nutzen, weil sonst wsimport Probleme hat (ObjectFactory bei mehreren Schemas mehrfach angelegt) und die Fehlermeldung liefert:
  # [ERROR] Two declarations cause a collision in the ObjectFactory class.
  # weiteres Problem
  # [ERROR] The package name 'x' used for this schema is not a valid package name.
  # dann eine XJB-Datei manuell anlegen und oben Variable $binding.
  # Beispiel:
  #
  # <bindings xmlns="http://java.sun.com/xml/ns/jaxb" xmlns:xs="http://www.w3.org/2001/XMLSchema" version="2.1">
  #  <bindings schemaLocation="sparql-protocol-types.xsd" node="/xs:schema">
  #    <schemaBindings>
  #      <package name="org.w3._2005._09.sparql_protocol_types"/>
  #    </schemaBindings>
  #  </bindings>
  # </bindings>

  my $anw = "wsimport $verzeichnis\\$datei -d $verzeichnis -Xnocompile";
  if ($binding ne "") {  $anw = $anw." -b $verzeichnis\\$binding"; }
  my $rueck = system($anw);
  if ($rueck != 0)
  {
    print "Rückgabewert von wsimport: $rueck\n";
  }
}


# Durchforstet die lokal abgespeicherte wsdl/xsd, macht schemaLocation-Ersetzung und lädt neue Datein ggf. herunter,
# also ggf. rekursiv. die StartUrl ist wichtig, da manchmal Verweise kein http haben, sondern nur Datenname, dann relativ
sub bearbeiten_laden()
{
  my $verzeichnis = $_[0]; my $datei = $_[1]; my $basisUrl = $_[2]; my $von; my $bis;

  print "Bearbeite $datei\n";

  # startUrl ggf. noch bestimmen und weitergeben
  if ($datei =~ /http:.*\.xsd/  || $basisUrl eq "")
  {
    die "Zu bearbeitende Datei nicht lokal oder basisUrl ist leer\n";
  }
  else { print "Basis-URL ist $basisUrl\n"; }


  # hole imports nach lokal !
  open (my $EINGABE, "<".$verzeichnis."\\$datei") || die "$datei konnte nicht gelesen werden\n";
  open (my $AUSGABE, ">".$verzeichnis."\\$datei"."_neu") || die "$datei"."_neu konnte nicht erzeugt werden\n";
  my $ns = "xsd"; # der Namespace wird erst noch ermittelt
  while (<$EINGABE>)
  {
    my $angepasst = 0;
    # mit und ohne Namespace beachten
    if ($_ =~ /\<([\w]+:)?schema /)
    {
      $bis = index($_, "schema "); $von = rindex($_, "<", $bis); die "Namespace nicht ermittelt" unless $bis >= 0 && $von >= 0;
      $ns = substr($_, $von+1, $bis-$von-1); 
      print "namespace des Schema ist $ns\n" unless $ns eq "";
    }
    my $ab;
    if (($ab = index($_, "<$ns"."import ")) >= 0 || ($ab = index($_, "<$ns"."include ")) >= 0 || ($ab = index($_, "<$ns"."redefine ")) >= 0)
    {
      print "import/include/redefine erkannt ...\n";
      $von = -1; # kann in neuer Zeile sein
      do
      {
        $von = index($_, "schemaLocation=", $ab);
        if ($von >= 0) { } 
        elsif (index($_, ">") >= 0) { die "Ende des tags nicht gefunden\n"; }
        if ($von < 0) { print $AUSGABE $_; $_ = <$EINGABE>; }
      } 
      while ($von < 0);
      # Fälle: 1) Schemadatei lokal schon vorhanden 2) Schemadatei absolut runterladen 3) Schemadatei relativ runterladen
      if ($von >= 0)
      {
        $von = index($_, "\"", $von); $bis = index($_, "\"", $von+1); die "kein Inhalt" unless $von >= 0 && $bis >= 0;
        my $imp = substr($_, $von+1, $bis-$von-1);

        # lokalen Dateinamen ermitteln, "/" sind ggf. durch %2F maskiert ...
        my $ende1 = rindex($imp, "%2F"); my $offset = 1; my $ende = -1;    
        my $ende2 = rindex($imp, "/");
        if ($ende1 >= 0 && $ende2 >= 0)
        {
          if ($ende1 > $ende2) { $offset = 3; $ende = $ende1; } 
          else { $ende = $ende2; }
        }
        elsif ($ende1 >= 0) { $ende = $ende1; $offset = 3; }
        elsif ($ende2 >= 0) { $ende = $ende2; }
        my $lokal = ($ende >= 0) ? substr($imp, $ende+$offset) : $imp ;
        if ($lokal !~ /\.xsd$/ ) { $lokal = $lokal.".xsd"; }  # ggf. .xsd ergänzen
        print "Quelle $imp, lokal $lokal\n";
        # Pfad in der aktuellen Datei ersetzen
        my $zielNeu; my $basisUrl2;
        if ($imp =~ /http:\// )
        {
          $zielNeu = $imp; # absolut
          $ende = rindex($zielNeu, "/"); die "Basis-URL nicht bestimmbar\n" unless $von >= 0;
          $basisUrl2 =  substr($zielNeu, 0, $ende);
        }
        else
        {
          $zielNeu = "$basisUrl/$imp"; $basisUrl2 = $basisUrl;   #relativ
        }
        my $neuText = substr($_, 0, $von+1).$lokal.substr($_, $bis);
        print $AUSGABE $neuText; $angepasst = 1;
        # muss die Datei noch geladen werden ?
        if (! -r "$verzeichnis\\$lokal")
        {
          my $zeileSicher = $_;  # weil offenbar wegen der Rekursion das $_ zerstört wird, hier sichern !
          &speichern($zielNeu , "$verzeichnis\\$lokal"); # Datei über http neu laden
          &bearbeiten_laden($verzeichnis, $lokal, $basisUrl2);  # die lokale Version bearbeiten
          $_ = $zeileSicher;
        }
      }
      else { die "keine schemaLocation gefunden\n"; }
    }
    if (!$angepasst) { print $AUSGABE $_; }
  }
  close $EINGABE; close $AUSGABE;
  my $anw =  "move $verzeichnis\\$datei"."_neu"." $verzeichnis\\$datei > null";
  system($anw);
}


# Datei über HTTP laden, lokal abspeichern, wenn noch nicht vorhanden
sub speichern()
{
  my $http = $_[0]; my $ziel = $_[1];

  # schauen: Ist die Zieldatei schon vorhanden, dann nicht mehr
  if (-r "$ziel") { print "$ziel vorhanden\n"; return; }
  if ($http !~ /https?:\/\//) { print "Kein Laden von $http\n"; return; }

  # print "Lade $http ...\n";
  my $request = new HTTP::Request("GET" => $http);
  if ($mitSec)
  {
    # Benutzer und Passwort mit ":" getrennt, dann base64-kodiert.
    my $wert = encode_base64("$benutzer:$passwort");
    $request->header("Authorization" =>  "Basic $wert");
  }
  my $response = $ua->request($request);
  my $seite = $response->content;

  # Wenn Unauthorized, dann Fehler
  if (index($seite, "Error 401") >= 0 && index($seite, "Unauthorized") >= 0)
  {
    warn "URL ist per Benutzer/Passwort gesichert\n";
    if ($benutzer eq "" && $passwort eq "") { die "geht nicht weiter\n"; }

    # Benutzer und Passwort mit ":" getrennt, dann base64-kodiert.
    my $wert = encode_base64("$benutzer:$passwort");
    $request->header("Authorization" =>  "Basic $wert");

    # neuer Versuch
    $response = $ua->request($request);
    $seite = $response->content;

    if (index($seite, "Error 401") >= 0 && index($seite, "Unauthorized") >= 0) { die "Benutzer/Passwort stimmen nicht\n"; }
    $mitSec = 1; # damit der Fehler nicht mehrfach passiert
  }

  # Speichern der Seite
  open (my $ZIEL, ">$ziel") || die "$ziel konnte nicht angelegt werden\n";
  print $ZIEL $seite;
  close $ZIEL;
  print "Gespeichert unter $ziel\n";
}