Comment puis-je formater les URL correctement en Perl?

Question

J'ai un tas d'URL que je dois transformer en liens:

for my $url (@url_list) { 
    say "<a href='$url'>$url</a>"; 
} 

Y at-il un module pour faire l'URL visible plus agréable? Un peu comme ceci:

 
http://www.foo.com/ → www.foo.com 
http://www.foo.com/long_path → www.foo.com/lo… 

Je sais simple regex va probablement faire ici, mais je suis gâté par CPAN. :)

Answer 1

L'astuce est de déterminer la façon dont vous voulez jolie imprimer chaque type d'URL, donc dans ce cas, vous devez dire votre script quoi faire dans chaque cas:

use URI; 

while(<DATA>) { 
    chomp; 
    my $uri = URI->new($_); 

    my $s = $uri->scheme; 
    my $rest = do { 
     if($s =~ /(?:https?|ftp)/) { 
      $uri->host . $uri->path_query 
      } 
     elsif($s eq 'mailto') { 
      $uri->path 
      } 
     elsif(! $s) { 
      $uri 
      } 
     }; 

    print "$uri -> $rest\n"; 
    } 

__END__ 
http://www.example.com/foo/bar.html 
www.example.com/foo/bar.html 
ftp://www.example.com 
mailto:joe@example.com 
https://www.example.com/foo?a=b;c=d 
http://joe:password@www.example.com/login 

Ce produit:

http://www.example.com/foo/bar.html -> www.example.com/foo/bar.html 
www.example.com/foo/bar.html -> www.example.com/foo/bar.html 
ftp://www.example.com -> www.example.com 
mailto:joe@example.com -> joe@example.com 
https://www.example.com/foo?a=b;c=d -> www.example.com/foo?a=b;c=d 
http://joe:password@www.example.com/login -> www.example.com/login 

Si vous voulez quelque chose de différent pour une URL particulière, il vous suffit de créer une branche et d'assembler les parties souhaitées. Notez que le URI gère également les adresses URI sans nom.

Si vous ne voulez pas de longues chaînes URI pour votre jolie impression, vous pouvez jeter quelque chose comme ça pour couper la chaîne après tant de personnages:

substr($rest, 20) = '...' if length $rest > 20; 

---

est ici une solution avec given , qui est légèrement plus propre, mais aussi un peu plus laide. Ceci est la version Perl 5,010:

use 5.010; 
use URI; 

while(<DATA>) { 
    chomp; 
    my $uri = URI->new($_); 

    my $r; 
    given($uri->scheme) { 
     when(/(?:https?|ftp)/ ) { $r = $uri->host . $uri->path_query } 
     when('mailto')   { $r = $uri->path }  
     default     { $r = $uri } 
     } 


    print "$uri -> $r\n"; 
    } 

Il est plus laid parce que je dois répéter que l'affectation à $r. Perl 5.14 va corriger cela tout en laissant given avoir une valeur de retour. Puisque cette version stable est pas encore disponible, vous devez utiliser la piste 5,13 expérimentale:

use 5.013004; 
use URI; 

while(<DATA>) { 
    chomp; 
    my $uri = URI->new($_); 

    my $r = do { 
     given($uri->scheme) { 
      when(/(?:https?|ftp)/ ) { $uri->host . $uri->path_query } 
      when('mailto')   { $uri->path }   
      default     { $uri } 
      } 
     }; 

    print "$uri -> $r\n"; 
    } 

Answer 2

Essayez the URI module à partir de cpan.

Answer 3

Une partie de la joie de Perl ne se fie pas modules :) J'ai réussi la solution suivante:

#!/usr/bin/perl -w 

use strict; 

my @url_list = ("<a href=http://www.test.com>www.test.com</a>", 
       "<a href=http://www.example.com>www.example.com</a>", 
       "<a href=http://www.this.com>www.this.com</a>"); 

my ($protocol, $domain_name); 

foreach my $url (@url_list) { 
    $url =~ m|(\w+)://([^/:]+)(:\d+)?/(.*)|; 
    $protocol = $1; 
    $domain_name = $2; 
    my ($url_part, $name_part) = split(/>/, $domain_name); 
    $name_part =~ s/\<//g; 
    print $protocol, "://" ,$url_part, " -> ", $name_part , "\n"; 
} 

