Hallo Patrick,
http://nochmal.de http://im.com http://klartext.com:
http://sorry.com, http://tut.com http://mir.de http://leid.de,
http://aber.de "http://www.nobody-is-perfect.de" !
Ich lese den Linksetzer (bzw. die ;-) eigentlich immer, weil das oft sehr informativ ist. Von dieser Variante der Antwort war ich spontan so begeistert, daß ich ein kleines Perlscript programmiert habe, welches Wörter einer Textdatei verlinkt, falls eine Site erreichbar ist. Das kann man auch zum Checken bereits vergebener (bzw. auf irgendeinem Server liegenden) Domains hernehmen ;-)
Gruß AlexBausW
#********** text2links.pl ********************
#!/use/local/bin/perl -w
use LWP::UserAgent;
use HTTP::Request;
use strict;
Variablen deklarieren
use vars qw($datei $text @worte %singlewords @tlds $tld $url $proto $res %tochange $ua $regex);
Topleveldomains angeben
@tlds = ('.de','.com','.net','.org','.at','.ch','.co.uk');
Protokoll
$proto = "http://";
zu wandelnde Datei
$datei = shift;
Datei einlesen
open (DATEI, $datei) or die "Can`t read from $datei: $!";
#************** Begin open() **************
$text = '';
while (<DATEI>) {
# Umlaute aendern
s/
(äöüÄÖÜß) # Suche nach Umlauten
/
($1 eq 'ä' ? 'ae' : ''). # wenn ä gefunden, dann ersetzen durch ae...
($1 eq 'ö' ? 'oe' : '').
($1 eq 'ü' ? 'ue' : '').
($1 eq 'Ä' ? 'Ae' : '').
($1 eq 'Ö' ? 'Oe' : '').
($1 eq 'Ü' ? 'Ue' : '').
($1 eq 'ß' ? 'ss' : '')
/egx;
# Text sichern
$text .= $_;
# Text in kleinschreibung wandeln (Domains sind caseinsensitiv!?)
$_ = lc($_);
# Worte extrahieren
push @worte, split /\W+/;
}
#*************** End open() ****************
close DATEI;
mehrfache Worte extrahieren durch Speicherung in Hash
@singlewords{@worte} = (1..scalar(@worte));
Useragenten erstellen
$ua = LWP::UserAgent->new();
Fuer jedes Wort pruefen, ob eine Domain vorhanden ist
WORD:
foreach (keys %singlewords) {
# angegebenen Topleveldomains ueberpruefen
foreach $tld (@tlds) {
# URL erstellen: http://domain.tld
$url = $proto.$_.$tld;
# URL anfordern
$res = $ua->request(HTTP::Request->new("HEAD", $url));
# wenn URL vorhanden, wird Wort als Key fuer die URL gespeichert
if ($res->is_success) {
$tochange{$_} = $url;
next WORD; #naechstes Wort pruefen
}
# falls URL nicht ansprechbar, wird nach http://www.domain.tld gesucht
else {
# s.o.
$url = $proto.'www.'.$_.$tld;
# s.o.
$res = $ua->request(HTTP::Request->new("HEAD", $url));
# s.o.
if ($res->is_success) {
$tochange{$_} = $url;
next WORD;
}
}
}
}
alle Worte zu einer Regexpression verbinden
$regex = join '', keys %tochange;
ersetzen aller Worte mit korrespondierender Domain durch einen Link
$text =~ s/($regex)/'<a href='.$tochange{lc($1)}.'>'.$1.'</a>'/eig;
Zeilenumbrueche ersetzen
$text =~ s/\015\012\015\012/<br>/g;
Datei als HTML-Datei speichern
open (DATEI, ">$datei.htm") or die "Can`t write to $datei.htm: $!";
print DATEI <<EOT;
<html>
<head>
<title>Text verlinkt</title>
</head>
<body>
<h1>Alles Links</h1>
$text
</body>
</html>
EOT
close DATEI;
feddisch
exit(0);
#*********************************************