File Coverage

blib/lib/WWW/Yandex/BarTIC.pm

Criterion	Covered	Total	%
statement	34	41	82.9
branch	2	10	20.0
condition	1	6	16.6
subroutine	10	11	90.9
pod	3	3	100.0
total	50	71	70.4

package WWW::Yandex::BarTIC;
use 5.006;
use strict;
use warnings;
our $VERSION = '0.05';

use base 'Object::Accessor';

use base 'Exporter';
our @EXPORT_OK = qw(get_tic);

use LWP::UserAgent;
use URI::Escape;
use Carp qw/carp croak/;

# Defaults
my $DEF_URL_TEMPLATE = 'http://bar-navig.yandex.ru/u?url=%s&show=1';
my $DEF_UA_AGENT     = 'Mozilla/5.0 (Ubuntu; X11; Linux i686; rv:9.0.1) Gecko/20100101 Firefox/9.0.1 YB/6.5.0-en';
my $TIC_RE           = qr##;
my @ATTRS            = qw/ua url_template/;

sub new {
  my ($class, %args) = @_;

  my $self = $class->SUPER::new(@ATTRS);
  $self->ua($args{ua} || LWP::UserAgent->new(agent => $DEF_UA_AGENT));
  $self->url_template($DEF_URL_TEMPLATE);

  return $self;
}


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

  croak 'I am waiting for url param' unless defined $url;
  unless ($url =~ m[^https?://]i) {
    carp 'use "http://some.domain" format for url';
    return;
  }

  my $query = sprintf($self->url_template, uri_escape($url));
  my $resp = $self->ua->get($query);

  if ($resp->is_success and $resp->content =~ $TIC_RE) {
    return wantarray ? ($1, $resp) : $1;
  }
  else {
    return wantarray ? (undef, $resp) : undef;
  }

}

sub get_tic {
  my ($url) = @_;
  return __PACKAGE__->new()->get($url);
}


=head1 NAME

WWW::Yandex::BarTIC - Query Yandex citation index (Яндекс ТИЦ in russian)

=head1 VERSION

Version 0.04

=cut


=head1 SYNOPSIS

    use WWW::Yandex::BarTIC 'get_tic';

    # OO Style
    my $yb = WWW::Yandex::BarTIC->new();
    my ($tic, $resp) = $yb->get('http://cpan.org');

    # Function
    my ($tic, $resp) = get_tic('http://cpan.org');


=head1 DESCRIPTION


The C is a class implementing a interface for
querying yandex citation index.

It uses L for making request to Yandex.

=head1 FUNCTIONS

=head2 C

You can use C function, but you must import it before

  use WWW::Yandex::BarTIC 'get_tic';
  my ($tic, $resp) = get_tic('http://mail.ru');

See L method for description

=head1 METHODS

C implements the following methods.

=head2 C

  my $yb = WWW::Yandex::BarTIC->new;
  my $yb = WWW::Yandex::BarTIC->new(ua => LWP::UserAgent->new);

Creates a new object. If C attribute is empty, it will be created automatically with following defaults:

   KEY                     DEFAULT
   -----------             --------------------
   agent                   "Mozilla/5.0 (Ubuntu; X11; Linux i686; rv:9.0.1) Gecko/20100101 Firefox/9.0.1 YB/6.5.0-en"


=head2 C

  my ($tic, $resp) = $yb->get('http://cpan.org');
  my $tic = $yb->get('http://cpan.org');

Queries Yandex for a specified URL and returns TIC. If
query successfull, integer value > 0 returned. If query fails
for some reason (yandex unreachable, url does not begin from
'http://', undefined url passed) it returns C.

In list context this function returns list from two elements where
first is the result as in scalar context and the second is the
C object (returned by C). This
can be usefull for debugging purposes and for querying failure
details.


=head1 ATTRIBUTES

=head2 C

  $yb->ua(LWP::UserAgent->new);
  $yb->ua->agent('MyAgent');

Get/Set L object for making request to Yandex

=head1 AUTHOR

Alex, 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::Yandex::BarTIC


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker (report bugs here)

L

=item * AnnoCPAN: Annotated CPAN documentation

L

=item * CPAN Ratings

L

=item * Search CPAN

L

=back


=head1 ACKNOWLEDGEMENTS


=head1 LICENSE AND COPYRIGHT

Copyright 2012 Alex.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.


=cut

1;    # End of WWW::Yandex::BarTIC