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

Langage Perl Discussion :

Besoin d'aide pour algo


Sujet :

Langage Perl

  1. #1
    Membre régulier
    Profil pro
    Inscrit en
    Décembre 2004
    Messages
    210
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Décembre 2004
    Messages : 210
    Points : 99
    Points
    99
    Par défaut Besoin d'aide pour algo
    Kikoo , j'ai un site auquel je souterai adjoindre un moteur de recherche maison , le site est hébergé chez free et si tout vas bien le moi prochain direction ovh .

    Voila mon problème j'ai fait un robot pour spider (j'indexe de chez moi) mon site et ses futur sous domaines sachant que mon site pointe vers d'autres comment faire pour ne spider que mon domaine principale et ses sous domaines ?

    voici mon bot

    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
    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
    #!/usr/bin/perl -w
    use strict;
    use URI::URL;
    use HTTP::Status;
    use HTTP::Request;
    use HTTP::Cookies;
    use HTTP::Headers;
    use HTTP::Response;
    use HTML::LinkExtor;
    use LWP::RobotUA;
    require WWW::RobotRules::AnyDBM_File;
     
     
    #...........................................................................#
    #                                     Config                                #
    #...........................................................................#
     
    $| = 1;
     
    my $VERSION = "MonRobot/0.1 (+http://dirthangel.free.fr)";
     
    my $rules = WWW::RobotRules::AnyDBM_File->new('Mozilla/5.0 (compatible; MonRobot/0.1 +http://dirthangel.free.fr)', 'cachefile');
    my $ua = LWP::RobotUA->new('Mozilla/5.0 (compatible; MonRobot/0.1 +http://dirthangel.free.fr)', 'hdd@free.fr', $rules);
       $ua->delay(1/60);
       $ua->host_wait(0);
       $ua->timeout(3);
       $ua->env_proxy;
       $ua->max_redirect(10);
       $ua->protocols_allowed( [ 'http' ] );
       $ua->protocols_forbidden( [ 'file', 'mailto', 'https', 'ftp', 'socks', 'gopher', 'wais' ] );
       $ua->requests_redirectable( [ 'HEAD' ] );
     
    my $cookie_jar = HTTP::Cookies->new(
        file => 'MonRobot_cookies.dat',
        autosave => 1,
      );
     
       $ua->cookie_jar($cookie_jar);
     
    my $headers = HTTP::Headers->new(
        Accept => [qw(text/html)]
      );
     
       $ua->default_headers($headers);
     
     
    my (@web, $find, @push, @webx, @exclude);
     
    #...........................................................................#
    #                                   "Options"                               #
    #...........................................................................#
     
       if (!$ARGV[0]) {
          print "Le robot a été lancé sans arguments :@\n";
          exit(0);
       }
     
       if ($ARGV[0] =~ /^http:\/\//g ) {
            robot(@ARGV);
       }
     
     
    #...........................................................................#
    #                                  Le robot                                 #
    #...........................................................................#
     
    sub robot {
      foreach my $url (@_) {
     
         # Fabrication d'une requete
         my $request = HTTP::Request->new('GET', $url);
     
         # Execution de la requete
         my $res = $ua->request($request);
     
         # Etat de la requete
         if ($res->is_success) {
     
              my $code = $res->content;
     
              my $date = date();
     
              my $base = $res->base;
     
              my $content_type = $res->content_type;
     
                    my @page = (
                           "$code","$url",
                           "$date", "$content_type",
                    );
     
     
                        print "$page[0]\n";
                        print "$page[1]\n";
                        print "$page[2]\n";
                        print "$page[3]\n";
     
                    @webx = links($code, $base);
     
         }
          else
         {
            print "Error: " . $res->status_line . "\n";
         }
       }
      if (!@webx) {
        exit(0);
      }
       else
      {
        robot(@webx);
      }
    }
     
     
    #...........................................................................#
    #                            On cherche les liens                           #
    #...........................................................................#
     
    sub links {
     my ($a, $b) = @_;
        my $p = HTML::LinkExtor->new(\&callback);
           $p->utf8_mode;
           $p->parse($a);
       @web = map { $_ = url($_, $b)->abs; } @web;
     return @web;
    }
     
     
    #...........................................................................#
    #                               Extract links                               #
    #...........................................................................#
     
    sub callback {
      my($tag, %attr) = @_;
      return if $tag ne 'a';
      push(@web, values %attr);
    }
     
     
    #...........................................................................#
    #                                Date du jour                               #
    #...........................................................................#
     
    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");
    }

    merci de votre aide

  2. #2
    Membre régulier
    Profil pro
    Inscrit en
    Décembre 2004
    Messages
    210
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Décembre 2004
    Messages : 210
    Points : 99
    Points
    99
    Par défaut
    Personne n'aurait une petite idée.

  3. #3
    Expert éminent
    Avatar de Jedai
    Homme Profil pro
    Enseignant
    Inscrit en
    Avril 2003
    Messages
    6 245
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Côte d'Or (Bourgogne)

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Avril 2003
    Messages : 6 245
    Points : 8 586
    Points
    8 586
    Par défaut
    N'est-il pas évident qu'il suffit de filtrer les urls par une petite regex qui vérifie juste qu'elles sont bien dans ton domaine !

    --
    Jedaï

  4. #4
    Membre régulier
    Profil pro
    Inscrit en
    Décembre 2004
    Messages
    210
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Décembre 2004
    Messages : 210
    Points : 99
    Points
    99
    Par défaut
    Certe sa je sais t'en fait pas , mais la question que je me pose en fait c'est comment faire pour que le robot s'arrete de lui meme une fois tout les liens "spider" ?

  5. #5
    Expert éminent
    Avatar de Jedai
    Homme Profil pro
    Enseignant
    Inscrit en
    Avril 2003
    Messages
    6 245
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Côte d'Or (Bourgogne)

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Avril 2003
    Messages : 6 245
    Points : 8 586
    Points
    8 586
    Par défaut
    Il faut que tu retiennes les liens que tu as déjà visité, pour ne plus y retourner : utilises un hash.

    --
    Jedaï

  6. #6
    Membre régulier
    Profil pro
    Inscrit en
    Décembre 2004
    Messages
    210
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Décembre 2004
    Messages : 210
    Points : 99
    Points
    99
    Par défaut
    Citation Envoyé par Jedai
    Il faut que tu retiennes les liens que tu as déjà visité, pour ne plus y retourner : utilises un hash.

    --
    Jedaï
    Certe j'ai fait le coup de hash mais sa ne donne rien de très concluant je me suis fait un site en local pour tester et le résultat et que sa produit quand meme des doublons et le bot ce met a tourner en rond

    voila mon code


    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
    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
    #!/usr/bin/perl -w 
    use strict; 
    use URI::URL; 
    use HTTP::Status; 
    use HTTP::Request; 
    use HTTP::Cookies; 
    use HTTP::Headers; 
    use HTTP::Response; 
    use HTML::LinkExtor; 
    use LWP::RobotUA; 
    use LWP::Debug;
    require WWW::RobotRules::AnyDBM_File; 
     
     
    #...........................................................................# 
    #                                     Config                                # 
    #...........................................................................# 
     
    $| = 1; 
     
    my $VERSION = "MonRobot/0.1 (+http://dirthangel.free.fr)"; 
     
    my $rules = WWW::RobotRules::AnyDBM_File->new('Mozilla/5.0 (compatible; MonRobot/0.1 +http://dirthangel.free.fr)', 'cachefile'); 
    my $ua = LWP::RobotUA->new('Mozilla/5.0 (compatible; MonRobot/0.1 +http://dirthangel.free.fr)', 'hdd@free.fr', $rules); 
       $ua->delay(1/60); 
       $ua->host_wait(0); 
       $ua->timeout(3); 
       $ua->env_proxy; 
       $ua->max_redirect(10); 
       $ua->protocols_allowed( [ 'http' ] ); 
       $ua->protocols_forbidden( [ 'file', 'mailto', 'https', 'ftp', 'socks', 'gopher', 'wais' ] ); 
       $ua->requests_redirectable( [ 'HEAD' ] ); 
     
    my $cookie_jar = HTTP::Cookies->new( 
        file => 'MonRobot_cookies.dat', 
        autosave => 1, 
      ); 
     
       $ua->cookie_jar($cookie_jar); 
     
    my $headers = HTTP::Headers->new( 
        Accept => [qw(text/html)] 
      ); 
     
       $ua->default_headers($headers); 
     
     
    my (@web, $find, @push, @webx, @exclude); 
     
    #...........................................................................# 
    #                                   "Options"                               # 
    #...........................................................................# 
     
       if (!$ARGV[0]) { 
          print "Le robot a été lancé sans arguments :@\n"; 
          exit(0); 
       } 
     
       if ($ARGV[0] =~ /^http:\/\//g ) { 
            robot(@ARGV); 
       } 
     
     
    #...........................................................................# 
    #                                  Le robot                                 # 
    #...........................................................................# 
    {
     my %deja_vue;
     
    sub robot { 
      foreach my $url (@_) { 
     
     if ($url =~ m!^http://[_a-zA-Z0-9-]+\.[_a-zA-Z0-9-]+[.a-zA-Z0-9-]*(/~|/?)[/_.a-zA-Z0-9#?&=+-]*$!i) {
     
     
         # Fabrication d'une requete 
         my $request = HTTP::Request->new('GET', $url) unless exists $deja_vue{$url}; 
     
          # Ajout du lien
          $deja_vue{$url};
     
         # Execution de la requete 
         my $res = $ua->request($request); 
     
         # Debug functions
         LWP::Debug::trace("$res");
     
         # Etat de la requete 
         if ($res->is_success) { 
     
              my $code = $res->content; 
     
              my $date = date(); 
     
              my $base = $res->base; 
     
              my $content_type = $res->content_type; 
     
                    my @page = ( 
                           "$code","$url", 
                           "$date", "$content_type", 
                    ); 
     
     
                       # print "$page[0]\n"; 
                        print "$page[1]\n"; 
                       # print "$page[2]\n"; 
                       # print "$page[3]\n"; 
     
                    @webx = links($code, $base); 
     
         } 
          else 
         { 
            print "Error: " . $res->status_line . "\n"; 
         } 
        } #END
       } 
      if (!@webx) { 
        exit(0); 
      } 
       else 
      { 
        robot(@webx); 
      } 
    } 
     
    }
     
    #...........................................................................# 
    #                            On cherche les liens                           # 
    #...........................................................................# 
     
    sub links { 
     my ($a, $b) = @_; 
        my $p = HTML::LinkExtor->new(\&callback); 
           $p->utf8_mode; 
           $p->parse($a); 
       @web = map { $_ = url($_, $b)->abs; } @web; 
     return @web; 
    } 
     
     
    #...........................................................................# 
    #                               Extract links                               # 
    #...........................................................................# 
     
    sub callback { 
      my($tag, %attr) = @_; 
      return if $tag ne 'a'; 
      push(@web, values %attr); 
    } 
     
     
    #...........................................................................# 
    #                                Date du jour                               # 
    #...........................................................................# 
     
    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"); 
    }
    Je commence a désèspéré je trouve pas comment faire pour que le bot ne passe pas deux fois aux meme endroits et ne tourne pas en rond

  7. #7
    Expert éminent
    Avatar de Jedai
    Homme Profil pro
    Enseignant
    Inscrit en
    Avril 2003
    Messages
    6 245
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Côte d'Or (Bourgogne)

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Avril 2003
    Messages : 6 245
    Points : 8 586
    Points
    8 586
    Par défaut
    C'est parce que tu ne vides pas @web et @webx.... Tu continue à pusher des valeurs dessus sans jamais les enlever, donc forcément tu ne finis jamais !
    Transforme @web et @webx en variable locales et en paramètre de tes fonctions, tant qu'elles sont globales tu prends trop de risque. (sauf si tu changes complètement le modèle de ton bot)

    --
    Jedaï

  8. #8
    Membre régulier
    Profil pro
    Inscrit en
    Décembre 2004
    Messages
    210
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Décembre 2004
    Messages : 210
    Points : 99
    Points
    99
    Par défaut
    merci jedai pour tes conseils voici mon nouveau code qui marche

    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
    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
     
    #!/usr/bin/perl -w 
    use strict; 
    use URI::URL; 
    use HTTP::Status; 
    use HTTP::Request; 
    use HTTP::Cookies; 
    use HTTP::Headers; 
    use HTTP::Response; 
    use HTML::LinkExtor; 
    use LWP::RobotUA; 
    use LWP::Debug; 
    require WWW::RobotRules::AnyDBM_File; 
     
     
    #...........................................................................# 
    #                                     Config                                # 
    #...........................................................................# 
     
    $| = 1; 
     
    my $VERSION = "MonRobot/0.1 (+http://dirthangel.free.fr)"; 
     
    my $rules = WWW::RobotRules::AnyDBM_File->new('Mozilla/5.0 (compatible; MonRobot/0.1 +http://dirthangel.free.fr)', 'cachefile'); 
    my $ua = LWP::RobotUA->new('Mozilla/5.0 (compatible; MonRobot/0.1 +http://dirthangel.free.fr)', 'hdd@free.fr', $rules); 
       $ua->delay(1/60); 
       $ua->host_wait(0); 
       $ua->timeout(3); 
       $ua->env_proxy; 
       $ua->max_redirect(10); 
       $ua->protocols_allowed( [ 'http' ] ); 
       $ua->protocols_forbidden( [ 'file', 'mailto', 'https', 'ftp', 'socks', 'gopher', 'wais' ] ); 
       $ua->requests_redirectable( [ 'HEAD' ] ); 
     
    my $cookie_jar = HTTP::Cookies->new( 
        file => 'MonRobot_cookies.dat', 
        autosave => 1, 
      ); 
     
       $ua->cookie_jar($cookie_jar); 
     
    my $headers = HTTP::Headers->new( 
        Accept => [qw(text/html)] 
      ); 
     
       $ua->default_headers($headers); 
     
     
    my ( $find, @push, @exclude); 
    # webx, 
    # @web,
    #...........................................................................# 
    #                                   "Options"                               # 
    #...........................................................................# 
     
       if (!$ARGV[0]) { 
          print "Le robot a été lancé sans arguments :@\n"; 
          exit(0); 
       } 
     
       if ($ARGV[0] =~ /^http:\/\//g ) { 
            robot(@ARGV); 
       } 
     
    #...........................................................................# 
    #                                  Le robot                                 # 
    #...........................................................................# 
    { 
     my %deja_vue; 
     
    sub robot { 
    my @webx;
      foreach my $url (@_) { 
     
     if ($url =~ m!^http://[_a-zA-Z0-9-]+\.[_a-zA-Z0-9-]+[.a-zA-Z0-9-]*(/~|/?)[/_.a-zA-Z0-9#?&=+-]*$!i) { 
     
     
         # Fabrication d'une requete 
         my $request = HTTP::Request->new('GET', $url) unless exists $deja_vue{$url}; 
     
          # Ajout du lien 
          $deja_vue{$url}; 
     
         # Execution de la requete 
         my $res = $ua->request($request); 
     
         # Debug functions 
         LWP::Debug::trace("$res"); 
     
         # Etat de la requete 
         if ($res->is_success) { 
     
              my $code = $res->content; 
     
              my $date = date(); 
     
              my $base = $res->base; 
     
              my $content_type = $res->content_type; 
     
                    my @page = ( 
                           "$code","$url", 
                           "$date", "$content_type", 
                    ); 
     
     
                       # print "$page[0]\n"; 
                        print "$page[1]\n"; 
                       # print "$page[2]\n"; 
                       # print "$page[3]\n"; 
     
                    @webx = links($code, $base); 
     
         } 
          else 
         { 
            print "Error: " . $res->status_line . "\n"; 
         } 
        } #END 
       } 
      if (!@webx) { 
        exit(0); 
      } 
       else 
      { 
        robot(@webx); 
      } 
    } 
     
    }
     
    my @web;
    #...........................................................................# 
    #                            On cherche les liens                           # 
    #...........................................................................# 
     
    sub links { 
     my ($a, $b) = @_; 
        my $p = HTML::LinkExtor->new(\&callback); 
           $p->utf8_mode; 
           $p->parse($a); 
       @web = map { $_ = url($_, $b)->abs; } @web; 
       my @si = @web;
     @web = ();
     return @si; 
     
    } 
     
     
    #...........................................................................# 
    #                               Extract links                               # 
    #...........................................................................# 
     
    sub callback { 
      my($tag, %attr) = @_; 
      return if $tag ne 'a'; 
      push(@web, values %attr); 
    } 
     
     
    #...........................................................................# 
    #                                Date du jour                               # 
    #...........................................................................# 
     
    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"); 
    }
    Ce bot marche parfaitement lui , mais il reste encore un problème avec html::linkextor je doit déclarer @web en tant que globales et passer par un hack
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    my @si = @web;
     @web = ();
     return @si;

  9. #9
    Membre régulier
    Profil pro
    Inscrit en
    Décembre 2004
    Messages
    210
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Décembre 2004
    Messages : 210
    Points : 99
    Points
    99
    Par défaut
    C bon j'ai trouvé la soluce pour ce problème de hack c'était tout simple

    voila mon nouveau nouveau code

    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
    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
     
    #!/usr/bin/perl -w 
    use strict; 
    use URI::URL; 
    use HTTP::Status; 
    use HTTP::Request; 
    use HTTP::Cookies; 
    use HTTP::Headers; 
    use HTTP::Response; 
    use HTML::LinkExtor; 
    use LWP::RobotUA; 
    use LWP::Debug; 
    require WWW::RobotRules::AnyDBM_File; 
     
     
    #...........................................................................# 
    #                                     Config                                # 
    #...........................................................................# 
     
    $| = 1; 
     
    my $VERSION = "MonRobot/0.1 (+http://dirthangel.free.fr)"; 
     
    my $rules = WWW::RobotRules::AnyDBM_File->new('Mozilla/5.0 (compatible; MonRobot/0.1 +http://dirthangel.free.fr)', 'cachefile'); 
    my $ua = LWP::RobotUA->new('Mozilla/5.0 (compatible; MonRobot/0.1 +http://dirthangel.free.fr)', 'hdd@free.fr', $rules); 
       $ua->delay(1/60); 
       $ua->host_wait(0); 
       $ua->timeout(3); 
       $ua->env_proxy; 
       $ua->max_redirect(10); 
       $ua->protocols_allowed( [ 'http' ] ); 
       $ua->protocols_forbidden( [ 'file', 'mailto', 'https', 'ftp', 'socks', 'gopher', 'wais' ] ); 
       $ua->requests_redirectable( [ 'HEAD' ] ); 
     
    my $cookie_jar = HTTP::Cookies->new( 
        file => 'MonRobot_cookies.dat', 
        autosave => 1, 
      ); 
     
       $ua->cookie_jar($cookie_jar); 
     
    my $headers = HTTP::Headers->new( 
        Accept => [qw(text/html)] 
      ); 
     
       $ua->default_headers($headers); 
     
     
    my ( $find, @push, @exclude); 
    # webx, 
    # @web,
    #...........................................................................# 
    #                                   "Options"                               # 
    #...........................................................................# 
     
       if (!$ARGV[0]) { 
          print "Le robot a été lancé sans arguments :@\n"; 
          exit(0); 
       } 
     
       if ($ARGV[0] =~ /^http:\/\//g ) { 
            robot(@ARGV); 
       } 
     
    #...........................................................................# 
    #                                  Le robot                                 # 
    #...........................................................................# 
    { 
     my %deja_vue; 
     
    sub robot { 
    my @webx;
      foreach my $url (@_) { 
     
     if ($url =~ m!^http://[_a-zA-Z0-9-]+\.[_a-zA-Z0-9-]+[.a-zA-Z0-9-]*(/~|/?)[/_.a-zA-Z0-9#?&=+-]*$!i) { 
     
     
         # Fabrication d'une requete 
         my $request = HTTP::Request->new('GET', $url) unless exists $deja_vue{$url}; 
     
          # Ajout du lien 
          $deja_vue{$url}; 
     
         # Execution de la requete 
         my $res = $ua->request($request); 
     
         # Debug functions 
         LWP::Debug::trace("$res"); 
     
         # Etat de la requete 
         if ($res->is_success) { 
     
              my $code = $res->content; 
     
              my $date = date(); 
     
              my $base = $res->base; 
     
              my $content_type = $res->content_type; 
     
                    my @page = ( 
                           "$code","$url", 
                           "$date", "$content_type", 
                    ); 
     
     
                       # print "$page[0]\n"; 
                        print "$page[1]\n"; 
                       # print "$page[2]\n"; 
                       # print "$page[3]\n"; 
     
                    @webx = links($code, $base); 
     
     
         } 
          else 
         { 
            print "Error: " . $res->status_line . "\n"; 
         } 
        } #END 
       } 
      if (!@webx) { 
        exit(0); 
      } 
       else 
      { 
        robot(@webx); 
      } 
    } 
     
    }
     
     
    #...........................................................................# 
    #                            On cherche les liens                           # 
    #...........................................................................# 
     
    sub links {
    my @web;
     my $p = HTML::LinkExtor->new(sub {
                                   my($tag, %attr) = @_; 
                                   return if $tag ne 'a';
                                   push(@web, values %attr); 
                                 }); 
        $p->utf8_mode; 
        $p->parse($_[0]); 
       @web = map { $_ = url($_, $_[1])->abs; } @web;
     return @web;
    }
     
    #...........................................................................# 
    #                                Date du jour                               # 
    #...........................................................................# 
     
    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"); 
    }
    Thanks Jedai et a developpez.com

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Réponses: 22
    Dernier message: 21/07/2013, 10h14
  2. Besoin d'aide pour un Algo
    Par Spinoza23 dans le forum Mathématiques
    Réponses: 10
    Dernier message: 16/02/2007, 15h35
  3. Besoin d'aide pour passage d'un algo au langage JAVA
    Par Spinoza23 dans le forum AWT/Swing
    Réponses: 6
    Dernier message: 16/02/2007, 15h33
  4. Besoin d'aide pour implementer un algo
    Par mobscene dans le forum Langage
    Réponses: 7
    Dernier message: 30/11/2006, 16h17
  5. besoin d'aide pour des algos
    Par mathieu77 dans le forum Algorithmes et structures de données
    Réponses: 23
    Dernier message: 08/11/2005, 18h33

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