R/queue.R

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