summaryrefslogtreecommitdiff
path: root/bucky2/lib
diff options
context:
space:
mode:
Diffstat (limited to 'bucky2/lib')
-rw-r--r--bucky2/lib/Bucky.pm159
-rw-r--r--bucky2/lib/Bucky/DB.pm147
-rw-r--r--bucky2/lib/Bucky/Keyword.pm26
-rw-r--r--bucky2/lib/Bucky/SVN.pm103
-rw-r--r--bucky2/lib/Bucky/Search.pm413
-rw-r--r--bucky2/lib/Bucky/Session.pm19
-rw-r--r--bucky2/lib/Bucky/Thread.pm30
-rw-r--r--bucky2/lib/Common.pm46
-rw-r--r--bucky2/lib/Poetaster.pm140
-rw-r--r--bucky2/lib/Rest.pm183
-rw-r--r--bucky2/lib/Rest/Dailyrotten.pm76
-rw-r--r--bucky2/lib/Rest/Topsy.pm185
-rw-r--r--bucky2/lib/Rest/Twitter.pm129
-rw-r--r--bucky2/lib/Time/Stopwatch.pm13
-rw-r--r--bucky2/lib/localbucky.pm12
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;
generated by cgit v1.2.3-70-g09d2 (git 2.51.0) at 2025-12-10 09:24:35 +0000