File Coverage

blib/lib/WWW/MSA/Hadith.pm

Criterion	Covered	Total	%
statement	61	91	67.0
branch	11	32	34.3
condition	9	24	37.5
subroutine	11	13	84.6
pod	0	7	0.0
total	92	167	55.0

package WWW::MSA::Hadith;

# $Id: Hadith.pm,v 1.3 2003/06/21 09:03:22 sherzodr Exp $

use strict;
use Carp;
use vars qw($VERSION $PROXY $HADITH_URLF);

$VERSION     = '1.01';
$PROXY       = 'http://www.usc.edu/cgi-bin/msasearch';
$HADITH_URLF = 'http://www.usc.edu/dept/MSA/fundamentals/hadithsunnah/%s/%03d.sbt.html';


# Preloaded methods go here.



sub new {
  my $class = shift;
  $class = ref($class) || $class;

  my $self = {
    _USER_AGENT => undef,
    _QUERY      => "",
    _RESULTS    => [],
  };

  return bless ($self, $class);
}



sub DESTROY { }


sub query {
  my ($self, $str) = @_;

  if ( defined $str ) {
    $self->{_QUERY} = $str;
  }

  return $self->{_QUERY};
}


sub submit {
  my $self = shift;

  unless ( defined $self->query ) {
    croak "You didn't call query() yet";
  }

  my $user_agent = $self->user_agent();
  my %form_ref = (
    querystring => $self->query(),
    database    => 'bukhari',
    dbpath      => '/www/dept/MSA/reference/indices',
    logpath     => '/www/dept/MSA/reference/indices/logfile',
    xpath       => '/www/dept/MSA/reference/xfile'
  );

  my $response = $user_agent->post($PROXY, \%form_ref);
  if ( $response->is_error ) {
    croak "couldn't fetch the results: " . $response->status_line;
  }

  $self->{_CONTENT} = $response->content_ref;
  return $self->_parse_response($response);
}



sub _parse_response {
  my ($self, $response) = @_;

  my $content = ${$self->{_CONTENT}};

  require HTML::TreeBuilder;
  my $html = new HTML::TreeBuilder();
  $html->parse($content);

  for my $a ( $html->look_down(\&_is_hadith) ) {
    my $href = $a->attr('href');
    my $abs_href = URI->new_abs($href, $response->base);
    my $id = $abs_href->fragment;
    my ($volume, $book, $report) = $id =~ m/^(\d+)\.(\d+)\.(\d+w?)/;

    push @{$self->{_RESULTS}}, {
      id => $id,
      url => $abs_href->as_string,
      book => $book,
      volume => $volume,
      report => $report
    };
  }
  $html->delete();
}






sub get_result {
  my $self = shift;

  return shift @{$self->{_RESULTS}};
}



sub read {
  my ($self, $id) = @_;

  my $text = "";

  my ($volume, $book, $report) = $id =~ m/^(\d+)\.(\d+)\.(\d+\w?)$/;
  my $url = sprintf($HADITH_URLF, 'bukhari', $book);

  my $user_agent = $self->user_agent();
  my $response = $user_agent->get($url);
  if ( $response->is_error ) {
    die $response->status_line;
  }
  require HTML::TokeParser;
  my $html = HTML::TokeParser->new($response->content_ref) or die $!;

  my $header = 0;
  my $inside = 0;
  while ( my $token = $html->get_token() ) {
    if ( !$header && ($token->[0] eq 'S') && ($token->[1] eq 'a')
            && ($token->[2]->{name}) && ($token->[2]->{name} eq $id) ) {
      $header = 1;
      next;
    }
    $header or next;
    if ( ($token->[0] eq 'E') && ($token->[1] eq 'blockquote') ) {
      $header = 0;
      $inside = 0;
      last;
    }
    if ( ($token->[0] eq 'S') && ($token->[1] eq 'blockquote') ) {
      $inside = 1;
      next;
    }
    $inside or next;

    if ( ($token->[0] eq 'S') && ($token->[1] eq 'p') ) {
      $text .= "\n";
    } elsif ( $token->[0] eq 'T' ) {
      $text .= $token->[1];
    }
  }
  return $text;
}



sub result_count {
  my $self = shift;

  unless ( $self->{_RESULTS} ) {
    return 0;
  }
  return scalar @{$self->{_RESULTS}};
}


sub _is_hadith {
  my $el = shift;

  $el->tag() eq 'a' or return;
  $el->attr('href') or return;

  return $el->attr('href') =~ m!bukhari!;
}










sub user_agent {
  my $self = shift;

  if ( defined $self->{_USER_AGENT} ) {
    return $self->{_USER_AGENT};
  }
  require LWP::UserAgent;
  my $ua = LWP::UserAgent->new(from => '[e-mail]');
  $ua->agent( sprintf("%s (%s/%s)", $ua->agent(), ref($self), $self->VERSION) );

  $self->{_USER_AGENT} = $ua;
  return $self->user_agent();
}


1;
__END__