Perl Schnippsel für das Web

Hier finden Sie verschiedene Code-Schnippsel, die praktisch für das Web sind:
BB-Codes, HTTP-Url extrahieren, zwei RFC-5322 Datumsfunkionen und ein MD5-Checksummen-Rechner für Dateien.

BB-Codes

Generelles zu BB-Code

Sie kennen gewiss die verbreitete Weise für BBcode, wobei die Syntax für HTML zugrunde liegt aber die spitzen Klammern durch [] ersetzt werden. Ich halte diesen Ansatz aus mehreren Gründen für ungünstig. Es sugerriert [starttag]Inhalt[/endttag], das dem Parser die Aufgabe leichter fällt. Wer sich aber auf leichtigkeit verlässt, der wird schnell invalides HTML erzeugen.

Ich habe mich desshalb für eine andere Syntax entschieden, die so lautet:

[function:Inhalt]
[function:[property:value][property:value]]

Dabei ist ein Paradigma wirksam: Eine Funktion ist nicht etwa auf HTML-Elemente beschränkt, sondern kann den Inhalt zu beliebiger Abarbeitung übergeben. Innerhalb der Funktion ist dann ein geregeltes parsing möglich. Ich möchte Beispiele dazu weiter anführen.

Link-Funktion

Man möchte in Kommentaren oder Eidtoren eine Link-Funktion bereitstellen. Was soll jedoch die geeignete Sytax sein? Hier folgen Beispiele für gültige Syntax meiner Link-Funktion: 

[link:http:example.org/]
[link:[url:http:example.org][label:Beispiel-Link]]
[link:
   [url:http:example.org]
   [label:Beispiel-Link]
]
[link:
   [label:Beispiel-Link]
   [url:http:example.org]
]
[link:
   [url:http:example.org]
]

Die Beispiele zeigen folgendes:

Damit all dies gewährleistet ist, muss der Parser natürlich geeignet aufgebaut sein.


sub parse_function{
    my $t=shift || '';  # der zu parsende Text
    for($t){
# ...
        s#(?<!\\)\[link: ($Nested1Level) (?<!\\)\]# user_link($1) #egx;
        s#(?<!\\)\[image: ($Nested1Level) (?<!\\)\]# user_image($1) #egx;

# ...
        s#\\\[#[#g;
        s#\\\]#]#g;
    }
    return $t;
}

