=pod

=head1 NAME

WWW::Search::Scraper - General purpose HTML parser/scraper.


=head1 SYNOPSIS

  use WWW::Search::Scraper;

=head1 DESCRIPTION

TODO

=head1 AUTHOR

Glenn Wood, C<glenwood@alumni.caltech.edu>.


=head1 COPYRIGHT

Copyright (C) 2001 Glenn Wood. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut


####################################################################################
####################################################################################
####################################################################################
####################################################################################

package WWW::Search::Scraper;

require Exporter;
@EXPORT = qw();
@EXPORT_OK = qw();
@ISA = qw(WWW::Search Exporter);
$VERSION = '1.00';
#'

use Carp ();
use WWW::Search;
require WWW::SearchResult;
@EXPORT_OK = qw(escape_query unescape_query generic_option strip_tags @ENGINES_WORKING trimAdmClutter addURL);

use strict;

sub generic_option 
{
    my ($option) = @_;
    return 1 if $option =~ /^scrape/;
    return WWW::Search::generic_option($option);
}

sub native_retrieve_some
{
    my ($self) = @_;
    
    # fast exit if already done
    return undef if (!defined($self->{_next_url}));
    
    # get some
    print STDERR "WWW::Search::HotJobs::native_retrieve_some: fetching " . $self->{_next_url} . "\n" if ($self->{_debug});
    my $method = $self->{'_http_method'};
    $method = 'GET' unless $method;
    my($response) = $self->http_request($method, $self->{_next_url});
    $self->{_next_url} = undef;
    $self->{response} = $response;
    return undef unless $response->is_success;
    
    my $hits_found = $self->scrape($response->content(), $self->{_debug});
    
    # sleep so as to not overload HotJobs
    $self->user_agent_delay if (defined($self->{_next_url}));
    
    return $hits_found;
}


# private
sub scrapeRow {
   my ($self, $hit, $rowDef, $row, $debug) = @_;
   $hit = new WWW::SearchResult unless $hit; # Set up a dummy stub if $hit is not defined.
   
   print "detailRow: $row\n" if $debug;
   for my $x4 ( $$rowDef[1] )
   {
      map 
      {
         my $datDef = $_;
         if ( 'TD' eq $$datDef[0] or 'DT' eq $$datDef[0] or 'DD' eq $$datDef[0] )
         {
            my $tag = $$datDef[0];
            my $datParser = $$datDef[2];
            $row =~ s-$tag\s*[^>]*>(.*?)</$tag\s*[^>]*>--si;
            my $dat = $1; 
            print "raw dat: '$dat'\n" if $debug;
            if ( $debug ) { # print ref $ aways does something screwy
               print "datParser: ";
               print ref $datParser;
               print "\n";
            };
            for my $binding ( $$datDef[1] ) {
               print "binding: $binding\n" if $debug;
               if ( $datParser ) {
                  print "parsed dat: '".&$datParser($self, $hit, $dat)."'\n" if $debug;
                  $hit->_elem($binding, &$datParser($self, $hit, $dat));
               } else {
                  print "trimmed dat: '".trimAdmClutter($dat)."'\n" if $debug;
                  $hit->_elem($binding, trimAdmClutter($dat));
               }
            }
            print "\n" if $debug;
         } else {die "Error in scaffold definition.\n";};
      } @$x4;
   }
}


# private
sub scrapeNEXT {
   my ($self, $next_url_button, $dat, $debug) = @_;

   print "next_url_button: $next_url_button\n" if $debug;
   $dat =~ m-<A\s+HREF="([^"]+)"[^>]+>$next_url_button</A>-si;
   my ($url) = new URI::URL($1, $self->{_base_url});
   $url = $url->abs;
   $self->{_next_url} = $url;
   print "NEXT_URL: $url\n" if $debug;
}


sub scrape { my ($self, $content, $debug) = @_;
   return scrapeTable($self, $content, $debug);
}

