IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Web Perl Discussion :

UN petit web crawler


Sujet :

Web Perl

  1. #1
    Membre actif Avatar de mobscene
    Profil pro
    Inscrit en
    Avril 2005
    Messages
    331
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Avril 2005
    Messages : 331
    Points : 234
    Points
    234
    Par défaut UN petit web crawler
    Heu voila je me suis fait un petit web crawler , il ne bug pas a proprement parler mais il ne renvoie aucun résultat le code est hybride de script récup sur le forum voici le "monstre" (heu monstre qui marche pas ).



    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
    #!C:/PROGRA~1/Perl/bin/perl.exe -w
    use cgi::carp;
    use strict;
    use LWP::UserAgent;
    use HTTP::Response;
    use HTTP::Request;
    use LWP::RobotUA;
    use URI;
     
    #---------------------------------------
    # Creation de l'agent
    # Create the users agent
    #---------------------------------------
    my $VERSION = "Bot/1.1 (+http://shunix.com)";
    my $ua = LWP::UserAgent->new;
       $ua->agent('Mozilla/5.0 (compatible; Bot/1.1)');
       $ua = new LWP::RobotUA('Mozilla/5.0 (compatible; Bot/1.1)', '!!!!!@free.fr');
    #---------------------------------------
    # Configuration du robot
    # Configure the robot
    #---------------------------------------
     
      $ua->protocols_allowed( ['http'] );
      $ua->timeout(4);
      $ua->requests_redirectable( ['HEAD'] );
      $ua->max_redirect(10);
      $ua->protocols_forbidden( ['mailto','https','gopher','ftp','socks','file'] );
     
    #----------------------------------------
    # Chargement des la liste des site
    # Loading site list
    #----------------------------------------
    my @url = ("http://free.fr");
         @url = allow(@url);
     
    #----------------------------------------
    # Configuration des variales
    # Configuring the variable
    #----------------------------------------
    $| = 1;
    my %urls;
    my $url = join("", @url);
     
    #----------------------------------------
    # Robot code
    # Code du robot
    #----------------------------------------
      sub explore {
      foreach $url (keys %urls)
      {
      my $base_uri = URI->new( $url );
      my $request = new HTTP::Request('GET', $url);
      my $response = $ua->request($request);
      if ($response->is_success) {
         # print $response->content; # Hear we take the good page
     
         my $link = $response->content;
         print "$link\n";
         my @links;  
            while (my $content =~ m/(?:<a [^>]+ href=|<frame [^>]+ src=) 
              (?: "((?:[^"\\]|\\")+)" ) 
                 [^>]*> 
                /xig){ 
                push @links, $1; 
             }
              @links=(@links, $link);
     
           foreach my $lien ( @links) {
           $lien = URI->new_abs( $lien, $base_uri )->as_string();
            $urls{$lien}++; 
             if( $urls{$lien} == 1 ) {
               $url = "";
               $url = $lien;
               &explore($url); # Faire du récusif a l'arrache
              print "Nouveau lien : $lien\n"; 
            } 
          }    
        } 
      }
     }
     
     
    #----------------------------------------
    # Supprésion des extentions interdites
    #----------------------------------------
     
    use Regexp::Assemble;
    { # scope pour rendre $re 'statique'
      my $re;
      sub allow
       {
        if( not $re ) {
            my $r = Regexp::Assemble->new;
            $r->add( "\\.$_\$" ) for
                qw/ htm asp aspx nux mspx cfm html xhtml jhtml php php3
                    php4 shtml jsp php4 php5 jpg jpeg png gif doc rtf pdf
                    xls pm shtm
                /;
            $re = $r->re;
        }
     
        return grep { /$re/ } @_;
      }
    }
    J'aimerais donc savoir d'ou vient mon bug parce que je ne le trouve pas du tout

    Pour ceux que sa intéresse comme web crawler super rapide il y a Larbin en C++ et www::robot mais je ne connais pas du tout ces perf , larbin lui peut ramener 5 000 000 de pages par jour sur un réseau de 2mb.

    Si quelqu'un trouve comment le compiler avec VC++ 2005 express faite moi signe
    Everybody have in their the potential to be their own god : Marilyn Manson

  2. #2
    Membre actif Avatar de mobscene
    Profil pro
    Inscrit en
    Avril 2005
    Messages
    331
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Avril 2005
    Messages : 331
    Points : 234
    Points
    234
    Par défaut
    Au passage l'exemple fournit par le CPAN ne marche pas chez moi quelqu'un d'autre a t'il le même probleme avec activestate 5.8.????????? ?

    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
     
       #!/usr/bin/perl
       require 5.002;
       use WWW::Robot;
     
       $rootDocument = $ARGV[0];
     
       $robot = new WWW::Robot('NAME'     =>  'Validator',
                               'VERSION'  =>  1.000,
                               'EMAIL'    =>  'fred@foobar.com');
     
       $robot->addHook('follow-url-test', \&follow_test);
       $robot->addHook('invoke-on-contents', \&validate_contents);
     
       $robot->run($rootDocument);
     
       #-------------------------------------------------------
       sub follow_test {
          my($robot, $hook, $url) = @_;
     
          return 0 unless $url->scheme eq 'http';
          return 0 if $url =~ /\.(gif|jpg|png|xbm|au|wav|mpg)$/;
     
          #---- we're only interested in pages on our site ----
          return $url =~ /^$rootDocument/;
       }
     
       #-------------------------------------------------------
       sub validate_contents {
          my($robot, $hook, $url, $response, $structure) = @_;
     
          return unless $response->content_type eq 'text/html';
     
          # some validation on $structure ...
     
       }
    Perl me sort

    WWW:Robot: Failed to create User Agent object: LWP::RobotUA from Adress required at C:/Program Files/Perl/site/lib/WWW/Robot.pm line 1160
    Everybody have in their the potential to be their own god : Marilyn Manson

Discussions similaires

  1. Framework web crawler et html data extractor
    Par sybaris dans le forum C#
    Réponses: 1
    Dernier message: 21/12/2013, 08h38
  2. PHP/AJAX - Petit web messenger
    Par lelapinrusse dans le forum Langage
    Réponses: 4
    Dernier message: 19/06/2009, 12h18
  3. Synchronisation ou API de Web crawler C#
    Par Wait4it dans le forum C#
    Réponses: 1
    Dernier message: 06/08/2008, 16h06
  4. web crawler integrant nutch
    Par minouml dans le forum Développement Web en Java
    Réponses: 2
    Dernier message: 09/02/2007, 16h05
  5. [C#] Comment programmer un web crawler ?
    Par siaoly dans le forum C#
    Réponses: 3
    Dernier message: 15/09/2006, 17h51

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo