File Coverage

blib/lib/WWW/Scroogle.pm

Criterion	Covered	Total	%
statement	115	165	69.7
branch	62	106	58.4
condition			n/a
subroutine	20	25	80.0
pod	17	17	100.0
total	214	313	68.3

package WWW::Scroogle;

use strict;
use warnings;
use Carp;

use LWP;
use WWW::Scroogle::Result;

our $VERSION = '0.0135';

sub new
{
     my $class = shift;
     my $self = {
                 num_results       => $class->_default_num_results,
                 language          => $class->_default_language,
                };
     bless $self, $class;
     return $self;
}

sub _default_num_results { return 100; }

sub searchstring
{
     ref(my $self = shift)
          or croak 'instance variable needed!';
     defined($self->{searchstring})
          or croak 'no searchstring given yet!';
     return $self->{searchstring};
}

sub set_searchstring
{
     ref(my $self = shift)
          or croak 'instance variable needed!';
     defined(my $searchstring = shift)
          or croak 'no searchstring given!';
     if ($searchstring eq '') { croak 'nullstring given!' }
     $self->{searchstring} = $searchstring;
     return $self;
}

sub _default_language { return ''; }

sub language
{
     ref(my $either = shift)
          or croak 'instance variable needed!';
     if ($either->{language} eq '') {
          return 'all';
     }else {
          return $either->{language};
     }
}

sub set_language
{
     ref(my $self = shift)
          or croak 'instance variable needed!';
     my $language = shift;
     if (not defined $language) {
          $self->{language} = $self->_default_language;
     }else {
          grep{$language eq $_}$self->languages
               or croak($language.' is not a valid language! ');
          if ($language eq 'all') {
               $self->{language} = '';
          }else {
               $self->{language} = $language;
               return $self;
          }
     }
     return $self;
}

sub languages
{
     ref(my $self = shift)
          or croak 'instance variable needed!';
     if (exists $self->{languages}) {             # does $self->{languages} exist?
          return @ {$self->{languages}};          # return the array $self->{languages}
     } else {                                     # if $self->{languages} does not exist, populate it
          @ {$self->{languages}} = qw(
                                          all ar zs zt cs da nl en et fi fr de el iw
                                          hu is it ja ko lv lt no pt pl ro ru es sv tr
                                    );
          return @ {$self->{languages}};          # and return it
     }
}

sub num_results
{
     ref(my $self = shift)
          or croak 'instance variable needed!';
     return $self->{num_results};
}

sub set_num_results
{
     ref(my $self = shift)
          or croak "instance variable needed!";
     my $num_results = shift;
     if (not defined $num_results) {
          $self->{num_results} = $self->_default_num_results;
          return $self;
     }
     if (not $num_results =~ m/^\d+$/) { croak 'odd number expected!'; }
     if ($num_results < 1) { croak 'minimum is 1 result!'}
     $self->{num_results} = $num_results;
     return $self;
}

sub perform_search
{
     ref(my $self = shift)
          or croak 'instance variable needed!';
     my $searchstring = $self->searchstring;
     my $language = $self->language;
     my $num_results = $self->num_results;
     if ($self->has_results) { $self->delete_results };
     my $agent = LWP::UserAgent->new;
     my $request = HTTP::Request->new(POST => 'http://www.scroogle.org/cgi-bin/nbbw.cgi');
     $request->content_type('application/x-www-form-urlencodde');
     my $postdata;
     if ($language ne 'all') {
          $postdata = 'Gw='.$searchstring.'&n=100&l='.$language.'&z=';
     } else {
          $postdata = 'Gw='.$searchstring.'&n=100&z=';
     }
     my $niterate;
     if ($self->num_results <= 100) {
          $niterate = 1;
     }else {
          $niterate = ($num_results - $num_results%100)/100;
          if ($num_results%100 == 0) { $niterate--; }
     }
     my $results_left = $num_results;
     for (0..$niterate) {
          $request->content($postdata.$_);
          my $result = $agent->request($request);
          for (split( '\n', $result->content)) {
               if ($results_left <= 0) { last; }
               if (m/^(\d{1,5})\. /) {
                    $self->_add_result({
                                        position => $1,
                                        url => $2
                                       });
                    $results_left--;
               }
          }
     }
     return 1;
}

sub _add_result
{
     ref (my $self = shift)
          or croak 'instance variable needed!';
     my $options = shift;
     if (not ref $options eq "HASH") { croak 'no options hash given!'; }
     if (not exists $options->{url}) { croak 'no url given!'; }
     if (not exists $options->{position}) { croak 'no position given!'; }
     my $result = WWW::Scroogle::Result->new({
                                              url            => $options->{url},
                                              position       => $options->{position},
                                              searchstring   => $self->searchstring,
                                              language       => $self->language,
                                             });
     push @ {$self->{results}}, $result;
     return $self;
}

sub nresults
{
     ref (my $self = shift)
          or croak 'instance variable needed!';
     if ($self->has_results) {
          my $nresults = @ {$self->{results}};
          return $nresults;
     }
     croak 'no results avaible';
}

sub get_results
{
     ref (my $self = shift)
          or croak 'instance variable needed!';
     if (not $self->has_results) { croak 'no results avaible' }
     return @ {$self->{results}};
}

sub has_results
{
     ref (my $self = shift)
          or croak 'instance variable needed!';
     if (exists $self->{results}) {
          1;
     }else {
          return;
     }
}

sub delete_results
{
     ref (my $self = shift)
          or croak 'instance variable needed!';
     if ($self->has_results) {
          delete $self->{results};
          1;
     }else {
          return;
     }
}

sub get_result
{
     ref (my $self = shift)
          or croak 'instance variable needed!';
     defined (my $requested_result = shift)
          or croak 'no value given';
     if (not $self->has_results) { croak 'no results avaible'; }
     return $self->{results}[$requested_result - 1];
}

sub position
{
     ref (my $self = shift)
          or croak 'instance variable needed!';
     defined (my $string = shift)
          or croak 'no string given!';
     if (not $self->has_results) { croak 'no results avaible'; }
     for (@ {$self->{results}}) {                 # iterate over all avaible results
          if ($_->url =~ /$string/) {             # does the url match the given pattern?
               return $_->position                # return the position of the result
          }
     }
     return;                                      # return boolean false if no matches were found
}

sub positions
{
     ref (my $self = shift)
          or croak 'instance variable needed!';
     defined (my $string = shift)
          or croak 'no string given!';
     if (not $self->has_results) { croak 'no results avaible'; }
     my @results = $self->get_results_matching($string); # get array of result objects
     my @return;
     for (@results) {                             # iterate array of result objects
          push @return, $_->position;             # push the position number of that array to @return
     }
     if (scalar(@return) == 0) { return; }        # return boolean false if no matches were found
     return @return;                              # return the array of position numbers
}

sub get_results_matching
{
     ref (my $self = shift)
          or croak 'instance variable needed!';
     defined (my $string = shift)
          or croak 'no string given!';
     if (not $self->has_results) { croak 'no results avaible'; }
     my @return;
     for (@ {$self->{results}}) {                 # iterate over all avaible results
          if ($_->url =~ /$string/) {             # does the url match the given pattern?
               push @return, $_;                  # push the result object to @return
          }
     }
     if (scalar(@return) == 0) { return; }        # return boolean false if no matches were found
     return @return;                              # return the array of result objects
}
1;

__END__