--- lib/Grep/Source.pm	2007/02/23 11:48:39	73
+++ lib/Grep/Source.pm	2007/06/11 22:56:53	165
@@ -7,8 +7,14 @@
 
 use Carp qw/verbose/;
 use Module::Pluggable search_path => 'Grep::Source', sub_name => 'sources', require => 1;
-use base qw(Class::Accessor);
-Grep::Source->mk_accessors( qw(feed uri q new_items collection) );
+use base qw(Class::Accessor Jifty::Object);
+Grep::Source->mk_accessors( qw(feed uri q new_items collection search_obj tree) );
+
+use HTML::TreeBuilder;
+use WWW::Mechanize;
+use XML::Feed;
+use URI;
+use HTML::ResolveLink;
 
 use Data::Dump qw/dump/;
 
@@ -95,16 +101,19 @@
 
 	$self->uri( $uri );
 
-	Jifty->log->info( $message );
+	$self->log->info( $message );
 
 	$self->collection( Grep::Model::ItemCollection->new() );
 
 	my $class = $self->feed->source || 'Grep::Source::Feed';
-	Jifty->log->debug("using $class");
+	$self->log->debug("using $class");
+
+	$self->search_obj( Grep::Search->new() );
+	$self->log->debug("created " . $self->search_obj);
 
 	$class->fetch( $self );
 
-	Grep::Search->finish if $self->new_items;
+	$self->search_obj->finish;
 
 	return $self->collection;
 }
