boB Rudis
6 years ago
17 changed files with 839 additions and 157 deletions
@ -1,10 +1,24 @@ |
|||||
Package: cloc |
Package: cloc |
||||
Title: Count Lines of Code, Comments and Whitespace in Source Files and Archives |
Title: Count Lines of Code, Comments and Whitespace in Source Files and Archives |
||||
Version: 0.0.0.9000 |
Version: 0.1.0 |
||||
Authors@R: c(person("Bob", "Rudis", email = "bob@rudis.net", role = c("aut", "cre"))) |
Authors@R: c( |
||||
Description: Count lines of code! |
person("Bob", "Rudis", email = "bob@rud.is", role = c("aut", "cre"), |
||||
Imports: R.utils, utils, dplyr, pbapply |
comment = c(ORCID = "0000-0001-5670-2640")), |
||||
Depends: R (>= 3.2.0) |
person("Al", "Danial", comment = "cloc perl script", role=c("aut")), |
||||
|
person("Maëlle", "Salmon", email = "maelle.salmon@yahoo.se", role = c("ctb")) |
||||
|
) |
||||
|
Description: Counts blank lines, comment lines, and physical lines of source code |
||||
|
in source files/trees/archives. An R wrapper to the 'Perl' command-line utility |
||||
|
<https://github.com/AlDanial/cloc>. |
||||
|
SystemRequirements: perl |
||||
|
Imports: |
||||
|
R.utils, |
||||
|
utils, |
||||
|
dplyr |
||||
|
Encoding: UTF-8 |
||||
|
Depends: |
||||
|
R (>= 3.2.0) |
||||
License: MIT + file LICENSE |
License: MIT + file LICENSE |
||||
LazyData: true |
LazyData: true |
||||
Suggests: testthat |
Suggests: testthat |
||||
|
RoxygenNote: 6.0.1.9000 |
||||
|
@ -1,10 +1,12 @@ |
|||||
# Generated by roxygen2 (4.1.1): do not edit by hand |
# Generated by roxygen2: do not edit by hand |
||||
|
|
||||
export(cloc) |
export(cloc) |
||||
export(cloc_cran) |
export(cloc_cran) |
||||
importFrom(R.utils,isUrl) |
importFrom(R.utils,isUrl) |
||||
importFrom(dplyr,bind_rows) |
importFrom(dplyr,bind_rows) |
||||
importFrom(dplyr,rbind_list) |
importFrom(dplyr,progress_estimated) |
||||
importFrom(dplyr,tbl_df) |
importFrom(utils,contrib.url) |
||||
importFrom(pbapply,pblapply) |
importFrom(utils,download.file) |
||||
|
importFrom(utils,download.packages) |
||||
importFrom(utils,read.table) |
importFrom(utils,read.table) |
||||
|
importFrom(utils,tail) |
||||
|
@ -0,0 +1,8 @@ |
|||||
|
# cloc 0.1.0 |
||||
|
|
||||
|
- overhaul to resurrect the package |
||||
|
- upgraded to latest (1.74) cloc perl utility (@maelle) |
||||
|
|
||||
|
# cloc 0.0.0.9000 |
||||
|
|
||||
|
- initial version |
@ -0,0 +1,51 @@ |
|||||
|
|
||||
|
#' Count lines of code (etc) from source packages on CRAN |
||||
|
#' |
||||
|
#' @md |
||||
|
#' @param pkgs names of packages |
||||
|
#' @param repos character vector, the base URL(s) of the repositories to use, |
||||
|
#' i.e., the URL of the CRAN master such as "`https://cran.r-project.org`" |
||||
|
#' or its Statlib mirror, "`http://lib.stat.cmu.edu/R/CRAN`". |
||||
|
#' @param contrib_url URL(s) of the contrib sections of the repositories. Use |
||||
|
#' this argument only if your repository mirror is incomplete, e.g., |
||||
|
#' because you burned only the ‘contrib’ section on a CD. Overrides |
||||
|
#' argument repos. |
||||
|
#' @param .progress show a progress bar? Default: `TRUE` if running interactively. |
||||
|
#' @return tibble |
||||
|
#' @export |
||||
|
#' @examples |
||||
|
#' # requires a network connection therefore is set for you to run it manually |
||||
|
#' \dontrun{ |
||||
|
#' cloc_cran(c("archdata", "hrbrthemes", "iptools", "dplyr")) |
||||
|
#' } |
||||
|
cloc_cran <- function(pkgs, |
||||
|
repos = getOption("repos"), |
||||
|
contrib_url = utils::ontrib.url(repos, "source"), |
||||
|
.progress = interactive()) { |
||||
|
|
||||
|
destdir <- tempfile() |
||||
|
dir.create(destdir) |
||||
|
on.exit(unlink(destdir, recursive = TRUE), add = TRUE) |
||||
|
|
||||
|
# retrieve the package archive |
||||
|
as.data.frame( |
||||
|
utils::download.packages( |
||||
|
pkgs, destdir, repos = repos, contriburl = contrib_url, type = "source" |
||||
|
), |
||||
|
stringsAsFactors = FALSE |
||||
|
) -> res_p |
||||
|
|
||||
|
# |
||||
|
if (.progress) pb <- dplyr::progress_estimated(length(res_p$V2)) |
||||
|
dplyr::bind_rows( |
||||
|
lapply(res_p$V2, function(x) { |
||||
|
if (.progress) pb$tick()$print() |
||||
|
ret <- cloc(x) |
||||
|
if (nrow(ret) > 0) ret$pkg <- res_p[res_p$V2 == x, ]$V1 |
||||
|
ret |
||||
|
}) |
||||
|
) -> res |
||||
|
|
||||
|
res |
||||
|
|
||||
|
} |
@ -1,11 +1,14 @@ |
|||||
#' A package to Count Lines of Code, Comments and Whitespace in Source Files and Archives |
#' Count Lines of Code, Comments and Whitespace in Source Files and Archives |
||||
|
#' |
||||
|
#' Counts blank lines, comment lines, and physical lines of source code in source |
||||
|
#' files/trees/archives. An R wrapper to the Perl `cloc` utility |
||||
|
#' <https://github.com/AlDanial/cloc> by @AlDanial. |
||||
|
#' |
||||
|
#' @md |
||||
#' @name cloc-package |
#' @name cloc-package |
||||
#' @docType package |
#' @docType package |
||||
#' @author Bob Rudis (@@hrbrmstr) |
#' @author Bob Rudis (bob@@rud.is) |
||||
#' @importFrom R.utils isUrl |
#' @importFrom R.utils isUrl |
||||
#' @importFrom utils read.table |
#' @importFrom utils read.table contrib.url download.file download.packages tail |
||||
#' @importFrom dplyr tbl_df |
#' @importFrom dplyr bind_rows progress_estimated |
||||
#' @importFrom dplyr bind_rows |
|
||||
#' @importFrom dplyr rbind_list |
|
||||
#' @importFrom pbapply pblapply |
|
||||
NULL |
NULL |
||||
|
@ -1,78 +1,104 @@ |
|||||
#' Count lines of code, comments and whitespace in source files/archives |
#' Count lines of code, comments and whitespace in source files/archives |
||||
#' |
#' |
||||
#' @param source thing to extract from |
#' @param source file, directory or archive to read from |
||||
#' @param extract_with thing |
#' @param extract_with passed into `cloc` command line. This option is only |
||||
#' @return \code{tbl_df} |
#' needed if cloc is unable to figure out how to extract the contents of |
||||
|
#' the input file(s) by itself. |
||||
|
#' @return tibble |
||||
#' @export |
#' @export |
||||
|
#' @examples |
||||
|
#' # by dir |
||||
|
#' cloc(system.file("extdata", package="cloc")) |
||||
|
#' |
||||
|
#' # by file |
||||
|
#' cloc(system.file("extdata", "App.java", package="cloc")) |
||||
|
#' |
||||
|
#' # requires a network connection therefore is set for you to run it manually |
||||
|
#' \dontrun{ |
||||
|
#' # from a url |
||||
|
#' cloc("https://rud.is/dl/cloc-1.74.tar.gz") |
||||
|
#' } |
||||
cloc <- function(source, extract_with=NULL) { |
cloc <- function(source, extract_with=NULL) { |
||||
|
|
||||
is_url <- isUrl(source) |
perl <- Sys.which("perl") |
||||
|
|
||||
|
if (perl == "") { |
||||
|
stop( |
||||
|
"Cannot find 'perl'. cloc required perl to be installed and on the PATH.", |
||||
|
call. = FALSE |
||||
|
) |
||||
|
} |
||||
|
|
||||
|
is_url <- R.utils::isUrl(source) |
||||
|
|
||||
if (is_url) { |
if (is_url) { # download the source if a URL was specified |
||||
dir <- tempdir() |
dir <- tempdir() |
||||
download.file(source, file.path(dir, basename(source)), method="curl") |
utils::download.file(source, file.path(dir, basename(source)), method = "curl") |
||||
source <- file.path(dir, basename(source)) |
source <- file.path(dir, basename(source)) |
||||
|
on.exit(unlink(source), add = TRUE) |
||||
} |
} |
||||
|
|
||||
stopifnot(file.exists(source)) |
stopifnot(file.exists(source)) |
||||
|
|
||||
cmd <- sprintf("perl %s --quiet --csv %s", |
# make the command line |
||||
system.file("bin/cloc.pl", package="cloc"), |
|
||||
source) |
|
||||
|
|
||||
if (!is.null(extract_with)) cmd <- sprintf('%s --extract-with="%s"', cmd, extract_with) |
sprintf( |
||||
|
"%s %s --quiet --csv %s", |
||||
|
perl, |
||||
|
system.file("bin/cloc.pl", package = "cloc"), |
||||
|
source |
||||
|
) -> cmd |
||||
|
|
||||
dat <- system(cmd, intern=TRUE) |
# tack on teh "--extract-with" value (if specified) |
||||
|
if (!is.null(extract_with)) cmd <- sprintf('%s --extract-with="%s"', cmd, extract_with) |
||||
|
|
||||
fil <- read.table(text=paste(tail(dat, -2), sep="", collapse="\n"), |
# run the perl script |
||||
col.names=c("file_count", "language", "blank_lines", |
dat <- system(cmd, intern = TRUE) |
||||
"comment_lines", "loc"), |
|
||||
sep=",", stringsAsFactors=FALSE) |
# nothing to count |
||||
|
if (length(dat) == 0) { |
||||
|
return( |
||||
|
data.frame( |
||||
|
source = basename(source), |
||||
|
language = NA_character_, |
||||
|
file_count = 0, |
||||
|
file_count_pct = 0, |
||||
|
loc = 0, |
||||
|
loc_pct = 0, |
||||
|
blank_lines = 0, |
||||
|
blank_line_pct = 0, |
||||
|
comment_lines = 0, |
||||
|
comment_line_pct = 0, |
||||
|
stringsAsFactors = FALSE |
||||
|
) |
||||
|
) |
||||
|
} |
||||
|
|
||||
if (is_url) unlink(source) |
# read in the output from the perl script |
||||
|
fil <- read.table( |
||||
|
text = paste(utils::tail(dat, -2), sep = "", collapse = "\n"), |
||||
|
col.names = c("file_count", "language", "blank_lines", "comment_lines", "loc"), |
||||
|
sep = ",", comment.char = "", stringsAsFactors = FALSE |
||||
|
) |
||||
|
|
||||
# calculate percentages |
# calculate percentages |
||||
|
|
||||
fil$source <- basename(source) |
fil$source <- basename(source) |
||||
fil$file_count_pct <- fil$file_count / sum(fil$file_count) |
fil$file_count_pct <- fil$file_count / sum(fil$file_count) |
||||
fil$blank_line_pct <- fil$blank_lines / sum(fil$blank_lines) |
fil$blank_line_pct <- fil$blank_lines / sum(fil$blank_lines) |
||||
fil$comment_line_pct <- fil$comment_lines / sum(fil$comment_lines) |
fil$comment_line_pct <- fil$comment_lines / sum(fil$comment_lines) |
||||
fil$loc_pct <- fil$loc / sum(fil$loc) |
fil$loc_pct <- fil$loc / sum(fil$loc) |
||||
|
|
||||
tbl_df(fil[, c("source", "language", |
# reorganize columns |
||||
"file_count", "file_count_pct", |
fil <- fil[, c( |
||||
"loc", "loc_pct", |
"source", "language", |
||||
"blank_lines", "blank_line_pct", |
"file_count", "file_count_pct", |
||||
"comment_lines", "comment_line_pct")]) |
"loc", "loc_pct", |
||||
|
"blank_lines", "blank_line_pct", |
||||
} |
"comment_lines", "comment_line_pct" |
||||
|
)] |
||||
#' Count lines of code (etc) from source packages on CRAN |
|
||||
#' |
|
||||
#' @param pkgs names of pkgs |
|
||||
#' @param repos repos |
|
||||
#' @param contriburl |
|
||||
#' @return \code{tbl_df} |
|
||||
#' @export |
|
||||
cloc_cran <- function(pkgs, |
|
||||
repos = getOption("repos"), |
|
||||
contriburl = contrib.url(repos, "source")) { |
|
||||
|
|
||||
destdir <- tempfile() |
|
||||
dir.create(destdir) |
|
||||
|
|
||||
res_p <- as.data.frame(download.packages(pkgs, destdir, repos=repos, |
|
||||
contriburl=contriburl, type="source"), |
|
||||
stringsAsFactors=FALSE) |
|
||||
|
|
||||
res <- bind_rows(pblapply(res_p$V2, function(x) { |
|
||||
ret <- cloc(x) |
|
||||
ret$pkg <- res_p[res_p$V2==x,]$V1 |
|
||||
ret |
|
||||
})) |
|
||||
|
|
||||
unlink(destdir, recursive=TRUE) |
class(fil) <- c("tbl_df", "tbl", "data.frame") |
||||
|
|
||||
res |
fil |
||||
|
|
||||
} |
} |
||||
|
@ -1,66 +1,119 @@ |
|||||
--- |
|
||||
output: |
|
||||
md_document: |
|
||||
variant: markdown_github |
|
||||
--- |
|
||||
|
|
||||
<!-- README.md is generated from README.Rmd. Please edit that file --> |
<!-- README.md is generated from README.Rmd. Please edit that file --> |
||||
|
|
||||
|
![Project Status: Concept - Minimal or no implementation has been done |
||||
|
yet.](http://www.repostatus.org/badges/0.1.0/concept.svg) |
||||
|
|
||||
|
# cloc |
||||
|
|
||||
[![Build Status](https://travis-ci.org/hrbrmstr/cloc.svg)](https://travis-ci.org/hrbrmstr/cloc) |
Count Lines of Code, Comments and Whitespace in Source Files and |
||||
![Project Status: Concept - Minimal or no implementation has been done yet.](http://www.repostatus.org/badges/0.1.0/concept.svg)](http://www.repostatus.org/#concept) |
Archives |
||||
[![CRAN_Status_Badge](http://www.r-pkg.org/badges/version/cloc)](http://cran.r-project.org/web/packages/cloc) |
|
||||
![downloads](http://cranlogs.r-pkg.org/badges/grand-total/cloc) |
|
||||
|
|
||||
cloc is ... |
## Description |
||||
|
|
||||
The following functions are implemented: |
Counts blank lines, comment lines, and physical lines of source code in |
||||
|
source files/trees/archives. An R wrapper to the Perl `cloc` utility |
||||
The following data sets are included: |
<https://github.com/AlDanial/cloc> by @AlDanial. |
||||
|
|
||||
### News |
## What’s Inside The Tin |
||||
|
|
||||
- Version released |
The following functions are implemented: |
||||
|
|
||||
### Installation |
- `cloc`: Count lines of code, comments and whitespace in source |
||||
|
files/archives |
||||
|
- `cloc_cran`: Count lines of code (etc) from source packages on CRAN |
||||
|
|
||||
|
## Usage |
||||
|
|
||||
```r |
``` r |
||||
devtools::install_github("hrbrmstr/cloc") |
devtools::install_github("hrbrmstr/cloc") |
||||
``` |
``` |
||||
|
|
||||
|
``` r |
||||
|
|
||||
### Usage |
|
||||
|
|
||||
|
|
||||
```r |
|
||||
library(cloc) |
library(cloc) |
||||
#> Error in library(cloc): there is no package called 'cloc' |
|
||||
|
|
||||
# current verison |
# current verison |
||||
packageVersion("cloc") |
packageVersion("cloc") |
||||
#> Error in packageVersion("cloc"): package 'cloc' not found |
#> [1] '0.1.0' |
||||
``` |
``` |
||||
|
|
||||
### Test Results |
Basic usage |
||||
|
|
||||
|
``` r |
||||
```r |
# by dir |
||||
library(cloc) |
cloc(system.file("extdata", package="cloc")) |
||||
#> Error in library(cloc): there is no package called 'cloc' |
#> # A tibble: 3 x 10 |
||||
library(testthat) |
#> source language file_count file_count_pct loc loc_pct blank_lines blank_line_pct comment_lines comment_line_pct |
||||
#> Loading required package: methods |
#> <chr> <chr> <int> <dbl> <int> <dbl> <int> <dbl> <int> <dbl> |
||||
|
#> 1 extdata C++ 1 0.3333333 142 0.49305556 41 0.62121212 63 0.45652174 |
||||
date() |
#> 2 extdata R 1 0.3333333 138 0.47916667 24 0.36363636 71 0.51449275 |
||||
#> [1] "Tue Jun 30 22:51:36 2015" |
#> 3 extdata Java 1 0.3333333 8 0.02777778 1 0.01515152 4 0.02898551 |
||||
|
|
||||
|
# by file |
||||
|
cloc(system.file("extdata", "App.java", package="cloc")) |
||||
|
#> # A tibble: 1 x 10 |
||||
|
#> source language file_count file_count_pct loc loc_pct blank_lines blank_line_pct comment_lines comment_line_pct |
||||
|
#> <chr> <chr> <int> <dbl> <int> <dbl> <int> <dbl> <int> <dbl> |
||||
|
#> 1 App.java Java 1 1 8 1 1 1 4 1 |
||||
|
|
||||
|
# from a url |
||||
|
cloc("https://rud.is/dl/cloc-1.74.tar.gz") |
||||
|
#> # A tibble: 93 x 10 |
||||
|
#> source language file_count file_count_pct loc loc_pct blank_lines blank_line_pct comment_lines |
||||
|
#> <chr> <chr> <int> <dbl> <int> <dbl> <int> <dbl> <int> |
||||
|
#> 1 cloc-1.74.tar.gz Perl 5 0.017985612 19712 0.59784059 1353 0.4203168686 2430 |
||||
|
#> 2 cloc-1.74.tar.gz YAML 141 0.507194245 2887 0.08755914 1 0.0003106555 141 |
||||
|
#> 3 cloc-1.74.tar.gz Markdown 1 0.003597122 2195 0.06657164 226 0.0702081392 26 |
||||
|
#> 4 cloc-1.74.tar.gz ANTLR Grammar 2 0.007194245 1012 0.03069271 200 0.0621310966 59 |
||||
|
#> 5 cloc-1.74.tar.gz R 3 0.010791367 698 0.02116948 95 0.0295122709 312 |
||||
|
#> 6 cloc-1.74.tar.gz C/C++ Header 1 0.003597122 617 0.01871285 191 0.0593351973 780 |
||||
|
#> 7 cloc-1.74.tar.gz C++ 4 0.014388489 570 0.01728740 132 0.0410065238 173 |
||||
|
#> 8 cloc-1.74.tar.gz Forth 2 0.007194245 529 0.01604392 17 0.0052811432 84 |
||||
|
#> 9 cloc-1.74.tar.gz TypeScript 3 0.010791367 410 0.01243479 52 0.0161540851 39 |
||||
|
#> 10 cloc-1.74.tar.gz Logtalk 1 0.003597122 368 0.01116099 59 0.0183286735 57 |
||||
|
#> # ... with 83 more rows, and 1 more variables: comment_line_pct <dbl> |
||||
|
``` |
||||
|
|
||||
test_dir("tests/") |
Custom CRAN package counter: |
||||
#> Error in library(cloc): there is no package called 'cloc' |
|
||||
|
``` r |
||||
|
cloc_cran(c("archdata", "hrbrthemes", "iptools", "dplyr")) |
||||
|
#> source language file_count file_count_pct loc loc_pct blank_lines blank_line_pct |
||||
|
#> 1 archdata_1.1.tar.gz <NA> 0 0.000000000 0 0.000000000 0 0.000000000 |
||||
|
#> 2 hrbrthemes_0.1.0.tar.gz R 9 0.750000000 360 0.592105263 80 0.544217687 |
||||
|
#> 3 hrbrthemes_0.1.0.tar.gz Markdown 2 0.166666667 140 0.230263158 39 0.265306122 |
||||
|
#> 4 hrbrthemes_0.1.0.tar.gz HTML 1 0.083333333 108 0.177631579 28 0.190476190 |
||||
|
#> 5 iptools_0.4.0.tar.gz JavaScript 2 0.080000000 7952 0.868691282 699 0.716188525 |
||||
|
#> 6 iptools_0.4.0.tar.gz C++ 3 0.120000000 600 0.065545117 109 0.111680328 |
||||
|
#> 7 iptools_0.4.0.tar.gz R 17 0.680000000 341 0.037251475 92 0.094262295 |
||||
|
#> 8 iptools_0.4.0.tar.gz HTML 2 0.080000000 220 0.024033210 51 0.052254098 |
||||
|
#> 9 iptools_0.4.0.tar.gz C/C++ Header 1 0.040000000 41 0.004478916 25 0.025614754 |
||||
|
#> 10 dplyr_0.7.4.tar.gz R 147 0.462264151 12303 0.436245656 2655 0.427398583 |
||||
|
#> 11 dplyr_0.7.4.tar.gz C/C++ Header 125 0.393081761 6816 0.241684987 1826 0.293947199 |
||||
|
#> 12 dplyr_0.7.4.tar.gz C++ 32 0.100628931 4335 0.153712503 795 0.127978107 |
||||
|
#> 13 dplyr_0.7.4.tar.gz HTML 11 0.034591195 3564 0.126374016 367 0.059079202 |
||||
|
#> 14 dplyr_0.7.4.tar.gz Markdown 2 0.006289308 1154 0.040919084 562 0.090470058 |
||||
|
#> 15 dplyr_0.7.4.tar.gz C 1 0.003144654 30 0.001063754 7 0.001126851 |
||||
|
#> comment_lines comment_line_pct pkg |
||||
|
#> 1 0 0.000000000 archdata |
||||
|
#> 2 239 0.995833333 hrbrthemes |
||||
|
#> 3 0 0.000000000 hrbrthemes |
||||
|
#> 4 1 0.004166667 hrbrthemes |
||||
|
#> 5 356 0.262924668 iptools |
||||
|
#> 6 260 0.192023634 iptools |
||||
|
#> 7 531 0.392171344 iptools |
||||
|
#> 8 2 0.001477105 iptools |
||||
|
#> 9 205 0.151403250 iptools |
||||
|
#> 10 3836 0.873406193 dplyr |
||||
|
#> 11 251 0.057149362 dplyr |
||||
|
#> 12 294 0.066939891 dplyr |
||||
|
#> 13 11 0.002504554 dplyr |
||||
|
#> 14 0 0.000000000 dplyr |
||||
|
#> 15 0 0.000000000 dplyr |
||||
``` |
``` |
||||
|
|
||||
### Code of Conduct |
## Code of Conduct |
||||
|
|
||||
Please note that this project is released with a [Contributor Code of Conduct](CONDUCT.md). |
Please note that this project is released with a [Contributor Code of |
||||
By participating in this project you agree to abide by its terms. |
Conduct](CONDUCT.md). By participating in this project you agree to |
||||
|
abide by its terms. |
||||
|
Binary file not shown.
@ -0,0 +1,13 @@ |
|||||
|
package is.rud.melting5; |
||||
|
|
||||
|
/** |
||||
|
* Hello world! |
||||
|
* |
||||
|
*/ |
||||
|
public class App |
||||
|
{ |
||||
|
public static void main( String[] args ) |
||||
|
{ |
||||
|
System.out.println( "Hello World!" ); |
||||
|
} |
||||
|
} |
@ -0,0 +1,233 @@ |
|||||
|
s_head <- purrr::safely(httr::HEAD) |
||||
|
|
||||
|
#' Driver for Drill database. |
||||
|
#' |
||||
|
#' @keywords internal |
||||
|
#' @export |
||||
|
setClass( |
||||
|
"DrillDriver", |
||||
|
contains = "DBIDriver" |
||||
|
) |
||||
|
|
||||
|
#' Unload driver |
||||
|
#' |
||||
|
#' @rdname DrilDriver-class |
||||
|
#' @param drv driver |
||||
|
#' @param ... Extra optional parameters |
||||
|
#' @export |
||||
|
setMethod( |
||||
|
"dbUnloadDriver", |
||||
|
"DrillDriver", |
||||
|
function(drv, ...) { TRUE } |
||||
|
) |
||||
|
|
||||
|
setMethod("show", "DrillDriver", function(object) { |
||||
|
cat("<DrillDriver>\n") |
||||
|
}) |
||||
|
|
||||
|
#' Drill |
||||
|
#' |
||||
|
#' @export |
||||
|
Drill <- function() { |
||||
|
new("DrillDriver") |
||||
|
} |
||||
|
|
||||
|
#' Drill connection class. |
||||
|
#' |
||||
|
#' @export |
||||
|
#' @keywords internal |
||||
|
setClass( |
||||
|
"DrillConnection", |
||||
|
contains = "DBIConnection", |
||||
|
slots = list( |
||||
|
host = "character", |
||||
|
port = "integer", |
||||
|
ssl = "logical", |
||||
|
username = "character", |
||||
|
password = "character" |
||||
|
) |
||||
|
) |
||||
|
|
||||
|
#' Connect to Drill |
||||
|
#' |
||||
|
#' @param drv An object created by \code{Drill()} |
||||
|
#' @rdname Drill |
||||
|
#' @param host host |
||||
|
#' @param port port |
||||
|
#' @param ssl use ssl? |
||||
|
#' @param ... Extra optional parameters |
||||
|
#' @export |
||||
|
setMethod( |
||||
|
"dbConnect", |
||||
|
"DrillDriver", function(drv, host = "localhost", port = 8047L, ssl = FALSE, ...) { |
||||
|
new("DrillConnection", host = host, port = port, ssl = ssl, ...) |
||||
|
} |
||||
|
) |
||||
|
|
||||
|
#' Disconnect from Drill |
||||
|
#' |
||||
|
#' @keywords internal |
||||
|
#' @export |
||||
|
setMethod( |
||||
|
"dbDisconnect", |
||||
|
"DrillConnection", function(conn, ...) { |
||||
|
TRUE |
||||
|
}, |
||||
|
valueClass = "logical" |
||||
|
) |
||||
|
|
||||
|
#' Drill results class. |
||||
|
#' |
||||
|
#' @keywords internal |
||||
|
#' @export |
||||
|
setClass( |
||||
|
"DrillResult", |
||||
|
contains = "DBIResult", |
||||
|
slots = list( |
||||
|
drill_server = "character", |
||||
|
statement = "character" |
||||
|
) |
||||
|
) |
||||
|
|
||||
|
# Create the drill server connection string |
||||
|
cmake_server <- function(conn) { |
||||
|
sprintf("%s://%s:%s", ifelse(conn@ssl[1], "https", "http"), conn@host, conn@port) |
||||
|
} |
||||
|
|
||||
|
#' Send a query to Drill |
||||
|
#' |
||||
|
#' @rdname DrillConnection-class |
||||
|
#' @param conn connection |
||||
|
#' @param statement SQL statement |
||||
|
#' @param ... passed on to methods |
||||
|
#' @aliases dbSendQuery,DrillConnection,character-method |
||||
|
setMethod( |
||||
|
"dbSendQuery", |
||||
|
"DrillConnection", |
||||
|
function(conn, statement, ...) { |
||||
|
|
||||
|
drill_server <- cmake_server(conn) |
||||
|
|
||||
|
new("DrillResult", drill_server=drill_server, statement=statement, ...) |
||||
|
|
||||
|
} |
||||
|
) |
||||
|
|
||||
|
#' Clear |
||||
|
#' |
||||
|
#' @rdname DrillResult-class |
||||
|
#' @export |
||||
|
setMethod( |
||||
|
"dbClearResult", |
||||
|
"DrillResult", |
||||
|
function(res, ...) { TRUE } |
||||
|
) |
||||
|
|
||||
|
#' Retrieve records from Drill query |
||||
|
#' |
||||
|
#' @rdname DrillResult-class |
||||
|
#' @param .progress show data transfer progress? |
||||
|
#' @export |
||||
|
setMethod( |
||||
|
"dbFetch", |
||||
|
"DrillResult", |
||||
|
function(res, .progress=FALSE, ...) { |
||||
|
|
||||
|
if (.progress) { |
||||
|
res <- httr::POST(sprintf("%s/query.json", res@drill_server), |
||||
|
encode="json", progress(), |
||||
|
body=list(queryType="SQL", query=res@statement)) |
||||
|
} else { |
||||
|
res <- httr::POST(sprintf("%s/query.json", res@drill_server), |
||||
|
encode="json", |
||||
|
body=list(queryType="SQL", query=res@statement)) |
||||
|
} |
||||
|
|
||||
|
if (httr::status_code(res) != 200) { |
||||
|
warning(content(res, as="parsed")) |
||||
|
dplyr::data_frame() |
||||
|
} else { |
||||
|
out <- jsonlite::fromJSON(httr::content(res, as="text", encoding="UTF-8"), flatten=TRUE) |
||||
|
out <- suppressMessages(dplyr::tbl_df(readr::type_convert(out$rows))) |
||||
|
out |
||||
|
} |
||||
|
|
||||
|
} |
||||
|
) |
||||
|
|
||||
|
#' Drill dbDataType |
||||
|
#' |
||||
|
#' @param dbObj A \code{\linkS4class{DrillDriver}} object |
||||
|
#' @param obj Any R object |
||||
|
#' @param ... Extra optional parameters |
||||
|
#' @export |
||||
|
setMethod( |
||||
|
"dbDataType", |
||||
|
"DrillConnection", |
||||
|
function(dbObj, obj, ...) { |
||||
|
if (is.integer(obj)) "INTEGER" |
||||
|
else if (inherits(obj, "Date")) "DATE" |
||||
|
else if (identical(class(obj), "times")) "TIME" |
||||
|
else if (inherits(obj, "POSIXct")) "TIMESTAMP" |
||||
|
else if (is.numeric(obj)) "DOUBLE" |
||||
|
else "VARCHAR(255)" |
||||
|
}, |
||||
|
valueClass = "character" |
||||
|
) |
||||
|
|
||||
|
#' Completed |
||||
|
#' |
||||
|
#' @rdname DrillResult-class |
||||
|
#' @export |
||||
|
setMethod( |
||||
|
"dbHasCompleted", |
||||
|
"DrillResult", |
||||
|
function(res, ...) { TRUE } |
||||
|
) |
||||
|
|
||||
|
#' @rdname DrillConnection-class |
||||
|
#' @export |
||||
|
setMethod( |
||||
|
'dbIsValid', |
||||
|
'DrillConnection', |
||||
|
function(dbObj, ...) { |
||||
|
drill_server <- cmake_server(dbObj) |
||||
|
!is.null(s_head(drill_server, httr::timeout(2))$result) |
||||
|
} |
||||
|
) |
||||
|
|
||||
|
#' @rdname DrillConnection-class |
||||
|
#' @export |
||||
|
setMethod( |
||||
|
'dbListFields', |
||||
|
c('DrillConnection', 'character'), |
||||
|
function(conn, name, ...) { |
||||
|
quoted.name <- dbQuoteIdentifier(conn, name) |
||||
|
names(dbGetQuery(conn, paste('SELECT * FROM', quoted.name, 'LIMIT 1'))) |
||||
|
} |
||||
|
) |
||||
|
|
||||
|
#' @rdname DrillResult-class |
||||
|
#' @export |
||||
|
setMethod( |
||||
|
'dbListFields', |
||||
|
signature(conn='DrillResult', name='missing'), |
||||
|
function(conn, name) { |
||||
|
res <- httr::POST(sprintf("%s/query.json", conn@drill_server), |
||||
|
encode="json", |
||||
|
body=list(queryType="SQL", query=conn@statement)) |
||||
|
out <- jsonlite::fromJSON(httr::content(res, as="text", encoding="UTF-8"), flatten=TRUE) |
||||
|
out <- suppressMessages(dplyr::tbl_df(readr::type_convert(out$rows))) |
||||
|
colnames(out) |
||||
|
} |
||||
|
) |
||||
|
|
||||
|
#' Statement |
||||
|
#' |
||||
|
#' @rdname DrillResult-class |
||||
|
#' @export |
||||
|
setMethod( |
||||
|
'dbGetStatement', |
||||
|
'DrillResult', |
||||
|
function(res, ...) { return(res@statement) } |
||||
|
) |
@ -0,0 +1,246 @@ |
|||||
|
#include <Rcpp.h> |
||||
|
#include "qrencode.h" |
||||
|
#include <stdio.h> |
||||
|
#include <unistd.h> |
||||
|
#include <string> |
||||
|
#include <fstream> |
||||
|
#include <streambuf> |
||||
|
|
||||
|
using namespace Rcpp; |
||||
|
|
||||
|
#define INCHES_PER_METER (100.0/2.54) |
||||
|
|
||||
|
static int rle = 1; |
||||
|
static unsigned int fg_color[4] = {0, 0, 0, 255}; |
||||
|
static unsigned int bg_color[4] = {255, 255, 255, 255}; |
||||
|
|
||||
|
//' @md
|
||||
|
//' @title Encodes a string as a QR code
|
||||
|
//' @description Encodes a string as a QR coder
|
||||
|
//' @param to_encode character string to encode
|
||||
|
//' @param version version of the symbol. If `0`, the library chooses the
|
||||
|
//' minimum version for the given input data.
|
||||
|
//' @param level error correction level (`0` - `3`, lowest to highest)
|
||||
|
//' @param hint tell the library how Japanese Kanji characters should be
|
||||
|
//' encoded:
|
||||
|
//' - If "`3`", the library assumes that the given string contains Shift-JIS characters
|
||||
|
//' and encodes them in Kanji-mode.
|
||||
|
//' - If "`2`" is given, all of non-alphanumerical characters will be encoded as is.
|
||||
|
//' If you want to embed UTF-8 string, choose this. Trying to encode UTF-8 with modes will cause an error.
|
||||
|
//' - "`0`" is "numeric mode",
|
||||
|
//' - "`1`" is "alphanumeric mode"
|
||||
|
//' - "`5`" is "ECI mode".
|
||||
|
//' @param caseinsensitive case-sensitive(\code{1}) or not(\code{0}).
|
||||
|
//' @seealso \url{http://www.qrcode.com/en/about/version.html}
|
||||
|
//' @export
|
||||
|
// [[Rcpp::export]]
|
||||
|
NumericMatrix qrencode_raw(std::string to_encode, |
||||
|
int version=0, |
||||
|
int level=0, |
||||
|
int hint=2, |
||||
|
int caseinsensitive=1) { |
||||
|
|
||||
|
QRcode *qrcode ; |
||||
|
unsigned char *row; |
||||
|
int x, y; |
||||
|
|
||||
|
qrcode = QRcode_encodeString(to_encode.c_str(), |
||||
|
version, |
||||
|
(QRecLevel)level, |
||||
|
(QRencodeMode)hint, caseinsensitive); |
||||
|
|
||||
|
NumericMatrix qr(qrcode->width, qrcode->width); |
||||
|
|
||||
|
for(y=0; y <qrcode->width; y++) { |
||||
|
row = qrcode->data+(y*qrcode->width); |
||||
|
for(x = 0; x < qrcode->width; x++) { |
||||
|
qr(x, y) = row[x]&0x1; |
||||
|
} |
||||
|
} |
||||
|
|
||||
|
return(qr); |
||||
|
|
||||
|
} |
||||
|
|
||||
|
static FILE *openFile(const char *outfile) { |
||||
|
FILE *fp; |
||||
|
|
||||
|
if(outfile == NULL || (outfile[0] == '-' && outfile[1] == '\0')) { |
||||
|
fp = stdout; |
||||
|
} else { |
||||
|
fp = fopen(outfile, "wb"); |
||||
|
if (fp == NULL) return(NULL); |
||||
|
} |
||||
|
|
||||
|
return fp; |
||||
|
} |
||||
|
|
||||
|
static void writeSVG_writeRect(FILE *fp, int x, int y, int width, char* col, float opacity) { |
||||
|
if(fg_color[3] != 255) { |
||||
|
fprintf(fp, "\t\t\t<rect x=\"%d\" y=\"%d\" width=\"%d\" height=\"1\" "\ |
||||
|
"fill=\"#%s\" fill-opacity=\"%f\" />\n", |
||||
|
x, y, width, col, opacity ); |
||||
|
} else { |
||||
|
fprintf(fp, "\t\t\t<rect x=\"%d\" y=\"%d\" width=\"%d\" height=\"1\" "\ |
||||
|
"fill=\"#%s\" />\n", |
||||
|
x, y, width, col ); |
||||
|
} |
||||
|
} |
||||
|
|
||||
|
CharacterVector writeSVG(QRcode *qrcode, int margin, int size, int dpi) { |
||||
|
|
||||
|
FILE *fp; |
||||
|
unsigned char *row, *p; |
||||
|
int x, y, x0, pen; |
||||
|
int symwidth, realwidth; |
||||
|
float scale; |
||||
|
char fg[7], bg[7]; |
||||
|
float fg_opacity; |
||||
|
float bg_opacity; |
||||
|
|
||||
|
char fname[L_tmpnam]; |
||||
|
memset(fname, 0, L_tmpnam); |
||||
|
strncpy(fname,"qrencoder-XXXXXX", 16); |
||||
|
|
||||
|
fp = openFile(mktemp(fname)); |
||||
|
|
||||
|
if (fp == NULL) return(R_NilValue); |
||||
|
|
||||
|
scale = dpi * INCHES_PER_METER / 100.0; |
||||
|
|
||||
|
symwidth = qrcode->width + margin * 2; |
||||
|
realwidth = symwidth * size; |
||||
|
|
||||
|
snprintf(fg, 7, "%02x%02x%02x", fg_color[0], fg_color[1], fg_color[2]); |
||||
|
snprintf(bg, 7, "%02x%02x%02x", bg_color[0], bg_color[1], bg_color[2]); |
||||
|
fg_opacity = (float)fg_color[3] / 255; |
||||
|
bg_opacity = (float)bg_color[3] / 255; |
||||
|
|
||||
|
/* XML declaration */ |
||||
|
fputs( "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>\n", fp ); |
||||
|
|
||||
|
/* DTD
|
||||
|
No document type specified because "while a DTD is provided in [the SVG] |
||||
|
specification, the use of DTDs for validating XML documents is known to be |
||||
|
problematic. In particular, DTDs do not handle namespaces gracefully. It |
||||
|
is *not* recommended that a DOCTYPE declaration be included in SVG |
||||
|
documents." |
||||
|
http://www.w3.org/TR/2003/REC-SVG11-20030114/intro.html#Namespace
|
||||
|
*/ |
||||
|
|
||||
|
/* Vanity remark */ |
||||
|
fprintf( fp, "<!-- Created with qrencode %s (http://fukuchi.org/works/qrencode/index.html.en) -->\n", |
||||
|
QRcode_APIVersionString() ); |
||||
|
|
||||
|
/* SVG code start */ |
||||
|
fprintf( fp, "<svg width=\"%0.2fcm\" height=\"%0.2fcm\" viewBox=\"0 0 %d %d\""\ |
||||
|
" preserveAspectRatio=\"none\" version=\"1.1\"" \ |
||||
|
" xmlns=\"http://www.w3.org/2000/svg\">\n", |
||||
|
realwidth / scale, realwidth / scale, symwidth, symwidth |
||||
|
); |
||||
|
|
||||
|
/* Make named group */ |
||||
|
fputs( "\t<g id=\"QRcode\">\n", fp ); |
||||
|
|
||||
|
/* Make solid background */ |
||||
|
if(bg_color[3] != 255) { |
||||
|
fprintf(fp, "\t\t<rect x=\"0\" y=\"0\" width=\"%d\" height=\"%d\" fill=\"#%s\" fill-opacity=\"%f\" />\n", symwidth, symwidth, bg, bg_opacity); |
||||
|
} else { |
||||
|
fprintf(fp, "\t\t<rect x=\"0\" y=\"0\" width=\"%d\" height=\"%d\" fill=\"#%s\" />\n", symwidth, symwidth, bg); |
||||
|
} |
||||
|
|
||||
|
/* Create new viewbox for QR data */ |
||||
|
fputs( "\t\t<g id=\"Pattern\">\n", fp); |
||||
|
|
||||
|
/* Write data */ |
||||
|
p = qrcode->data; |
||||
|
for(y=0; y<qrcode->width; y++) { |
||||
|
row = (p+(y*qrcode->width)); |
||||
|
|
||||
|
if( !rle ) { |
||||
|
/* no RLE */ |
||||
|
for(x=0; x<qrcode->width; x++) { |
||||
|
if(*(row+x)&0x1) { |
||||
|
writeSVG_writeRect(fp, margin + x, |
||||
|
margin + y, 1, |
||||
|
fg, fg_opacity); |
||||
|
} |
||||
|
} |
||||
|
} else { |
||||
|
/* simple RLE */ |
||||
|
pen = 0; |
||||
|
x0 = 0; |
||||
|
for(x=0; x<qrcode->width; x++) { |
||||
|
if( !pen ) { |
||||
|
pen = *(row+x)&0x1; |
||||
|
x0 = x; |
||||
|
} else { |
||||
|
if(!(*(row+x)&0x1)) { |
||||
|
writeSVG_writeRect(fp, x0 + margin, y + margin, x-x0, fg, fg_opacity); |
||||
|
pen = 0; |
||||
|
} |
||||
|
} |
||||
|
} |
||||
|
if( pen ) { |
||||
|
writeSVG_writeRect(fp, x0 + margin, y + margin, qrcode->width - x0, fg, fg_opacity); |
||||
|
} |
||||
|
} |
||||
|
} |
||||
|
/* Close QR data viewbox */ |
||||
|
fputs( "\t\t</g>\n", fp ); |
||||
|
|
||||
|
/* Close group */ |
||||
|
fputs( "\t</g>\n", fp ); |
||||
|
|
||||
|
/* Close SVG code */ |
||||
|
fputs( "</svg>\n", fp ); |
||||
|
fclose( fp ); |
||||
|
|
||||
|
std::ifstream t(fname); |
||||
|
std::string str((std::istreambuf_iterator<char>(t)), |
||||
|
std::istreambuf_iterator<char>()); |
||||
|
|
||||
|
t.close(); |
||||
|
|
||||
|
unlink(fname); |
||||
|
|
||||
|
return(Rcpp::wrap(str)); |
||||
|
|
||||
|
} |
||||
|
|
||||
|
//' @md
|
||||
|
//' @title Return a QR encoded string as an svg string
|
||||
|
//' @description Encodes a string as a QR coder
|
||||
|
//' @param to_encode character string to encode
|
||||
|
//' @param version version of the symbol. If `0`, the library chooses the
|
||||
|
//' minimum version for the given input data.
|
||||
|
//' @param level error correction level (`0` - `3`, lowest to highest)
|
||||
|
//' @param hint tell the library how Japanese Kanji characters should be
|
||||
|
//' encoded:
|
||||
|
//' - If "`3`", the library assumes that the given string contains Shift-JIS characters
|
||||
|
//' and encodes them in Kanji-mode.
|
||||
|
//' - If "`2`" is given, all of non-alphanumerical characters will be encoded as is.
|
||||
|
//' If you want to embed UTF-8 string, choose this. Trying to encode UTF-8 with modes will cause an error.
|
||||
|
//' - "`0`" is "numeric mode",
|
||||
|
//' - "`1" is "alphanumeric mode"
|
||||
|
//' - "`5`" is "ECI mode".
|
||||
|
//' @param caseinsensitive case-sensitive(`1`) or not(`0`).
|
||||
|
//' @param margin width of the marginsl default is 4
|
||||
|
//' @param size module size in dots (pixels); default is 3
|
||||
|
//' @param dpi resolution; default = 72
|
||||
|
//' @seealso \url{http://www.qrcode.com/en/about/version.html}
|
||||
|
//' @export
|
||||
|
// [[Rcpp::export]]
|
||||
|
CharacterVector qrencode_svg( |
||||
|
std::string to_encode, |
||||
|
int version=0, int level=0, int hint=2, |
||||
|
int caseinsensitive=1, int margin = 0, int size = 3, int dpi = 72) { |
||||
|
|
||||
|
QRcode *qrcode ; |
||||
|
|
||||
|
qrcode = QRcode_encodeString(to_encode.c_str(), |
||||
|
version, |
||||
|
(QRecLevel)level, |
||||
|
(QRencodeMode)hint, caseinsensitive); |
||||
|
return(writeSVG(qrcode, margin, size, dpi)); |
||||
|
} |
@ -1,23 +1,36 @@ |
|||||
% Generated by roxygen2 (4.1.1): do not edit by hand |
% Generated by roxygen2: do not edit by hand |
||||
% Please edit documentation in R/cloc.R |
% Please edit documentation in R/cloc-cran.r |
||||
\name{cloc_cran} |
\name{cloc_cran} |
||||
\alias{cloc_cran} |
\alias{cloc_cran} |
||||
\title{Count lines of code (etc) from source packages on CRAN} |
\title{Count lines of code (etc) from source packages on CRAN} |
||||
\usage{ |
\usage{ |
||||
cloc_cran(pkgs, repos = getOption("repos"), contriburl = contrib.url(repos, |
cloc_cran(pkgs, repos = getOption("repos"), |
||||
"source")) |
contrib_url = utils::ontrib.url(repos, "source"), |
||||
|
.progress = interactive()) |
||||
} |
} |
||||
\arguments{ |
\arguments{ |
||||
\item{pkgs}{names of pkgs} |
\item{pkgs}{names of packages} |
||||
|
|
||||
\item{repos}{repos} |
\item{repos}{character vector, the base URL(s) of the repositories to use, |
||||
|
i.e., the URL of the CRAN master such as "\code{https://cran.r-project.org}" |
||||
|
or its Statlib mirror, "\code{http://lib.stat.cmu.edu/R/CRAN}".} |
||||
|
|
||||
\item{contriburl}{} |
\item{contrib_url}{URL(s) of the contrib sections of the repositories. Use |
||||
|
this argument only if your repository mirror is incomplete, e.g., |
||||
|
because you burned only the ‘contrib’ section on a CD. Overrides |
||||
|
argument repos.} |
||||
|
|
||||
|
\item{.progress}{show a progress bar? Default: \code{TRUE} if running interactively.} |
||||
} |
} |
||||
\value{ |
\value{ |
||||
\code{tbl_df} |
tibble |
||||
} |
} |
||||
\description{ |
\description{ |
||||
Count lines of code (etc) from source packages on CRAN |
Count lines of code (etc) from source packages on CRAN |
||||
} |
} |
||||
|
\examples{ |
||||
|
# requires a network connection therefore is set for you to run it manually |
||||
|
\dontrun{ |
||||
|
cloc_cran(c("archdata", "hrbrthemes", "iptools", "dplyr")) |
||||
|
} |
||||
|
} |
||||
|
Loading…
Reference in new issue