use List::Util 1.33 qw(any all);
use Module::Load;
use Ref::Util qw(is_arrayref is_coderef is_hashref is_ref is_refref is_scalarref);
-use Scalar::Util qw(blessed readonly);
+use Scalar::Util qw(blessed looks_like_number readonly);
+use Time::Piece;
+use boolean;
use namespace::clean -except => 'import';
our $VERSION = '999.999'; # VERSION
our %EXPORT_TAGS = (
assert => [qw(assert_64bit)],
+ class => [qw(extends has)],
clone => [qw(clone clone_nomagic)],
+ coercion => [qw(to_bool to_number to_string to_time to_tristate to_uuid)],
crypt => [qw(pad_pkcs7)],
debug => [qw(dumper)],
fork => [qw(can_fork)],
gzip => [qw(gzip gunzip)],
io => [qw(is_readable is_writable read_all)],
load => [qw(load_optional load_xs try_load_optional)],
- search => [qw(query search simple_expression_query)],
+ search => [qw(query search search_limited simple_expression_query)],
text => [qw(snakify trim)],
uuid => [qw(format_uuid generate_uuid is_uuid uuid)],
uri => [qw(split_url uri_escape_utf8 uri_unescape_utf8)],
# boolean
$str =~ s/bless\( do\{\\\(my \$o = ([01])\)\}, 'boolean' \)/boolean($1)/gs;
# Time::Piece
- $str =~ s/bless\([^\)]+?(\d+)'?,\s+\d+,?\s+\], 'Time::Piece' \)/Time::Piece->new($1)/gs;
+ $str =~ s/bless\([^\)]+?(\d+)'?,\s+\d+,?\s+\], 'Time::Piece' \),/
+ "scalar gmtime($1), # " . scalar gmtime($1)->datetime/ges;
print STDERR $str if !defined wantarray;
push @dumps, $str;
=cut
sub erase_scoped {
+ throw 'Programmer error: Cannot call erase_scoped in void context' if !defined wantarray;
my @args;
for (@_) {
!is_ref($_) || is_arrayref($_) || is_hashref($_) || is_scalarref($_)
return Scope::Guard->new(sub { erase(@args) });
}
+=func extends
+
+ extends $class;
+
+Set up the current module to inheret from another module.
+
+=cut
+
+sub extends {
+ my $parent = shift;
+ my $caller = caller;
+ load $parent;
+ no strict 'refs'; ## no critic (ProhibitNoStrict)
+ @{"${caller}::ISA"} = $parent;
+}
+
+=func has
+
+ has $name => %options;
+
+Create an attribute getter/setter. Possible options:
+
+=for :list
+* C<is> - Either "rw" (default) or "ro"
+* C<default> - Default value
+* C<coerce> - Coercive function
+
+=cut
+
+sub has {
+ my $name = shift;
+ my %args = @_ % 2 == 1 ? (default => shift, @_) : @_;
+
+ my $d = $args{default};
+ my $default = is_arrayref($d) ? sub { [%$d] } : is_hashref($d) ? sub { +{%$d} } : $d;
+ my $coerce = $args{coerce};
+ my $is = $args{is} || 'rw';
+
+ my $has_default = is_coderef $default;
+ my $has_coerce = is_coderef $coerce;
+
+ my $caller = caller;
+ no strict 'refs'; ## no critic (ProhibitNoStrict)
+ if (my $store = $args{store}) {
+ *{"${caller}::${name}"} = $is eq 'ro' && $has_default ? sub {
+ $_[0]->$store->{$name} //= scalar $default->($_[0]);
+ } : $is eq 'ro' ? sub {
+ $_[0]->$store->{$name} //= $default;
+ } : $has_default && $has_coerce ? sub {
+ $#_ ? $_[0]->$store->{$name} = scalar $coerce->($_[1])
+ : $_[0]->$store->{$name} //= scalar $default->($_[0]);
+ } : $has_default ? sub {
+ $#_ ? $_[0]->$store->{$name} = $_[1]
+ : $_[0]->$store->{$name} //= scalar $default->($_[0]);
+ } : $has_coerce ? sub {
+ $#_ ? $_[0]->$store->{$name} = scalar $coerce->($_[1])
+ : $_[0]->$store->{$name} //= $default;
+ } : sub {
+ $#_ ? $_[0]->$store->{$name} = $_[1]
+ : $_[0]->$store->{$name} //= $default;
+ };
+ }
+ else {
+ *{"${caller}::${name}"} = $is eq 'ro' && $has_default ? sub {
+ $_[0]->{$name} //= scalar $default->($_[0]);
+ } : $is eq 'ro' ? sub {
+ $_[0]->{$name} //= $default;
+ } : $has_default && $has_coerce ? sub {
+ $#_ ? $_[0]->{$name} = scalar $coerce->($_[1])
+ : $_[0]->{$name} //= scalar $default->($_[0]);
+ } : $has_default ? sub {
+ $#_ ? $_[0]->{$name} = $_[1]
+ : $_[0]->{$name} //= scalar $default->($_[0]);
+ } : $has_coerce ? sub {
+ $#_ ? $_[0]->{$name} = scalar $coerce->($_[1])
+ : $_[0]->{$name} //= $default;
+ } : sub {
+ $#_ ? $_[0]->{$name} = $_[1]
+ : ($_[0]->{$name} //= $default);
+ };
+ }
+}
+
=func format_uuid
$string_uuid = format_uuid($raw_uuid);
sub search {
my $list = shift;
my $query = shift;
- # my %args = @_;
if (is_coderef($query) && !@_) {
# already a query
$query = query($query, @_);
}
- # my $limit = $args{limit};
+ my @match;
+ for my $item (@$list) {
+ push @match, $item if $query->($item);
+ }
+ return \@match;
+}
+
+=for Pod::Coverage search_limited
+
+=cut
+
+sub search_limited {
+ my $list = shift;
+ my $query = shift;
+ my $limit = shift // 1;
+
+ if (is_coderef($query) && !@_) {
+ # already a query
+ }
+ elsif (is_scalarref($query)) {
+ $query = simple_expression_query($$query, @_);
+ }
+ else {
+ $query = query($query, @_);
+ }
my @match;
for my $item (@$list) {
push @match, $item if $query->($item);
- # last if defined $limit && $limit <= @match;
+ last if $limit <= @match;
}
return \@match;
}
return ($scheme, $auth, $host, $port, $path, $query, $hash, $username, $password);
}
+=func to_bool
+
+=func to_number
+
+=func to_string
+
+=func to_time
+
+=func to_tristate
+
+=func to_uuid
+
+Various typecasting / coercive functions.
+
+=cut
+
+sub to_bool { $_[0] // return; boolean($_[0]) }
+sub to_number { $_[0] // return; 0+$_[0] }
+sub to_string { $_[0] // return; "$_[0]" }
+sub to_time {
+ $_[0] // return;
+ return gmtime($_[0]) if looks_like_number($_[0]);
+ return Time::Piece->strptime($_[0], '%Y-%m-%d %H:%M:%S') if !blessed $_[0];
+ return $_[0];
+}
+sub to_tristate { $_[0] // return; boolean($_[0]) }
+sub to_uuid {
+ my $str = to_string(@_) // return;
+ return sprintf('%016s', $str) if length($str) < 16;
+ return substr($str, 0, 16) if 16 < length($str);
+ return $str;
+}
+
=func trim
$string = trim($string);