[langage]Besoin d'aide pour debogage d'un script

**deadgod** · 14/06/2005, 00h37

Bonjour , j'ai besoin d'aide pous déboguer et ajouter quelque fonctions a ce script.

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
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
#!/usr/bin/perl -w
use strict;
use threads;
use threads::shared;
 
 
my $thr = threads->new(\&spider);
   $thr = threads->new(\&Array_Unique);
 
my $VERSION = "Dev/0.9; (http://<a href="http://www.developpez.com)";" target="_blank">www.developpez.com)";</a>
 
use LWP::UserAgent;
use HTML::LinkExtor;
use URI::URL;
 
$| = 1;
 
sub spider (%);
 
spider URL => '$url';
 
sub spider (%) {
	my %args = @_;
 
	my @startlinks : shared = ("http://www.webrankinfo.com");
 
	push(@startlinks, $args{URL});
 
 
	my $ua = LWP::UserAgent->new;
 
 
         $ua->agent('Mozilla/5.0 (compatible; Dev/0.9; +http://<a href="http://www.developpez.com)&#39;);" target="_blank">www.developpez.com)');</a>
 
	WORKLOOP: while (my $link : shared = shift @startlinks) {
 
		for (my $i : shared = 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/};
 
			# mark already spidered links for removal
			foreach my $start_link (@startlinks) {
				my $i : shared = 0;
				for (0 .. $#links) {
					if ($links[$i++] eq $start_link) {
						$links[$i -1] = "'REMOVE'";
					}
				}
			}
 
			@links = sort @links;
			for (my $i : shared = 0; $i< $#links; $i++) {
				$links[$i] = "'REMOVE'" if $links[$i] eq $links[$i +1];
			}
			@links = grep { $_ ne "'REMOVE'" } @links;
 
                  #####################################
                  #      Suppréssion des doublons     #
                  #####################################
 
                  @links = Array_Unique(@links); # Semble ne pas marcher ????
 
 
 
                  #####################################
                  #      Impréssion des résultats     #
                  #####################################
 
 
			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 : "";
           	  }
         	)
	}
}
 
 
##############################################################
# Suppréssion des doublons
##############################################################
 
     sub Array_Unique
     { 
     my %vu; 
     for my $elem( @_ ) { 
         ++$vu{$elem}; 
     } 
     (keys %vu); 
     }

Voila tout d'abord j'ai l'impréssion sur la fonction Array_Unique ne remplie pas sont role ou que je l'est mis a mauvaise endroit.

De plus je cherche depuis quasi 1 mois a ajouter cette fonction au robot

sub vide
{

my @t = (".css",".js","onclick",".ico");
{
my $temp = join "|", (map { quotemeta($_) } @t);
$temp = qr/$temp/;
@links = grep { /$temp/ } @links;
}
$, = ", ";
return @links;

}

Comme vous pouvez le voir cette fonction sert a supprimé de @links les liens pointant contenant .css ,.js, .ico, onclick, mais la encore après de nombreux essaie je ne suis arrivé a rien a part des bugs.

Enfin j'ai un souci avec cette ligne

Code :

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

