File Coverage

blib/lib/WWW/FindConcept.pm

Criterion	Covered	Total	%
statement	16	32	50.0
branch	0	4	0.0
condition			n/a
subroutine	6	8	75.0
pod			n/a
total	22	44	50.0

# $Id: FindConcept.pm,v 1.7 2004/01/06 07:40:30 cvspub Exp $
package WWW::FindConcept;

use strict;

use WWW::FindConcept::Sources;
use WWW::Mechanize;
use Data::Dumper;
use Exporter;

our @ISA = qw(Exporter);
our @EXPORT = qw(find_concept update_concept delete_concept dump_cache remove_cache);
our @EXPORT_FAIL = qw(extract get_concept);

our $VERSION = '0.03';

our $cachepath = $ENV{HOME}."/.find-concept";

sub extract {
    my ($pattern, $text, $concept) = @_;
#    print $pattern.$/;
    while($text =~ /$pattern/g){
	$concept->{$1} = 1;
    }
}

sub get_concept {
    die unless caller eq __PACKAGE__;
    my ($url, $template) = @{shift()};
    my ($query) = shift;
    my ($concept) = shift;
    $url =~ s/\Q{%query%}\E/$query/o;

    my $a = WWW::Mechanize->new(
				env_proxy => 1,
				timeout => 10,
				);
    $a->agent_alias( 'Windows IE 6' );
    $a->get( $url );
    if($a->success){
	extract($template, $a->content, $concept);
#	print $template.$/;
#	print Dumper $concept;
    }
}

use DB_File;
use Storable qw(freeze thaw);

sub delete_concept($) {
    tie my %cache, 'DB_File', $cachepath, O_CREAT | O_RDWR, 0644, $DB_BTREE
	or die "cannot open $cachepath";
    delete $cache{$_[0]};
    untie %cache;
}

sub find_concept($) {
    my $query = shift;
    my %concept;
    tie my %cache, 'DB_File', $cachepath, O_CREAT | O_RDWR, 0644, $DB_BTREE
	or die "cannot open $cachepath";

    if($cache{$query}){
	%concept = %{ thaw($cache{$query}) };
    }
    else{
	foreach my $src ( keys %WWW::FindConcept::Sources::source ){
#	    next if $WWW::FindConcept::Sources::source{$src}->[-1] eq 'to_skip';
	    get_concept($WWW::FindConcept::Sources::source{$src}, $query, \%concept);
	}
	$cache{$query} = freeze \%concept;
    }
    untie %cache;

    keys %concept;
}

sub dump_cache(){
    tie my %cache, 'DB_File', $cachepath, O_CREAT | O_RDWR, 0644, $DB_BTREE
	or die "cannot open $cachepath";
    my @c = keys %cache;
    untie %cache;
    return @c;
}

sub update_concept($) {
    delete_concept($_[0]);
    find_concept($_[0]);
}

sub remove_cache {
    unlink $cachepath;
}

1;
__END__