Une tite question sur Grep()

Version imprimable

11/07/2005, 03h55
bluecurve

Une tite question sur Grep()

Bonjour , j'élabore un script mais je suis bloqué car il faudrais que je supprime d'un tableau tout les doublons, il me semble qu'il existe une méthode avec Grep

Si cette méthode existe qu'elle est elle ?

Thanks
----------------------
Cpan powaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa :D
11/07/2005, 07h12
Gamdwin
Suffit d'insérer dans un autre tableau tous les éléments du premier qui n'ont pas déjà été insérés.
D'où le grep :
Code:

1 2 3 4 5 6 my @t_unique; foreach my $ligne ( @tableau_avec_doublons ) { push @t_unique, $ligne if ( not grep { $ligne } @t_unique ); } @tableau_avec_doublons = @t_unique;
Mais tu peux également utiliser un hâchage pour ce genre de tâche, un truc dans ce goût-là :
Code:

1 2 3 4 5 6 7 my %h_unique; foreach my $ligne ( @tableau_avec_doublons ) { $h_unique{$ligne} = undef; } @tableau_avec_doublons = keys %h_unique;
La seconde méthode est normalement plus performante (accès aléatoire pour le hâchage, contre accès séquentiel pour la première).
La différence peut être sensible sur de gros tableaux.
11/07/2005, 12h56
bluecurve

Oki sa marche , mais j'ai maintenant le même prb avec une variable

Citation:

$resultats

, je sais je suis chiant.
11/07/2005, 13h04
Gamdwin

Citation:

Envoyé par bluecurve

Oki sa marche , mais j'ai maintenant le même prb avec une variable

Citation:

$resultats

Tu n'es pas assez vague, pourrais-tu être moins spécifique ?

Pourrais-tu poster du code, expliquer le problème ou autre ? Parce que je ne comprends pas ce que tu veux dire

Citation:

je sais je suis chiant.

Ben non, il est là pour ça ce forum.

Ben j'ai une variable $resultats qui prend disont tout les 1s une valeur différente je voudrais garantire qu'elle n'est jamais deux fois la même valeur :D

voici le code dans sa version antérieur (vive la récup) regarde a la ligne

Citation:

print "Nouveau lien : $resultats\n";

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
#! /usr/bin/perl 
use strict; 
use threads; 
use threads::shared;
 
use LWP::Simple; 
use HTML::LinkExtor; 
 
$| = 1; 
 
 
my %urls : shared; 
@urls{ @ARGV } = (1) x @ARGV; 
my @links;
 
my @accepted_url_end : shared = qw/html htm asp pl php php\d/; 
my $sregurl : shared = join '|\.', @accepted_url_end; 
my $regurl = qr/\.$sregurl/; 
 
foreach my $resultats ( keys %urls ){  
  my $thr = threads->create( \&explore, $resultats ); 
  $thr->detach; 
} 
 
for (;;) { 
  threads->yield(); 
}
 
sub explore { 
  my $url = shift or warn "URL vide ?\n"; 
  print "Explore $url\n"; 
  my $content = get $url; 
  warn "Couldn't get $url !\n" unless defined $content; 
 
  my $p = HTML::LinkExtor->new( \&handle_links, $url ); 
  $p->parse( $content ) or warn "N'a pas pu parser $url\n"; 
 
  foreach my $resultats ( @links ) { 
    lock %urls; 
    $urls{$resultats}++; 
    if( $urls{$resultats} == 1 ) { 
      my $thr = threads->create( \&explore, $resultats ); 
       $thr->detach; 
      print "Nouveau lien : $resultats\n"; # CETTE VARIALE
    } 
  } 
 
} 
 
sub handle_links { 
  my ( $tag, %attr ) = @_; 
  return unless $attr{href} =~ m/$regurl/; 
  push @links, $attr{href}; 
}

Bon je me suis forgé sa, mais sa marhe ps :? :?: :twisted: :evil: :roll: :cry:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
my @begin = ("$resultats");
 
         my %h_unique2; 
         foreach my $ligne2 ( @begin ) 
         { 
         $h_unique2{$ligne2} = undef; 
         } 
         @begin = keys %h_unique2;
 
          foreach my $resultats (@begin) {
      	     print "Nouveau lien : $resultats\n";
      	  }

