17 changed files with 839 additions and 157 deletions
@ -1,10 +1,24 @@ |
|||
Package: cloc |
|||
Title: Count Lines of Code, Comments and Whitespace in Source Files and Archives |
|||
Version: 0.0.0.9000 |
|||
Authors@R: c(person("Bob", "Rudis", email = "bob@rudis.net", role = c("aut", "cre"))) |
|||
Description: Count lines of code! |
|||
Imports: R.utils, utils, dplyr, pbapply |
|||
Depends: R (>= 3.2.0) |
|||
Version: 0.1.0 |
|||
Authors@R: c( |
|||
person("Bob", "Rudis", email = "bob@rud.is", role = c("aut", "cre"), |
|||
comment = c(ORCID = "0000-0001-5670-2640")), |
|||
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 |
|||
LazyData: true |
|||
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_cran) |
|||
importFrom(R.utils,isUrl) |
|||
importFrom(dplyr,bind_rows) |
|||
importFrom(dplyr,rbind_list) |
|||
importFrom(dplyr,tbl_df) |
|||
importFrom(pbapply,pblapply) |
|||
importFrom(dplyr,progress_estimated) |
|||
importFrom(utils,contrib.url) |
|||
importFrom(utils,download.file) |
|||
importFrom(utils,download.packages) |
|||
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 |
|||
#' @docType package |
|||
#' @author Bob Rudis (@@hrbrmstr) |
|||
#' @author Bob Rudis (bob@@rud.is) |
|||
#' @importFrom R.utils isUrl |
|||
#' @importFrom utils read.table |
|||
#' @importFrom dplyr tbl_df |
|||
#' @importFrom dplyr bind_rows |
|||
#' @importFrom dplyr rbind_list |
|||
#' @importFrom pbapply pblapply |
|||
#' @importFrom utils read.table contrib.url download.file download.packages tail |
|||
#' @importFrom dplyr bind_rows progress_estimated |
|||
NULL |
|||
|
|||
@ -1,78 +1,104 @@ |
|||
#' Count lines of code, comments and whitespace in source files/archives |
|||
#' |
|||
#' @param source thing to extract from |
|||
#' @param extract_with thing |
|||
#' @return \code{tbl_df} |
|||
#' @param source file, directory or archive to read from |
|||
#' @param extract_with passed into `cloc` command line. This option is only |
|||
#' needed if cloc is unable to figure out how to extract the contents of |
|||
#' the input file(s) by itself. |
|||
#' @return tibble |
|||
#' @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) { |
|||
|
|||
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() |
|||
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)) |
|||
on.exit(unlink(source), add = TRUE) |
|||
} |
|||
|
|||
stopifnot(file.exists(source)) |
|||
|
|||
cmd <- sprintf("perl %s --quiet --csv %s", |
|||
system.file("bin/cloc.pl", package="cloc"), |
|||
source) |
|||
# make the command line |
|||
|
|||
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"), |
|||
col.names=c("file_count", "language", "blank_lines", |
|||
"comment_lines", "loc"), |
|||
sep=",", stringsAsFactors=FALSE) |
|||
# run the perl script |
|||
dat <- system(cmd, intern = TRUE) |
|||
|
|||
# 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 |
|||
|
|||
fil$source <- basename(source) |
|||
fil$file_count_pct <- fil$file_count / sum(fil$file_count) |
|||
fil$blank_line_pct <- fil$blank_lines / sum(fil$blank_lines) |
|||
fil$comment_line_pct <- fil$comment_lines / sum(fil$comment_lines) |
|||
fil$loc_pct <- fil$loc / sum(fil$loc) |
|||
|
|||
tbl_df(fil[, c("source", "language", |
|||
"file_count", "file_count_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 |
|||
})) |
|||
# reorganize columns |
|||
fil <- fil[, c( |
|||
"source", "language", |
|||
"file_count", "file_count_pct", |
|||
"loc", "loc_pct", |
|||
"blank_lines", "blank_line_pct", |
|||
"comment_lines", "comment_line_pct" |
|||
)] |
|||
|
|||
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 --> |
|||
|
|||
 |
|||
|
|||
# cloc |
|||
|
|||
[](https://travis-ci.org/hrbrmstr/cloc) |
|||
](http://www.repostatus.org/#concept) |
|||
[](http://cran.r-project.org/web/packages/cloc) |
|||
 |
|||
Count Lines of Code, Comments and Whitespace in Source Files and |
|||
Archives |
|||
|
|||
cloc is ... |
|||
## Description |
|||
|
|||
The following functions are implemented: |
|||
|
|||
The following data sets are included: |
|||
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. |
|||
|
|||
### 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") |
|||
``` |
|||
|
|||
|
|||
|
|||
### Usage |
|||
|
|||
|
|||
```r |
|||
``` r |
|||
library(cloc) |
|||
#> Error in library(cloc): there is no package called 'cloc' |
|||
|
|||
# current verison |
|||
packageVersion("cloc") |
|||
#> Error in packageVersion("cloc"): package 'cloc' not found |
|||
#> [1] '0.1.0' |
|||
``` |
|||
|
|||
### Test Results |
|||
|
|||
|
|||
```r |
|||
library(cloc) |
|||
#> Error in library(cloc): there is no package called 'cloc' |
|||
library(testthat) |
|||
#> Loading required package: methods |
|||
|
|||
date() |
|||
#> [1] "Tue Jun 30 22:51:36 2015" |
|||
Basic usage |
|||
|
|||
``` r |
|||
# by dir |
|||
cloc(system.file("extdata", package="cloc")) |
|||
#> # A tibble: 3 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 extdata C++ 1 0.3333333 142 0.49305556 41 0.62121212 63 0.45652174 |
|||
#> 2 extdata R 1 0.3333333 138 0.47916667 24 0.36363636 71 0.51449275 |
|||
#> 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/") |
|||
#> Error in library(cloc): there is no package called 'cloc' |
|||
Custom CRAN package counter: |
|||
|
|||
``` 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). |
|||
By participating in this project you agree to abide by its terms. |
|||
Please note that this project is released with a [Contributor Code of |
|||
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 |
|||
% Please edit documentation in R/cloc.R |
|||
% Generated by roxygen2: do not edit by hand |
|||
% Please edit documentation in R/cloc-cran.r |
|||
\name{cloc_cran} |
|||
\alias{cloc_cran} |
|||
\title{Count lines of code (etc) from source packages on CRAN} |
|||
\usage{ |
|||
cloc_cran(pkgs, repos = getOption("repos"), contriburl = contrib.url(repos, |
|||
"source")) |
|||
cloc_cran(pkgs, repos = getOption("repos"), |
|||
contrib_url = utils::ontrib.url(repos, "source"), |
|||
.progress = interactive()) |
|||
} |
|||
\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{ |
|||
\code{tbl_df} |
|||
tibble |
|||
} |
|||
\description{ |
|||
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