Perl

The URL is not DAV enabled or not accessible

3. Oktober 2023 · Programmierung · andreas · Kein Kommentar

Nach dem Wechsel des Reverse-Proxys war ein mit HTTP::DAV arbeitendes Perl-Skript nicht mehr in der Lage, Daten abzurufen. Die Fehlermeldung war alles andere als aussagekräftig:

The URL "..." is not DAV enabled or not accessible.

Auch eine Erhöhung des DebugLevels von 0 (“off”) auf 3 (“noisy”) brachte keine weiteren Erkenntnisse, so daß manuelle Fehlersuche angesagt war. Da weder am Server noch am Skript Änderungen vorgenommen wurden, konzentrierte sich die Suche auf den Reverse-Proxy

Letztendlich lag der Fehler an einem fehlenden Intermediate-Zertifikat des Trustcenters auf dem Reverse-Proxy. Nach dem Hinzufügen des fehlenden Zertifikats funktionierten die Zugriffe wieder wie erwartet.


Perl setzt bei regulären Ausdrücken Treffer-Variablen nicht zurück

14. September 2022 · Programmierung · andreas · Kein Kommentar

Werden z.B. innerhalb einer Schleife verschiedene Elemente mit Hilfe eines regulären Ausdrucks ausgewertet, so werden im Falle eines Nicht-Treffers die Treffer-Variablen nicht zurückgesetzt.

use strict;
use warnings;

my @albums = (
	'The Phantom Agony',
	'Design Your Universe',
	'The Holographic Principle'
);

foreach my $album (@albums) {

	$album =~ /(Universe)/;

	if (defined $1) { print "match: $1 -> '$album'\n"; }
}

Auf den ersten Blick wäre zu erwarten, daß lediglich eine Zeile als Ergebnis ausgegeben wird, tatsächlich sind dies aber zwei:

match: Universe -> 'Design Your Universe'
match: Universe -> 'The Holographic Principle'

Die Ursache liegt in der überhaupt nicht durchgeführten Überprüfung des Ergebnisses des regulären Ausdrucks, die korrekt so aussehen muss:

use strict;
use warnings;

my @albums = (
	'The Phantom Agony',
	'Design Your Universe',
	'The Holographic Principle'
);

foreach my $album (@albums) {

	if ($album =~ /(Universe)/) {

		print "match: $1 -> '$album'\n"; }
}

Dann erscheint auch - wie ursprünglich erwartet - als Ergebnis nur eine Zeile:

match: Universe -> 'Design Your Universe'

Notiz an mich selbst: eine korrekte Behandlung von Abfrageergebnissen erspart eine aufwendige Fehlersuche.


Perl, Unicode und Umlaute in Dateinamen

9. Juni 2022 · Programmierung · andreas · Kein Kommentar

Das Projekt klingt einfach: eine Liste von Dateinamen aus einem Verzeichnis auslesen, in einer Datenbank speichern und zu einem späteren Zeitpunkt anhand der Liste in der Datenbank wieder öffnen. Leider konnte das Skript einige Dateien nicht mehr finden, obwohl diese im Verzeichnis weiterhin vorhanden waren.

Heruntergebrochen auf ein Beispielskript sieht das Szenario wie folgt aus:

#!/usr/bin/perl

use strict;
use warnings;
use utf8;
use DBI;

# remove database
unlink("files.sqlite");

# create database from scratch
my $dbh = DBI->connect("dbi:SQLite:dbname=files.sqlite", "", "", { sqlite_unicode => 1 });
$dbh->do("CREATE TABLE files (name TEXT);");

# the file to be processed
my $filename = "Elternschreiben Änderungen der Regelungen zum Infektionsschutz.pdf";

# create the file in the current directory
open(my $fh, ">$filename");
print $fh "TEXT";
close($fh);

# read files in current directory
opendir(my $dh, ".");
while (my $file = readdir($dh)) {

	next if $file !~ /pdf$/;

	$file = $dbh->quote($file);
	$dbh->do("INSERT INTO files (name) VALUES ($file);");
}
closedir($dh);

# get number of files with name "filename"
$filename = $dbh->quote($filename);
my $sth = $dbh->prepare("SELECT COUNT(*) AS cnt FROM files WHERE name = $filename;");
$sth->execute;
my $row = $sth->fetchrow_hashref;

print "found $row->{cnt} file(s).\n";

$sth->finish;
$dbh->disconnect();

Statt des erwarteten Ergebnisses “1” ist das Skript jedoch der Meinung, keine passende Datei eingelesen zu haben:

found 0 file(s).

Um Probleme mit der Datenbank auszuschließen, kann das Szenario im Dateisystem nachgebildet werden:

#!/usr/bin/perl

use strict;
use warnings;
use utf8;
use DBI;

# the file to be processed
my $filename = "Elternschreiben Änderungen der Regelungen zum Infektionsschutz.pdf";

my $found = 0;

# create the file in the current directory
open(my $fh, ">$filename");
print $fh "TEXT";
close($fh);