if ($links[$i++] eq $start_link) {

perl me renvoie l'erreur suivante

Use of uninitialized value in string eq at bot.pl line 57

Pourtant le robot continue a fonctionner comme si de rien n'etait

:

Pouvez vous m'aider sil vous plait sa fait 30 piges que je vais d'echec en echec je sèche sur ce coup la HELP, HELP

**djibril** · 14/06/2005, 01h16

si ton script marche tres bien sans erreurs, c'est bon signe.
Il y a deux solutions :
- soit tu lui demandes à un moment donnée de comparé une case du tableau @link inexistente (ex : @link a 3 cases et tu compares la case 4($i++) )
- soit tu as initialisé $start_link ainsi : my $start_link; et donc à la premiere comparaison, il compare la case à rien d'où le message : donc met my $start_link="";

Mais c'est plus la premiere remarque car vu ton programme, y a pas de souci avec $start_link.
voilà

**Gamdwin** · 14/06/2005, 09h28

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
<snip>
 
@links = Array_Unique(@links); # Semble ne pas marcher ???? 
 
<snip>
 
sub Array_Unique
{
   my %vu;
   for my $elem( @_ ) 
   {
      ++$vu{$elem};
   }
 
   (keys %vu);
}

C'est normal que ça ne fonctionne pas, il manque un return dans ta fonction.

Code :

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

1
2
3
4
5
6
7
8
9
10
sub Array_Unique
{
   my %vu;
   for my $elem( @_ ) 
   {
      ++$vu{$elem};
   }
 
   return keys %vu;
}

**Gamdwin** · 14/06/2005, 09h48

(je fais plusieurs posts pour séparer les réponses)

De plus je cherche depuis quasi 1 mois a ajouter cette fonction au robot

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
sub vide
{
my @t = (".css",".js","onclick",".ico");
{
my $temp = join "|", (map { quotemeta($_) } @t);
$temp = qr/$temp/;
@links = grep { /$temp/ } @links;
}
$, = ", ";
return @links;
 
}

Comme vous pouvez le voir cette fonction sert a supprimé de @links les liens pointant contenant .css ,.js, .ico, onclick, mais la encore après de nombreux essaie je ne suis arrivé a rien a part des bugs.

Le souci vient de ton grep, qui ne retourne QUE les lignes contenant .js, .css, etc.
Il faut inverser la sélection.
De plus, je trouve ça moyen de modifier une variable globale et d'en faire un return ensuite.

Je te propose d'écrire ta fonction comme suit :

Code :

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

1
2
3
4
5
6
7
8
9
10
sub vide(@)
{
   my @source = @_;
   my @l_filtres = (".css",".js","onclick",".ico");
 
   my $filtre = join "|", (map { quotemeta($_) } @l_filtres);
   $filtre = qr/$filtre/;
 
   return grep { !/$filtre/ } @source;
}

J'en ai profité pour utiliser des noms de variable explicites (ça commente ton programme à peu de frais, et le rend donc plus lisible, c'est important), et j'ai ajouté la déclaration d'un paramètre.

**Gamdwin** · 14/06/2005, 10h03

Enfin j'ai un souci avec cette ligne

Code :

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

