Update of /cvsroot/www-mechanize/www-mechanize/lib/WWW
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv10271/lib/WWW
Modified Files:
Mechanize.pm
Log Message:
* When links are extracted from <area> tags, the ALT attribute will
be captured become part of the WWW::Mechanize::Link object.
(RT #3317). Patch by Mark Stosberg.
Index: Mechanize.pm
===================================================================
RCS file: /cvsroot/www-mechanize/www-mechanize/lib/WWW/Mechanize.pm,v
retrieving revision 1.139
retrieving revision 1.140
diff -u -d -r1.139 -r1.140
--- Mechanize.pm 16 Sep 2004 04:29:40 -0000 1.139
+++ Mechanize.pm 29 Sep 2004 19:38:55 -0000 1.140
@@ -1551,25 +1551,33 @@
while (my $token = $p->get_tag( keys %urltags )) {
my $tag = $token->[0];
- my $url = $token->[1]{$urltags{$tag}};
+ my $attrs = $token->[1];
+ my $url = $attrs->{$urltags{$tag}};
my $text;
my $name;
+ my $alt;
if ( $tag eq "a" ) {
$text = $p->get_trimmed_text("/$tag");
$text = "" unless defined $text;
- my $onClick = $token->[1]{onclick};
+ my $onClick = $attrs->{onclick};
if ( $onClick && ($onClick =~ /^window\.open\(\s*'([^']+)'/) ) {
$url = $1;
}
} # a
- if ( $tag ne "area" ) {
- $name = $token->[1]{name};
+
+ # Of the tags we extract from, only 'AREA' has an alt tag
+ if ($tag eq 'area') {
+ $alt = $attrs->{alt};
+ }
+ # The rest should have a 'name' attribute.
+ else {
+ $name = $attrs->{name};
}
if ( $tag eq "meta" ) {
- my $equiv = $token->[1]{"http-equiv"};
- my $content = $token->[1]{"content"};
+ my $equiv = $attrs->{"http-equiv"};
+ my $content = $attrs->{"content"};
next unless $equiv && (lc $equiv eq "refresh") && defined $content;
if ( $content =~ /^\d+\s*;\s*url\s*=\s*(.+)/ ) {
@@ -1580,7 +1588,14 @@
} # meta
next unless defined $url; # probably just a name link or <AREA
NOHREF...>
- push( @{$self->{links}}, WWW::Mechanize::Link->new( $url, $text,
$name, $tag, $self->base ) );
+ push( @{$self->{links}}, WWW::Mechanize::Link->new({
+ url => $url,
+ text => $text,
+ name => $name,
+ tag => $tag,
+ base => $self->base,
+ alt => $alt,
+ }) );
} # while
# Old extract_links() returned a value. Carp if someone expects
-------------------------------------------------------
This SF.net email is sponsored by: IT Product Guide on ITManagersJournal
Use IT products in your business? Tell us what you think of them. Give us
Your Opinions, Get Free ThinkGeek Gift Certificates! Click to find out more
http://productguide.itmanagersjournal.com/guidepromo.tmpl
|