Aus einer Textdatei alle http: URL's rausfiltern....Wie mach ich das?

[Thomas Henkel]

Hallo Leute!

Ich bin noch ein kleiner Anfänger in Perl und brauche jetzt schon Hilfe! ;-)
Also folgendes: Ich habe ein Formularscript auf meiner Seite installiert (nicht von mir geschrieben), es schreibt verschiedene Daten in eine normale Textdatei. So eine sieht ungefähr so aus:

Name: Max Mustermann
Straße: Musterstraße 1
PLZ: 11111
Ort: Musterort
URL: http://www.mustermann.de

Name: Thomas Mustermann
Straße: Musterstraße 14
PLZ: 23423
Ort: Musterort
URL: http://www.mustermaenchen.de

und so weiter. von diesen Datensätzen habe ich ca. 1000 in einer Textdatei pro Woche. Ich muss jetzt alle URL's aus dieser Textdatei auslesen. Bis jetzt hab ich das immer einzeln rauskopiert und in eine neue eingefügt, wo nur URL's drin stehen. Das war ne Massenarbeit. Jetzt wollte ich euch um Hilfe bitten. Könnt ihr mir sagen wie ich die URL's da rauskrieg mit nem CGI-Skript? Also ich bräuchte sie einfach nur so:

http://www.mustermann.de
http://www.mustermaenchen.de
http://www.undsoweiter.de

Vielleicht hat ja einer mal kurz Zeit und kann mir den Code dafür sagen, oder weiss wo ich ein Beispiel Skript dazu finde. Das wäre echt nett von euch, nämlich so ist es wie gesagt ne sehr langweilige und lange Arbeit! *fg*

Best regards

Thomas

[Christian Kruse]

Hi,

Ich muss jetzt alle URL's aus dieser Textdatei auslesen. Bis jetzt hab ich das immer einzeln
rauskopiert und in eine neue eingefügt, wo nur URL's drin stehen. Das war ne Massenarbeit.

Selber Schuld ;)

Jetzt wollte ich euch um Hilfe bitten. Könnt ihr mir sagen wie ich die URL's da rauskrieg mit nem
CGI-Skript? Also ich bräuchte sie einfach nur so:

http://www.mustermann.de
http://www.mustermaenchen.de
http://www.undsoweiter.de

Wenn die Datei _immer_ so aufgebaut ist, dann geht das ganz einfach:

#einlesen
open(DAT,"<datei.txt");
$inhalt = join("",<DAT>);
close(DAT);

