Problème récupération lien (attribut) dans une balise (html)

**stansoad0108** · 08/04/2008, 11h16

Bonjour à tous,

Mon problème est de vouloir récupérer un lien qui se situe dans cette balise :

Code :

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

<a href="http://www.pharmgkb.org/do/serve?objId=PA227" class=l onmousedown="return clk(this.href,'','','res','1','')">

mon adresse à récuperer est http://www.pharmgkb.org/do/serve?objId=PA227.

Début de code uniquement dans le parser :

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
#Parser
my $parser = HTML::Parser->new(start_h => [\&start_rtn,"tag, attr"],
                text_h => [\&text_rtn, "text, attr"],
                end_h => [\&end_rtn, "tag"]
                );
 
sub start_rtn {
	my ($tag, $attr) = @_;
 
#$Flag = 1 (Récupération URL sur pharmGKB.org)
	if ($tag =~ /^a$/ 		
		and defined $attr->{href}  
    		and $attr->{href} =~ /http:\/\/www.pharmgkb.org\/do\/serve?objId=.[0-9]$/
   		and defined $attr->{class} 
    		and $attr->{class} =~ /^l$/
		and defined $attr->{onmousedown}
		and $attr->{onmousedown} =~ /return clk(this.href,'','','res','1','')/ ){    
  		$flag = 3;
		my $URL = $attr->{href};
		print "$URL";
	}
}

Et on ne m'affiche rien...Ainsi je vous demande vos aides et commentaires...Merci

**Jedai** · 08/04/2008, 11h50

Les parenthèses () et ? sont des caractères spéciaux dans les regexps, il faut les échapper pour qu'elles soient traités normalement.
(Par ailleurs, ça m'a l'air un peu trop précis comme réquisition, est-ce que tu as vraiment besoin de matcher "onmousedown" pour sélectionner la bonne balise ?)

Et aussi, lorsque tu as 3 fois les mêmes instructions, crée une fonction :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
sub check { defined $_[0] and $_[0] =~ m/$_[1]/ }
 
# ...
 
  if ($tag =~ /^a$/ 		
      and check( $attr->{href}, qr{^http://www.pharmgkb.org/do/serve\?objId=} )
      and check( $attr->{class}, qr{^l$} )
      and check( $attr->{onmousedown}, qr{return clk\(this\.href,'','','res','1',''\)} ) ){    
    $flag = 3;
    my $URL = $attr->{href};
    print "$URL";
  }

--
Jedaï

**stansoad0108** · 08/04/2008, 14h22

Merci pour ce changement !!! Cela risque de fonctionner je vous remercie...

Cependant je ne comprend pas, ma console, après exécution du programme, m'indique :

Code :

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

1
2
http://www.google.com/search?hl=fr&q=PharmGKB+LDLR&btnG=Rechercher&meta=
Use of uninitialized value in subroutine entry at Essai_1.pl line 66.

Voici 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
#!/usr/bin/perl
use strict; 
use warnings;
 
use HTML::Parser;
use LWP::Simple;
 
#Variables
my $baseurl = 'http://www.google.com/';
my $flag = 0;
 
 
die "usage: $0 site gene\n"
    if @ARGV != 2;
 
 
my $pharmGKB = $ARGV[0];
my $nom_gene = $ARGV[1];
 
#Page URL où parser
my $url = $baseurl.'search?hl=fr&q='.$pharmGKB.'+'.$nom_gene.'&btnG=Rechercher&meta=';
print "$url\n";
my $PAGE = get($url); 
 
 
sub check { defined $_[0] and $_[0] =~ m/$_[1]/ }
 
#Parser
my $parser = HTML::Parser->new(start_h => [\&start_rtn,"tag, attr"],
                text_h => [\&text_rtn, "text"],
                end_h => [\&end_rtn, "tag"]
                );
 
sub start_rtn {
 
	my ($tag, $attr) = @_;
	if ($tag =~ /^a$/ 		
      		and check( $attr->{href}, qr{^http://www.pharmgkb.org/do/serve\?objId=} )
     	 	and check( $attr->{class}, qr{^l$} )
      		and check( $attr->{onmousedown}, qr{return clk\(this\.href,'','','res','1',''\)} ) ){    
    		$flag = 1;
    		my $URL = $attr->{href};
    		print "$URL";
  	}
}
 
sub text_rtn {
	my ($text) = @_;
  	$text =~ s/\n/ /g;
 
	if($flag == 1){                
       		print "$text\n";
    	}
}
 
sub end_rtn {
	my ($tag) = @_;
 
	if ($tag =~ /^\/a$/ && $flag == 1){
             	$flag = 0;
	}
 
}
 
#start parsing
$parser->parse($PAGE);
 
#end parser
$parser->eof;

Pourquoi il m'affiche cela (en sachant que la ligne 66 correspond à $parser->parse($PAGE). De plus mes autres programmes étaient basés sur le même "parser" et fonctionnaient très bien...

Merci d'avance

**Jedai** · 08/04/2008, 16h39

Cela risque de fonctionner je vous remercie...

Intéressante formulation...

Pourquoi il m'affiche cela (en sachant que la ligne 66 correspond à $parser->parse($PAGE). De plus mes autres programmes étaient basés sur le même "parser" et fonctionnaient très bien...

Parce que Google a décidé de refuser l'accès de ses pages de recherche au robots, et rejette donc notre UserAgent qui s'identifie comme "libwww/5.8", il faut changer cette identification pour accéder à la page, le code suivant te montre comment : (et simplifie un peu tes réquisitions draconiennes et exagérées)

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
#!/usr/bin/perl
use strict; 
use warnings;
 
use HTML::Parser;
use LWP::Simple qw($ua get);
 
#Variables
my $baseurl = 'http://www.google.com/';
my $flag = 0;
 
 
die "usage: $0 site gene\n"
    if @ARGV != 2;
 
 
my $pharmGKB = $ARGV[0];
my $nom_gene = $ARGV[1];
 
#Page URL où parser
my $url = $baseurl.'search?hl=fr&q='.$pharmGKB.'+'.$nom_gene.'&btnG=Rechercher&meta=';
print "$url\n";
 
$ua->agent('Mozilla/5.0');
my $page = get($url);
die "Can't get $url\n" unless defined $page;
 
sub check { defined $_[0] and $_[0] =~ m/$_[1]/ }
 
#Parser
my $parser = HTML::Parser->new(start_h => [\&start_rtn,"tag, attr"],
			       text_h => [\&text_rtn, "text"],
			       end_h => [\&end_rtn, "tag"]
);
 
sub start_rtn {
  my ($tag, $attr) = @_;
  if ($tag =~ /^a$/ 		
      and check( $attr->{href}, qr{^http://www.pharmgkb.org/do/serve\?objId=[^&]+$} ) ){
    $flag = 1;
    my $URL = $attr->{href};
    print "$URL\n";
  }
}
 
sub text_rtn {
	my ($text) = @_;
  	$text =~ s/\n/ /g;
 
	if($flag == 1){                
       		print "$text\n";
    	}
}
 
sub end_rtn {
	my ($tag) = @_;
 
	if ($tag =~ /^\/a$/ && $flag == 1){
             	$flag = 0;
	}
 
}
 
#start parsing
$parser->parse($page);
 
#end parser
$parser->eof;