Un web crawler en perl

[vodevil]

Bonjour j'ai récupérer sur le net un crawler en perl , il marche parfaitement si ce n'est qu'il produit des doublons dans la array @links , j'ai bien tenté d'arranger sa e utilisant un hash mais rien a faire je n'y arrive pas , il me faut l'aide plus fort que moi en perl pour régler ce problème merci , d'avance pout tout coup de main ou idée

#!/usr/bin/perl -w
use strict;
use warnings;

my $VERSION = "Bot/1.01";

use LWP::UserAgent;
use HTML::LinkExtor;
use URI::URL;

$| = 1;

sub spider (%);

spider URL => '$url';

sub spider (%) {
	my %args = @_;

	my @startlinks = ("http://www.free.fr");

	push(@startlinks, $args{URL});

	my $ua = LWP::UserAgent->new;
	
         $ua->agent('Mozilla/5.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 : "";
           	  }
         	)
	}
}

le problème vient de la

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 tenter de supprimé les doublons de $link et @links grace a des codes comme celui ci notament

    my %h_unique; 
    foreach my $ligne ( @links ) 
    { 
    $h_unique{$ligne} = undef; 
    } 
    @links = keys %h_unique;

 

[rebirth]

Si les doublons sont contenus dans @links (j'ai pas le temps de lire tout ton code)

Globalement :

undef %hash_table;
$hash_table{@links} = ();
@links = keys %hash_table;

 

[rebirth]

Ou sinon modifies le code pour utiliser une table de hash directement, ca risque d'etre plus optimal....

La methode donnee prend la taille de ton tableau, plus une table de hash, pour revenir vers tableau.....

 

[vodevil]

Ben en fait j'ai carrément fait une coupe dans le soft comme un barbare en utilisant Xurl pour extraire les url ! Il fonctionne parfaitement mais n'est pas redondant il ne suis pas les urls comme la version précédente mais je vais trouver , bien sur la présente version ne produit pas de doublon.

#!/usr/bin/perl -w
use strict;
use carp;
use LWP::UserAgent;
use URI::URL;
use HTML::Parse qw(parse_html);


# Ecriture du log d'erreur
BEGIN {
use CGI::Carp qw(carpout);
open(LOG, ">>/log_erreur.txt") or die "Impossible d'ouvrir : $!\n";
carpout(*LOG);
}


my $VERSION = "Bot/1.01";


$| = 1;


sub spider (%);

spider URL => '$url';

sub spider (%) {
	my %args = @_;

	my @startlinks = ("http://www.free.fr");
	
	@startlinks = delete_doublon(@startlinks); 
    
	push(@startlinks, $args{URL});
    
    # Call Lwp method
	my $ua = LWP::UserAgent->new;
           
     $ua->agent('Mozilla/5.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";
      	  
      	  #------------------------------------------------#
      	  # Nettoyage de $link et suppréssion des doublons #
      	  #------------------------------------------------#
      	  
 
     	  my @links = $link;
     	   
     	  @links = delete_doublon(@links); 
     	 
     	  @links = grep { $_ ne "\$url" } @links;
      	 
      	  @links = explore(@links);
      	  
      	      print "$_\n" foreach @links;
      	  
      	  #--------------------------------------------------------------------------------  
      	  
      	  #------------------------------------------------#
      	  #      Exploration des liens (sans doublon)  :)  #
      	  #------------------------------------------------#
      	  
                sub explore
                {
                my $ua = new LWP::UserAgent;
                $ua->agent('Mozilla/5.0 (compatible;)');
                my($url, %saw, @urls);

                foreach $url ( @_ ) {
                my $res = $ua->request(HTTP::Request->new(GET => $url));
=pod
                    unless ($res->is_success) {
	                warn "$0: Bad URL: $url\n";
	                next;
                    }
=cut
                    my $ht_tree = parse_html($res->content);
                    my $base = $res->base;
                    my($linkpair, $fqurl);
                    foreach $linkpair (@{$ht_tree->extract_links(qw<a img>)}) {
                        my($link,$elem) = @$linkpair;
                        push(@urls, $fqurl)
	                     unless $saw{ $fqurl = url($link,$base)->abs->as_string }++;
                    }
                }                

=pod
                 push @urls, print join("\n", @urls), "\n";
                 push @urls, return @urls;       
                 use next line for uniq and sorted urls
                 print join("\n", sort keys %saw), "\n";
=cut
                
                push @urls, return sort keys %saw;

              }
      	  
      	  
      	        	  
      	  #--------------------------------------------------------------------------------  
      	  

  }
}


sub delete_doublon
{
  @_ = grep { defined } @_;
  my %h_unique; 
   foreach my $ligne ( @_ ) 
   { 
    $h_unique{$ligne} = undef; 
   } 
   @_ = keys %h_unique;
   push @_, return grep { defined } @_;
}

[/code]