File Coverage

blib/lib/WWW/WebDevout/BrowserSupportInfo.pm

Criterion	Covered	Total	%
statement	26	102	25.4
branch	2	38	5.2
condition	0	3	0.0
subroutine	7	20	35.0
pod	12	12	100.0
total	47	175	26.8

package WWW::WebDevout::BrowserSupportInfo;

use warnings;
use strict;

our $VERSION = '0.0103';

use Carp;
use URI;
use LWP::UserAgent;
use overload '%{}' => \&_overload;

sub _overload {
    return shift->browser_results;
}

sub new {
    my $class = shift;
    croak "Even number of arguments expected to new()"
        if @_ & 1;
    my %args = @_;
    $args{ +uc } = delete $args{ $_ } for keys %args;

    %args = (
        LONG        => 0,
        BROWSERS    => [ qw(IE6 IE7 IE8 FX1_5 FX2 FX3 OP8 OP9 KN3_5 SF2) ],
        %args,
    );
    #IE6-IE7-FX1_5-FX2-OP8-OP9-KN3_5-SF2

    unless ( exists $args{UA_ARGS}{timeout} ) {
        $args{UA_ARGS}{timeout} = 30;
    }

    return bless [ \%args ], $class;
}

sub fetch {
    my $self = shift;
    my $input = shift;

    croak "Undefined argument to fetch()"
        unless defined $input;

    my $uri = URI->new('http://www.webdevout.net/lookup-support');
    $uri->query_form(
        'q'   => $input,
        'uas' => join '-', @{ $self->browsers }
    );
    my $ua = LWP::UserAgent->new( %{ $self->ua_args || {} } );

    my $response = $ua->get( $uri );

    if ( $response->is_success ) {
        return $self->_parse_fetched( $response->content );
    }
    else {
        $self->error( $response->status_line );
        return;
    }
}

sub _parse_fetched {
    my $self = shift;
    my $content = shift;
    $content =~ s/^\s+|\s+$//g
        if defined $content;
    if ( not defined $content or not length $content ) {
        $self->error('No results');
        return;
    }

    my %results;
    ( my ( $what, $uri_info), @results{ @{ $self->browsers } } )
    = grep { defined } split /\n/, $content;

    keys %results;
    while ( my ( $browser, $info ) = each %results ) {
        $info =~ s/^\s*.+?:\s*//
            if defined $info;
        $results{ $browser } = $info;
        $self->browser_info( $browser => $info );
    }

    if ( $self->long ) {
        $results{ $self->make_long_name( $_ ) }
            = delete $results{ $_ } for keys %results;
    }

    $self->browser_results( { %results } );
    $self->what( $what );
    $self->uri_info( $uri_info );
    @results{ qw(what  uri_info) } = ( $what, $uri_info );

    return $self->results( \%results );
}

sub make_long_name {
    my $self = shift;
    my $short_ua = shift
        or return;
    my %long_name_for = (
        IE6     => 'Internet Explorer 6',
        IE7     => 'Internet Explorer 7',
        IE8     => 'Internet Explorer 7',
        FX1_5   => 'FireFox 1.5',
        FX2     => 'FireFox 2',
        FX3     => 'FireFox 3',
        OP8     => 'Opera 8',
        OP9     => 'Opera 9',
        KN3_5   => 'Konqueror 3.5',
        SF2     => 'Safari 2',
    );

    return $long_name_for{ $short_ua };
}

###### ACCESSORS/MUTATORS

sub browser_info {
    my ( $self, $browser ) = splice @_, 0, 2;
    if ( @_ ) {
        $self->[0]{INFO}{ $browser } = shift;
    }
    return $self->[0]{INFO}{ $browser };
}

sub error {
    my $self = shift;
    if ( @_ ) {
        $self->[0]{ ERROR } = shift;
    }
    return $self->[0]{ ERROR };
}

sub ua_args {
    my $self = shift;
    if ( @_ ) {
        $self->[0]{ UA_ARGS } = shift;
    }
    return $self->[0]{ UA_ARGS };
}

sub long {
    my $self = shift;
    if ( @_ ) {
        $self->[0]{ LONG } = shift;
    }
    return $self->[0]{ LONG };
}

sub results {
    my $self = shift;
    if ( @_ ) {
        $self->[0]{ RESULTS } = shift;
    }
    return $self->[0]{ RESULTS };
}

sub browser_results {
    my $self = shift;
    if ( @_ ) {
        $self->[0]{ BROWSER_RESULTS } = shift;
    }
    return $self->[0]{ BROWSER_RESULTS };
}


sub what {
    my $self = shift;
    if ( @_ ) {
        $self->[0]{ WHAT } = shift;
    }
    return $self->[0]{ WHAT };
}


sub uri_info {
    my $self = shift;
    if ( @_ ) {
        $self->[0]{ URI_INFO } = shift;
    }
    return $self->[0]{ URI_INFO };
}

sub browsers {
    my $self = shift;
    if ( @_ ) {
        $self->[0]{ BROWSERS } = shift;
    }
    return $self->[0]{ BROWSERS };
}


1;

__END__