App-reposdb
view release on metacpan or search on metacpan
script/_reposdb-inline view on Meta::CPAN
#
#This function is not exported by default, but exportable.
#
#Arguments ('*' denotes required arguments):
#
#=over 4
#
#=item * B<$cmdline> => I<str>
#
#Command-line which contains a marker character.
#
#=item * B<$marker> => I<str> (default: "^")
#
#Marker character.
#
#
#=back
#
#Return value: (any)
#
#=head1 ENVIRONMENT
#
#=head2 COMPLETE_BASH_DEFAULT_ESC_MODE
#
#Str. To provide default for the C<esc_mode> option in L</format_completion>.
#
#=head2 COMPLETE_BASH_FZF
#
#Bool. Whether to pass large completion answer to fzf instead of directly passing
#it to bash and letting bash page it with a simpler more-like internal pager. By
#default, large is defined as having at least 100 items (same bash's
#C<completion-query-items> setting). This can be configured via
#L</COMPLETE_BASH_FZF_ITEMS>.
#
#=head2 COMPLETE_BASH_FZF_ITEMS
#
#Uint. Default 100. The minimum number of items to trigger passing completion
#answer to fzf. See also: L</COMPLETE_BASH_FZF>.
#
#=head2 COMPLETE_BASH_MAX_COLUMNS
#
#Uint.
#
#Bash will show completion entries in one or several columns, depending on the
#terminal width and the length of the entries (much like a standard non-long
#`ls`). If you prefer completion entries to be shown in a single column no matter
#how wide your terminal is, or how short the entries are, you can set the value
#of this variable to 1. If you prefer a maximum of two columns, set to 2, and so
#on. L</format_completion> will pad the entries with sufficient spaces to limit
#the number of columns.
#
#=head2 COMPLETE_BASH_SHOW_SUMMARIES
#
#Bool. Will set the default for C<show_summaries> option in
#L</format_completion>.
#
#=head2 COMPLETE_BASH_SUMMARY_ALIGN
#
#String. Either C<left> (the default) or C<right>.
#
#The C<left> align looks something like this:
#
# --bar Summary about the bar option
# --baz Summary about the baz option
# --foo Summary about the foo option
# --schapen Summary about the schapen option
#
#The C<right> align will make the completion answer look like what you see in the
#B<fish> shell:
#
# --bar Summary about the bar option
# --baz Summary about the baz option
# --foo Summary about the foo option
# --schapen Summary about the schapen option
#
#=head2 COMPLETE_BASH_TRACE
#
#Bool. If set to true, will produce more log statements to L<Log::ger>.
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Complete-Bash>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Complete-Bash>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Complete-Bash>
#
#When submitting a bug or request, please include a test-file or a
#patch to an existing test-file that illustrates the bug or desired
#feature.
#
#=head1 SEE ALSO
#
#L<Complete>, the convention that this module follows.
#
#Some higher-level modules that use this module (so you don't have to use this
#module directly): L<Getopt::Long::Complete> (via L<Complete::Getopt::Long>),
#L<Getopt::Long::Subcommand>, L<Perinci::CmdLine> (via
#L<Perinci::Sub::Complete>).
#
#Other modules related to bash shell tab completion: L<Bash::Completion>,
#L<Getopt::Complete>, L<Term::Bash::Completion::Generator>.
#
#Programmable Completion section in Bash manual:
#L<https://www.gnu.org/software/bash/manual/html_node/Programmable-Completion.html>
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2020, 2019, 2018, 2016, 2015, 2014 by perlancar@cpan.org.
#
#This is free software; you can redistribute it and/or modify it under
#the same terms as the Perl 5 programming language system itself.
#
script/_reposdb-inline view on Meta::CPAN
#Clean $data. Modify data in-place.
#
#=head2 $obj->clone_and_clean($data) => $cleaned
#
#Clean $data. Clone $data first.
#
#=head1 FAQ
#
#=head2 Why am I getting 'Modification of a read-only value attempted at lib/Data/Clean.pm line xxx'?
#
#[2013-10-15 ] This is also from Data::Clone::clone() when it encounters
#JSON::{PP,XS}::Boolean objects. You can use clean_in_place() instead of
#clone_and_clean(), or clone your data using other cloner like L<Sereal>.
#
#=head1 ENVIRONMENT
#
#LOG_CLEANSER_CODE
#
#=head1 HOMEPAGE
#
#Please visit the project's homepage at L<https://metacpan.org/release/Data-Clean-ForJSON>.
#
#=head1 SOURCE
#
#Source repository is at L<https://github.com/perlancar/perl-Data-Clean-ForJSON>.
#
#=head1 BUGS
#
#Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Clean-ForJSON>
#
#When submitting a bug or request, please include a test-file or a
#patch to an existing test-file that illustrates the bug or desired
#feature.
#
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2019, 2018, 2017, 2016, 2015, 2014, 2013, 2012 by perlancar@cpan.org.
#
#This is free software; you can redistribute it and/or modify it under
#the same terms as the Perl 5 programming language system itself.
#
#=cut
### Data/Dmp.pm ###
### no critic: Modules::ProhibitAutomaticExportation
#
#package Data::Dmp;
#
#our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
#our $DATE = '2020-04-07'; # DATE
#our $DIST = 'Data-Dmp'; # DIST
#our $VERSION = '0.240'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Scalar::Util qw(looks_like_number blessed reftype refaddr);
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT = qw(dd dmp);
#our @EXPORT_OK = qw(dd_ellipsis dmp_ellipsis);
#
## for when dealing with circular refs
#our %_seen_refaddrs;
#our %_subscripts;
#our @_fixups;
#
#our $OPT_MAX_DUMP_LEN_BEFORE_ELLIPSIS = 70;
#our $OPT_PERL_VERSION = "5.010";
#our $OPT_REMOVE_PRAGMAS = 0;
#our $OPT_DEPARSE = 1;
#our $OPT_STRINGIFY_NUMBERS = 0;
#
## BEGIN COPY PASTE FROM Data::Dump
#my %esc = (
# "\a" => "\\a",
# "\b" => "\\b",
# "\t" => "\\t",
# "\n" => "\\n",
# "\f" => "\\f",
# "\r" => "\\r",
# "\e" => "\\e",
#);
#
## put a string value in double quotes
#sub _double_quote {
# local($_) = $_[0];
#
# # If there are many '"' we might want to use qq() instead
# s/([\\\"\@\$])/\\$1/g;
# return qq("$_") unless /[^\040-\176]/; # fast exit
#
# s/([\a\b\t\n\f\r\e])/$esc{$1}/g;
#
# # no need for 3 digits in escape for these
# s/([\0-\037])(?!\d)/sprintf('\\%o',ord($1))/eg;
#
# s/([\0-\037\177-\377])/sprintf('\\x%02X',ord($1))/eg;
# s/([^\040-\176])/sprintf('\\x{%X}',ord($1))/eg;
#
# return qq("$_");
#}
## END COPY PASTE FROM Data::Dump
#
#sub _dump_code {
# my $code = shift;
#
# state $deparse = do {
# require B::Deparse;
# B::Deparse->new("-l"); # -i option doesn't have any effect?
# };
#
# my $res = $deparse->coderef2text($code);
#
# my ($res_before_first_line, $res_after_first_line) =
# $res =~ /(.+?)^(#line .+)/ms;
#
# if ($OPT_REMOVE_PRAGMAS) {
# $res_before_first_line = "{";
# } elsif ($OPT_PERL_VERSION < 5.016) {
# # older perls' feature.pm doesn't yet support q{no feature ':all';}
# # so we replace it with q{no feature}.
# $res_before_first_line =~ s/no feature ':all';/no feature;/m;
# }
# $res_after_first_line =~ s/^#line .+//gm;
#
# $res = "sub" . $res_before_first_line . $res_after_first_line;
# $res =~ s/^\s+//gm;
# $res =~ s/\n+//g;
# $res =~ s/;\}\z/}/;
# $res;
#}
#
#sub _quote_key {
# $_[0] =~ /\A-?[A-Za-z_][A-Za-z0-9_]*\z/ ||
# $_[0] =~ /\A-?[1-9][0-9]{0,8}\z/ ? $_[0] : _double_quote($_[0]);
#}
#
#sub _dump {
# my ($val, $subscript) = @_;
#
# my $ref = ref($val);
# if ($ref eq '') {
# if (!defined($val)) {
# return "undef";
# } elsif (looks_like_number($val) && !$OPT_STRINGIFY_NUMBERS &&
# # perl does several normalizations to number literal, e.g.
# # "+1" becomes 1, 0123 is octal literal, etc. make sure we
# # only leave out quote when the number is not normalized
# $val eq $val+0 &&
# # perl also doesn't recognize Inf and NaN as numeric
# # literals (ref: perldata) so these unquoted literals will
# # choke under 'use strict "subs"
# $val !~ /\A-?(?:inf(?:inity)?|nan)\z/i
# ) {
# return $val;
# } else {
# return _double_quote($val);
# }
# }
# my $refaddr = refaddr($val);
# $_subscripts{$refaddr} //= $subscript;
# if ($_seen_refaddrs{$refaddr}++) {
# push @_fixups, "\$a->$subscript=\$a",
# ($_subscripts{$refaddr} ? "->$_subscripts{$refaddr}" : ""), ";";
# return "'fix'";
# }
#
# my $class;
#
# if ($ref eq 'Regexp' || $ref eq 'REGEXP') {
# require Regexp::Stringify;
# return Regexp::Stringify::stringify_regexp(
# regexp=>$val, with_qr=>1, plver=>$OPT_PERL_VERSION);
# }
#
# if (blessed $val) {
# $class = $ref;
# $ref = reftype($val);
# }
#
# my $res;
# if ($ref eq 'ARRAY') {
# $res = "[";
# my $i = 0;
# for (@$val) {
# $res .= "," if $i;
# $res .= _dump($_, "$subscript\[$i]");
# $i++;
# }
# $res .= "]";
# } elsif ($ref eq 'HASH') {
# $res = "{";
# my $i = 0;
# for (sort keys %$val) {
# $res .= "," if $i++;
# my $k = _quote_key($_);
# my $v = _dump($val->{$_}, "$subscript\{$k}");
# $res .= "$k=>$v";
# }
# $res .= "}";
# } elsif ($ref eq 'SCALAR') {
# $res = "\\"._dump($$val, $subscript);
# } elsif ($ref eq 'REF') {
# $res = "\\"._dump($$val, $subscript);
# } elsif ($ref eq 'CODE') {
script/_reposdb-inline view on Meta::CPAN
#=head1 AUTHOR
#
#perlancar <perlancar@cpan.org>
#
#=head1 COPYRIGHT AND LICENSE
#
#This software is copyright (c) 2018, 2016, 2015, 2014 by perlancar@cpan.org.
#
#This is free software; you can redistribute it and/or modify it under
#the same terms as the Perl 5 programming language system itself.
#
#=cut
### Perinci/Sub/Util.pm ###
#package Perinci::Sub::Util;
#
#our $DATE = '2017-01-31'; # DATE
#our $VERSION = '0.46'; # VERSION
#
#use 5.010001;
#use strict;
#use warnings;
#
#require Exporter;
#our @ISA = qw(Exporter);
#our @EXPORT_OK = qw(
# err
# caller
# warn_err
# die_err
# gen_modified_sub
# gen_curried_sub
# );
#
#our %SPEC;
#
#$SPEC{':package'} = {
# v => 1.1,
# summary => 'Helper when writing functions',
#};
#
#our $STACK_TRACE;
#our @_c; # to store temporary celler() result
#our $_i; # temporary variable
#sub err {
# require Scalar::Util;
#
# # get information about caller
# my @caller = CORE::caller(1);
# if (!@caller) {
# # probably called from command-line (-e)
# @caller = ("main", "-e", 1, "program");
# }
#
# my ($status, $msg, $meta, $prev);
#
# for (@_) {
# my $ref = ref($_);
# if ($ref eq 'ARRAY') { $prev = $_ }
# elsif ($ref eq 'HASH') { $meta = $_ }
# elsif (!$ref) {
# if (Scalar::Util::looks_like_number($_)) {
# $status = $_;
# } else {
# $msg = $_;
# }
# }
# }
#
# $status //= 500;
# $msg //= "$caller[3] failed";
# $meta //= {};
# $meta->{prev} //= $prev if $prev;
#
# # put information on who produced this error and where/when
# if (!$meta->{logs}) {
#
# # should we produce a stack trace?
# my $stack_trace;
# {
# no warnings;
# # we use Carp::Always as a sign that user wants stack traces
# last unless $STACK_TRACE // $INC{"Carp/Always.pm"};
# # stack trace is already there in previous result's log
# last if $prev && ref($prev->[3]) eq 'HASH' &&
# ref($prev->[3]{logs}) eq 'ARRAY' &&
# ref($prev->[3]{logs}[0]) eq 'HASH' &&
# $prev->[3]{logs}[0]{stack_trace};
# $stack_trace = [];
# $_i = 1;
# while (1) {
# {
# package DB;
# @_c = CORE::caller($_i);
# if (@_c) {
# $_c[4] = [@DB::args];
# }
# }
# last unless @_c;
# push @$stack_trace, [@_c];
# $_i++;
# }
# }
# push @{ $meta->{logs} }, {
# type => 'create',
# time => time(),
# package => $caller[0],
# file => $caller[1],
# line => $caller[2],
# func => $caller[3],
# ( stack_trace => $stack_trace ) x !!$stack_trace,
# };
# }
#
# #die;
# [$status, $msg, undef, $meta];
#}
#
#sub warn_err {
# require Carp;
#
# my $res = err(@_);
script/_reposdb-inline view on Meta::CPAN
# $self->_emit($ef), last
# if $_[0] =~ /$ESCAPE_CHAR/;
# if ($_[0] =~ /\n/) {
# $self->_emit($sb),
# $self->_emit_block($LIT_CHAR, $_[0]),
# $self->_emit($eb), last
# if $self->use_block;
# Carp::cluck "[YAML::Old] \$UseFold is no longer supported"
# if $self->use_fold;
# $self->_emit($sf),
# $self->_emit_double($_[0]),
# $self->_emit($ef), last
# if length $_[0] <= 30;
# $self->_emit($sf),
# $self->_emit_double($_[0]),
# $self->_emit($ef), last
# if $_[0] !~ /\n\s*\S/;
# $self->_emit($sb),
# $self->_emit_block($LIT_CHAR, $_[0]),
# $self->_emit($eb), last;
# }
# $self->_emit($sf),
# $self->_emit_number($_[0]),
# $self->_emit($ef), last
# if $self->is_literal_number($_[0]);
# $self->_emit($sf),
# $self->_emit_plain($_[0]),
# $self->_emit($ef), last
# if $self->is_valid_plain($_[0]);
# $self->_emit($sf),
# $self->_emit_double($_[0]),
# $self->_emit($ef), last
# if $_[0] =~ /'/;
# $self->_emit($sf),
# $self->_emit_single($_[0]),
# $self->_emit($ef);
# last;
# }
#
# $self->{level}--;
#
# return;
#}
#
#sub is_literal_number {
# my $self = shift;
# # Stolen from JSON::Tiny
# return B::svref_2object(\$_[0])->FLAGS & (B::SVp_IOK | B::SVp_NOK)
# && 0 + $_[0] eq $_[0];
#}
#
#sub _emit_number {
# my $self = shift;
# return $self->_emit_plain($_[0]);
#}
#
## Check whether or not a scalar should be emitted as an plain scalar.
#sub is_valid_plain {
# my $self = shift;
# return 0 unless length $_[0];
# return 0 if $self->quote_numeric_strings and Scalar::Util::looks_like_number($_[0]);
# # refer to YAML::Old::Loader::parse_inline_simple()
# return 0 if $_[0] =~ /^[\s\{\[\~\`\'\"\!\@\#\>\|\%\&\?\*\^]/;
# return 0 if $_[0] =~ /[\{\[\]\},]/;
# return 0 if $_[0] =~ /[:\-\?]\s/;
# return 0 if $_[0] =~ /\s#/;
# return 0 if $_[0] =~ /\:(\s|$)/;
# return 0 if $_[0] =~ /[\s\|\>]$/;
# return 0 if $_[0] eq '-';
# return 1;
#}
#
#sub _emit_block {
# my $self = shift;
# my ($indicator, $value) = @_;
# $self->{stream} .= $indicator;
# $value =~ /(\n*)\Z/;
# my $chomp = length $1 ? (length $1 > 1) ? '+' : '' : '-';
# $value = '~' if not defined $value;
# $self->{stream} .= $chomp;
# $self->{stream} .= $self->indent_width if $value =~ /^\s/;
# $self->{stream} .= $self->indent($value);
#}
#
## Plain means that the scalar is unquoted.
#sub _emit_plain {
# my $self = shift;
# $self->{stream} .= defined $_[0] ? $_[0] : '~';
#}
#
## Double quoting is for single lined escaped strings.
#sub _emit_double {
# my $self = shift;
# (my $escaped = $self->escape($_[0])) =~ s/"/\\"/g;
# $self->{stream} .= qq{"$escaped"};
#}
#
## Single quoting is for single lined unescaped strings.
#sub _emit_single {
# my $self = shift;
# my $item = shift;
# $item =~ s{'}{''}g;
# $self->{stream} .= "'$item'";
#}
#
##==============================================================================
## Utility subroutines.
##==============================================================================
#
## Indent a scalar to the current indentation level.
#sub indent {
# my $self = shift;
# my ($text) = @_;
# return $text unless length $text;
# $text =~ s/\n\Z//;
# my $indent = ' ' x $self->offset->[$self->level];
# $text =~ s/^/$indent/gm;
# $text = "\n$text";
# return $text;
#}
#
script/_reposdb-inline view on Meta::CPAN
# my ($anchor) = @_;
# my $mapping = $self->preserve ? YAML::Old::Node->new({}) : {};
# $self->anchor2node->{$anchor} = $mapping;
# my $key;
# while (not $self->done and $self->indent == $self->offset->[$self->level]) {
# # If structured key:
# if ($self->{content} =~ s/^\?\s*//) {
# $self->preface($self->content);
# $self->_parse_next_line(COLLECTION);
# $key = $self->_parse_node();
# $key = "$key";
# }
# # If "default" key (equals sign)
# elsif ($self->{content} =~ s/^\=\s*//) {
# $key = VALUE;
# }
# # If "comment" key (slash slash)
# elsif ($self->{content} =~ s/^\=\s*//) {
# $key = COMMENT;
# }
# # Regular scalar key:
# else {
# $self->inline($self->content);
# $key = $self->_parse_inline();
# $key = "$key";
# $self->content($self->inline);
# $self->inline('');
# }
#
# unless ($self->{content} =~ s/^:\s*//) {
# $self->die('YAML_LOAD_ERR_BAD_MAP_ELEMENT');
# }
# $self->preface($self->content);
# my $line = $self->line;
# $self->_parse_next_line(COLLECTION);
# my $value = $self->_parse_node();
# if (exists $mapping->{$key}) {
# $self->warn('YAML_LOAD_WARN_DUPLICATE_KEY', $key);
# }
# else {
# $mapping->{$key} = $value;
# }
# }
# return $mapping;
#}
#
## Parse a YAML sequence into a Perl array
#sub _parse_seq {
# my $self = shift;
# my ($anchor) = @_;
# my $seq = [];
# $self->anchor2node->{$anchor} = $seq;
# while (not $self->done and $self->indent == $self->offset->[$self->level]) {
# if ($self->content =~ /^-(?: (.*))?$/) {
# $self->preface(defined($1) ? $1 : '');
# }
# else {
# $self->die('YAML_LOAD_ERR_BAD_SEQ_ELEMENT');
# }
#
# # Check whether the preface looks like a YAML mapping ("key: value").
# # This is complicated because it has to account for the possibility
# # that a key is a quoted string, which itself may contain escaped
# # quotes.
# my $preface = $self->preface;
# if ( $preface =~ /^ (\s*) ( \w .*? \: (?:\ |$).*) $/x or
# $preface =~ /^ (\s*) ((') (?:''|[^'])*? ' \s* \: (?:\ |$).*) $/x or
# $preface =~ /^ (\s*) ((") (?:\\\\|[^"])*? " \s* \: (?:\ |$).*) $/x
# ) {
# $self->indent($self->offset->[$self->level] + 2 + length($1));
# $self->content($2);
# $self->level($self->level + 1);
# $self->offset->[$self->level] = $self->indent;
# $self->preface('');
# push @$seq, $self->_parse_mapping('');
# $self->{level}--;
# $#{$self->offset} = $self->level;
# }
# else {
# $self->_parse_next_line(COLLECTION);
# push @$seq, $self->_parse_node();
# }
# }
# return $seq;
#}
#
## Parse an inline value. Since YAML supports inline collections, this is
## the top level of a sub parsing.
#sub _parse_inline {
# my $self = shift;
# my ($top, $top_implicit, $top_explicit) = (@_, '', '', '');
# $self->{inline} =~ s/^\s*(.*)\s*$/$1/; # OUCH - mugwump
# my ($node, $anchor, $alias, $explicit, $implicit) = ('') x 5;
# ($anchor, $alias, $explicit, $implicit, $self->{inline}) =
# $self->_parse_qualifiers($self->inline);
# if ($anchor) {
# $self->anchor2node->{$anchor} = CORE::bless [], 'YAML-anchor2node';
# }
# $implicit ||= $top_implicit;
# $explicit ||= $top_explicit;
# ($top_implicit, $top_explicit) = ('', '');
# if ($alias) {
# $self->die('YAML_PARSE_ERR_NO_ANCHOR', $alias)
# unless defined $self->anchor2node->{$alias};
# if (ref($self->anchor2node->{$alias}) ne 'YAML-anchor2node') {
# $node = $self->anchor2node->{$alias};
# }
# else {
# $node = do {my $sv = "*$alias"};
# push @{$self->anchor2node->{$alias}}, [\$node, $self->line];
# }
# }
# elsif ($self->inline =~ /^\{/) {
# $node = $self->_parse_inline_mapping($anchor);
# }
# elsif ($self->inline =~ /^\[/) {
# $node = $self->_parse_inline_seq($anchor);
# }
# elsif ($self->inline =~ /^"/) {
# $node = $self->_parse_inline_double_quoted();
# $node = $self->_unescape($node);
( run in 1.290 second using v1.01-cache-2.11-cpan-39bf76dae61 )