File Coverage

blib/lib/WWW/Yandex/TIC.pm

Criterion	Covered	Total	%
statement	37	46	80.4
branch	4	10	40.0
condition			n/a
subroutine	8	9	88.8
pod	3	4	75.0
total	52	69	75.3

package WWW::Yandex::TIC;

# -*- perl -*-

use strict;
use warnings;

use vars qw($VERSION);

use LWP::UserAgent;
use HTTP::Headers;

# we try to parse yandex bar info
# on failure we must parse yandex catalog page

$VERSION = '0.07';

my $regexps = [
	qr/(?is).*?[^<]+? &(?:#151|mdash); (\d+)/,
	qr|(?is).*?[^<]+? 1(\d+).|, # zero -)
	qr|(?is)
];

sub new {
	my $class = shift;
	my %par = @_;
	my $self;

	# config overrided by parameters
	my $ua = $self->{ua} = LWP::UserAgent->new;

	my $proxy = delete $par{proxy};

	foreach my $k (keys %par) {
		$ua->$k ($par{$k});
	}

	if ($proxy) {
		# support for old interface
		$ua->proxy ('http', $proxy);
	}

	bless($self, $class);
}

sub user_agent {
	shift->{ua};
}

sub request_uri {
	my ($self, $url) = @_;

	my $query = "http://search.yaca.yandex.ru/yca/cy/ch/$url/";

	return $query;
}

sub get {
	my ($self, $url) = @_;

	my $query = $self->request_uri ($url);

	my $resp = $self->{ua}->get($query);

	if ($resp->is_success) {

		my $content = $resp->content;

		my $tic = undef;

		my $c = 0;

		foreach my $rx (@$regexps) {
			if ($content =~ /$rx/) {
				$tic = $1;
				last;
			}
		}

		if (wantarray) {
			return ($tic, $resp);
		} else {
			return $tic;
		}

	} else {
		if (wantarray) {
			return (undef, $resp);
		} else {
			return;
		}
	}
}

1;

__END__