Email::Find und E-Mails in Links? (gelöst) (Fragen zu Perl-Modulen)

[thread]15084[/thread]

Email::Find und E-Mails in Links? [gelöst]

Leser: 17

Articles: hide open all | hide show old branches

+15 replies

bianca

2010-06-01 16:22

User since
2009-09-13
7016 Artikel
BenutzerIn

user image

Hat jemand eine Idee, wie ich Email::Find "überrede", E-Mails innerhalb von URL Links nicht zu finden?

Mein Problem ist oben im Text der Link

Code: (dl )

http://www.example.org/login_index.php?email=info\@test.example

//Modedit GwenDragon: Mail in Code-Tags, Domain geändert.

Da baut die folgende sub Mist indem die E-Mail innerhalb des Links nochmal übersetzt wird.
Wie kann ich das verhindern?
Danke für alle Tipps

Code (perl): (dl )

#!/usr/bin/perl -W
use strict;
use warnings;
use diagnostics;

my $testtext = <<TEXTPLAIN;
Dies ist ein kleiner
Test zur Erkennung von Hyperlinks test.de oder www.test.de oder http://www.test.de
oder https://www.testhttps.de
oder (http://test.de/slash/pfad)
oder info\@test.example
Und hier ein Gemeinschaftstest: http://www.test.de/login_index.php?email=info\@test.example
mal schauen...
TEXTPLAIN

identifylinks (\$testtext,'<a href="%s" target="_blank">%s</a>','<a href="mailto:%s">%s</a>');
print "<pre>$testtext</pre>";

#--------#
sub identifylinks {
        #
        # Erkennt und markiert Hyperlinks in einem Text
        #
        # Aufruf:
        # =======
        # my $testtext = 'test: http://www.test.de';
        # identifylinks (\$testtext,'<a href="%s" target="_blank">%s</a>','<a href="mailto:%s">%s</a>');
        # print $testtext;
        #
        my $text = $_[0];
        my $link = $_[1];
        my $email_link = (defined $_[2] ? $_[2] : '');
        my $modul = 1;
        eval "use URI::Find; 1;" or $modul = 0;
        if ($modul) {
                my $finder = URI::Find -> new (
                        sub { return sprintf ($link,@_); }
                );
                $finder -> find ($text);
        }
        if ($email_link ne '') {                                                                                                                                                                        # E-Mail auch erwünscht?
                eval "use Email::Find; 1;" or $modul = 0;
                if ($modul) {
                        my $finder = Email::Find -> new (
                                sub { return sprintf ($email_link,$_[0] -> format,$_[1]); }
                        );
                        $finder -> find ($text);
                }
        }
}
#--------#

Last edited: 2010-06-02 10:34:23 +0200 (CEST)

10 print "Hallo"
20 goto 10

topeg

2010-06-01 17:46

User since
2006-07-10
2611 Artikel
BenutzerIn

user image

So geht es, aber sicher kann noch etwas durch schlüpfen.

Code (perl): (dl )

#--------#
sub identifylinks {
  #
  # Erkennt und markiert Hyperlinks in einem Text
  #
  # Aufruf:
  # =======
  # my $testtext = 'test: http://www.test.de';
  # identifylinks (\$testtext,'<a href="%s" target="_blank">%s</a>','<a href="mailto:%s">%s</a>');
  # print $testtext;
  #
  my $text = $_[0];
  my $link = $_[1];
  my $email_link = (defined $_[2] ? $_[2] : '');

  my %found;

  my $modul = 1;
  eval "use URI::Find; 1;" or $modul = 0;
  if ($modul) {
    my $finder = URI::Find -> new ( sub
      {
        $found{$_[0]}++;
        $found{$_[1]}++;
        return sprintf ($link,@_);
      }
    );
    $finder -> find ($text);
  }

  if ($email_link ne '') {                                          # E-Mail auch erwünscht?
    eval "use Email::Find; 1;" or $modul = 0;
    if ($modul) {
      my $finder = Email::Find -> new (sub
        {
          return $_[1] if($found{$_[0]->format});
          return $_[1] if($found{'http:'.$_[0]->format});
          return $_[1] if($found{$_[1]});
          return $_[1] if($found{'http:'.$_[1]});
          return sprintf ($email_link,$_[0]->format,$_[1]);
        }
      );
      $finder -> find ($text);
    }
  }
}
#--------#

oder so:
hat aber den Nachteil, dass etwas in "@" gewandelt erden könnte was nicht "@" sein sollte.

Code (perl): (dl )

#--------#
sub identifylinks {
  #
  # Erkennt und markiert Hyperlinks in einem Text
  #
  # Aufruf:
  # =======
  # my $testtext = 'test: http://www.test.de';
  # identifylinks (\$testtext,'<a href="%s" target="_blank">%s</a>','<a href="mailto:%s">%s</a>');
  # print $testtext;
  #
  my $text = $_[0];
  my $link = $_[1];
  my $email_link = (defined $_[2] ? $_[2] : '');

  my $modul = 1;
  eval "use URI::Find; 1;" or $modul = 0;
  if ($modul) {
    my $finder = URI::Find -> new ( sub
      {
        $_[0]=~s/\@/\0---at---\0/g;
        $_[0]=~s/\@/\0---at---\0/g;
        return sprintf ($link,@_);
      }
    );
    $finder -> find ($text);
  }

  if ($email_link ne '') {                                          # E-Mail auch erwünscht?
    eval "use Email::Find; 1;" or $modul = 0;
    if ($modul) {
      my $finder = Email::Find -> new (
        sub { return sprintf ($email_link,$_[0]->format,$_[1]); }
      );
      $finder -> find ($text);
    }
  }

  $$text=~s/\0---at---\0/\@/g;
}
#--------#

Das wäre es was mir so auf Anhieb einfiele.

Edit: Blöder kleiner Fehler beseitigt.
Edit2: Besseres Trennzeichen.
Last edited: 2010-06-01 17:50:18 +0200 (CEST)

+3 replies

2010-06-01 17:48

User since
2003-08-04
12208 Artikel
Admin1

das ist der falsche ansatz, den text mehrere male zu durchlaufen.
dafür ist ja die callback-funktionalität von URI::Find da, damit man eben nur den rest, also alles, was nicht zur URL gehört, noch durchläuft. auf diesen rest musst du deine emailfinder-funktion anwenden.

Always code as if the guy who ends up maintaining your code will be a violent psychopath who knows where you live. -- Damian Conway in "Perl Best Practices"
lesen: Wiki:

Wie frage ich & perlintro Wiki:

brian's Leitfaden für jedes Perl-Problem

topeg

2010-06-01 18:02

User since
2006-07-10
2611 Artikel
BenutzerIn

ja stimmt, wäre besser.

topeg

2010-06-01 18:10

User since
2006-07-10
2611 Artikel
BenutzerIn

user image

Also so:

Code (perl): (dl )

#--------#
sub identifylinks {
  #
  # Erkennt und markiert Hyperlinks in einem Text
  #
  # Aufruf:
  # =======
  # my $testtext = 'test: http://www.test.de';
  # identifylinks (\$testtext,'<a href="%s" target="_blank">%s</a>','<a href="mailto:%s">%s</a>');
  # print $testtext;
  #
  my $text = $_[0];
  my $link = $_[1];
  my $email_link = (defined $_[2] ? $_[2] : '');

  if(eval "use URI::Find; 1;")
  {
    my $finder = URI::Find -> new (
      sub { return sprintf ($link,@_); }
    );

    my $call=sub{ return $_[0]; };
    if($email_link ne '' && eval "use Email::Find; 1;" ) # E-Mail auch erwünscht?
    {
      my $finder = Email::Find -> new (
        sub { return sprintf ($email_link,$_[0]->format,$_[1]); }
      );
      $call=sub
        {
          my $text=shift;
          $finder -> find (\$text);
          return $text;
        };
    }

    $finder -> find ($text, $call);
  }

}
#--------#

+7 replies

bianca

2010-06-01 19:04

User since
2009-09-13
7016 Artikel
BenutzerIn

user image

Danke topeg und pq. Ich habe parallel auch mal gebastelt und auch topeg's Vorschlag mal als Vergleich herangezogen:

Code (perl): (dl )

#!/usr/bin/perl -W
use strict;
use warnings;
use diagnostics;
use Data::Dumper;

my $testtext = <<TEXTPLAIN;
Dies ist ein kleiner
Test zur Erkennung von Hyperlinks test.de oder www.test.de oder http://www.test.de
oder https://www.testhttps.de
test Platzhalter ||2||||||||||||
oder (http://test.de/slash/pfad)
oder info\@test.example
Und hier ein Gemeinschaftstest: http://www.test.de/login_index.php?email=info\@test.example
mal schauen...
TEXTPLAIN

identifylinks (\$testtext,'<a href="%s" target="_blank">%s</a>','<a href="mailto:%s">%s</a>');
print "<pre>$testtext</pre>";
identifylinks_topeg (\$testtext,'<a href="%s" target="_blank">%s</a>','<a href="mailto:%s">%s</a>');
print "<pre>$testtext</pre>";

#--------#
sub identifylinks {
        #
        # Erkennt und markiert Hyperlinks in einem Text
        #
        # Aufruf:
        # =======
        # my $testtext = 'test: http://www.test.de';
        # identifylinks (\$testtext,'<a href="%s" target="_blank">%s</a>','<a href="mailto:%s">%s</a>');
        # print $testtext;
        #
        my $text = $_[0];
        my $link = $_[1];
        my $email_link = (defined $_[2] ? $_[2] : '');
        my $modul = 1;
        eval "use URI::Find; 1;" or $modul = 0;
        my (%uris,%zuordnung);
        my $erkennung = 1;
        while ($$text =~ m/\|{$erkennung,$erkennung}/) {                                                                                                                        # eindeutigen temporären Ersetzungsstring finden
                $erkennung ++;
        }
        if ($modul) {
                my $lfd_uri = 0;
                my $finder = URI::Find -> new (
                        sub {                                                                                                                                                                                           # URI und geschriebenen Link speichern
                                $lfd_uri ++;
                                $uris{$lfd_uri} = $_[0];
                                $lfd_uri ++;
                                $uris{$lfd_uri} = $_[1];
                                return sprintf ($link,@_);
                        }
                );
                $finder -> find ($text);
        }

        my $ersatz = 0;
        if (keys %uris) {                                                                                                                                                                                       # alle URI's verbergen vor E-Mail Erkennung
                $ersatz = 1;
                foreach my $lfd_uri (keys %uris) {
                        my $ersatz = '|' x $erkennung . $lfd_uri . '|' x $erkennung;
                        $$text =~ s/\Q$uris{$lfd_uri}/$ersatz/g;
                }
        }

        if ($email_link ne '') {                                                                                                                                                                        # E-Mail auch erwünscht?
                eval "use Email::Find; 1;" or $modul = 0;
                if ($modul) {
                        my $finder = Email::Find -> new (
                                sub { return sprintf ($email_link,$_[0] -> format,$_[1]); }
                        );
                        $finder -> find ($text);
                }
        }
        if ($ersatz) {                                                                                                                                                                                          # alle verborgenen URI's wieder hervorholen
                foreach my $lfd_uri (keys %uris) {
                        my $ersatz = '|' x $erkennung . $lfd_uri . '|' x $erkennung;
                        $$text =~ s/\Q$ersatz/$uris{$lfd_uri}/g;
                }
        }
}
#--------#
sub identifylinks_topeg {
  #
  # Erkennt und markiert Hyperlinks in einem Text
  #
  # Aufruf:
  # =======
  # my $testtext = 'test: http://www.test.de';
  # identifylinks (\$testtext,'<a href="%s" target="_blank">%s</a>','<a href="mailto:%s">%s</a>');
  # print $testtext;
  #
  my $text = $_[0];
  my $link = $_[1];
  my $email_link = (defined $_[2] ? $_[2] : '');

  if(eval "use URI::Find; 1;")
  {
    my $finder = URI::Find -> new (
      sub { return sprintf ($link,@_); }
    );

    my $call=sub{ return $_[0]; };
    if($email_link ne '' && eval "use Email::Find; 1;" ) # E-Mail auch erwünscht?
    {
      my $finder = Email::Find -> new (
        sub { return sprintf ($email_link,$_[0]->format,$_[1]); }
      );
      $call=sub
        {
          my $text=shift;
          $finder -> find (\$text);
          return $text;
        };
    }

    $finder -> find ($text, $call);
  }

}
#--------#

Ausgabe:

Code: (dl )

<pre>Dies ist ein kleiner
Test zur Erkennung von Hyperlinks test.de oder www.test.de oder <a href="http://www.test.de/" target="_blank">http://www.tes
t.de</a>
oder <a href="https://www.testhttps.de/" target="_blank">https://www.testhttps.de</a>
test Platzhalter ||2||||||||||||
oder (<a href="http://test.de/slash/pfad" target="_blank">http://test.de/slash/pfad</a>)
oder <a href="mailto:info@test.example">info@test.example</a>
Und hier ein Gemeinschaftstest: <a href="http://www.test.de/login_index.php?email=info@test.example" target="_blank">http://
www.test.de/login_index.php?email=info@test.example</a>
mal schauen...
</pre><pre>Dies ist ein kleiner
Test zur Erkennung von Hyperlinks test.de oder www.test.de oder <a href="<a href="http://www.test.de/" target="_blank">http:
//www.test.de/</a>" target="_blank"><a href="http://www.test.de/" target="_blank">http://www.test.de</a></a>
oder <a href="<a href="https://www.testhttps.de/" target="_blank">https://www.testhttps.de/</a>" target="_blank"><a href="ht
tps://www.testhttps.de/" target="_blank">https://www.testhttps.de</a></a>
test Platzhalter ||2||||||||||||
oder (<a href="<a href="http://test.de/slash/pfad" target="_blank">http://test.de/slash/pfad</a>" target="_blank"><a href="h
ttp://test.de/slash/pfad" target="_blank">http://test.de/slash/pfad</a></a>)
oder <a href="<a href="mailto:info@test.example" target="_blank">mailto:info@test.example</a>"><a href="mailto:info@test.exa
mple">info@test.example</a></a>
Und hier ein Gemeinschaftstest: <a href="<a href="http://www.test.de/login_index.php?email=info@test.example" target="_blank
">http://www.test.de/login_index.php?email=info@test.example</a>" target="_blank"><a href="http://www.test.de/login_index.ph
p?email=info@test.example" target="_blank">http://www.test.de/login_index.php?email=info@test.example</a></a>
mal schauen...
</pre>

Nach meiner bescheidenen Meinung verhindert topeg's Vorschlag nicht die "Übersetzung" von E-Mail innerhalb von Links oder ich hab es falsch implementiert.

Ergänzung (durch Edit): meine Herangehensweise besteht halt darin, die bereits durch URI::Find identifizierten Links dem Modul Email::Find erst garnicht mehr anzubieten, indem ich sie vorher temporär ersetze.
Last edited: 2010-06-01 19:06:15 +0200 (CEST)

10 print "Hallo"
20 goto 10

+2 replies

topeg

2010-06-01 19:13

User since
2006-07-10
2611 Artikel
BenutzerIn

user image

Hüstel:

Code (perl): (dl )

identifylinks (\$testtext,'<a href="%s" target="_blank">%s</a>','<a href="mailto:%s">%s</a>');
print "<pre>$testtext</pre>";
identifylinks_topeg (\$testtext,'<a href="%s" target="_blank">%s</a>','<a href="mailto:%s">%s</a>');
print "<pre>$testtext</pre>";

Kein Wunder das meines "nicht funktioniert" wenn du schon den bearbeiteten String noch einmal durchläufst!
mach mal daraus:

Code (perl): (dl )

my $txt=$testtext;
identifylinks (\$txt,'<a href="%s" target="_blank">%s</a>','<a href="mailto:%s">%s</a>');
print "<pre>$txt</pre>";

my $txt_topeg=$testtext;
identifylinks_topeg (\$txt_topeg,'<a href="%s" target="_blank">%s</a>','<a href="mailto:%s">%s</a>');
print "<pre>$txt_topeg</pre>";

bianca

2010-06-01 19:22

User since
2009-09-13
7016 Artikel
BenutzerIn

Der Hammer!
Tut mir leid, topeg, war keine Absicht!
10 print "Hallo"
20 goto 10

+4 replies

topeg

2010-06-01 20:20

User since
2006-07-10
2611 Artikel
BenutzerIn

user image

2010-06-01T17:04:17 bianca

Ich habe parallel auch mal gebastelt

Code (perl): (dl )

#--------#
sub identifylinks {
        #
        # Erkennt und markiert Hyperlinks in einem Text
        #
        # Aufruf:
        # =======
        # my $testtext = 'test: http://www.test.de';
        # identifylinks (\$testtext,'<a href="%s" target="_blank">%s</a>','<a href="mailto:%s">%s</a>');
        # print $testtext;
        #
        my $text = $_[0];
        my $link = $_[1];
        my $email_link = (defined $_[2] ? $_[2] : '');
        my $modul = 1;
        eval "use URI::Find; 1;" or $modul = 0;
        my (%uris,%zuordnung);
        my $erkennung = 1;
        while ($$text =~ m/\|{$erkennung,$erkennung}/) {                                                                                                                        # eindeutigen temporären Ersetzungsstring finden
                $erkennung ++;
        }
        if ($modul) {
                my $lfd_uri = 0;
                my $finder = URI::Find -> new (
                        sub {                                                                                                                                                                                           # URI und geschriebenen Link speichern
                                $lfd_uri ++;
                                $uris{$lfd_uri} = $_[0];
                                $lfd_uri ++;
                                $uris{$lfd_uri} = $_[1];
                                return sprintf ($link,@_);
                        }
                );
                $finder -> find ($text);
        }

        my $ersatz = 0;
        if (keys %uris) {                                                                                                                                                                                       # alle URI's verbergen vor E-Mail Erkennung
                $ersatz = 1;
                foreach my $lfd_uri (keys %uris) {
                        my $ersatz = '|' x $erkennung . $lfd_uri . '|' x $erkennung;
                        $$text =~ s/\Q$uris{$lfd_uri}/$ersatz/g;
                }
        }

        if ($email_link ne '') {                                                                                                                                                                        # E-Mail auch erwünscht?
                eval "use Email::Find; 1;" or $modul = 0;
                if ($modul) {
                        my $finder = Email::Find -> new (
                                sub { return sprintf ($email_link,$_[0] -> format,$_[1]); }
                        );
                        $finder -> find ($text);
                }
        }
        if ($ersatz) {                                                                                                                                                                                          # alle verborgenen URI's wieder hervorholen
                foreach my $lfd_uri (keys %uris) {
                        my $ersatz = '|' x $erkennung . $lfd_uri . '|' x $erkennung;
                        $$text =~ s/\Q$ersatz/$uris{$lfd_uri}/g;
                }
        }
}
#--------#

Nun ein wenig kompliziert heschrieben. Macht das selbe ist aber etwas einfacher:

Code (perl): (dl )

#--------#
sub identifylinks {
  #
  # Erkennt und markiert Hyperlinks in einem Text
  #
  # Aufruf:
  # =======
  # my $testtext = 'test: http://www.test.de';
  # identifylinks (\$testtext,'<a href="%s" target="_blank">%s</a>','<a href="mailto:%s">%s</a>');
  # print $testtext;
  #
  my $text = $_[0];
  my $link = $_[1];
  my $email_link = (defined $_[2] ? $_[2] : '');

  my %uris;

  # eindeutigen temporären Ersetzungsstring finden
  my $kennung = 'X';
  $kennung+=chr(int(65+rand(25))) while (index($kennung,$$text)>-1);

  my $uri_mod=eval "use URI::Find; 1;" || 0;
  my $mail_mod=0;
  $mail_mod=1 if($email_link ne '' && eval "use Email::Find; 1;");

  if ($uri_mod)
  {
    my $lfd_uri = 0;
    my $finder = URI::Find -> new (
      sub {
        # URI und geschriebenen Link speichern
        if($mail_mod)
        {
          my $origin=shift;
          my $text=shift;
          my $symbol_o=sprintf('%s%u',$kennung,++$lfd_uri);
          my $symbol_t=sprintf('%s%u',$kennung,++$lfd_uri);
          $uris{$symbol_o}=$origin;
          $uris{$symbol_t}=$text;
          return sprintf ($link,$symbol_o,$symbol_t);
        }
        else
        { return sprintf ($link,@_); }
      }
    );
    $finder -> find ($text);
  }


  # E-Mail auch erwünscht?
  if ($mail_mod)
  {
    my $finder = Email::Find -> new (
        sub { return sprintf ($email_link,$_[0] -> format,$_[1]); }
    );
    $finder -> find ($text);

    $$text=~s/$_/$uris{$_}/g for(keys(%uris));
  }
}
#--------#

+3 replies
bianca

2010-06-02 08:08

User since
2009-09-13
7016 Artikel
BenutzerIn

2010-06-01T18:20:55 topeg
Nun ein wenig kompliziert heschrieben. Macht das selbe ist aber etwas einfacher:

Ja, bei mir ist das immer noch sehr optimierungsbedürftig :)

Nun hast Du diese Lösung hier und oben die "kurze".
Macht diese hier etwas anderes oder besser als die obige Kurze?
Oder ging es hier eher um den Lerneffekt, meinen Denkansatz kürzer zu machen?
10 print "Hallo"
20 goto 10
- +2 replies
- topeg
  
  2010-06-02 15:43
  User since
  2006-07-10
  2611 Artikel
  BenutzerIn
  Der schnellste Code ist der in der Antwort auf pq. Das ist auch der den man verwenden sollte, denke ich.
  
  Nur hat man nicht immer solche Möglichkeiten mit den Modulen. darum sind auch die anderen Varianten sicher ganz interessant zu lesen.
  
  Die Letzte war als Vergleich zu deinem Code gedacht.
  Sie macht insofern etwas anderes, als sein anderes Symbol nutzt als deine Variante, sie nicht nachträglich ersetzt sondern direkt beim Suchen wenn es nötig ist und dazu nicht so viele Iterationen über den String macht.
  
  Sie ist leichter zu lesen, schneller, kürzer und "hübscher". :-)
  
  Wobei mir in Zeile 56 auffällt:
  
  Code (perl): (dl )
  
  $$text=~s/$_/$uris{$_}/g for(keys(%uris));
  
  Das geht besser:
  
  Code (perl): (dl )
  
  $$text=~s/($kennung\d+)/$uris{$1}/g;
  
  Last edited: 2010-06-02 15:47:19 +0200 (CEST)
  - bianca
    
    2010-06-02 16:07
    
    User since
    2009-09-13
    7016 Artikel
    BenutzerIn
    
    OK, danke Dir vielmals.
    10 print "Hallo"
    20 goto 10

+3 replies
GwenDragon

2010-06-02 10:33

User since
2005-01-17
14748 Artikel
Admin1

Es sollen keine Test-URL verwendet werden, die einen existenten Domainnamen beinhalten!
Dafür gibt es example.com, example.org, example.local, example.localdomain.
die Drachin Gwen

Meine Perl-Artikel · perldev – verschiedene Perl-Versionen unter Windows starten
- +2 replies
- Gast ҉
  
  2010-06-02 11:34
  
  Korrekt ist: example.com, example.org, example.net, example.local, example.localdomain sind existente Domains. Die ersten drei dürfen für Dokumentationszwecke benutzt werden. Die letzten beiden sind genauso schlecht wie öffentliche TLD (von ICANN, OpenNIC etc.) wie das besagte test.de.
  
  Garantiert nichtexistent sind Domains der TLD .invalid.
  
  Siehe bitte http://tools.ietf.org/html/rfc2606
  Last edited: 2010-06-02 11:37:34 +0200 (CEST)
  - GwenDragon
    
    2010-06-02 11:51
    
    User since
    2005-01-17
    14748 Artikel
    Admin1
    
    .local bezieht sich auf per Multicast-DNS (Bonjour) vergebene Rechnernamen.
    .localdomain auf den lokalen Rechner.
    
    Denke ich.
    die Drachin Gwen
    
    Meine Perl-Artikel · perldev – verschiedene Perl-Versionen unter Windows starten

View all threads created 2010-06-01 16:22.