Nochmal Links testen - mein Modul für Perl

Also ich habe mich ja schon öfters über das Testen von Links auf Webseiten ausgelassen. Da ich anscheinend einen Server habe, der weder das Modul Scraper noch WWW::Mechanize bereithält, bleibt mir eben nichts anderes übrig, als selbst mal wieder in die Tasten zu greifen und mir ein Modul zu schreiben, das Webseiten bzw. in Dateien gespeicherte Webseiten nach Links abgrast und mit alle Parameter der Links bereitstellt.

Herausgekommen ist das Modul, das hier heruntergeladen werden kann. Falls man es benutzen möchte, einfach in das cgi-bin-Verzeichnis kopieren und die Rechte auf 0755 setzen.
Und was kann das Modul?
Also:
- Eine Seite aus dem WWW laden
- Daten aus lokalen Dateien verarbeiten
- Links finden, die in <a ...>, <area...>, <frame...> und <iframe...> - Tags gesetzt sind
- Dazu ALLE Parameter extrahieren, auch zum Beispiel das rel=nofollow
- sortiert nach internen oder externen Links
- oder nach Javascript bzw. Email-Links
- Leicht zu installieren, Modul einfach ins cgi-bin-Verzeichnis kopieren und gut (Rechte setzen auf 0755)
- läuft auf wahrscheinlich jedem Server, da eingebundene Module (wirklich) zum Standart gehören
- vollständig gekapselt, d.h. keine Seiteneffekte zu anderen Script-Teilen
- erkennt auch utopische Schreibweisen wie
<a href=test.htm> oder <a target=frame href='blah.htm' />
- Linktexte liegen als Orginal vor, bzw. können "bereinigt" werden, d.h. HTML-Tags werden gelöscht, <img...> wird in IMAGE gewandelt
- usw.

Verwendung
Die Verwendung ist relativ simpel.
Hier ein Beispiel:

use Linkcheck;

$t=Linkcheck->new('http://www.hidemail.de/blog');

if ($t->Is_OK != 1){
print "Error beim initialisieren";
exit;
}

# tested, ob ein übergebener Link vorhanden ist
if ($t->Is_Linked('http://www.hidemail.de/blog') != -1){
$num=$t->Is_Linked('http://www.hidemail.de/blog');

print "title: ".$t->Get_title($num)."\n" if $t->Get_title($num);
print "href= ".$t->Get_href($num)."\n";
print "Linktext= ".$t->Get_linktext($num)."\n";
print "target= ".$t->Get_target($num)."\n";

my %params=$t->Get_all_params($num);

print "\nAlle Parameter:\n";
foreach (keys %params){print "$_ : $params{$_}\n";}

}

# zeigt Anzahl der gefundenen Maillinks
print "\n\nEs wurden ".$t->Get_maillinks_count." Maillinks gefunden" ;

# und gibt Maillinks aus, falls vorhanden
if ($t->Get_maillinks_count > 0 ){print ": \n";
my @maillinks= $t->Get_all_maillinks;
foreach (@maillinks){print "$_\n";}
} else {
print ".\n";
}

print "Es gibt ".$t->Get_external_links_count." externe Links\n";
print "Es gibt ".$t->Get_internal_links_count." interne Links\n";

print "\n\nAlle externen Links:\n";
$cou=1;
foreach ($t->Get_all_external_links){
print "$cou: ".$t->Get_href($_)."\nLinktext: ".$t->Clear($t->Get_linktext($_))."\n\n";
$cou++;
}

print "\n\nAlle internen Links:\n";
$cou=1;
foreach ($t->Get_all_internal_links){
print "$cou: ".$t->Get_href($_)."\nLinktext: ".$t->Clear($t->Get_linktext($_))."\n\n";
$cou++;
}

Ähh... wie jetzt?
Ganz einfach:
Nach der Einbindung wird der Linkchecker initialisiert. Dazu wird die Seite angegeben, die eingelesen werden soll, in diesem Fall dieser Blog.

Per Is_OK kann geprüft werden, ob die Initialisierung geklappt hat.

Dann wird geprüft (Is_Linked), ob die eingelesene Seite nach http://www.hidemail.de/blog linkt, wenn ja werden alle Parameter ausgegeben.

Danach werden die gefundenen Mailadressen ausgegeben, falls vorhanden.

Im Anschluß wird die Anzahl der externen und internen Links ausgegeben, danach die Links selbst.

War doch einfach, oder?

Das Modul kennt noch folgende Methoden:
Clear
Entfernt alle HTML-Tags, \n, \t, \f, \s und doppelte Leerzeichen aus einem Skalar (zum Beispiel dem Linktext). Zusätzlich wird ein <img...>-Tag in " IMAGE " verwandelt.
Kann verwendet werden, um die Linktexte zu "säubern".

