Subklassen

(Auszug aus "Perl & XML" von Erik T. Ray & Jason McIntosh)

Wenn wir als Perl- und XML-Hacker Module schreiben, sollten wir auf keinen Fall vergessen, den Giganten über die Schultern zu schauen bzw. sich auf dieselben zu stellen. Die Giganten sind in diesem Fall die Autoren der allgemeinen XML-Parser und ähnlicher Module. Das kann eine sehr einfache und schnelle Möglichkeit sein, anwendungsspezifische Module zu schreiben. Wir (die Autoren) wissen das als faule Menschen zu schätzen.

Man muß nicht unbedingt gleich mit Vererbung arbeiten. Der einfachste Weg ist beispielsweise, im Konstruktor einen Parser zu erzeugen, ihn irgendwo aufzubewahren und dann für die Verarbeitung von rohem XML zu nutzen. So könnte das aussehen:

package XML::MyThingy;    

use strict;
use warnings;
use XML::SomeSortOfParser;

sub new {
    # Der Konstruktor
    my $invocant = shift;
    my $self = {};
    if (ref($invocant)) {
    bless ($self, ref($invocant));
    } else {
    bless ($self, $invocant);
    }
      
    # Wir erzeugen einen XML-Parser...
    my $parser = XML::SomeSortOfParser->new
    or die "Oh nein, kein XML-Parser gefunden. Wie schade.";
      
    # ... und für die spätere Verwendung sichern wir ihn.
    $self->{xml} = $parser;
return $self;
}

sub parse_file {
  
    # Alles was wir tun, ist, den Aufruf des Benutzers an den Parser weiterzugeben.
    # (Zufällig hat dieser eine Methode namens parse_file ...)
    my $self = shift;
    my $result = $self->{xml}->parse_file;
      
    # Das folgende hängt vom Verhalten des XML::SomeSortOfParser-Objekts ab.
    # Nehmen wir an, es speichert das gelesene Dokument intern und liefert
    # einen Fehlercode. Wir lassen also den Parser im Schlüssel 'xml' stehen
    # und geben einfach den Fehlercode zurück.
    return $result;
}

Andererseits hat die Ableitung einer Subklasse auch ihre Vorzüge. Erstens erbt unser Modul ohne jeglichen Aufwand die grundlegenden Methoden der Basisklasse, insbesondere die Methoden zum Parsen eines Dokuments. Möchte man alle möglichen Varianten wie parse_file, parse_string usw. berücksichtigen, kann das unter Umständen schon einige Ersparnis bringen. Das gilt insbesondere, wenn man ein Hilfsmodul für eine bestimmte XML-Anwendung schreibt. Zweitens lohnt es sich bei baumorientierten Parsern, deren Datenstrukturen zu klau... äh, zu übernehmen und zu erweitern. Durch kleine Anpassungen erreicht man oft schon sein persönliches Ziel. Die objektorientierten Fähigkeiten von Perl sind in dieser Beziehung ungemein wertvoll.

Beispiel einer Subklasse: XML::ComicsML

Für dieses Beispiel legen wir (mit einem gewissen Bedauern) unser lieb gewonnenes MonkeyML beiseite und zwar zugunsten von ComicsML, einer Markup-Sprache zur Beschreibung von Online-Comics. Viele Möglichkeiten und Ideen sind von RSS übernommen, unter anderem eine standardisierte Methode zur Synchronisierung von Informationen. Ein Hilfsprogramm für ComicsML dürfte für jeden mit Web-Comics befaßten Programmierer eine Bereicherung darstellen.

Wir werden uns bei diesem Beispiel ganz DOM stellen und auf XML::LibXML als Mittel der Wahl setzen, da dieses Modul (beinahe) dem DOM-Standard entspricht und einen schnellen Parser enthält. Unser Ziel ist es, eine komplette objektorientierte Schnittstelle zur Bearbeitung von ComicsML-Dokumenten und ihrer wichtigsten Elemente anzubieten:

use XML::ComicsML;

# Lesen einer existierenden ComicsML-Datei
my $parser = XML::ComicsML::Parser->new;
my $comic = $parser->parsefile('my_comic.xml');

my $title = $comic->title;
print "Der Titel dieses Comics ist: $title\n";

my @strips = $comic->strips;
print "Er enthält ".scalar(@strips)." verschiedene Strips4.\n";

Reden wir nicht lange drum herum, fangen wir an zu programmieren:

package XML::ComicsML;

# Ein Hilfsmodul zum Parsen und Bearbeiten von ComicsML-Dokumenten.
use XML::LibXML;
use base qw(XML::LibXML);

