Parcourir le web

Version imprimable

03/09/2005, 13h19
scaleo

Parcourir le web

Bonjour dans le cadre d'un projet d'entreprise je doit mettre au point sur crawler en perl 8O , j'ai donc appris ce language mais je ne sais pas comment extraire des url avec LWP. Le crawler doit supporté les pragma de LWP, j'ai aussi tenter de comprendre comment marche WWW::Mechanize qui parait interessant mais j'ai pas compris comment faire un crawler extracteur d'url avec.

Pourriez vous m'aider ?
03/09/2005, 14h26
scaleo

J'ai relue les doc de WWW::Mechanize et LWP

Les modules qu'ils me faut sont :

LWP::Parallel::UserAgent
LWP::Parallel::RobotUA et WWW::RobotRules::AnyDBM_File pour faire un cache

Mon choix est il le bon ? :D

Pourquoi personne répond :piou:

Heu voici un bout de notre cahier des charges que j'ai un peu arrangé

Citation:

-> Gestion de plusieurs centaines de connections en parallèle
-> Capacité a faire plusieurs requetes en parallèle
-> Programmation en perl ou l'etendue des librairies disponible
-> Prise en charge des fichiers robots.txt
-> Capacité de plusieurs milliers de page par jour voir plus
-> Doit pouvoir fonctionner sur plusieurs pc en même temps
-> Echange de donnés entre les différent robot pour empécher les doublons

Je sais que tout sa est possible mais je bute sur le crawler

Petit détail tout les pc tourne sous Windows server 2003 x64

---------

Cher moi même j'ai trouvé sur ce forum ce crwler qui marche très bien mais néçéssite des amélioratiosn

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 = "0.8"; 
 
use LWP::UserAgent; 
use HTML::LinkExtor; 
use URI::URL; 
 
$| = 1; 
 
sub spider (%); 
 
spider URL => '$url'; 
 
sub spider (%) { 
   my %args = @_; 
 
   my @startlinks = ("http://clubic.com"); 
 
   push(@startlinks, $args{URL}); 
 
   my $ua = LWP::UserAgent->new; 
 
         $ua->agent('Mozilla/4.0 (compatible)'); 
 
   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 : ""; 
                } 
            ) 
   } 
}

03/09/2005, 15h39
Jedai

Citation:

Envoyé par scaleo

Pourquoi personne répond :piou:

Houla... Un peu de patience : tu n'as pas dix programmeurs Perl en permanence pour te répondre dans les trois minutes sur ce forum, surtout le samedi midi, avec moins de deux heures entre les messages !!!! :evil:

Citation:

Envoyé par scaleo

Heu voici un bout de notre cahier des charges que j'ai un peu arrangé

Citation:

-> Gestion de plusieurs centaines de connections en parallèle
-> Capacité a faire plusieurs requetes en parallèle
-> Programmation en perl ou l'etendue des librairies disponible
-> Prise en charge des fichiers robots.txt
-> Capacité de plusieurs milliers de page par jour voir plus
-> Doit pouvoir fonctionner sur plusieurs pc en même temps
-> Echange de donnés entre les différent robot pour empécher les doublons

Je sais que tout sa est possible mais je bute sur le crawler

Petit détail tout les pc tourne sous Windows server 2003 x64

