Apache-Wyrd
view release on metacpan or search on metacpan
Wyrd/Services/Index.pm view on Meta::CPAN
my $index = $self->{'db'};
if (ref($index) and UNIVERSAL::isa($index, 'Apache::Wyrd::Services::Index')) {
$index->db_close;
untie %{$self->{'db'}};
$self->{'db'} = undef;
delete ($self->{'status'}); #close the DB ref
$self->{'status'} = undef;
}
$index = $self->{'db_big'};
if (ref($index) and UNIVERSAL::isa($index, 'Apache::Wyrd::Services::Index')) {
$index->db_close;
untie %{$self->{'db_big'}};
$self->{'db_big'} = undef;
delete ($self->{'status'}); #close the DB ref
$self->{'status'} = undef;
}
my $env = $self->{'env'};
if (ref($env) and UNIVERSAL::isa($env, 'BerkeleyDB::Env')) {
$self->{'env'} = undef;
}
undef $index;
undef $env;
return;
}
=pod
=item (scalar) C<update_entry> (Apache::Wyrd::Interfaces::Indexable ref)
Called by an indexable object, passing itself as the argument, in order to
update it's entry in the index. This method calls C<index_foo> for every
attribute B<foo> in the index, storing that value under the attribute entry for
that object. The function always returns a message about the process.
update_entry will always check index_timestamp and index_digest. If the stored
value and the returned value agree on either attribute, the index will not be
updated. This behavior can be overridden by returning a true value from method
C<force_update>.
Index will also check for an C<index_runtime_flags> method and call it to
determine if the indexed object is attempting to modify the behavior of the
update during the process of updating for debugging purposes. Currently, it
recognizes the following flags:
=over
=item debug/nodebug
Turn on debugging messages for the course of this update, even if debug is
not specified in the arguments to C<new>.
=item nodata
Avoid processing, word-mapping, and storing the data attribute.
=back
=cut
#attributes - integer=name (self_path), 0=reverse, 1=timestamp, 2=digest, 3=data, 4=word, 5=count, 6=title, 7=keywords, 8=description
sub update_entry {
my ($self, $entry) = @_;
$self->set_error = "Index entries must be objects " unless (ref($entry));
#localize debug value so that the entry can modify it.
my $debug = $self->debug;
$self->{'runtime_flags'} = {};
if (UNIVERSAL::can($entry, 'index_runtime_flags')) {
map {$self->{'runtime_flags'}->{$_} => 1} token_parse($entry->index_runtime_flags);
$debug = 1 if ($self->{'runtime_flags'}->{'debug'});
$debug = 0 if ($self->{'runtime_flags'}->{'nodebug'});
}
foreach my $function (qw/no_index index_name index_timestamp index_digest index_data/) {
$self->set_error("Index entries must implement the method $function\(\)") unless ($entry->can($function));
}
my $name = $entry->index_name;
$self->set_error("Index entries must return non-null for method index_name()") unless ($name);
$self->check_error;
$self->set_error("<DELETED> is an invalid name for index entries ") if ($name eq '<DELETED>');
$self->set_error($name . " is an invalid name for index entries ") if ($name =~ /^.%/s);
$self->check_error;
my $index = $self->read_db;
my $null = undef;#used for DB checks where no value needs be returned
if ($entry->no_index) {
if ($index->db_get("\x00%" . $name, $null)) {
#if key is not found
return "yes to no_index and not indexed.";
}
$index = $self->write_db;
my $result = $self->purge_entry($name);
$self->close_db;
return $result;
}
my ($id, $id_is_new) = $self->get_id($name);
$debug && warn $name . " is new" if ($id_is_new);
unless ($entry->force_update) {
$index->db_get("\x01\%$id", my $timestamp);
$debug && warn "Comparing timestamps: $timestamp <-> " . $entry->index_timestamp . " for " . $name;
if ($timestamp eq $entry->index_timestamp) {
$debug && warn "No update needed. Timestamp is $timestamp." ;
return "No update needed. Timestamp is $timestamp." ;
}
if ($timestamp) {
#Timestamp was found and is different, so calculate an sha1 fingerprint and see if there really
#has been a change.
$index->db_get("\x02\%$id", my $digest);
$debug && warn "Comparing digests: $digest <-> " . $entry->index_digest . " for " . $name;
if ($digest eq $entry->index_digest) {
$index = $self->write_db;
$self->update_key("\x01\%$id", $entry->index_timestamp);
$self->close_db;
$debug && warn "Updated timestamp only, since digest was identical.";
return "Updated timestamp only, since digest was identical.";
}
#} else {
# warn "skipping digest check and updating index, since no timestamp was found."
}
}
$index = $self->write_db;
#scope out a transaction handle whether you need it or not.
my $txn = undef;
Wyrd/Services/Index.pm view on Meta::CPAN
return $self->get_entry($id);
}
sub get_entry {
#note - Call get_entry with an ID ONLY. No names
my ($self, $id, $params) = @_;
$params = {} unless (ref($params) eq 'HASH');
my $failed = $self->db->db_get($id, my $name);
return {} if ($failed);
my %entry = (id => $id, name => $name);
my @attributes = @{$self->attribute_list};
my %skip = map {$_ => 1} (@{$params->{'skip'} || []}, @{$self->map_list}, 'name', 'id');
@attributes = grep {!$skip{$_}} @attributes;
if ($params->{'limit'}) {
my %limit = map {$_ => 1} @{$params->{'limit'}};
@attributes = grep {$limit{$_}} @attributes;
}
if ($params->{'require'}) {
my %unique = ();
@attributes = grep {$unique{$_}++ == 0} (@attributes, @{$params->{'require'}});
}
foreach my $attribute (@attributes) {
$self->db->db_get($self->attributes->{$attribute} . '%' . $id, $entry{$attribute});
if ($self->bigfile and $entry{$attribute} =~ s/^\x00://) {
my $key = $entry{$attribute};
$self->db_big->db_get($key, $entry{$attribute});
}
}
return \%entry;
}
sub get_id {
my ($self, $name) = @_;
my $result = $self->db->db_get("\x00%$name", my $id);
return $id unless ($result);
$result = $self->db->db_get("\xff%greatest_id", $id);
$id ||= 0;#make ID numerical
#warn ("Did not find $name. Higest ID found by metadata: " . ($result || $id));
#warn $self->_error("Index metadata failed to find a highest ID, scanning instead...") if ($result);
$id++;
while (not($self->db->db_get($id, my $null))) {
#make sure this really is a key, and if the metadata fails, we're scanning anyway
$id++;
}
return ($id, 1);#new id + flag
}
sub get_value {
my ($self, $key) = @_;
my $result = $self->db->db_get($key, my $value);
return undef if (($result eq 'DB_NOTFOUND') or !$result);
$self->recover_db;
$self->read_db;
$result = $self->db->db_get($key, $value);
return undef if (($result eq 'DB_NOTFOUND') or !$result);
$self->set_error("Could not get key: " . $result);
$self->check_error;
return;
}
sub update_key {
my ($self, $key, $value) = @_;
my $result = $self->db->db_put($key, $value);
return undef unless ($result);
$self->recover_db;
$self->write_db;
$result = $self->db->db_put($key, $value);
return undef unless ($result);
$self->set_error("Could not set key: " . $result);
$self->check_error;
return;
}
sub delete_key {
my ($self, $key) = @_;
my $result = $self->db->db_del($key);
return undef if (($result == DB_NOTFOUND) or !$result);
$self->recover_db;
$self->write_db;
$result = $self->db->db_del($key);
return undef if (($result == DB_NOTFOUND) or !$result);
$self->set_error("Could not delete key: " . $result);
$self->check_error;
}
sub process_html {
my ($self, $id, $data) = @_;
return undef if ($self->{'runtime_flags'}->{'no_data'});
#Remove all punctuation noise from the data and turn all control characters
#and unicode into entities
$data = $self->clean_html($data);
#if we're doing bigfiles, we get a chance to override the re-indexing
#of large swaths of data if there has been no change to the html of the
#indexed object
if ($self->bigfile and length($data) >= 2048) {
$self->db->db_get("\x03\%$id", my $old_key);
$old_key =~ s/^\x00://;
my $current_key = sha1_hex($data);
if ($current_key ne $old_key) {
$self->db_big->db_put($current_key, $data);
my $wordcount = $self->index_words($id, $data);
$self->update_key("\x03\%$id", "\x00:$current_key");
$self->update_key("\x05\%$id", $wordcount);
}
return;
}
$self->update_key("\x03\%$id", $data);
my $wordcount = $self->index_words($id, $data);
$self->update_key("\x05\%$id", $wordcount);
#warn "\x03\%$id updated to $data";
return;
}
sub extract_html {
my ($self, $id) = @_;
$self->db->db_get("\x03\%$id", my $data);
if ($data =~ s/^\x00:(.+)//) {
( run in 1.526 second using v1.01-cache-2.11-cpan-9581c071862 )