#URLs rausfiltern
@urls = ();
while($inhalt =~ /URL: (http://.*)[\n\r]+/gs)
{ push(@urls,$1); }

mfg
CK1

<img src="http://wwwtech.de/images/banner.jpg" alt="">
http://wwwtech.de/moorhuhn/

[n.d. parker]

hi ho

while($inhalt =~ /URL: (http://.*)[\n\r]+/gs)

ist nicht ganz korrekt ... und ausserdem, warum so kompliziert? :-)

nicht ganz korrekt, weil .* durch das /s auch \n erkennen wuerde (.* ist vor dem [\n\r]+ gierig)

ich denke,

while($inhalt =~ /^URL:\s*(http://.+)$/gm)  # .+, damit auch nach http:// was kommt :-)

ist besser :-)

cua

n.d.p.

[Cheatah]

Hi,

while($inhalt =~ /URL: (http://.*)[\n\r]+/gs)

ist nicht ganz korrekt ... und ausserdem, warum so kompliziert? :-)

möchtest Du mal wissen, was kompliziert ist? ;-)

Also, hier ging es ja um ein relativ einfaches Beispiel. Allgemein betrachtet ist die korrekte Erkennung von URLs nicht ganz so einfach - RFC 1738 (ftp://ftp.isi.edu/in-notes/rfc1738.txt) regelt, wie eine solche auszusehen hat, und man kann sogar eine Regular Expression draus basteln.

Die völlig RFC-konforme RegExp hat noch (mindestens) zwei kleine Macken: Erstens matcht "otherurl" auf so ziemlich alles, zweitens sind in HTTP-URLs keine Tilden "~" erlaubt, werden aber sehr oft benutzt. Nach diesen Anpassungen kommt folgendes heraus (ich hoffe, das Forums-Script macht mir jetzt keinen Strich durch die Rechnung; falls doch, schicke ich noch ein zweites Posting mit dem Rest):

Basic definitions:

my $lowalpha       =  '(?:[a-z])';
my $hialpha        =  '(?:[A-Z])';
my $alpha          =  "(?:$lowalpha$hialpha)";
my $digit          =  '(?:\d)';
my $safe           =  '(?:[$_.+-])';
my $extra          =  '(?:[!*'(),])';
my $national       =  '(?:[{}\\^~[]`])';
my $punctuation    =  '(?:[<>#%"])';
my $reserved       =  '(?:[;/?:@&=])';
my $hex            =  '(?:[\dA-Fa-f])';
my $escape         =  "(?:%$hex$hex)";
my $unreserved     =  "(?:$alpha$digit$safe$extra)";
my $uchar          =  "(?:$unreserved$escape)";
my $xchar          =  "(?:$unreserved$escape$reserved)";
my $digits         =  '(?:\d+)';
my $alphadigit     =  "(?:$alpha\d)";

URL schemeparts for ip based protocols:

my $urlpath        =  "(?:$xchar*)";
my $user           =  "(?:(?:$uchar[;?&=])*)";
my $password       =  "(?:(?:$uchar[;?&=])*)";
my $port           =  "(?:$digits)";
my $hostnumber     =  "(?:$digits\.$digits\.$digits\.$digits)";
my $toplabel       =  "(?:(?:$alpha(?:$alphadigit-)*$alphadigit)$alpha)";
my $domainlabel    =  "(?:(?:$alphadigit(?:$alphadigit-)*$alphadigit)$alphadigit)";
my $hostname       =  "(?:(?:$domainlabel\.)*$toplabel)";
my $host           =  "(?:(?:$hostname)(?:$hostnumber))";
my $hostport       =  "(?:(?:$host)(?::$port)?)";
my $login          =  "(?:(?:$user(?::$password)?@)?$hostport)";
my $ip_schemepart  =  "(?://$login(?:/$urlpath)?)";

my $schemepart     =  "(?:$xchar*$ip_schemepart)";
my $scheme         =  "(?:(?:$lowalpha$digit[+.-])+)";

The generic form of a URL is:

my $genericurl     =  "(?:$scheme:$schemepart)";

The predefined schemes:

FTP (see also RFC959)

my $fsegment       =  "(?:(?:$uchar[?:@&=])*)";
my $ftptype        =  "(?:[AIDaid])";
my $fpath          =  "(?:$fsegment(?:/$fsegment)*)";
my $ftpurl         =  "(?:ftp://$login(?:/$fpath(?:;type=$ftptype)))";

FILE

my $fileurl        =  "(?:file://(?:(?:$host)localhost)?/$fpath)";

HTTP

my $httpuchar      =  "(?:(?:$alpha$digit$safe(?:[!*',]))$escape)";
my $hsegment       =  "(?:(?:$httpuchar[;:@&=~])*)";
my $search         =  "(?:(?:$httpuchar[;:@&=~])*)";
my $hpath          =  "(?:$hsegment(?:/$hsegment)*)";
my $httpurl        =  "(?:http://$hostport(?:/$hpath(?:\?$search)?)?)";

GOPHER (see also RFC1436)

my $gopher_plus    =  "(?:$xchar*)";
my $selector       =  "(?:$xchar*)";
my $gtype          =  "(?:$xchar)";
my $gopherurl      =  "(?:gopher://$hostport(?:/$gtype(?:$selector(?:%09$search(?:%09$gopher_plus)?)?)?)?)";

MAILTO (see also RFC822)

my $encoded822addr =  "(?:$xchar+)";
my $mailtourl      =  "(?:mailto:$encoded822addr)";

NEWS (see also RFC1036)

my $article        =  "(?:(?:$uchar[;/?:&=])+@$host)";
my $group          =  "(?:$alpha(?:$alpha$digit[.+_-])*)";
my $grouppart      =  "(?:$article$group\*)";
my $newsurl        =  "(?:news:$grouppart)";

NNTP (see also RFC977)

my $nntpurl        =  "(?:nntp://$hostport/$group(?:/$digits)?)";

TELNET

my $telneturl      =  "(?:telnet://$login(?:/)?)";

WAIS (see also RFC1625)

my $wpath          =  "(?:$uchar*)";
my $wtype          =  "(?:$uchar*)";
my $database       =  "(?:$uchar*)";
my $waisdoc        =  "(?:wais://$hostport/$database/$wtype/$wpath)";
my $waisindex      =  "(?:wais://$hostport/$database\?$search)";
my $waisdatabase   =  "(?:wais://$hostport/$database)";
my $waisurl        =  "(?:$waisdatabase$waisindex$waisdoc)";

PROSPERO

my $fieldvalue     =  "(?:(?:$uchar[?:@&]))";
my $fieldname      =  "(?:(?:$uchar[?:@&]))";
my $fieldspec      =  "(?:;$fieldname=$fieldvalue)";
my $psegment       =  "(?:(?:$uchar[?:@&=]))";
my $ppath          =  "(?:$psegment(?:/$psegment)*)";
my $prosperourl    =  "(?:prospero://$hostport/$ppath(?:$fieldspec)*)";

my $url            =  "$httpurl$ftpurl$newsurl$nntpurl$telneturl$gopherurl$waisurl$mailtourl$fileurl$prosperourl";

$text =~ s!$url!<a href="$&">$&</a>!g;

Man beachte nun noch, daß die Verwendung von $& die Performance des gesamten Scripts (nämlich die jeder einzelnen Regular Expression!) herunterziehen kann, aber das ist glaube ich hier ein eher zweitrangiges Problem :-)

Cheatah

[n.d. parker]

hi ho

[...] ganz viel regex geloescht [...]

_diesen_ regex werd ich mir abspeichern, die rfc hab ich schon lange gesucht usw.

danke!

cua

n.d.p.

p.s.: :-)

[Cheatah]

Hi,

_diesen_ regex werd ich mir abspeichern, die rfc hab ich schon lange gesucht usw.

wenn Du da _eine_ RegExp draus machst, also am Ende $url betrachtest, ist das Ding übrigens satte acht Kilobyte groß :-)