Ok, tout cela est largement faisable, néanmoins, j'aimerais avoir quelques détails sur le but de l'entreprise (donc les données à stocker : l'intégralité de la page Web ?) ? La capacité du réseau entre les différents PC ?

Je pense que le mieux est que tu nous donnes ces différents détails. Je peux déjà te dire que pour ma part je pencherais plutôt pour un traitement centralisé des visites (autrement dit un script qui affecte leur tâches aux crawlers et récupère les nouvelles adresse à visiter et les trie)

--
Jedaï

Le but du spider est de stocker le contenue des pages Web , pour arriver a faire un ti moteur de recherche genre Google extra light lol ! En fait le but premier est de proposer un moteur de recherche d'articles scientifique et un moteur pour les universités (Renater en france).

la capacité du réseaux entre les différents pc est de 4Gb et ont a 15 pc Bi-p4 3.2Ghz.

En ce moment je teste un peu LWP::Parallel::UserAgent

J'ai fait cela pour l'instant et sa marche :D

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
require LWP::Parallel::UserAgent;
use HTTP::Request;
use HTTP::Response;
$ua = LWP::Parallel::UserAgent->new();
$ua->max_hosts(200); # sets maximum number of locations accessed in parallel
$ua->max_req  (200); # sets maximum number of parallel requests per host
 
      $links = "http://www.free.fr";
      my $request = HTTP::Request->new('GET', $links);
 
 
 
my $res = $ua->request($request, $arg, 4096);
 
if ($res->is_success)
{
my $code = $res->content;
print $code;
 
}

Je vais essayer de cabler le robot que j'ai trouvé avec

Bon voila j'ai testé mon cablage et ben il marche pas :?

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
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
#!/usr/bin/perl -w
use strict;
use warnings;
 
my $VERSION = "Bot/0.01";
 
#use LWP::UserAgent;
use HTML::LinkExtor;
use URI::URL;
require LWP::Parallel::UserAgent;
use HTTP::Request;
use HTTP::Response;
 
$| = 1;
 
my $ua = LWP::Parallel::UserAgent->new('Mozilla/5.0 (compatible; Bot/0.01');
$ua->max_hosts(200); # sets maximum number of locations accessed in parallel
$ua->max_req(200);   # sets maximum number of parallel requests per host
$ua->wait(0);
 
my $arg;
 
 
my @startlinks = ("http://www.wanadoo.fr");
 
 
 
 
 
 
 
sub spider (%);
 
spider URL => '$url';
 
sub spider (%) {
        my %args = @_;
 
 
 
        push(@startlinks, $args{URL});
 
 
 
        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";        
 
 
                # Mon dieux c moche mais sa marche :) ?
 
 
                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 $request = HTTP::Response->new('GET', $link);
                       my $res = $ua->request($request, $arg, 4096);
 
                       $res->content_type eq "text/html" ? $res->content : "";
 
 
                 )
         }
    }
 
}

C'est bon pourtant :?: :idea: perl me sort

Citation:

syntax error at Untitled.pl line 77, near "}
"

syntax error at Untitled.pl line 80, near "}"

Untitled.pl had compilation erros

Citation:

C'est bon pourtant perl me sort

Si Perl dit que c'est pas bon, c'est pas bon !! En l'occurence tu avais simplement interverti une parenthèse et une accolade... évidemment je te laisse imaginer les conséquences ! A moins que tu ne les imagines pas ? Quelle est ton niveau d'expérience en Perl ? Quel est le style d'entreprise pour lequel tu travailles (je ne te demande pas de nom évidemment) ?

Voilà le code corrigé (et réindenté par perltidy), je ne dis pas qu'il marche, mais au moins il compile :

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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
 
#!/usr/bin/perl -w
use strict;
use warnings;
 
my $VERSION = "Bot/0.01";
 
#use LWP::UserAgent;
use HTML::LinkExtor;
use URI::URL;
require LWP::Parallel::UserAgent;
use HTTP::Request;
use HTTP::Response;
 
$| = 1;
 
my $ua = LWP::Parallel::UserAgent->new('Mozilla/5.0 (compatible; Bot/0.01');
$ua->max_hosts(200);    # sets maximum number of locations accessed in parallel
$ua->max_req(200);      # sets maximum number of parallel requests per host
$ua->wait(0);
 
my $arg;
 
my @startlinks = ("http://www.wanadoo.fr");
 
sub spider (%);
 
spider URL => '$url';
 
sub spider (%) {
    my %args = @_;
 
    push( @startlinks, $args{URL} );
 
  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";
 
        # Mon dieux c moche mais sa marche :) ?
 
        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 $request = HTTP::Response->new( 'GET', $link );
                my $res = $ua->request( $request, $arg, 4096 );
 
                $res->content_type eq "text/html" ? $res->content : "";
              }
 
          );
    }
}

--
Jedaï

03/09/2005, 17h29
Jedai

Par ailleurs, après avoir jeté un coup d'oeil au code de ce crawler, je ne pense pas que ce soit une bonne idée de se baser dessus : il n'est pas adapté à ta solution, et en plus il utilise des techniques très mauvaises pour gérer les doublons.

