bucky2

8 files changed, 383 insertions, 0 deletions

diff --git a/bucky2/bin/__db.auto.db b/bucky2/bin/__db.auto.db
new file mode 100644
index 0000000..e69de29
--- /dev/null
+++ b/bucky2/bin/__db.auto.db
diff --git a/bucky2/bin/build-autocomplete b/bucky2/bin/build-autocomplete
new file mode 100755
index 0000000..d9a62fd
--- /dev/null
+++ b/bucky2/bin/build-autocomplete
@@ -0,0 +1,53 @@
+#!/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/bucky2/bin/build-index b/bucky2/bin/build-index
new file mode 100755
index 0000000..437f146
--- /dev/null
+++ b/bucky2/bin/build-index
@@ -0,0 +1,112 @@
+#!/usr/bin/perl
+use strict;
+use lib "../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");
+
+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/cp", "./$file", "../cgi-bin/$file");
+# 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/bucky2/bin/build-splashes b/bucky2/bin/build-splashes
new file mode 100755
index 0000000..d5fd5c1
--- /dev/null
+++ b/bucky2/bin/build-splashes
@@ -0,0 +1,112 @@
+#!/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/bucky2/bin/gross.db b/bucky2/bin/gross.db
new file mode 100644
index 0000000..6df80d0
--- /dev/null
+++ b/bucky2/bin/gross.db
diff --git a/bucky2/bin/listener.pl b/bucky2/bin/listener.pl
new file mode 100755
index 0000000..0f0f2d9
--- /dev/null
+++ b/bucky2/bin/listener.pl
@@ -0,0 +1,65 @@
+#!/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/bucky2/bin/poetaster b/bucky2/bin/poetaster
new file mode 100755
index 0000000..fe973a5
--- /dev/null
+++ b/bucky2/bin/poetaster
@@ -0,0 +1,33 @@
+#!/usr/bin/perl 
+use lib "../lib";
+use Rest;
+use CGI;
+use Poetaster;
+
+my $file = $ARGV[0] || "twain";
+my $data = load_data($file);
+$data =~ s/<[^>]+>//g;
+$data =~ s/\r\n/ /g;
+$data =~ s/\s+/ /g;
+$data =~ s/\. \. \. /... /g;
+my $self = new Poetaster;
+my $poem = $self->poem($data);
+print $poem;
+
+sub load_data
+	{
+	my ($file) = @_;
+	my $data = '';
+	if ($file =~ /^http/)
+		{
+		$data = Rest->new->rest_get_raw($file);
+		}
+	else
+		{
+		local $/;
+		open F, $file;
+		$data = <F>;
+		close F;
+		}
+	return $data;
+	}
diff --git a/bucky2/bin/watch-index.pl b/bucky2/bin/watch-index.pl
new file mode 100755
index 0000000..c9d950b
--- /dev/null
+++ b/bucky2/bin/watch-index.pl
@@ -0,0 +1,8 @@
+#!/usr/bin/perl
+
+while (1)
+	{
+	system("./build-index");
+	sleep(60*60);
+	}
+