Skip to content
Browse files

Inital Commit.

  • Loading branch information...
0 parents commit 2ac6f33e827c9fac18acc3f5f7cdf0276d727cb7 @symkat symkat committed Jun 14, 2011
Showing with 155 additions and 0 deletions.
  1. +14 −0 Makefile.PL
  2. +1 −0 README.md
  3. +106 −0 lib/Cache/SQLite.pm
  4. +14 −0 t/00_load.t
  5. +20 −0 t/01_basic_functions.t
14 Makefile.PL
@@ -0,0 +1,14 @@
+use inc::Module::Install;
+
+# Define metadata
+name 'Cache-SQLite';
+all_from 'lib/Cache/SQLite.pm';
+license 'bsd';
+
+# Specific dependencies
+requires 'DBI';
+requires 'DBD::SQLite';
+
+test_requires 'Test::More' => '0.42';
+
+WriteAll;
1 README.md
@@ -0,0 +1 @@
+# Not Production Ready
106 lib/Cache/SQLite.pm
@@ -0,0 +1,106 @@
+package Cache::SQLite;
+use warnings;
+use strict;
+use DBI;
+use Data::Dumper;
+
+our $VERSION = '0.001000'; # 0.1.0
+$VERSION = eval $VERSION;
+
+my $hit_count = 0;
+
+sub new {
+ my ( $class ) = @_;
+ my $self = {};
+ bless $self, $class;
+ $self->connection(
+ DBI->connect( "dbi:SQLite:dbname=:memory:", "", "" )
+ );
+ $self->_make_table();
+ return $self;
+}
+
+sub cache_limit {
+ 10;
+}
+
+sub connection {
+ my $self = shift;
+ $self->{_connection} = shift if @_;
+ return $self->{_connection};
+}
+
+sub _make_table {
+ my ( $self ) = @_;
+ my $sql = qq/
+ CREATE TABLE cache (
+ key text UNIQUE,
+ value text,
+ expires int,
+ hit int,
+ hit_count int )
+ /;
+ $self->connection->do( $sql );
+}
+
+sub set {
+ my ( $self, $key, $value, $expires ) = @_;
+ my $sth = $self->connection
+ ->prepare( "INSERT into cache ( key, value, expires ) VALUES( ?, ?, ? )" );
+ $sth->execute( $key, $value, $expires || 0 );
+ return $self;
+}
+
+sub get {
+ my ( $self, $key ) = @_;
+
+ if ( ++$hit_count % 50 == 0 ) {
+ $self->purge_over_limit;
+ $self->purge_expired;
+ }
+
+ my $sth = $self->connection->prepare( "SELECT * FROM cache WHERE key = ? LIMIT 1" );
+ $sth->execute( $key );
+ my $row = $sth->fetchrow_hashref;
+
+ if ( $row ) {
+ $self->hit( $row->{value} );
+ return $row->{value};
+ }
+ return undef;
+}
+
+sub purge {
+ my ( $self, $key ) = @_;
+ my $sth = $self->connection->prepare( "DELETE FROM cache WHERE key = ?" );
+ $sth->execute( $key );
+ return $self;
+}
+
+sub purge_expired {
+ my ( $self ) = @_;
+ my $sth = $self->connection->prepare("DELETE FROM cache where expires <= ? AND expires != 0");
+ $sth->execute( time() );
+ return $self;
+}
+
+sub purge_over_limit {
+ my ( $self ) = @_;
+ my $sth = $self->connection->prepare( "SELECT * from cache ORDER BY hit DESC LIMIT 1000 OFFSET ?" );
+ $sth->execute( $self->cache_limit );
+ my $delete = $self->connection->prepare( "DELETE FROM cache WHERE key = ?" );
+ for my $row ( $sth->fetchrow_hashref ) {
+ next unless $row;
+ $delete->execute( $row->{key} );
+ }
+ return $self;
+}
+
+sub hit {
+ my ( $self, $key ) = @_;
+ my $sth = $self->connection->prepare( "UPDATE cache SET hit = hit + 1 WHERE key = ?" );
+ $sth->execute( $key );
+ return $self;
+}
+
+1;
14 t/00_load.t
@@ -0,0 +1,14 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use Test::More;
+
+my @required_modules = qw/
+ DBI
+ DBD::SQLite
+ Cache::SQLite
+/;
+
+use_ok( $_ ) for @required_modules;
+
+done_testing;
20 t/01_basic_functions.t
@@ -0,0 +1,20 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use Test::More;
+use Cache::SQLite;
+
+ok my $Cache = Cache::SQLite->new;
+
+ok $Cache->isa( 'Cache::SQLite' );
+
+ok $Cache->set( "hello", "world" );
+ok $Cache->set( "Dr", "Who", time() + 10 );
+
+is $Cache->get( "hello" ), "world";
+is $Cache->get( "Dr" ), "Who";
+
+ok $Cache->purge( "hello" );
+is $Cache->get( "hello" ), undef;
+
+done_testing;

0 comments on commit 2ac6f33

Please sign in to comment.
Something went wrong with that request. Please try again.