Dieser Parser hat nun eine besondere Eigenschaft. Er muss ja eine Methode kennen, nach welcher ich Klammern vom Parsen ausnehmen darf. Ich muss solche Klammern maskieren, falls auf die Klammer ein Funktionsname folgt. \[ soll nicht geparst werden. Darauf deutet der negative Lookbehind in der Regulären Expression hin: (?<!\\).
Wichtig ist nun die Generelle Funktionsweise der regulären expression:
s#(pattern)#function($1)#ge Hier wird ein gematchter Inhalt an eine Subfuntion übergeben, welche sich der Behandlung annimmt und das Resultat zurück gibt. Wir versuchen gar nicht erst, eine unnötige Komplexität in eine RE zu bauen. Das würde den Parser unnütig aufblähen.
Noch was. $Nested1Level ist ein Pattern, das erlaubt, dass balancierte Klammern gematcht werden, ich also Eigenschaften [property:value] innerhalb der Funktion notieren kann. Im globalen Scope wurde die Variable deklariert:

my $Nested1Level = qr/ 
    [^\[\]]* 
      (?: \s* \[ [^\[\]]* \] [^\[\]]* )*
    /x;

Was für Eigenschaften-Combos das sind, braucht uns in der RE nicht zu interessieren. Die Sub soll die Eigenschaften extrahieren, welche sie anerkennt. $Nested1Level Ist gleichzeitig so aufgebaut, dass wir Whitespace zwischen die Combos platzieren dürfen, wodurch wir die Funktion formatieren dürfen. 


sub user_link{
    my $t = shift;  
    my $url = my $label = '-';  # initialisieren
    # wir testen, ob eine URL als Inhalt der Funktion übergeben wurde.
    if( $t =~ m#
        (
          (https?://[^/\s\[\]]*) 
          (?:
            ( / (?:[^\?\s\#\[\]]*)? ) 
            (?:\?[^\#\s\[\]]*)? 
          )? 
        ) #x ){
        # Wir weisen die gesamte URL der variable $url zu
        # es sind nur http oder https Schema oder lokale Links gültig.
        $url = $1;
        # Wir speichern eine reduzierte Form als Label
        $label = $2.$3;
    }
    elsif( $t =~ m#\[url:(.*?)\]#x ){
        # wenn eine url Eigenschaft vorhanden ist,
        # speichern wir diese in $url und $label.
        $label = $url = $1;
    }
    # wenn eine label Eigenschaft gematcht wird:
    # speichern wir diese in $label.
    $t =~ m/\[label:(.*?)\]/ and $label=$1;
    # wir geben die url zurück.
    return( '<a href="'.$url.'" title="'.$url.'">'.$label.'</a>' );
}

Diese Methode hat den Vorteil, dass Sie nun der Funktion [link:] in Zukunft weitere Eigenschaften geben können. Pro Eigeschaften brauchen Sie einfach eine neue RE um sie zu extrahieren. Bestehende Syntax wird dadurch nicht invalide und Korrekturen entfallen.
Natürlich ist die vorliegende Funktion ein Beispiel. Meine eigene Ausführung hat noch viel mehr Details.

Image Funktion

Weiter oben habe ich im Parser auch die RE für [image:] gezeigt. Hier möchte ich diese Darstellen, weil sie demonstriert, wie hier viele Eigenschaften verwendet werden können. Nicht alle Eigenschaften sind hier optional, deshalb haben wir hier auch die Rückgabe eines leeren Resultates, wenn minimalangaben fehlen.


sub user_image{
    my $i = shift || '';
    my $align = my $caption = my $cite = my $src = my $alt = '';
    $i =~ m/\[align:(left|right|center)\]/ and $align = '-'. $1;
    $i =~ m/\[caption:(.+?)\]/s and $caption=$1;
    $i =~ m/\[cite:([^<>"']+?)\]/ and $cite=$1;
    $i =~ m/\[src:([^<>"']+?)\]/ and $src=$1;
    $i =~ m/\[alt:([^<>"']+?)\]/ and $alt=$1;
        # erforderlche Eigenschaften
    $i and $src and $alt or return;
    $i = '<p class="image'.$align.'">'.NL.
        '<img src="'.$src.'" alt="'.$alt.'">'.NL;
    $caption and $i .= $caption.NL;
    $cite and $i .= '<cite>'.$cite.'</cite>'.NL;
    $i .= '</p>';
    return $i;
}

Diese Funktion stellt ein Bild mit Legende und Quelle dar. Die Reihenfolge der Argumente ist vollkommen egal und alle Argumente sind optional. Das ist das wichtige Designprinzip. Natürlich kann eine solche Funktion sinnlos werden, wenn nicht ein Minimum von erforderlichen Angaben vorhanden ist. In diesem Fall sind die Bild-Url und der Alt-Text erforderlich. Andernfalls wird, damit nicht invalides HTML entsteht, ein undef zurückgegeben.

HTTP-Url extrahieren

Wie kann ich eine Url extrahieren? Zuerst muss man sagen, dass dies nicht so einfach ist, denn der Aufbau einer Url ist abhängig vom Schema.
In einem Webkontext hat man nun in der Regel nicht beliebige Urls vor Augen sondern in der Regel http oder https Urls.
Eine HTTP Url ist zusammengebaut aus:

Man kann nun versuchen, für jeden Part ein valides Pattern zu erstellen. Sehr wahrscheinlich übersieht man dabei aber legitime urls.
Da man beim extrahieren ja nur die einzelnen Parts erkennen will, reicht es, die Pattern durch das zu kennzeichnen, was in einem Part nicht vorkommen darf.


my $schema = qr!https?:!i;
my $authority = qr!//[^\s/\?\#]+!;
my $path = qr!(?:[^\s\?\#]+)!;
my $query = qr!\?[^\s\#]*!;
my $fragment = qr!\#[^\s]*!;

Jetzt müssen diese Teile noch zusammengesetzt werden, wobei verschiedene Kombinationen denkbar sind.


my $httpurl = qr/	
	(
	  $schema 
	  $authority
	)?
	($path?)
	($query?)
	($fragment?)
	/x;
my @results = ( "http://www.irgendwas.de/" =~ $httpurl );
print join ', ', @results;

Die Url-Parts werden gespeichert und stehen in $1 bis $4 zur Verfügung. Diese Art der Extraktion erfordert, dass der Input als url vorgesehen ist. Ist das nicht der Fall und man möchte über einen beliebigen Text Urls extrahieren, so sollte der schema/authority Part nicht optional sein. Der ?-Quantifier entfällt dann.

Zwei RFC-5322 Datumsfunktionen

RFC-5322 ist ein Update von RFC 2822 und ist Teil des umfangreicheren Corpus zum MIME Standard. Hierin wird beschrieben, welches Format Datumsangaben in Mailheader annehmen müssen.

Problemstellung

Das Datumformat verlangt eine Zeitzonen-Information [+-]hhmm, welche ausdrückt, um welche Zeit die lokale Zeit der GMT vorangeht. Es gibt aber keine einfache Perlfunktion, welche diese Angabe ausgibt.
Das folgende Script stellt zwei Funktionen zur Verfügung, um RFC-5322 gemässe Datumsformate auszugeben.

Besonderheiten

Es werden auch Zeitzonen berücksichtigt, die Teile von Stunden von GMT abweichen.
Ist die Zeitzonendifferen Null, so wird gemäss RFC 5322 die Zeitzone -0000 verwendet, wodurch indiziert wird, dass es sich um eine von GMT verschiedene lokale Zeitzone handelt.


#!perl
#
#!/usr/bin/perl

use warnings;
use strict;
use constant { NL => "\n", };
BEGIN {
    use CGI::Carp qw(carpout);
    open(LOG, ">","error.txt")  or die "Unable to append to error.txt: $!\n";
    carpout(*LOG);
}

foreach my $t (0,1230764890, 1234567890){
    print 'Epochensekunden: ', $t,NL,
        'local: ', rfc5322_date_local($t),NL,
        'gmt:   ', rfc5322_date_gmt($t),NL;
}
<>;

# Datumsformat nach RFC 5322 (Update von RFC 2822) für lokale Zeit
# Ermittelt korrekt den Timeoffset. liefert korrekt '-0000'
# berücksichtigt Zeitzonen mit Minutenabweichungen relativ zu GMT
sub rfc5322_date_local{
	my $t   = shift || time();
    my @gmt =  (    gmtime( $t )  );
    my @loc =  ( localtime( $t )  );
    my $tzm = 60 * ( $loc[2] - $gmt[2] ) 
            +        $loc[1] - $gmt[1]
            + ( $loc[5] <=> $gmt[5] 
                        || 
                $loc[7] <=> $gmt[7] ) 
            * 24 * 60;
    return( 
        sprintf( "%s, %2d %s %04d %02d:%02d:%02d %s%02d%02d",
            qw(Sun Mon Tue Wed Thu Fri Sat)[ $loc[6] ],
            $loc[3],
            qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec)[ $loc[4] ],
            $loc[5] + 1900,
            $loc[2], $loc[1], $loc[0],
            ( $tzm > 0 ? '+' : '-' ),
            int( $tzm / 60 ),
            int( $tzm % 60 ),
        )
    );
}

# Datumsformat nach RFC 5322 (Update von RFC 2822) für GMT Zeit (=UTC)
sub rfc5322_date_gmt{
	my $t   = shift || time();
    my @gmt = ( gmtime( $t ) );
    return( 
        sprintf( "%s, %2d %s %04d %02d:%02d:%02d +0000",
            qw(Sun Mon Tue Wed Thu Fri Sat)[ $gmt[6] ],
            $gmt[3],
            qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec)[ $gmt[4] ],
            $gmt[5] + 1900,
            $gmt[2], $gmt[1], $gmt[0],
        )
    );
}

Sie können diesen Code frei für sich verwenden.

MD5 HEX Checksummen für Dateien berechnen

Das folgende kleine Programm berechnet MD5 Checksummen und gibt die Digests im HEX Format aus.
Das Perlscript muss im gleichen Verzeichnis wie das zu prüfende File liegen.

Hintergrund: Um die Integrität eines Files zu prüfen, das über einen Softwareanbieter heruntergeladen wurde, stellen die autoritativen Websites für Pakete Checksummen bereit. Dadurch kann sichergestellt werden, dass das Thirdparty Paket tatsächlich eine valide Instanz des originalen Pakets war.

Eine MD5 Checksumme im HEX Format sieht so aus:
34e7520f31d4bf9355b0db577ef2e796

#!perl 
#
# Ein MD5 hex Digest Berechner für Files.


BEGIN {
  use CGI::Carp qw(carpout);
  open(LOG, ">","error.txt")
     or die "Unable to append to error.txt: $!\n";
  carpout(*LOG);
}

use warnings;
use strict;
use constant { NL => "\n", CRLF => "\015\012"};
use Digest::MD5 qw(md5_hex);
my $digest = Digest::MD5->new();

print 'Geben Sie den Namen des Files an,
fuer welches Sie die MD5 Checksumme berechnen wollen:',"\n";
my $file = <>;
chomp $file;
$file or print "Bye...\n" and sleep 2 and exit;
-e $file or die "Bad File $!";
open( my $fh, '<', $file ) 
    or die "File $file kann nicht geöffnet werden: $!";
binmode $fh;
$digest->addfile( $fh );
close ($fh);
print "MD5 Hex Checksumme für: ", $file,"\n", $digest->hexdigest, "\n";
<>;
print "Bye...\n";
sleep 2;
exit;

Die MD5 HEX Checksumme des obigen Codes ist übrigens:
f97136553bbd5d26da9761077e9a78b5