Extraction d'urls en PERL

Version imprimable

09/02/2007, 17h11
mih4k

Extraction d'urls en PERL

Hello à tous,

Je suis noveau sur le forum et encore plus dans le monde PERL. J'ai une petite tache qui ma été assigné et il faut bien avouer, je sèche un peu.
Je voudrais depuis un fichier html extraire les "href" pour ne garder que
host.domain.xx - J'ai trouvé sur un site un script bien et je l'ai qq peu modifié:
-----------------------
# exturls.pl
-----------------------

while (<>) {
$src .= $_
} ;
$_ = $src ;
while (m|href="http://(.*?)"|gs) {
my $url=$1;
print "$url\n";
} ;

-----------------------

Par exemple, si je prends la page index.html du site http://www.icq.com et que je lance la commande suivante, j'obtiens:
# perl exturls.pl index.html
[...]
games.icq.com/game.htm?code=110356410&RefId=MagicBall2_441x206
entertainment.icq.com
romance.icq.com
people.icq.com/
company.icq.com/info/advertise.html
company.icq.com/info/contact.html
company.icq.com/
company.icq.com/info/icqstory.html
www.icq.com/products/sitemap.html
www.icq.com/legal/privacy.html
www.icq.com/legal/

Je voudrais arriver à ne garder que www.icq.com ou people.icq.com et tronquer le reste de la chaine pour ensuite, ne les afficher qu'une seule fois chacune.

Auriez-vous une idée pour m'aider?

Merci par avance

M

à tester :

Code:

1
2
3
4
5
6
my %h ;
while (m|href="http://(.*?)/?"|gs) {
 my $url=$1;
 $h{$url} = 1 ;
 } 
 print join("\n", keys %h};

Une solution a base de regxp , par contre c'est lent a cause du module URI::URL un vraie escargot :?

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
#!/usr/bin/perl -w
use strict;
use diagnostics;
use URI::URL;
use Regexp::Common qw/URI/;
use Data::Dumper;
use LWP::Simple;
 
 
my %urls = ();
 
# pompe une page
my $page = get('http://www.free.fr');
 
 
 
my $links = _extract_urls($page, 'http://www.free.fr');
 print Dumper($links);
 
 
sub _extract_urls
{
  my $base = shift;
  # tableau d'urls un hash est
  # préférable pour éviter les doublons
  my %urls = ();
  # extraction des urls
  while ( $page =~ /($RE{URI}{HTTP})/gi )
  {
     # Traitement des cliens relatif
     my $uri = url($1, $base)->abs;
 
     if ( _valid_scheme($uri) )
     {
       # Ajout de l'url dans le hash
       $urls{$uri} = undef unless exists $urls{$uri};
     }
  }
 return \%urls;
}
 
 
 
 
sub _valid_scheme
{
  my $urlchk = shift;
  my $scheme = '';
  my @schema = qw (http);
  if ($urlchk =~ s/^([^:]*)://) {
    $scheme = lc($1);
  }
  if ($scheme && ! grep {$scheme eq $_} @schema) {
    print("Invalid scheme [$scheme]\n");
    return 0;
  }
 return 1;
}

10/02/2007, 13h38
Antoun

Citation:

Envoyé par mobscene

Une solution a base de regxp , par contre c'est lent a cause du module URI::URL un vraie escargot :?

m'enfin, c'est déjà une regexp et il suffit d'ajouter un / juste après l'étoile paresseuse !
12/02/2007, 19h54
Woufeil

Je pense que pour ce genre de chose, si on ne veut pas trop s'embêter, c'est de télécharger un parsuer HTML sur le CPAN. Après, niveau apprentissage, je trouve sympa d'essayer de le réaliser soit même à base de regex ;)
La solution de Antoun donc fonctionner normalement ;)