adding perl search index builder

1 files changed, 159 insertions, 0 deletions

diff --git a/search/lib/Bucky.pm b/search/lib/Bucky.pm
new file mode 100644
index 0000000..181c1ae
--- /dev/null
+++ b/search/lib/Bucky.pm
@@ -0,0 +1,159 @@
+package Bucky;
+
+use strict 'vars';
+
+use Data::Dumper;
+use Common;
+
+use localbucky qw("config");
+
+use Bucky::DB;
+use Bucky::Keyword;
+use Bucky::Search;
+use Bucky::Session;
+use Bucky::Thread;
+# use Bucky::Comment;
+# use Bucky::File;
+use Bucky::SVN;
+
+our $TYPE_Bucky			= "bucky";
+our $TYPE_Keyword		= "keyword";
+our $TYPE_Thread		= "thread";
+our $TYPE_Comment		= "comment";
+our $TYPE_File			= "file";
+
+our $VALID_TYPES =
+	{
+	$TYPE_Bucky => 1,
+	$TYPE_Keyword => 1,
+	$TYPE_Thread => 1,
+	$TYPE_Comment => 1,
+	$TYPE_File => 1,
+	};
+sub valid_types
+	{ return $VALID_TYPES; }
+sub is_valid_type
+	{
+	my ($self, $type) = @_;
+#	print "TYPE $type IS VALID? >>> " . $self->valid_types->{$type} . "\n";
+	return $self->valid_types->{$type};
+	}
+sub bucky_data_path
+	{ return "/var/www/vhosts/carbonpictures.com" }
+sub new
+	{
+	my ($class, $self) = @_;
+	$self ||= {};
+	bless $self, $class;
+	return $self;
+	}
+sub type
+	{ return $TYPE_Bucky; }
+sub inherit
+	{
+	my ($self, $parent) = @_;
+	if ($parent && ref($parent) =~ /Bucky/)
+		{
+		$self->db($parent);
+		$self->bucky($parent);
+		}
+	}
+sub bucky
+	{
+	my ($self, $parent) = @_;
+	return $self->{_bucky} if $self->{_bucky};
+	if ($parent && ref($parent) eq "Bucky")
+		{ $self->{_bucky} = $parent; }
+	elsif ($parent && ref($parent) =~ /Bucky/)
+		{ $self->{_bucky} = $parent->bucky; }
+	elsif ($self && ref($self) eq "Bucky")
+		{ $self->{_bucky} = $self; }
+	else
+		{ $self->{_bucky} = new Bucky; }
+	return $self->{_bucky};
+	}
+sub db
+	{
+	my ($self, $parent) = @_;
+	return $self->{_db} if $self->{_db};
+	if ($parent && ref($parent) =~ /Bucky/)
+		{ $self->{_db} = $parent->bucky->db; }
+	else
+		{ $self->{_db} = new Bucky::DB; }
+	return $self->{_db};
+	}
+sub keywords
+	{
+	}
+sub keyword ($)
+	{ return shift->entity( $TYPE_Keyword, @_ ); }
+sub thread ($)
+	{ return shift->entity( $TYPE_Thread, @_ ); }
+sub comment ($)
+	{ return shift->entity( $TYPE_Comment, @_ ); }
+sub file ($)
+	{ return shift->entity( $TYPE_File, @_ ); }
+# return unless my $criteria = $self->check_criteria($which);
+sub check_criteria
+	{
+	my ($self, $type, $which) = @_;
+	my $accessor = "_" . $type;
+	if ($self->can($accessor))
+		{ $which ||= $self->$accessor; }
+	return undef unless $type && $which;
+	my $criteria = {};
+	if ( $self->is_number($which) )
+		{ $criteria->{id} = $which; }
+	elsif ( length($which) )
+		{ $criteria->{keyword} = $which; }
+	return scalar keys %$criteria ? $criteria : undef;
+	}
+# my $keyword = $self->entity( $TYPE_Keyword, $which );
+sub entity
+	{
+	my ($self, $type, $which) = @_;
+	return unless my $criteria = $self->check_criteria($type, $which);
+	my $entity_list = $self->db->select($type, $criteria);
+	foreach my $entity (@$entity_list)
+		{
+		# TODO: privacy check?
+		return $self->condone( $entity, $type );
+		}
+	return undef;
+	}
+# my $threads = $keyword->threads;
+# my $files = $thread->files;
+# my $children = $keyword->children;
+# join " ", map { $_->type }, $keyword->children;
+sub comments_by_id
+	{
+	my ($self, $comments_to_get) = @_;
+	return $self->db->select_by_id("comment", $comments_to_get);
+	}
+sub files_by_id
+	{
+	my ($self, $files_to_get) = @_;
+	return $self->db->select_by_id("file", $files_to_get);
+	}
+sub threads
+	{
+	my ($self) = @_;
+	return {};
+	}
+sub family
+	{
+	my ($self, $which) = @_;
+	my $type = $self->type || return;
+	my $entity_list = $self->db->select("family", { $type => $self->id });
+	}
+sub condone
+	{
+	my ($self, $ref, $type) = @_;
+	if ($type !~ /Bucky/ && $self->is_valid_type($type))
+		{ $type = "Bucky::" . ucfirst($type); }
+	bless $ref, $type;
+	$ref->inherit($self);
+	return $ref;
+	}
+1;
+