12/07/2005, 09h50
Jedai

A priori, mon code évite déjà l'écueil que tu redoutes. N'est-ce pas le cas ?
Ce code marche-t-il sur ta machine ?
Sur la mienne il crève rapidement parce que Link::Extor n'est pas thread-safe (sauf que si ça marche sur la tienne, y a quelque chose que je comprend pas bien : tu sous Linux ?).

--
Jedaï
12/07/2005, 10h12
bluecurve

Oui il marche mais il n'est pas très stable a cause des threads sans doute ?
12/07/2005, 11h35
Jedai

A priori le problème vient de LinkExtor, ou plus précisément de HTML::Parser qui en est à la base et qui semble n'être pas thread-safe... En tout cas moi je n'arrive pas à dépasser la dizaine d'URL visitée, alors que si je fais effectuer l'extraction par une petite regex (pas aussi puissante malheureusement), je n'ai plus aucun problème.
(mais il est théoriquement impossible que tu ais des répétitions dans $résultat, en as tu ?)

--
Jedaï
12/07/2005, 12h50
bluecurve

Oui j'en est eu une , et une seule !!!, mais sinon j'en est pas vue d'autres html::parser pas thread safe :? , y a t'il un module equivalent qui le soit ??

Bon la question a deux franc six sous comment sa ce fait que c'est théoriquement impossible d'avoir des doublon pk , j'ai aussi récup un autre script dans le genre et ben lui les doublons sa y vas ! lol

Pour ce qui est de ton regXp , tu pourais me passer le script mais avec lui parce qu'il est vraiment pas très stable !

Ah encore une question , ton regXp il est capable de recontruire un lien du genre ...\...\ee.gif ?

Voici l'autre script dont je te parlais dommage qui produise des doublons pk il est bien sinon juste une ou deux bricole a amliorer sinon sa vas .

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
59
60
61
62
63
64
65
66
#!/usr/bin/perl -w
use strict;
use warnings;
 
my $VERSION = "BraBot/0.1";
 
use LWP::UserAgent;
use HTML::LinkExtor;
use URI::URL;
 
$| = 1;
 
sub spider (%);
 
spider URL => '$url';
 
sub spider (%) {
	my %args = @_;
 
	my @startlinks = ("http://mansonfr.com");
 
	push(@startlinks, $args{URL});
 
	my $ua = LWP::UserAgent->new;
 
         $ua->agent('Mozilla/5.0 (compatible; BraBot/0.1)');
 
	WORKLOOP: while (my $link = shift @startlinks) {
 
		for (my $i = 0; $i< $#startlinks; $i++) {
			next WORKLOOP if $link eq $startlinks[$i];
		}
		print ">>>>> working on $link\n";
	        HTML::LinkExtor->new(
          	  sub {
			my ($t, %a) = @_;
			my @links = map { url($_, $link)->abs() }
			grep { defined } @a{qw/href img/};
 
			foreach my $start_link (@startlinks) {
				my $i = 0;
				for (0 .. $#links) {
					if ($links[$i++] eq $start_link) {
						$links[$i -1] = "'REMOVE'";
					}
				}
			}
 
			@links = sort @links;
			for (my $i = 0; $i< $#links; $i++) {
				$links[$i] = "'REMOVE'" if $links[$i] eq $links[$i +1];
			}
			@links = grep { $_ ne "'REMOVE'" } @links;
 
			print "+ $_\n" foreach @links;
 
			push @startlinks, @links if @links;
          	  } ) -> parse(
           	  do {
               		my $r = $ua->simple_request
                 	(HTTP::Request->new("GET", $link));
               		$r->content_type eq "text/html" ? $r->content : "";
           	  }
         	)
	}
}

j'ai tester sa pour supprimer les doubons dans ce robot masi rien a faire sa marche pas !:

Citation:

# La récup sa nous gagne lol
my %h_unique;
foreach my $ligne ( @links )
{
$h_unique{$ligne} = undef;
}
@links = keys %h_unique;

12/07/2005, 14h56
Jedai

Dans mon script, j'utilise un hash donc à priori pas de doublon dedans :
la valeur de chaque entrée du hash est le nombre de fois où l'on a vu cette URL, mais elle n'est traîtée que si on ne l'a vue qu'une seule fois. Le doublon que tu as vu devait être un petit peu différent.