@@ -123,20 +132,28 @@
 sub add_record {
 	my $self = shift;
 
+	$self->log->confess("no search_obj") unless ($self->search_obj);
+
 	my $i = Grep::Model::Item->new();
 
-	my ($ok,$msg) = $i->load_or_create( @_ );
+	my $rec = {@_};
+
+	$self->log->debug("resolving links using base ", $rec->{link});
+	my $resolver = HTML::ResolveLink->new( base => $rec->{link} );
+	$rec->{content} = $resolver->resolve( $rec->{content} );
+
+	my ($ok,$msg) = $i->load_or_create( %$rec );
 
 	$msg ||= '';
 
 	if ( $ok ) {
-		Jifty->log->debug("item ", $i->id, ": $msg");
+		$self->log->debug("item ", $i->id, ": $msg");
 		$self->collection->add_record( $i );
 
 		# is new record?
 		if ( $msg !~ m/^Found/ ) {
-			Grep::Search->add( $i );
-			$self->new_items( $self->new_items + 1 );
+			$self->search_obj->add( $i );
+			$self->new_items( ( $self->new_items || 0 ) + 1 );
 		}
 	} else {
 		warn "can't add entry ", dump( @_ ), "\n";
@@ -157,11 +174,285 @@
 	my $content = shift or die "no content?";
 
 	foreach my $s ( $self->sources ) {
-		Jifty->log->debug("testing source class $s");
-		if ($s->can('content_have') && $s->content_have( $content ) ) {
-			Jifty->log->debug("${s}->content_have succesful");
-			return "$s";
+		$self->log->debug("testing source class $s");
+		if ( $s->can('content_have') ) {
+			my $regex =	$s->content_have( $content ) or
+				die "${s}->content_have didn't return anything";
+			die "${s}->content_have didn't return regex but ", dump( $regex ), " ref ", ref( $regex )
+				unless ( ref($regex) eq 'Regexp' );
+			if ( $content =~ $regex ) {
+				$self->log->debug("${s}->content_have succesful");
+				return $s;
+			}
+		}
+	}
+}
+
+
+=head2 element_by_triplet
+
+Helper method to select element(s) using C<element/attribute/value> triplet using
+L<HTML::TreeBuilder> trees.
+
+  my $el = $self->element_by_triplet(
+  	tree => $tree_or_element,
+	triplets => [ qw/
+		div id target
+		div class another
+	/ ],
+	message => 'find search result element',
+	fatal => 1,	# die instead of warn
+  );
+
+=cut
+
+sub element_by_triplet {
+	my $self = shift;
+
+	my $args = {@_};
+
+	my $tree = $args->{tree} || die "no tree";
+	my $message = $args->{message} || '';
+	my $fatal = $args->{fatal};
+	die "no triplets" unless defined( $args->{triplets} );
+	my @triplets;
+	if ( ref( $args->{triplets} ) eq 'ARRAY' ) {
+		@triplets = @{ $args->{triplets} };
+	} else {
+		@triplets = ( $args->{triplets} );
+	}
+
+	push @triplets, ( undef, undef ) if ( $#triplets == 0 );
+
+	die "triplet doesn't have 3 elements but ", $#triplets unless (
+		( $#triplets + 1 ) % 3 == 0
+	);
+
+	my ( $el, $attr, $value );
+
+	my @results;
+	my @tags;
+
+	$self->log->debug("looking for $message ", dump( @triplets ));
+	while ( @triplets ) {
+		( $el,$attr,$value ) = splice( @triplets, 0, 3 );
+		my $tag = $attr ? "<$el $attr=\"$value\">" : "<$el>";
+		push @tags, $tag;
+		@results = $tree->look_down( '_tag', $el, sub {
+				return 1 unless ( $attr && $value );
+				( $_[0]->attr( $attr ) || '' ) =~ m/\b\Q$value\E\b/
+		});
+		last if @results;
+	}
+
+	if ( ! @results ) {
+		my $msg = "can't find $message " . join(" ", @tags);
+		die $msg if ( $fatal );
+		#warn $msg;
+		return;
+	}
+
+	$self->log->debug("found ", $#results + 1, " elements");
+	#warn dump( map { $_->as_HTML } @results );
+
+	return @results if wantarray;
+	return shift @results;
+}
+
+=head2 scrape
+
+Create semi-complex L<WWW::Mechanize> rules to scrape page easily
+
+  $parent->scrape(
+		# if search string isn't part or URI
+		submit_form => {
+			fields => {
+				value => $parent->q,
+			},
+			button => 'fullsearch',
+		},
+		# element with search results
+		wrapper => [ qw/div class searchresults/ ],
+		# element (or tripple) for each result with link
+		# <a href=".."> inside it to full-text result
+		results => 'dt',
+		# collect which element on page linked from results
+		scrape => [ qw/div id page/ ],
+		# when search returns just single hit, it will redirect to result page
+		redirect_single_result => 1,
+  );
+
+=cut
+
+sub scrape {
+	my $self = shift;
+
+	my $args = {@_};
+
+	$self->log->debug("scrape with args ",dump($args));
+
+	my ($feed,$uri,$q) = ($self->feed, $self->uri,$self->q);
+	die "no uri" unless ($uri);
+	die "feed is not a Grep::Model::Feed but ", ref $feed unless $feed->isa('Grep::Model::Feed');
+
+	sub mech_warn {
+		my $m = shift || return;
+		warn $m;
+	}
+
+	my $mech = WWW::Mechanize->new(
+		cookie_jar => {},
+		onwarn => \&mech_warn,
+		onerror => \&mech_warn,
+	);
+
+	$mech->get( $uri );
+
+	$self->save( 'get.html', $mech->content );
+
+	if ( my $form = $args->{submit_form} ) {
+		$self->log->debug("submit form on $uri with ", dump( $form ));
+		$mech->submit_form( %$form ) or die "can't submit form ", dump( $form );
+		$self->save( 'submit.html', $mech->content );
+	}
+
+	$self->log->debug("parse result page");
+
+	my $tree = HTML::TreeBuilder->new or die "can't create html tree";
+	$tree->parse( $mech->content ) or die "can't parse fetched content";
+
+	my @wrapper_divs = $self->element_by_triplet(
+		tree => $tree,
+		triplets => $args->{wrapper},
+		message => 'wrapper for all results',
+		# on closer recollection, this shouldn't be ever fatal, because
+		# "no results found" page might not contain wrapper
+		#fatal => $args->{redirect_single_result} ? 0 : 1,
+	);
+
+	my $max = 15;
+	my $nr = 1;
+
+	my $base_uri = $uri;
+	$base_uri =~ s!\?.*$!!;
+
+	# directly got first result
+	if ( $args->{redirect_single_result} && ! @wrapper_divs ) {
+
+		my $uri = $mech->uri; $uri->query( undef ); $uri = $uri->canonical;
+
+		my $div = $self->element_by_triplet(
+			tree => $tree,
+			message => "single result - redirect to $uri",
+			triplets => $args->{scrape},
+			fatal => 1,
+		);
+
+		$self->add_record(
+			in_feed => $feed,
+			title => $mech->title,
+			link => $uri,
+			content => $div->as_HTML,
+		);
+
+		$tree->delete; # clear memory!
+		return;
+	}
+
+	my @r;
+
+	foreach my $div ( @wrapper_divs ) {
+
+		my @r_here = $self->element_by_triplet(
+			tree => $div,
+			triplets => $args->{results},
+			message => 'result element',
+		);
+
+		push @r, @r_here if (@r_here);
+	}
+
+	$self->log->debug("in total, found ", $#r + 1, " results in ", $#wrapper_divs + 1, " result wrapper elements");
+
+	foreach my $dt ( @r ) {
+		my $a = $dt->look_down( '_tag', 'a', sub { $_[0]->attr('href') } );
+		if ( $a ) {
+
+			my $href = $a->attr('href') or die "can't find href inside <", $args->{results}, ">";
+
+			my $page_uri = URI->new_abs( $href, $base_uri );
+			$page_uri->query( undef );
+			$page_uri = $page_uri->canonical;
+
+			$self->log->debug("fetching page: ",$a->as_text," from $page_uri");
+			if ( $mech->follow_link( url => $href ) ) {
+
+				$self->save( "page-${nr}.html", $mech->content );
+
+				my $page_tree = HTML::TreeBuilder->new or die "can't create page tree";
+				$page_tree->parse( $mech->content ) or die "can't parse page at $page_uri";
+				my @divs = $self->element_by_triplet(
+					tree => $page_tree,
+					message => "result page $nr",
+					triplets => $args->{scrape}
+				);
+
+				if ( @divs ) {
+
+					my $html = join("<hr/>\n", map { $_->as_HTML } @divs );
+					$self->log->debug("combined ", $#divs + 1, " elements elements in ", length($html), " bytes");
+
+					$self->add_record(
+						in_feed => $feed,
+						title => $mech->title,
+						link => $page_uri,
+						content => $html,
+#						summary => 
+#						category => 
+#						author => 
+#						issued => 
+#						modified => 
+					);
+
+				} else {
+					$self->log->debug("NO CONTENT scraped from page $nr");
+				}
+
+				$mech->back;
+				$page_tree->delete;
+
+			} else {
+				warn "can't follow uri $page_uri: $!\n";
+			}
+		} else {
+			$self->log->debug("result $nr doesn't have link inside, ignoring...");
 		}
+
+		last if ($nr == $max);
+		$nr++;
+	}
+
+	$tree->delete; # clear memory!
+
+}
+
+=head2 save
+
+  save( 'name', $content );
+
+Save dumps into C</tmp/grep> if writable
+
+=cut
+
+sub save {
+	my $self = shift;
+	my ( $file, $content ) = @_;
+	return unless ( defined($file) && defined($content) );
+	if ( -w '/tmp/grep' ) {
+		open(my $f, '>', "/tmp/grep/$file") or die "can't open $file: $!";
+		print $f $content or die "can't write to $file: $!";
+		close $f or die "can't close $file: $!";
+		$self->log->debug("saved $file ",length($content)," bytes");
 	}
 }