# read files in current directory
opendir(my $dh, ".");
while (my $file = readdir($dh)) {

	next if $file !~ /pdf$/;

	if ($file eq $filename) { $found++; }
}
closedir($dh);

print "found $found file(s).\n";

Auch hier wird statt der erwarteten “1” eine “0” für die Menge der gefundenen Dateien ausgegeben.

found 0 file(s).

Einen ersten Hinweis auf die mögliche Ursache bringt die Ausgabe der zu vergleichenden Werte mittels “Data::Dumper”. Während für “$filename” der Wert

$VAR1 = "Elternschreiben \x{c4}nderungen der Regelungen zum Infektionsschutz.pdf";

ausgegeben wird, wird für “$file” der Wert

$VAR1 = 'Elternschreiben Änderungen der Regelungen zum Infektionsschutz.pdf';

ausgegeben, d.h. die Werte der beiden Variablen sind in der internen Repräsentation in Perl tatsächlich unterschiedlich. Mit den richtigen Anhaltspunkten führt eine Suche im Internet zum Stackoverflow-Beitrag “In what encoding does readdir return a filename?” und der dort verlinkten ausführlichen Erklärung.

Des Rätsels Lösung ist die Verwendung von “Encode::decode_utf8”

#!/usr/bin/perl

use strict;
use warnings;
use utf8;
use DBI;
use Encode;

# the file to be processed
my $filename = "Elternschreiben Änderungen der Regelungen zum Infektionsschutz.pdf";

my $found = 0;

# create the file in the current directory
open(my $fh, ">$filename");
print $fh "TEXT";
close($fh);

# read files in current directory
opendir(my $dh, ".");
while (my $file = readdir($dh)) {

	next if $file !~ /pdf$/;

	if (Encode::decode_utf8($file) eq $filename) { $found++; }
}
closedir($dh);

print "found $found file(s).\n";

dann stimmt auch die Anzahl der gefundenen Dateien mit der erwarteten Anzahl überein:

found 1 file(s).

Bessere Fehlerbehandlung mit Try::Tiny

14. April 2022 · Programmierung · andreas · Kein Kommentar

Die im Beitrag “MIME::Lite Fehlerbehandlung” implementierte Fehlerbehandlung mit “eval” funktioniert zwar in den meisten Fällen, kann aber in bestimmten Situationen doch nicht zum gewünschten Ergebnis führen.

Eine bessere Alternative ist die Verwendung von z.B. Try::Tiny, welches sich mit den aus anderen Sprachen bekannten “try”, “catch” und “finally”-Anweisungen um die Fehlerbehandlung kümmert:

use strict;
use warnings;
use MIME::Lite;
use Try::Tiny;

MIME::Lite->send('smtp', 'mailserver', Debug => 0);

my $msg = MIME::Lite->new(

	From    => 'me@whereever.net',
	To      => 'you@somewhereelse.net',
	Data    => 'Hello World!',
	Subject => 'testmail',
);

try {
	$msg->send;
}
catch {
	warn "you DON'T have mail!";
};

print "... still running ...";

Nach der Warnung “you DON’T have mail!” wird das Programm mit “… still running …” fortgesetzt.


MIME::Lite Fehlerbehandlung

13. April 2022 · Programmierung · andreas · Kein Kommentar

Ein Skript, welches MIME::Lite zum Versenden von Mails verwendet, hat sich im Fehlerfall lieber direkt mit einem “SMTP Failed to connect to mail server: Bad file descriptor” beendet, statt gemäß Dokumentation auf den Fehler zu reagieren.

use strict;
use warnings;
use MIME::Lite;

MIME::Lite->send('smtp', 'mailserver', Debug => 0);

my $msg = MIME::Lite->new(

	From    => 'me@whereever.net',
	To      => 'you@somewhereelse.net',
	Data    => 'Hello World!',
	Subject => 'testmail',
);

$msg->send || die "you DON'T have mail!";

print "... still running ...";

Weder “you DON’T have mail!” noch “… still running …” werden ausgegeben, da diese Stellen im Code auf Grund des Programmabbruchs nicht mehr erreicht werden.

Leider ist die Erläuterung zum Verhalten der Funktion “$msg->send” nicht wirklich hilfreich:

Returns whatever the mail-handling routine returns: this should be true on success, false/exception on error.

Eine Suche im Internet führte zum Blogbeitrag “Perl exception handling”, welcher genau das aufgetretene Verhalten beschreibt und eine Lösungsmöglichkeit mittels “eval” aufzeigt:

use strict;
use warnings;
use MIME::Lite;

MIME::Lite->send('smtp', 'mailserver', Debug => 0);

my $msg = MIME::Lite->new(

	From    => 'me@whereever.net',
	To      => 'you@somewhereelse.net',
	Data    => 'Hello World!',
	Subject => 'testmail',
);

eval { $msg->send; };

if ($@) {
	print "you DON'T have mail!";
}

print "... still running ...";

So gekapselt läuft das Skript auch nach einem gescheiterten “$msg->send” weiter und auf einen eventuellen Fehler kann reagiert werden.