Pour ce qui est de la regex, ce que tu indiques est retraité à l'aide du module URI, mais le problème est déjà de mettre au point une regex potable, ce qui est toujours un défi pour l'HTML... N'oublie pas que les liens ne se trouvent pas que dans les balises <a> par exemple, et que l'attribut correspondant n'est pas toujours href ! Mettre au point ce genre de balise demande surtout une solide connaissance des arcanes de HTML (si on veut être complet) et une imagination à toute épreuve (si on veut être indulgent envers les innombrables horreurs qui traînent sur le Net), donc du temps, dont je manque actuellement. (dans 5 jours j'aurais tout le temps qu'il faut)

Mais je ne suis pas sûr de comprendre ce que tu veux faire de ce script : à part pour l'entraînement, il ne sert à rien de réinventer la roue et WWW::Robot fait sûrement tout ce que tu veux et plus ! 8)

--
Jedaï
14/07/2005, 02h51
vodevil

Pour ce qui est des doublons en me basent sur le script de Jedai qui na pour moi comme seule défaut de na pas être stable (tu pourrais faire une version sans threads ??? :D ) , j'ai réusie a supprimé les doublons mais cela empéchait le script de tourner , donc j'ai bien réetudier la chose et le problème vient de l'utilisation de

Code:

HTML::LinkExtor

, pour ce qui est de la stabilité je comprend pas pour quoi le script de Jedai est instable ? alors que l'autre ne bouge pas d'un poil

Voila j'ai retrouvé l'url du site ou j'ai pris le spider

http://www.infocopter.com/perl_corner/url-spider.htm
14/07/2005, 12h07
vodevil

J'ai fait quelque essaie la meilleur solution est une bonne veille clause UNIQUE dans ta base donné :D

Moi je me sert de ce script pour en apprendre plus sur les threds , les tableau et hash notamment et aussi sur lwp parce qu'ils sont une bonne plateforme pour comprendre ce module.

Bref excellent pour l'exercice mais si tu veut te faire un bot www::robot est la solution quoi que a l'arrangeant bien comme il faut le robot de Jedai pourrais vraiment être pas mal.
14/07/2005, 12h23
bluecurve

Une clause UNIQUE dans Mysql je n'y a vais pas pensé :oops: , par contre , si tu a fait des essaies c'est que tu a mis au point un indexeur ?

Et oui le bot de Jedai serais géniale sans threads
14/07/2005, 13h06
bluecurve

Une dernière question qui me trote dans la tête , hier j'ai fait un test de déconnexio avec le robot de vodevil , j'ai lancé la bot et débranché ma freebox le robot a attendu dans les 15 secondes et c'est arreter.

Je voudrais avoir si il existe une fonction qui permettrais de mettre le script en attente , je connais la fonction sleep mais pour le reste :?

Pour ce qui est de mettre en attente un script je sais pas mais j'ai recu ton MP voici la partie du robot a recoder si le coeur tant dit

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
	        HTML::LinkExtor->new(
          	  sub {
			my ($t, %a) = @_;
 
			my @links = map { url($_, $link)->abs() }
 
			# Configure the type of links to following
			grep { defined } @a{qw/href/};
 
			foreach my $start_link (@startlinks) {
				my $i = 0;
				for (0 .. $#links) {
					if ($links[$i++] eq $start_link) {
						$links[$i -1] = "'REMOVE'";
					}
				}
			}
 
			@links = sort @links;
			for (my $i = 0; $i< $#links; $i++) {
				$links[$i] = "'REMOVE'" if $links[$i] eq $links[$i +1];
			}
			@links = grep { $_ ne "'REMOVE'" } @links;
 
                 print "$_\n" foreach @links;     # array for indexer
 
             	push @startlinks, @links if @links;
          	  } ) -> parse(
           	  do {
               		my $r = $ua->simple_request
                 	(HTTP::Request->new("GET", $link));
               		$r->content_type eq "text/html" ? $r->content : "";
           	  }
         	)

Faudrais refait mais avec des hash , j'ai déjà tenté mais echouer :oops: , si tu trouve envoie moi le bot par Mp j'ai un petit projet pour lui