R/queue.R

   1 setClass("queue",
   2          representation(queue = "filehashDB1",
   3                         name = "character")
   4          )
   5
   6 createQ <- function(filename) {
   7         dbCreate(filename, "DB1")
   8         queue <- dbInit(filename, "DB1")
   9         dbInsert(queue, "head", NULL)
  10         dbInsert(queue, "tail", NULL)
  11
  12         new("queue", queue = queue, name = filename)
  13 }
  14
  15 initQ <- function(filename) {
  16         new("queue",
  17             queue = dbInit(filename, "DB1"),
  18             name = filename)
  19 }
  20
  21 setGeneric("lockFile", function(db, ...) standardGeneric("lockFile"))
  22
  23 ## Public
  24 setGeneric("pop", function(db, ...) standardGeneric("pop"))
  25 setGeneric("push", function(db, val, ...) standardGeneric("push"))
  26 setGeneric("isEmpty", function(db, ...) standardGeneric("isEmpty"))
  27 setGeneric("top", function(db, ...) standardGeneric("top"))
  28
  29
  30 ################################################################################
  31 ## Methods
  32
  33 setMethod("lockFile", "queue",
  34           function(db, ...) {
  35                   paste(db@name, "qlock", sep = ".")
  36           })
  37
  38 setMethod("push", c("queue", "ANY"), function(db, val, ...) {
  39         ## Create a new tail node
  40         node <- list(value = val,
  41                      nextkey = NULL)
  42         key <- sha1(node)
  43
  44         if(!createLockFile(lockFile(db)))
  45                 stop("cannot create lock file")
  46         on.exit(deleteLockFile(lockFile(db)))
  47
  48         if(isEmpty(db))
  49                 dbInsert(db@queue, "head", key)
  50         else {
  51                 ## Convert tail node to regular node
  52                 tailkey <- dbFetch(db@queue, "tail")
  53                 oldtail <- dbFetch(db@queue, tailkey)
  54                 dbInsert(db@queue, tl,
  55                          list(value = oldtail$value, nextkey = key))
  56         }
  57         ## Insert new node and point tail to new node
  58         dbInsert(db@queue, key, node)
  59         dbInsert(db@queue, "tail", key)
  60 })
  61
  62 setMethod("isEmpty", "queue", function(db) {
  63         is.null(dbFetch(db@queue, "head"))
  64 })
  65
  66 setMethod("top", "queue", function(db, ...) {
  67         if(!createLockFile(lockFile(db)))
  68                 stop("cannot create lock file")
  69         tryCatch({
  70                 h <- dbFetch(db@queue, "head")
  71
  72                 if(is.null(h))
  73                         return(NULL)
  74                 node <- dbFetch(db@queue, h)
  75         }, finally = {
  76                 deleteLockFile(lockFile(db))
  77         })
  78         node$value
  79 }
  80
  81 setMethod("pop", "queue", function(db, ...) {
  82         if(!createLockFile(lockFile(db)))
  83                 stop("cannot create lock file")
  84         tryCatch({
  85                 h <- dbFetch(db@queue, "head")
  86
  87                 if(is.null(h))
  88                         return(NULL)
  89                 node <- dbFetch(db@queue, h)
  90                 dbInsert(db@queue, "head", node$nextkey)
  91         }, finally = {
  92                 deleteLockFile(lockFile(db))
  93         })
  94         dbDelete(db@queue, h)
  95         node$value
  96 }