R/sqlite-cache.R

In skubicius/cashmere: Implements disk and memory caching

SqliteCache <- R6Class(
  classname = "SqliteCache",
  inherit = Cache,

  public = list(
    initialize = function(dir = tempfile()) {
      if (!dir.exists(dir))
        dir.create(dir)

      private$db <- Database$new(dir)
      private$db$execute(private$sql$init)
    },

    # removes expired keys
    trim = function() {
      private$db$execute(
        "delete from cache where expire_time < :time_now",
        params = list(time_now = time_now())
      )
    },

    # drops the main cache table and disconnects from the db
    destroy = function() {},

    # returns the cached value for a valid key
    # if a key does not exist or is expired, returns default
    get = function(key, default = NULL) {
      row <- private$get_row(key)
      if (private$is_empty(row))
        return(default)

      if (private$is_expired(row)) {
        self$delete(key)
        return(default)
      }

      time_now <- time_now()
      private$db$execute(
        "update cache set access_time = :access_time, access_count = access_count + 1 where key_hash = :key_hash",
        params = list(access_time = time_now, key_hash = private$hash(key))
      )

      private$unserial(row[["value"]])
    },

    exists = function(key) {
      !private$is_empty(private$get_row(key))
    },

    # adds key/value to the db
    set = function(key, value, expire_in = NULL) {
      private$db$execute(
        private$sql$insert,
        params = private$create_params(key, value, expire_in)
      )
    },

    # delete key from cache
    delete = function(key) {
      private$db$execute(
        "delete from cache where key_hash = :key_hash",
        params = list(key_hash = private$hash(key))
      )
    },

    print_table = function() {
      private$db$fetch("select * from cache")
    }
  ),

  private = list(
    db = NULL,

    create_params = function(key, value, expire_in) {
      time_now <- time_now()

      list(
        key_hash = private$hash(key),
        store_time = time_now,
        access_time = time_now,
        expire_time = ifelse(is.null(expire_in), NA, time_now + expire_in),
        access_count = 0,
        value = private$serial(value)
      )
    },

    get_row = function(key) {
      key_hash <- private$hash(key)
      private$db$fetch(private$sql$select, params = list(key_hash = key_hash))
    },

    sql = list(
      init =
      "create table if not exists cache (
        key_hash TEXT PRIMARY KEY,
        store_time REAL,
        access_time REAL,
        expire_time REAL,
        access_count INTEGER,
        value BLOB
      );

      create index if not exists cache_key_hash on cache(key_hash);
      ",

      insert = "insert into cache values (:key_hash, :store_time, :access_time, :expire_time, :access_count, :value)",
      select = "select key_hash, expire_time, value from cache where key_hash = :key_hash"
    )
  )
)