bucky2

15 files changed, 1681 insertions, 0 deletions

diff --git a/bucky2/lib/Bucky.pm b/bucky2/lib/Bucky.pm
new file mode 100644
index 0000000..181c1ae
--- /dev/null
+++ b/bucky2/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;
+
diff --git a/bucky2/lib/Bucky/DB.pm b/bucky2/lib/Bucky/DB.pm
new file mode 100644
index 0000000..bca92b7
--- /dev/null
+++ b/bucky2/lib/Bucky/DB.pm
@@ -0,0 +1,147 @@
+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
+	{
+	}
+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
+	{ 'bucky' }
+sub db_host
+	{ 'localhost' }
+sub my_cnf
+	{ '/var/www/vhosts/carbonpictures.com/.my.cnf' }
+
+1;
diff --git a/bucky2/lib/Bucky/Keyword.pm b/bucky2/lib/Bucky/Keyword.pm
new file mode 100644
index 0000000..8c52256
--- /dev/null
+++ b/bucky2/lib/Bucky/Keyword.pm
@@ -0,0 +1,26 @@
+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/bucky2/lib/Bucky/SVN.pm b/bucky2/lib/Bucky/SVN.pm
new file mode 100644
index 0000000..ef04464
--- /dev/null
+++ b/bucky2/lib/Bucky/SVN.pm
@@ -0,0 +1,103 @@
+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/bucky2/lib/Bucky/Search.pm b/bucky2/lib/Bucky/Search.pm
new file mode 100644
index 0000000..43c23f7
--- /dev/null
+++ b/bucky2/lib/Bucky/Search.pm
@@ -0,0 +1,413 @@
+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
+	{ "gross.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/bucky2/lib/Bucky/Session.pm b/bucky2/lib/Bucky/Session.pm
new file mode 100644
index 0000000..0cff753
--- /dev/null
+++ b/bucky2/lib/Bucky/Session.pm
@@ -0,0 +1,19 @@
+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/bucky2/lib/Bucky/Thread.pm b/bucky2/lib/Bucky/Thread.pm
new file mode 100644
index 0000000..dbd8ad0
--- /dev/null
+++ b/bucky2/lib/Bucky/Thread.pm
@@ -0,0 +1,30 @@
+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/bucky2/lib/Common.pm b/bucky2/lib/Common.pm
new file mode 100644
index 0000000..0797943
--- /dev/null
+++ b/bucky2/lib/Common.pm
@@ -0,0 +1,46 @@
+## 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/bucky2/lib/Poetaster.pm b/bucky2/lib/Poetaster.pm
new file mode 100644
index 0000000..da5b854
--- /dev/null
+++ b/bucky2/lib/Poetaster.pm
@@ -0,0 +1,140 @@
+package Bucky::Poetaster;
+use Digest::MD5;
+use Rest;
+
+# Maximum distance to indent a line of text
+my $MAX_INDENT = 3;
+
+# Maximum number of words per line
+my $MAX_WORD_COUNT = 6;
+
+# Maximum number of letters per line
+my $MAX_CHAR_COUNT = 36;
+
+# Number of spaces to print per level of indentation
+my $INDENT_WIDTH = 2;
+
+sub new
+	{
+	my ($class, $self) = @_;
+	$self ||= {};
+	$self->{'indent'} = 0;
+	bless $self, $class;
+	return $self;
+	}
+# Given a big block of text, reformat it to resemble a poem
+sub poem
+	{
+	my ($self, $text) = @_;
+	# Split the text into words
+	my @words = split / /, $text;
+	# Initialize all counters to zero
+	$self->{'indent'} = 0;
+	my $word_count = 0;
+	my $char_count = 0;
+	# variable to dump all data onto
+	my $stanza = '';
+	# loop over all words in the block
+	foreach my $word (@words)
+		{
+		# if word is undefined, skip it (two spaces next to each other)
+		next unless $word;
+		# if word starts with non-alphanumeric character
+		# make a new line and then print the word
+		if ($word =~ /^[^a-z0-9<>]/i)
+			{
+			$word_count = 1;
+			$char_count = length $word;
+			$stanza .= $self->indent;
+			$stanza .= $word;
+			next;
+			}
+		# if word ends with non-alphanumeric character,
+		# print the word and THEN start a new line
+		if ($word =~ /([^a-z<>])$/i)
+			{
+			my $punct = $1;
+			# if the word ends with a period, start a new stanza
+			if ($punct eq "." || $punct eq "?")
+				{ $self->{'indent'} = 0; }
+			$word_count = 0;
+			$char_count = 0;
+			$stanza .= " " . $word;
+			$stanza .= $self->indent;
+			next;
+			}
+		# otherwise, print the word
+		$stanza .=  " ". $word;
+		# tally the line length and number of words on the line
+		$word_count += 1;
+		$char_count += length($word)+ 1;
+		# if we've printed a whole line's worth, start a new line
+		if ($char_count > $MAX_CHAR_COUNT || $word_count > $MAX_WORD_COUNT)
+			{
+			$stanza .= $self->indent;
+			$word_count = 0;
+			$char_count = 0;
+			}
+		}
+	# return the new poem cuz we're done
+	return $stanza;
+	}
+# Modify the current indentation depth,
+# and return a string constituting the indent
+sub indent
+	{
+	my ($self) = @_;
+	# if we've already indented as far as we'd like, pull back
+	if ($self->{'indent'} > $MAX_INDENT)
+		{
+		$self->{'indent'} -= 1;
+		}
+	# otherwise, indent one notch further
+	else
+		{
+		$self->{'indent'} += 1;
+		}
+	# print a newline, then indent according to the indentation width
+	return "\n" . " " x ( $self->{'indent'} * $INDENT_WIDTH );
+	}
+sub url_cache
+	{
+	my ($self, $url) = @_;
+	my $hash = md5_hex($url);
+	my $path = $self->url_cache_path($hash);
+	while (-e $path)
+		{
+		open P, $path or last;
+		my @lines = <P>;
+		close P;
+		return join "", @lines;
+		}
+	my $data = Rest->new->rest_get_raw($url);
+	open P, ">$path" or return $data;
+	print P $data;
+	close $p;
+	return $data;
+	}
+sub url_cache_path
+	{
+	my ($self, $hash) = @_;
+	my $path = $self->bucky_data_path . "/poetaster/" . $hash;
+	return $path;
+	}
+sub log
+	{
+	my ($self, $date) = @_;
+	my $criteria = {};
+	$criteria->{'date'} = $date if $date;
+	return $self->db->select("poetaster_log", $criteria);
+	}
+sub log_query
+	{
+	my ($self, $query, $total) = @_;
+	return unless $query;
+	my $date = time;
+	$matches ||= '0';
+	$self->db->insert("poetaster_log", { query => $query, date => $date, matches => $total });
+	}
+1;
+
diff --git a/bucky2/lib/Rest.pm b/bucky2/lib/Rest.pm
new file mode 100644
index 0000000..076a434
--- /dev/null
+++ b/bucky2/lib/Rest.pm
@@ -0,0 +1,183 @@
+package Rest;
+use Common;
+use LWP;
+use LWP::UserAgent;
+use URI::Escape;
+use WWW::Shorten;
+use XML::Simple;
+sub new
+	{
+	my ($class, $self) = @_;
+	my $self ||= {};
+	bless $self, $class;
+	}
+sub browser
+	{
+	my ($self) = @_;
+	if (! exists($self->{'browser'}) )
+		{
+		$self->{'browser'} = new LWP::UserAgent;
+		$self->{'browser'}->agent("Mozilla/5.0 (compatible)");
+		}
+	return $self->{'browser'};
+	}
+sub rest_post_raw
+	{
+	my ($self, $uri, $data) = @_;
+	my $qs = $self->qs_encode($data);
+	my $r = HTTP::Request->new(POST => $uri);
+	$r->content_type('application/x-www-form-urlencoded');
+	$r->content($qs);
+	my $re = $self->browser->request($r);
+	my $content = $re->content();
+	return $content;
+	}
+sub rest_post
+	{
+	my ($self, $uri, $data) = @_;
+	my $qs = $self->qs_encode($data);
+	return undef unless $qs && $self->do_auth;
+	my $r = HTTP::Request->new(POST => $uri);
+	if ($self->do_auth)
+		{ $r->authorization_basic($self->auth); }
+	$r->content_type('application/x-www-form-urlencoded');
+	$r->content($qs);
+	my $re = $self->browser->request($r);
+	my $xml = $re->content();
+	my $ref = XMLin($xml);
+	return $ref;
+	}
+sub proxy_uri
+	{
+	my ($self, $uri) = @_;
+	my $random_proxy = $self->proxy_random;
+	my $proxy_uri = "http://" . $random_proxy . "/browse.php?u=" . uri_escape($uri);
+	return $proxy_uri;
+	}
+sub proxy_load
+	{
+	my ($self) = @_;
+	my $proxies = $self->read_data("../tmp/proxies.txt");
+	my @lines = split "\n", $proxies;
+	my $real = [];
+	map { push @$real, $_ if $_ } @lines;
+	return $real;
+	}
+sub rest_get_proxy
+	{
+	my ($self, $uri, $data) = @_;
+	my $proxy_uri = $self->proxy_uri($uri);
+	return $self->rest_get_raw($proxy_uri, $data, \&_rest_get_raw_callback);
+	}
+sub rest_get_raw
+	{
+	my ($self, $uri, $data) = @_;
+	return $self->rest_get($uri, $data, \&_rest_get_raw_callback);
+	}
+sub rest_get_xml
+	{
+	my ($self, $uri, $data) = @_;
+	return $self->rest_get($uri, $data, \&_rest_get_xml_callback);
+	}
+sub _rest_get_raw_callback
+	{
+	my ($self, $data) = @_;
+	return $data;
+	}
+sub _rest_get_xml_callback
+	{
+	my ($self, $data) = @_;
+	return XMLin($data);
+	}
+sub rest_get
+	{
+	my ($self, $uri, $data, $callback) = @_;
+	$callback ||= \&_rest_get_xml_callback;
+	my $qs = $self->qs_encode($data);
+	if ($qs)
+		{ $uri = $uri . "?" . $qs; }
+	my $r = HTTP::Request->new(GET => $uri);
+	if ($self->do_auth)
+		{ $r->authorization_basic($self->auth); }
+print "getting $uri\n";
+	my $re = $self->browser->request($r);
+	my $data = $re->content();
+	my $ref = $self->$callback($data);
+	return $ref;
+	}
+sub qs_encode
+	{
+	my ($self, $data) = @_;
+	my $qs = [];
+	foreach my $key (keys %$data)
+		{
+		my $val = uri_escape($data->{$key});
+		next unless $val;
+		push @$qs, "$key=$val";
+		}
+	return undef unless scalar(@$qs);
+	my $encoded = join "&", @$qs;
+	return $encoded;
+	}
+sub auth
+	{
+	my ($self, $user, $pass) = @_;
+	if ($user && $pass)
+		{
+		$self->{'user'} = $user;
+		$self->{'pass'} = $pass;
+		}
+	else
+		{
+		$user = $self->{'user'};
+		$pass = $self->{'pass'};
+		}
+	return ($user, $pass);
+	}
+sub do_auth
+	{
+	my ($self) = @_;
+	if ($self->{'user'} && $self->{'pass'})
+		{ return 1; }
+	return undef;
+	}
+sub user
+	{
+	my ($self) = @_;
+	if ($self->do_auth)
+		{ return $self->{'user'}; }
+	return undef;
+
+	}
+sub read_xml
+	{
+	my ($self, $file) = @_;
+	my $data = $self->read_data($file);
+	return XMLin($data);
+	}
+sub write_xml
+	{
+	my ($self, $file, $data) = @_;
+	my $xml = XMLout($data);
+	$self->write_data($file, $xml);
+	}
+sub read_data
+	{
+	my ($self, $file) = @_;
+	return undef unless -e $file;
+	open IN, $file or die $!;
+	my @lines = <IN>;
+	close IN;
+	my $out = join "", @lines;
+	print "Read " . length($out) . " bytes\n";
+	return $out;
+	}
+sub write_data
+	{
+	my ($self, $file, $data) = @_;
+	open OUT, ">$file" or die $!;
+	print OUT $data;
+	close OUT;
+	print "Wrote " . length($data) . " bytes\n";
+	}
+1;
diff --git a/bucky2/lib/Rest/Dailyrotten.pm b/bucky2/lib/Rest/Dailyrotten.pm
new file mode 100644
index 0000000..93a41a7
--- /dev/null
+++ b/bucky2/lib/Rest/Dailyrotten.pm
@@ -0,0 +1,76 @@
+package Rest::Dailyrotten;
+use base 'Rest';
+
+#	my $topsy_data = $self->rest_get_raw($self->topsy_query($page));
+#	$self->write_data("../tmp/topsy_call", $topsy_data);
+#	exit;
+
+
+sub dailyrotten_get
+	{
+	my ($self) = @_;
+	my $year = 2009;
+	my $archive_url = "http://www.dailyrotten.com/archive/$year/";
+	my $dailyrotten_calendar = $self->rest_get_raw($archive_url);
+	my @lines = split "\n", $dailyrotten_calendar;
+	my $valid = [];
+	foreach my $line (@lines)
+		{
+		if ($line =~ /<a href="$archive_url(_$year-\d+-\d+.html)">/)
+			{
+			push @$valid, $1;
+			}
+		}
+	# skip the last day so we can get accurate forum count later
+	my $skip = pop(@$valid);
+	my $xml_data = [];
+	foreach my $file (@$valid)
+		{
+		my $raw_data = $self->read_data("../tmp/dr/raw/$file");
+		if (!$raw_data)
+			{
+			sleep 5;
+			my $page_url = $archive_url . $file;
+			$raw_data = $self->rest_get_raw($page_url);
+			$self->write_data("../tmp/dr/raw/$file", $raw_data);
+			}
+		my $posts = $self->dailyrotten_posts($raw_data);
+		push @$xml_data, { file => $file, post => $posts };
+		}
+	$self->write_xml("../tmp/dr/2009.xml", $xml_data);
+	}
+sub dailyrotten_load
+	{
+	my ($self) = @_;
+	return $self->read_xml("../tmp/dr/2009.xml");
+	}
+sub dailyrotten_posts
+	{
+	my ($self, $raw_data) = @_;
+	my @lines = split "\n", $raw_data;
+	my $recs = [];
+	my $rec = {};
+	foreach my $line (@lines)
+		{
+##		if ($line =~ /Daily Rotten Archives<\/font><br>(.*)<br>/)
+#			{
+#			}
+		if ($line =~ /^<a href="(.*)" target="_blank">Read article\.\.\.<\/a>/)
+			{
+			$rec->{'url'} = $1;
+			}
+		if ($line =~ /class="newslink">(.*)<\/a>/)
+			{
+			$rec->{'title'} = $1;
+			}
+		if ($line =~ /Comments \((\d+)\)/)
+			{
+			$rec->{'comments'} = $1;
+			push @$recs, $rec;
+			$rec = {};
+			}
+		}
+	return $recs;
+	}
+
+1;
diff --git a/bucky2/lib/Rest/Topsy.pm b/bucky2/lib/Rest/Topsy.pm
new file mode 100644
index 0000000..3ef045e
--- /dev/null
+++ b/bucky2/lib/Rest/Topsy.pm
@@ -0,0 +1,185 @@
+package Rest::Topsy;
+use base 'Rest';
+use Data::Dumper;
+use XML::Simple;
+
+sub topsy_search
+	{
+	my ($self, $query) = @_;
+	my $topsy_data = $self->rest_get_raw("http://topsy.com/s", { q => $query });
+	my $initials = $query;
+	$initials =~ s/\W//g;
+	$initials = substr($initials, 0, 2);
+	if (! -e "../tmp/nndb/topsy/$initials")
+		{
+		system("/bin/mkdir", "../tmp/nndb/topsy/$initials");
+		}
+	$self->write_data("../tmp/nndb/topsy/$initials/$query.txt", $topsy_data);
+	my @lines = split "\n", $topsy_data;
+	my $value = undef;
+	my $rank = {};
+	foreach my $line (@lines)
+		{
+		if ($line =~ /<span class="(count|label)">(.*)<\/span>/)
+			{
+			my ($token, $text) = ($1, $2);
+			if ($token eq "count")
+				{
+				$value = $text;
+				$value =~ s/\,//;
+				}
+			elsif ($token eq "label")
+				{
+				$rank->{lc $text} = $value if $value;
+				undef $value;
+				}
+			}
+		}
+	return $rank;
+	}
+sub topsy_get
+	{
+	my ($self) = @_;
+
+#	my $topsy_data = $self->rest_get_raw($self->topsy_query($page));
+#	$self->write_data("../tmp/topsy_call", $topsy_data);
+#	exit;
+
+	$topsy_data = $self->read_data("../tmp/topsy_call");
+
+	my $topsy_script_data ||= $self->topsy_script_data($topsy_data);
+	my $topsy_entries = $self->topsy_entries($topsy_data);
+	my $xml_entries = $self->topsy_load;
+	if (scalar(@$xml_entries))
+		{
+		$topsy_entries = $xml_entries;
+		}
+
+	my $page = int(scalar(@$topsy_entries) / 10) || 1;
+	my $last_page = $topsy_script_data->{'pages'};
+
+	print "$last_page pages\n";
+
+	while ($page < $last_page)
+		{
+		$page++;
+		print $page . "...";
+		my $page_data = $self->rest_get_raw($self->topsy_query($page));
+		my $page_entries = $self->topsy_entries($page_data);
+		push @$topsy_entries, @$page_entries;
+		$self->write_xml("../tmp/topsy_entries.xml", $topsy_entries);
+		sleep 10 + (int rand 5);
+		}
+
+	print "Expected " . $topsy_script_data->{'total'} . ", got " . scalar(@$topsy_entries)."\n";
+
+	$self->write_xml("../tmp/topsy_entries.xml", $topsy_entries);
+
+	return @$page_entries;
+	}
+sub topsy_load
+	{
+	my ($self) = @_;
+	my $page_entries = $self->read_xml("../tmp/topsy_entries.xml");
+	print "Loaded ".scalar(@$page_entries)." entries\n";
+	return $page_entries;
+	}
+
+sub topsy_entries
+	{
+	my ($self, $data) = @_;
+	my @raw_entries = split '<div class="concept-rank">', $data;
+	my $entries = [];
+	my $current = "";
+	foreach my $entry (@raw_entries)
+		{
+		next if $entry =~ /concept-list-re/;
+		my $entry_hash = {};
+		my @lines = split "\n", $entry;
+		my $key = "";
+LINE:	foreach my $line (@lines)
+			{
+			$line = $self->trim($line);
+			next unless $line;
+			if ($line =~ /class\=\"(\w+)\"/)
+				{
+				$key = $1;
+				}
+			my $value = "";
+			if ($line =~ /url\((.*)\)/)
+				{
+				$entry_hash->{'tile'} = $1;
+				}
+			if ($key eq "total" && $line =~ />(\d+)</)
+				{
+				$value = $1;
+				}
+			elsif ($line =~ />(.*)</)
+				{
+				$value = $1;
+				}
+			elsif ($key eq "description" && $line =~ /\&ldquo\;(.*)\&rdquo\;/)
+				{
+				$value = $1;
+				$value =~ s/ http.*$//;
+				}
+			if ($key && $value)
+				{
+				$entry_hash->{$key} = $value;
+				undef $key;
+				}
+			last LINE if $line =~ /script type\=\"text/;
+			}
+		if (scalar keys %$entry_hash)
+			{
+			push @$entries, $entry_hash;
+			}
+		}
+	return $entries;
+	}
+# Recipes.re= {
+#    page:    2,
+#    total:   964,
+#    perpage: 10,
+#    pages:   97
+# };
+sub topsy_script_data
+	{
+	my ($self, $data) = @_;
+	my @lines = split "\n", $data;
+	my $script_data = {};
+	foreach my $line (@lines)
+		{
+		next unless $line =~ /\:/;
+		$line =~ s/\s+//g;
+		$line =~ s/\,//;
+		my ($k, $v) = split ":", $line;
+		next unless $k && $v;
+		next unless $k =~ /^(page|total|perpage|pages)/;
+		$script_data->{$k} = $v;
+		}
+	return scalar keys %$script_data ? $script_data : undef;
+	}
+sub topsy_query
+	{
+	my ($self, $page) = @_;
+	my $url = "http://topsy.com/concept";
+	my $query =
+		{
+		"page" => $page,
+		"sort_method" => "",
+		"url" => $self->url,
+		"class" => "UB::Concept::List::Re",
+		};
+	return ($url, $query);
+	}
+sub url
+	{
+	my ($self, $url) = @_;
+	if ($url)
+		{
+		$self->{'url'} = $url;
+		}
+	return $self->{'url'};
+	}
+1;
diff --git a/bucky2/lib/Rest/Twitter.pm b/bucky2/lib/Rest/Twitter.pm
new file mode 100644
index 0000000..00220a6
--- /dev/null
+++ b/bucky2/lib/Rest/Twitter.pm
@@ -0,0 +1,129 @@
+package Rest::Twitter;
+use base 'Rest';
+use Data::Dumper;
+my $twitter_status_uri	= "http://twitter.com/statuses/mentions.xml";
+my $twitter_update_uri	= "http://twitter.com/statuses/update.xml";
+my $twitter_dm_uri		= "http://twitter.com/direct_messages.xml";
+my $twitter_dm_new_uri	= "http://twitter.com/direct_messages/new.xml";
+
+sub dm_post
+	{
+	my ($self, $user, $tweet) = @_;
+	return unless $user && $tweet;
+	$tweet =~ s/\s+/ /g;
+	print ">>> D $user: $tweet\n";
+	return $self->rest_post($twitter_dm_new_uri, {text => $tweet, user => $user});
+	}
+sub tweet_post
+	{
+	my ($self, $tweet, $replyid) = @_;
+	$tweet =~ s/\s+/ /g;
+	print ">>> $tweet\n";
+	return $self->rest_post($twitter_update_uri, {status => $tweet, in_reply_to_status_id => $replyid});
+	}
+sub dm_get
+	{
+	my ($self) = @_;
+	my $twitter_since_id = $self->since_id("dm");
+	my $dm_data = $self->rest_get($twitter_dm_uri, {since_id => $twitter_since_id});
+#	return (undef, undef) unless exists($tweet_data->{'status'});
+	# DEFAULT: plural behavior
+	my $status = $dm_data->{'direct_message'};
+	# CATCH: singular behavior
+	if (exists($status->{'id'}))
+		{
+		my $id = $status->{'id'};
+		$status = { $id => $status };
+		}
+	my $dms = [];
+	my $last_id = 0;
+	foreach my $id (keys %{ $status })
+		{
+		if ($id > $last_id)
+			{ $last_id = $id; }
+		my $dm = $status->{$id}->{'text'};
+		my $user = $status->{$id}->{'sender_screen_name'};
+		push @$dms, {id => $id, tweet => $dm, user => $user, type => "dm"};
+		}
+	if ($last_id > $twitter_since_id)
+		{
+		$self->since_id("dm", $last_id);
+		}
+	return $dms;
+	}
+sub tweet_get
+	{
+	my ($self) = @_;
+	my $twitter_since_id = $self->since_id("status");
+	my $tweet_data = $self->rest_get($twitter_status_uri, {since_id => $twitter_since_id});
+	return (undef, undef) unless exists($tweet_data->{'status'});
+	# DEFAULT: plural behavior
+	my $status = $tweet_data->{'status'};
+	# CATCH: singular behavior
+	if (exists($status->{'id'}))
+		{
+		my $id = $status->{'id'};
+		$status = { $id => $status };
+		}
+	my $tweets = [];
+	my $last_id = 0;
+	foreach my $id (keys %{ $status })
+		{
+		if ($id > $last_id)
+			{ $last_id = $id; }
+		my $tweet = $status->{$id}->{'text'};
+		my $user = $status->{$id}->{'user'}->{'screen_name'};
+		push @$tweets, {id => $id, tweet => $tweet, user => $user, type => "tweet"};
+		}
+	if ($last_id > $twitter_since_id)
+		{
+		$self->since_id("status", $last_id);
+		}
+	return $tweets;
+	}
+sub since_id
+	{
+	my ($self, $key, $id) = @_;
+	return unless $key;
+	$self->{'since'} ||= {};
+	if ($id)
+		{
+		if ($self->{'since'}->{$key} < $id)
+			{
+			$self->{'since'}->{$key} = $id;
+			$self->_since_id_write($key, $id);
+			}
+		}
+	if (! exists($self->{'since'}->{$key}))
+		{
+		$self->{'since'}->{$key} = $self->_since_id_read($key);
+		}
+	return $self->{'since'}->{$key};
+	}
+sub _since_id_read
+	{
+	my ($self, $key) = @_;
+	my $file = $self->_since_id_file($key);
+	open LAST, $file;
+	my $line = $self->trim(<LAST>);
+	close LAST;
+	return $line;
+	}
+sub _since_id_write
+	{
+	my ($self, $key, $id) = @_;
+	my $file = $self->_since_id_file($key);
+	open LAST, ">$file";
+	print LAST $id."\n";
+	close LAST;
+	}
+sub _since_id_file
+	{
+	my ($self, $key) = @_;
+	my $tmp_dir = "../tmp";
+	my $file = $tmp_dir."/twitter-".$self->user."-".$key;
+	for ($tmp_dir, $file)
+		{ die ("can't find $_") unless -e $_; }
+	return $file;
+	}
+1;
diff --git a/bucky2/lib/Time/Stopwatch.pm b/bucky2/lib/Time/Stopwatch.pm
new file mode 100644
index 0000000..b7cec26
--- /dev/null
+++ b/bucky2/lib/Time/Stopwatch.pm
@@ -0,0 +1,13 @@
+################################################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/bucky2/lib/localbucky.pm b/bucky2/lib/localbucky.pm
new file mode 100644
index 0000000..41c7553
--- /dev/null
+++ b/bucky2/lib/localbucky.pm
@@ -0,0 +1,12 @@
+package Bucky;
+my $LOCAL_CONFIG =
+	{
+	SVN_SECRET => '1s0c4h3dr0n',
+	};
+sub config
+	{
+	my ($self, $key) = @_;
+	$key ||= $self;
+	return $LOCAL_CONFIG->{$key} if $LOCAL_CONFIG->{$key};
+	}
+1;