if ($links[$i++] eq $start_link) {

perl me renvoie l'erreur suivante
Citation:
Use of uninitialized value in string eq at bot.pl line 57

Pourtant le robot continue a fonctionner comme si de rien n'etait

Bon, déjà c'est crade, il faudrait indenter et aérer le code, on y verrait plus clair.
C'est très important pour arriver à décrypter un code surtout quand, a priori, celui-ci n'est pas le tien.

Code :

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

WORKLOOP: while (my $link : shared = shift @startlinks) {

Code :

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

1
2
3
         foreach my $start_link (@startlinks) {
            for (0 .. $#links) {
               if ($links[$i++] eq $start_link) {

Il faut savoir que lorsqu'on fait un "shift LISTE", on retire le premier élément de cette liste.
Le fait de continuer à utiliser cette liste sans tester s'il reste quelque chose dedans, c'est plutôt génant !

Et c'est fatalement ce qui va se passer une fois arrivé au dernier shift : @startlinks sera vide, car le dernier élément aura déjà été extrait, et $start_link sera indéfini.

**nematoad** · 14/06/2005, 14h13

Envoyé par Gamdwin

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
<snip>
 
@links = Array_Unique(@links); # Semble ne pas marcher ???? 
 
<snip>
 
sub Array_Unique
{
   my %vu;
   for my $elem( @_ ) 
   {
      ++$vu{$elem};
   }
 
   (keys %vu);
}

C'est normal que ça ne fonctionne pas, il manque un return dans ta fonction.

Faux.

Tout statement est un expression. La derniere expression executee dans un sub sera renvoyee sur la pile. Tu pourrais tester le fonctionnement avec un petit one-liner avant de tirer les conclusions hatives:

Code :

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

1
2
3
 
% perl -le 'sub x { $ENV{HOME} } print "mon home est ", x'
mon home est /home/nematoad

Le probleme est donc ailleurs :)

N

**Gamdwin** · 14/06/2005, 14h25

Envoyé par nematoad

Faux.

Tout statement est un expression. La derniere expression executee dans un sub sera renvoyee sur la pile.

Oh ?
Je ne savais pas.

**deadgod** · 14/06/2005, 20h48

Je vais tester sa de suite

**deadgod** · 14/06/2005, 20h58

Voila le robot marche très bien comme ceci

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
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
#!/usr/bin/perl -w
use strict;
use threads;
use threads::shared;
 
 
my $thr = threads->new(\&spider);
   $thr = threads->new(\&Array_Unique);
   $thr = threads->new(\&vide);
 
my $VERSION = "Dev/0.9; (http://<a href="http://www.developpez.com)";" target="_blank">www.developpez.com)";</a>
 
use LWP::UserAgent;
use HTML::LinkExtor;
use URI::URL;
 
$| = 1;
 
sub spider (%);
 
spider URL => '$url';
 
sub spider (%) {
	my %args = @_;
 
	my @startlinks : shared = ("http://developpez.com");
 
	push(@startlinks, $args{URL});
 
 
	my $ua = LWP::UserAgent->new;
 
 
         $ua->agent('Mozilla/5.0 (compatible; Dev/0.9; +http://<a href="http://www.developpez.com)&#39;);" target="_blank">www.developpez.com)');</a>
 
	WORKLOOP: while (my $link : shared = shift @startlinks) {
 
		for (my $i : shared = 0; $i< $#startlinks; $i++) {
			next WORKLOOP if $link eq $startlinks[$i];
		}   
 
             $link = empty($link);
 
      	print ">>>>> working on $link\n";
 
	        HTML::LinkExtor->new(
          	  sub {
			my ($t, %a) = @_;
			my @links = map { url($_, $link)->abs() }
			grep { defined } @a{qw/href img/};
 
			# mark already spidered links for removal
			foreach my $start_link (@startlinks) {
				my $i : shared = 0;
				for (0 .. $#links) {
					if ($links[$i++] eq $start_link) {
						$links[$i -1] = "'REMOVE'";
					}
				}
			}
 
			@links = sort @links;
			for (my $i : shared = 0; $i< $#links; $i++) {
				$links[$i] = "'REMOVE'" if $links[$i] eq $links[$i +1];
			}
			@links = grep { $_ ne "'REMOVE'" } @links;
 
 
 
                       @links = Array_Unique(@links);
 
                       @links = vide(@links); # Suppéssion des liens invalide
 
 
 
 
 
			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 : "";
           	  }
         	)
	}
}
 
 
##############################################################
# Suppréssion des doublons
##############################################################
 
     sub Array_Unique
     { 
     my %vu; 
     for my $elem( @_ ) { 
         ++$vu{$elem}; 
     } 
     (keys %vu); 
     }
 
 
 
##############################################################
#                Opérations sur les liens
##############################################################
 
 
sub vide(@) 
{
 
   my @links = @_; 
   my @l_filtres = (".css",".js","onclick",".ico","java","#","@"); 
 
   my $filtre = join "|", (map { quotemeta($_) } @l_filtres); 
   $filtre = qr/$filtre/; 
 
   return grep { !/$filtre/ } @links;
}

Par contre je n'est toujours pas trouvé de solution pour Array_Unique

**vodevil** · 16/06/2005, 01h30

Moi deadgod je trouve qu'il manque quelque chose a ton script

je m'explique tu fait appele a la foncion vide() , en fin de script avant

print "+ $_\n" foreach @links;

le problème c'est qu'il me parais logique d'appeler une fonction équivalente dans la partie qui sort

print ">>>>> working on $link\n";

**deadgod** · 17/06/2005, 07h07

J'ai remarqué que le robot ralentissait significativement au bout d'un moment

:

**nematoad** · 17/06/2005, 15h10

Il commence a swapper ?

**deadgod** · 17/06/2005, 16h55

C'est quoi swapper ?

**nematoad** · 17/06/2005, 19h02

c'est a dire qu'il prend tellement de place en RAM que tu n'en as plus en quantite suffisant, donc le systeme d'exploitation passe son temps a ecrire les debordements sur disque. Ce qui pourrait ralentir le processus.

En regardant de plus pres ton histoire de Array_Unique, tu galeres parce que tu as choisi le mauvais outil. Au lieu d'utiliser un array, utilise un hash a la place, et le probleme n'existe plus.

Quand tu recuperes les links d'une page, tu les mets dans le hash. Attention, on doit verifier que le link n'est y psa deja, sinon deux pages qu'on spider qui pointe sur une troisieme page serait suffisant pour qu'on considere qu'on la deja vu :

Code :

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

1
2
3
4
5
 
my %vu;
...
 
    exists $vu{$_} or $vu{$_} = 1 for @startlinks;

Ensuite, on choisi un link a partir du hash %vu qui vaut 1 (donc :qu'on vient d'inserer), et une fois qu'on le prend pour visiter, on l'incremente, qui aura comme objet d'eviter de le prendre une deuxieme fois

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
    my $nbre_visite;
    do {
        $nbr_visite = 0;
        while( my $start = each %vu ) {
            if $vu{$start} == 1 ) {
                ++$vu{$start};
                ++$nbre_visite;
                visite($start);
            }
        }
    } while $nbre_visite > 0;

Si on a visite au moins un link dans la liste, on reboucle pour respiderer quelque chose d'autre. Si on ne visite rien, alors on a tout visite et on sort

Dans ce context, tu n'as qu'a partager %vu entre tes threads, et tu crees floppee de threads sur la routine visite()

Remarque : c'est un peu con de spiderer des images : tu ne vas pas y trouver de liens vers d'autres pages...

N

**vodevil** · 17/06/2005, 19h14

Heu oui nematoad , le question con que je vais poser c'est comment tu met sa dans le script ?

Attention c'est très con

**deadgod** · 18/06/2005, 01h25

Oula j'ai compri comment sa marche mais pas comment l'intégrer

**Gamdwin** · 18/06/2005, 10h23

Envoyé par vodevil

Heu oui nematoad , le question con que je vais poser c'est comment tu met sa dans le script ?

AMHA, il faut refaire le script qui est trop alambiqué au départ.
On ne fait pas grand chose de bon si on n'a pas une base saine.

**deadgod** · 18/06/2005, 14h49

Envoyé par Gamdwin

Envoyé par vodevil

Heu oui nematoad , le question con que je vais poser c'est comment tu met sa dans le script ?

AMHA, il faut refaire le script qui est trop alambiqué au départ.
On ne fait pas grand chose de bon si on n'a pas une base saine.

Ouais mais sa ne m'aide pas beaucoup, je veut juste savoir comment intégré la soluce de nematoad au script c'est tout.

**Jedai** · 18/06/2005, 16h46

Voilà ce que j'ai essayé de faire, le seul problème de mon script c'est qu'il plante assez vite, mais il s'agit assez probablement d'un problème de threads, lesquels sont assez "instables" en Perl..

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
 
#! /usr/bin/perl
use strict;
#~ use warnings;
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 $link ( keys %urls ){  
  my $thr = threads->create( \&explore, $link );
  $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 $link ( @links ) {
    lock %urls;
    $urls{$link}++;
    if( $urls{$link} == 1 ) {
      my $thr = threads->create( \&explore, $link );
      $thr->detach;
      print "Nouveau lien : $link\n";
    }
  }
 
}
 
sub handle_links {
  my ( $tag, %attr ) = @_;
  return unless $attr{href} =~ m/$regurl/;
  push @links, $attr{href};
}

Au final je recommande d'oublier les threads (en tout cas sous Windows) et de procéder à une approche plus classique comme celle qui sert de base à ce script (où tu n'emploies pas du tout les threads, ou plutôt de façon erronée).

--
Jedaï

**deadgod** · 18/06/2005, 16h58

A oui les threads , ce script ne les utilise pas a la base, mais la je les est viré parce qu'ils complique les choses.

Pour l'instannt j'ai une erreur incompréhensile du moins pour moi.
J'ai voulue etoffer un peut le " filtre " pour les liens avec une liste de sites pas très recommandé récupérer dans Spybot S&D , le script suivant fonctonne très bien

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
#!/usr/bin/perl
 
&vide;
 
@links = ("http://google.fr/inex.#","www.blue-elefant.com","http://free.fr","castingsamateur.com");
 
@links = vide(@links);
 
print "@links";
 
sub vide(@)
{
  my ($fichier) = eee;
 
 
    open FICHIER, $fichier || die "Unable to open $fichier: $!"; 
    my @tab_result = <FICHIER>; 
    close FICHIER; 
    chomp @tab_result; 
 
 
   my @links = @_;
   my @E = (".css",".js","onclick",".ico","java","#","@",".exe",".zip",".rar",".tar",".tar.gz",".cue",".bin",".wmz",".js",".xml"); 
 
my @l_filtres=(@tab_result, @E);
 
my $filtre = join "|", (map { quotemeta($_) } @l_filtres); 
   $filtre = qr/$filtre/; 
 
   return grep { !/$filtre/ } @links;
}