$text=$lc->Clear($text);

Get_all_params
Holt alle Parameter eines Links als Hash

%Params=$lc->Get_all_params($num);
foreach (keys %Params){print "Parameter: $_, Value $Params{$_}\n";}

Get_href
Holt href eines Links

$href=$lc->Get_href($num);

Get_linktext
Holt Linktext eines Links

$linktext=$lc->Get_linktext($num);

Get_nofollow
Prüft auf rel=nofollow;
Gibt eine 1 zurück, wenn nofollow gefunden wurde.

$nofollow=$lc->Get_nofollow($num);

Get_title
Gibt den Title-Tag zurück, falls vorhanden

$title=$lc->Get_title($num);

Get_target
Gibt den target-Tag zurück, falls vorhanden

$target=$lc->Get_target($num);

Get_count
Gibt die Anzahl der gefundenen Links zurück

$conut=$lc->Get_count;

Get_maillinks_count
Gibt die Anzahl der gefundenen Mail-Links zurück

$maillinkscount=$lc->Get_maillinks_count;

Get_javascriptlinks_count
Gibt die Anzahl der gefundenen Javascript-Links zurück

$javascriptlinkscount=$lc->Get_javascriptlinks_count;

Get_all_maillinks
Gibt alle Mailadressen als Array zurück.

@mailadresses=$lc->Get_all_maillinks;

Get_all_external_links
Gibt Referenznummern aller externen Links als Array zurück.

@external_links=$lc->Get_all_external_links;

Get_all_internal_links
Gibt Referenznummern aller internen Links als Array zurück.

@internal_links=$lc->Get_all_internal_links;

Get_external_links_count
Gibt die Anzahl der externen Links zurück.

$external_links_count=$lc->Get_external_links_count;

Get_internal_links_count
Gibt die Anzahl der internen Links zurück.

$internal_links_count=$lc->Get_internal_links_count;

Eventuell andere Parameter eines Links können per

%Params=$lc->Get_all_params($num);
foreach (keys %Params){ # $_ = Parametername
# $Params{$_} = Parameter
}

abgefragt werden.

Verarbeiten von Dateien
Auch die Verarbeitung von Dateien ist möglich. Dazu muß die Datei eingelsen werden und in einem Array oder Skalar vorliegen.
Zur Initialisierung wird dann

my $lc = Linkcheck->new(Base,Skalar);
#or
my $lc = Linkcheck->new(Base,Array);

verwendet, wobei Base die Basisadresse angibt, unter der die Seite im Internet steht, also zum Beispiel

my $base='http://www.hidemail.de/blog';
open (my $IN,"<","seite.txt");
my @inhalt=<$IN>;
close $IN;
my $lc = Linkcheck->new($base,@inhalt);

Bemerkungen zum Modul
Also die einfache Variante zum extrahieren von Links, also das Suchen nach <a href="test" target="frame" title="title">, funktioniert ja leider nicht, da es zu viele verschiedene Schreibweisen gibt, die als gültig anerkannt werden. Deswegen der etwas aufwändigere Teil der Extraktion im Modul. Und wahrscheinlich werden wiederum nicht alle (ungültigen) schreibweisen erkannt. Jedoch wird alles, was sich halbwegs an die Konventionen hält, sauber verarbeitet.
<area...>-Links werden ebenfalls verwertet.
<frame...>-Angaben sind ja eigentlich keine Links, werden aber von großen Suchmaschinen wie Google ebenfalls gewertet, deswegen auch hier.
Das Gleiche gilt für <iframe...>'s, die auch verfolgt werden.

Und natürlich:
Per Module wie Web::Scraper oder WWW::Mechanize könnte man ebenfalls zu solchen Ergebnissen gelangen, möglicherweise schneller. Da aber, wie oben angedeutet, nicht auf allen Servern diese Module vorliegen, und dieses Script wirklich überall läuft, bin ich zufrieden damit.
Nachtrag
1.
Falls per Is_linked geprüft wird, ob ein Link gesetzt ist, wird ein evtl. rel=nofollow nicht beachtet.
Da aber als Rückgabewert von Is_linked die Referenznummer des Links zurückgegeben wird, kann dann per Get_nofollow($nummer} auf ein nofollow geprüft werden.

2.
Links werden IMMER in absolute Links verwandelt, auch wenn es interne Links sind.

Kommentare zum Beitrag "Nochmal Links testen - mein Modul für Perl"

Kommentar von Renée Bäcker

Anmerkungen zum Modul:

