├── .Rbuildignore ├── .github ├── .gitignore ├── CODE_OF_CONDUCT.md └── workflows │ ├── R-CMD-check.yaml │ ├── pr-commands.yaml │ └── test-coverage.yaml ├── .gitignore ├── DESCRIPTION ├── LICENSE ├── LICENSE.md ├── Makefile ├── NAMESPACE ├── NEWS.md ├── R ├── assertions.R ├── db.R ├── liteq-package.R ├── messages.R ├── package.R ├── queue.R └── utils.R ├── README.Rmd ├── README.md ├── codecov.yml ├── inst └── examples │ └── queue-scraper.R ├── man ├── ack.Rd ├── consume.Rd ├── create_queue.Rd ├── db_ack.Rd ├── db_consume.Rd ├── db_create_queue.Rd ├── db_try_consume.Rd ├── default_db.Rd ├── delete_queue.Rd ├── ensure_db.Rd ├── ensure_queue.Rd ├── is_empty.Rd ├── list_failed_messages.Rd ├── list_messages.Rd ├── list_queues.Rd ├── liteq-package.Rd ├── liteq.Rd ├── make_message.Rd ├── message_count.Rd ├── nack.Rd ├── publish.Rd ├── remove_failed_messages.Rd ├── requeue_failed_messages.Rd └── try_consume.Rd └── tests ├── testthat.R └── testthat ├── test-blocking.R ├── test-concurrency.R ├── test-crashes.R ├── test-db.R ├── test-messages.R ├── test-queue.R ├── test-remove-failed.R ├── test-requeue-failed.R └── test-utils.R /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^Makefile$ 4 | ^README.Rmd$ 5 | ^.travis.yml$ 6 | ^appveyor.yml$ 7 | ^revdep$ 8 | ^\.github$ 9 | ^LICENSE\.md$ 10 | ^codecov\.yml$ 11 | -------------------------------------------------------------------------------- /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /.github/CODE_OF_CONDUCT.md: -------------------------------------------------------------------------------- 1 | # Contributor Covenant Code of Conduct 2 | 3 | ## Our Pledge 4 | 5 | We as members, contributors, and leaders pledge to make participation in our 6 | community a harassment-free experience for everyone, regardless of age, body 7 | size, visible or invisible disability, ethnicity, sex characteristics, gender 8 | identity and expression, level of experience, education, socio-economic status, 9 | nationality, personal appearance, race, caste, color, religion, or sexual 10 | identity and orientation. 11 | 12 | We pledge to act and interact in ways that contribute to an open, welcoming, 13 | diverse, inclusive, and healthy community. 14 | 15 | ## Our Standards 16 | 17 | Examples of behavior that contributes to a positive environment for our 18 | community include: 19 | 20 | * Demonstrating empathy and kindness toward other people 21 | * Being respectful of differing opinions, viewpoints, and experiences 22 | * Giving and gracefully accepting constructive feedback 23 | * Accepting responsibility and apologizing to those affected by our mistakes, 24 | and learning from the experience 25 | * Focusing on what is best not just for us as individuals, but for the overall 26 | community 27 | 28 | Examples of unacceptable behavior include: 29 | 30 | * The use of sexualized language or imagery, and sexual attention or advances of 31 | any kind 32 | * Trolling, insulting or derogatory comments, and personal or political attacks 33 | * Public or private harassment 34 | * Publishing others' private information, such as a physical or email address, 35 | without their explicit permission 36 | * Other conduct which could reasonably be considered inappropriate in a 37 | professional setting 38 | 39 | ## Enforcement Responsibilities 40 | 41 | Community leaders are responsible for clarifying and enforcing our standards of 42 | acceptable behavior and will take appropriate and fair corrective action in 43 | response to any behavior that they deem inappropriate, threatening, offensive, 44 | or harmful. 45 | 46 | Community leaders have the right and responsibility to remove, edit, or reject 47 | comments, commits, code, wiki edits, issues, and other contributions that are 48 | not aligned to this Code of Conduct, and will communicate reasons for moderation 49 | decisions when appropriate. 50 | 51 | ## Scope 52 | 53 | This Code of Conduct applies within all community spaces, and also applies when 54 | an individual is officially representing the community in public spaces. 55 | Examples of representing our community include using an official e-mail address, 56 | posting via an official social media account, or acting as an appointed 57 | representative at an online or offline event. 58 | 59 | ## Enforcement 60 | 61 | Instances of abusive, harassing, or otherwise unacceptable behavior may be 62 | reported to the community leaders responsible for enforcement at codeofconduct@posit.co. 63 | All complaints will be reviewed and investigated promptly and fairly. 64 | 65 | All community leaders are obligated to respect the privacy and security of the 66 | reporter of any incident. 67 | 68 | ## Enforcement Guidelines 69 | 70 | Community leaders will follow these Community Impact Guidelines in determining 71 | the consequences for any action they deem in violation of this Code of Conduct: 72 | 73 | ### 1. Correction 74 | 75 | **Community Impact**: Use of inappropriate language or other behavior deemed 76 | unprofessional or unwelcome in the community. 77 | 78 | **Consequence**: A private, written warning from community leaders, providing 79 | clarity around the nature of the violation and an explanation of why the 80 | behavior was inappropriate. A public apology may be requested. 81 | 82 | ### 2. Warning 83 | 84 | **Community Impact**: A violation through a single incident or series of 85 | actions. 86 | 87 | **Consequence**: A warning with consequences for continued behavior. No 88 | interaction with the people involved, including unsolicited interaction with 89 | those enforcing the Code of Conduct, for a specified period of time. This 90 | includes avoiding interactions in community spaces as well as external channels 91 | like social media. Violating these terms may lead to a temporary or permanent 92 | ban. 93 | 94 | ### 3. Temporary Ban 95 | 96 | **Community Impact**: A serious violation of community standards, including 97 | sustained inappropriate behavior. 98 | 99 | **Consequence**: A temporary ban from any sort of interaction or public 100 | communication with the community for a specified period of time. No public or 101 | private interaction with the people involved, including unsolicited interaction 102 | with those enforcing the Code of Conduct, is allowed during this period. 103 | Violating these terms may lead to a permanent ban. 104 | 105 | ### 4. Permanent Ban 106 | 107 | **Community Impact**: Demonstrating a pattern of violation of community 108 | standards, including sustained inappropriate behavior, harassment of an 109 | individual, or aggression toward or disparagement of classes of individuals. 110 | 111 | **Consequence**: A permanent ban from any sort of public interaction within the 112 | community. 113 | 114 | ## Attribution 115 | 116 | This Code of Conduct is adapted from the [Contributor Covenant][homepage], 117 | version 2.1, available at 118 | . 119 | 120 | Community Impact Guidelines were inspired by 121 | [Mozilla's code of conduct enforcement ladder][https://github.com/mozilla/inclusion]. 122 | 123 | For answers to common questions about this code of conduct, see the FAQ at 124 | . Translations are available at . 125 | 126 | [homepage]: https://www.contributor-covenant.org 127 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | # 4 | # NOTE: This workflow is overkill for most R packages and 5 | # check-standard.yaml is likely a better choice. 6 | # usethis::use_github_action("check-standard") will install it. 7 | on: 8 | push: 9 | branches: [main, master] 10 | pull_request: 11 | 12 | name: R-CMD-check.yaml 13 | 14 | permissions: read-all 15 | 16 | jobs: 17 | R-CMD-check: 18 | runs-on: ${{ matrix.config.os }} 19 | 20 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 21 | 22 | strategy: 23 | fail-fast: false 24 | matrix: 25 | config: 26 | - {os: macos-latest, r: 'release'} 27 | 28 | - {os: windows-latest, r: 'release'} 29 | # use 4.0 or 4.1 to check with rtools40's older compiler 30 | - {os: windows-latest, r: 'oldrel-4'} 31 | 32 | - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} 33 | - {os: ubuntu-latest, r: 'release'} 34 | - {os: ubuntu-latest, r: 'oldrel-1'} 35 | - {os: ubuntu-latest, r: 'oldrel-2'} 36 | - {os: ubuntu-latest, r: 'oldrel-3'} 37 | - {os: ubuntu-latest, r: 'oldrel-4'} 38 | 39 | env: 40 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 41 | R_KEEP_PKG_SOURCE: yes 42 | 43 | steps: 44 | - uses: actions/checkout@v4 45 | 46 | - uses: r-lib/actions/setup-pandoc@v2 47 | 48 | - uses: r-lib/actions/setup-r@v2 49 | with: 50 | r-version: ${{ matrix.config.r }} 51 | http-user-agent: ${{ matrix.config.http-user-agent }} 52 | use-public-rspm: true 53 | 54 | - uses: r-lib/actions/setup-r-dependencies@v2 55 | with: 56 | extra-packages: any::rcmdcheck 57 | needs: check 58 | 59 | - uses: r-lib/actions/check-r-package@v2 60 | with: 61 | upload-snapshots: true 62 | build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' 63 | -------------------------------------------------------------------------------- /.github/workflows/pr-commands.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | issue_comment: 5 | types: [created] 6 | 7 | name: pr-commands.yaml 8 | 9 | permissions: read-all 10 | 11 | jobs: 12 | document: 13 | if: ${{ github.event.issue.pull_request && (github.event.comment.author_association == 'MEMBER' || github.event.comment.author_association == 'OWNER') && startsWith(github.event.comment.body, '/document') }} 14 | name: document 15 | runs-on: ubuntu-latest 16 | env: 17 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 18 | permissions: 19 | contents: write 20 | steps: 21 | - uses: actions/checkout@v4 22 | 23 | - uses: r-lib/actions/pr-fetch@v2 24 | with: 25 | repo-token: ${{ secrets.GITHUB_TOKEN }} 26 | 27 | - uses: r-lib/actions/setup-r@v2 28 | with: 29 | use-public-rspm: true 30 | 31 | - uses: r-lib/actions/setup-r-dependencies@v2 32 | with: 33 | extra-packages: any::roxygen2 34 | needs: pr-document 35 | 36 | - name: Document 37 | run: roxygen2::roxygenise() 38 | shell: Rscript {0} 39 | 40 | - name: commit 41 | run: | 42 | git config --local user.name "$GITHUB_ACTOR" 43 | git config --local user.email "$GITHUB_ACTOR@users.noreply.github.com" 44 | git add man/\* NAMESPACE 45 | git commit -m 'Document' 46 | 47 | - uses: r-lib/actions/pr-push@v2 48 | with: 49 | repo-token: ${{ secrets.GITHUB_TOKEN }} 50 | 51 | style: 52 | if: ${{ github.event.issue.pull_request && (github.event.comment.author_association == 'MEMBER' || github.event.comment.author_association == 'OWNER') && startsWith(github.event.comment.body, '/style') }} 53 | name: style 54 | runs-on: ubuntu-latest 55 | env: 56 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 57 | permissions: 58 | contents: write 59 | steps: 60 | - uses: actions/checkout@v4 61 | 62 | - uses: r-lib/actions/pr-fetch@v2 63 | with: 64 | repo-token: ${{ secrets.GITHUB_TOKEN }} 65 | 66 | - uses: r-lib/actions/setup-r@v2 67 | 68 | - name: Install dependencies 69 | run: install.packages("styler") 70 | shell: Rscript {0} 71 | 72 | - name: Style 73 | run: styler::style_pkg() 74 | shell: Rscript {0} 75 | 76 | - name: commit 77 | run: | 78 | git config --local user.name "$GITHUB_ACTOR" 79 | git config --local user.email "$GITHUB_ACTOR@users.noreply.github.com" 80 | git add \*.R 81 | git commit -m 'Style' 82 | 83 | - uses: r-lib/actions/pr-push@v2 84 | with: 85 | repo-token: ${{ secrets.GITHUB_TOKEN }} 86 | -------------------------------------------------------------------------------- /.github/workflows/test-coverage.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | 8 | name: test-coverage.yaml 9 | 10 | permissions: read-all 11 | 12 | jobs: 13 | test-coverage: 14 | runs-on: ubuntu-latest 15 | env: 16 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 17 | 18 | steps: 19 | - uses: actions/checkout@v4 20 | 21 | - uses: r-lib/actions/setup-r@v2 22 | with: 23 | use-public-rspm: true 24 | 25 | - uses: r-lib/actions/setup-r-dependencies@v2 26 | with: 27 | extra-packages: any::covr, any::xml2 28 | needs: coverage 29 | 30 | - name: Test coverage 31 | run: | 32 | cov <- covr::package_coverage( 33 | quiet = FALSE, 34 | clean = FALSE, 35 | install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package") 36 | ) 37 | covr::to_cobertura(cov) 38 | shell: Rscript {0} 39 | 40 | - uses: codecov/codecov-action@v4 41 | with: 42 | # Fail if error if not on PR, or if on PR and token is given 43 | fail_ci_if_error: ${{ github.event_name != 'pull_request' || secrets.CODECOV_TOKEN }} 44 | file: ./cobertura.xml 45 | plugin: noop 46 | disable_search: true 47 | token: ${{ secrets.CODECOV_TOKEN }} 48 | 49 | - name: Show testthat output 50 | if: always() 51 | run: | 52 | ## -------------------------------------------------------------------- 53 | find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true 54 | shell: bash 55 | 56 | - name: Upload test results 57 | if: failure() 58 | uses: actions/upload-artifact@v4 59 | with: 60 | name: coverage-test-failures 61 | path: ${{ runner.temp }}/package 62 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | /revdep 5 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: liteq 2 | Title: Lightweight Portable Message Queue Using 'SQLite' 3 | Version: 1.1.0 4 | Authors@R: c( 5 | person("Gábor", "Csárdi", , "csardi.gabor@gmail.com", role = c("aut", "cre")), 6 | person("Posit Software, PBC", role = c("cph", "fnd")) 7 | ) 8 | Description: Temporary and permanent message queues for R. Built on top of 9 | 'SQLite' databases. 'SQLite' provides locking, and makes it possible 10 | to detect crashed consumers. Crashed jobs can be automatically marked 11 | as "failed", or put in the queue again, potentially a limited number 12 | of times. 13 | License: MIT + file LICENSE 14 | URL: https://github.com/r-lib/liteq#readme 15 | BugReports: https://github.com/r-lib/liteq/issues 16 | Depends: 17 | R (>= 3.6) 18 | Imports: 19 | assertthat, 20 | DBI, 21 | rappdirs, 22 | RSQLite 23 | Suggests: 24 | callr, 25 | covr, 26 | processx, 27 | testthat, 28 | withr 29 | Encoding: UTF-8 30 | LazyData: true 31 | Roxygen: list(markdown = TRUE) 32 | RoxygenNote: 7.2.3 33 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2023 2 | COPYRIGHT HOLDER: liteq authors 3 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # MIT License 2 | 3 | Copyright (c) 2023 liteq authors 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | 2 | all: README.md 3 | 4 | README.md: README.Rmd 5 | Rscript -e "library(knitr); library(methods); knit('$<', output = '$@', quiet = TRUE)" 6 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(print,liteq_message) 4 | S3method(print,liteq_queue) 5 | export(ack) 6 | export(consume) 7 | export(create_queue) 8 | export(default_db) 9 | export(delete_queue) 10 | export(ensure_queue) 11 | export(is_empty) 12 | export(list_failed_messages) 13 | export(list_messages) 14 | export(list_queues) 15 | export(message_count) 16 | export(nack) 17 | export(publish) 18 | export(remove_failed_messages) 19 | export(requeue_failed_messages) 20 | export(try_consume) 21 | importFrom(DBI,dbConnect) 22 | importFrom(DBI,dbDisconnect) 23 | importFrom(DBI,dbExecute) 24 | importFrom(DBI,dbGetQuery) 25 | importFrom(DBI,dbWithTransaction) 26 | importFrom(DBI,sqlInterpolate) 27 | importFrom(RSQLite,SQLite) 28 | importFrom(RSQLite,dbExistsTable) 29 | importFrom(assertthat,"on_failure<-") 30 | importFrom(assertthat,assert_that) 31 | importFrom(rappdirs,user_cache_dir) 32 | importFrom(rappdirs,user_data_dir) 33 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | 2 | # development version 3 | 4 | * `publish()` now accepts multiple messages (note that `title` and 5 | `message` must be of the same length) and publishes them in a single 6 | transaction (#25, @Enchufa2). 7 | 8 | * Setting the `R_LITEQ_BUSY_TIMEOUT` environment variable now works 9 | properly. Previously it was ignored and the timeout was set to 10 | ten seconds (#24, @Enchufa2). 11 | 12 | # 1.1.0 13 | 14 | * Work around a SQLITE bug that resets the database busy timeout after a 15 | successful query. Now we set the timeout after each database operation. 16 | The timeout can now also be set via the `R_LITEQ_BUSY_TIMEOUT` 17 | environment variable, and it defaults to 10 seconds, instead of 1 second. 18 | 19 | * `consume()` now has a `poll_interval` argument to set how often to poll 20 | the queue for new jobs. 21 | 22 | * New `is_empty()` and `message_count()` functions (#18, @wlandau). 23 | 24 | * Get rid of annoying warning about closing unused connections 25 | (#15, #20, @wlandau). 26 | 27 | # 1.0.1 28 | 29 | * Set the `LITEQ_CACHE_DIR` environment variable to change the 30 | default cache directory. 31 | 32 | # 1.0.0 33 | 34 | First public release. 35 | -------------------------------------------------------------------------------- /R/assertions.R: -------------------------------------------------------------------------------- 1 | 2 | #' @importFrom assertthat on_failure<- assert_that 3 | 4 | is_string <- function(x) { 5 | is.character(x) && 6 | length(x) == 1 && 7 | !is.na(x) 8 | } 9 | 10 | on_failure(is_string) <- function(call, env) { 11 | paste0(deparse(call$x), " is not a string (length 1 character)") 12 | } 13 | 14 | is_crash_strategy <- function(x) { 15 | identical(x, "fail") || identical(x, "requeue") || is_count(x) 16 | } 17 | 18 | on_failure(is_crash_strategy) <- function(call, env) { 19 | paste0( 20 | deparse(call$x), 21 | " must be 'fail', 'requeue' or a non-negative scalar" 22 | ) 23 | } 24 | 25 | is_count <- function(x) { 26 | is.numeric(x) && length(x) == 1 && !is.na(x) && round(x) == x 27 | } 28 | 29 | on_failure(is_count) <- function(call, env) { 30 | paste0(deparse(call$x), " is not a count (length 1 integer)") 31 | } 32 | 33 | is_string_or_null <- function(x) { 34 | is.null(x) || is_string(x) 35 | } 36 | 37 | on_failure(is_string_or_null) <- function(call, env) { 38 | paste0(deparse(call$x), " must be a string or NULL") 39 | } 40 | 41 | is_path <- function(x) { 42 | is_string(x) 43 | } 44 | 45 | on_failure(is_path) <- function(call, env) { 46 | paste0(deparse(call$x), " must be a file name") 47 | } 48 | 49 | is_queue <- function(x) { 50 | inherits(x, "liteq_queue") 51 | } 52 | 53 | on_failure(is_queue) <- function(call, env) { 54 | paste0(deparse(call$x), " must be a 'liteq_queue' object") 55 | } 56 | 57 | is_flag <- function(x) { 58 | is.logical(x) && 59 | length(x) == 1 && 60 | !is.na(x) 61 | } 62 | 63 | on_failure(is_flag) <- function(call, env) { 64 | paste0(deparse(call$x), " must be a flag (length 1 logical)") 65 | } 66 | 67 | is_message <- function(x) { 68 | inherits(x, "liteq_message") 69 | } 70 | 71 | on_failure(is_message) <- function(call, env) { 72 | paste0(deparse(call$x), " must be a 'liteq_message' object") 73 | } 74 | 75 | is_message_ids_or_null <- function(x) { 76 | is.null(x) || 77 | (is.numeric(x) && !any(is.na(x)) && all(round(x) == x)) 78 | } 79 | 80 | on_failure(is_message_ids_or_null) <- function(call, env) { 81 | paste0(deparse(call$x), " must be a vector of message ids or NULL") 82 | } 83 | -------------------------------------------------------------------------------- /R/db.R: -------------------------------------------------------------------------------- 1 | 2 | #' @importFrom DBI dbExecute 3 | 4 | db_set_timeout <- function(con) { 5 | timeout <- as.integer(Sys.getenv("R_LITEQ_BUSY_TIMEOUT", "10000")) 6 | if (is.na(timeout)) timeout <- 10000 7 | dbExecute(con, sprintf("PRAGMA busy_timeout = %d", timeout)) 8 | } 9 | 10 | #' @importFrom DBI dbGetQuery sqlInterpolate dbConnect dbDisconnect 11 | #' @importFrom DBI dbExecute dbWithTransaction 12 | #' @importFrom RSQLite SQLite 13 | 14 | db_connect <- function(..., synchronous = NULL) { 15 | con <- dbConnect(SQLite(), synchronous = synchronous, ...) 16 | db_set_timeout(con) 17 | con 18 | } 19 | 20 | #' The name of the default database 21 | #' 22 | #' If the queue database is not specified explicitly, 23 | #' then `liteq` uses this file. Its location is determined via the 24 | #' `rappdirs` package, see [rappdirs::user_data_dir()]. 25 | #' 26 | #' @return A characater scalar, the name of the default database. 27 | #' 28 | #' @importFrom rappdirs user_data_dir 29 | #' @export 30 | 31 | default_db <- function() { 32 | file.path( 33 | user_data_dir(appname = "liteq"), 34 | "liteq.db" 35 | ) 36 | } 37 | 38 | #' Ensure that the DB exists and has the right columns 39 | #' 40 | #' We try a query, and if it fails then we try to create the DB. 41 | #' 42 | #' @param db DB file. 43 | #' 44 | #' @keywords internal 45 | 46 | ensure_db <- function(db) { 47 | dir.create(dirname(db), recursive = TRUE, showWarnings = FALSE) 48 | db_create_db(db) 49 | } 50 | 51 | db_queue_name <- function(name) { 52 | paste0("qq", name) 53 | } 54 | 55 | db_query <- function(con, query, ...) { 56 | db_set_timeout(con) 57 | dbGetQuery(con, sqlInterpolate(con, query, ...)) 58 | } 59 | 60 | db_execute <- function(con, query, ...) { 61 | db_set_timeout(con) 62 | dbExecute(con, sqlInterpolate(con, query, ...)) 63 | } 64 | 65 | do_db <- function(db, query, ...) { 66 | con <- db_connect(db) 67 | on.exit(dbDisconnect(con)) 68 | db_query(con, query, ...) 69 | } 70 | 71 | do_db_execute <- function(db, query, ...) { 72 | con <- db_connect(db) 73 | on.exit(dbDisconnect(con)) 74 | db_execute(con, query, ...) 75 | } 76 | 77 | db_lock <- function(con) { 78 | done <- FALSE 79 | while (!done) { 80 | tryCatch( 81 | { 82 | dbExecute(con, "BEGIN EXCLUSIVE") 83 | done <- TRUE 84 | }, 85 | error = function(e) NULL 86 | ) 87 | } 88 | } 89 | 90 | db_create_db <- function(db) { 91 | do_db_execute( 92 | db, 93 | "CREATE TABLE IF NOT EXISTS meta ( 94 | name TEXT PRIMARY KEY, 95 | created TIMESTAMP, 96 | lockdir TEXT, 97 | requeue TEXT DEFAULT \"fail\" -- fail/ requeue/ number of requeues 98 | )" 99 | ) 100 | } 101 | 102 | #' @importFrom RSQLite dbExistsTable 103 | 104 | db_ensure_queue <- function(name, db, crash_strategy) { 105 | con <- db_connect(db) 106 | on.exit(dbDisconnect(con), add = TRUE) 107 | db_execute(con, "BEGIN") 108 | tablename <- db_queue_name(name) 109 | if (!dbExistsTable(con, tablename)) { 110 | db_create_queue_locked(db, con, name, crash_strategy) 111 | } 112 | } 113 | 114 | #' Create a queue 115 | #' 116 | #' The database columns: 117 | #' * id Id of the message, it is generated automatically by the database. 118 | #' * title The title of the message, can be empty. In the future, 119 | #' it can be used to filter messages. 120 | #' * message The message, arbitrary text, can be empty. 121 | #' * status Can be: 122 | #' * `READY`, ready to be consumed 123 | #' * `WORKING`, it is being consumed 124 | #' * `FAILED`, failed. 125 | #' * requeued How many times the message was requeued. 126 | #' 127 | #' @inheritParams create_queue 128 | #' @importFrom rappdirs user_cache_dir 129 | #' @keywords internal 130 | 131 | db_create_queue <- function(name, db, crash_strategy) { 132 | con <- db_connect(db) 133 | on.exit(dbDisconnect(con), add = TRUE) 134 | db_execute(con, "BEGIN") 135 | db_create_queue_locked(db, con, name, crash_strategy) 136 | } 137 | 138 | db_create_queue_locked <- function(db, con, name, crash_strategy) { 139 | db_execute( 140 | con, 141 | 'CREATE TABLE ?tablename ( 142 | id INTEGER PRIMARY KEY AUTOINCREMENT, 143 | title TEXT NOT NULL, 144 | message TEXT NOT NULL, 145 | status TEXT DEFAULT "READY", 146 | requeued INTEGER DEFAULT 0)', 147 | tablename = db_queue_name(name) 148 | ) 149 | db_execute( 150 | con, 151 | 'INSERT INTO meta (name, created, lockdir, requeue) VALUES 152 | (?name, DATE("now"), ?lockdir, ?crash)', 153 | name = name, 154 | lockdir = db_lockdir(db), 155 | crash = as.character(crash_strategy) 156 | ) 157 | db_execute(con, "COMMIT") 158 | } 159 | 160 | db_lockdir <- function(db) { 161 | file.path( 162 | Sys.getenv("LITEQ_CACHE_DIR", user_cache_dir(appname = "liteq")), 163 | paste0(basename(db), "-", random_lock_name()) 164 | ) 165 | } 166 | 167 | db_list_queues <- function(db) { 168 | do_db(db, "SELECT name FROM meta"); 169 | } 170 | 171 | db_publish <- function(db, queue, title, message) { 172 | con <- db_connect(db) 173 | on.exit(dbDisconnect(con)) 174 | dbWithTransaction(con, { 175 | for (i in seq_along(title)) { 176 | db_execute( 177 | con, 178 | "INSERT INTO ?tablename (title, message) 179 | VALUES (?title, ?message)", 180 | tablename = db_queue_name(queue), 181 | title = title[i], 182 | message = message[i] 183 | ) 184 | } 185 | }) 186 | invisible() 187 | } 188 | 189 | #' Try to consume a message from the queue 190 | #' 191 | #' If there is a message that it `READY`, it returns that. Otherwise it 192 | #' checks for crashed workers. 193 | #' 194 | #' @section Details of the implementation: 195 | #' 196 | #' The database must be locked for the whole operation, including 197 | #' checking on or creating the lock databases. 198 | #' 199 | #' 1. If there is a `READY` message, that one is taken. 200 | #' 2. Otherwise if there are `WORKING` messages, then 201 | #' we check them one by one. This might take a lot of 202 | #' time, and the DB must be locked for the whole search, 203 | #' so it is not ideal. But I don't have a better solution 204 | #' right now. 205 | #' 206 | #' Taking a message means 207 | #' 1. Updating its row.status to `WORKING`. 208 | #' 2. Creating another database that serves as the lock for this message. 209 | #' 210 | #' @param db DB file name. 211 | #' @param queue Name of the queue. 212 | #' @keywords internal 213 | 214 | db_try_consume <- function(db, queue, crashed = TRUE, con = NULL) { 215 | if (is.null(con)) { 216 | con <- db_connect(db) 217 | on.exit(try_silent(dbDisconnect(con)), add = TRUE) 218 | db_lock(con) 219 | } 220 | 221 | ## See if there is a message to work on. If there is, we just return it. 222 | msg <- db_query( 223 | con, 'SELECT * FROM ?tablename WHERE status = "READY" LIMIT 1', 224 | tablename = db_queue_name(queue) 225 | ) 226 | if (nrow(msg) == 1) { 227 | db_execute( 228 | con, 'UPDATE ?tablename SET status = "WORKING" WHERE id = ?id', 229 | tablename = db_queue_name(queue), 230 | id = msg$id 231 | ) 232 | lockdir <- db_query( 233 | con, "SELECT lockdir FROM meta WHERE name = ?name", 234 | name = queue 235 | )$lockdir 236 | db_execute(con, "COMMIT") 237 | return(list(msg = msg, db = db, queue = queue, lockdir = lockdir)) 238 | } 239 | 240 | ## Otherwise we need to check on crashed workers 241 | if (crashed && db_clean_crashed(con, queue)) { 242 | mmsg <- db_try_consume(db, queue, crashed = FALSE, con = con) 243 | tryCatch(db_execute(con, "COMMIT"), error = function(e) NULL) 244 | return(mmsg) 245 | 246 | } else { 247 | tryCatch(db_execute(con, "COMMIT"), error = function(e) NULL) 248 | NULL 249 | } 250 | } 251 | 252 | db_clean_crashed <- function(con, queue) { 253 | work <- db_query( 254 | con, 'SELECT * FROM ?tablename WHERE status = "WORKING"', 255 | tablename = db_queue_name(queue) 256 | ) 257 | if (nrow(work) == 0) return(FALSE) 258 | 259 | meta <- db_query( 260 | con, "SELECT * FROM meta WHERE name = ?name", 261 | name = queue 262 | ) 263 | 264 | locks <- message_lock_file(meta$lockdir, queue, work$id) 265 | for (i in seq_along(locks)) { 266 | lock <- locks[[i]] 267 | x <- tryCatch( 268 | { 269 | lcon <- db_connect(lock) 270 | dbGetQuery(lcon, "SELECT * FROM foo") 271 | }, 272 | error = function(x) "busy" 273 | ) 274 | if (! identical(x, "busy")) { 275 | try_silent(dbDisconnect(lcon)) 276 | if (meta$requeue == "fail" || meta$requeue == "requeue") { 277 | ## Always fail, or always requeue 278 | status <- if (meta$requeue == "fail") "FAILED" else "READY" 279 | db_clean_crashed_update(con, queue, work$id[i], status) 280 | 281 | } else if (as.numeric(work$requeued[i]) >= as.numeric(meta$requeue)) { 282 | ## Requeued too many times 283 | db_clean_crashed_update(con, queue, work$id[i], "FAILED") 284 | 285 | } else { 286 | ## Can still requeue 287 | db_clean_crashed_update(con, queue, work$id[i], "READY") 288 | db_execute( 289 | con, 290 | 'UPDATE ?tablename SET requeued = requeued + 1 WHERE id = ?id', 291 | tablename = db_queue_name(queue), 292 | id = work$id[i] 293 | ) 294 | } 295 | unlink(lock) 296 | } 297 | } 298 | TRUE 299 | } 300 | 301 | db_clean_crashed_update <- function(con, queue, id, status) { 302 | db_execute( 303 | con, 'UPDATE ?tablename SET status = ?status WHERE id = ?id', 304 | tablename = db_queue_name(queue), 305 | id = id, 306 | status = status 307 | ) 308 | } 309 | 310 | #' Consume a message from a message queue 311 | #' 312 | #' This is the blocking version of [try_consume()]. Currently it just 313 | #' polls twice a second, and sleeps between the polls. Each poll will also 314 | #' trigger a crash cleanup, if there are workers running. 315 | #' 316 | #' @inheritParams try_consume 317 | #' 318 | #' @keywords internal 319 | 320 | db_consume <- function(db, queue, poll_interval = 500) { 321 | while (TRUE) { 322 | msg <- db_try_consume(db, queue) 323 | if (!is.null(msg)) break 324 | Sys.sleep(poll_interval / 1000) 325 | } 326 | msg 327 | } 328 | 329 | #' Positive or negative ackowledgement 330 | #' 331 | #' If positive, then we need to remove the message from the queue. 332 | #' If negative, we just set the status to `FAILED`. 333 | #' 334 | #' @param db DB file. 335 | #' @param queue Queue name. 336 | #' @param id Message id. 337 | #' @param lock Name of the message lock file. 338 | #' @param success Whether this is a positive or negative ACK. 339 | #' 340 | #' @keywords internal 341 | 342 | db_ack <- function(db, queue, id, lock, success) { 343 | con <- db_connect(db) 344 | on.exit(try_silent(dbDisconnect(con)), add = TRUE) 345 | db_lock(con) 346 | if (success) { 347 | num <- db_execute( 348 | con, "DELETE FROM ?tablename WHERE id = ?id", 349 | tablename = db_queue_name(queue), id = id 350 | ) 351 | 352 | } else { 353 | num <- db_execute( 354 | con, 'UPDATE ?tablename SET status = "FAILED" WHERE id = ?id', 355 | tablename = db_queue_name(queue), id = id 356 | ) 357 | } 358 | 359 | if (num == 0) stop("Message does not exist, internal error?") 360 | if (num > 1) stop("Multiple messages with the same id, internal error") 361 | 362 | lockdir <- db_query( 363 | con, "SELECT lockdir FROM meta WHERE name = ?name", 364 | name = queue 365 | )$lockdir 366 | 367 | try_silent(dbDisconnect(lock)) 368 | lock <- message_lock_file(lockdir, queue, id) 369 | unlink(lock) 370 | 371 | db_execute(con, "COMMIT") 372 | 373 | invisible() 374 | } 375 | 376 | db_message_count <- function(db, queue, failed = FALSE) { 377 | 378 | q <- "SELECT COUNT(id) FROM ?tablename LIMIT 1" 379 | if (failed) q <- paste(q, "WHERE status = \"FAILED\"") 380 | 381 | do_db(db, q, tablename = db_queue_name(queue))[1, 1] 382 | } 383 | 384 | db_is_empty <- function(db, queue, failed = FALSE) { 385 | 386 | db_message_count(db = db, queue = queue, failed = failed) < 1 387 | 388 | } 389 | 390 | db_list_messages <- function(db, queue, failed = FALSE) { 391 | 392 | q <- "SELECT id, title, status FROM ?tablename" 393 | if (failed) q <- paste(q, "WHERE status = \"FAILED\"") 394 | 395 | do_db(db, q, tablename = db_queue_name(queue)) 396 | } 397 | 398 | db_requeue_failed_messages <- function(db, queue, id) { 399 | if (is.null(id)) { 400 | db_requeue_all_failed_messages(db, queue) 401 | } else { 402 | db_requeue_some_failed_messages(db, queue, id) 403 | } 404 | invisible() 405 | } 406 | 407 | db_requeue_all_failed_messages <- function(db, queue) { 408 | do_db_execute( 409 | db, 410 | "UPDATE ?tablename SET status = \"READY\" WHERE status = \"FAILED\"", 411 | tablename = db_queue_name(queue) 412 | ) 413 | } 414 | 415 | db_requeue_some_failed_messages <- function(db, queue, id) { 416 | con <- db_connect(db) 417 | on.exit(dbDisconnect(con)) 418 | dbWithTransaction(con, { 419 | for (id1 in id) { 420 | db_execute( 421 | con, 422 | "UPDATE ?tablename 423 | SET status = \"READY\" 424 | WHERE status = \"FAILED\" AND id = ?id", 425 | tablename = db_queue_name(queue), 426 | id = id1 427 | ) 428 | } 429 | }) 430 | } 431 | 432 | db_remove_failed_messages <- function(db, queue, id) { 433 | if (is.null(id)) { 434 | db_remove_all_failed_messages(db, queue) 435 | } else { 436 | db_remove_some_failed_messages(db, queue, id) 437 | } 438 | invisible() 439 | } 440 | 441 | db_remove_all_failed_messages <- function(db, queue) { 442 | do_db_execute( 443 | db, 444 | "DELETE FROM ?tablename WHERE status = \"FAILED\"", 445 | tablename = db_queue_name(queue) 446 | ) 447 | } 448 | 449 | db_remove_some_failed_messages <- function(db, queue, id) { 450 | con <- db_connect(db) 451 | on.exit(dbDisconnect(con)) 452 | dbWithTransaction(con, { 453 | for (id1 in id) { 454 | db_execute( 455 | con, 456 | "DELETE FROM ?tablename 457 | WHERE status = \"FAILED\" AND id = ?id", 458 | tablename = db_queue_name(queue), 459 | id = id1 460 | ) 461 | } 462 | }) 463 | } 464 | 465 | db_delete_queue <- function(db, queue, force) { 466 | con <- db_connect(db) 467 | on.exit(dbDisconnect(con)) 468 | dbWithTransaction(con, { 469 | num <- db_query( 470 | con, 471 | "SELECT COUNT(*) FROM ?tablename", 472 | tablename = db_queue_name(queue) 473 | ) 474 | 475 | if (num > 0 && ! force) { 476 | stop("Unwilling to delete non-empty queue, consider 'force = TRUE'") 477 | } 478 | 479 | db_execute( 480 | con, 481 | "DELETE FROM meta WHERE name = ?name", 482 | name = queue 483 | ) 484 | db_execute( 485 | con, 486 | "DROP TABLE ?tablename", 487 | tablename = db_queue_name(queue) 488 | ) 489 | }) 490 | } 491 | -------------------------------------------------------------------------------- /R/liteq-package.R: -------------------------------------------------------------------------------- 1 | #' @aliases liteq-package NULL 2 | #' @keywords internal 3 | "_PACKAGE" 4 | 5 | ## usethis namespace: start 6 | ## usethis namespace: end 7 | NULL 8 | -------------------------------------------------------------------------------- /R/messages.R: -------------------------------------------------------------------------------- 1 | 2 | #' Make a message object 3 | #' 4 | #' It creates the lock for the message as well. 5 | #' 6 | #' The message object contains the connection to the message lock. If the 7 | #' worker crashes, then there will be no reference to the connection, and 8 | #' the lock will be released. This is how we detect crashed workers. 9 | #' 10 | #' @param id Message id, integer, auto-generated. 11 | #' @param title Title of message. 12 | #' @param message The message itself. 13 | #' @param db Main DB file. 14 | #' @param queue Name of the queue. 15 | #' @param lockdir Directory to create the message lock in. 16 | #' @return message object 17 | #' 18 | #' @keywords internal 19 | 20 | make_message <- function(id, title, message, db, queue, lockdir) { 21 | if (is.null(id)) return(NULL) 22 | dir.create(lockdir, recursive = TRUE, showWarnings = FALSE) 23 | lock <- message_lock_file(lockdir, queue, id) 24 | con <- db_connect(lock) 25 | db_execute(con, "CREATE TABLE foo (id INT)") 26 | db_execute(con, "BEGIN EXCLUSIVE") 27 | 28 | structure( 29 | list( 30 | id = id, 31 | title = title, 32 | message = message, 33 | db = db, queue = queue, 34 | lock = con 35 | ), 36 | class = "liteq_message" 37 | ) 38 | } 39 | 40 | message_lock_file <- function(lockdir, queue, id) { 41 | file.path(lockdir, paste0(queue, "-", id, ".lock")) 42 | } 43 | 44 | #' Publish messages in a queue 45 | #' 46 | #' @param queue The queue object. 47 | #' @param title The title of the messages. It can be the empty string. 48 | #' @param message The body of the messages. It can be the empty string. 49 | #' Must be the same length as `title`. 50 | #' 51 | #' @family liteq messages 52 | #' @seealso [liteq] for examples 53 | #' @export 54 | 55 | publish <- function(queue, title = "", message = "") { 56 | assert_that(is_queue(queue)) 57 | assert_that(is.character(title)) 58 | assert_that(is.character(message)) 59 | assert_that(length(title) == length(message)) 60 | db_publish(queue$db, queue$name, title, message) 61 | } 62 | 63 | #' Consume a message from a queue 64 | #' 65 | #' Blocks and waits for a message if there isn't one to work on currently. 66 | #' 67 | #' @param queue The queue object. 68 | #' @param poll_interval Poll interval in milliseconds. How often to poll 69 | #' the queue for new jobs, if none are immediately available. 70 | #' @return A message. 71 | #' 72 | #' @family liteq messages 73 | #' @seealso [liteq] for examples 74 | #' @export 75 | 76 | consume <- function(queue, poll_interval = 500) { 77 | assert_that(is_queue(queue)) 78 | msg <- db_consume(queue$db, queue$name, poll_interval = poll_interval) 79 | make_message(msg$msg$id, msg$msg$title, msg$msg$message, msg$db, 80 | msg$queue, msg$lockdir) 81 | } 82 | 83 | #' Consume a message if there is one available 84 | #' 85 | #' @param queue The queue object. 86 | #' @return A message, or `NULL` if there is not message to work on. 87 | #' 88 | #' @family liteq messages 89 | #' @seealso [liteq] for examples 90 | #' @export 91 | 92 | try_consume <- function(queue) { 93 | assert_that(is_queue(queue)) 94 | msg <- db_try_consume(queue$db, queue$name) 95 | make_message(msg$msg$id, msg$msg$title, msg$msg$message, msg$db, 96 | msg$queue, msg$lockdir) 97 | } 98 | 99 | #' Acknowledge that the work on a message has finished successfully 100 | #' 101 | #' @param message The message object. 102 | #' @family liteq messages 103 | #' @seealso [liteq] for examples 104 | #' @export 105 | 106 | ack <- function(message) { 107 | assert_that(is_message(message)) 108 | db_ack(message$db, message$queue, message$id, message$lock, TRUE) 109 | } 110 | 111 | #' Report that the work on a message has failed 112 | #' 113 | #' @param message The message object. 114 | #' @seealso [liteq] for examples 115 | #' @export 116 | 117 | nack <- function(message) { 118 | assert_that(is_message(message)) 119 | db_ack(message$db, message$queue, message$id, message$lock, FALSE) 120 | } 121 | 122 | #' @export 123 | 124 | print.liteq_message <- function(x, ...) { 125 | cat("liteq message from queue ", sQuote(x$queue), ":\n", sep = "") 126 | msg_bytes <- nchar(x$message, type = "bytes") 127 | cat(" ", x$title, " (", msg_bytes, " B)\n", sep = "") 128 | invisible(x) 129 | } 130 | 131 | #' Get the number of messages in a queue. 132 | #' 133 | #' @param queue The queue object. 134 | #' @return Number of messages in the queue. 135 | #' 136 | #' @family liteq messages 137 | #' @seealso [liteq] for examples 138 | #' @export 139 | 140 | message_count <- function(queue) { 141 | assert_that(is_queue(queue)) 142 | db_message_count(queue$db, queue$name) 143 | } 144 | 145 | #' Check if a queue is empty 146 | #' 147 | #' @param queue The queue object. 148 | #' @return Logical, whether the queue is empty. 149 | #' 150 | #' @family liteq messages 151 | #' @seealso [liteq] for examples 152 | #' @export 153 | 154 | is_empty <- function(queue) { 155 | assert_that(is_queue(queue)) 156 | db_is_empty(queue$db, queue$name) 157 | } 158 | 159 | #' List all messages in a queue 160 | #' 161 | #' @param queue The queue object. 162 | #' @return Data frame with columns: `id`, `title`, `status`. 163 | #' 164 | #' @family liteq messages 165 | #' @seealso [liteq] for examples 166 | #' @export 167 | 168 | list_messages <- function(queue) { 169 | assert_that(is_queue(queue)) 170 | db_list_messages(queue$db, queue$name) 171 | } 172 | 173 | #' List failed messages in a queue 174 | #' 175 | #' @param queue The queue object. 176 | #' @return Data frame with columns: `id`, `title`, `status`. 177 | #' 178 | #' @family liteq messages 179 | #' @seealso [liteq] for examples 180 | #' @export 181 | 182 | list_failed_messages <- function(queue) { 183 | assert_that(is_queue(queue)) 184 | db_list_messages(queue$db, queue$name, failed = TRUE) 185 | } 186 | 187 | #' Requeue failed messages 188 | #' 189 | #' @param queue The queue object. 190 | #' @param id Ids of the messages to requeue. If it is `NULL`, then all 191 | #' failed messages will be requeued. 192 | #' 193 | #' @family liteq messages 194 | #' @seealso [liteq] for examples 195 | #' @export 196 | 197 | requeue_failed_messages <- function(queue, id = NULL) { 198 | assert_that(is_queue(queue)) 199 | assert_that(is_message_ids_or_null(id)) 200 | db_requeue_failed_messages(queue$db, queue$name, id) 201 | } 202 | 203 | #' Remove failed messages from the queue 204 | #' 205 | #' @param queue The queue object. 206 | #' @param id Ids of the messages to requeue. If it is `NULL`, then all 207 | #' failed messages will be removed. 208 | #' 209 | #' @family liteq messages 210 | #' @seealso [liteq] for examples 211 | #' @export 212 | 213 | remove_failed_messages <- function(queue, id = NULL) { 214 | assert_that(is_queue(queue)) 215 | assert_that(is_message_ids_or_null(id)) 216 | db_remove_failed_messages(queue$db, queue$name, id) 217 | } 218 | -------------------------------------------------------------------------------- /R/package.R: -------------------------------------------------------------------------------- 1 | 2 | #' Lightweight Portable Message Queue Using 'SQLite' 3 | #' 4 | #' Message queues for R. Built on top of 'SQLite' databases. 5 | #' 6 | #' @section Concurrency: 7 | #' 8 | #' liteq works with multiple producer and/or consumer processes accessing 9 | #' the same queue, via the locking mechanism of 'SQLite'. If a queue is 10 | #' locked by 'SQLite', the process that tries to access it, must wait until 11 | #' it is unlocked. The maximum amount of waiting time is by default 10 12 | #' seconds, and it can be changed via the `R_LITEQ_BUSY_TIMEOUT` 13 | #' environment variable, in milliseconds. If you have many concurrent 14 | #' processes using the same liteq database, and see `database locked` 15 | #' errors, then you can try to increase the timeout value. 16 | #' 17 | #' @docType package 18 | #' @name liteq 19 | #' @section Examples: 20 | #' ``` 21 | #' # We don't run this, because it writes to the cache directory 22 | #' db <- tempfile() 23 | #' q <- ensure_queue("jobs", db = db) 24 | #' q 25 | #' list_queues(db) 26 | #' 27 | #' # Publish two messages 28 | #' publish(q, title = "First message", message = "Hello world!") 29 | #' publish(q, title = "Second message", message = "Hello again!") 30 | #' is_empty(q) 31 | #' message_count(q) 32 | #' list_messages(q) 33 | #' 34 | #' # Consume one 35 | #' msg <- try_consume(q) 36 | #' msg 37 | #' 38 | #' ack(msg) 39 | #' list_messages(q) 40 | #' msg2 <- try_consume(q) 41 | #' nack(msg2) 42 | #' list_messages(q) 43 | #' 44 | #' # No more messages 45 | #' is_empty(q) 46 | #' try_consume(q) 47 | #' ``` 48 | #' 49 | #' @examples 50 | #' ## See the manual page 51 | 52 | NULL 53 | -------------------------------------------------------------------------------- /R/queue.R: -------------------------------------------------------------------------------- 1 | 2 | #' Create a queue in a database 3 | #' 4 | #' It also creates the database, if it does not exist. 5 | #' @param name Name of the queue. If not specified or `NULL`, a 6 | #' name is generated randomly. 7 | #' @param db Path to the database file. 8 | #' @param crash_strategy What to do with crashed jobs. The default is that 9 | #' they will `"fail"` (just like a negative acknowledgement). Another 10 | #' possibility is `"requeue"`, in which case they are requeued 11 | #' immediately, potentially even multiple times. Alternatively it can be 12 | #' a number, in which case they are requeued at most the specified number 13 | #' of times. 14 | #' 15 | #' @family liteq queues 16 | #' @seealso [liteq] for examples 17 | #' @export 18 | 19 | create_queue <- function(name = NULL, db = default_db(), 20 | crash_strategy = "fail") { 21 | 22 | assert_that(is_string_or_null(name)) 23 | assert_that(is_path(db)) 24 | assert_that(is_crash_strategy(crash_strategy)) 25 | 26 | name <- name %||% random_queue_name() 27 | 28 | ensure_db(db) 29 | db_create_queue(name, db, crash_strategy) 30 | 31 | make_queue(name, db) 32 | } 33 | 34 | #' Delete a queue 35 | #' 36 | #' @param queue The queue to delete. 37 | #' @param force Whether to delete the queue even if it contains messages. 38 | #' 39 | #' @family liteq queues 40 | #' @seealso [liteq] for examples 41 | #' @export 42 | 43 | delete_queue <- function(queue, force = FALSE) { 44 | assert_that(is_queue(queue)) 45 | assert_that(is_flag(force)) 46 | db_delete_queue(queue$db, queue$name, force) 47 | } 48 | 49 | #' Make sure that a queue exists 50 | #' 51 | #' If it does not exist, then the queue will be created. 52 | #' 53 | #' @inheritParams create_queue 54 | #' @return The queue object. 55 | #' 56 | #' @family liteq queues 57 | #' @seealso [liteq] for examples 58 | #' @export 59 | 60 | ensure_queue <- function(name, db = default_db(), 61 | crash_strategy = "fail") { 62 | assert_that(is_string(name)) 63 | assert_that(is_path(db)) 64 | assert_that(is_crash_strategy(crash_strategy)) 65 | 66 | ensure_db(db) 67 | db_ensure_queue(name, db, crash_strategy) 68 | make_queue(name, db) 69 | } 70 | 71 | #' List all queues in a database 72 | #' 73 | #' @param db The queue database to query. 74 | #' @return A list of `liteq_queue` objects. 75 | #' 76 | #' @family liteq queues 77 | #' @seealso [liteq] for examples 78 | #' @export 79 | 80 | list_queues <- function(db = default_db()) { 81 | assert_that(is_path(db)) 82 | ensure_db(db) 83 | lapply(db_list_queues(db)$name, make_queue, db = db) 84 | } 85 | 86 | make_queue <- function(name, db) { 87 | structure( 88 | list(name = name, db = db), 89 | class = "liteq_queue" 90 | ) 91 | } 92 | 93 | #' @export 94 | 95 | print.liteq_queue <- function(x, ...) { 96 | cat("liteq queue ", sQuote(x$name), "\n", sep = "") 97 | invisible(x) 98 | } 99 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | 2 | random_id <- function(length = 10, prefix = "q") { 3 | paste( 4 | c(prefix, sample(c(letters, 0:9), length, replace = TRUE)), 5 | collapse = "" 6 | ) 7 | } 8 | 9 | random_queue_name <- function() { 10 | random_id(length = 10, prefix = "q") 11 | } 12 | 13 | random_lock_name <- function() { 14 | random_id(length = 6, prefix = "") 15 | } 16 | 17 | `%||%` <- function(l, r) if (is.null(l)) r else l 18 | 19 | try_silent <- function(x) { 20 | try(x, silent = TRUE) 21 | } 22 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | 2 | ```{r, setup, echo = FALSE, message = FALSE} 3 | knitr::opts_chunk$set( 4 | comment = "#>", 5 | tidy = FALSE, 6 | error = FALSE) 7 | ``` 8 | 9 | # liteq 10 | 11 | > Lightweight Portable Message Queue Using SQLite 12 | 13 | 14 | [![R-CMD-check](https://github.com/r-lib/liteq/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/r-lib/liteq/actions/workflows/R-CMD-check.yaml) 15 | [![](https://www.r-pkg.org/badges/version/liteq)](https://www.r-pkg.org/pkg/liteq) 16 | [![CRAN RStudio mirror downloads](https://cranlogs.r-pkg.org/badges/liteq)](https://www.r-pkg.org/pkg/liteq) 17 | [![Codecov test coverage](https://codecov.io/gh/r-lib/liteq/graph/badge.svg)](https://app.codecov.io/gh/r-lib/liteq) 18 | 19 | 20 | Temporary and permanent message queues for R. Built on top of SQLite 21 | databases. 'SQLite' provides locking, and makes it possible to detect 22 | crashed consumers. Crashed jobs can be automatically marked as "failed", 23 | or put back in the queue again, potentially a limited number of times. 24 | 25 | ## Installation 26 | 27 | Stable version: 28 | 29 | ```r 30 | install.packages("liteq") 31 | ``` 32 | 33 | Development versiot: 34 | 35 | ```r 36 | pak::pak("r-lib/liteq") 37 | ``` 38 | 39 | ## Introduction 40 | 41 | `liteq` implements a serverless message queue system in R. 42 | It can handle multiple databases, and each database can contain 43 | multiple queues. 44 | 45 | `liteq` uses SQLite to store a database of queues, and uses other, 46 | temporary SQLites databases for locking, and finding crashed workers 47 | (see below). 48 | 49 | ## Usage 50 | 51 | ### Basic usage 52 | 53 | ```{r} 54 | library(liteq) 55 | ``` 56 | 57 | In the following we create a queue in a temporary queue database. 58 | The database will be removed if the R session quits. 59 | 60 | ```{r} 61 | db <- tempfile() 62 | q <- ensure_queue("jobs", db = db) 63 | q 64 | list_queues(db) 65 | ``` 66 | 67 | Note that `ensure_queue()` is idempotent, if you call it again on the same 68 | database, it will return the queue that was created previously. So it is 69 | safe to call it multiple times, even from multiple processes. In case of 70 | multiple processes, the locking mechanism eliminates race conditions. 71 | 72 | To publish a message in the queue, call `publish()` on the queue object: 73 | 74 | ```{r} 75 | publish(q, title = "First message", message = "Hello world!") 76 | publish(q, title = "Second message", message = "Hello again!") 77 | list_messages(q) 78 | ``` 79 | 80 | A `liteq` message has a title, which is a string scalar, and the message 81 | body itself is a string scalar as well. To use more complex data types in 82 | messages, you need to serialize them using the `serialize()` function (set 83 | `ascii` to `TRUE`!), or convert them to JSON with the `jsonlite` package. 84 | 85 | Two functions are available to consume a message from a queue. 86 | `try_consume()` returns immediately, either with a message (`liteq_message` 87 | object), or `NULL` if the queue is empty. The `consume()` function blocks 88 | if the queue is empty, and waits until a message appears in it. 89 | 90 | ```{r} 91 | msg <- try_consume(q) 92 | msg 93 | ``` 94 | 95 | The title and the message body are available as fields of the message 96 | object: 97 | 98 | ```{r} 99 | msg$title 100 | msg$message 101 | ``` 102 | 103 | When a consumer is done processing a message it must call `ack()` on the 104 | message object, to notify the queue that it is safe to remove the message. 105 | If the consumer fails to process a message, it can call `nack()` (negative 106 | ackowledgement) on the message object. Then the status of the message will 107 | be set to `"FAILED"`. Failed messages can be removed from the queue, or 108 | put back in the queue again, depending on the application. 109 | 110 | ```{r} 111 | ack(msg) 112 | list_messages(q) 113 | msg2 <- try_consume(q) 114 | nack(msg2) 115 | list_messages(q) 116 | ``` 117 | 118 | The queue is empty now, so `try_consume()` returns `NULL`: 119 | 120 | ```{r} 121 | try_consume(q) 122 | ``` 123 | 124 | ### Crashed workers 125 | 126 | If a worker crashes without calling either `ack()` or `nack()` on a message, 127 | then this messages will be put back in the queue the next time a message is 128 | requested from the queue. 129 | 130 | To make this possible, each delivered message keeps an open connection to 131 | a lock file, and crashed workers are found by the absense of this open 132 | connection. In R basically means that the worker is considered as crashed 133 | if the R process has no reference to the message object. 134 | 135 | Note, that this also means that having many workers at the same time means 136 | that it is possible to reach the maximum number of open connections by 137 | R or the operating system. 138 | 139 | ## License 140 | 141 | MIT © Gábor Csárdi 142 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # liteq 5 | 6 | > Lightweight Portable Message Queue Using SQLite 7 | 8 | 9 | [![R-CMD-check](https://github.com/r-lib/liteq/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/r-lib/liteq/actions/workflows/R-CMD-check.yaml) 10 | [![](https://www.r-pkg.org/badges/version/liteq)](https://www.r-pkg.org/pkg/liteq) 11 | [![CRAN RStudio mirror downloads](https://cranlogs.r-pkg.org/badges/liteq)](https://www.r-pkg.org/pkg/liteq) 12 | [![Codecov test coverage](https://codecov.io/gh/r-lib/liteq/graph/badge.svg)](https://app.codecov.io/gh/r-lib/liteq) 13 | 14 | 15 | Temporary and permanent message queues for R. Built on top of SQLite 16 | databases. 'SQLite' provides locking, and makes it possible to detect 17 | crashed consumers. Crashed jobs can be automatically marked as "failed", 18 | or put back in the queue again, potentially a limited number of times. 19 | 20 | ## Installation 21 | 22 | Stable version: 23 | 24 | ```r 25 | install.packages("liteq") 26 | ``` 27 | 28 | Development versiot: 29 | 30 | ```r 31 | pak::pak("r-lib/liteq") 32 | ``` 33 | 34 | ## Introduction 35 | 36 | `liteq` implements a serverless message queue system in R. 37 | It can handle multiple databases, and each database can contain 38 | multiple queues. 39 | 40 | `liteq` uses SQLite to store a database of queues, and uses other, 41 | temporary SQLites databases for locking, and finding crashed workers 42 | (see below). 43 | 44 | ## Usage 45 | 46 | ### Basic usage 47 | 48 | 49 | ```r 50 | library(liteq) 51 | ``` 52 | 53 | In the following we create a queue in a temporary queue database. 54 | The database will be removed if the R session quits. 55 | 56 | 57 | ```r 58 | db <- tempfile() 59 | q <- ensure_queue("jobs", db = db) 60 | q 61 | ``` 62 | 63 | ``` 64 | #> liteq queue 'jobs' 65 | ``` 66 | 67 | ```r 68 | list_queues(db) 69 | ``` 70 | 71 | ``` 72 | #> [[1]] 73 | #> liteq queue 'jobs' 74 | ``` 75 | 76 | Note that `ensure_queue()` is idempotent, if you call it again on the same 77 | database, it will return the queue that was created previously. So it is 78 | safe to call it multiple times, even from multiple processes. In case of 79 | multiple processes, the locking mechanism eliminates race conditions. 80 | 81 | To publish a message in the queue, call `publish()` on the queue object: 82 | 83 | 84 | ```r 85 | publish(q, title = "First message", message = "Hello world!") 86 | publish(q, title = "Second message", message = "Hello again!") 87 | list_messages(q) 88 | ``` 89 | 90 | ``` 91 | #> id title status 92 | #> 1 1 First message READY 93 | #> 2 2 Second message READY 94 | ``` 95 | 96 | A `liteq` message has a title, which is a string scalar, and the message 97 | body itself is a string scalar as well. To use more complex data types in 98 | messages, you need to serialize them using the `serialize()` function (set 99 | `ascii` to `TRUE`!), or convert them to JSON with the `jsonlite` package. 100 | 101 | Two functions are available to consume a message from a queue. 102 | `try_consume()` returns immediately, either with a message (`liteq_message` 103 | object), or `NULL` if the queue is empty. The `consume()` function blocks 104 | if the queue is empty, and waits until a message appears in it. 105 | 106 | 107 | ```r 108 | msg <- try_consume(q) 109 | msg 110 | ``` 111 | 112 | ``` 113 | #> liteq message from queue 'jobs': 114 | #> First message (12 B) 115 | ``` 116 | 117 | The title and the message body are available as fields of the message 118 | object: 119 | 120 | 121 | ```r 122 | msg$title 123 | ``` 124 | 125 | ``` 126 | #> [1] "First message" 127 | ``` 128 | 129 | ```r 130 | msg$message 131 | ``` 132 | 133 | ``` 134 | #> [1] "Hello world!" 135 | ``` 136 | 137 | When a consumer is done processing a message it must call `ack()` on the 138 | message object, to notify the queue that it is safe to remove the message. 139 | If the consumer fails to process a message, it can call `nack()` (negative 140 | ackowledgement) on the message object. Then the status of the message will 141 | be set to `"FAILED"`. Failed messages can be removed from the queue, or 142 | put back in the queue again, depending on the application. 143 | 144 | 145 | ```r 146 | ack(msg) 147 | list_messages(q) 148 | ``` 149 | 150 | ``` 151 | #> id title status 152 | #> 1 2 Second message READY 153 | ``` 154 | 155 | ```r 156 | msg2 <- try_consume(q) 157 | nack(msg2) 158 | list_messages(q) 159 | ``` 160 | 161 | ``` 162 | #> id title status 163 | #> 1 2 Second message FAILED 164 | ``` 165 | 166 | The queue is empty now, so `try_consume()` returns `NULL`: 167 | 168 | 169 | ```r 170 | try_consume(q) 171 | ``` 172 | 173 | ``` 174 | #> NULL 175 | ``` 176 | 177 | ### Crashed workers 178 | 179 | If a worker crashes without calling either `ack()` or `nack()` on a message, 180 | then this messages will be put back in the queue the next time a message is 181 | requested from the queue. 182 | 183 | To make this possible, each delivered message keeps an open connection to 184 | a lock file, and crashed workers are found by the absense of this open 185 | connection. In R basically means that the worker is considered as crashed 186 | if the R process has no reference to the message object. 187 | 188 | Note, that this also means that having many workers at the same time means 189 | that it is possible to reach the maximum number of open connections by 190 | R or the operating system. 191 | 192 | ## License 193 | 194 | MIT © Gábor Csárdi 195 | -------------------------------------------------------------------------------- /codecov.yml: -------------------------------------------------------------------------------- 1 | comment: false 2 | 3 | coverage: 4 | status: 5 | project: 6 | default: 7 | target: auto 8 | threshold: 1% 9 | informational: true 10 | patch: 11 | default: 12 | target: auto 13 | threshold: 1% 14 | informational: true 15 | -------------------------------------------------------------------------------- /inst/examples/queue-scraper.R: -------------------------------------------------------------------------------- 1 | # The aim is to showcase queuing a scraper in R and requery failed attempts 2 | # To simulate "failed attempts" we gonna write a flawed scraper 3 | 4 | # Setup 5 | # a) Scrape Hackernews ticker (https://news.ycombinator.com/) 6 | # b) Scrape the html-titles of all websites that are linked by hackernews 7 | 8 | # The scraper to so b) is flawed 9 | 10 | # Doublecheck that the queue knows which scrapes failed 11 | 12 | # P.S.: This is a sequential/blocking example. 13 | # If you really would like to scrape a website a non-blocking approach might 14 | # be much faster. E.g. https://github.com/jeroenooms/curl/blob/master/examples/crawler.R 15 | 16 | library(liteq) 17 | library(DBI) 18 | require(tidyverse) 19 | require(jsonlite) 20 | 21 | # Setup Query DB ---------------------------------------------------------- 22 | 23 | queues_db <- "~/Downloads/queuesdb" 24 | q <- ensure_queue("jobs", db = queues_db) 25 | 26 | urls <- paste0("https://news.ycombinator.com/news?p=", 1) 27 | map(urls, partial(publish, q = q, title = "get_links")) 28 | 29 | 30 | # Setup result DB --------------------------------------------------------- 31 | 32 | result_db <- src_sqlite(path = "~/Downloads/resultdb", create = TRUE) 33 | result_tbl <- tibble( 34 | id = integer(), 35 | title = character(), 36 | points = integer(), 37 | comments = integer(), 38 | html_title = character(), 39 | url = character(), 40 | timestamp = integer()) %>% 41 | copy_to(result_db, ., "hackernews", indexes = list(id_idx = "id")) # evtl. noch indexes setzen 42 | 43 | # tbl <- tbl(result_db, "hackernews") 44 | 45 | 46 | # scraper functions -------------------------------------------------------- 47 | 48 | parse_hackernews_row <- function(row){ 49 | tibble( 50 | id = row[[1]] %>% html_attr("id") %>% as.integer, 51 | title = row[[1]] %>% html_node(".storylink") %>% html_text, 52 | points = row[[2]] %>% html_node(".score") %>% html_text %>% parse_number, 53 | comments = row[[2]] %>% html_node("a+ a") %>% html_text %>% parse_number(na = c("", "NA", "discuss")), 54 | html_title = character(1), 55 | url = row[[1]] %>% html_node(".storylink") %>% html_attr("href"), 56 | timestamp = as.integer(Sys.time()) 57 | ) 58 | } 59 | 60 | scrape_hackernews <- function(url){ 61 | doc <- read_html(url) 62 | doc %>% html_node(".itemlist") %>% html_nodes("tr") %>% 63 | .[-c(length(.):(length(.)-1))] %>% # Exclude "more" row at the bottom 64 | {split(., rep(seq(length(.)/3), each = 3))} %>% # Group 3 tr together as one row 65 | map_df(parse_hackernews_row) 66 | } 67 | 68 | # This scraper fails # e.g. for JS-Framework websites link 69 | # Angular and React if they set the html-title with JS 70 | flawed_scraper <- function(url){ 71 | read_html(url) %>% html_node("title") %>% html_text 72 | } 73 | 74 | do_job <- function(msg, db, q){ 75 | if(msg$title == "get_links"){ 76 | out <- scrape_hackernews(msg$message) 77 | messages <- build_messages(out[, c("id", "url")]) 78 | map(unlist(messages), partial(publish, q = q, title = "get_title")) 79 | dbWriteTable(db$con, "hackernews", out, append = TRUE) 80 | } 81 | if(msg$title == "get_title"){ 82 | message <- fromJSON(msg$message) 83 | out <- flawed_scraper(message$url) 84 | sql <- sprintf("UPDATE hackernews SET html_title='%s' WHERE id=%d", out, message$id) 85 | dbExecute(db$con, sql) 86 | } 87 | } 88 | 89 | # liteq utils ------------------------------------------------------------- 90 | 91 | build_messages <- function(dat){ 92 | by_row(dat, ~toJSON(as.list(.), auto_unbox = TRUE))$.out 93 | } 94 | 95 | 96 | # Actual scraper ---------------------------------------------------------- 97 | 98 | msg <- try_consume(q) 99 | while(!is.null(msg)){ 100 | cat(msg$id, msg$title, "\n") 101 | tryCatch({do_job(msg, result_db, q); ack(msg)}, error = function(e) nack(msg)) 102 | msg <- try_consume(q) 103 | } 104 | 105 | 106 | # Doublecheck results ----------------------------------------------------- 107 | 108 | failed_messages <- list_failed_messages(q) 109 | result_without_html_table <- result_tbl %>% filter(html_title == "") %>% collect 110 | nrow(failed_messages) == nrow(result_without_html_table) # TRUE 111 | -------------------------------------------------------------------------------- /man/ack.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/messages.R 3 | \name{ack} 4 | \alias{ack} 5 | \title{Acknowledge that the work on a message has finished successfully} 6 | \usage{ 7 | ack(message) 8 | } 9 | \arguments{ 10 | \item{message}{The message object.} 11 | } 12 | \description{ 13 | Acknowledge that the work on a message has finished successfully 14 | } 15 | \seealso{ 16 | \link{liteq} for examples 17 | 18 | Other liteq messages: 19 | \code{\link{consume}()}, 20 | \code{\link{is_empty}()}, 21 | \code{\link{list_failed_messages}()}, 22 | \code{\link{list_messages}()}, 23 | \code{\link{message_count}()}, 24 | \code{\link{publish}()}, 25 | \code{\link{remove_failed_messages}()}, 26 | \code{\link{requeue_failed_messages}()}, 27 | \code{\link{try_consume}()} 28 | } 29 | \concept{liteq messages} 30 | -------------------------------------------------------------------------------- /man/consume.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/messages.R 3 | \name{consume} 4 | \alias{consume} 5 | \title{Consume a message from a queue} 6 | \usage{ 7 | consume(queue, poll_interval = 500) 8 | } 9 | \arguments{ 10 | \item{queue}{The queue object.} 11 | 12 | \item{poll_interval}{Poll interval in milliseconds. How often to poll 13 | the queue for new jobs, if none are immediately available.} 14 | } 15 | \value{ 16 | A message. 17 | } 18 | \description{ 19 | Blocks and waits for a message if there isn't one to work on currently. 20 | } 21 | \seealso{ 22 | \link{liteq} for examples 23 | 24 | Other liteq messages: 25 | \code{\link{ack}()}, 26 | \code{\link{is_empty}()}, 27 | \code{\link{list_failed_messages}()}, 28 | \code{\link{list_messages}()}, 29 | \code{\link{message_count}()}, 30 | \code{\link{publish}()}, 31 | \code{\link{remove_failed_messages}()}, 32 | \code{\link{requeue_failed_messages}()}, 33 | \code{\link{try_consume}()} 34 | } 35 | \concept{liteq messages} 36 | -------------------------------------------------------------------------------- /man/create_queue.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/queue.R 3 | \name{create_queue} 4 | \alias{create_queue} 5 | \title{Create a queue in a database} 6 | \usage{ 7 | create_queue(name = NULL, db = default_db(), crash_strategy = "fail") 8 | } 9 | \arguments{ 10 | \item{name}{Name of the queue. If not specified or \code{NULL}, a 11 | name is generated randomly.} 12 | 13 | \item{db}{Path to the database file.} 14 | 15 | \item{crash_strategy}{What to do with crashed jobs. The default is that 16 | they will \code{"fail"} (just like a negative acknowledgement). Another 17 | possibility is \code{"requeue"}, in which case they are requeued 18 | immediately, potentially even multiple times. Alternatively it can be 19 | a number, in which case they are requeued at most the specified number 20 | of times.} 21 | } 22 | \description{ 23 | It also creates the database, if it does not exist. 24 | } 25 | \seealso{ 26 | \link{liteq} for examples 27 | 28 | Other liteq queues: 29 | \code{\link{delete_queue}()}, 30 | \code{\link{ensure_queue}()}, 31 | \code{\link{list_queues}()} 32 | } 33 | \concept{liteq queues} 34 | -------------------------------------------------------------------------------- /man/db_ack.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/db.R 3 | \name{db_ack} 4 | \alias{db_ack} 5 | \title{Positive or negative ackowledgement} 6 | \usage{ 7 | db_ack(db, queue, id, lock, success) 8 | } 9 | \arguments{ 10 | \item{db}{DB file.} 11 | 12 | \item{queue}{Queue name.} 13 | 14 | \item{id}{Message id.} 15 | 16 | \item{lock}{Name of the message lock file.} 17 | 18 | \item{success}{Whether this is a positive or negative ACK.} 19 | } 20 | \description{ 21 | If positive, then we need to remove the message from the queue. 22 | If negative, we just set the status to \code{FAILED}. 23 | } 24 | \keyword{internal} 25 | -------------------------------------------------------------------------------- /man/db_consume.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/db.R 3 | \name{db_consume} 4 | \alias{db_consume} 5 | \title{Consume a message from a message queue} 6 | \usage{ 7 | db_consume(db, queue, poll_interval = 500) 8 | } 9 | \arguments{ 10 | \item{queue}{The queue object.} 11 | } 12 | \description{ 13 | This is the blocking version of \code{\link[=try_consume]{try_consume()}}. Currently it just 14 | polls twice a second, and sleeps between the polls. Each poll will also 15 | trigger a crash cleanup, if there are workers running. 16 | } 17 | \keyword{internal} 18 | -------------------------------------------------------------------------------- /man/db_create_queue.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/db.R 3 | \name{db_create_queue} 4 | \alias{db_create_queue} 5 | \title{Create a queue} 6 | \usage{ 7 | db_create_queue(name, db, crash_strategy) 8 | } 9 | \arguments{ 10 | \item{name}{Name of the queue. If not specified or \code{NULL}, a 11 | name is generated randomly.} 12 | 13 | \item{db}{Path to the database file.} 14 | 15 | \item{crash_strategy}{What to do with crashed jobs. The default is that 16 | they will \code{"fail"} (just like a negative acknowledgement). Another 17 | possibility is \code{"requeue"}, in which case they are requeued 18 | immediately, potentially even multiple times. Alternatively it can be 19 | a number, in which case they are requeued at most the specified number 20 | of times.} 21 | } 22 | \description{ 23 | The database columns: 24 | \itemize{ 25 | \item id Id of the message, it is generated automatically by the database. 26 | \item title The title of the message, can be empty. In the future, 27 | it can be used to filter messages. 28 | \item message The message, arbitrary text, can be empty. 29 | \item status Can be: 30 | \itemize{ 31 | \item \code{READY}, ready to be consumed 32 | \item \code{WORKING}, it is being consumed 33 | \item \code{FAILED}, failed. 34 | } 35 | \item requeued How many times the message was requeued. 36 | } 37 | } 38 | \keyword{internal} 39 | -------------------------------------------------------------------------------- /man/db_try_consume.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/db.R 3 | \name{db_try_consume} 4 | \alias{db_try_consume} 5 | \title{Try to consume a message from the queue} 6 | \usage{ 7 | db_try_consume(db, queue, crashed = TRUE, con = NULL) 8 | } 9 | \arguments{ 10 | \item{db}{DB file name.} 11 | 12 | \item{queue}{Name of the queue.} 13 | } 14 | \description{ 15 | If there is a message that it \code{READY}, it returns that. Otherwise it 16 | checks for crashed workers. 17 | } 18 | \section{Details of the implementation}{ 19 | 20 | 21 | The database must be locked for the whole operation, including 22 | checking on or creating the lock databases. 23 | \enumerate{ 24 | \item If there is a \code{READY} message, that one is taken. 25 | \item Otherwise if there are \code{WORKING} messages, then 26 | we check them one by one. This might take a lot of 27 | time, and the DB must be locked for the whole search, 28 | so it is not ideal. But I don't have a better solution 29 | right now. 30 | } 31 | 32 | Taking a message means 33 | \enumerate{ 34 | \item Updating its row.status to \code{WORKING}. 35 | \item Creating another database that serves as the lock for this message. 36 | } 37 | } 38 | 39 | \keyword{internal} 40 | -------------------------------------------------------------------------------- /man/default_db.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/db.R 3 | \name{default_db} 4 | \alias{default_db} 5 | \title{The name of the default database} 6 | \usage{ 7 | default_db() 8 | } 9 | \value{ 10 | A characater scalar, the name of the default database. 11 | } 12 | \description{ 13 | If the queue database is not specified explicitly, 14 | then \code{liteq} uses this file. Its location is determined via the 15 | \code{rappdirs} package, see \code{\link[rappdirs:user_data_dir]{rappdirs::user_data_dir()}}. 16 | } 17 | -------------------------------------------------------------------------------- /man/delete_queue.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/queue.R 3 | \name{delete_queue} 4 | \alias{delete_queue} 5 | \title{Delete a queue} 6 | \usage{ 7 | delete_queue(queue, force = FALSE) 8 | } 9 | \arguments{ 10 | \item{queue}{The queue to delete.} 11 | 12 | \item{force}{Whether to delete the queue even if it contains messages.} 13 | } 14 | \description{ 15 | Delete a queue 16 | } 17 | \seealso{ 18 | \link{liteq} for examples 19 | 20 | Other liteq queues: 21 | \code{\link{create_queue}()}, 22 | \code{\link{ensure_queue}()}, 23 | \code{\link{list_queues}()} 24 | } 25 | \concept{liteq queues} 26 | -------------------------------------------------------------------------------- /man/ensure_db.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/db.R 3 | \name{ensure_db} 4 | \alias{ensure_db} 5 | \title{Ensure that the DB exists and has the right columns} 6 | \usage{ 7 | ensure_db(db) 8 | } 9 | \arguments{ 10 | \item{db}{DB file.} 11 | } 12 | \description{ 13 | We try a query, and if it fails then we try to create the DB. 14 | } 15 | \keyword{internal} 16 | -------------------------------------------------------------------------------- /man/ensure_queue.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/queue.R 3 | \name{ensure_queue} 4 | \alias{ensure_queue} 5 | \title{Make sure that a queue exists} 6 | \usage{ 7 | ensure_queue(name, db = default_db(), crash_strategy = "fail") 8 | } 9 | \arguments{ 10 | \item{name}{Name of the queue. If not specified or \code{NULL}, a 11 | name is generated randomly.} 12 | 13 | \item{db}{Path to the database file.} 14 | 15 | \item{crash_strategy}{What to do with crashed jobs. The default is that 16 | they will \code{"fail"} (just like a negative acknowledgement). Another 17 | possibility is \code{"requeue"}, in which case they are requeued 18 | immediately, potentially even multiple times. Alternatively it can be 19 | a number, in which case they are requeued at most the specified number 20 | of times.} 21 | } 22 | \value{ 23 | The queue object. 24 | } 25 | \description{ 26 | If it does not exist, then the queue will be created. 27 | } 28 | \seealso{ 29 | \link{liteq} for examples 30 | 31 | Other liteq queues: 32 | \code{\link{create_queue}()}, 33 | \code{\link{delete_queue}()}, 34 | \code{\link{list_queues}()} 35 | } 36 | \concept{liteq queues} 37 | -------------------------------------------------------------------------------- /man/is_empty.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/messages.R 3 | \name{is_empty} 4 | \alias{is_empty} 5 | \title{Check if a queue is empty} 6 | \usage{ 7 | is_empty(queue) 8 | } 9 | \arguments{ 10 | \item{queue}{The queue object.} 11 | } 12 | \value{ 13 | Logical, whether the queue is empty. 14 | } 15 | \description{ 16 | Check if a queue is empty 17 | } 18 | \seealso{ 19 | \link{liteq} for examples 20 | 21 | Other liteq messages: 22 | \code{\link{ack}()}, 23 | \code{\link{consume}()}, 24 | \code{\link{list_failed_messages}()}, 25 | \code{\link{list_messages}()}, 26 | \code{\link{message_count}()}, 27 | \code{\link{publish}()}, 28 | \code{\link{remove_failed_messages}()}, 29 | \code{\link{requeue_failed_messages}()}, 30 | \code{\link{try_consume}()} 31 | } 32 | \concept{liteq messages} 33 | -------------------------------------------------------------------------------- /man/list_failed_messages.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/messages.R 3 | \name{list_failed_messages} 4 | \alias{list_failed_messages} 5 | \title{List failed messages in a queue} 6 | \usage{ 7 | list_failed_messages(queue) 8 | } 9 | \arguments{ 10 | \item{queue}{The queue object.} 11 | } 12 | \value{ 13 | Data frame with columns: \code{id}, \code{title}, \code{status}. 14 | } 15 | \description{ 16 | List failed messages in a queue 17 | } 18 | \seealso{ 19 | \link{liteq} for examples 20 | 21 | Other liteq messages: 22 | \code{\link{ack}()}, 23 | \code{\link{consume}()}, 24 | \code{\link{is_empty}()}, 25 | \code{\link{list_messages}()}, 26 | \code{\link{message_count}()}, 27 | \code{\link{publish}()}, 28 | \code{\link{remove_failed_messages}()}, 29 | \code{\link{requeue_failed_messages}()}, 30 | \code{\link{try_consume}()} 31 | } 32 | \concept{liteq messages} 33 | -------------------------------------------------------------------------------- /man/list_messages.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/messages.R 3 | \name{list_messages} 4 | \alias{list_messages} 5 | \title{List all messages in a queue} 6 | \usage{ 7 | list_messages(queue) 8 | } 9 | \arguments{ 10 | \item{queue}{The queue object.} 11 | } 12 | \value{ 13 | Data frame with columns: \code{id}, \code{title}, \code{status}. 14 | } 15 | \description{ 16 | List all messages in a queue 17 | } 18 | \seealso{ 19 | \link{liteq} for examples 20 | 21 | Other liteq messages: 22 | \code{\link{ack}()}, 23 | \code{\link{consume}()}, 24 | \code{\link{is_empty}()}, 25 | \code{\link{list_failed_messages}()}, 26 | \code{\link{message_count}()}, 27 | \code{\link{publish}()}, 28 | \code{\link{remove_failed_messages}()}, 29 | \code{\link{requeue_failed_messages}()}, 30 | \code{\link{try_consume}()} 31 | } 32 | \concept{liteq messages} 33 | -------------------------------------------------------------------------------- /man/list_queues.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/queue.R 3 | \name{list_queues} 4 | \alias{list_queues} 5 | \title{List all queues in a database} 6 | \usage{ 7 | list_queues(db = default_db()) 8 | } 9 | \arguments{ 10 | \item{db}{The queue database to query.} 11 | } 12 | \value{ 13 | A list of \code{liteq_queue} objects. 14 | } 15 | \description{ 16 | List all queues in a database 17 | } 18 | \seealso{ 19 | \link{liteq} for examples 20 | 21 | Other liteq queues: 22 | \code{\link{create_queue}()}, 23 | \code{\link{delete_queue}()}, 24 | \code{\link{ensure_queue}()} 25 | } 26 | \concept{liteq queues} 27 | -------------------------------------------------------------------------------- /man/liteq-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/liteq-package.R 3 | \docType{package} 4 | \name{liteq-package} 5 | \alias{liteq-package} 6 | \title{liteq: Lightweight Portable Message Queue Using 'SQLite'} 7 | \description{ 8 | Temporary and permanent message queues for R. Built on top of 'SQLite' databases. 'SQLite' provides locking, and makes it possible to detect crashed consumers. Crashed jobs can be automatically marked as "failed", or put in the queue again, potentially a limited number of times. 9 | } 10 | \seealso{ 11 | Useful links: 12 | \itemize{ 13 | \item \url{https://github.com/r-lib/liteq#readme} 14 | \item Report bugs at \url{https://github.com/r-lib/liteq/issues} 15 | } 16 | 17 | } 18 | \author{ 19 | \strong{Maintainer}: Gábor Csárdi \email{csardi.gabor@gmail.com} 20 | 21 | Other contributors: 22 | \itemize{ 23 | \item Posit Software, PBC [copyright holder, funder] 24 | } 25 | 26 | } 27 | \keyword{internal} 28 | -------------------------------------------------------------------------------- /man/liteq.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/package.R 3 | \docType{package} 4 | \name{liteq} 5 | \alias{liteq} 6 | \title{Lightweight Portable Message Queue Using 'SQLite'} 7 | \description{ 8 | Message queues for R. Built on top of 'SQLite' databases. 9 | } 10 | \section{Concurrency}{ 11 | 12 | 13 | liteq works with multiple producer and/or consumer processes accessing 14 | the same queue, via the locking mechanism of 'SQLite'. If a queue is 15 | locked by 'SQLite', the process that tries to access it, must wait until 16 | it is unlocked. The maximum amount of waiting time is by default 10 17 | seconds, and it can be changed via the \code{R_LITEQ_BUSY_TIMEOUT} 18 | environment variable, in milliseconds. If you have many concurrent 19 | processes using the same liteq database, and see \verb{database locked} 20 | errors, then you can try to increase the timeout value. 21 | } 22 | 23 | \section{Examples}{ 24 | 25 | 26 | \if{html}{\out{
}}\preformatted{# We don't run this, because it writes to the cache directory 27 | db <- tempfile() 28 | q <- ensure_queue("jobs", db = db) 29 | q 30 | list_queues(db) 31 | 32 | # Publish two messages 33 | publish(q, title = "First message", message = "Hello world!") 34 | publish(q, title = "Second message", message = "Hello again!") 35 | is_empty(q) 36 | message_count(q) 37 | list_messages(q) 38 | 39 | # Consume one 40 | msg <- try_consume(q) 41 | msg 42 | 43 | ack(msg) 44 | list_messages(q) 45 | msg2 <- try_consume(q) 46 | nack(msg2) 47 | list_messages(q) 48 | 49 | # No more messages 50 | is_empty(q) 51 | try_consume(q) 52 | }\if{html}{\out{
}} 53 | } 54 | 55 | \examples{ 56 | ## See the manual page 57 | } 58 | -------------------------------------------------------------------------------- /man/make_message.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/messages.R 3 | \name{make_message} 4 | \alias{make_message} 5 | \title{Make a message object} 6 | \usage{ 7 | make_message(id, title, message, db, queue, lockdir) 8 | } 9 | \arguments{ 10 | \item{id}{Message id, integer, auto-generated.} 11 | 12 | \item{title}{Title of message.} 13 | 14 | \item{message}{The message itself.} 15 | 16 | \item{db}{Main DB file.} 17 | 18 | \item{queue}{Name of the queue.} 19 | 20 | \item{lockdir}{Directory to create the message lock in.} 21 | } 22 | \value{ 23 | message object 24 | } 25 | \description{ 26 | It creates the lock for the message as well. 27 | } 28 | \details{ 29 | The message object contains the connection to the message lock. If the 30 | worker crashes, then there will be no reference to the connection, and 31 | the lock will be released. This is how we detect crashed workers. 32 | } 33 | \keyword{internal} 34 | -------------------------------------------------------------------------------- /man/message_count.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/messages.R 3 | \name{message_count} 4 | \alias{message_count} 5 | \title{Get the number of messages in a queue.} 6 | \usage{ 7 | message_count(queue) 8 | } 9 | \arguments{ 10 | \item{queue}{The queue object.} 11 | } 12 | \value{ 13 | Number of messages in the queue. 14 | } 15 | \description{ 16 | Get the number of messages in a queue. 17 | } 18 | \seealso{ 19 | \link{liteq} for examples 20 | 21 | Other liteq messages: 22 | \code{\link{ack}()}, 23 | \code{\link{consume}()}, 24 | \code{\link{is_empty}()}, 25 | \code{\link{list_failed_messages}()}, 26 | \code{\link{list_messages}()}, 27 | \code{\link{publish}()}, 28 | \code{\link{remove_failed_messages}()}, 29 | \code{\link{requeue_failed_messages}()}, 30 | \code{\link{try_consume}()} 31 | } 32 | \concept{liteq messages} 33 | -------------------------------------------------------------------------------- /man/nack.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/messages.R 3 | \name{nack} 4 | \alias{nack} 5 | \title{Report that the work on a message has failed} 6 | \usage{ 7 | nack(message) 8 | } 9 | \arguments{ 10 | \item{message}{The message object.} 11 | } 12 | \description{ 13 | Report that the work on a message has failed 14 | } 15 | \seealso{ 16 | \link{liteq} for examples 17 | } 18 | -------------------------------------------------------------------------------- /man/publish.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/messages.R 3 | \name{publish} 4 | \alias{publish} 5 | \title{Publish messages in a queue} 6 | \usage{ 7 | publish(queue, title = "", message = "") 8 | } 9 | \arguments{ 10 | \item{queue}{The queue object.} 11 | 12 | \item{title}{The title of the messages. It can be the empty string.} 13 | 14 | \item{message}{The body of the messages. It can be the empty string. 15 | Must be the same length as \code{title}.} 16 | } 17 | \description{ 18 | Publish messages in a queue 19 | } 20 | \seealso{ 21 | \link{liteq} for examples 22 | 23 | Other liteq messages: 24 | \code{\link{ack}()}, 25 | \code{\link{consume}()}, 26 | \code{\link{is_empty}()}, 27 | \code{\link{list_failed_messages}()}, 28 | \code{\link{list_messages}()}, 29 | \code{\link{message_count}()}, 30 | \code{\link{remove_failed_messages}()}, 31 | \code{\link{requeue_failed_messages}()}, 32 | \code{\link{try_consume}()} 33 | } 34 | \concept{liteq messages} 35 | -------------------------------------------------------------------------------- /man/remove_failed_messages.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/messages.R 3 | \name{remove_failed_messages} 4 | \alias{remove_failed_messages} 5 | \title{Remove failed messages from the queue} 6 | \usage{ 7 | remove_failed_messages(queue, id = NULL) 8 | } 9 | \arguments{ 10 | \item{queue}{The queue object.} 11 | 12 | \item{id}{Ids of the messages to requeue. If it is \code{NULL}, then all 13 | failed messages will be removed.} 14 | } 15 | \description{ 16 | Remove failed messages from the queue 17 | } 18 | \seealso{ 19 | \link{liteq} for examples 20 | 21 | Other liteq messages: 22 | \code{\link{ack}()}, 23 | \code{\link{consume}()}, 24 | \code{\link{is_empty}()}, 25 | \code{\link{list_failed_messages}()}, 26 | \code{\link{list_messages}()}, 27 | \code{\link{message_count}()}, 28 | \code{\link{publish}()}, 29 | \code{\link{requeue_failed_messages}()}, 30 | \code{\link{try_consume}()} 31 | } 32 | \concept{liteq messages} 33 | -------------------------------------------------------------------------------- /man/requeue_failed_messages.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/messages.R 3 | \name{requeue_failed_messages} 4 | \alias{requeue_failed_messages} 5 | \title{Requeue failed messages} 6 | \usage{ 7 | requeue_failed_messages(queue, id = NULL) 8 | } 9 | \arguments{ 10 | \item{queue}{The queue object.} 11 | 12 | \item{id}{Ids of the messages to requeue. If it is \code{NULL}, then all 13 | failed messages will be requeued.} 14 | } 15 | \description{ 16 | Requeue failed messages 17 | } 18 | \seealso{ 19 | \link{liteq} for examples 20 | 21 | Other liteq messages: 22 | \code{\link{ack}()}, 23 | \code{\link{consume}()}, 24 | \code{\link{is_empty}()}, 25 | \code{\link{list_failed_messages}()}, 26 | \code{\link{list_messages}()}, 27 | \code{\link{message_count}()}, 28 | \code{\link{publish}()}, 29 | \code{\link{remove_failed_messages}()}, 30 | \code{\link{try_consume}()} 31 | } 32 | \concept{liteq messages} 33 | -------------------------------------------------------------------------------- /man/try_consume.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/messages.R 3 | \name{try_consume} 4 | \alias{try_consume} 5 | \title{Consume a message if there is one available} 6 | \usage{ 7 | try_consume(queue) 8 | } 9 | \arguments{ 10 | \item{queue}{The queue object.} 11 | } 12 | \value{ 13 | A message, or \code{NULL} if there is not message to work on. 14 | } 15 | \description{ 16 | Consume a message if there is one available 17 | } 18 | \seealso{ 19 | \link{liteq} for examples 20 | 21 | Other liteq messages: 22 | \code{\link{ack}()}, 23 | \code{\link{consume}()}, 24 | \code{\link{is_empty}()}, 25 | \code{\link{list_failed_messages}()}, 26 | \code{\link{list_messages}()}, 27 | \code{\link{message_count}()}, 28 | \code{\link{publish}()}, 29 | \code{\link{remove_failed_messages}()}, 30 | \code{\link{requeue_failed_messages}()} 31 | } 32 | \concept{liteq messages} 33 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(liteq) 3 | 4 | testme <- function() { 5 | cache <- tempfile() 6 | on.exit(unlink(cache, recursive = TRUE), add = TRUE) 7 | withr::with_envvar( 8 | c("LITEQ_CACHE_DIR" = cache), 9 | test_check("liteq") 10 | ) 11 | } 12 | -------------------------------------------------------------------------------- /tests/testthat/test-blocking.R: -------------------------------------------------------------------------------- 1 | 2 | context("blocking consume") 3 | 4 | test_that("consume", { 5 | ## We are currently not testing this, because it needs two 6 | ## R processes 7 | }) 8 | -------------------------------------------------------------------------------- /tests/testthat/test-concurrency.R: -------------------------------------------------------------------------------- 1 | 2 | context("concurrency") 3 | 4 | test_that("pressure test", { 5 | 6 | ## peace 7 | skip_on_cran() 8 | 9 | producer <- function() { 10 | library(liteq) 11 | q <- ensure_queue("q", db = "db.txt") 12 | limit <- Sys.time() + 30 13 | while (Sys.time() < limit) { 14 | publish(q, title = "title", message = "message") 15 | cat("O") 16 | } 17 | } 18 | 19 | consumer <- function() { 20 | library(liteq) 21 | q <- ensure_queue("q", db = "db.txt") 22 | while (TRUE) { 23 | msg <- consume(q) 24 | ack(msg) 25 | cat("X") 26 | } 27 | } 28 | 29 | dir.create(tmp <- tempfile()) 30 | on.exit(unlink(tmp, recursive = TRUE), add = TRUE) 31 | withr::local_dir(tmp) 32 | 33 | pp <- callr::r_bg(producer) 34 | pc <- callr::r_bg(consumer) 35 | 36 | outp <- character() 37 | outc <- character() 38 | 39 | while (pp$is_alive()) { 40 | processx::poll(list(pp, pc), -1) 41 | outp <- c(outp, pp$read_output()) 42 | outc <- c(outc, pc$read_output()) 43 | } 44 | 45 | expect_equal(pp$get_exit_status(), 0) 46 | 47 | pc$kill(close_connections = FALSE) 48 | outp <- c(outp, pp$read_all_output()) 49 | outc <- c(outc, pc$read_all_output()) 50 | close(pc$get_output_connection()) 51 | close(pc$get_error_connection()) 52 | 53 | outp <- paste(outp, collapse = "") 54 | outc <- paste(outc, collapse = "") 55 | 56 | expect_true(grepl("^O+$", outp)) 57 | expect_true(grepl("^X+$", outc)) 58 | 59 | expect_null(pp$get_result()) 60 | }) 61 | -------------------------------------------------------------------------------- /tests/testthat/test-crashes.R: -------------------------------------------------------------------------------- 1 | 2 | context("crashed consumers") 3 | 4 | test_that("requeueing crashed consumers", { 5 | db <- tempfile() 6 | on.exit(unlink(db), add = TRUE) 7 | q <- ensure_queue("jobs", db = db, crash_strategy = "requeue") 8 | publish(q, title = title <- "title", message = text <- "MSG") 9 | msg <- try_consume(q) 10 | 11 | ## now we simulate a crash, so the connection embedded in `msg` is closed 12 | rm(msg) 13 | suppressWarnings(gc()) 14 | 15 | ## now, if we try to get a message, the same message must be served again 16 | msg <- try_consume(q) 17 | expect_false(is.null(msg)) 18 | if (!is.null(msg)) { 19 | ack(msg) 20 | expect_equal(msg$title, title) 21 | expect_equal(msg$message, text) 22 | } 23 | }) 24 | 25 | test_that("requeueing multiple crashed consumers", { 26 | db <- tempfile() 27 | on.exit(unlink(db), add = TRUE) 28 | q <- ensure_queue("jobs", db = db, crash_strategy = "requeue") 29 | publish(q, title = "title1", message = "MSG1") 30 | publish(q, title = "title2", message = "MSG2") 31 | msg <- try_consume(q) 32 | msg2 <- try_consume(q) 33 | 34 | ## both crash 35 | rm(msg, msg2) 36 | gc() 37 | 38 | ## both are restarted 39 | msg <- try_consume(q) 40 | msg2 <- try_consume(q) 41 | 42 | expect_false(is.null(msg)) 43 | if (!is.null(msg)) { 44 | ack(msg) 45 | expect_equal(msg$title, "title1") 46 | expect_equal(msg$message, "MSG1") 47 | } 48 | 49 | expect_false(is.null(msg2)) 50 | if (!is.null(msg2)) { 51 | ack(msg2) 52 | expect_equal(msg2$title, "title2") 53 | expect_equal(msg2$message, "MSG2") 54 | } 55 | }) 56 | 57 | test_that("failing crashed consumers", { 58 | db <- tempfile() 59 | on.exit(unlink(db), add = TRUE) 60 | q <- ensure_queue("jobs", db = db, crash_strategy = "fail") 61 | publish(q, title = title <- "title", message = text <- "MSG") 62 | msg <- try_consume(q) 63 | 64 | ## now we simulate a crash, so the connection embedded in `msg` is closed 65 | rm(msg) 66 | gc() 67 | 68 | msg <- try_consume(q) 69 | expect_null(msg) 70 | fail <- list_failed_messages(q) 71 | expect_equal(fail$title, title) 72 | }) 73 | 74 | test_that("requeueing crashed consumers a limited number of times", { 75 | db <- tempfile() 76 | on.exit(unlink(db), add = TRUE) 77 | q <- ensure_queue("jobs", db = db, crash_strategy = 2) 78 | publish(q, title = title <- "title", message = text <- "MSG") 79 | msg <- try_consume(q) 80 | 81 | ## now we simulate a crash, so the connection embedded in `msg` is closed 82 | rm(msg) 83 | gc() 84 | 85 | ## it is requeued 86 | msg <- try_consume(q) 87 | expect_false(is.null(msg)) 88 | if (!is.null(msg)) { 89 | expect_equal(msg$title, title) 90 | expect_equal(msg$message, text) 91 | } 92 | 93 | ## fail it again 94 | rm(msg) 95 | gc() 96 | 97 | ## it is requeued again 98 | msg <- try_consume(q) 99 | expect_false(is.null(msg)) 100 | if (!is.null(msg)) { 101 | expect_equal(msg$title, title) 102 | expect_equal(msg$message, text) 103 | } 104 | 105 | ## fail it again 106 | rm(msg) 107 | gc() 108 | 109 | ## not requeued any more 110 | msg <- try_consume(q) 111 | expect_null(msg) 112 | fail <- list_failed_messages(q) 113 | expect_equal(fail$title, title) 114 | }) 115 | -------------------------------------------------------------------------------- /tests/testthat/test-db.R: -------------------------------------------------------------------------------- 1 | 2 | context("db") 3 | 4 | test_that("default_db", { 5 | db <- default_db() 6 | expect_true(is.character(db) && length(db) == 1) 7 | }) 8 | 9 | test_that("ensure_db", { 10 | db <- tempfile() 11 | on.exit(unlink(db)) 12 | expect_silent(ensure_db(db)) 13 | expect_silent(ensure_db(db)) 14 | expect_true(file.exists(db)) 15 | }) 16 | 17 | test_that("db_query", { 18 | db <- tempfile() 19 | on.exit(unlink(db)) 20 | ensure_db(db) 21 | con <- dbConnect(SQLite(), db, synchronous = NULL) 22 | on.exit(dbDisconnect(con)) 23 | db_execute( 24 | con, 'INSERT INTO ?table (name) VALUES (?value)', 25 | table = "meta", value = "foobar" 26 | ) 27 | expect_equal( 28 | db_query(con, "SELECT name FROM meta"), 29 | data.frame(name = "foobar", stringsAsFactors = FALSE) 30 | ) 31 | }) 32 | 33 | test_that("db_execute", { 34 | db <- tempfile() 35 | on.exit(unlink(db)) 36 | ensure_db(db) 37 | con <- dbConnect(SQLite(), db, synchronous = NULL) 38 | on.exit(dbDisconnect(con)) 39 | db_execute( 40 | con, 'INSERT INTO ?table (name) VALUES (?value)', 41 | table = "meta", value = "foobar" 42 | ) 43 | expect_equal( 44 | db_execute(con, "DELETE FROM meta WHERE name = ?n", n = "foobar"), 45 | 1 46 | ) 47 | expect_equal( 48 | db_execute(con, "DELETE FROM meta WHERE name = ?n", n = "foobar"), 49 | 0 50 | ) 51 | }) 52 | 53 | test_that("do_db", { 54 | db <- tempfile() 55 | on.exit(unlink(db)) 56 | ensure_db(db) 57 | do_db_execute( 58 | db, 'INSERT INTO ?table (name) VALUES (?value)', 59 | table = "meta", value = "foobar" 60 | ) 61 | expect_equal( 62 | do_db(db, "SELECT name FROM meta"), 63 | data.frame(name = "foobar", stringsAsFactors = FALSE) 64 | ) 65 | }) 66 | 67 | test_that("db_lock", { 68 | db <- tempfile() 69 | ensure_db(db) 70 | con <- dbConnect(SQLite(), db, synchronous = NULL) 71 | con2 <- dbConnect(SQLite(), db, synchronous = NULL) 72 | db_lock(con) 73 | 74 | ## We can do queries 75 | expect_silent(db_query(con, "SELECT * FROM meta")) 76 | 77 | ## But others cannot even connect 78 | con3 <- dbConnect(SQLite(), db, synchronous = NULL) 79 | expect_error(db_query(con3, "SELECT * FROM meta")) 80 | 81 | ## Already existing connections cannot query 82 | expect_error(db_query(con2, "SELECT * FROM meta")) 83 | 84 | ## But we can request another lock, and that waits. 85 | ## For this we need another R process, so we cannot test it now.... 86 | 87 | ## Removing the connection removes the lock 88 | rm(con) 89 | gc() 90 | expect_silent(db_query(con2, "SELECT * FROM meta")) 91 | expect_silent(db_query(con3, "SELECT * FROM meta")) 92 | rm(con2, con3) 93 | gc() 94 | }) 95 | 96 | test_that("db_create_db", { 97 | ## Tested through ensure_db() already 98 | }) 99 | 100 | test_that("db_create_queue", { 101 | ## Tested through higher level functions 102 | }) 103 | 104 | test_that("db_list_queues", { 105 | ## Tested through higher level functions 106 | }) 107 | 108 | test_that("db_publish", { 109 | ## Tested through higher level functions 110 | }) 111 | 112 | test_that("db_try_consume", { 113 | ## Tested through higher level functions 114 | }) 115 | 116 | test_that("db_clean_crashed", { 117 | ## Tested through higher level functions 118 | }) 119 | 120 | test_that("db_consume", { 121 | ## Tested through higher level functions 122 | }) 123 | 124 | test_that("db_ack", { 125 | ## Tested through higher level functions 126 | }) 127 | -------------------------------------------------------------------------------- /tests/testthat/test-messages.R: -------------------------------------------------------------------------------- 1 | 2 | context("messages") 3 | 4 | test_that("publish, is_empty, and message_count", { 5 | db <- tempfile() 6 | on.exit(unlink(db), add = TRUE) 7 | q <- ensure_queue("jobs", db = db) 8 | expect_true(is_empty(q)) 9 | expect_equal(message_count(q), 0) 10 | 11 | for (i in 1:5) { 12 | publish(q, title = title <- as.character(i), message = text <- "MSG") 13 | } 14 | 15 | # title and message lengths must match 16 | expect_error(publish(q, title = "one", message = c("one", "two"))) 17 | 18 | # multiple messages at once 19 | publish(q, title = as.character(6:10), message = rep("MSG", 5)) 20 | expect_false(is_empty(q)) 21 | expect_equal(message_count(q), 10) 22 | }) 23 | 24 | test_that("publish & consume", { 25 | db <- tempfile() 26 | on.exit(unlink(db), add = TRUE) 27 | q <- ensure_queue("jobs", db = db) 28 | 29 | for (i in 1:10) { 30 | publish(q, title = title <- as.character(i), message = text <- "MSG") 31 | msg <- try_consume(q) 32 | ack(msg) 33 | expect_equal(msg$title, title) 34 | expect_equal(msg$message, text) 35 | } 36 | 37 | for (i in 1:10) { 38 | publish(q, title = as.character(i), message = paste0("MSG-", i)) 39 | } 40 | 41 | for (i in 1:10) { 42 | msg <- try_consume(q) 43 | ack(msg) 44 | expect_equal(msg$title, as.character(i)) 45 | expect_equal(msg$message, paste0("MSG-", i)) 46 | } 47 | }) 48 | 49 | test_that("nack", { 50 | db <- tempfile() 51 | on.exit(unlink(db), add = TRUE) 52 | q <- ensure_queue("jobs", db = db) 53 | 54 | for (i in 1:10) { 55 | publish(q, title = title <- as.character(i), message = text <- "MSG") 56 | msg <- try_consume(q) 57 | nack(msg) 58 | expect_equal(msg$title, title) 59 | expect_equal(msg$message, text) 60 | } 61 | 62 | ## Check that the messages are still there, but "FAILED" 63 | con <- db_connect(q$db) 64 | on.exit(dbDisconnect(con), add = TRUE) 65 | msgs <- db_query( 66 | con, 67 | "SELECT * FROM ?tablename", 68 | tablename = db_queue_name(q$name) 69 | ) 70 | expect_equal(msgs$title, as.character(1:10)) 71 | expect_equal(msgs$status, rep("FAILED", 10)) 72 | }) 73 | 74 | test_that("try_consume if queue is empty", { 75 | db <- tempfile() 76 | on.exit(unlink(db), add = TRUE) 77 | q <- ensure_queue("jobs", db = db) 78 | 79 | expect_null(try_consume(q)) 80 | 81 | for (i in 1:10) { 82 | publish(q, title = title <- as.character(i), message = text <- "MSG") 83 | msg <- try_consume(q) 84 | nack(msg) 85 | expect_equal(msg$title, title) 86 | expect_equal(msg$message, text) 87 | } 88 | 89 | expect_null(try_consume(q)) 90 | }) 91 | -------------------------------------------------------------------------------- /tests/testthat/test-queue.R: -------------------------------------------------------------------------------- 1 | 2 | context("queue") 3 | 4 | test_that("create_queue", { 5 | db <- tempfile() 6 | q <- create_queue("foo", db = db) 7 | expect_true(inherits(q, "liteq_queue")) 8 | expect_equal(db_list_queues(db)$name, "foo") 9 | 10 | ## Random name works as well 11 | q <- create_queue(db = db) 12 | expect_true(q$name %in% db_list_queues(db)$name) 13 | }) 14 | 15 | test_that("ensure_queue", { 16 | db <- tempfile() 17 | q <- ensure_queue("foo", db = db) 18 | expect_true(inherits(q, "liteq_queue")) 19 | expect_equal(db_list_queues(db)$name, "foo") 20 | 21 | expect_silent(q <- ensure_queue("foo", db = db)) 22 | expect_true(inherits(q, "liteq_queue")) 23 | expect_equal(db_list_queues(db)$name, "foo") 24 | }) 25 | 26 | test_that("delete_queue", { 27 | db <- tempfile() 28 | q <- create_queue("foo", db = db) 29 | 30 | delete_queue(q) 31 | expect_false(q$name %in% db_list_queues(db)$name) 32 | 33 | q <- create_queue("foo", db = db) 34 | publish(q, title = "title", message = "") 35 | expect_error(delete_queue(q), "Unwilling to delete non-empty queue") 36 | expect_true(q$name %in% db_list_queues(db)$name) 37 | expect_silent(delete_queue(q, force = TRUE)) 38 | expect_false(q$name %in% db_list_queues(db)$name) 39 | }) 40 | 41 | test_that("list_queues", { 42 | db <- tempfile() 43 | q <- create_queue("foo", db = db) 44 | expect_true("foo" %in% lapply(list_queues(db), "[[", "name")) 45 | }) 46 | 47 | test_that("make_queue", { 48 | ## Tested via other methods 49 | }) 50 | -------------------------------------------------------------------------------- /tests/testthat/test-remove-failed.R: -------------------------------------------------------------------------------- 1 | 2 | context("removing failed messages") 3 | 4 | test_that("remove all failed messages", { 5 | 6 | ## Create queue 7 | db <- tempfile() 8 | on.exit(unlink(db), add = TRUE) 9 | q <- ensure_queue("jobs", db = db) 10 | 11 | ## Fail some messages 12 | publish(q, title = "title1", message ="MSG1") 13 | msg <- try_consume(q) 14 | nack(msg) 15 | 16 | publish(q, title = "title2", message ="MSG2") 17 | msg <- try_consume(q) 18 | nack(msg) 19 | 20 | ## And add another one 21 | publish(q, title = "title3", message ="MSG3") 22 | 23 | ## List failed messages 24 | fail <- list_failed_messages(q) 25 | expect_equal(nrow(fail), 2) 26 | expect_equal(fail$title, c("title1", "title2")) 27 | expect_equal(fail$status, c("FAILED", "FAILED")) 28 | 29 | msgs <- list_messages(q) 30 | expect_equal(nrow(msgs), 3) 31 | expect_equal(sum(msgs$status == "FAILED"), 2) 32 | 33 | ## Remove them 34 | remove_failed_messages(q) 35 | fail <- list_failed_messages(q) 36 | expect_equal(nrow(fail), 0) 37 | msgs <- list_messages(q) 38 | expect_equal(nrow(msgs), 1) 39 | }) 40 | 41 | 42 | test_that("remove some failed messages", { 43 | 44 | ## Create queue 45 | db <- tempfile() 46 | on.exit(unlink(db), add = TRUE) 47 | q <- ensure_queue("jobs", db = db) 48 | 49 | ## Fail some messages 50 | publish(q, title = "title1", message ="MSG1") 51 | msg <- try_consume(q) 52 | nack(msg) 53 | 54 | publish(q, title = "title2", message ="MSG2") 55 | msg <- try_consume(q) 56 | nack(msg) 57 | 58 | ## And add another one 59 | publish(q, title = "title2", message ="MSG2") 60 | 61 | ## List failed messages 62 | fail <- list_failed_messages(q) 63 | expect_equal(nrow(fail), 2) 64 | expect_equal(fail$title, c("title1", "title2")) 65 | expect_equal(fail$status, c("FAILED", "FAILED")) 66 | 67 | msgs <- list_messages(q) 68 | expect_equal(nrow(msgs), 3) 69 | expect_equal(sum(msgs$status == "FAILED"), 2) 70 | 71 | ## Remove one 72 | remove_failed_messages(q, id = 1) 73 | fail <- list_failed_messages(q) 74 | expect_equal(nrow(fail), 1) 75 | expect_equal(fail$title, "title2") 76 | msgs <- list_messages(q) 77 | expect_equal(nrow(msgs), 2) 78 | }) 79 | -------------------------------------------------------------------------------- /tests/testthat/test-requeue-failed.R: -------------------------------------------------------------------------------- 1 | 2 | context("requeueing failed messages") 3 | 4 | test_that("requeue all failed messages", { 5 | 6 | ## Create queue 7 | db <- tempfile() 8 | on.exit(unlink(db), add = TRUE) 9 | q <- ensure_queue("jobs", db = db) 10 | 11 | ## Fail some messages 12 | publish(q, title = "title1", message ="MSG1") 13 | msg <- try_consume(q) 14 | nack(msg) 15 | 16 | publish(q, title = "title2", message ="MSG2") 17 | msg <- try_consume(q) 18 | nack(msg) 19 | 20 | ## And add another one 21 | publish(q, title = "title3", message ="MSG3") 22 | 23 | ## List failed messages 24 | fail <- list_failed_messages(q) 25 | expect_equal(nrow(fail), 2) 26 | expect_equal(fail$title, c("title1", "title2")) 27 | expect_equal(fail$status, c("FAILED", "FAILED")) 28 | 29 | msgs <- list_messages(q) 30 | expect_equal(nrow(msgs), 3) 31 | expect_equal(sum(msgs$status == "FAILED"), 2) 32 | 33 | ## Requeue them 34 | requeue_failed_messages(q) 35 | fail <- list_failed_messages(q) 36 | expect_equal(nrow(fail), 0) 37 | msgs <- list_messages(q) 38 | expect_equal(nrow(msgs), 3) 39 | expect_equal(sort(msgs$title), sort(c("title1", "title2", "title3"))) 40 | }) 41 | 42 | test_that("requeue some failed messages", { 43 | 44 | ## Create queue 45 | db <- tempfile() 46 | on.exit(unlink(db), add = TRUE) 47 | q <- ensure_queue("jobs", db = db) 48 | 49 | ## Fail some messages 50 | publish(q, title = "title1", message ="MSG1") 51 | msg <- try_consume(q) 52 | nack(msg) 53 | 54 | publish(q, title = "title2", message ="MSG2") 55 | msg <- try_consume(q) 56 | nack(msg) 57 | 58 | ## And add another one 59 | publish(q, title = "title3", message ="MSG3") 60 | 61 | ## List failed messages 62 | fail <- list_failed_messages(q) 63 | expect_equal(nrow(fail), 2) 64 | expect_equal(fail$title, c("title1", "title2")) 65 | expect_equal(fail$status, c("FAILED", "FAILED")) 66 | 67 | msgs <- list_messages(q) 68 | expect_equal(nrow(msgs), 3) 69 | expect_equal(sum(msgs$status == "FAILED"), 2) 70 | 71 | ## Requeue them 72 | requeue_failed_messages(q, id = 1) 73 | fail <- list_failed_messages(q) 74 | expect_equal(nrow(fail), 1) 75 | expect_equal(sort(fail$title), "title2") 76 | msgs <- list_messages(q) 77 | expect_equal(nrow(msgs), 3) 78 | expect_equal(sum(msgs$status == "FAILED"), 1) 79 | }) 80 | -------------------------------------------------------------------------------- /tests/testthat/test-utils.R: -------------------------------------------------------------------------------- 1 | 2 | context("utils") 3 | 4 | test_that("random_queue_name", { 5 | x <- replicate(10, random_queue_name()) 6 | expect_true(all(nchar(x) >= 10)) 7 | expect_true(all(grepl("^[a-z][a-z0-9]+$", x))) 8 | }) 9 | 10 | test_that("%||%", { 11 | expect_identical(NULL %||% "foo", "foo") 12 | expect_identical("bar" %||% "foo", "bar") 13 | expect_identical(NULL %||% NULL, NULL) 14 | }) 15 | 16 | test_that("try_silent", { 17 | expect_silent(try_silent(stop("boo"))) 18 | expect_silent(try_silent(1 + "A")) 19 | expect_output(try_silent(print("hello")), "hello") 20 | }) 21 | --------------------------------------------------------------------------------