Apache-Wyrd

 view release on metacpan or  search on metacpan

Wyrd/Interfaces/Columnize.pm  view on Meta::CPAN

	$class = qq( class="$class") if $class;
	my $cellpadding = ($self->{'cellpadding'} || '0');
	my $cellspacing = ($self->{'cellspacing'} || '0');

	my $out = undef;
	my $rows = scalar(@items) ? int(1 + (@items/$cols)) : 1;
	if ($self->{'direction'} eq 'down') {#only re-map the array to the down-first direction if specified
		my (@newitems, $counter, $rowcounter) = ();
		my $count = $#items;
		while (@items) {#map a new array by iterating across the old array horizontal-wise
			my $cursor = $counter;
			while ($cursor <= $count) {
				my $item = shift @items;
				$newitems[$cursor] = $item;
				$cursor += $cols;
			}
			$counter++;
		}
		while (@newitems < ($cols * $rows)) {#fill in additional items;
			push @newitems, '&nbsp';
		}
		@items = @newitems;
	}
	while (@items) {
		$out .= join (

Wyrd/Services/Index.pm  view on Meta::CPAN

				$value .= pack "n", $item;
				$value .= pack "n", $entries{$item};
			}
			push (@updates, "$attribute\%$entry", $value);
		}
		$self->db->db_del("$rev_attribute\%$id")  && $self->set_error("Could not remove reversemap for $attribute_name on id $id");
	}
	if ($reversemap_notfound) {
		$debug && $self->reversemaps && warn ("No reverse index for map $attribute_name.  Doing a full purge of $id from the map.");
		my ($key, $current, $removed) = ();
		my $cursor = $self->db->db_cursor;
		unless ($cursor) {
			$self->read_db;
			$cursor = $self->db->db_cursor;
			unless ($cursor) {
				warn 'Failed to obtain DB Cursor.  Aborting purge_map()';
				return 1;
			}
		}
		$cursor->c_get($key, $current, DB_FIRST);
		do {
			if (unpack("C", $key) == ord($attribute)) {
				my $value = undef;
				my $do_update = 0;
				use Apache::Wyrd::Services::SAK qw(spit_file);
				my @test = unpack("n*", $current);
				if (@test % 2) {
					warn 'broken at ' . ord($attribute);
					spit_file('/Users/barry/Desktop/dump', $current);
					die;

Wyrd/Services/Index.pm  view on Meta::CPAN

				foreach my $item (keys %entries) {
					if ($item eq $id) {
						$do_update = 1;
						next;
					}
					$value .= pack "n", $item;
					$value .= pack "n", $entries{$item};
				}
				push (@updates, $key, $value) if ($do_update);
			}
		} until ($cursor->c_get($key, $current, DB_NEXT));
		$cursor->c_close;
	}
	#cursors have fallen out of scope.  Time to perform the updates.
	while (@updates) {
		my $value = pop @updates;
		my $key = pop @updates;
		$self->update_key($key, $value);
	}
	return scalar($self->error);
}

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

Wyrd/Services/Index.pm  view on Meta::CPAN

sub parsed_search {
	my $self = shift;
	my $parser = Apache::Wyrd::Services::SearchParser->new($self);
	return $parser->parse(@_);
}

sub get_all_entries {
	my $self=shift;
	my @entries = ();
	my $cursor = $self->db->db_cursor;
	$cursor->c_get(my $id, my $entry, DB_FIRST);
	do {
		push @entries, $entry if ($id =~ /^\x00%/);
	} until ($cursor->c_get($id, $entry, DB_NEXT));
	$cursor->c_close;
	return @entries;
}

sub make_key {
	my ($self, $attribute, $id) = @_;
	return $self->attributes->{$attribute} . '%' . $id;
}

