App-Genpass-ID
view release on metacpan or search on metacpan
script/_genpass-id view on Meta::CPAN
#our $DATE = '2017-01-15';
#our $VERSION = '0.38';
#
#use 5.010001;
#use strict;
#use warnings;
#
#use parent qw(Data::Clean);
#
#use Exporter qw(import);
#our @EXPORT_OK = qw(
# clean_json_in_place
# clone_and_clean_json
# );
#
#sub new {
# my ($class, %opts) = @_;
# $opts{DateTime} //= [call_method => 'epoch'];
# $opts{'Time::Moment'} //= [call_method => 'epoch'];
# $opts{'Math::BigInt'} //= [call_method => 'bstr'];
# $opts{Regexp} //= ['stringify'];
# $opts{version} //= ['stringify'];
#
# $opts{SCALAR} //= ['deref_scalar'];
# $opts{-ref} //= ['replace_with_ref'];
# $opts{-circular} //= ['clone'];
# $opts{-obj} //= ['unbless'];
#
# $opts{'!recurse_obj'} //= 1;
# $class->SUPER::new(%opts);
#}
#
#sub get_cleanser {
# my $class = shift;
# state $singleton = $class->new;
# $singleton;
#}
#
#sub clean_json_in_place {
# __PACKAGE__->get_cleanser->clean_in_place(@_);
#}
#
#sub clone_and_clean_json {
# __PACKAGE__->get_cleanser->clone_and_clean(@_);
#}
#
#1;
#
#__END__
#
### Data/Dmp.pm ###
#package Data::Dmp;
#
#our $DATE = '2017-01-30';
#our $VERSION = '0.23';
#
#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 %_seen_refaddrs;
#our %_subscripts;
#our @_fixups;
#
#our $OPT_PERL_VERSION = "5.010";
#our $OPT_REMOVE_PRAGMAS = 0;
#our $OPT_DEPARSE = 1;
#our $OPT_STRINGIFY_NUMBERS = 0;
#
#my %esc = (
# "\a" => "\\a",
# "\b" => "\\b",
# "\t" => "\\t",
# "\n" => "\\n",
# "\f" => "\\f",
# "\r" => "\\r",
# "\e" => "\\e",
#);
#
#sub _double_quote {
# local($_) = $_[0];
#
# s/([\\\"\@\$])/\\$1/g;
# return qq("$_") unless /[^\040-\176]/;
#
# s/([\a\b\t\n\f\r\e])/$esc{$1}/g;
#
# 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("$_");
#}
#
#sub _dump_code {
# my $code = shift;
#
# state $deparse = do {
# require B::Deparse;
# B::Deparse->new("-l");
# };
#
# 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) {
# $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 &&
# $val eq $val+0 &&
# $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') {
# $res = $OPT_DEPARSE ? _dump_code($val) : 'sub{"DUMMY"}';
# } else {
# die "Sorry, I can't dump $val (ref=$ref) yet";
# }
#
# $res = "bless($res,"._double_quote($class).")" if defined($class);
script/_genpass-id view on Meta::CPAN
# $opts->{remove_internal_properties} //= 0;
#
# require Sah::Schema::rinci::function_meta;
# my $sch = $Sah::Schema::rinci::function_meta::schema;
# my $sch_proplist = $sch->[1]{_prop}
# or die "BUG: Rinci schema structure changed (1a)";
#
# _normalize($meta, 1.1, $opts, $sch_proplist, {}, '');
#}
#
#1;
#
#__END__
#
### Perinci/Sub/Util.pm ###
#package Perinci::Sub::Util;
#
#our $DATE = '2017-01-31';
#our $VERSION = '0.46';
#
#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;
#our $_i;
#sub err {
# require Scalar::Util;
#
# my @caller = CORE::caller(1);
# if (!@caller) {
# @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;
#
# if (!$meta->{logs}) {
#
# my $stack_trace;
# {
# no warnings;
# last unless $STACK_TRACE // $INC{"Carp/Always.pm"};
# 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,
# };
# }
#
# [$status, $msg, undef, $meta];
#}
#
#sub warn_err {
# require Carp;
#
# my $res = err(@_);
# Carp::carp("ERROR $res->[0]: $res->[1]");
#}
#
#sub die_err {
# require Carp;
script/_genpass-id view on Meta::CPAN
# $self->_emit($sf),
# $self->_emit_double($_[0]),
# $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;
# 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]);
#}
#
#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]);
# 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);
#}
#
#sub _emit_plain {
# my $self = shift;
# $self->{stream} .= defined $_[0] ? $_[0] : '~';
#}
#
#sub _emit_double {
# my $self = shift;
# (my $escaped = $self->escape($_[0])) =~ s/"/\\"/g;
# $self->{stream} .= qq{"$escaped"};
#}
#
#sub _emit_single {
# my $self = shift;
# my $item = shift;
# $item =~ s{'}{''}g;
# $self->{stream} .= "'$item'";
#}
#
#
#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;
#}
#
#my @escapes = qw(\0 \x01 \x02 \x03 \x04 \x05 \x06 \a
# \x08 \t \n \v \f \r \x0e \x0f
# \x10 \x11 \x12 \x13 \x14 \x15 \x16 \x17
# \x18 \x19 \x1a \e \x1c \x1d \x1e \x1f
# );
#
#sub escape {
# my $self = shift;
( run in 0.478 second using v1.01-cache-2.11-cpan-39bf76dae61 )