if (!$basis=~ /^htt[p|ps]\:\/\//i ){

Das macht nicht das was Du willst. Mit [] werden Zeichenklassen angegeben. In diesem Fall besteht die Zeichenklasse aus "p","|","p","s". Der reguläre Ausdruck matcht also folgendes:

http://
htt|://
htts://

Was Du willst, ist

if (!$basis=~ /^htt(?:p|ps)\:\/\//i ){

Oder noch besser:

if (!$basis=~ /^https?\:\/\//i ){

Und um sich das ganze Escapen zu sparen:

if (!$basis=~ m!^https?://!i ){

Zusätzlich muss es statt

! $var =~ /.../

so heißen:

$var !~ /.../

.
Du kannst ja mal

#!/usr/bin/perl

use strict;
use warnings;

my $link = 'htt://foo-magazin.de';
if (! $link =~ /^htt[p|ps]\:\/\//i ){
print "Fehler!";
}

testen...
Das Problem ist, dass das ! stärker ist als das =~, so dass erst $link "negiert" wird und dann der reguläre Ausdruck angewendet wird. D.h. es wird folgende Abfrage gemacht: "Beginnt das Gegenteil von $link mit htt gefolgt von eine p,| oder s gefolgt von ://"?

Um sich anzuschauen was RegExes so machen, kann ich nur YAPE::Regex::Explain empfehlen. Noch mehr nützliche Module sind hier zu finden: http://foo-magazin.de/download.cgi?issue=9

Der gleiche Fehler mit den Zeichenklassen passiert an mehreren Stellen..

---

return -1 if ($datei eq '');
return -1 if ($basis eq '');

Das sollte noch auf Definiertheit prüfen, sonst gibts Warnungen wenn Du make_link_absolut() aufrufst...
Es ist auch eher unüblich (wenn auch nicht falsch), dass der Konstruktor so viel Arbeit macht. Üblicherweise lagert man einen Teil der Funktionalitäten in Subroutinen aus und ruft diese dann vom Konstruktor aus auf.

Das soll's für's Erste gewesen sein ;-) Ich hoffe, es ist ok, dass ich den Code ein wenig beurteile...

Kommentar von Admin

Konstruktive oder kreative Beiträge (oder beides) sind immer gern gesehen!

Zu Punkt 1.:
Ist natürlich richtig. Hab da wohl zu wenig getestet... oder betriebsblind...

Das mit der Negation bei !$sonstwas=~ /blah/; stimmt tatsächlich, seltsamerweise ist mir das so aber noch nie aufgefallen ... und ich bin ja nun doch schon etwas länger am perlen ... aber man lernt nie aus...

Die Abfrage, ob $basis und $datei nun auch definiert sind, hab ich folgendermaßen gelöst:
$basis=shift || '';
my $datei=shift || '';

So dürfte es auch mit den warnings klappen.

Und zum Schluß noch den ausführlichen new()-Teil:
Ich dachte mir dabei, da sowieso immer eine Datei bzw. eine Site eingelesen werden muß, packe ich das gleich mit in die Initialisierung, so erspart man sich einen separaten Aufruf einer weiteren Routine, die das dann eben erledigt... Aber wie Du schon sagtest, ungewöhnlich, aber nicht falsch...

Kommentar von Renee Bäcker

Die Abfrage, ob $basis und $datei nun auch definiert sind, hab ich folgendermaßen gelöst:
$basis=shift || '';
my $datei=shift || '';

... macht in diesem Fall sicherlich was es soll, aber als Hinweis für alle, die vielleicht noch nicht so lange Perl programmieren: Das überprüft nicht die Definiertheit von Variablen, sondern ob sie "wahr" sind - und wenn sie nicht "wahr" (also "false") sind, wird '' zugewiesen.

Das "Problem" bei Perl ist, dass das hier alles "false" ist:

* undef
* ''
* 0
* 0.0
* 0E10
* ...

Also auch durchaus definierte Werte.

Deswegen freue ich mich schon auf Perl 5.10 - das voraussichtlich nächste Woche rauskommt -, da es dort den "defined-or"-Operator gibt: //

Kommentar von Admin

Yo, 5.10 hört (liest) sich gut an... Aber bis sich das wieder auf die Miet-Server durchringt, kann es wohl noch ein paar Monate (Jahre) dauern...

Bis dahin ist leider immer wieder selbermachen angesagt (Server-Steinzeit eben...)

Kommentar von Renée Bäcker

Es wäre wünschenswert, wenn Hoster in den Parallelbetrieb gehen würden. Standard kann ja eine "alte" Version bleiben...

Bei PHP wird so etwas ja auch öfters gemacht!

Thema: Perl Script

Der Beitrag "Nochmal Links testen - mein Modul für Perl" wurde 5770 mal gelesen.