File Coverage

blib/lib/WebService/HtmlKitCom/FavIconFromImage.pm

Criterion	Covered	Total	%
statement	37	46	80.4
branch	9	22	40.9
condition	1	3	33.3
subroutine	8	9	88.8
pod	2	2	100.0
total	57	82	69.5

package WebService::HtmlKitCom::FavIconFromImage;

use warnings;
use strict;

our $VERSION = '1.001001'; # VERSION

use Carp;
use WWW::Mechanize;
use Devel::TakeHashArgs;
use base 'Class::Accessor::Grouped';

__PACKAGE__->mk_group_accessors( simple => qw(
    error
    mech
    response
));


sub new {
    my $self = bless {}, shift;

    get_args_as_hash( \@_, \ my %args, { timeout => 180 } )
        or croak $@;

    $args{mech} ||= WWW::Mechanize->new(
        autocheck => 0,
        timeout => $args{timeout},
        agent   => 'Mozilla/5.0 (X11; U; Linux x86_64; en-US; rv:1.8.1.12)'
                    .' Gecko/20080207 Ubuntu/7.10 (gutsy) Firefox/2.0.0.12',
    );

    $self->mech( $args{mech} );

    return $self;
}

sub favicon {
    my $self = shift;

    $self->$_(undef) for qw(error response);

    my $image = shift;
    get_args_as_hash( \@_, \ my %args, { # also used: `file`
            image   => $image,
        },
    ) or croak $@;

    -e $args{image}
        or return $self->_set_error("File `$args{image}` does not exist");

    my $mech = $self->mech;

    $mech->get('http://www.html-kit.com/favicon/')->is_success
        or return $self->_set_error( $mech, 'net' );

    $mech->form_number(1)
        or return $self->_set_error('Failed to find favicon form');

    $mech->set_visible(
        $args{image},
    );

    $mech->click->is_success
        or return $self->_set_error( $mech, 'net' );

#         use Data::Dumper;
#     print $mech->res->decoded_content;
#     exit;
    my $response = $mech->follow_link(
        url_regex => qr|^\Qhttp://favicon.htmlkit.com/favicon/download/|
    ) or return $self->_set_error(
            'Failed to create favicon. Check your args'
        );

    $response->is_success
        or return $self->_set_error( $mech, 'net' );

    if ( $args{file} ) {
        open my $fh, '>', $args{file}
            or return $self->_set_error(
                "Failed to open `$args{file}` for writing ($!)"
            );
        binmode $fh;
        print $fh $response->content;
        close $fh;
    }
    return $self->response($response);
}

sub _set_error {
    my ( $self, $mech_or_message, $type ) = @_;
    if ( $type ) {
        $self->error(
            'Network error: ' . $mech_or_message->res->status_line
        );
    }
    else {
        $self->error( $mech_or_message );
    }
    return;
}


1;
__END__