sub translate_packed {
	return join('',  map {(($_ + 0) < 33 or ($_ + 0) > 122) ? '{' . $_ . '}' : chr($_)} unpack('c*', $_[1]) );

Wyrd/Site/Index.pm  view on Meta::CPAN

text of the output from that purge.

=cut

sub purge_missing {
	my ($self, $req) = @_;
	die ("index site requires an Apache request object, not a: " . ref($req)) unless (ref($req) eq 'Apache');
	my $root = $req->document_root;
	my $result = "<P>First checking for deleted documents:";
	my $index = $self->write_db;
	my $cursor = $index->db_cursor;
	my %exists = ();
	$cursor->c_get(my $id, my $document, DB_FIRST);
	do {
		$exists{$id}=1 if ($id =~ /^\d\d/);
	} until ($cursor->c_get($id, $document, DB_NEXT));
	$cursor->c_get($id, $document, DB_FIRST);
	do {
		my ($current_id) = $id =~ /^[\x00-\xff]%(\d+)/;
		if ($id =~ /^\d\d/) {
			if (-f "$root$document") {
				$result .= "<BR>keeping $root$document" 
			} else {
				$result .= "<BR>destroying $root$document: " . $self->purge_entry($id);
			}
		} elsif (not($exists{$current_id})) {
			my $error = $index->db_del($id);
			$result .= "<br>warning: purged corrupt data for nonexistent id $current_id: ". ($error ? 'failed!' : 'succeeded.');
		}
	} until ($cursor->c_get($id, $document, DB_NEXT));
	$cursor->c_close;
	$self->close_db;
	return "$result</p>";
}

=pod

=item (scalar) C<skip_file> (scalar)

Simple filter for removing files from consideration by the index.  Intended
as an over-loadable handle.  Returns 0 if the file should be indexed. 

Wyrd/Site/IndexBot.pm  view on Meta::CPAN

	print "<P>First checking for deleted documents and corrupt data";
	my $index = $instance->write_db;
	my %ismap = ();
	foreach my $value (keys %{$instance->maps}) {
		$value = $instance->attributes->{$value};
		$ismap{$value} = 1;
	}
	my %exists = ();
	my %reverse = ();
	my %force_purge = ();
	my $cursor = $index->db_cursor;
	$cursor->c_get(my $id, my $document, DB_FIRST);
	do {
		my ($first, $second, $identifier) = unpack('aaa*', $id);
		if ($second ne '%') {
			#if the metachar is not there, this is a primary filename map.
			$exists{$id} = $document || 'error: unnamed entry';
		} elsif ($first eq "\0") {
			#if the metachar is 0, this is a reversemap
			$reverse{$document} = $identifier;
		}
	} until ($cursor->c_get($id, $document, DB_NEXT));
	undef $cursor;
	foreach my $id (keys %exists) {
		my $document = $exists{$id};
		if ($reverse{$id} ne $exists{$id}) {
			print "Entry $id for $exists{$id} seems to be a duplicate entry.  Deleting it prior to purge...";
			my $result = $index->db_del($id);
			$force_purge{$id} = 1;
			if ($result) {
				print "Failed to delete dangling entry $id.  Manual repair may be necessary...";
			}
		} elsif (-f ($root . $document)) {

Wyrd/Site/IndexBot.pm  view on Meta::CPAN

				} else {
					print"skipping dirty reference to a previously deleted document";
				}
			} elsif ($document =~ /^\//) {
				print "purging proxy reference to deleted document $root$document: ". $instance->purge_entry($id);
			} else {
				print "purging reference to a dropped proxy to $document ($file): ". $instance->purge_entry($id);
			}
		}
	}
	#re-invoke an instance of cursor since db may have changed (just in case)
	$cursor = $index->db_cursor;
	$cursor->c_get(my $id, my $document, DB_FIRST);
	do {
		my ($attribute, $separator, $current_id) = unpack('aaa*', $id);
		if ($separator ne '%') {
			#do nothing with primary data
		} elsif ($ismap{$attribute}) {
			my $do_update = 0;
			my $value = '';
			my @ids = ();
			my(%entries) = unpack("n*", $document);
			foreach my $item (keys %entries) {

Wyrd/Site/IndexBot.pm  view on Meta::CPAN

			};
		} elsif ($attribute eq "\xff") {
			#do nothing to global metadata
		} elsif (not($current_id)) {
			print "Strange null entry under attribute " . $instance->attribute_list->[unpack "C", $id] . "... Your guess is as good ad mine...";
		} elsif ($force_purge{$current_id} or (not(($attribute eq "\x00")) and not($exists{$current_id}))) {
			my $error = $index->db_del($id);
			my $ord = unpack "C", $id;
			print "WARNING: purged corrupt data for nonexistent id $current_id — " . ($instance->attribute_list->[$ord] || "Unknown attribute [$ord]") . " (id# $current_id): ". ($error ? 'failed!' : 'succeeded.');
		}
	} until ($cursor->c_get($id, $document, DB_NEXT));
	$cursor->c_close;
	$instance->close_db;
	print "</p>";
	return @no_skip;
}


=pod

=head1 AUTHOR