Cheatah

[Calocybe]

Hi!

$text =~ s!$url!<a href="$&">$&</a>!g;
Man beachte nun noch, daß die Verwendung von $& die Performance des gesamten Scripts (nämlich die jeder einzelnen Regular Expression!) herunterziehen kann, aber das ist glaube ich hier ein eher zweitrangiges Problem :-)

Na jetzt koennte man doch einfach $url in Klammern fassen und dann $1 verwenden, oder? Also
$text =~ s!($url)!<a href="$1">$1</a>!g;

So long

[AlexBausW]

Hallo Cheatah,

[...]

my $url            =  "$httpurl$ftpurl$newsurl$nntpurl$telneturl$gopherurl$waisurl$mailtourl$fileurl$prosperourl";

Wessen Copyright muss ich eigentlich einfügen, wenn ich das benutzen will, oder ist das unter keiner Lizens stehende OpenSource? ;-)

Gruß AlexBausW

Please visit my SELFvisitingcard @ http://www.atomic-eggs.com/selfspezial/daten/150.html

[AndreasW]

Hallo Leute!

Ich bin noch ein kleiner Anfänger in Perl und brauche jetzt schon Hilfe! ;-)

Kann jedem mal passieren.

[...]

Best regards

Thomas

Hallo,
so mal aus dem Kopf heraus (ungetestet):

while (<>)
{
  if ($_ =~ m/.*(http:[^ \t]*).*/)
  {
    print $1;
  }
}

Andreas

[n.d. parker]

hi ho

Name: Max Mustermann
Straße: Musterstraße 1
PLZ: 11111
Ort: Musterort
URL: http://www.mustermann.de

wenn der aufbau der datei wirklich so standardisiert ist, sollte folgendes funktionieren:

#!/usr/bin/perl -w

$rein="namedertextdatei";
$raus="namederurldatei";