Essaie plutôt de dessiner un schéma : tu as besoin d'un "manager" qui gère les doublons et qui coordonne les scripts "crawler" proprement dit, de plus il faut que ces "crawlers" soient spécialement écrits pour profiter de LWP::Parallel::UserAgent, ce qui n'est pas le cas du crawler dont tu reprends le code (du coup c'est probablement encore plus lent que normalement, si ça marche !).
Réfléchis à tout ça à tête reposée, si tu veux je peux t'aider pas mal, mais essaie d'en faire un maximum avant.

--
Jedaï
04/09/2005, 02h10
scaleo

Citation:

Quelle est ton niveau d'expérience en Perl ? Quel est le style d'entreprise pour lequel tu travailles (je ne te demande pas de nom évidemment) ?

Ben disont que perl j'ai appris sur le tas et a coup de bouquins le tout très rapidement , je sais manipuler les fonctions mathématique , hash etc.. mais je n'est pas encore assez d'expérience pour que la logique de programmation perl soit simple

Pour la boite ben ont créer des softs sur mesure , ont est une toute petite boite (20) :D .

Citation:

techniques très mauvaises pour gérer les doublons

sa par contre j'ai remarqué ce spider est horrible il oblige a utiliser de nombreux sous prog qui sont inutile puique LWP offre des pragma adapté :wink: .

Citation:

plus il faut que ces "crawlers" soient spécialement écrits pour profiter de LWP::Parallel::UserAgent,

C'est la justement mon probleme je ne sais pas par ou commancer :?

Citation:

Réfléchis à tout ça à tête reposée, si tu veux je peux t'aider pas mal, mais essaie d'en faire un maximum avant

Ok :wink:
04/09/2005, 15h15
scaleo

Donc voila j'écoute tes conseil maitre (dark vador n'est pas loin lol), j'ai fait un schéma du foncionnement du robot que voici :

http://dirthangel.free.fr/mcd.png

Qu'en pense tu ?

Pour moi la difficulté est dans le système pour robots.txt , il faudrais faire un genre de cache je pense pour éviter que pour chaque domaine ben lwp ne lance une nouvelle requete sur robots.txt.

Le trie des fichiers par mime , si le bot est bien codé c'est lwp qui le fait :) lors du "get"

Citation:

$ua->default_headers(
'Accept' => [
qw(
text/html application/xhtml+xml application/msexcel
application/msword application/pdf application/rtf
application/x-javascript application/x-httpd-php
image/gif image/jpeg image/png text/rtf text/nux
application/sxc application/sxw application/sxd
application/mdi application/x-httpd-asp
application/x-httpd-aspx application/x-httpd-mspx
application/x-httpd-cfm application/x-httpd-jthl
application/x-httpd-pm )
]
);

le filtrage par extension peut être fait par un trie.

Mon raisonnement te parait il bon ? :D

Les modules a utlisé sont donc :

Les modules qu'il faut sont :

Citation:

WWW::RobotRules (faudrais faire un cache pour eviter le redondance)
use HTTP::Response
use HTTP::Request
LWP::Parallel::UserAgent
URI::URL
HTML::LinkExtor
04/09/2005, 15h37
Jedai

Tu dois coordonner plusieurs robots, et éviter toute redondance, le plus simple est donc de faire un programme contrôleur à part, qui discute avec les divers robots par l'intermédiaire de sockets et centralise les informations : c'est lui qui contient la banque de donnée WWW::RobotRules, c'est lui qui contient un Trie (il y a des modules pour ça sur le CPAN) contenant les URL déjà visités (et un pour ceux qui sont en instance d'être visités), c'est lui qui dit aux robots quels URLs ils doivent maintenant visiter. Les robots se contentent d'exécuter les ordres du contrôleurs, de transmettre le contenu de leur recherche et c'est tout.

--
Jedaï
04/09/2005, 16h21
scaleo

En clair un architecteur comme sa :

http://dirthangel.free.fr/reseaux.png

En plus ton architectur est plus claire et plus simple a géré tu feras un sacré ingénieur :wink:

Je commande aussi quelque bouquins sur perl et réseaux :wink: pk je sens que j'en aurais besoin

M'empeche ce serait pas mal ce truc en OpenSouce ?

Citation:

Procédure pour parser de robots.txt

-> Ont parse chaque url jusqu'au dernier tld et ont ajoute /robots.txt
-> Ont fait un get
-> Si réponse est is_success ont parse le fichier
|->

-> Sinon ont continue a spider le site
04/09/2005, 16h25
Jedai

Tout à fait, avec le contrôleur tournant sur l'ordinateur central (le hub n'est pas important tant qu'il fonctionne bien).

