diff options
Diffstat (limited to 'search/lib')
| -rw-r--r-- | search/lib/Bucky.pm | 159 | ||||
| -rw-r--r-- | search/lib/Bucky/DB.pm | 175 | ||||
| -rw-r--r-- | search/lib/Bucky/Keyword.pm | 26 | ||||
| -rw-r--r-- | search/lib/Bucky/SVN.pm | 103 | ||||
| -rw-r--r-- | search/lib/Bucky/Search.pm | 413 | ||||
| -rw-r--r-- | search/lib/Bucky/Session.pm | 19 | ||||
| -rw-r--r-- | search/lib/Bucky/Thread.pm | 30 | ||||
| -rw-r--r-- | search/lib/Common.pm | 46 | ||||
| -rw-r--r-- | search/lib/Time/Stopwatch.pm | 13 | ||||
| -rw-r--r-- | search/lib/localbucky.pm | 12 |
10 files changed, 0 insertions, 996 deletions
diff --git a/search/lib/Bucky.pm b/search/lib/Bucky.pm deleted file mode 100644 index 181c1ae..0000000 --- a/search/lib/Bucky.pm +++ /dev/null @@ -1,159 +0,0 @@ -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; - diff --git a/search/lib/Bucky/DB.pm b/search/lib/Bucky/DB.pm deleted file mode 100644 index 1f0f99e..0000000 --- a/search/lib/Bucky/DB.pm +++ /dev/null @@ -1,175 +0,0 @@ -package Bucky::DB; - -use base 'Bucky'; - -use Data::Dumper; -use DBI; - -my $DB_LOOKUP = - { - bucky => '', - user => 'users', - keyword => 'keywords', - thread => 'threads', - file => 'files', - comment => 'comments', - family => 'family', - search_log => 'search_log', - poetaster_log => 'poetaster_log', - svn => 'svn', - }; -sub insert - { - my ($self, $type, $record) = @_; - $type = $DB_LOOKUP->{$type}; - return unless $type && ref($record) eq "HASH" && scalar keys %$record; - my $keys = []; - my $values = []; - foreach my $key (keys %$record) - { - push @$keys, $key; - push @$values, $self->quote($record->{$key}); - } - my $key_string = join ",", @$keys; - my $value_string = join ",", @$values; - return unless length $key_string && length $value_string; - my $sql = "INSERT INTO $type ($key_string) VALUES($value_string)"; - $self->execute($sql); - return $self->lastinsertid($sql); - } -sub update - { - my ($self, $type, $opt) = @_; - my $criteria = $opt->{'criteria'}; - my $record = $opt->{'record'}; - - $type = $DB_LOOKUP->{$type}; - return unless $type && ref($record) eq "HASH" && scalar keys %$record; - my $key_values = []; - foreach my $key (keys %$record) - { - push @$key_values, $key . "=" . $self->quote($record->{$key}); - } - my $key_value_string = join ",", @$key_values; - return unless length $key_value_string; - - my $criteria_string = $self->criteria($criteria); - return unless length $criteria_string; - - my $sql = "UPDATE $type SET $key_value_string $criteria_string"; - - $self->execute($sql); - } -sub update_by_id - { - my ($self, $type, $opt) = @_; - my $id = $opt->{'id'} + 0; - $opt->{'criteria'} = "id=$id"; - - $self->update($type, $opt) - } -sub select - { - my ($self, $type, $criteria) = @_; - $type = $DB_LOOKUP->{$type}; - return unless $type; - my $criteria_string = $self->criteria($criteria); - my $rows = []; - my $sql = "SELECT * FROM $type"; - $sql .= " " . $criteria_string if $criteria_string; - my $sth = $self->execute($sql); - while (my $row = $sth->fetchrow_hashref) - { - push @$rows, $row; - } - return $rows; - } -sub select_by_id - { - my ($self, $type, $id_array) = @_; - $type = $DB_LOOKUP->{$type}; - return unless $type and ref($id_array) eq "ARRAY" and scalar @$id_array; - my $rows = {}; - my $ids = join ",", @$id_array; - my $sql = "SELECT * FROM $type"; - $sql .= " WHERE id IN ($ids)"; - my $sth = $self->execute($sql); - while (my $row = $sth->fetchrow_hashref) - { - $rows->{ $row->{'id'} } = $row; - } - return $rows; - } -sub criteria - { - my ($self, $criteria) = @_; - - my $criteria_list = []; - - if ($self->is_string($criteria)) - { - push @$criteria_list, $criteria; - } - elsif (ref $criteria eq "HASH") - { - foreach my $key (keys %$criteria) - { - my $criterion = $key; - if ($criteria->{$key}) - { $criterion .= "=" . $self->quote($criteria->{$key}); } - push @$criteria_list, $criterion; - } - } - return undef unless scalar @$criteria_list; - - my $criteria_string = join(" AND ", @$criteria_list); - $criteria_string = "WHERE " . $criteria_string if $criteria_string =~ /[=<>]|( (IS|IN) )/; - return $criteria_string; - } -sub execute - { - my ($self, $sql) = @_; - my $sth = $self->dbh->prepare($sql); - $sth->execute; - return $sth; - } -sub quote - { - my ($self, $string) = @_; - return $self->dbh->quote($string); - } -sub lastinsertid - { - my ($self) = @_; - return $self->dbh->last_insert_id(0, undef, undef, undef); - } -sub dbh - { - my ($self, $parent) = @_; - if ($parent && ref($parent) =~ /Bucky/) - { - $self->{_dbh} ||= $parent->dbh; - } - if (! $self->{_dbh}) - { - $self->{_dbh} ||= DBI->connect($self->dsn); - } - return $self->{_dbh}; - } -sub dsn - { - my ($self) = @_; - $self->{_dsn} ||= - "DBI:mysql:database=" . $self->db_name . - ":" . $self->db_host . - ";mysql_read_default_file=" . $self->my_cnf; - return $self->{_dsn}; - } -sub db_name - { 'bucky3' } -sub db_host - { 'localhost' } -sub my_cnf - { './.my.cnf' } - -1; diff --git a/search/lib/Bucky/Keyword.pm b/search/lib/Bucky/Keyword.pm deleted file mode 100644 index 8c52256..0000000 --- a/search/lib/Bucky/Keyword.pm +++ /dev/null @@ -1,26 +0,0 @@ -package Bucky::Keyword; - -use base 'Bucky'; - -sub type { $Bucky::Keyword } -sub fields - {[qw[ - id keyword threads owner createdate - owner ops public - agglutinate - color display - ]]} - -sub _id { shift->{id} } -sub _keyword { shift->{keyword} } -sub _threads { shift->{threads} } -sub _username { shift->{owner} } -sub _ops { shift->{ops} } -sub _public { shift->{public} } -sub _createdate { shift->{createdate} } -sub _agglutinate { shift->{agglutinate} } -sub _color { shift->{color} } -sub _display { shift->{display} } - -1; - diff --git a/search/lib/Bucky/SVN.pm b/search/lib/Bucky/SVN.pm deleted file mode 100644 index ef04464..0000000 --- a/search/lib/Bucky/SVN.pm +++ /dev/null @@ -1,103 +0,0 @@ -package Bucky::SVN; -use base "Bucky"; -use Bucky::Session; -sub svn_secret - { return shift->config("SVN_SECRET"); } -sub list - { - my ($self, $count) = @_; - $count ||= 7; - return $self->db->select("svn", "ORDER BY date DESC LIMIT $count"); - } -sub query_incoming - { - my ($self) = @_; - my $session = new Bucky::Session; - error() unless scalar $session->q->param && length $session->q->param("secret") && $session->q->param("secret") eq $self->svn_secret(); - if ($session->q->param("user")) - { - print $self->query_add($session); - } - else - { - print "Content-type: text/html\n\n"; - print $self->query_list; - } - } -sub query_list - { - my ($self) = @_; - my $svns = $self->list; - my $out .= <<__HEAD__; -<table cellpadding=0 cellspacing=0 style="border: 1px solid #333;"> -__HEAD__ - my $r = 0; - foreach my $svn (@$svns) - { - $r = $r ? 0 : 1; - my $user = $svn->{'user'}; - $user = "default" if $user eq "root"; - my $user_profile = "/cgi-bin/bucky/profile/$user"; - my $user_img = "/bucky/data/profile/.thumb/am.$user.jpg"; - my $date = $self->show_date($svn->{'date'}); - my $revision = $svn->{'revision'}; - my $comment = $svn->{'comment'}; - $out .= <<__SVN__; -<tr> -<td style="border: 1px solid #333;" align="center"> -<a href="$user_profile"><img src="$user_img" border=0></a><!--<br><small>$user</small>--> -</td> -<td style="border: 1px solid #333; padding: 3px" class="r$r"> -<small>$revision: $comment</small> -</td> -</small> -</tr> -__SVN__ - } - $out .= <<__FOOT__; -</table> -__FOOT__ - return $out; - } -sub query_add - { - my ($self, $session) = @_; - - my $user = $session->q->param("user"); - my $revision = $session->q->param("revision"); - my $comment = $session->q->param("comment"); - my $date = time; - - error("missing some parameters\npossible: secret, user, revision, comment\n") - unless $user && $comment && $revision - && $self->is_number($revision) && length $user && length $comment; - - my $query = - { - user => $user, - comment => $comment, - revision => $revision, - date => $date, - }; - - if (my $id = $self->db->insert("svn", $query)) - { success("Successfully inserted $id"); } - else - { error("Unable to insert!"); } - } -sub success - { - my ($success) = @_; - $success ||= "NICE ONE"; - print "Content-type: text/plain\n\nSUCCESS: $success"; - exit; - } -sub error - { - my ($error) = @_; - $error ||= "SORRY GUY"; - print "Content-type: text/plain\n\nERROR: $error"; - exit; - } - -1; diff --git a/search/lib/Bucky/Search.pm b/search/lib/Bucky/Search.pm deleted file mode 100644 index c3516a1..0000000 --- a/search/lib/Bucky/Search.pm +++ /dev/null @@ -1,413 +0,0 @@ -package Bucky::Search; - -use base 'Bucky'; - -use Data::Dumper; -use DB_File; - -sub index - { - my ($self, $index) = @_; - $self->{'_index'} = $index || $self->index_read; - return $self->{'_index'}; - } -sub index_read - { - my ($self) = @_; - my %index; - tie %index, "DB_File", $self->index_filename, O_RDONLY, 0666, $DB_HASH ; - return \%index; - } -sub index_write - { - my ($self) = @_; - my %index; - tie %index, "DB_File", $self->index_filename, O_CREAT|O_RDWR, 0666, $DB_HASH ; - return \%index; - } -sub index_close - { - my ($self, $index) = @_; - $index ||= $self->index; - untie %$index; - } -sub index_filename - { "search_init.db" } -sub auto_index - { - my ($self, $auto_index) = @_; - $self->{'_auto_index'} = $auto_index || $self->auto_index_read; - return $self->{'_auto_index'}; - } -sub auto_index_read - { - my ($self) = @_; - my %auto_index; - tie %auto_index, "DB_File", $self->auto_index_filename, O_RDONLY, 0666, $DB_HASH ; - return \%auto_index; - } -sub auto_index_write - { - my ($self) = @_; - my %auto_index; - tie %auto_index, "DB_File", $self->auto_index_filename, O_CREAT|O_RDWR, 0666, $DB_HASH ; - return \%auto_index; - } -sub auto_index_close - { - my ($self, $auto_index) = @_; - $auto_index ||= $self->auto_index; - untie %$auto_index; - } -sub auto_index_filename - { "auto.db" } -sub lexicon_store - { - my ($self, $lexicon) = @_; - my $index = $self->index_write; - foreach my $term (keys %$lexicon) - { - next if $self->is_stopword($term); - my $serialized = $self->serialize_matches($lexicon->{$term}); - next unless $serialized; - $index->{$term} = $serialized; - } - $self->index_close($index); - } -sub unserialize_matches - { - my ($self, $serialized_string) = @_; - my @serialized_matches = split ",", $serialized_string; - my @matches; - foreach my $serialized_match (@serialized_matches) - { - my ($thread, $comment, $file, $strength) = split " ", $serialized_match; - my $match = {}; - $match->{'thread'} = $thread; - $match->{'comment'} = $comment; - $match->{'file'} = $file; - $match->{'strength'} = $strength; - push @matches, $match; - } - return \@matches; - } -sub serialize_matches - { - my ($self, $matches) = @_; - my @serialized_matches; - foreach my $match (values %$matches) - { - next unless $match && ref($match) eq "HASH"; - my $string = join " ", - $match->{'thread'}, - $match->{'comment'}, - $match->{'file'}, - $match->{'strength'}; - next unless $string; - push @serialized_matches, $string if $string; - } - return undef unless scalar @serialized_matches; - return join ",", @serialized_matches; - } -my $STOPWORDS = {( map { lc $_, 1 } qw( -a about above across adj after again against all almost alone along also -although always am among an and another any anybody anyone anything anywhere -apart are around as aside at away be because been before behind being below -besides between beyond both but by can cannot could deep did do does doing done -down downwards during each either else enough etc even ever every everybody -everyone except far few for forth from get gets got had hardly has have having -her here herself him himself his how however i if in indeed instead into inward -is it its itself just kept many maybe might mine more most mostly much must -myself near neither next no nobody none nor not nothing nowhere of off often on -only onto or other others ought our ours out outside over own p per please plus -pp quite rather really said seem self selves several shall she should since so -some somebody somewhat still such than that the their theirs them themselves -then there therefore these they this thorough thoroughly those through thus to -together too toward towards under until up upon v very was well were what -whatever when whenever where whether which while who whom whose will with -within without would yet young your yourself s ) )}; -sub is_stopword - { - my ($self, $term) = @_; - return exists $STOPWORDS->{lc $term}; - } -sub autocomplete - { - my ($self, $query) = @_; - return unless $query; - my $terms = parse_terms($query); - my $last_term = pop @$terms; - - my $auto_index = $self->auto_index; - my $guess_term = $auto_index->{$last_term}; - my $guess_full = join " ", @$terms, $guess_term; - my $guess_tail = $guess_term; - $guess_tail =~ s/^$last_term//; - - my $guess = {}; - $guess->{'full'} = $guess_full; - $guess->{'tail'} = $guess_tail; - $guess->{'term'} = $guess_term; - return $guess; - } -sub search_light - { - my ($self, $query, $start, $limit) = @_; - return unless $query; - $start ||= 0; - $limit ||= 10; - my $scores = {}; - my $terms = parse_terms($query); - my $index = $self->index; - foreach my $term (@$terms) - { - next if $self->is_stopword($term); - next unless my $serial = $index->{$term}; - my $results = $self->unserialize_matches($serial); - foreach my $result (@$results) - { - my $thread = $result->{'thread'}; - $scores->{$thread} ||= {}; - $scores->{$thread}->{thread} ||= $result->{'thread'}; - $scores->{$thread}->{file} ||= $result->{'file'}; - $scores->{$thread}->{strength} += $result->{'strength'}; - $scores->{$thread}->{count}++; - } - } - my $total = scalar keys %$scores; - my $i = 0; - my $to_display = $limit; - my $threads = {}; - my $comments_to_get = []; - my $files_to_get = []; - foreach my $match (sort { $b->{count} <=> $a->{count} || $b->{strength} * $b->{count} <=> $a->{strength} * $a->{count} } values %$scores ) - { - next if $i++ < $start; - my $thread = $self->thread( $match->{'thread'} ); - next unless $thread; - next if $thread->{'private'}; - last if $to_display-- == 0; - push @$results, $match; - push @$comments_to_get, $match->{'comment'} if $match->{'comment'}; - if ( $match->{'file'} ) - { push @$files_to_get, $match->{'file'}; } - if ( $thread->{'flagged'} ) - { push @$files_to_get, $thread->{'flagged'}; } - $threads->{ $thread->{'id'} } = $thread; - } - my $files = $self->files_by_id($files_to_get); - # $self->log_query($query, $total); - return - { - start => $start + $limit, - limit => $limit, - total => $total, - results => $results, - threads => $threads, - files => $files, - terms => $terms, - }; - } -sub search - { - my ($self, $query, $start, $limit) = @_; - return unless $query; - $start ||= 0; - $limit ||= 10; - my $scores = {}; - my $terms = parse_terms($query); - my $index = $self->index; - foreach my $term (@$terms) - { - next if $self->is_stopword($term); - next unless my $serial = $index->{$term}; - my $results = $self->unserialize_matches($serial); - foreach my $result (@$results) - { - my $thread = $result->{'thread'}; - $scores->{$thread} ||= {}; - $scores->{$thread}->{thread} ||= $result->{'thread'}; - $scores->{$thread}->{comment} ||= $result->{'comment'}; - $scores->{$thread}->{file} ||= $result->{'file'}; - $scores->{$thread}->{strength} += $result->{'strength'}; - $scores->{$thread}->{count}++; - } - } - my $total = scalar keys %$scores; - my $i = 0; - my $to_display = $limit; - my $threads = {}; - my $comments_to_get = []; - my $files_to_get = []; - foreach my $match (sort { $b->{count} <=> $a->{count} || $b->{strength} * $b->{count} <=> $a->{strength} * $a->{count} } values %$scores ) - { - next if $i++ < $start; - my $thread = $self->thread( $match->{'thread'} ); - next unless $thread; - next if $thread->{'private'}; - last if $to_display-- == 0; - push @$results, $match; - push @$comments_to_get, $match->{'comment'} if $match->{'comment'}; - if ( $match->{'file'} ) - { push @$files_to_get, $match->{'file'}; } - if ( $thread->{'flagged'} ) - { push @$files_to_get, $thread->{'flagged'}; } - $threads->{ $thread->{'id'} } = $thread; - } - my $files = $self->files_by_id($files_to_get); - my $comments = $self->comments_by_id($comments_to_get); - $self->log_query($query, $total); - return - { - start => $start + $limit, - limit => $limit, - total => $total, - results => $results, - threads => $threads, - comments => $comments, - files => $files, - terms => $terms, - }; - } -sub score_display - { - my ($obj) = @_; - return scalar(keys %{$obj->{terms}}) . "x" . $obj->{count}; - } -sub display_object - { - my ($obj) = @_; - my ($type, $id) = split ":", $obj; - my $thread = $bucky->thread($id); - my $title = $thread ? $thread->_title : "* * *"; - return $type . " " . $id . "\t" . $title; - } -sub bold_terms - { - my ($self, $string, $terms) = @_; - $string = $self->strip_html($string); - foreach my $term (@$terms) - { - $string =~ s/\b($term)\b/<b>$1<\/b>/gi; - } - return $string; - } -sub bold_snippet - { - my ($self, $string, $terms) = @_; - my $snippet = $self->snippet($string, $terms); - return $self->bold_terms($snippet, $terms); - } -sub snippet - { - my ($self, $string, $terms) = @_; - - # clean up the string we got - $string = $self->strip_html($string); - - # create a regex out of the search terms - my $term_re = join "|", @$terms; - - # take the string to be snippetized and split it into words - my @words = split /\s+/, $string; - - # deduper for matching @words indexes, so we don't add a word twice - my $index_matches = {}; - - # words in the eventual snippet - my @words_matched; - - # the snippet itself - my $snippet = ''; - - # counter for aggregating context after a match - my $aggr = 0; - - # amount of context to show, in number of words surrounding a match - my $pad = 4; - - # loop over each of the words in the string - for (my $i = 0; $i < scalar @words; $i++) - { - # does this word contain a match? - if ($words[$i] =~ /\b($term_re)\b/i && ! $self->is_stopword($1)) - { - # if we aren't already aggregating, add an ellipsis - if (! $aggr) - { - push @words_matched, "..."; - } - # look backward $pad words - for (my $j = -$pad; $j < 1; $j++) - { - # create a new index from the offset - my $idx = $i + $j; - - # is this a valid index? has it already been encountered? - next if $idx < 0; - next if $idx > scalar @words; - next if exists $index_matches->{$i+$j}; - - # checks out, save this word - push @words_matched, $words[$i+$j]; - - # note the matching index in our deduper - $index_matches->{$i+$j} ++; - } - # enter aggregate mode -- add the next $pad words - $aggr = $pad; - } - # have we been told to aggregate? - elsif ($aggr) - { - # save this word - push @words_matched, $words[$i]; - - # add index to the deduper - $index_matches->{$i} ++; - - # one less word to aggregate - $aggr--; - } - # keep snippets to a modest length - last if scalar @words_matched > 30; - } - # add a trailing ellipsis - push @words_matched, "..."; - - # create the snippet from the saved context words - $snippet = join " ", @words_matched; - - return $snippet; - } -sub parse_terms - { - my ($s) = @_; - my @terms = split /(\W+)/, lc($s); - my $words = []; - my $count = 0; - foreach my $term (@terms) - { - if ( $term !~ /\W/ ) - { - push @$words, $term; - } - } - return $words; - } -sub log - { - my ($self, $date) = @_; - my $criteria = {}; - $criteria->{'date'} = $date if $date; - return $self->db->select("search_log", $criteria); - } -sub log_query - { - my ($self, $query, $total) = @_; - return unless $query; - my $date = time; - $matches ||= '0'; - $self->db->insert("search_log", { query => $query, date => $date, matches => $total }); - } -1; diff --git a/search/lib/Bucky/Session.pm b/search/lib/Bucky/Session.pm deleted file mode 100644 index 0cff753..0000000 --- a/search/lib/Bucky/Session.pm +++ /dev/null @@ -1,19 +0,0 @@ -package Bucky::Session; - -use base 'Bucky'; - -use CGI; - -sub param - { - my ($self, $name) = @_; - return unless $name; - return $self->q->param($name); - } -sub q - { - my ($self) = @_; - $self->{'_q'} ||= new CGI; - return $self->{'_q'}; - } -1; diff --git a/search/lib/Bucky/Thread.pm b/search/lib/Bucky/Thread.pm deleted file mode 100644 index dbd8ad0..0000000 --- a/search/lib/Bucky/Thread.pm +++ /dev/null @@ -1,30 +0,0 @@ -package Bucky::Thread; - -use base 'Bucky'; - -sub type { $Bucky::Thread } -sub fields - {[qw[ - id title username keyword private allowed - createdate lastmodified revision viewed - size color display flagged zipped - ]]} - -sub _id { shift->{id} } -sub _title { shift->{title} } -sub _username { shift->{username} } -sub _keyword { shift->{keyword} } -sub _private { shift->{private} } -sub _allowed { shift->{allowed} } -sub _createdate { shift->{createdate} } -sub _lastmodified { shift->{lastmodified} } -sub _revision { shift->{revision} } -sub _viewed { shift->{viewed} } -sub _size { shift->{size} } -sub _color { shift->{color} } -sub _display { shift->{display} } -sub _flagged { shift->{flagged} } -sub _zipped { shift->{zipped} } - -1; - diff --git a/search/lib/Common.pm b/search/lib/Common.pm deleted file mode 100644 index 0797943..0000000 --- a/search/lib/Common.pm +++ /dev/null @@ -1,46 +0,0 @@ -## utility functions -package Common; -use base 'Exporter'; -our @EXPORT = qw[is_number is_string show_date get_age trim strip_html]; - -# promiscuous namespace -sub is_number - { my ($self, $s) = @_; return $s && $s !~ /\D/; } -sub is_string - { my ($self, $s) = @_; return length $s && ! length ref $s; } -sub show_date - { my ($self, $date) = @_; return scalar localtime($date); } -sub get_age - { - my ($self, $time) = @_; - if ($time < 0) - { return "old"; } - my $age = time - $time; - if ($age < 60) - { return int($age)."s"; } - $age /= 60; - if ($age < 60) - { return int($age)."m"; } - my $mins = $age % 60; - $age /= 60; - if ($age < 2) - { return int($age)."h".int($mins)."m"; } - elsif ($age < 24) - { return int($age)."h"; } - $age /= 24; - if ($age < 10000) - { return int($age)."d"; } - my $powers = qw[k m g t p e z y]; - foreach my $prefix (@$powers) - { - $age /= 1000; - if ($age < 10000) - { return int($age).$prefix."d"; } - } - } -sub trim - { my ($self, $s) = @_; $s =~ s/^\s+//; $s =~ s/\s+$//; return $s; } -sub strip_html - { my ($self, $s) = @_; $s =~ s/[<>]+/ /g; return $s; } - -1; diff --git a/search/lib/Time/Stopwatch.pm b/search/lib/Time/Stopwatch.pm deleted file mode 100644 index b7cec26..0000000 --- a/search/lib/Time/Stopwatch.pm +++ /dev/null @@ -1,13 +0,0 @@ -################################################3 -package Time::Stopwatch; -my $VERSION = '1.00'; -use strict; -use constant HIRES => eval { local $SIG{__DIE__}; require Time::HiRes }; -sub TIESCALAR { my $pkg = shift; - my $time = (HIRES ? Time::HiRes::time() : time()) - (@_ ? shift() : 0); - bless \$time, $pkg; } -sub FETCH { (HIRES ? Time::HiRes::time() : time()) - ${$_[0]}; } -sub STORE { ${$_[0]} = (HIRES ? Time::HiRes::time() : time()) - $_[1]; } -################################################# -sub print_timer { print sprintf "%3.2f s %s\n", shift, shift; } -1; diff --git a/search/lib/localbucky.pm b/search/lib/localbucky.pm deleted file mode 100644 index 41c7553..0000000 --- a/search/lib/localbucky.pm +++ /dev/null @@ -1,12 +0,0 @@ -package Bucky; -my $LOCAL_CONFIG = - { - SVN_SECRET => '1s0c4h3dr0n', - }; -sub config - { - my ($self, $key) = @_; - $key ||= $self; - return $LOCAL_CONFIG->{$key} if $LOCAL_CONFIG->{$key}; - } -1; |