Ce n'est pas génial, et je me suis retrouvé avec un < parasite au nom de domaine qui a pris un substitut retirer. Pour répondre à votre question initiale, vous pouvez combiner LWP::Simple et HTML::LinkExtor pour télécharger et analyser des documents HTML à partir du Web. Combo puissant.

** Avertissement: Depuis Ruby et Python, mon Perl suce. Toutes mes excuses aux puristes pour avoir brutalisé votre langage.

Answer 4

Je ne sais pas exactement ce que vous voulez exactement. Je suppose que vous voulez supprimer http:// et avoir une URL raccourcie à afficher. Si c'est le cas, vous pouvez faire quelque chose comme:

#!/usr/bin/perl 
use strict; 
use warnings; 
use 5.10.1; 


my @url_list = ('http://www.foo.com/','http://www.foo.com/long_path'); 

for my $url (@url_list) { 
    (my $short = $url) =~ s!\w+://!!; 
    $short =~ s!/$!!; 
    $short =~ s!^(.{15}).*$!$1...!; 
    say "<a href='$url'>$short</a>"; 
} 

Sortie:

<a href='http://www.foo.com/'>www.foo.com</a> 
<a href='http://www.foo.com/long_path'>www.foo.com/lon...</a> 

Answer 5

Annexe B de RFC 2396 spécifie une expression régulière qui analyse une référence URI.Adapter qu'un peu pour obtenir ce que vous voulez:

#! /usr/bin/perl 

use warnings; 
use strict; 

use 5.10.0; # for defined-or (//) 

my $uri = qr{ 
^
    (?:([^:/?\#]+):)? # scheme = $1 
    (?://([^/?\#]*))? # authority = $2 
    ([^?\#]*)   # path = $3 
    (\?[^\#]*)?  # query = $4 
    (\#.*)?   # fragment = $5 
}x; 

Le code utilise au-dessus du /x modifier

Il indique à l'analyseur d'expression régulière ignorer la plupart des espaces qui ne sont ni backslashés, ni au sein d'une classe de caractères. Vous pouvez l'utiliser pour diviser votre expression régulière en parties (légèrement) plus lisibles. Le caractère # est également traité comme un méta-caractère introduisant un commentaire, tout comme dans le code Perl ordinaire.

mais nous voulons faire correspondre les caractères littéraux # s'ils sont présents, ce qui signifiait que j'avais besoin de les échapper avec des antislashs. Par habitude, j'ai commencé avec qr/ mais j'ai dû changer le délimiteur à cause des barres obliques dans le motif.

Quelques cas de test:

my @cases = qw(
    ftp://www.foo.com.invalid/ 
    http://www.foo.com.invalid/ 
    http://www.foo.com.invalid/long_path 
    http://www.foo.com.invalid/?query 
    http://www.foo.com.invalid?query 
    http://www.foo.com.invalid/#fragment 
    http://www.foo.com.invalid#fragment 
); 

Un peu de logique

for (@cases) { 
    my $nice; 
    if (my($scheme,$auth,$path,@rest) = /$uri/) { 
    if ($scheme eq "http" && defined $auth) { 
     if (grep defined, @rest) { 
     $nice = join "" => map $_ // "" => $auth, $path, @rest; 
     } 
     else { 
     $nice = $auth 
       . ($path eq "/" ? "" : $path); 
     } 
    } 
    else { 
     $nice = $_; 
    } 
    } 

    print "$_ → $nice\n"; 
} 

et la sortie:

ftp://www.foo.com.invalid/ → ftp://www.foo.com.invalid/ 
http://www.foo.com.invalid/ → www.foo.com.invalid 
http://www.foo.com.invalid/long_path → www.foo.com.invalid/long_path 
http://www.foo.com.invalid/?query → www.foo.com.invalid/?query 
http://www.foo.com.invalid?query → www.foo.com.invalid?query 
http://www.foo.com.invalid/#fragment → www.foo.com.invalid/#fragment 
http://www.foo.com.invalid#fragment → www.foo.com.invalid#fragment