Nothing
truncate_address <- function(x, max_width, ellipsis) {
width_ellipsis <- pillar::get_extent(ellipsis)
width_x <- pillar::get_extent(x)
width_shown <- max_width - width_ellipsis
too_wide <- which(!is.na(x) & width_x > max_width)
x[too_wide] <- paste0(
substr(x[too_wide], 1, ceiling(width_shown / 2)),
ellipsis,
substr(x[too_wide], width_x[too_wide] - floor(width_shown / 2) + 1, width_x[too_wide])
)
x
}
pretty_address <- function(addr) {
addr <- gsub(".", pillar::style_subtle("."), addr, fixed = TRUE)
addr <- gsub(":", pillar::style_subtle(":"), addr, fixed = TRUE)
addr
}
pretty_cidr <- function(addr, pfx) {
out <- paste0(
pillar::align(pretty_address(addr), align = "right"),
crayon::green(paste0(
"/",
pillar::align(pfx, align = "left")
))
)
out[is.na(addr)] <- NA
out
}
pillar_shaft_ipaddress <- function(addr, pfx) {
is_cidr <- !is.null(pfx)
addr <- as.character(addr)
pfx <- as.character(pfx)
# require longest IPv4 address/network can be shown
min_address_width <- 15
if (is_cidr) {
width <- pillar::get_max_extent(paste0(addr, "/", pfx))
min_width <- min_address_width + 3
} else {
width <- pillar::get_max_extent(addr)
min_width <- min_address_width
}
pillar::new_pillar_shaft(
list(addr = addr, pfx = pfx),
is_cidr = is_cidr,
width = width,
min_width = pmin(min_width, width),
class = "pillar_shaft_ipaddress"
)
}
#' @export
format.pillar_shaft_ipaddress <- function(x, width, ...) {
min_width <- attr(x, "min_width")
if (width < min_width) {
cli::cli_abort("Need at least width {.val min_width}, requested {.val width}.")
}
is_cidr <- attr(x, "is_cidr")
desired_width <- attr(x, "width")
if (width < desired_width) {
width_address <- if (is_cidr) {
width - pillar::get_max_extent(x$pfx) - 1
} else {
width
}
x$addr <- truncate_address(x$addr, width_address, ellipsis = "...")
}
ornament <- if (is_cidr) {
pretty_cidr(x$addr, x$pfx)
} else {
pretty_address(x$addr)
}
ornament[is.na(ornament)] <- pillar::style_na("NA")
pillar::new_ornament(ornament, align = "right")
}
# Dynamically exported, see zzz.R
pillar_shaft.ip_address <- function(x, ...) {
pillar_shaft_ipaddress(
addr = x,
pfx = NULL
)
}
pillar_shaft.ip_network <- function(x, ...) {
pillar_shaft_ipaddress(
addr = network_address(x),
pfx = prefix_length(x)
)
}
pillar_shaft.ip_interface <- function(x, ...) {
pillar_shaft_ipaddress(
addr = as_ip_address(x),
pfx = prefix_length(x)
)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.