# PARSEN

# Wir übernehmen die Ausgabe der verschiedenen Methoden von XML::LibXML
# und transferieren verschiedene Knoten in unsere eigenen Klassen, die
# entsprechende Subklassen sein müssen.

sub parse_file {    
    # Parsen wie üblich, Transfer des Root-Dokuments und Rückgabe.
    my $self = shift;
    my $doc = $self->SUPER::parse_file(@_);
    my $root = $doc->documentElement;
    return $self->rebless($root);
}

sub parse_string {
    # Parsen wie üblich, Transfer des Root-Dokuments und Rückgabe.
    my $self = shift;
    my $doc = $self->SUPER::parse_string(@_);
    my $root = $doc->documentElement;
    return $self->rebless($root);
}

Was geschieht hier genau? Wir haben angegeben, daß unser Paket eine Subklasse von XML::LibXML ist (mit Hilfe des Pragmas use base), und dann zwei Methoden dieser Klasse überschrieben. Alle machen im Grunde genommen dasselbe, nämlich die entsprechende Methode von XML::LibXML aufzurufen und das Ergebnisobjekt in einen eigenen Namensraum zu transferieren, indem die folgende interne Methode aufgerufen wird:

sub rebless {   
  
   # Erhält eine Instanz von XML::LibXML::Node (genauer gesagt einer Subklasse)
   # und übernimmt diese in eine der ComicsML-Klassen.
   my $self = shift;
   my ($node) = @_;
     
   # Hash interessanter Elemente (macht die Suche einfacher)
   my %interesting_elements = (comic=>1,
            person=>1,
            panel=>1,
            panel-desc=>1,
            line=>1,
            strip=>1,
           );
     
   # Wenn dies kein interessantes Element ist, dann tue nichts.
      my $name = $node->getName;
      return $node unless ( $node->isa('XML::LibXML::Element')
         and (exists($interesting_elements{$name})) );
  
   # Dies ist ein interessantes Element! Finde die zugehörige Klasse und mache das
   # Element zu einer Instanz dieser Klasse.
   my $class_name = $self->element2class($name);
   bless ($node, $class_name);
  return $node;
}

sub element2class {
   # Umwandlung eines XML-Elementnamens in einen passenden Klassennamen.
   my $self = shift;
   my ($class_name) = @_;
   $class_name = ucfirst($class_name);
   $class_name =~ s/-(.?)/uc($1)/e;
   $class_name = "XML::ComicsML::$class_name";
}

Die Methode rebless bekommt einen Elementknoten übergeben. Sie prüft, ob der Name des Elements in einer hartcodierten Liste »interessanter« Elementnamen steht. Wenn das der Fall ist, wird mit Hilfe der Methode element2class eine Klasse für dieses Element ausgewählt und der Elementknoten zu einer Instanz dieser Klasse gemacht. Abgesehen von der egomanischen Befriedigung, unsere eigenen Klassennamen dem Werk eines anderen anzuheften, bietet das auch ganz offensichtliche Vorteile: Wir können diese neuen Klassen mit eigenen Methoden versehen, die die transferierten Objekte dann anbieten. Allerdings verbleibt noch die Arbeit, diese Klassen und Methoden zu definieren.

Das erledigen wir im wesentlichen durch die Deklaration einer Methode AUTOLOAD in der Klasse XML::ComicsML::Element. Dabei handelt es sich um eine abstrakte Klasse, von denen unsere »echten« Elementklassen abgeleitet werden. Diese Methode hat die folgende Aufgabe: Wenn auf einer Instanz unserer Elementklassen eine unbekannte Methode aufgerufen wird, ruft Perl automatisch diese Methode auf. Diese wiederum prüft, ob der Methodenname in einer Liste erlaubter Element- und Attributnamen steht. Falls das der Fall ist, wird der Methodenaufruf als Versuch interpretiert, das betreffende Element oder Attribut zu setzen bzw. zu lesen. Falls es kein solches Attribut oder Element gibt, aber der Name der aufgerufenen Methode add_foo oder remove_foo lautet, wird der Aufruf als Versuch interpretiert, ein entsprechendes Element unserer eigenen Klassen hinzuzufügen bzw. zu löschen:

package XML::ComicsML::Element;

# Abstrakte Basisklasse für alle Knotentypen von ComicsML.
use base qw(XML::LibXML::Element);
use vars qw($AUTOLOAD @elements @attributes);

