diff options
Diffstat (limited to 'search')
| -rwxr-xr-x | search/bin/build-autocomplete | 53 | ||||
| -rwxr-xr-x | search/bin/build-index | 112 | ||||
| -rwxr-xr-x | search/bin/build-splashes | 112 | ||||
| -rw-r--r-- | search/bin/fix-files | 41 | ||||
| -rw-r--r-- | search/bin/gross.db | bin | 3158016 -> 0 bytes | |||
| -rwxr-xr-x | search/bin/listener.pl | 65 | ||||
| -rwxr-xr-x | search/bin/watch-index.pl | 8 | ||||
| -rw-r--r-- | search/db/.gitkeep | 0 | ||||
| -rw-r--r-- | search/db/env/.gitkeep | 0 | ||||
| -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 |
19 files changed, 0 insertions, 1387 deletions
diff --git a/search/bin/build-autocomplete b/search/bin/build-autocomplete deleted file mode 100755 index d9a62fd..0000000 --- a/search/bin/build-autocomplete +++ /dev/null @@ -1,53 +0,0 @@ -#!/usr/bin/perl -use lib "../lib"; -use Bucky; -use Bucky::Search; -use Data::Dumper; -use DB_File; - -my $file = "auto.db"; - -my $search = new Bucky::Search; - -my $index = $search->index; -my $auto_index = $search->auto_index_write; - -my $partials = {}; -my $partials_with_media = {}; -foreach my $word (keys %$index) - { - # goatse operator - my $count =()= $index->{$word} =~ /,/g; - - next unless $word; - - my $par = ''; - my @letters = split "", $word; - for (my $i = 0; $i < scalar @letters; $i++) - { - $par .= $letters[$i]; - if (! exists $partials->{$par} || $partials->{$par}->[0] < $count) - { - $partials->{$par} = [$count,$word]; - } - } - } -# don't autocomplete if we match a word -foreach my $word (keys %$index) - { - $partials->{$word}->[1] = $word - } - -foreach my $par (sort keys %$partials) - { - $auto_index->{$par} = $partials->{$par}->[1]; - } -$search->auto_index_close; - -print "NEW: " ; system("/bin/ls", "-l", "./$file"); -print "OLD: " ; system("/bin/ls", "-l", "../cgi-bin/$file"); -system("/bin/mv", "../cgi-bin/$file", "../cgi-bin/$file.1"); -system("/bin/mv", "./$file", "../cgi-bin/$file"); - -exit; - diff --git a/search/bin/build-index b/search/bin/build-index deleted file mode 100755 index b7fa2fc..0000000 --- a/search/bin/build-index +++ /dev/null @@ -1,112 +0,0 @@ -#!/usr/bin/perl -use strict; -use lib "./search/lib"; -use Bucky; -use DB_File; -#require Time::Stopwatch; -tie my $timer, 'Time::Stopwatch'; - -print_timer($timer, "Initialized"); - -my $bucky = new Bucky::Search; - -my $keywords = $bucky->db->select("keyword"); -my $threads = $bucky->db->select("thread", {"id > 1"}); -my $files = $bucky->db->select("file"); -my $comments = $bucky->db->select("comment", {"thread > 1"}); - -print_timer($timer, "Loaded mysql"); - -my $lexicon = {}; -my $total = 0; -#foreach my $keyword (@$keywords) -# { -# my $id = $keyword->{$id}; -# $lexicon->{ $keyword->{'keyword'} }++; -# $total++; -# } -foreach my $thread (@$threads) - { - $total += parse_terms({ string => $thread->{'title'}, thread => $thread->{'id'} }); - } -foreach my $comment (@$comments) - { - $total += parse_terms({ string => $comment->{'comment'}, thread => $comment->{'thread'}, comment => $comment->{'id'} }); - } -foreach my $file (@$files) - { - $total += parse_terms({ string => $file->{'filename'}, thread => $file->{'thread'}, file => $file->{'id'} }); - } - -print_timer($timer, "Created index"); - -my $unique = scalar keys %$lexicon; -print "--- WORD COUNT: " . $total . "\n"; -print "--- UNIQUE WORDS: " . $unique . "\n"; - -$bucky->lexicon_store($lexicon); - -my $file = $bucky->index_filename; - -print_timer($timer, "Dumped $file"); - -system("/bin/mv", "./search/db/search.db", "./search/db/search.db.1"); -system("/bin/mv", "$file", "./search/db/search.db"); -print "OLD: " ; system("/bin/ls", "-l", "./search/db/search.db.1"); -print "NEW: " ; system("/bin/ls", "-l", "./search/db/search.db"); -# system("/usr/bin/perl", "./build-autocomplete"); -exit; - -sub parse_terms - { - my ($args) = @_; - my $thread = $args->{'thread'} || return; - my $comment = $args->{'comment'} || '0'; - my $file = $args->{'file'} || '0'; - my $string = $args->{'string'}; - $string =~ s/_/ /g; - my @terms = split /(\W+)/, $string; - my $count = 0; - foreach my $term (@terms) - { - if ( $term !~ /\W/ ) - { - my $t = lc($term); - $lexicon->{$t} ||= {}; - $lexicon->{$t}->{$thread} ||= {}; - $lexicon->{$t}->{$thread}->{'thread'} ||= $thread; - $lexicon->{$t}->{$thread}->{'comment'} ||= $comment; - $lexicon->{$t}->{$thread}->{'file'} ||= $file; - # give terms in title an extra bump - if ($comment eq '0' && $file eq '0') - { $lexicon->{$t}->{$thread}->{'strength'} += 2; } - else - { $lexicon->{$t}->{$thread}->{'strength'} += 1; } - $count++; - } - } - return $count; - } - -sub print_timer - { print STDERR sprintf "%3.2f s %s\n", shift, shift; } - -################################################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]; } - -1; - diff --git a/search/bin/build-splashes b/search/bin/build-splashes deleted file mode 100755 index d5fd5c1..0000000 --- a/search/bin/build-splashes +++ /dev/null @@ -1,112 +0,0 @@ -#!/usr/bin/perl - -my $TEMPLATE_DIR = "../template"; -my $BASE_DIR = "/var/www/vhosts/carbonpictures.com/httpdocs/splash"; -my $OUT_FILE = "/var/www/vhosts/carbonpictures.com/httpdocs/splash/index.html"; -my @ab = qw[b c d f g h j k l m n p q r s t v w x y z]; -unshift @ab, undef; - -# disabled for now -# build_site(read_splashes()); - -sub build_site - { - my ($years) = @_; - carp("Building site!"); - my $t_page = slurp_template("splash_list_page"); - my $t_year = slurp_template("splash_year"); - my $t_month = slurp_template("splash_month"); - my $t_day = slurp_template("splash_day"); - my $yeas = ""; - foreach my $year (sort keys %$years) - { - carp($year); - my $mons = ""; - foreach my $month (sort keys %{ $years->{$year} }) - { - my $days = ""; - foreach my $day (sort {$a cmp $b} keys %{ $years->{$year}->{$month} }) - { - my $d = $years->{$year}->{$month}->{$day}; - $days .= templatize($t_day, $d); - } - $mons .= templatize($t_month, { month => $month, days => $days }); - } - $yeas .= templatize($t_year, { year => "20".$year, months => $mons }); - } - my $page = templatize($t_page, { years => $yeas } ); - vomit($OUT_FILE, $page); - } -sub templatize - { - my ($t, $o) = @_; - while ($t =~ /\%\%([^\%]+)\%\%/) - { - my $val = $o->{lc $1}; - $t =~ s/\%\%$1\%\%/$val/g; - } - return $t; - } -sub read_splashes - { - my $years = {}; - foreach my $y (grep /^\d/, slurp_dir($BASE_DIR)) - { - my $months = {}; - $years->{$y} = $months; - foreach my $m (grep /^\d/, slurp_dir("$BASE_DIR/$y")) - { - my $days = {}; - $months->{$m} = $days; - foreach my $d (grep /^\d/, slurp_dir("$BASE_DIR/$y/$m")) - { - my $abi = 0; - foreach my $f (sort grep /html$/, slurp_dir("$BASE_DIR/$y/$m/$d")) - { - my $is_index = $f eq "index.html"; - if ($is_index) - { $k = $d; } - else - { $k = "$d".$ab[$abi++]; } - my $d = - { - key => $k, - url => "/splash/$y/$m/$d/" . ($is_index ? undef : $f), - }; - $days->{$k} = $d; - } - } - } - } - return $years; - } - -sub slurp_dir - { - my ($d) = @_; - my @files; - opendir D, $d; - while (my $f = readdir(D)) - { push(@files,$f) if $f !~ /^\./; } - closedir D; - return @files; - } -sub slurp_template - { return slurp(join "/", $TEMPLATE_DIR, @_); } -sub slurp - { - my ($f) = @_; - open F, $f; my @lines = <F>; close F; - return join "", @lines; - } -sub vomit - { - my ($f, $t) = @_; - carp("Writing $f"); - open F, ">", $f || die "couldn't open $f : $!"; print F $t; close F; - } -sub carp - { - my ($m) = @_; - print STDERR $m . "\n"; - } diff --git a/search/bin/fix-files b/search/bin/fix-files deleted file mode 100644 index b56d377..0000000 --- a/search/bin/fix-files +++ /dev/null @@ -1,41 +0,0 @@ -#!/usr/bin/perl -use strict; -use lib "../lib"; -use Bucky; - -my $bucky = new Bucky; -my $file_list = $bucky->db->select("file", {'thread = 2833'}); -my $file_map = {}; -foreach my $f (@$file_list) { - $file_map->{ $f->{'filename'} } = $f->{'id'}; -} - -my $base = "/var/www/vhosts/carbonpictures.com/bucky/data/"; -opendir(DIR, $base) or die $!; -my @dirs = readdir(DIR); -closedir(DIR); - -print scalar @dirs; - -foreach my $thread_id (@dirs) { - my $dir = $base . $thread_id; - - next unless (-d $dir && $thread_id !~ /^\./); - - opendir (THREAD, $dir); - my @local_files = readdir(THREAD); - closedir (THREAD); - - foreach my $filename (@local_files) { - next unless exists($file_map->{$filename}); - - my $file_id = $file_map->{$filename}; - - $bucky->db->update_by_id('file', { - "id" => $file_id, - "record" => { - "thread" => $thread_id - } - }); - } -}
\ No newline at end of file diff --git a/search/bin/gross.db b/search/bin/gross.db Binary files differdeleted file mode 100644 index 410d4e8..0000000 --- a/search/bin/gross.db +++ /dev/null diff --git a/search/bin/listener.pl b/search/bin/listener.pl deleted file mode 100755 index 0f0f2d9..0000000 --- a/search/bin/listener.pl +++ /dev/null @@ -1,65 +0,0 @@ -#!/usr/bin/perl - use IO::Socket; - use IO::Select; - - # Create a socket to listen on. - # - my $listener = - IO::Socket::INET->new( LocalPort => 8008, Listen => 5, Reuse => 1 ); - - die "Can't create socket for listening: $!" unless $listener; - print "Listening for connections on port 8008\n"; - - my $readable = IO::Select->new; # Create a new IO::Select object - $readable->add($listener); # Add the listener to it - - while(1) { - - # Get a list of sockets that are ready to talk to us. - # - my ($ready) = IO::Select->select($readable, undef, undef, undef); - foreach my $s (@$ready) { - - # Is it a new connection? - # - if($s == $listener) { - - # Accept the connection and add it to our readable list. - # - my $new_sock = $listener->accept; - $readable->add($new_sock) if $new_sock; - - print $new_sock "Welcome!\r\n"; - print "connection :-o\n\n"; - - } else { # It's an established connection - - my $buf = <$s>; # Try to read a line - - # Was there anyone on the other end? - # - if( defined $buf ) { - - # If they said goodbye, close the socket. If not, - # echo what they said to us. - # - if ($buf =~ /(good)?bye/i) { - print $s "See you later!\n"; - $readable->remove($s); - $s->close; - } else { - print $s "You said: $buf\n"; - print "$buf\n"; - } - - } else { # The client disconnected. - - $readable->remove($s); - $s->close; - print STDERR "Client Connection closed\n"; - - } - } - } - } - diff --git a/search/bin/watch-index.pl b/search/bin/watch-index.pl deleted file mode 100755 index c9d950b..0000000 --- a/search/bin/watch-index.pl +++ /dev/null @@ -1,8 +0,0 @@ -#!/usr/bin/perl - -while (1) - { - system("./build-index"); - sleep(60*60); - } - diff --git a/search/db/.gitkeep b/search/db/.gitkeep deleted file mode 100644 index e69de29..0000000 --- a/search/db/.gitkeep +++ /dev/null diff --git a/search/db/env/.gitkeep b/search/db/env/.gitkeep deleted file mode 100644 index e69de29..0000000 --- a/search/db/env/.gitkeep +++ /dev/null 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; |