sub scrapeTable  { my ($self, $content, $debug) = @_;
   my $hits_found = 0;

   for my $x1 ( $self->{'_options'}{'scrapeFrame'}[1],  ) # <HTML> is implicit, so we don't do any processing on it.
   {
      map
      {
         if ( 'BODY' eq $$_[0] )
         {  
            my $bodyDef = $_;
            my $body = $content;
            # Process the BEGIN attribute.
            if ( $$bodyDef[1] ) {
               $body =~ s-^.*$$bodyDef[1]--s; # Make the parsing easier for scrapeTable() by stripping off the adminstrative clutter.
            }
            # Process the END attribute.
            if ( $$bodyDef[2] ) {
               $body =~ s-$$bodyDef[2]$--s; # Make the parsing easier for scrapeTable() by stripping off the adminstrative clutter.
            }
            for my $x2 ( $$bodyDef[3] ) 
            {
               map
               {
                  if ( 'TABLE' eq $$_[0] )
                  {  my $tblName = $$_[1]; print "tblName: $tblName\n" if $debug;
                     my $table = $body;
                     if ( $tblName =~ /^#(\d*)$/ )
                     {
                          for (1..$1) {
                             $table =~ s-<TABLE\s*[^>]+>(.*?)</TABLE\s*[^>]*>--si;
                          }
                          $table =~ m-<TABLE\s*[^>]+>(.*?)</TABLE\s*[^>]*>-si;
                          $table = $1;
                     } else {
                        $table =~ m-<TABLE\s+[^>]*NAME="$tblName"[^>]*>(.*?)</TABLE\s*[^>]*>-si;
                        $table = $1;
                     }
                     for my $x3 ( $$_[2] ) 
                     {
                        map 
                        {
                           if ( 'HIT*' eq $$_[0] )
                           {
                              while ( $table =~ m-(<TR\s*[^>]*>(.*?)</TR\s*[^>]*>)-si ) # while <table> has <tr>'s.
                              {
                                 my $hit = new WWW::SearchResult;
                                 my $raw = '';
                                 for my $x4 ( $$_[1] )
                                 {
                                    map {
                                       if ( 'TR' eq $$_[0] ) {
                                          my $rowDef = $_;
                                          $table =~ s-(<TR\s*[^>]*>(.*?)</TR\s*[^>]*>)--si;
                                          $raw .= $1;
                                          $self->scrapeRow($hit, $rowDef, $2, $debug);
                                       } else {die "Error in scaffold definition; expecting TR.\n";};
                                    } @$x4;
                                 }
                                 push @{$self->{cache}}, $hit;
                                 $hits_found += 1;
                              }
                           }
                           elsif ( 'TR' eq $$_[0] ) 
                           {
                              my $rowDef = $_;
                              $table =~ s-<TR\s*[^>]*>(.*?)</TR\s*[^>]*>--si;
                              $self->scrapeRow(undef, $rowDef, $1, $debug);
                           }
                           elsif ( 'NEXT' eq $$_[0] )
                           {  
                              $self->scrapeNEXT(undef, $$_[2], $table, $debug);
                           } else {die "Error in scaffold definition; expecting ( HIT* | TR | NEXT ).\n";};
                        } @$x3;
                     }
                  }
                  elsif ( 'HIT*' eq $$_[0] )
                  {
                     my $table = $body;
                     while ( $table =~ m-(<DL\s*[^>]*>(.*?)</DL\s*[^>]*>)-si ) # while <table> has <tr>'s.
                     {
                        my $hit = new WWW::SearchResult;
                        my $raw = '';
                        for my $x4 ( $$_[1] )
                        {
                           map {
                              if ( 'DL' eq $$_[0] ) {
                                 my $rowDef = $_;
                                 $table =~ s-(<DL\s*[^>]*>(.*?)</DL\s*[^>]*>)--si;
                                 $raw .= $1;
                                 $self->scrapeRow($hit, $rowDef, $2, $debug);
                              } else {die "Error in scaffold definition; expecting DL.\n";};
                           } @$x4;
                        }
                        push @{$self->{cache}}, $hit;
                        $hits_found += 1;
                     }
                  }
                  elsif ( 'COUNT' eq $$_[0] )
                  {
                    $self->approximate_result_count(0);
                    if ( $body =~ m/$$_[1]/ ) 
                        {
                            print "approximate_result_count: '$1'\n" if $debug;
                            $self->approximate_result_count($1);
                        };
                  } 
                  elsif ( 'REGEX*' eq $$_[0] ) 
                  {
                      my @ary = @$_;
                      shift @ary;
                      my $regex = shift @ary;
                      my $dat = $body;
                      while ( $dat =~ s/$regex//si ) {
                          my @dts = ($1,$2,$3,$4,$5,$6,$7,$8,$9);
                          my $hit = new WWW::SearchResult;
                          for ( @ary ) {
                              if ( $_ eq '' ) {
                                  shift @dts;
                              }
                              elsif ( $_ eq 'url' ) {
                                  my $url = new URI::URL(shift @dts, $self->{_base_url});
                                  $url = $url->abs;
                                  $hit->add_url($url);
                              } 
                              else {
                                  $hit->_elem($_, shift @dts);
                              }
                          }
                          push @{$self->{cache}}, $hit;
                          $hits_found += 1;
                      }
                  }
                  elsif ( 'NEXT' eq $$_[0] )
                  {  
                     $self->scrapeNEXT(undef, $$_[2], $body, $debug);
                  }
                  else {die "Error in scaffold definition; got '$$_[0]', expecting ( TABLE | HIT* | COUNT | REGEX* ).\n";};
               } @$x2;
            } #else {die "Error in scaffold definition; expecting ( TABLE | HIT* ).\n";};
         } else {die "Error in scaffold definition; expecting BODY.\n";};
      } @$x1;
   }
   return $hits_found;
}



sub addURL {
   my ($self, $hit, $dat) = @_;
   
   if ( $dat =~ m-<A\s+HREF="([^"]+)"[^>]*>-si )
   {
      my ($url) = new URI::URL($1, $self->{_base_url});
      $url = $url->abs;
      $hit->add_url($url);
   } else
   {
      $hit->add_url("Can't find HREF in '$dat'");
   }

   return trimAdmClutter($dat);
}

sub trimAdmClutter { # Strip administrative clutter from $_;
   my $dat = shift;
   # This removes all HTML <tags> from the string, leaving just the data!
   $dat =~ s-<BR>-\n-gsi; # Translate <BR>'s
   $dat =~ s-</?[^>]+>--sg;
   return $dat;
}

1;
