File Coverage

blib/lib/WWW/Mechanize/Meta.pm

Criterion	Covered	Total	%
statement	54	61	88.5
branch	6	10	60.0
condition	5	6	83.3
subroutine	12	13	92.3
pod	6	6	100.0
total	83	96	86.4

package WWW::Mechanize::Meta;

use warnings;
use strict;
use Data::Dumper;
use HTTP::Headers;
use HTML::HeadParser;

use base 'WWW::Mechanize';

=head1 NAME

WWW::Mechanize::Meta - Adds HEAD tag parsing to WWW::Mechanize

=head1 VERSION

Version 0.07

=cut

our $VERSION = '0.07';

=head1 SYNOPSIS

    use WWW::Mechanize::Meta;

    my $mech = WWW::Mechanize::Meta->new();
    my @css=$mech->link('stylesheet');
    foreach (@css){
	print "$_->{href}\n";
    }


=head1 METHODS

=head2 link( [$type] )

Returns link tag with attribure rel = $type. If no attribute $type given, returns all link tags.

=cut

sub link {
    my $self = shift;
    my $type = shift;
    my @links;
    foreach my $link ( $self->{head}->header('link') ) {

        my @params = split '; ', $link;
        my ($src) = ( ( shift @params ) =~ m/\<(.*)\>/ );
        my %params = map { m/(.*)=\"([^\"]*)\"/ } @params;
        $params{href} = $src;
        push @links, \%params if !$type || $params{rel} eq $type;
    }
    return @links;

}

=head2 rss

Returns all rss objects for this page

=cut

sub rss {
    my $self  = shift;
    my @links = $self->link('alternate');
    my @news;
    foreach (@links) {
        push @news, $_
          if $_->{type} eq 'application/rss+xml'
              or $_->{type} eq 'application/atom+xml';
    }
    return @news;

}

=head2 headtag

Returns raw header object

=cut

sub headtag {
    my $self = shift;
    return $self->{head};
}

=head1 INTERNAL METHODS

=head2 new

=cut

sub new {
    my $class = shift;
    my $self  = $class->SUPER::new(@_);
    $self->{headparser} = HTML::HeadParser->new();
    return $self;
}

=head2 title

=cut

sub title {
    my $self = shift;
    return unless $self->is_html;
    my $title = $self->{head}->header('Title');
    return $title;
}

=head2 update_html

=cut

sub update_html {
    my $self = shift;
    my $html = shift;
    $self->SUPER::update_html($html);

    #    warn $html;
    if ( $self->is_html ) {
        utf8::decode($html);
        $self->{headparser}{'header'} = HTTP::Headers->new();
        $self->{headparser}->parse($html);
        $self->{head} = $self->{headparser}->header;
    }
    else {
        $self->{head} = undef;
        $self->{link} = undef;
    }
    return;
}

=head2 _parse_head

=cut

sub _parse_head {
    my $self = shift;
    return unless $self->is_html;
    require HTML::HeadParser;
    my $p = HTML::HeadParser->new;
    $p->parse( $self->content );
}

=head1 AUTHOR

Andrey Kostenko, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to
C, or through the web interface at
L.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc WWW::Mechanize::Meta

You can also look for information at:

=over 4

=item * AnnoCPAN: Annotated CPAN documentation

L

=item * CPAN Ratings

L

=item * RT: CPAN's request tracker

L

=item * Search CPAN

L

=back

=head1 ACKNOWLEDGEMENTS

=head1 LICENSE

Copyright 2007 Andrey Kostenko, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1;    # End of WWW::Mechanize::Meta