File-RsyBak
view release on metacpan or search on metacpan
script/rsybak view on Meta::CPAN
# },
# args_as => 'array',
# result => {
# schema => 'str*',
# },
# result_naked => 1,
#};
#sub rgb_to_ansi_bg_code {
# my ($rgb) = @_;
# my $cd = _color_depth();
# if ($cd >= 2**24) {
# rgb_to_ansi24b_bg_code($rgb);
# } elsif ($cd >= 256) {
# rgb_to_ansi256_bg_code($rgb);
# } else {
# rgb_to_ansi16_bg_code($rgb);
# }
#}
#
#sub ansibg { goto &rgb_to_ansi_bg_code }
#
#sub ansi_reset { "\e[0m" }
#
#1;
#
#__END__
#
### Complete/Bash.pm ###
#package Complete::Bash;
#
#our $DATE = '2018-10-10';
#our $VERSION = '0.320';
#
#use 5.010001;
#use strict;
#use warnings;
#use Log::ger;
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
# point
# parse_cmdline
# join_wordbreak_words
# format_completion
# );
#
#our %SPEC;
#
#$SPEC{':package'} = {
# v => 1.1,
# summary => 'Completion routines for bash shell',
#};
#
#sub _expand_tilde {
# my ($user, $slash) = @_;
# my @ent;
# if (length $user) {
# @ent = getpwnam($user);
# } else {
# @ent = getpwuid($>);
# $user = $ent[0];
# }
# return $ent[7] . $slash if @ent;
# "~$user$slash";
#}
#
#sub _add_unquoted {
# no warnings 'uninitialized';
#
# my ($word, $is_cur_word, $after_ws) = @_;
#
#
# $word =~ s!^(~)(\w*)(/|\z) | # 1) tilde 2) username 3) optional slash
# \\(.) | # 4) escaped char
# \$(\w+) # 5) variable name
# !
# $1 ? (not($after_ws) || $is_cur_word ? "$1$2$3" : _expand_tilde($2, $3)) :
# $4 ? $4 :
# ($is_cur_word ? "\$$5" : $ENV{$5})
# !egx;
# $word;
#}
#
#sub _add_double_quoted {
# no warnings 'uninitialized';
#
# my ($word, $is_cur_word) = @_;
#
# $word =~ s!\\(.) | # 1) escaped char
# \$(\w+) # 2) variable name
# !
# $1 ? $1 :
# ($is_cur_word ? "\$$2" : $ENV{$2})
# !egx;
# $word;
#}
#
#sub _add_single_quoted {
# my $word = shift;
# $word =~ s/\\(.)/$1/g;
# $word;
#}
#
#$SPEC{point} = {
# v => 1.1,
# summary => 'Return line with point marked by a marker',
# description => <<'_',
#
#This is a utility function useful for testing/debugging. `parse_cmdline()`
#expects a command-line and a cursor position (`$line`, `$point`). This routine
#expects `$line` with a marker character (by default it's the caret, `^`) and
#return (`$line`, `$point`) to feed to `parse_cmdline()`.
#
#Example:
#
# point("^foo") # => ("foo", 0)
# point("fo^o") # => ("foo", 2)
#
#_
# args_as => 'array',
script/rsybak view on Meta::CPAN
# )?
# \z/x or return ("Invalid syntax in braced hash value");
# my $res; $res = [
# '{',
# '',
# $1,
# $2,
# $3,
# $4,
# ] if $needs_res;
# my $decode_res = $self->_decode_json("{$1}");
# return ($decode_res->[1]) unless $decode_res->[0] == 200;
# return (undef, $res, $decode_res->[2]);
#
# } elsif ($val =~ /\A~/ && $self->{enable_tilde}) {
#
# $val =~ /\A
# ~(.*)
# (\s*)
# (?: ([;#])(.*) )?
# \z/x or return ("Invalid syntax in path value");
# my $res; $res = [
# '~',
# '',
# $1,
# $2,
# $3,
# $4,
# ] if $needs_res;
#
# my $decode_res = $self->_decode_path_or_paths($val, 'path');
# return ($decode_res->[1]) unless $decode_res->[0] == 200;
# return (undef, $res, $decode_res->[2]);
#
# } else {
#
# $val =~ /\A
# (.*?)
# (\s*)
# (?: ([#;])(.*) )?
# \z/x or return ("Invalid syntax in value");
# my $res; $res = [
# '',
# '',
# $1,
# $2,
# $3,
# $4,
# ] if $needs_res;
# return (undef, $res, $1);
#
# }
#}
#
#sub _get_my_user_name {
# if ($^O eq 'MSWin32') {
# return $ENV{USERNAME};
# } else {
# return $ENV{USER} if $ENV{USER};
# my @pw;
# eval { @pw = getpwuid($>) };
# return $pw[0] if @pw;
# }
#}
#
#sub _get_my_home_dir {
# if ($^O eq 'MSWin32') {
# return $ENV{HOME} if $ENV{HOME};
# return $ENV{USERPROFILE} if $ENV{USERPROFILE};
# return join($ENV{HOMEDRIVE}, "\\", $ENV{HOMEPATH})
# if $ENV{HOMEDRIVE} && $ENV{HOMEPATH};
# } else {
# return $ENV{HOME} if $ENV{HOME};
# my @pw;
# eval { @pw = getpwuid($>) };
# return $pw[7] if @pw;
# }
#
# die "Can't get home directory";
#}
#
#sub _get_user_home_dir {
# my ($name) = @_;
#
# if ($^O eq 'MSWin32') {
# return undef;
# } else {
# if ($name eq getpwuid($<)) {
# return _get_my_home_dir();
# }
#
# SCOPE: {
# my $home = (getpwnam($name))[7];
# return $home if $home and -d $home;
# }
#
# return undef;
# }
#
#}
#
#sub _decode_json {
# my ($self, $val) = @_;
# state $json = do {
# if (eval { require Cpanel::JSON::XS; 1 }) {
# Cpanel::JSON::XS->new->allow_nonref;
# } else {
# require JSON::PP;
# JSON::PP->new->allow_nonref;
# }
# };
# my $res;
# eval { $res = $json->decode($val) };
# if ($@) {
# return [500, "Invalid JSON: $@"];
# } else {
# return [200, "OK", $res];
# }
#}
#
#sub _decode_path_or_paths {
# my ($self, $val, $which) = @_;
#
# if ($val =~ m!\A~([^/]+)?(?:/|\z)!) {
# my $home_dir = length($1) ?
# _get_user_home_dir($1) : _get_my_home_dir();
# unless ($home_dir) {
# if (length $1) {
# return [500, "Can't get home directory for user '$1' in path"];
# } else {
# return [500, "Can't get home directory for current user in path"];
# }
# }
# $val =~ s!\A~([^/]+)?!$home_dir!;
# }
# $val =~ s!(?<=.)/\z!!;
#
# if ($which eq 'path') {
# return [200, "OK", $val];
# } else {
# return [200, "OK", [glob $val]];
# }
#}
#
#sub _decode_hex {
# my ($self, $val) = @_;
# [200, "OK", pack("H*", $val)];
#}
script/rsybak view on Meta::CPAN
#use Math::BigFloat;
#
#use Exporter qw(import);
#our @EXPORT_OK = qw(
# format_number
# );
#
#sub format_number {
# my ($num, $opts) = @_;
# $opts //= {};
#
# $opts->{thousands_sep} //= ',';
# $opts->{decimal_point} //= '.';
# $opts->{decimal_digits} //= 2;
#
# my $str = Math::BigFloat->new($num)->round(0, -$opts->{decimal_digits});
# my ($sign, $int, $decpoint, $frac) =
# $str =~ /\A(-?)([0-9]+)(\.?)([0-9]*)\z/
# or return $num;
#
# $int =~ s/(?<=[0-9])(?=([0-9]{3})+(?![0-9]))/$opts->{thousands_sep}/g
# if length $opts->{thousands_sep};
#
# $decpoint = $opts->{decimal_point}
# if length $decpoint;
#
# "$sign$int$decpoint$frac";
#}
#
#1;
#
#__END__
#
### PERLANCAR/File/HomeDir.pm ###
#package PERLANCAR::File::HomeDir;
#
#our $DATE = '2018-09-20';
#our $VERSION = '0.060';
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Exporter qw(import);
#our @EXPORT_OK = qw(
# get_my_home_dir
# get_user_home_dir
# );
#
#our $DIE_ON_FAILURE = 0;
#
#sub get_my_home_dir {
# if ($^O eq 'MSWin32') {
# return $ENV{HOME} if $ENV{HOME};
# return $ENV{USERPROFILE} if $ENV{USERPROFILE};
# return join($ENV{HOMEDRIVE}, "\\", $ENV{HOMEPATH})
# if $ENV{HOMEDRIVE} && $ENV{HOMEPATH};
# } else {
# return $ENV{HOME} if $ENV{HOME};
# my @pw;
# eval { @pw = getpwuid($>) };
# return $pw[7] if @pw;
# }
#
# if ($DIE_ON_FAILURE) {
# die "Can't get home directory";
# } else {
# return undef;
# }
#}
#
#sub get_user_home_dir {
# my ($name) = @_;
#
# if ($^O eq 'MSWin32') {
# return undef;
# } else {
# if ($name eq getpwuid($<)) {
# return get_my_home_dir();
# }
#
# SCOPE: {
# my $home = (getpwnam($name))[7];
# return $home if $home and -d $home;
# }
#
# return undef;
# }
#
#}
#
#1;
#
#__END__
#
### Perinci/Access/Lite.pm ###
#package Perinci::Access::Lite;
#
#our $DATE = '2016-09-25';
#our $VERSION = '0.14';
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Perinci::AccessUtil qw(strip_riap_stuffs_from_res);
#
#sub new {
# my ($class, %args) = @_;
# $args{riap_version} //= 1.1;
# bless \%args, $class;
#}
#
#sub __package_exists {
# no strict 'refs';
#
# my $pkg = shift;
#
# return unless $pkg =~ /\A\w+(::\w+)*\z/;
# if ($pkg =~ s/::(\w+)\z//) {
# return !!${$pkg . "::"}{$1 . "::"};
# } else {
# return !!$::{$pkg . "::"};
# }
#}
#
#sub request {
# no strict 'refs';
#
# my ($self, $action, $url, $extra) = @_;
#
#
# $extra //= {};
#
# my $v = $extra->{v} // 1.1;
# if ($v ne '1.1' && $v ne '1.2') {
# return [501, "Riap protocol not supported, must be 1.1 or 1.2"];
# }
script/rsybak view on Meta::CPAN
# );
#
# $res->[3]{"cmdline.skip_format"} = 1;
# $res;
#}
#
#sub action_call {
# my ($self, $r) = @_;
#
# my %extra;
# if ($r->{send_argv}) {
# log_trace("[pericmd] Sending argv to server: %s", $extra{argv});
# $extra{argv} = $r->{orig_argv};
# } else {
# my %extra_args;
# $extra_args{-dry_run} = 1 if $r->{dry_run};
# $extra{args} = {%extra_args, %{$r->{args}}};
# }
#
# $extra{stream_arg} = 1 if $r->{stream_arg};
#
# my $url = $r->{subcommand_data}{url};
#
# log_trace("[pericmd] Riap request: action=call, url=%s", $url);
#
#
# if ($r->{meta}{features}{progress}) {
# $self->_setup_progress_output;
# }
#
# $self->riap_client->request(
# call => $url, \%extra);
#}
#
#1;
#
#__END__
#
### Perinci/CmdLine/Util/Config.pm ###
#package Perinci::CmdLine::Util::Config;
#
#our $DATE = '2018-03-05';
#our $VERSION = '1.721';
#
#use 5.010001;
#use strict;
#use warnings;
#use Log::ger;
#
#our %SPEC;
#
#sub _get_my_home_dir {
# if ($^O eq 'MSWin32') {
# return $ENV{HOME} if $ENV{HOME};
# return $ENV{USERPROFILE} if $ENV{USERPROFILE};
# return join($ENV{HOMEDRIVE}, "\\", $ENV{HOMEPATH})
# if $ENV{HOMEDRIVE} && $ENV{HOMEPATH};
# } else {
# return $ENV{HOME} if $ENV{HOME};
# my @pw;
# eval { @pw = getpwuid($>) };
# return $pw[7] if @pw;
# }
# die "Can't get home directory";
#}
#
#$SPEC{get_default_config_dirs} = {
# v => 1.1,
# args => {},
#};
#sub get_default_config_dirs {
# my @dirs;
# my $home = _get_my_home_dir();
# if ($^O eq 'MSWin32') {
# push @dirs, $home;
# } else {
# push @dirs, "$home/.config", $home, "/etc";
# }
# \@dirs;
#}
#
#$SPEC{read_config} = {
# v => 1.1,
# args => {
# config_paths => {},
# config_filename => {},
# config_dirs => {},
# program_name => {},
# hook_section => {},
# },
#};
#sub read_config {
# require Config::IOD::Reader;
#
# my %args = @_;
#
# my $config_dirs = $args{config_dirs} // get_default_config_dirs();
#
# my $paths;
#
# my @filenames;
# my %section_config_filename_map;
# if (my $names = $args{config_filename}) {
# for my $name (ref($names) eq 'ARRAY' ? @$names : ($names)) {
# if (ref($name) eq 'HASH') {
# $section_config_filename_map{$name->{filename}} = $name->{section};
# push @filenames, $name->{filename};
# } else {
# $section_config_filename_map{$name} = 'GLOBAL';
# push @filenames, $name;
# }
# }
# }
# unless (@filenames) {
# @filenames = (($args{program_name} // "prog") . ".conf");
# }
#
# if ($args{config_paths}) {
# $paths = $args{config_paths};
# } else {
# for my $dir (@$config_dirs) {
( run in 0.641 second using v1.01-cache-2.11-cpan-e1769b4cff6 )