sub AUTOLOAD {    
    my $self = shift;
    my $name = $AUTOLOAD;
    $name =~ s/^.*::(.*)$/$1/;
    my @elements = $self->elements;
    my @attributes = $self->attributes;
      
      # Ist ein Kindelement $name erlaubt?
    if (grep (/^$name$/, @elements)) {
      
    # Ja; ist ein zu setzender Wert angegeben?
    if (my $new_value = $_[0]) {
    # Wert wird gesetzt und überschreibt ein evtl. vorhandenes Element dieses Typs.
    my $new_node = XML::LibXML::Element->new($name);
    my $new_text = XML::LibXML::Text->new($new_value);
    $new_node->appendChild($new_text);
    my @kids = $new_node->childNodes;
    if (my ($existing_node) = $self->findnodes("./$name")) {
    $self->replaceChild($new_node, $existing_node);
    } else {
    $self->appendChild($new_node);
    }
  }
    
    # Gib den Inhalt des betreffenden Elements zurück.
    if (my ($existing_node) = $self->findnodes("./$name")) {
    return $existing_node->firstChild->getData;
    } else {
    return '';
  }

    # Nein, ein Kindelement $name ist nicht erlaubt,
    # aber vielleicht ein Attribut $name?
    } elsif (grep (/^$name$/, @attributes)) {
    # Ja; ist ein zu setzender Wert angegeben?
    if (my $new_value = $_[0]) {
    # Attributwert setzen
    $self->setAttribute($name, $new_value);
  }

    # Attributwert als Ergebnis liefern
    return $self->getAttribute($name) || '';
    
    # Nein, auch ein Attribut $name ist nicht erlaubt. Vielleicht soll ein neues
    # Element unserer eigenen Klasse hinzugefügt werden?
  } elsif ($name =~ /^add_(.*)/) {
    my $class_to_add = XML::ComicsML->element2class($1);
    my $object = $class_to_add->new;
    $self->appendChild($object);
    return $object;
    
    # ... oder eines entfernt werden?
  } elsif ($name =~ /^remove_(.*)/) {
    my ($kid) = @_;
    $self->removeChild($kid);
    return $kid;
  }

}

# Stub-Funktionen; standardmäßig sind weder Kindelemente noch Attribute erlaubt.

sub elements {
    return ();
}

sub attributes {
    return ();
}

package XML::ComicsML::Comic;
use base qw(XML::ComicsML::Element);

# Für ein Comic sind die Kindelemente 'version', 'title' usw. erlaubt.
# Durch AUTOLOAD kann man die Version mit $comic->version()
# lesen bzw. mit $comic->version(1) setzen.
sub elements {
return qw(version title icon description url);
}

sub new {
    my $class = shift;
    return $class->SUPER::new('comic');
}

sub strips {
    # Generiere eine Liste aller Strips, die in diesem Comic enthalten sind.
    my $self = shift;
    return map {XML::ComicsML->rebless($_)} $self->findnodes("./strip");
}

sub get_strip {
    # Finde den Strip mit der angegebenen 'id'.
    my $self = shift;
    my ($id) = @_;
    unless ($id) {
    warn "get_strip benötigt eine ID als Argument!";
    return;
    }
  
    my (@strips) = $self->findnodes("./strip[attribute::id='$id']");
    if (@strips > 1) {
    warn "Hoppla, es gibt mehr als einen Strip mit der ID $id?\n";
    }
    return XML::ComicsML->rebless($strips[0]);
}

In der realen Version von ComicsML gibt es viele weitere Elementklassen. Einige von ihnen beschäftigen sich mit den Figuren, die im Comic eine Rolle spielen, andere mit den im Comic enthaltenen Strips usw. Wir werden das bis hierher erstellte später nochmals aufgreifen und auf ein konkretes Problem anwenden.

  

  

<< zurück vor >>

 

 

 

Tipp der data2type-Redaktion:
Zum Thema Perl & XML bieten wir auch folgende Schulungen zur Vertiefung und professionellen Fortbildung an:

Copyright © 2003 O'Reilly Verlag GmbH & Co. KG
Für Ihren privaten Gebrauch dürfen Sie die Online-Version ausdrucken.
Ansonsten unterliegt dieses Kapitel aus dem Buch "Perl & XML" denselben Bestimmungen, wie die gebundene Ausgabe: Das Werk einschließlich aller seiner Teile ist urheberrechtlich geschützt. Alle Rechte vorbehalten einschließlich der Vervielfältigung, Übersetzung, Mikroverfilmung sowie Einspeicherung und Verarbeitung in elektronischen Systemen.

O’Reilly Verlag GmbH & Co. KG, Balthasarstraße 81, 50670 Köln, kommentar(at)oreilly.de