Discussion :

[mih4k]

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

[Antoun]

à tester :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[mobscene]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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;
}

[Antoun]

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 !

[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