--
Jedaï

Je poursuit mon expérience du perl et je n'est qu'une chose a dire j'aime :D .

Voici mon serveur socket il ne peut gérer qu'une connection a la fois

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
#!/usr/bin/perl
use Socket;
 
$| = 1;
 
#Message qui sera envoyé a la machine.
$ligne = ("");                             # mettre ici un message pour confirmé la co 
 
#Définition d'un port de départ pour la recherche.
$port = 2000;
 
#Recherche d'un port libre.
while ( getservbyport( $port, "tcp" ) ) {
    $port++;
}
 
#Le port a été trouve, Son numéro est maintenant dans le scalaire $port.
#On traduit le nom du protocole en son numéro.
$numero = getprotobyname("tcp");
 
#On crée la variable de fichier SERVEUR attachée au protocole.
socket( SERVEUR, PF_INET, SOCK_STREAM, $numero )
  or die("Pas moyen de creer de socket.\n");
 
#On associe la variable de fichier SERVEUR a notre machine
bind( SERVEUR, sockaddr_in( $port, INADDR_ANY ) )
  or die("Impossible de lier le port $port\n");
 
#On écoute la prise ainsi validée.
#Seul un process peut se mettre en file d'attente.
listen( SERVEUR, 1 ) or die("Impossible d'ecouter.\n");
print("Le serveur ecoute sur le port $port..\n");
print("Attente de connection.\n");
 
#On attend qu'un client se connecte.
#Une nouvelle variable de fichier (CLIENT) est alors créé.
( $client = accept( CLIENT, SERVEUR ) ) or die("L'acceptation a echoue.\n");
( $port, @ip ) = unpack_sockaddr_in $client;
print "Connection acceptee de", inet_ntoa(@ip), ":$port\n";
print("Envoi du message\n");
 
#On envoie la chîine de caractères au client.
print CLIENT ("$ligne");
print("Fermeture de la connection.\n");
 
 
 
#On ferme tout.
#close(CLIENT);
#close(SERVEUR);

Mon client

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
#!/usr/bin/perl
use Socket;
$| = 1;
 
#Définition d'un port de départ pour la recherche.
$port = 2000;
 
#Recherche d'un port libre.
while ( getservbyport( $port, "tcp" ) ) {
    $port++;
}
 
#Le port a été trouve, Son numéro est maintenant dans le scalaire $port.
#On traduit le nom du protocole serveur en son numéro.
$numero = getprotobyname("tcp");
 
#On traduit le nom de la machine serveur en son adresse (packee).
$serveur = gethostbyname("robot");
socket( CLIENT, PF_INET, SOCK_STREAM, $numero )
  or die("Pas moyen de creer de socket.\n");
print "connecting to ", inet_ntoa($serveur), ":$port.. ";
 
#On crée la variable de fichier CLIENT attachée au protocole.
connect( CLIENT, sockaddr_in( $port, $serveur ) )
  or die("Connection impossible.\n");
print("Connection etablie.\n\n");
 
#On récupère l'information qui arrive sur la ligne :)
$ligne =;
 
 
 
 
# Mettre ici un post traitement de $ligne
 
 
 
 
#On l'imprime.
#print("Information recue : '$ligne'\n");
#close(CLIENT);

Qu'en pense tu ?

Le client a un bug :!: :?: :?: :?: :?:

05/09/2005, 18h20
cryptorchild

Wahou il y a du niveau dans ce thread , c'est trop complexe pour moi en tout cas je vous souhaite bonne chance et c'est vraie ce serais pas mal en OpenSource !