open REIN,"<$rein" or &error (tralala);   # oeffnen zum lesen
open RAUS,">$raus" or &error (soundso);   # und zum schreiben
while (<REIN>) {
  if (/^URL:\s*(.+)$/) {                  #  siehe perldoc perlre :-)
    print RAUS "$1\n";
}
close RAUS;
close REIN;

Trara!

cua

n.d.p.

[n.d. parker]

hi ho

open REIN,"<$rein" or &error (tralala);   # oeffnen zum lesen
open RAUS,">$raus" or &error (soundso);   # und zum schreiben
while (<REIN>) {
  if (/^URL:\s*(.+)$/) {                  #  siehe perldoc perlre :-)
    print RAUS "$1\n";

der aufmerksame leser wird gemerkt haben - hier fehlt eine } .-), also:

print RAUS "$1\n";}

so!

cua

n.d.p.

[Frank Schönmann]

hi!

#!/usr/bin/perl -w

$rein="namedertextdatei"
$raus="namederurldatei"

open REIN,"<$rein" or &error (tralala);   # oeffnen zum lesen
open RAUS,">$raus" or &error (soundso);   # und zum schreiben

while (<REIN>) {
  if (/^URL:\s*(.+)$/) {                  #  siehe perldoc perlre >     print RAUS "$1\n"
}

Wie unschön ;)

print RAUS join "\n", grep { /^URL:\s(.+)$/ } <REIN>;

close RAUS;
close REIN;

bye, Frank!

[n.d. parker]

hi ho

print RAUS join "\n", grep { /^URL:\s(.+)$/ } <REIN>;

kleine korrektur:

print RAUS join "\n", map { /^URL:\s*(.+)$/ } <REIN>;

liefert das richtige ergebnis .-)

cua

n.d.p.

[Frank Schönmann]

hi!

print RAUS join "\n", grep { /^URL:\s(.+)$/ } <REIN>
kleine korrektur:

Sicher, dass obiges falsch ist? grep() liefert doch im Listenkontext
alle Ergebnisse zurück, sofern für die jeweiligen Elemente die
Subroutine erfolgreich ist.

print RAUS join "\n", map { /^URL:\s*(.+)$/ } <REIN>

map() dagegen müsste die Subroutine auf alle Elemente anwenden und in
diesem Fall nur zufällig die richtige URL zurückliefern, in allen
Zeilen, in denen keine URL vorhanden ist aber eine leere Liste.

bye, Frank! *verwirrt*

[n.d. parker]

re hi

print RAUS join "\n", grep { /^URL:\s(.+)$/ } <REIN>
Sicher, dass obiges falsch ist? grep() liefert doch im Listenkontext

... eine Liste der _gesamten_ zeilen zurueck, bei denen das matching erfolgreich war.
in der url-datei wuerde dann sowas stehen:

URL: http://www.mustermann.de
URL: http://tralala
usw.

print RAUS join "\n", map { /^URL:\s*(.+)$/ } <REIN>
map() dagegen müsste die Subroutine auf alle Elemente anwenden und in
diesem Fall nur zufällig die richtige URL zurückliefern, in allen
Zeilen, in denen keine URL vorhanden ist aber eine leere Liste.

hmm, jetzt, wo dus sagst, aber funktioniert hat es bei mir, ein paar tests (mit den daten aus dem ursprungsposting) haben folgendes ergeben:

(1)

print RAUS join "*\n", map { my ($x,$y)=/^((?:NameURL):\s*)(.+)$/;($x,$y); } <REIN>;

liefert das zurueck, was du sagst.

(2)

print RAUS join "*\n", map { my @array=/^((?:NameURL):\s*)(.+)$/;@array; } <REIN>;  # und
print RAUS join "*\n", map { /^((?:NameURL):\s*)(.+)$/ } <REIN>;

liefern das angestrebte (also meins:-) Ergebnis zurueck

Der Unterschied zwischen beiden ist: (jeweils im nicht-gemachten Fall)
bei (2) wird eine leere Liste zurueckgegeben (also quasi _nichts_), es ist nichts da zum joinen
bei (1) wird keine leere Liste, sondern eine Liste mit zwei leeren Elementen, in diesem Fall handelt join und naja joint eben :-)

so wuerde ich mir das erklaeren, Gegenstimmen? :-)

cua

n.d.p. (auch noch etwas verwirrt .-)

[n.d. parker]

hi ho

kleiner Nachtrag:

local @array;
print join ("*","1",@array,"2","3",@array,"4"),"\n";

ergibt:

1*2*3*4

also stimmt meine theorie vermutlich .-)

cua

n.d.p.