Suggestion subliminale (Demande a ton patron pour l'OpenSource) :D

Heu ouais j'en est déjà parlé au patron il a dit il vas réfléchire , donc Wait and See.

Bon voila comment j'ai cablé www::robotrules
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 sub robot_parser { foreach my $url ( @_ ) { # Make new WWW::RobotRules object my $rules = WWW::RobotRules->new('Mozilla/5.0 (compatible; Robot-ext/0.9'); { my $url = "$url./robots.txt"; my $robots_txt = get $url; $rules->parse( $url, $robots_txt ) if defined $robots_txt; } if ( $rules->allowed($url) ) { return 0; } else { return 1; } } }
Et un ti bout de code tout simple qui fait le total des évaluations du lien
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 sub check { foreach my $link (@_) { my $robots = robot_parser($link); if ( $robots == 1 ) { my $robots = 0; } else { my $robots = 1; } my $bannished = bann($link); if ( $bannished == 1 ) { my $ban = 0; } else { my $ban = 1; } my $total = $robots + $ban; return $total; # If $total >= 1 we ignore the link } }
Citation:

Un Trie est un arbre de lettres, on peut ranger des mots à l'intérieur, et vérifier ensuite si un mot y a été inséré. Il n'y a pas plus rapide théoriquement pour cette vérification. Evidemment un Trie fait sous Perl n'est pas extraordinairement performant, mais pour te donner une idée ma propre implémentation qui est juste un premier jet fait à l'occasion d'un Projet TIPE a des performances telles que l'insertion de 20000 mots de longueurs variées (mais représentative du langage naturel) prend à peine 1/4 de secondes, la recherche d'un mot se faisant en moins d'un centième de seconde, et on parle là seulement d'une implémentation en Perl non-optimisée ! Mais pour une faible quantité d'alternative comme dans ton cas, c'est sans doute redondant.

A sa Jedai sa m'intéresse , parce que les crawler vont ignorer certain sites et ce a partir d'une liste de sites bannies , liste récupérer sur l'excellent SpyBot S&D , donc fait péter l'algo :D

Bon je vous présente mon spider , le code me parait bon , a mon EDI perl aussi mais il ne marche pas :? et perl ne me renvoie aucune erreur :twisted:

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
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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
#!/usr/bin/perl -w
use strict;
use CGI::Carp;
use URI::URL;
use HTTP::Request;
use HTTP::Response;
use HTTP::Cookies;
require LWP::Parallel::UserAgent;
use POSIX;
use HTTP::Size;
use HTML::Parse;
use HTML::Element;
 
#===========================================================================#
#                          Begin of configuration                           #
#===========================================================================#
 
$| = 1;
my $arg;
my $VERSION = "Bot/1.1";
 
 
 
 
my $ua = LWP::Parallel::UserAgent->new('Mozilla/5.0 (compatible; Bot/1.1');
   $ua->max_hosts(200); # sets maximum number of locations accessed in parallel
   $ua->max_req(200);   # sets maximum number of parallel requests per host
   $ua->wait(0);
 
   $ua->max_redirect(8000000000);
   $ua->protocols_allowed( [ 'http' ] );
   $ua->protocols_forbidden( [ 'file', 'mailto', 'https', 'ftp', 'socks', 'gopher'] );
   $ua->requests_redirectable( [ 'HEAD' ] );
   $ua->timeout(4);
   $ua->env_proxy;
   $ua->redirect(1);
 
   my $cookie_jar = HTTP::Cookies->new(
    file => 'lwp_cookies.dat',
    autosave => 1,
  );
 
   $ua->cookie_jar($cookie_jar);
 
 
 
 
#===========================================================================#
#                               The Robot                                   #
#===========================================================================#
 
my %urls;
 
@urls{ @ARGV } = (1) x @ARGV;
 
 
sub robot
{
 
 foreach my $link ( @_ ) {
 
  my $req = HTTP::Request->new(GET => '$link');
 
     $req->header('Accept' => [
                     qw(
                      text/html application/xhtml+xml application/msexcel
                      application/msword application/pdf application/rtf
                      application/x-javascript application/x-httpd-php
                      text/rtf text/nux application/sxc application/sxw
                      application/sxd application/mdi application/x-httpd-asp
                      application/x-httpd-aspx application/x-httpd-mspx
                      application/x-httpd-cfm application/x-httpd-jthml
                      application/x-httpd-pm )
 
    ]
);
 
 
 
 
 my $res = $ua->request($req, $arg, 4096);
 
 
 
 if ($res->is_success) {
 
 
 
 
 
 
     my $verif = "1";
 
     if ($verif == 1) {
 
     my ($code, $date, $size, %page);
 
     $code = $res->content;
 
     $date = date();
 
     $size = $res->content_length;
 
     $size = size($size);
 
     %page = (
 
 
            result => [
 
                         "$code", "$link",
                         "$date", "$size KB"
 
                      ]
 
 
            );
 
       extor_links($link);                                   # seng $links to HTML::LinkExtor
 
     } else {
 
      print "disallowed\n";
 
    }
 
 } else {
 
     print "Error : " . $res->status_line ."\n";
 
  }
 
}
 
 
 
#===========================================================================#
#                                Sub software                               #
#===========================================================================#
 
 
####################################
# Extract links form $link
 
sub extor_links
{
  foreach my $html ( @_ )
  {
   my $htm = "1";
   if ($htm == 1) {
    my $parsed_html = HTML::Parse::parse_html($html);
 
    for (@{ $parsed_html->extract_links( ) }) {
       my $link=$_->[0];
       my $url        = new URI::URL $link;
       my $full_url   = $url->abs($html);
       # return $full_url;
       robot($full_url);
 
      }
    }
  }
}
 
 
 
####################################
# Get date
 
sub date
{
  my @tab_date =localtime(time);
  my $jour = $tab_date[3];
  my $mois = ($tab_date[4]+1);
  my $annee =  ($tab_date[5]+1900);
  return ("$jour/$mois/$annee");
}
 
 
 
####################################
# Get size in Kb
 
sub size
{
 
 my $url = join("", @_);
 
      my $size = HTTP::Size::get_size( $url );
 
      if (defined $size)
      {
            my $result = $size/1024;
               $result = floor($result);
 
         return $result;
 
      } else {
 
         return "?";
 
      }
   }
}

Ou est le problème ? , parce que je n'arrive vraiment pas a l"identifier

10/09/2005, 03h10
scaleo

:piou: :arf: :wow: :marteau:

Code:

1
2
3
my $verif = "1";
 
     if ($verif == 1) {

:?:

Code:

1
2
3
4
 
     $size = $res->content_length;
 
     $size = size($size);

:?:

Code:

1
2
3
4
 
   my $link=$_->[0];
       my $url        = new URI::URL $link;
       my $full_url   = $url->abs($html);

:?:

:?: J'ai modif un peu le spider ( :?: ) pour voir si il marche mais il marche pas :oops:

qd il est "normal" , $verif envoir l'url sur le serveur central qui lui fait passer quelques test => robots.txt , exclusion , et déjà spider, si l'url n'est pas bonne ont renvoie 0 donc on la laisse de coté si c'est 1 alors ont continue dessus

Citation:

$size = $res->content_length;

$size = size($size);

Sa c'est pour déterminer la taille des documents

si je fait

Citation:

$size = size($res->content_lenght);

sa ne marche pas parce que j'envoie une ref de hash au prog et il aime pas
Code:

1 2 3 my $link=$_->[0]; my $url = new URI::URL $link; my $full_url = $url->abs($html);
Marche thrès bien teste avec sa
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 use HTML::Parse; use HTML::Element; use URI::URL; $u = " <html> <head> <title>44</title> </head> <body> <a href=http://wanadoo.fr>777</a> Hello!!!!!!!!! </body> </html> "; extor_links($u); sub extor_links { foreach my $html ( @_ ) { #my $htm = trie_local($html); $htm = 1; if ($htm == 1) { my $parsed_html = HTML::Parse::parse_html($html); for (@{ $parsed_html->extract_links() }) { my $link=$_->[0]; my $url = URI::URL->new($link); my $full_url = $url->abs($html); # return $full_url; # robot($full_url); print "$full_url\n"; } } } }
J'ai un autre prb , avec les socket :cry:
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 sub socket_client { my $line; foreach my $send ( @_ ) { # Get machine name my $name = gethostbyaddr ("127.0.0.1"); # Define start search port my $port = 2000; # Find free port while ( getservbyport( $port, "tcp" ) ) { $port++; } # Traduce proto name , in number my $number = getprotobyname ("tcp"); # Traduce machine name in adress my $server = gethostbyname ("$name"); socket (CLIENT, PF_INET, SOCK_STREAM, $number) or die ("Cannot create server.\n"); print "Connecting on port : $port\n"; # Make CLIENT scalar attach to proto connect (CLIENT, sockaddr_in($port, $server)) or die ("Cannot connect\n"); print "Connecting on Shunix Corporation socket\n"; # Send request print SERVER ("$send"); } }
Comme tu peut le voir j'envoie le contenue de $send au client serveur socket via la méthode print SERVER ("$send"); , jusque la tout vas bien (heu j'espère) , mon probleme est comment récupérer la réponse sur ma variable $line :?:

De plus perl me sort l'erreur

Citation:

Not enough arguments for gethostbyaddr at bot line 8, near ""127.0.01")"